Changeset 71 for lang/elisp

Show
Ignore:
Timestamp:
01/30/09 23:52:02 (16 years ago)
Author:
naoya_t
Message:
 
Location:
lang/elisp/pdicv-mode/trunk
Files:
1 removed
13 modified

Legend:

Unmodified
Added
Removed

  • lang/elisp/pdicv-mode/trunk/README.utf8

    r67 r71  
    55　　アルク刊「英辞郎」赤本・黒本CD-ROMに収録されているPDIC形式の辞書データや、 
    66　　インターネット上で入手可能なPDIC形式の様々な辞書データリソースが利用できます。 
     7　　[NEW]アルク刊「英辞郎 第四版」に収録されているUnicodeタイプの英辞郎データにも対応しました！(2009/1) 
    78 
    89　　Unicode(BOCU)辞書にも対応しています。（要(?)Mule-UCS） 
    … …  
    2829◎ 作者連絡先 
    2930 
    30 　　Naochan (Naoya TOZUKA) <pdicviewer@gmail.com> 
    31 　　http://www.naochan.com/ 
    32 　　http://d.hatena.ne.jp/naoya_t/ 
     31　　naoya_t <naoya.t@aqua.plala.or.jp> 
     32　　http://blog.livedoor.jp/naoya_t/ 
     33    
    3334 
    3435◎ 一次配布元 
    35  
    36 　　http://pdicviewer.naochan.com/el/ 
    37  
     36   svn://lambdarepos.svnrepository.com/svn/share/lang/elisp/pdicv-mode/trunk 

  • lang/elisp/pdicv-mode/trunk/nt-bocu.el

    r67 r71  
    11;;; nt-bocu.el --- decode/encode BOCU-1 string (via utf-8, so requires Mule-UCS) 
    22;; 
    3 ;; Copyright (C) 2005 Naoya TOZUKA. All Rights Reserved. 
     3;; Copyright (C) 2005-2009 naoya_t. All Rights Reserved. 
    44;; 
    5 ;; Author: Naoya TOZUKA <pdicviewer@gmail.com> 
    6 ;; Maintainer: Naoya TOZUKA <pdicviewer@gmail.com> 
    7 ;; Primary distribution site: http://pdicviewer.naochan.com/el/ 
     5;; Author: naoya_t <naoya.t@aqua.plala.or.jp> 
     6;; Maintainer: naoya_t <naoya.t@aqua.plala.or.jp> 
     7;; Primary distribution site: 
     8;;   http://lambdarepos.svnrepository.com/svn/share/lang/elisp/pdicv-mode/trunk 
    89;; 
    910;; Created: 12 Feb 2005 
    … …  
    3839   ((>= tr #x10) (- tr 10)) ;10 ... 19 >> 06 ... 0F 
    3940   (t (1- tr))              ;01 ... 06 >> 00 ... 05 
    40    ); cond 
    41   ) 
     41   )) 
     42 
    4243(defsubst nt:bocu-encode-trail-char (c) 
    4344  "[BOCU] encode trail char" 
    … …  
    4748   ((>= c #x06) (+ c 10)) ;06 ... 0F >> 10 ... 19 
    4849   (t (1+ c))             ;00 ... 05 >> 01 ... 06 
    49    ); cond 
    50   ) 
     50   )) 
    5151 
    5252(defun nt:bocustr-to-rawcode-list (s) 
    … …  
    6767                                        ; trail 1 
    6868             (setq tr (nt:bocu-decode-trail-char (aref s i)) i (1+ i)) 
    69              (setq diff (+ diff tr)) 
    70              ) 
     69             (setq diff (+ diff tr)) ) 
    7170            ((< lead #x25) ;22-24 (L T T) 
    7271             (setq diff (+ -10513 (* (- lead #x25) 243 243))) 
    … …  
    7675                                        ; trail 1 
    7776             (setq tr (nt:bocu-decode-trail-char (aref s i)) i (1+ i)) 
    78              (setq diff (+ diff tr)) 
    79              ) 
     77             (setq diff (+ diff tr)) ) 
    8078            ((< lead #x50) ;25-4f (L T) 
    8179             (setq diff (+ -64 (* (- lead #x50) 243))) 
    8280                                        ; trail 1 
    8381             (setq tr (nt:bocu-decode-trail-char (aref s i)) i (1+ i)) 
    84              (setq diff (+ diff tr)) 
    85              ) 
     82             (setq diff (+ diff tr)) ) 
    8683            ((< lead #xd0) ;50-cf (L) 
    87              (setq diff (- lead #x90)) 
    88              ) 
     84             (setq diff (- lead #x90)) ) 
    8985            ((< lead #xfb) ;d0-fa (L T) 
    9086             (setq diff (+ 64 (* (- lead #xd0) 243))) 
    9187                                        ; trail 1 
    9288             (setq tr (nt:bocu-decode-trail-char (aref s i)) i (1+ i)) 
    93              (setq diff (+ diff tr)) 
    94              ) 
     89             (setq diff (+ diff tr)) ) 
    9590            ((< lead #xfe) ;fb-fd (L T T) 
    9691             (setq diff (+ 10513 (* (- lead #xfb) 243 243))) 
    … …  
    10095                                        ; trail 1 
    10196             (setq tr (nt:bocu-decode-trail-char (aref s i)) i (1+ i)) 
    102              (setq diff (+ diff tr)) 
    103              ) 
     97             (setq diff (+ diff tr)) ) 
    10498            ((= lead #xfe) ;fe    (L T T T) 
    10599             (setq diff 187660) 
    … …  
    112106                                        ; trail 1 
    113107             (setq tr (nt:bocu-decode-trail-char (aref s i)) i (1+ i)) 
    114              (setq diff (+ diff tr)) 
    115              ) 
    116             ((= lead #xff) ; reset 
    117              ) 
    118             ); end of cond. 
     108             (setq diff (+ diff tr)) ) 
     109            ((= lead #xff) )) ; reset 
    119110 
    120111      (cond 
    … …  
    122113        (push lead l) 
    123114                                        ;       (setq r (concat r (string lead))) 
    124         (if (< lead #x20) (setq pc #x40)) ;#x20�ʤ餽�Τޤ�        ) 
    125        ((< lead #xff) 
     115        (if (< lead #x20) (setq pc #x40)) ) ;#x20�ʤ餽�Τޤ�       ((< lead #xff) 
    126116        (progn 
    127117          (setq code (+ pc diff)) 
    128118          (if (< code 0) (setq code 0));; error recovery 
    129  
    130119          (push code l) 
    131120                                        ;         (setq r (concat r (if (> code 0) (code-to-utf8 code) "?"))) 
    … …  
    140129                    )); pc 
    141130          )) 
    142        (t (setq pc #x40)); #xFF: reset 
    143        ) 
    144       ); wend 
    145     (nreverse l) 
    146     ); let 
    147   ) 
     131       (t (setq pc #x40)) )); #xFF: reset 
     132    (nreverse l) )) 
    148133 
    149134(defun nt:diff-to-bocustr (diff) 
    … …  
    160145          (setq t1 (% diff 243)) (setq diff (/ diff 243)) 
    161146                                        ;(setq t0 diff) 
    162           (string #x21 (nt:bocu-encode-trail-char t1) (nt:bocu-encode-trail-char t2) (nt:bocu-encode-trail-char t3)) 
    163           ) 
    164         ) 
     147          (string #x21 (nt:bocu-encode-trail-char t1) (nt:bocu-encode-trail-char t2) (nt:bocu-encode-trail-char t3)) )) 
    165148       ((< diff -10513)   ; [-187660,-10513) : 22-24 
    166149        (progn 
    … …  
    169152          (setq t1 (% diff 243)) (setq diff (/ diff 243)) 
    170153          (setq t0 diff) 
    171           (string (+ #x22 t0) (nt:bocu-encode-trail-char t1) (nt:bocu-encode-trail-char t2)) 
    172           ) 
    173         ) 
     154          (string (+ #x22 t0) (nt:bocu-encode-trail-char t1) (nt:bocu-encode-trail-char t2)) )) 
    174155       ((< diff -64)      ; [-10513,-64) : 25-4F 
    175156        (progn 
    … …  
    177158          (setq t1 (% diff 243)) (setq diff (/ diff 243)) 
    178159          (setq t0 diff) 
    179           (string (+ #x25 t0) (nt:bocu-encode-trail-char t1)) 
    180           ) 
    181         ) 
     160          (string (+ #x25 t0) (nt:bocu-encode-trail-char t1)) )) 
    182161       ((< diff 64)       ; [-64,63) : 50-CF 
    183162        (progn 
    184163          (setq diff (- diff -64)) 
    185164          (setq t0 diff) 
    186           (string (+ #x50 t0)) 
    187           ) 
    188         ) 
     165          (string (+ #x50 t0)) )) 
    189166       ((< diff 10513)    ; [64,10513) : D0-FA 
    190167        (progn 
    … …  
    192169          (setq t1 (% diff 243)) (setq diff (/ diff 243)) 
    193170          (setq t0 diff) 
    194           (string (+ #xD0 t0) (nt:bocu-encode-trail-char t1)) 
    195           ) 
    196         ) 
     171          (string (+ #xD0 t0) (nt:bocu-encode-trail-char t1)) )) 
    197172       ((< diff 187660)   ; [10513,187660) : FB-FD 
    198173        (progn 
    … …  
    201176          (setq t1 (% diff 243)) (setq diff (/ diff 243)) 
    202177          (setq t0 diff) 
    203           (string (+ #xFB t0) (nt:bocu-encode-trail-char t1) (nt:bocu-encode-trail-char t2)) 
    204           ) 
    205         ) 
     178          (string (+ #xFB t0) (nt:bocu-encode-trail-char t1) (nt:bocu-encode-trail-char t2)) )) 
    206179       ((< diff 14536567) ; [187660,14536567) : FE 
    207180        (progn 
    … …  
    211184          (setq t1 (% diff 243)) (setq diff (/ diff 243)) 
    212185                                        ;(setq t0 diff) 
    213           (string #xFE (nt:bocu-encode-trail-char t1) (nt:bocu-encode-trail-char t2) (nt:bocu-encode-trail-char t3)) 
    214           ) 
    215         ) 
    216        (t (throw 'bocu-encode-diff 'overflow-exception)) 
    217        ); cond 
    218       ); let 
    219     ); caught 
    220   ) 
     186          (string #xFE (nt:bocu-encode-trail-char t1) (nt:bocu-encode-trail-char t2) (nt:bocu-encode-trail-char t3)) )) 
     187       (t (throw 'bocu-encode-diff 'overflow-exception)) )))) 
    221188 
    222189(defun nt:rawcode-list-to-bocustr (l) ; not tested much 
    … …  
    234201                  ((and (<= #x4E00 code) (<= code #x9FA5)) #x7711) 
    235202                  ((and (<= #xAC00 code) (<= code #xD7A3)) #xC1D1) 
    236                   (t (+ (logand code #xffff80) #x40)))) 
    237         ); let* 
    238       ); wend 
    239     s 
    240     ); let* 
    241   ) 
     203                  (t (+ (logand code #xffff80) #x40)))) )) 
     204    s)) 
    242205 
    243206(defsubst nt:bocu-decode (s) 
    … …  
    245208  (let* ((rawcode-list (nt:bocustr-to-rawcode-list s)) 
    246209         (utf8str (nt:rawcode-list-to-utf8str rawcode-list))) 
    247     (decode-coding-string utf8str 'utf-8) 
    248     ) 
    249   ) 
     210    (decode-coding-string utf8str 'utf-8) )) 
    250211 
    251212(defsubst nt:bocu-encode (s) 
    … …  
    253214  (let* ((utf8str (encode-coding-string s 'utf-8)) 
    254215         (rawcode-list (nt:utf8str-to-rawcode-list utf8str)) 
    255          (bocustr (nt:rawcode-list-to-bocustr rawcode-list)) 
    256          ) 
    257     bocustr 
    258     ) 
    259   ) 
     216         (bocustr (nt:rawcode-list-to-bocustr rawcode-list))) 
     217    bocustr)) 
    260218 
    261219;;; nt-bocu.el ends here 

  • lang/elisp/pdicv-mode/trunk/nt-english.el

    r67 r71  
    11;;; nt-english.el --- English 
    22;; 
    3 ;; Copyright (C) 2005 Naoya TOZUKA. All Rights Reserved. 
     3;; Copyright (C) 2005-2009 naoya_t. All Rights Reserved. 
    44;; 
    5 ;; Author: Naoya TOZUKA <pdicviewer@gmail.com> 
    6 ;; Maintainer: Naoya TOZUKA <pdicviewer@gmail.com> 
    7 ;; Primary distribution site: http://pdicviewer.naochan.com/el/ 
     5;; Author: naoya_t <naoya.t@aqua.plala.or.jp> 
     6;; Maintainer: naoya_t <naoya.t@aqua.plala.or.jp> 
     7;; Primary distribution site: 
     8;;   http://lambdarepos.svnrepository.com/svn/share/lang/elisp/pdicv-mode/trunk 
    89;; 
    910;; Created: 23 Dec 2005 
    … …  
    261262     ((null word) (throw 'block nil)) 
    262263     ((string= word "") (throw 'block nil)) 
    263      (t nil) 
    264      ) 
     264         (t nil)) 
    265265     
    266266    (let* ((word-len (length word)) 
    … …  
    273273      (setq suffix-1 (substring word -1 nil)) 
    274274 
    275       (if (>= word-len 2) 
    276           (progn 
    277            (setq body-2 (substring word 0 -2)) 
    278            (setq suffix-2 (substring word -2 nil)) 
    279             
    280            (if (>= word-len 3) 
    281                (progn 
    282                 (setq body-3 (substring word 0 -3)) 
    283                 (setq suffix-3 (substring word -3 nil)) 
    284                  
    285                 (if (>= word-len 4) 
    286                     (progn 
    287                      (setq body-4 (substring word 0 -4)) 
    288                      (setq suffix-4 (substring word -4 nil)) 
    289                      )) 
    290                 )) 
    291            )) 
     275      (when (>= word-len 2) 
     276                (setq body-2 (substring word 0 -2)) 
     277                (setq suffix-2 (substring word -2 nil)) 
     278                (when (>= word-len 3) 
     279                  (setq body-3 (substring word 0 -3)) 
     280                  (setq suffix-3 (substring word -3 nil)) 
     281                  (when (>= word-len 4) 
     282                        (setq body-4 (substring word 0 -4)) 
     283                        (setq suffix-4 (substring word -4 nil))))) 
    292284       
    293285      ;; irregular verbs/nouns first. 
    294286      (setq tmp (cdr (assoc word nt-english-irreg-verbs-list))) 
    295       (if tmp (throw 'block (list tmp))) 
     287      (when tmp (throw 'block (list tmp))) 
    296288      (setq tmp (cdr (assoc word nt-english-irreg-nouns-list))) 
    297       (if tmp (throw 'block (list tmp))) 
     289      (when tmp (throw 'block (list tmp))) 
    298290       
    299291      (cond 
    … …  
    328320       ((string= suffix-2 "'s") (list body-2)) 
    329321       
    330        (t nil) ;; ������ʤ��������������� 
    331        ) ;cond 
    332       ) ;let 
    333     );caught 
    334   ) 
     322       (t nil))))) ;; ������ʤ��������������� 
    335323 
    336324(defmacro nt:skipit-p (word) 

  • lang/elisp/pdicv-mode/trunk/nt-file.el

    r67 r71  
    11;;; nt-file.el --- file-related functions 
    22;; 
    3 ;; Copyright (C) 2005 Naoya TOZUKA. All Rights Reserved. 
     3;; Copyright (C) 2005-2009 naoya_t. All Rights Reserved. 
    44;; 
    5 ;; Author: Naoya TOZUKA <pdicviewer@gmail.com> 
    6 ;; Maintainer: Naoya TOZUKA <pdicviewer@gmail.com> 
    7 ;; Primary distribution site: http://pdicviewer.naochan.com/el/ 
     5;; Author: naoya_t <naoya.t@aqua.plala.or.jp> 
     6;; Maintainer: naoya_t <naoya.t@aqua.plala.or.jp> 
     7;; Primary distribution site: 
     8;;   http://lambdarepos.svnrepository.com/svn/share/lang/elisp/pdicv-mode/trunk 
    89;; 
    910;; Created: 16 Feb 2005 (formerly nt-utils) 
    … …  
    3637      (setq my-buffer (buffer-substring 1 (+ 1 read-length))) 
    3738      (kill-buffer buffer-name) 
    38       my-buffer 
    39       ) ; let 
    40     ) ; save-current-buffer 
    41   ) 
     39      my-buffer))) 
    4240 
    4341(defun nt:scan-latest-version (filename-format min max) 
    … …  
    4745        (let ((file (format filename-format version))) 
    4846          (if (file-readable-p file) (throw 'scan-latest-version (list file version)) 
    49             (setq version (1- version)) 
    50             );fi 
    51           );let 
    52         );wend 
    53       nil 
    54       );let 
    55     );caught 
    56   ) 
     47            (setq version (1- version))))) 
     48      nil))) 
    5749 
    5850;;; nt-file.el ends here 

  • lang/elisp/pdicv-mode/trunk/nt-macros.el

    r67 r71  
    11;;; nt-macros.el --- useful (at least for NT) macros 
    22;; 
    3 ;; Copyright (C) 2005 Naoya TOZUKA. All Rights Reserved. 
     3;; Copyright (C) 2005-2009 naoya_t. All Rights Reserved. 
    44;; 
    5 ;; Author: Naoya TOZUKA <pdicviewer@gmail.com> 
    6 ;; Maintainer: Naoya TOZUKA <pdicviewer@gmail.com> 
    7 ;; Primary distribution site: http://pdicviewer.naochan.com/el/ 
     5;; Author: naoya_t <naoya.t@aqua.plala.or.jp> 
     6;; Maintainer: naoya_t <naoya.t@aqua.plala.or.jp> 
     7;; Primary distribution site: 
     8;;   http://lambdarepos.svnrepository.com/svn/share/lang/elisp/pdicv-mode/trunk 
    89;; 
    910;; Created: 16 Feb 2005 (formerly nt-utils.el) 

  • lang/elisp/pdicv-mode/trunk/nt-readval.el

    r67 r71  
    11;;; nt-readval.el --- read value or a string from buffer 
    22;; 
    3 ;; Copyright (C) 2005 Naoya TOZUKA. All Rights Reserved. 
     3;; Copyright (C) 2005-2009 naoya_t. All Rights Reserved. 
    44;; 
    5 ;; Author: Naoya TOZUKA <pdicviewer@gmail.com> 
    6 ;; Maintainer: Naoya TOZUKA <pdicviewer@gmail.com> 
    7 ;; Primary distribution site: http://pdicviewer.naochan.com/el/ 
     5;; Author: naoya_t <naoya.t@aqua.plala.or.jp> 
     6;; Maintainer: naoya_t <naoya.t@aqua.plala.or.jp> 
     7;; Primary distribution site: 
     8;;   http://lambdarepos.svnrepository.com/svn/share/lang/elisp/pdicv-mode/trunk 
    89;; 
    910;; Created: 06 Feb 2005 
    … …  
    2930    (if (not index) (setq index 0)) 
    3031    (if (or (< index 0) (<= (length s) index)) (throw 'uchar 'out-of-bounds-exception)) 
    31     (aref s index) 
    32     ) 
    33   ) 
     32    (aref s index))) 
    3433 
    3534;;=========================================================== 
    … …  
    4847      (if (or (< index 0) (<= (length s) index)) (throw 'char 'out-of-bounds-exception)) 
    4948      (setq c (aref s index)) 
    50       (if (< c 128) c (- c 256)) ; =result 
    51       ); let 
    52     ); caught 
    53   ) 
     49      (if (< c 128) c (- c 256))))) ; =result 
    5450 
    5551;;============================================================== 
    … …  
    6359    (if (or (< index 0) (< (- (length s) 2) index)) (throw 'ushort 'out-of-bounds-exception)) 
    6460    (+ (lsh (aref s (1+ index)) 8) 
    65        (aref s index)) 
    66     ) 
    67   ) 
     61       (aref s index)))) 
    6862 
    6963(defsubst nt:read-ushort-bigendian (s &optional index) 
    … …  
    7367    (if (or (< index 0) (< (- (length s) 2) index)) (throw 'ushort 'out-of-bounds-exception)) 
    7468    (+ (lsh (aref s index) 8) 
    75        (aref s (1+ index))) 
    76     ) 
    77   ) 
     69       (aref s (1+ index))))) 
    7870 
    7971(defmacro nt:read-ushort-littleendian (s &optional index) 
    … …  
    9082    (let ((us (nt:read-ushort s index))) 
    9183      (if (eq us 'out-of-bounds-exception) (throw 'short us)) 
    92       (if (< us 32768) us (- us 65536)) 
    93       ) ; let 
    94     );caught 
    95   ) 
     84      (if (< us 32768) us (- us 65536))))) 
    9685 
    9786(defsubst nt:read-short-bigendian (s &optional index) 
    … …  
    10089    (let ((us (nt:read-ushort-bigendian s index))) 
    10190      (if (eq us 'out-of-bounds-exception) (throw 'short us)) 
    102       (if (< us 32768) us (- us 65536)) 
    103       ) ; let 
    104     ) 
    105   ) 
     91      (if (< us 32768) us (- us 65536))))) 
    10692 
    10793(defmacro nt:read-short-littleendian (s &optional index) 
    … …  
    123109    (if (or (< index 0) (< (- (length s) 4) index)) (throw 'long 'out-of-bounds-exception)) 
    124110 
    125     (let* ( 
    126            (hh (aref s (+ index 3))) 
    127            (h0 (lsh hh -4)) 
    128            ) 
    129  
     111    (let* ((hh (aref s (+ index 3))) 
     112           (h0 (lsh hh -4))) 
    130113      (cond ((zerop h0) nil) ; plus 
    131114            ((= h0 15) nil) ; minus 
    132115                                        ;      (t (setq hh (logand 15 hh))) 
    133116            ((< h0 8) (throw 'long 'overflow-exception)) 
    134             ((>= h0 8) (throw 'long 'underflow-exception)) 
    135             ) 
     117            ((>= h0 8) (throw 'long 'underflow-exception))) 
    136118                                        ;      (logior (lsh (aref s (+ index 3)) 24) 
    137119      (logior (lsh hh 24) 
    138120              (lsh (aref s (+ index 2)) 16) 
    139121              (lsh (aref s (1+ index)) 8) 
    140               (aref s index)) 
    141       ) 
    142     ) 
    143   ) 
     122              (aref s index))))) 
    144123 
    145124(defsubst nt:read-long-bigendian (s &optional index) 
    … …  
    150129    (if (or (< index 0) (< (- (length s) 4) index)) (throw 'long 'out-of-bounds-exception)) 
    151130 
    152     (let* ( 
    153            (hh (aref s index)) 
    154            (h0 (lsh hh -4)) 
    155            ) 
    156  
     131    (let* ((hh (aref s index)) 
     132           (h0 (lsh hh -4))) 
    157133      (cond ((zerop h0) nil) ; plus 
    158134            ((= h0 15) nil) ; minus 
    159135                                        ;      (t (setq hh (logand 15 hh))) 
    160136            ((< h0 8) (throw 'long 'overflow-exception)) 
    161             ((>= h0 8) (throw 'long 'underflow-exception)) 
    162             ) 
     137            ((>= h0 8) (throw 'long 'underflow-exception))) 
    163138                                        ;      (logior (lsh (aref s (+ index 3)) 24) 
    164139      (logior (lsh hh 24) 
    165140              (lsh (aref s (1+ index)) 16) 
    166141              (lsh (aref s (+ index 2)) 8) 
    167               (aref s (+ index 3))) 
    168       ) 
    169     ) 
    170   ) 
     142              (aref s (+ index 3)))))) 
    171143 
    172144(defmacro nt:read-long-littleendian (s &optional index) 
    … …  
    188160    (if (or (< index 0) (< (- (length s) 4) index)) (throw 'ulong 'out-of-bounds-exception)) 
    189161 
    190     (let* ( 
    191            (hh (aref s (+ index 3))) 
    192            (h0 (lsh hh -4)) 
    193            ) 
    194  
     162    (let* ((hh (aref s (+ index 3))) 
     163           (h0 (lsh hh -4))) 
    195164      (cond ((zerop h0) nil) ; plus 
    196165                                        ;      (t (setq hh (logand 15 hh))) 
    … …  
    200169              (lsh (aref s (+ index 2)) 16) 
    201170              (lsh (aref s (1+ index)) 8) 
    202               (aref s index)) 
    203       ) 
    204     ) 
    205  
    206 ;    (let ((sl (long s index))) 
    207 ;    (if (>= sl 0) sl 0) 
    208 ;    ) 
    209   ) 
     171              (aref s index))))) 
    210172 
    211173(defsubst nt:read-ulong-bigendian (s &optional index) 
    … …  
    216178    (if (or (< index 0) (< (- (length s) 4) index)) (throw 'ulong 'out-of-bounds-exception)) 
    217179 
    218     (let* ( 
    219            (hh (aref s index)) 
    220            (h0 (lsh hh -4)) 
    221            ) 
    222  
     180    (let* ((hh (aref s index)) 
     181           (h0 (lsh hh -4))) 
    223182      (cond ((zerop h0) nil) ; plus 
    224183                                        ;      (t (setq hh (logand 15 hh))) 
    … …  
    228187              (lsh (aref s (1+ index)) 16) 
    229188              (lsh (aref s (+ index 2)) 8) 
    230               (aref s (+ index 3))) 
    231       ) 
    232     ) 
    233  
    234 ;    (let ((sl (long s index))) 
    235 ;    (if (>= sl 0) sl 0) 
    236 ;    ) 
    237   ) 
     189              (aref s (+ index 3)))))) 
    238190 
    239191(defmacro nt:read-ulong-littleendian (s &optional index) 
    … …  
    255207;     (if (> ofs-max 248) (setq ofs-max 248)) 
    256208      (while (< ofs ofs-max) 
    257         (if (zerop (aref s (+ index ofs)))  
    258             (throw 'cstring (cons (substring s index (+ index ofs)) ofs) ) 
    259           ) 
    260         (setq ofs (1+ ofs)) 
    261         ) 
    262       (cons (substring s index nil) ofs-max) 
    263       ) 
    264     ) 
    265   ) 
     209        (if (zerop (aref s (+ index ofs))) 
     210            (throw 'cstring (cons (substring s index (+ index ofs)) ofs) )) 
     211        (setq ofs (1+ ofs))) 
     212      (cons (substring s index nil) ofs-max)))) 
    266213 
    267214;;============================================== 
    … …  
    278225           (size (nt:read-uchar s index)) ) 
    279226      (if (> (1+ size) ofs-max) (throw 'pstring 'out-of-bounds-exception)) 
    280       (throw 'pstring (cons (substring s (1+ index) (+ index 1 size)) size) ) 
    281       ); let 
    282     ); caught 
    283   ) 
     227      (throw 'pstring (cons (substring s (1+ index) (+ index 1 size)) size) )))) 
    284228 
    285229(defsubst nt:read-bcd (s ofs bytes) 
    … …  
    289233      (setq c (aref s (+ ofs i))) 
    290234      (setq n (+ (* n 100) (* (lsh c -4) 10) (logand c #x0f))) 
    291       (setq i (1+ i)) ;; (++ i) 
    292       );wend 
    293     n 
    294     );let 
    295   ) 
     235      (setq i (1+ i))) ;; (++ i) 
     236    n)) 
    296237 
    297238;;; nt-readval.el ends here 

  • lang/elisp/pdicv-mode/trunk/nt-string.el

    r67 r71  
    11;;; nt-string.el --- NT's string utilities 
    2  
    32;; 
    4 ;; Copyright (C) 2005 Naoya TOZUKA. All Rights Reserved. 
     3;; Copyright (C) 2005-2009 naoya_t. All Rights Reserved. 
    54;; 
    6 ;; Author: Naoya TOZUKA <pdicviewer@gmail.com> 
    7 ;; Maintainer: Naoya TOZUKA <pdicviewer@gmail.com> 
    8 ;; Primary distribution site: http://pdicviewer.naochan.com/el/ 
     5;; Author: naoya_t <naoya.t@aqua.plala.or.jp> 
     6;; Maintainer: naoya_t <naoya.t@aqua.plala.or.jp> 
     7;; Primary distribution site: 
     8;;   http://lambdarepos.svnrepository.com/svn/share/lang/elisp/pdicv-mode/trunk 
    99;; 
    1010;; Created: 16 Feb 2005 
    … …  
    4444           (i 0)) 
    4545 
    46       (if n 
    47           (if (or (> n s1-length) (> n s2-length)) 
    48               (setq n nil strncmp-p nil))) 
    49       (if (null n)  
    50           (setq n (min s1-length s2-length))) 
     46      (when n 
     47                (when (or (> n s1-length) (> n s2-length)) 
     48                  (setq n nil strncmp-p nil))) 
     49      (when (null n)  
     50                (setq n (min s1-length s2-length))) 
    5151 
    52       (if (zerop n) (throw 'strcmp 0)) 
    53  
     52      (when (zerop n) (throw 'strcmp 0)) 
    5453 
    5554      (while (< i n) 
    5655        (let ((s1-i (aref s1 i)) 
    5756              (s2-i (aref s2 i))) 
    58           (if (/= s1-i s2-i) (throw 'strcmp (- s1-i s2-i))) 
    59           );let 
    60         (setq i (1+ i)) 
    61         );wend 
     57          (when (/= s1-i s2-i) (throw 'strcmp (- s1-i s2-i)))) 
     58        (setq i (1+ i))) 
    6259 
    6360      ;nʸ����1=s2 
    … …  
    8279      (while (<= i till) 
    8380        (setq at (string-match r str i)) 
    84         (if (null at) (throw 'replace-in-string (concat result (substring str i)))) 
     81        (when (null at) (throw 'replace-in-string (concat result (substring str i)))) 
    8582 
    8683        (setq result (concat result (substring str i at) n)) 
    87         (setq i (+ at r-len)) 
    88         ); wend 
    89       result 
    90       ); let 
    91     ); caught 
    92   ) 
     84        (setq i (+ at r-len))) 
     85      result))) 
    9386 
    9487(defun nt:replace-all (str regex subst) 
    … …  
    10396              (progn 
    10497                (setq result (concat result (substring str ofs found-at) subst)) 
    105                 (setq ofs (match-end 0)) 
    106                 ) 
     98                (setq ofs (match-end 0))) 
    10799            (progn 
    108100              (setq result (concat result (substring str ofs last))) 
    109               (throw 'while nil) 
    110               )) 
    111           );let 
    112         );wend 
    113       );caught 
    114     result 
    115     );let 
    116   ) 
     101              (throw 'while nil)))))) 
     102    result)) 
    117103 
    118104(defun nt:rtrim (str) 
    … …  
    121107    (let ((i (1- (length str)))) 
    122108      (while (> i 0) 
    123         (if (> (aref str i) #x20) (throw 'rtrim (substring str 0 (1+ i)))) 
    124         (-- i) 
    125         );wend 
    126       );let 
    127     );caught 
    128   ) 
     109        (when (> (aref str i) #x20) (throw 'rtrim (substring str 0 (1+ i)))) 
     110        (-- i))))) 
    129111 
    130112(defun nt:ltrim (str) 
    … …  
    133115    (let ((len (length str)) (i 0)) 
    134116      (while (< i len) 
    135         (if (> (aref str i) #x20) (throw 'ltrim (substring str i len))) 
    136         (++ i) 
    137         );wend 
    138       );let 
    139     );caught 
    140   ) 
     117        (when (> (aref str i) #x20) (throw 'ltrim (substring str i len))) 
     118        (++ i))))) 
    141119 
    142120;(defun nt:trim (str) 
    143121;  "trim" 
    144 ;  (nt:ltrim (nt:rtrim str)) 
    145 ;  ) 
     122;  (nt:ltrim (nt:rtrim str))) 
    146123(defmacro nt:trim (str) 
    147124  "trim" 
    148   `(nt:ltrim (nt:rtrim ,str)) 
    149   ) 
     125  `(nt:ltrim (nt:rtrim ,str))) 
    150126 
    151127;;; nt-string.el ends here 

  • lang/elisp/pdicv-mode/trunk/nt-utf8.el

    r67 r71  
    22;;;             some functions require Mule-UCS 
    33;; 
    4 ;; Copyright (C) 2005 Naoya TOZUKA. All Rights Reserved. 
     4;; Copyright (C) 2005-2009 naoya_t. All Rights Reserved. 
    55;; 
    6 ;; Author: Naoya TOZUKA <pdicviewer@gmail.com> 
    7 ;; Maintainer: Naoya TOZUKA <pdicviewer@gmail.com> 
    8 ;; Primary distribution site: http://pdicviewer.naochan.com/el/ 
     6;; Author: naoya_t <naoya.t@aqua.plala.or.jp> 
     7;; Maintainer: naoya_t <naoya.t@aqua.plala.or.jp> 
     8;; Primary distribution site: 
     9;;   http://lambdarepos.svnrepository.com/svn/share/lang/elisp/pdicv-mode/trunk 
    910;; 
    1011;; Created: 14 Feb 2005 

  • lang/elisp/pdicv-mode/trunk/pdicv-core.el

    r67 r71  
    11;;; pdicv-core.el --- core functions for PDIC-formatted dictionaries 
    22;; 
    3 ;; Copyright (C) 2005 Naoya TOZUKA. All Rights Reserved. 
     3;; Copyright (C) 2005-2009 naoya_t. All Rights Reserved. 
    44;; 
    5 ;; Author: Naoya TOZUKA <pdicviewer@gmail.com> 
    6 ;; Maintainer: Naoya TOZUKA <pdicviewer@gmail.com> 
    7 ;; Primary distribution site: http://pdicviewer.naochan.com/el/ 
     5;; Author: naoya_t <naoya.t@aqua.plala.or.jp> 
     6;; Maintainer: naoya_t <naoya.t@aqua.plala.or.jp> 
     7;; Primary distribution site: 
     8;;   http://lambdarepos.svnrepository.com/svn/share/lang/elisp/pdicv-mode/trunk 
    89;; 
    910;; Created: 14 Feb 2005 
    10 ;; Last modified: 23 Dec 2005 
    11 ;; Version: 0.9.1 
    12 ;; Keywords: PDIC dictionary search 
     11;; Last modified: 30 Jan 2009 
     12;; Version: 0.9.2 
     13;; Keywords: PDIC dictionary search eijiro 
    1314 
    1415(provide 'pdicv-core) 
    15 ;(put 'pdicv-core 'version "0.9.1") 
     16;(put 'pdicv-core 'version "0.9.2") 
    1617 
    1718;;; Commentary: 
    1819 
    1920; (pdicv-get-header-info FILENAME) 
    20 ;    - �إå���߼� 
     21;    - ��ؒ�Ò���������ߒ�蒤� 
     22; (pdicv-get-index-list FILENAME [WORD-ENCODING]) 
     23;    - PDIC��������������뒤���钡���������Ò�������꒥���Ȓ���� 
    2124; 
    22 ; (pdicv-get-index-list FILENAME [WORD-ENCODING]) 
    23 ;    - PDIC��������뤫�顢����å����ꥹ�Ȥ��; 
    2425; (pdicv-scan-datablock FILENAME PHYS CRITERIA-FUNC) 
    25 ;    - �ǡ����֥����򥹥��� 
     26;    - ��ǒ�������֒�풥Ò����򒥹�����㒥�; (pdicv-core-search DICINFO CRITERIA [SIMPLE-MODE-P DONT-CLEAR-P]) 
     27;    - PDIC��������������뒡������ 
    2628; 
    27 ; (pdicv-core-search DICINFO CRITERIA [SIMPLE-MODE-P DONT-CLEAR-P]) 
    28 ;    - PDIC��������롼���; 
    2929 
    3030;;; Code: 
    … …  
    4949(defvar pdicv-result-height 8) 
    5050; 
    51 ; �إå���߼� 
    52 ; 
     51; ��ؒ�Ò���������ߒ�蒤� 
    5352(defun pdicv-get-header-info (filename) 
    5453  "[PDIC] Get Header Info" 
    … …  
    5655    (let* ((header-buf (nt:read-from-file filename 0 256)) 
    5756           ; 
    58            (headername nil);(substring header-buf 1 100)) 
    59            (dictitle nil);(substring header-buf 101 140)) 
     57           (headername nil); (substring header-buf 1 100)) 
     58           (dictitle nil); (substring header-buf 101 140)) 
    6059           (version (nt:read-short header-buf 140)) 
    6160           (lword (nt:read-short header-buf 142)) 
    … …  
    8584 
    8685      (setq version 
    87             (nth major-version '(not-supported not-supported newdic1 newdic2 newdic3 newdic4))) 
     86            (nth major-version '(not-supported not-supported newdic1 newdic2 newdic3 newdic4 unicode-bocu-6))) 
    8887 
    8988      (setq dicorder 
    9089            (nth (nt:read-uchar header-buf 164) '(code-order ignore-case dictionary-order order-descendant))) 
    9190 
    92       (if (> (logand dictype 128) 0) (setq dictype* (cons 'tree-view-mode dictype*))) 
    93       (if (> (logand dictype 64) 0) (setq dictype* (cons 'crypted dictype*))) 
    94 ;     (if (> (logand dictype 32) 0) (setq dictype* (cons 'multilingual dictype*))) 
    95       (if (> (logand dictype 16) 0) (setq dictype* (cons 'unicode dictype*))) 
    96       (if (> (logand dictype 8) 0) (setq dictype* (cons 'bocu dictype*))) 
    97       (if (> (logand dictype 1) 0) (setq dictype* (cons 'ar-compressed dictype*))) 
    98  
    99       (if (= major-version 5) 
    100           (progn "HyperDIC, Ver 5.00" 
    101                  (setq os (nt:read-char header-buf 167)) 
    102                  (setq os (cond ((= os 0) 'sjis-crlf) 
    103                                 ((= os 1) 'sjis-cr) 
    104                                 ((= os 2) 'sjis-lf) 
    105                                 ((= os 3) 'euc-lf) 
    106                                 ((= os 4) 'jis-lf) 
    107                                 ((= os 32) 'bocu) 
    108                                 )) 
    109                  (if (eq os 'bocu) (setq bocu t)) 
    110                  (setq olenumber (nt:read-long header-buf 168)) 
    111                                ;(setq lid-word (short header-buf 172)) 
    112                                ;(setq lid-japa (short header-buf 174)) 
    113                                 ;(setq lid-exp (short header-buf 176)) 
    114                                ;(setq lid-pron (short header-buf 178)) 
    115                               ;(setq lid-other (short header-buf 180)) 
    116                  (setq index-blkbit (if (= (nt:read-uchar header-buf 182) 1) 32 16)) 
    117                  ; dummy0 @185 
    118                  (setq extheader (nt:read-ulong header-buf 184)) 
    119                  (setq empty-block (nt:read-long header-buf 188)) ;overwrite 
    120                  (setq nindex (nt:read-long header-buf 192)) ;overwrite 
    121                  (setq nblock (nt:read-long header-buf 196)) ;overwrite 
    122                  (setq datablock-size (* nblock block-size)) 
    123                  (setq cypt (substring header-buf 200 208)) ;- reserved[8] 
    124                  (setq update-count (nt:read-ulong header-buf 208)) 
     91      (when (> (logand dictype 128) 0) (setq dictype* (cons 'tree-view-mode dictype*))) 
     92      (when (> (logand dictype 64) 0) (setq dictype* (cons 'crypted dictype*))) 
     93;     (when (> (logand dictype 32) 0) (setq dictype* (cons 'multilingual dictype*))) 
     94      (when (> (logand dictype 16) 0) (setq dictype* (cons 'unicode dictype*))) 
     95      (when (> (logand dictype 8) 0) (setq dictype* (cons 'bocu dictype*))) 
     96      (when (> (logand dictype 1) 0) (setq dictype* (cons 'ar-compressed dictype*))) 
     97 
     98          (case major-version 
     99                (6 "Ver 6.xx" 
     100                   (setq os (nt:read-char header-buf 167)) 
     101                   (setq os (cond ((= os 0) 'sjis-crlf) 
     102                                                  ((= os 1) 'sjis-cr) 
     103                                                  ((= os 2) 'sjis-lf) 
     104                                                  ((= os 3) 'euc-lf) 
     105                                                  ((= os 4) 'jis-lf) 
     106                                                  ((= os 32) 'bocu) 
     107                                                  )) 
     108                   (when (eq os 'bocu) (setq bocu t)) 
     109                   (setq olenumber (nt:read-long header-buf 168)) 
     110                   ;; dummy_lid, 10 bytes 
     111                   (setq index-blkbit (if (= (nt:read-uchar header-buf 182) 1) 32 16)) 
     112                   ;; dummy0 @185 
     113                   (setq extheader (nt:read-ulong header-buf 184)) 
     114                   (setq empty-block (nt:read-long header-buf 188)) ;overwrite 
     115                   (setq nindex (nt:read-long header-buf 192)) ;overwrite 
     116                   (setq nblock (nt:read-long header-buf 196)) ;overwrite 
     117                   (setq datablock-size (* nblock block-size)) 
     118                   (setq cypt (substring header-buf 200 208)) ;- reserved[8] 
     119                   (setq update-count (nt:read-ulong header-buf 208)) 
    125120                                        ; dummy00 @212[4] 
    126                  (setq dicident (substring header-buf 216 224)) 
     121                   (setq dicident (substring header-buf 216 224)) 
    127122                                        ;(setq dummy (substring header-buf 224 256)) 
    128                  (setq index-size (* index-block block-size)) ;overwrite 
    129  
    130                  );progn 
    131         (progn "< 5.0" 
    132                (if (>= major-version 3) 
    133                    (progn "NEWDIC2-" 
    134                           (setq olenumber (nt:read-long header-buf 167)) 
     123                   (setq index-size (* index-block block-size)) ;overwrite 
     124                   );6 
     125                (5 "HyperDIC, Ver 5.00" 
     126                   (setq os (nt:read-char header-buf 167)) 
     127                   (setq os (cond ((= os 0) 'sjis-crlf) 
     128                                                  ((= os 1) 'sjis-cr) 
     129                                                  ((= os 2) 'sjis-lf) 
     130                                                  ((= os 3) 'euc-lf) 
     131                                                  ((= os 4) 'jis-lf) 
     132                                                  ((= os 32) 'bocu) 
     133                                                  )) 
     134                   (when (eq os 'bocu) (setq bocu t)) 
     135                   (setq olenumber (nt:read-long header-buf 168)) 
     136                   (setq index-blkbit (if (= (nt:read-uchar header-buf 182) 1) 32 16)) 
     137                   ;; dummy0 @185 
     138                   (setq extheader (nt:read-ulong header-buf 184)) 
     139                   (setq empty-block (nt:read-long header-buf 188)) ;overwrite 
     140                   (setq nindex (nt:read-long header-buf 192)) ;overwrite 
     141                   (setq nblock (nt:read-long header-buf 196)) ;overwrite 
     142                   (setq datablock-size (* nblock block-size)) 
     143                   (setq cypt (substring header-buf 200 208)) ;- reserved[8] 
     144                   (setq update-count (nt:read-ulong header-buf 208)) 
     145                                        ; dummy00 @212[4] 
     146                   (setq dicident (substring header-buf 216 224)) 
     147                                        ;(setq dummy (substring header-buf 224 256)) 
     148                   (setq index-size (* index-block block-size)) ;overwrite 
     149                   );5 
     150                (t "< 5.0" 
     151                   (when (>= major-version 3) 
     152                         "NEWDIC2-" 
     153                         (setq olenumber (nt:read-long header-buf 167)) 
    135154                                        ;(setq os (byte (substring header-buf 172 173))) 
    136                           (setq os (nth (nt:read-char header-buf 171) '(sjis-crlf))) 
     155                        (setq os (nth (nt:read-char header-buf 171) '(sjis-crlf))) 
    137156                                        ;(setq lid-word (short header-buf 172)) 
    138157                                        ;(setq lid-japa (short header-buf 174)) 
    … …  
    140159                                        ;(setq lid-pron (short header-buf 178)) 
    141160                                        ;(setq lid-other (short header-buf 180)) 
    142                           )) 
    143                (if (>= major-version 4) 
    144                    (progn "NEWDIC3-" 
    145                           (setq extheader (nt:read-ulong header-buf 182)) 
    146                           (setq empty-block (nt:read-long header-buf 186)) ;overwrite 
    147                           (setq nindex (nt:read-long header-buf 190)) ;overwrite 
    148                           (setq nblock (nt:read-long header-buf 194)) ;overwrite 
    149                           (setq datablock-size (* nblock block-size)) 
    150                           (setq index-blkbit (if (= (nt:read-uchar header-buf 198) 1) 32 16)) 
    151                           (setq cypt (substring header-buf 200 208)) 
    152                           (setq update-count (nt:read-ulong header-buf 207)) 
     161                         ) 
     162                   (when (>= major-version 4) 
     163                        "NEWDIC3-" 
     164                        (setq extheader (nt:read-ulong header-buf 182)) 
     165                        (setq empty-block (nt:read-long header-buf 186)) ;overwrite 
     166                        (setq nindex (nt:read-long header-buf 190)) ;overwrite 
     167                        (setq nblock (nt:read-long header-buf 194)) ;overwrite 
     168                        (setq datablock-size (* nblock block-size)) 
     169                        (setq index-blkbit (if (= (nt:read-uchar header-buf 198) 1) 32 16)) 
     170                        (setq cypt (substring header-buf 200 208)) 
     171                        (setq update-count (nt:read-ulong header-buf 207)) 
    153172                                        ;(setq dummy (substring header-buf 212 256)) 
    154                           (setq index-size (* index-block block-size)) ;overwrite 
    155                           )) 
    156                ); < 5.0 
    157         );fi 
    158        
     173                         (setq index-size (* index-block block-size)) ;overwrite 
     174                         ) 
     175               )); esac 
    159176      (list 
    160177;       (cons 'headername headername)   ; 
    … …  
    189206       (cons 'datablock-ends-at (+ header-size extheader index-size datablock-size)) 
    190207       (cons 'datablock-size datablock-size) 
    191        (cons 'bocu bocu) 
    192        ); list 
    193       ); let* 
    194     ); caught 
    195   ) 
     208       (cons 'bocu bocu))))) 
    196209 
    197210(defun pdicv-get-index-list (filename &optional word-encoding) 
    198211  "[PDICV] Get the index list from PDIC file" 
    199   (let* ( 
    200          (header (pdicv-get-header-info filename)) 
     212  (let* ((header (pdicv-get-header-info filename)) 
    201213         (index-buf (nt:read-from-file filename 
    202214                                    (-> header 'index-begins-at) (-> header 'index-size))) 
    203215 
    204216         (32bit-address-mode (if (= (-> header 'index-blkbit) 32) t nil)) 
     217                 (tab-sep-p (if (eq 'unicode-bocu-6 (-> header 'version)) t nil)) 
    205218 
    206219         (ix 0) (ix-max (-> header 'nindex)) 
    207220         (ofs 0) 
    208          (index-list ()) 
    209          ) 
    210  
     221         (index-list ())) 
    211222    (while (< ix ix-max) 
    212223      (let ((phys -1) (word "") (word* nil)) 
    213224        (if 32bit-address-mode 
    214             (progn (setq phys (nt:read-ulong index-buf ofs)) (setq ofs (+ ofs 4))) 
    215           (progn (setq phys (nt:read-ushort index-buf ofs)) (setq ofs (+ ofs 2))) 
    216           ) 
     225            (progn (setq phys (nt:read-ulong index-buf ofs)) 
     226                                   (setq ofs (+ ofs 4))) 
     227          (progn (setq phys (nt:read-ushort index-buf ofs)) 
     228                                 (setq ofs (+ ofs 2)))) 
    217229        (setq word* (nt:read-cstring index-buf ofs)) (setq ofs (+ ofs (cdr word*) 1)) 
    218230        (setq word (car word*)) 
     231 
     232                (when tab-sep-p 
     233                  (let ((tsv (split-string word "\t"))) 
     234                        (when (consp tsv) 
     235                          (setq word (car tsv))))) 
    219236;       (cond 
    220237;        ((eq word-encoding 'bocu) 
    … …  
    229246        (push (cons phys word) index-list) 
    230247        (setq ix (1+ ix)) 
    231         );let 
    232       ) 
    233     (nreverse index-list) 
    234     ) 
    235   ) 
     248        )) 
     249    (nreverse index-list) )) 
    236250 
    237251(defface pdicv-face-dummy 
    … …  
    255269 
    256270(defvar pdicv-default-inserter 
    257       (lambda (eword pron jword example) 
    258         (progn 
    259           (set-text-properties 0 (length eword) '(face bold) eword) 
     271  (lambda (eword pron jword example) 
     272        (progn 
     273          (set-text-properties 0 (length eword) '(face bold) eword) 
    260274                                        ;       (set-text-properties 0 (length eword) '(face pdicv-face-caption-green) eword) 
    261275                                        ;       (set-text-properties 0 (length jword) '(face pdicv-face-caption-gray) jword) 
    262276 
    263           (setq jword (nt:replace-all jword "����/ ")) 
    264           (setq jword (nt:replace-all jword "\n" "\n  ")) 
    265  
    266           (let ((buf "")) 
    267             (setq buf eword) 
    268             (if (string< "" pron) (setq buf (concat buf " [" pron "]"))) 
     277          (setq jword (nt:replace-all jword "������/ ")) 
     278          (setq jword (nt:replace-all jword "\n" "\n  ")) 
     279 
     280          (let ((buf "")) 
     281                (setq buf eword) 
     282                (when (string< "" pron) (setq buf (concat buf " [" pron "]"))) 
    269283                                        ;               (setq result (concat result " : " jword)) 
    270             (setq buf (concat buf "\n  " jword)) 
    271             (if (string< "" example) (setq buf (concat buf "\n  - " example)) 
     284                (setq buf (concat buf "\n  " jword)) 
     285                (when (string< "" example) (setq buf (concat buf "\n  - " example))) 
    272286                                        ;             (setq buf (concat buf "\n")) 
    273               ) 
    274287;            (setq buf (concat buf "\n\n")) 
    275             (setq buf (concat buf "\n")) 
    276  
    277             (insert buf) 
    278             ); let 
    279           ); progn 
    280         );lambda 
    281       ) 
     288                (setq buf (concat buf "\n")) 
     289 
     290                (insert buf))))) 
    282291;; 
    283292;; 
    … …  
    285294(defun pdicv-scan-datablock (filename phys criteria-func) 
    286295  "[PDICV] scan a datablock" 
    287 ;  (insert (format "pdicv-scan-datablock (%s %d ...)\n" filename phys)) 
    288296  (catch 'pdicv-scan-datablock 
    289297    (let* ((result ()) ;(match-count 0) 
    290298           (header (pdicv-get-header-info filename)) 
    291            (offset (+ (-> header 'datablock-begins-at) (lsh phys 8))) 
    292            (aligned (if (eq (-> header 'version) 'newdic4) t nil)) 
    293 ;          (bocu (-> header 'bocu)) 
     299                   (block-size (-> header 'block-size)) 
     300           (offset (+ (-> header 'datablock-begins-at) (* phys block-size))) 
     301                   (aligned (and (member (-> header 'version) '(newdic4 unicode-bocu-6)) t)) 
     302                   ;; (bocu (-> header 'bocu)) 
    294303           (head-word (nt:read-ushort (nt:read-from-file filename offset 2))) 
    295304           (blocks (logand 32767 head-word)) 
    296            (block-length (- (lsh blocks 8) 2)) 
     305           (block-length (- (* blocks block-size) 2)) 
    297306           (field-size (if (zerop (logand 32768 head-word)) 2 4)) 
    298307           (datablock (nt:read-from-file filename (+ offset 2) block-length)) 
    299308                                        ;    (list blocks field-size datablock) 
    300309           (p 0) 
    301            (field-length 0) 
     310                   (field-length 0) 
    302311           (compress-length 0) 
    303312           (rest nil) 
    … …  
    308317        (setq field-length 
    309318              (if (= field-size 2) (nt:read-ushort datablock p) (nt:read-ulong datablock p)) ) 
    310         (if (zerop field-length) (throw 'pdicv-scan-datablock (nreverse result))); sfield-list)) 
    311         (setq p (+ p field-size)) ;2�ʤ���4�Х���        (setq compress-length (nt:read-uchar datablock p)) ; ����� 
     319        (when (zerop field-length) (throw 'pdicv-scan-datablock (nreverse result))); sfield-list)) 
     320        (setq p (+ p field-size)) ;2��ʒ�����4��В�����        (setq compress-length (nt:read-uchar datablock p)) ; �����̒Ĺ 
    312321        (setq p (1+ p)) 
    313322 
    314         (if aligned (progn 
    315                       (setq eword-attrib (nt:read-uchar datablock p)) ; ���Ф���� 
    316                       (setq p (1+ p)) 
    317                       )) 
    318                                         ; ���Ф����ߤ�ꤢ���� rest ����� 
    319         (setq rest (substring datablock p (+ p field-length))) 
     323        (when aligned 
     324                  (setq eword-attrib (nt:read-uchar datablock p)) ; �����В�������� 
     325                  (setq p (1+ p))) 
     326                                        ; �����В����쒰ʒ�ߒ����꒤������� rest ��˒���쒤�       (setq rest (substring datablock p (+ p field-length))) 
    320327        (setq p (+ p field-length)) 
    321                                         ; ���Ф���NULL��ü) 
     328                                        ; �����В�����NULL����ü) 
    322329        (let* ((eword-cstr (nt:read-cstring rest)) 
    323330               (eword-compressed (car eword-cstr)) (eword-len (cdr eword-cstr)) 
    … …  
    327334               (jword-cstr nil) (jword "") (jword-len 0) 
    328335               (ext-list nil) 
    329                (example "") (pron "") (link "") 
    330                ) 
     336               (example "") (pron "") (link "")) 
    331337 
    332338          (setq eword (if (zerop compress-length) 
    333339                          eword-compressed 
    334                         (concat (substring eword 0 compress-length) eword-compressed) 
    335                         )) 
     340                        (concat (substring eword 0 compress-length) eword-compressed) )) 
    336341          (setq q (1+ eword-len)) 
    337                                         ; ���Ф���� 
    338           (if (not aligned) (progn 
    339                               (setq eword-attrib (nt:read-uchar rest q)) 
    340                               (setq q (1+ q)) 
    341                               )) 
     342                                        ; �����В�������� 
     343          (when (not aligned) 
     344                        (setq eword-attrib (nt:read-uchar rest q)) 
     345                        (setq q (1+ q))) 
     346 
    342347          (setq level (logand eword-attrib 15)) 
    343348;         (insert (format ": %s %d %d\n" eword eword-len eword-attrib)) 
    … …  
    348353          (setq extended (if (zerop (logand eword-attrib 16)) nil t)) 
    349354          (if extended 
    350               (progn ;��� 
     355              (progn ;��Ȓĥ 
    351356                (setq jword-cstr (nt:read-cstring rest q)) 
    352357                (setq jword (car jword-cstr)) (setq jword-len (cdr jword-cstr)) 
    … …  
    359364                           (exdata-cstr nil) 
    360365                           (exdata "") (exdata-len 0) ) 
    361                       (if (= (logand ex-attrib 128) 128) (throw 'while t)) 
     366                      (when (= (logand ex-attrib 128) 128) (throw 'while t)) 
    362367                      (setq q (1+ q)) 
    363368                      (setq exdata-cstr (nt:read-cstring rest q)) 
    … …  
    374379                  ) ; catch while2 
    375380                ) ; progn 
    376             (progn ;ɸ��             (setq jword (substring rest q)) 
     381            (progn ;�ɸ���             (setq jword (substring rest q)) 
    377382              (setq pron "") 
    378               (setq example "") 
    379               ) ; progn 
     383              (setq example "")) 
    380384            ) ; if extended 
    381385 
    382386                                        ;         (insert (format "- %s\n" eword)) 
    383           (if (funcall criteria-func eword pron jword example) 
    384               (push (list eword pron jword example) result)) 
     387          (when (funcall criteria-func eword pron jword example) 
     388                        (push (list eword pron jword example) result)) 
    385389          );let 
    386390        ); wend 
    387       (nreverse result) 
    388       ); let* 
    389     ) ;catch(0) 
    390   ) 
     391      (nreverse result)))) 
    391392 
    392393(defun pdicv-core-search (dicinfo criteria &optional simple-mode-p dont-clear-p) 
    … …  
    396397         (encoding-list (nth 2 dicinfo)) 
    397398         (decoder-list ()) 
    398          (index-table (-> pdicv-index-table-list dicname)) 
    399          ) 
     399         (index-table (-> pdicv-index-table-list dicname))) 
    400400;    (if (null index-table) (setq index-table (pdicv-get-index-list dicfile))) 
    401401 
    402     (if (atom encoding-list) ;; expand encoding-list 
    403         (setq encoding-list (list encoding-list encoding-list encoding-list encoding-list))) 
     402    (when (atom encoding-list) ;; expand encoding-list 
     403          (setq encoding-list (list encoding-list encoding-list encoding-list encoding-list))) 
    404404  
    405405    (while encoding-list ;; build the decoder-list 
    … …  
    410410         ((eq encoding 'latin1) (push pdicv-latin1-decoder decoder-list)) 
    411411         (encoding (push (pdicv-create-decoder encoding) decoder-list)) 
    412          (t (push pdicv-null-decoder decoder-list)) 
    413          );cond 
    414         );let 
    415       (setq encoding-list (cdr encoding-list)) 
    416       );wend 
     412         (t (push pdicv-null-decoder decoder-list)))) 
     413      (setq encoding-list (cdr encoding-list))) 
    417414    (setq decoder-list (nreverse decoder-list)) 
    418415 
    … …  
    434431             (ix index-table) (index-size (length ix)) (curr-size index-size) 
    435432             (ix+ (cadr ix)); next one 
    436              (match-count 0) 
    437              ) 
     433             (match-count 0)) 
    438434 
    439435;         (switch-to-buffer pdicv-buffer-name) 
    440436        (save-current-buffer 
    441437          (set-buffer pdicv-buffer) 
    442           (if (null dont-clear-p) (erase-buffer)) 
    443  
    444           (if (not simple-mode-p) 
    445               (progn 
     438          (when (null dont-clear-p) (erase-buffer)) 
     439 
     440          (when (not simple-mode-p) 
    446441                                        ;(pop-to-buffer pdicv-buffer-name) 
    447442                                        ;              (set-buffer pdicv-buffer-name) 
    448                 (insert (format "�����%s\n" word-to-search)) 
    449                 (insert (format "�����: ????\n")) 
    450                 (newline)) 
     443                        (insert (format "��������� %s\n" word-to-search)) 
     444                        (insert (format "��������???\n")) 
     445                        (newline)) 
    451446                                        ;(insert "\n")) 
    452             ) 
    453           (if index-needles 
    454               (setq ix 
    455                     (let ((p ix) (last-p nil)) 
    456                       (catch 'pdicv-search-in-index 
    457                         (while p 
    458                           (let* ((elem (car p)) 
    459                                         ;(phys (car elem)) 
    460                                  (word (cdr elem)) ) 
    461  
    462                             (if (string< needle1 word) (throw 'pdicv-search-in-index last-p)) 
    463                                         ; (if (string< needle2 word) (throw 'pdicv-search-in-index last-p)) 
    464  
     447          (when index-needles 
     448                        (setq ix 
     449                                  (let ((p ix) (last-p nil)) 
     450                                        (catch 'pdicv-search-in-index 
     451                                          (while p 
     452                                                (let* ((elem (car p)) ;(phys (car elem)) 
     453                                                           (word (cdr elem))) 
     454                                                  (if (string< needle1 word) (throw 'pdicv-search-in-index last-p)) 
     455                                                  ;; (if (string< needle2 word) (throw 'pdicv-search-in-index last-p)) 
    465456                            (setq last-p p) 
    466                             (setq p (cdr p)) 
    467                             ); let 
    468                           ); wend 
    469                         last-p 
    470                         ); caught 
    471  
    472                       ); let 
    473                     )) 
    474  
     457                            (setq p (cdr p)) )) 
     458                                          last-p)))) 
    475459          (catch 'while 
    476460            (while ix 
    477461              (let* ((curr (car ix)) 
    478462                     (phys (car curr)) (word (cdr curr)) 
    479                                         ; (x (insert (format "* current ix: (%d %s)\n" phys word))) 
     463                                         ;; (x (insert (format "* current ix: (%d %s)\n" phys word))) 
    480464                     (result (pdicv-scan-datablock dicfile phys datablock-criteria-func)); decoder-list nil)) 
    481465                     (result-count (length result)) 
    482                      (inserter pdicv-default-inserter) 
    483                      ) 
    484  
    485                 (if index-needles 
    486                     (if (string>= word needle2) (throw 'while t))) 
    487                                         ;                   (if (not (string< word (cdr index-needles))) (throw 'while t))) 
     466                     (inserter pdicv-default-inserter)) 
     467                (when index-needles 
     468                                  (when (string>= word needle2) (throw 'while t))) 
     469                                ;;  (if (not (string< word (cdr index-needles))) (throw 'while t))) 
    488470 
    489471                                        ;               (insert (format "(%s with index %s ... %s)\n"  
    … …  
    501483                                          ) 
    502484                                 (setq match-count (1+ match-count)) 
    503                                  ) 
    504                                );wend 
     485                                 )) 
    505486                             (message "%5d/%5d:%7d" curr-size index-size match-count) 
    506                              (sit-for 0) 
    507                              ) 
    508                   (progn ;else 
    509                     (if (zerop (% curr-size 128)) ;;128�����ʿ�                      (message "%5d/%5d:%7d" curr-size index-size match-count)) 
    510                     ));fi 
    511                 );let* 
     487                             (sit-for 0)) 
     488                  ;;else 
     489                                  (when (zerop (% curr-size 128)) ;;128��ϒŬ����ʒ��                      (message "%5d/%5d:%7d" curr-size index-size match-count)))) 
    512490              (setq ix (cdr ix)) 
    513491              (setq curr-size (1- curr-size)) 
    … …  
    515493            );caught 
    516494 
    517                                         ;(insert (pdicv-scan-datablock dicfile (car (car ix)) decoder-list nil needle1 needle2)) 
     495                  ;;(insert (pdicv-scan-datablock dicfile (car (car ix)) decoder-list nil needle1 needle2)) 
    518496          (goto-char 1) 
    519497 
    520           (if (not simple-mode-p) 
    521               (if (re-search-forward ": [?][?][?][?]" nil t nil) 
    522                   (replace-match (format ": %d" match-count) t t nil 0)) 
    523             );fi 
    524  
     498          (when (not simple-mode-p) 
     499                        (when (re-search-forward ": [?][?][?][?]" nil t nil) 
     500                          (replace-match (format ": %d" match-count) t t nil 0))) 
    525501          ); save-current-buffer 
    526502 
    527503;      (pop-to-buffer (current-buffer)) 
    528504;        (setq split-height-threshold 6) 
    529         (if (one-window-p) 
    530             (set-window-buffer (split-window-vertically (- pdicv-result-height)) pdicv-buffer) 
    531           ) 
    532         ); let* 
    533       ); caught 
    534     );let* 
    535   ) 
     505        (when (one-window-p) 
     506                  (set-window-buffer (split-window-vertically (- pdicv-result-height)) pdicv-buffer)) 
     507        )))) 
    536508 
    537509;;; pdicv-core.el ends here 

  • lang/elisp/pdicv-mode/trunk/pdicv-eijiro.el

    r67 r71  
    11;;; pdicv-eijiro.el --- around eijiro 
    22;; 
    3 ;; Copyright (C) 2005 Naoya TOZUKA. All Rights Reserved. 
     3;; Copyright (C) 2005-2009 naoya_t. All Rights Reserved. 
    44;; 
    5 ;; Author: Naoya TOZUKA <pdicviewer@gmail.com> 
    6 ;; Maintainer: Naoya TOZUKA <pdicviewer@gmail.com> 
    7 ;; Primary distribution site: http://pdicviewer.naochan.com/el/ 
     5;; Author: naoya_t <naoya.t@aqua.plala.or.jp> 
     6;; Maintainer: naoya_t <naoya.t@aqua.plala.or.jp> 
     7;; Primary distribution site: 
     8;;   http://lambdarepos.svnrepository.com/svn/share/lang/elisp/pdicv-mode/trunk 
    89;; 
    910;; Created: 06 Feb 2005 
    1011;; Last modified: 23 Dec 2005 
    11 ;; Version: 0.9.1 
     12;; Version: 0.9.2 
    1213;; Keywords: eijiro waeijiro 
    1314 

  • lang/elisp/pdicv-mode/trunk/pdicv-mode.el

    r67 r71  
    11;; pdicviewer.el - PDIC Viewer for Emacs 
    22;; 
    3 ;; Copyright (C) 2005 Naoya TOZUKA. All Rights Reserved. 
     3;; Copyright (C) 2005-2009 naoya_t. All Rights Reserved. 
    44;; 
    5 ;; Author: Naoya TOZUKA <pdicviewer@gmail.com> 
    6 ;; Maintainer: Naoya TOZUKA <pdicviewer@gmail.com> 
    7 ;; Primary distribution site: http://pdicviewer.naochan.com/el/ 
     5;; Author: naoya_t <naoya.t@aqua.plala.or.jp> 
     6;; Maintainer: naoya_t <naoya.t@aqua.plala.or.jp> 
     7;; Primary distribution site: 
     8;;   http://lambdarepos.svnrepository.com/svn/share/lang/elisp/pdicv-mode/trunk 
    89;; 
    910;; Created: 14 Feb 2005 
    1011;; Last modified: 23 Dec 2005 
    11 ;; Version: 0.9.1 
     12;; Version: 0.9.2 
    1213;; Keywords: PDIC dictionary search eijiro 
    1314;; 

  • lang/elisp/pdicv-mode/trunk/pdicv-search.el

    r67 r71  
    11;;; pdicv-search.el --- upper layer 
    22;; 
    3 ;; Copyright (C) 2005 Naoya TOZUKA. All Rights Reserved. 
    4 ;; 
    5 ;; Author: Naoya TOZUKA <pdicviewer@gmail.com> 
    6 ;; Maintainer: Naoya TOZUKA <pdicviewer@gmail.com> 
    7 ;; Primary distribution site: http://pdicviewer.naochan.com/el/ 
     3;; Copyright (C) 2005-2009 naoya_t. All Rights Reserved. 
     4;; 
     5;; Author: naoya_t <naoya.t@aqua.plala.or.jp> 
     6;; Maintainer: naoya_t <naoya.t@aqua.plala.or.jp> 
     7;; Primary distribution site: 
     8;;   http://lambdarepos.svnrepository.com/svn/share/lang/elisp/pdicv-mode/trunk 
    89;; 
    910;; Created: 06 Feb 2005 
    1011;; Last modified: 23 Dec 2005 
    11 ;; Version: 0.9.1 
     12;; Version: 0.9.2 
    1213;; Keywords: read-from-file 
    1314 
    … …  
    7374  "" 
    7475;  (pdicv-search dicname nil regexp-to-search t field-to-search) 
    75   (pdicv-search dicname regexp-to-search nil t field-to-search) 
    76   ) 
     76  (pdicv-search dicname regexp-to-search nil t field-to-search)) 
    7777 
    7878(defun pdicv-search-just (dicname word-to-search &optional field-to-search) 
    7979  "" 
    80   (pdicv-search dicname word-to-search t nil field-to-search) 
    81   ) 
     80  (pdicv-search dicname word-to-search t nil field-to-search)) 
    8281 
    8382(defun pdicv-search (dicname word-to-search &optional just-p regexp-p field-to-search) 
    … …  
    8988  (catch 'pdicv-search 
    9089    (let ((candidates 
    91            (if just-p (cons (downcase word-to-search) (nt:english-guess-original-form word-to-search)))) 
     90           (if just-p (cons (downcase word-to-search) (nt:english-guess-original-form word-to-search)) 
     91                         (list word-to-search) 
     92                         )) 
    9293          (candidate word-to-search) 
    9394          (first-round-p t) 
    9495          (dicinfo (assoc dicname pdicv-dictionary-list))) 
    95  
     96          ;;(debug candidates);(nt:english-guess-original-form word-to-search)) 
    9697      (if (null dicinfo) (throw 'pdicv-search 'dictionary-not-found)) 
    9798 
    … …  
    106107              (while dicname-list 
    107108                (pdicv-search (car dicname-list) candidate just-p regexp-p field-to-search) 
    108                 (setq dicname-list (cdr dicname-list)) 
    109                 ) 
    110               ) 
    111                                         ;else... 
     109                (setq dicname-list (cdr dicname-list)))) 
     110                  ;;else... 
    112111          (let* ((encoding-list (nth 2 dicinfo)) 
    113112                 (word-encoding (if (listp encoding-list) (car encoding-list) encoding-list)) 
    … …  
    154153                 );let* 
    155154                                        ;         (insert (format "%s" criteria)) 
    156  
    157155            (pdicv-core-search dicinfo criteria simple-mode-p (not first-round-p)) ; clear only at the first time 
    158156            );let* 
    … …  
    163161    );caught 
    164162  ) 
     163 ;;debug 
    165164 
    166165(defun pdicv-search-interactive () 

  • lang/elisp/pdicv-mode/trunk/pdicviewer.el

    r67 r71  
    11;; pdicviewer.el - PDIC Viewer for Emacs 
    22;; 
    3 ;; Copyright (C) 2005 Naoya TOZUKA. All Rights Reserved. 
     3;; Copyright (C) 2005-2009 naoya_t. All Rights Reserved. 
    44;; 
    5 ;; Author: Naoya TOZUKA <pdicviewer@gmail.com> 
    6 ;; Maintainer: Naoya TOZUKA <pdicviewer@gmail.com> 
    7 ;; Primary distribution site: http://pdicviewer.naochan.com/el/ 
     5;; Author: naoya_t <naoya.t@aqua.plala.or.jp> 
     6;; Maintainer: naoya_t <naoya.t@aqua.plala.or.jp> 
     7;; Primary distribution site: 
     8;;   http://lambdarepos.svnrepository.com/svn/share/lang/elisp/pdicv-mode/trunk 
    89;; 
    910;; Created: 14 Feb 2005 
    1011;; Last modified: 23 Dec 2005 
    11 ;; Version: 0.9.1 
     12;; Version: 0.9.2 
    1213;; Keywords: PDIC dictionary search eijiro 
    1314;; 
    … …  
    3334;        (sample "~/pdic/SAMPLE.DIC" ; 
    3435;                (nil nil sjis sjis) t) 
    35         (cj2 "~/pdic/cj2.dic" ; 
    36              bocu nil) 
    37         (eijiro "~/pdic/eijiro81/EIJIRO81.DIC" 
    38                 (nil nil sjis sjis)) 
    39         (waeijiro "~/pdic/eijiro81/WAEIJI81.DIC" 
    40                   (sjis nil sjis sjis) t) 
    41         (fr "~/pdic/fr.dic" 
    42             (latin1 nil sjis latin1) nil) 
     36;        (cj2 "~/pdic/cj2.dic" ; 
     37;             bocu nil) 
     38                (eijiro "~/Library/EIJIRO 4th Edition/Eijiro112.dic" bocu nil) 
     39                (waeijiro "~/Library/EIJIRO 4th Edition/Waeiji112.dic" bocu nil) 
     40;        (eijiro "~/pdic/eijiro81/EIJIRO81.DIC" 
     41;                (nil nil sjis sjis)) 
     42;        (waeijiro "~/pdic/eijiro81/WAEIJI81.DIC" 
     43;                  (sjis nil sjis sjis) t) 
     44;        (fr "~/pdic/fr.dic" 
     45;            (latin1 nil sjis latin1) nil) 
    4346;        (ej 
    4447;         (eijiro waeijiro))