Index: /lang/elisp/pdicv-mode/trunk/README.utf8 =================================================================== --- /lang/elisp/pdicv-mode/trunk/README.utf8 (revision 67) +++ /lang/elisp/pdicv-mode/trunk/README.utf8 (revision 71) @@ -5,4 +5,5 @@ 　　アルク刊「英辞郎」赤本・黒本CD-ROMに収録されているPDIC形式の辞書データや、 　　インターネット上で入手可能なPDIC形式の様々な辞書データリソースが利用できます。 +　　[NEW]アルク刊「英辞郎 第四版」に収録されているUnicodeタイプの英辞郎データにも対応しました！(2009/1) 　　Unicode(BOCU)辞書にも対応しています。（要(?)Mule-UCS） @@ -28,10 +29,8 @@ ◎ 作者連絡先 -　　Naochan (Naoya TOZUKA) -　　http://www.naochan.com/ -　　http://d.hatena.ne.jp/naoya_t/ +　　naoya_t +　　http://blog.livedoor.jp/naoya_t/ + ◎ 一次配布元 - -　　http://pdicviewer.naochan.com/el/ - + svn://lambdarepos.svnrepository.com/svn/share/lang/elisp/pdicv-mode/trunk Index: /lang/elisp/pdicv-mode/trunk/pdicv-eijiro.el =================================================================== --- /lang/elisp/pdicv-mode/trunk/pdicv-eijiro.el (revision 67) +++ /lang/elisp/pdicv-mode/trunk/pdicv-eijiro.el (revision 71) @@ -1,13 +1,14 @@ ;;; pdicv-eijiro.el --- around eijiro ;; -;; Copyright (C) 2005 Naoya TOZUKA. All Rights Reserved. +;; Copyright (C) 2005-2009 naoya_t. All Rights Reserved. ;; -;; Author: Naoya TOZUKA -;; Maintainer: Naoya TOZUKA -;; Primary distribution site: http://pdicviewer.naochan.com/el/ +;; Author: naoya_t +;; Maintainer: naoya_t +;; Primary distribution site: +;; http://lambdarepos.svnrepository.com/svn/share/lang/elisp/pdicv-mode/trunk ;; ;; Created: 06 Feb 2005 ;; Last modified: 23 Dec 2005 -;; Version: 0.9.1 +;; Version: 0.9.2 ;; Keywords: eijiro waeijiro Index: /lang/elisp/pdicv-mode/trunk/nt-string.el =================================================================== --- /lang/elisp/pdicv-mode/trunk/nt-string.el (revision 67) +++ /lang/elisp/pdicv-mode/trunk/nt-string.el (revision 71) @@ -1,10 +1,10 @@ ;;; nt-string.el --- NT's string utilities - ;; -;; Copyright (C) 2005 Naoya TOZUKA. All Rights Reserved. +;; Copyright (C) 2005-2009 naoya_t. All Rights Reserved. ;; -;; Author: Naoya TOZUKA -;; Maintainer: Naoya TOZUKA -;; Primary distribution site: http://pdicviewer.naochan.com/el/ +;; Author: naoya_t +;; Maintainer: naoya_t +;; Primary distribution site: +;; http://lambdarepos.svnrepository.com/svn/share/lang/elisp/pdicv-mode/trunk ;; ;; Created: 16 Feb 2005 @@ -44,20 +44,17 @@ (i 0)) - (if n - (if (or (> n s1-length) (> n s2-length)) - (setq n nil strncmp-p nil))) - (if (null n) - (setq n (min s1-length s2-length))) + (when n + (when (or (> n s1-length) (> n s2-length)) + (setq n nil strncmp-p nil))) + (when (null n) + (setq n (min s1-length s2-length))) - (if (zerop n) (throw 'strcmp 0)) - + (when (zerop n) (throw 'strcmp 0)) (while (< i n) (let ((s1-i (aref s1 i)) (s2-i (aref s2 i))) - (if (/= s1-i s2-i) (throw 'strcmp (- s1-i s2-i))) - );let - (setq i (1+ i)) - );wend + (when (/= s1-i s2-i) (throw 'strcmp (- s1-i s2-i)))) + (setq i (1+ i))) ;nʸ����1=s2 @@ -82,13 +79,9 @@ (while (<= i till) (setq at (string-match r str i)) - (if (null at) (throw 'replace-in-string (concat result (substring str i)))) + (when (null at) (throw 'replace-in-string (concat result (substring str i)))) (setq result (concat result (substring str i at) n)) - (setq i (+ at r-len)) - ); wend - result - ); let - ); caught - ) + (setq i (+ at r-len))) + result))) (defun nt:replace-all (str regex subst) @@ -103,16 +96,9 @@ (progn (setq result (concat result (substring str ofs found-at) subst)) - (setq ofs (match-end 0)) - ) + (setq ofs (match-end 0))) (progn (setq result (concat result (substring str ofs last))) - (throw 'while nil) - )) - );let - );wend - );caught - result - );let - ) + (throw 'while nil)))))) + result)) (defun nt:rtrim (str) @@ -121,10 +107,6 @@ (let ((i (1- (length str)))) (while (> i 0) - (if (> (aref str i) #x20) (throw 'rtrim (substring str 0 (1+ i)))) - (-- i) - );wend - );let - );caught - ) + (when (> (aref str i) #x20) (throw 'rtrim (substring str 0 (1+ i)))) + (-- i))))) (defun nt:ltrim (str) @@ -133,19 +115,13 @@ (let ((len (length str)) (i 0)) (while (< i len) - (if (> (aref str i) #x20) (throw 'ltrim (substring str i len))) - (++ i) - );wend - );let - );caught - ) + (when (> (aref str i) #x20) (throw 'ltrim (substring str i len))) + (++ i))))) ;(defun nt:trim (str) ; "trim" -; (nt:ltrim (nt:rtrim str)) -; ) +; (nt:ltrim (nt:rtrim str))) (defmacro nt:trim (str) "trim" - `(nt:ltrim (nt:rtrim ,str)) - ) + `(nt:ltrim (nt:rtrim ,str))) ;;; nt-string.el ends here Index: /lang/elisp/pdicv-mode/trunk/pdicv-mode.el =================================================================== --- /lang/elisp/pdicv-mode/trunk/pdicv-mode.el (revision 67) +++ /lang/elisp/pdicv-mode/trunk/pdicv-mode.el (revision 71) @@ -1,13 +1,14 @@ ;; pdicviewer.el - PDIC Viewer for Emacs ;; -;; Copyright (C) 2005 Naoya TOZUKA. All Rights Reserved. +;; Copyright (C) 2005-2009 naoya_t. All Rights Reserved. ;; -;; Author: Naoya TOZUKA -;; Maintainer: Naoya TOZUKA -;; Primary distribution site: http://pdicviewer.naochan.com/el/ +;; Author: naoya_t +;; Maintainer: naoya_t +;; Primary distribution site: +;; http://lambdarepos.svnrepository.com/svn/share/lang/elisp/pdicv-mode/trunk ;; ;; Created: 14 Feb 2005 ;; Last modified: 23 Dec 2005 -;; Version: 0.9.1 +;; Version: 0.9.2 ;; Keywords: PDIC dictionary search eijiro ;; Index: /lang/elisp/pdicv-mode/trunk/pdicv-core.el =================================================================== --- /lang/elisp/pdicv-mode/trunk/pdicv-core.el (revision 67) +++ /lang/elisp/pdicv-mode/trunk/pdicv-core.el (revision 71) @@ -1,30 +1,30 @@ ;;; pdicv-core.el --- core functions for PDIC-formatted dictionaries ;; -;; Copyright (C) 2005 Naoya TOZUKA. All Rights Reserved. +;; Copyright (C) 2005-2009 naoya_t. All Rights Reserved. ;; -;; Author: Naoya TOZUKA -;; Maintainer: Naoya TOZUKA -;; Primary distribution site: http://pdicviewer.naochan.com/el/ +;; Author: naoya_t +;; Maintainer: naoya_t +;; Primary distribution site: +;; http://lambdarepos.svnrepository.com/svn/share/lang/elisp/pdicv-mode/trunk ;; ;; Created: 14 Feb 2005 -;; Last modified: 23 Dec 2005 -;; Version: 0.9.1 -;; Keywords: PDIC dictionary search +;; Last modified: 30 Jan 2009 +;; Version: 0.9.2 +;; Keywords: PDIC dictionary search eijiro (provide 'pdicv-core) -;(put 'pdicv-core 'version "0.9.1") +;(put 'pdicv-core 'version "0.9.2") ;;; Commentary: ; (pdicv-get-header-info FILENAME) -; - �إå���߼� +; - ��ؒ�Ò���������ߒ�蒤� +; (pdicv-get-index-list FILENAME [WORD-ENCODING]) +; - PDIC��������������뒤���钡���������Ò�������꒥���Ȓ���� ; -; (pdicv-get-index-list FILENAME [WORD-ENCODING]) -; - PDIC��������뤫�顢����å����ꥹ�Ȥ��; ; (pdicv-scan-datablock FILENAME PHYS CRITERIA-FUNC) -; - �ǡ����֥����򥹥��� +; - ��ǒ�������֒�풥Ò����򒥹�����㒥�; (pdicv-core-search DICINFO CRITERIA [SIMPLE-MODE-P DONT-CLEAR-P]) +; - PDIC��������������뒡������ ; -; (pdicv-core-search DICINFO CRITERIA [SIMPLE-MODE-P DONT-CLEAR-P]) -; - PDIC��������롼���; ;;; Code: @@ -49,6 +49,5 @@ (defvar pdicv-result-height 8) ; -; �إå���߼� -; +; ��ؒ�Ò���������ߒ�蒤� (defun pdicv-get-header-info (filename) "[PDIC] Get Header Info" @@ -56,6 +55,6 @@ (let* ((header-buf (nt:read-from-file filename 0 256)) ; - (headername nil);(substring header-buf 1 100)) - (dictitle nil);(substring header-buf 101 140)) + (headername nil); (substring header-buf 1 100)) + (dictitle nil); (substring header-buf 101 140)) (version (nt:read-short header-buf 140)) (lword (nt:read-short header-buf 142)) @@ -85,54 +84,74 @@ (setq version - (nth major-version '(not-supported not-supported newdic1 newdic2 newdic3 newdic4))) + (nth major-version '(not-supported not-supported newdic1 newdic2 newdic3 newdic4 unicode-bocu-6))) (setq dicorder (nth (nt:read-uchar header-buf 164) '(code-order ignore-case dictionary-order order-descendant))) - (if (> (logand dictype 128) 0) (setq dictype* (cons 'tree-view-mode dictype*))) - (if (> (logand dictype 64) 0) (setq dictype* (cons 'crypted dictype*))) -; (if (> (logand dictype 32) 0) (setq dictype* (cons 'multilingual dictype*))) - (if (> (logand dictype 16) 0) (setq dictype* (cons 'unicode dictype*))) - (if (> (logand dictype 8) 0) (setq dictype* (cons 'bocu dictype*))) - (if (> (logand dictype 1) 0) (setq dictype* (cons 'ar-compressed dictype*))) - - (if (= major-version 5) - (progn "HyperDIC, Ver 5.00" - (setq os (nt:read-char header-buf 167)) - (setq os (cond ((= os 0) 'sjis-crlf) - ((= os 1) 'sjis-cr) - ((= os 2) 'sjis-lf) - ((= os 3) 'euc-lf) - ((= os 4) 'jis-lf) - ((= os 32) 'bocu) - )) - (if (eq os 'bocu) (setq bocu t)) - (setq olenumber (nt:read-long header-buf 168)) - ;(setq lid-word (short header-buf 172)) - ;(setq lid-japa (short header-buf 174)) - ;(setq lid-exp (short header-buf 176)) - ;(setq lid-pron (short header-buf 178)) - ;(setq lid-other (short header-buf 180)) - (setq index-blkbit (if (= (nt:read-uchar header-buf 182) 1) 32 16)) - ; dummy0 @185 - (setq extheader (nt:read-ulong header-buf 184)) - (setq empty-block (nt:read-long header-buf 188)) ;overwrite - (setq nindex (nt:read-long header-buf 192)) ;overwrite - (setq nblock (nt:read-long header-buf 196)) ;overwrite - (setq datablock-size (* nblock block-size)) - (setq cypt (substring header-buf 200 208)) ;- reserved[8] - (setq update-count (nt:read-ulong header-buf 208)) + (when (> (logand dictype 128) 0) (setq dictype* (cons 'tree-view-mode dictype*))) + (when (> (logand dictype 64) 0) (setq dictype* (cons 'crypted dictype*))) +; (when (> (logand dictype 32) 0) (setq dictype* (cons 'multilingual dictype*))) + (when (> (logand dictype 16) 0) (setq dictype* (cons 'unicode dictype*))) + (when (> (logand dictype 8) 0) (setq dictype* (cons 'bocu dictype*))) + (when (> (logand dictype 1) 0) (setq dictype* (cons 'ar-compressed dictype*))) + + (case major-version + (6 "Ver 6.xx" + (setq os (nt:read-char header-buf 167)) + (setq os (cond ((= os 0) 'sjis-crlf) + ((= os 1) 'sjis-cr) + ((= os 2) 'sjis-lf) + ((= os 3) 'euc-lf) + ((= os 4) 'jis-lf) + ((= os 32) 'bocu) + )) + (when (eq os 'bocu) (setq bocu t)) + (setq olenumber (nt:read-long header-buf 168)) + ;; dummy_lid, 10 bytes + (setq index-blkbit (if (= (nt:read-uchar header-buf 182) 1) 32 16)) + ;; dummy0 @185 + (setq extheader (nt:read-ulong header-buf 184)) + (setq empty-block (nt:read-long header-buf 188)) ;overwrite + (setq nindex (nt:read-long header-buf 192)) ;overwrite + (setq nblock (nt:read-long header-buf 196)) ;overwrite + (setq datablock-size (* nblock block-size)) + (setq cypt (substring header-buf 200 208)) ;- reserved[8] + (setq update-count (nt:read-ulong header-buf 208)) ; dummy00 @212[4] - (setq dicident (substring header-buf 216 224)) + (setq dicident (substring header-buf 216 224)) ;(setq dummy (substring header-buf 224 256)) - (setq index-size (* index-block block-size)) ;overwrite - - );progn - (progn "< 5.0" - (if (>= major-version 3) - (progn "NEWDIC2-" - (setq olenumber (nt:read-long header-buf 167)) + (setq index-size (* index-block block-size)) ;overwrite + );6 + (5 "HyperDIC, Ver 5.00" + (setq os (nt:read-char header-buf 167)) + (setq os (cond ((= os 0) 'sjis-crlf) + ((= os 1) 'sjis-cr) + ((= os 2) 'sjis-lf) + ((= os 3) 'euc-lf) + ((= os 4) 'jis-lf) + ((= os 32) 'bocu) + )) + (when (eq os 'bocu) (setq bocu t)) + (setq olenumber (nt:read-long header-buf 168)) + (setq index-blkbit (if (= (nt:read-uchar header-buf 182) 1) 32 16)) + ;; dummy0 @185 + (setq extheader (nt:read-ulong header-buf 184)) + (setq empty-block (nt:read-long header-buf 188)) ;overwrite + (setq nindex (nt:read-long header-buf 192)) ;overwrite + (setq nblock (nt:read-long header-buf 196)) ;overwrite + (setq datablock-size (* nblock block-size)) + (setq cypt (substring header-buf 200 208)) ;- reserved[8] + (setq update-count (nt:read-ulong header-buf 208)) + ; dummy00 @212[4] + (setq dicident (substring header-buf 216 224)) + ;(setq dummy (substring header-buf 224 256)) + (setq index-size (* index-block block-size)) ;overwrite + );5 + (t "< 5.0" + (when (>= major-version 3) + "NEWDIC2-" + (setq olenumber (nt:read-long header-buf 167)) ;(setq os (byte (substring header-buf 172 173))) - (setq os (nth (nt:read-char header-buf 171) '(sjis-crlf))) + (setq os (nth (nt:read-char header-buf 171) '(sjis-crlf))) ;(setq lid-word (short header-buf 172)) ;(setq lid-japa (short header-buf 174)) @@ -140,21 +159,19 @@ ;(setq lid-pron (short header-buf 178)) ;(setq lid-other (short header-buf 180)) - )) - (if (>= major-version 4) - (progn "NEWDIC3-" - (setq extheader (nt:read-ulong header-buf 182)) - (setq empty-block (nt:read-long header-buf 186)) ;overwrite - (setq nindex (nt:read-long header-buf 190)) ;overwrite - (setq nblock (nt:read-long header-buf 194)) ;overwrite - (setq datablock-size (* nblock block-size)) - (setq index-blkbit (if (= (nt:read-uchar header-buf 198) 1) 32 16)) - (setq cypt (substring header-buf 200 208)) - (setq update-count (nt:read-ulong header-buf 207)) + ) + (when (>= major-version 4) + "NEWDIC3-" + (setq extheader (nt:read-ulong header-buf 182)) + (setq empty-block (nt:read-long header-buf 186)) ;overwrite + (setq nindex (nt:read-long header-buf 190)) ;overwrite + (setq nblock (nt:read-long header-buf 194)) ;overwrite + (setq datablock-size (* nblock block-size)) + (setq index-blkbit (if (= (nt:read-uchar header-buf 198) 1) 32 16)) + (setq cypt (substring header-buf 200 208)) + (setq update-count (nt:read-ulong header-buf 207)) ;(setq dummy (substring header-buf 212 256)) - (setq index-size (* index-block block-size)) ;overwrite - )) - ); < 5.0 - );fi - + (setq index-size (* index-block block-size)) ;overwrite + ) + )); esac (list ; (cons 'headername headername) ; @@ -189,32 +206,32 @@ (cons 'datablock-ends-at (+ header-size extheader index-size datablock-size)) (cons 'datablock-size datablock-size) - (cons 'bocu bocu) - ); list - ); let* - ); caught - ) + (cons 'bocu bocu))))) (defun pdicv-get-index-list (filename &optional word-encoding) "[PDICV] Get the index list from PDIC file" - (let* ( - (header (pdicv-get-header-info filename)) + (let* ((header (pdicv-get-header-info filename)) (index-buf (nt:read-from-file filename (-> header 'index-begins-at) (-> header 'index-size))) (32bit-address-mode (if (= (-> header 'index-blkbit) 32) t nil)) + (tab-sep-p (if (eq 'unicode-bocu-6 (-> header 'version)) t nil)) (ix 0) (ix-max (-> header 'nindex)) (ofs 0) - (index-list ()) - ) - + (index-list ())) (while (< ix ix-max) (let ((phys -1) (word "") (word* nil)) (if 32bit-address-mode - (progn (setq phys (nt:read-ulong index-buf ofs)) (setq ofs (+ ofs 4))) - (progn (setq phys (nt:read-ushort index-buf ofs)) (setq ofs (+ ofs 2))) - ) + (progn (setq phys (nt:read-ulong index-buf ofs)) + (setq ofs (+ ofs 4))) + (progn (setq phys (nt:read-ushort index-buf ofs)) + (setq ofs (+ ofs 2)))) (setq word* (nt:read-cstring index-buf ofs)) (setq ofs (+ ofs (cdr word*) 1)) (setq word (car word*)) + + (when tab-sep-p + (let ((tsv (split-string word "\t"))) + (when (consp tsv) + (setq word (car tsv))))) ; (cond ; ((eq word-encoding 'bocu) @@ -229,9 +246,6 @@ (push (cons phys word) index-list) (setq ix (1+ ix)) - );let - ) - (nreverse index-list) - ) - ) + )) + (nreverse index-list) )) (defface pdicv-face-dummy @@ -255,29 +269,24 @@ (defvar pdicv-default-inserter - (lambda (eword pron jword example) - (progn - (set-text-properties 0 (length eword) '(face bold) eword) + (lambda (eword pron jword example) + (progn + (set-text-properties 0 (length eword) '(face bold) eword) ; (set-text-properties 0 (length eword) '(face pdicv-face-caption-green) eword) ; (set-text-properties 0 (length jword) '(face pdicv-face-caption-gray) jword) - (setq jword (nt:replace-all jword "����/ ")) - (setq jword (nt:replace-all jword "\n" "\n ")) - - (let ((buf "")) - (setq buf eword) - (if (string< "" pron) (setq buf (concat buf " [" pron "]"))) + (setq jword (nt:replace-all jword "������/ ")) + (setq jword (nt:replace-all jword "\n" "\n ")) + + (let ((buf "")) + (setq buf eword) + (when (string< "" pron) (setq buf (concat buf " [" pron "]"))) ; (setq result (concat result " : " jword)) - (setq buf (concat buf "\n " jword)) - (if (string< "" example) (setq buf (concat buf "\n - " example)) + (setq buf (concat buf "\n " jword)) + (when (string< "" example) (setq buf (concat buf "\n - " example))) ; (setq buf (concat buf "\n")) - ) ; (setq buf (concat buf "\n\n")) - (setq buf (concat buf "\n")) - - (insert buf) - ); let - ); progn - );lambda - ) + (setq buf (concat buf "\n")) + + (insert buf))))) ;; ;; @@ -285,19 +294,19 @@ (defun pdicv-scan-datablock (filename phys criteria-func) "[PDICV] scan a datablock" -; (insert (format "pdicv-scan-datablock (%s %d ...)\n" filename phys)) (catch 'pdicv-scan-datablock (let* ((result ()) ;(match-count 0) (header (pdicv-get-header-info filename)) - (offset (+ (-> header 'datablock-begins-at) (lsh phys 8))) - (aligned (if (eq (-> header 'version) 'newdic4) t nil)) -; (bocu (-> header 'bocu)) + (block-size (-> header 'block-size)) + (offset (+ (-> header 'datablock-begins-at) (* phys block-size))) + (aligned (and (member (-> header 'version) '(newdic4 unicode-bocu-6)) t)) + ;; (bocu (-> header 'bocu)) (head-word (nt:read-ushort (nt:read-from-file filename offset 2))) (blocks (logand 32767 head-word)) - (block-length (- (lsh blocks 8) 2)) + (block-length (- (* blocks block-size) 2)) (field-size (if (zerop (logand 32768 head-word)) 2 4)) (datablock (nt:read-from-file filename (+ offset 2) block-length)) ; (list blocks field-size datablock) (p 0) - (field-length 0) + (field-length 0) (compress-length 0) (rest nil) @@ -308,16 +317,14 @@ (setq field-length (if (= field-size 2) (nt:read-ushort datablock p) (nt:read-ulong datablock p)) ) - (if (zerop field-length) (throw 'pdicv-scan-datablock (nreverse result))); sfield-list)) - (setq p (+ p field-size)) ;2�ʤ���4�Х��� (setq compress-length (nt:read-uchar datablock p)) ; ����� + (when (zerop field-length) (throw 'pdicv-scan-datablock (nreverse result))); sfield-list)) + (setq p (+ p field-size)) ;2��ʒ�����4��В����� (setq compress-length (nt:read-uchar datablock p)) ; �����̒Ĺ (setq p (1+ p)) - (if aligned (progn - (setq eword-attrib (nt:read-uchar datablock p)) ; ���Ф���� - (setq p (1+ p)) - )) - ; ���Ф����ߤ�ꤢ���� rest ����� - (setq rest (substring datablock p (+ p field-length))) + (when aligned + (setq eword-attrib (nt:read-uchar datablock p)) ; �����В�������� + (setq p (1+ p))) + ; �����В����쒰ʒ�ߒ����꒤������� rest ��˒���쒤� (setq rest (substring datablock p (+ p field-length))) (setq p (+ p field-length)) - ; ���Ф���NULL��ü) + ; �����В�����NULL����ü) (let* ((eword-cstr (nt:read-cstring rest)) (eword-compressed (car eword-cstr)) (eword-len (cdr eword-cstr)) @@ -327,17 +334,15 @@ (jword-cstr nil) (jword "") (jword-len 0) (ext-list nil) - (example "") (pron "") (link "") - ) + (example "") (pron "") (link "")) (setq eword (if (zerop compress-length) eword-compressed - (concat (substring eword 0 compress-length) eword-compressed) - )) + (concat (substring eword 0 compress-length) eword-compressed) )) (setq q (1+ eword-len)) - ; ���Ф���� - (if (not aligned) (progn - (setq eword-attrib (nt:read-uchar rest q)) - (setq q (1+ q)) - )) + ; �����В�������� + (when (not aligned) + (setq eword-attrib (nt:read-uchar rest q)) + (setq q (1+ q))) + (setq level (logand eword-attrib 15)) ; (insert (format ": %s %d %d\n" eword eword-len eword-attrib)) @@ -348,5 +353,5 @@ (setq extended (if (zerop (logand eword-attrib 16)) nil t)) (if extended - (progn ;��� + (progn ;��Ȓĥ (setq jword-cstr (nt:read-cstring rest q)) (setq jword (car jword-cstr)) (setq jword-len (cdr jword-cstr)) @@ -359,5 +364,5 @@ (exdata-cstr nil) (exdata "") (exdata-len 0) ) - (if (= (logand ex-attrib 128) 128) (throw 'while t)) + (when (= (logand ex-attrib 128) 128) (throw 'while t)) (setq q (1+ q)) (setq exdata-cstr (nt:read-cstring rest q)) @@ -374,19 +379,15 @@ ) ; catch while2 ) ; progn - (progn ;ɸ�� (setq jword (substring rest q)) + (progn ;�ɸ��� (setq jword (substring rest q)) (setq pron "") - (setq example "") - ) ; progn + (setq example "")) ) ; if extended ; (insert (format "- %s\n" eword)) - (if (funcall criteria-func eword pron jword example) - (push (list eword pron jword example) result)) + (when (funcall criteria-func eword pron jword example) + (push (list eword pron jword example) result)) );let ); wend - (nreverse result) - ); let* - ) ;catch(0) - ) + (nreverse result)))) (defun pdicv-core-search (dicinfo criteria &optional simple-mode-p dont-clear-p) @@ -396,10 +397,9 @@ (encoding-list (nth 2 dicinfo)) (decoder-list ()) - (index-table (-> pdicv-index-table-list dicname)) - ) + (index-table (-> pdicv-index-table-list dicname))) ; (if (null index-table) (setq index-table (pdicv-get-index-list dicfile))) - (if (atom encoding-list) ;; expand encoding-list - (setq encoding-list (list encoding-list encoding-list encoding-list encoding-list))) + (when (atom encoding-list) ;; expand encoding-list + (setq encoding-list (list encoding-list encoding-list encoding-list encoding-list))) (while encoding-list ;; build the decoder-list @@ -410,9 +410,6 @@ ((eq encoding 'latin1) (push pdicv-latin1-decoder decoder-list)) (encoding (push (pdicv-create-decoder encoding) decoder-list)) - (t (push pdicv-null-decoder decoder-list)) - );cond - );let - (setq encoding-list (cdr encoding-list)) - );wend + (t (push pdicv-null-decoder decoder-list)))) + (setq encoding-list (cdr encoding-list))) (setq decoder-list (nreverse decoder-list)) @@ -434,56 +431,41 @@ (ix index-table) (index-size (length ix)) (curr-size index-size) (ix+ (cadr ix)); next one - (match-count 0) - ) + (match-count 0)) ; (switch-to-buffer pdicv-buffer-name) (save-current-buffer (set-buffer pdicv-buffer) - (if (null dont-clear-p) (erase-buffer)) - - (if (not simple-mode-p) - (progn + (when (null dont-clear-p) (erase-buffer)) + + (when (not simple-mode-p) ;(pop-to-buffer pdicv-buffer-name) ; (set-buffer pdicv-buffer-name) - (insert (format "�����%s\n" word-to-search)) - (insert (format "�����: ????\n")) - (newline)) + (insert (format "��������� %s\n" word-to-search)) + (insert (format "��������???\n")) + (newline)) ;(insert "\n")) - ) - (if index-needles - (setq ix - (let ((p ix) (last-p nil)) - (catch 'pdicv-search-in-index - (while p - (let* ((elem (car p)) - ;(phys (car elem)) - (word (cdr elem)) ) - - (if (string< needle1 word) (throw 'pdicv-search-in-index last-p)) - ; (if (string< needle2 word) (throw 'pdicv-search-in-index last-p)) - + (when index-needles + (setq ix + (let ((p ix) (last-p nil)) + (catch 'pdicv-search-in-index + (while p + (let* ((elem (car p)) ;(phys (car elem)) + (word (cdr elem))) + (if (string< needle1 word) (throw 'pdicv-search-in-index last-p)) + ;; (if (string< needle2 word) (throw 'pdicv-search-in-index last-p)) (setq last-p p) - (setq p (cdr p)) - ); let - ); wend - last-p - ); caught - - ); let - )) - + (setq p (cdr p)) )) + last-p)))) (catch 'while (while ix (let* ((curr (car ix)) (phys (car curr)) (word (cdr curr)) - ; (x (insert (format "* current ix: (%d %s)\n" phys word))) + ;; (x (insert (format "* current ix: (%d %s)\n" phys word))) (result (pdicv-scan-datablock dicfile phys datablock-criteria-func)); decoder-list nil)) (result-count (length result)) - (inserter pdicv-default-inserter) - ) - - (if index-needles - (if (string>= word needle2) (throw 'while t))) - ; (if (not (string< word (cdr index-needles))) (throw 'while t))) + (inserter pdicv-default-inserter)) + (when index-needles + (when (string>= word needle2) (throw 'while t))) + ;; (if (not (string< word (cdr index-needles))) (throw 'while t))) ; (insert (format "(%s with index %s ... %s)\n" @@ -501,13 +483,9 @@ ) (setq match-count (1+ match-count)) - ) - );wend + )) (message "%5d/%5d:%7d" curr-size index-size match-count) - (sit-for 0) - ) - (progn ;else - (if (zerop (% curr-size 128)) ;;128�����ʿ� (message "%5d/%5d:%7d" curr-size index-size match-count)) - ));fi - );let* + (sit-for 0)) + ;;else + (when (zerop (% curr-size 128)) ;;128��ϒŬ����ʒ�� (message "%5d/%5d:%7d" curr-size index-size match-count)))) (setq ix (cdr ix)) (setq curr-size (1- curr-size)) @@ -515,23 +493,17 @@ );caught - ;(insert (pdicv-scan-datablock dicfile (car (car ix)) decoder-list nil needle1 needle2)) + ;;(insert (pdicv-scan-datablock dicfile (car (car ix)) decoder-list nil needle1 needle2)) (goto-char 1) - (if (not simple-mode-p) - (if (re-search-forward ": [?][?][?][?]" nil t nil) - (replace-match (format ": %d" match-count) t t nil 0)) - );fi - + (when (not simple-mode-p) + (when (re-search-forward ": [?][?][?][?]" nil t nil) + (replace-match (format ": %d" match-count) t t nil 0))) ); save-current-buffer ; (pop-to-buffer (current-buffer)) ; (setq split-height-threshold 6) - (if (one-window-p) - (set-window-buffer (split-window-vertically (- pdicv-result-height)) pdicv-buffer) - ) - ); let* - ); caught - );let* - ) + (when (one-window-p) + (set-window-buffer (split-window-vertically (- pdicv-result-height)) pdicv-buffer)) + )))) ;;; pdicv-core.el ends here Index: /lang/elisp/pdicv-mode/trunk/nt-readval.el =================================================================== --- /lang/elisp/pdicv-mode/trunk/nt-readval.el (revision 67) +++ /lang/elisp/pdicv-mode/trunk/nt-readval.el (revision 71) @@ -1,9 +1,10 @@ ;;; nt-readval.el --- read value or a string from buffer ;; -;; Copyright (C) 2005 Naoya TOZUKA. All Rights Reserved. +;; Copyright (C) 2005-2009 naoya_t. All Rights Reserved. ;; -;; Author: Naoya TOZUKA -;; Maintainer: Naoya TOZUKA -;; Primary distribution site: http://pdicviewer.naochan.com/el/ +;; Author: naoya_t +;; Maintainer: naoya_t +;; Primary distribution site: +;; http://lambdarepos.svnrepository.com/svn/share/lang/elisp/pdicv-mode/trunk ;; ;; Created: 06 Feb 2005 @@ -29,7 +30,5 @@ (if (not index) (setq index 0)) (if (or (< index 0) (<= (length s) index)) (throw 'uchar 'out-of-bounds-exception)) - (aref s index) - ) - ) + (aref s index))) ;;=========================================================== @@ -48,8 +47,5 @@ (if (or (< index 0) (<= (length s) index)) (throw 'char 'out-of-bounds-exception)) (setq c (aref s index)) - (if (< c 128) c (- c 256)) ; =result - ); let - ); caught - ) + (if (< c 128) c (- c 256))))) ; =result ;;============================================================== @@ -63,7 +59,5 @@ (if (or (< index 0) (< (- (length s) 2) index)) (throw 'ushort 'out-of-bounds-exception)) (+ (lsh (aref s (1+ index)) 8) - (aref s index)) - ) - ) + (aref s index)))) (defsubst nt:read-ushort-bigendian (s &optional index) @@ -73,7 +67,5 @@ (if (or (< index 0) (< (- (length s) 2) index)) (throw 'ushort 'out-of-bounds-exception)) (+ (lsh (aref s index) 8) - (aref s (1+ index))) - ) - ) + (aref s (1+ index))))) (defmacro nt:read-ushort-littleendian (s &optional index) @@ -90,8 +82,5 @@ (let ((us (nt:read-ushort s index))) (if (eq us 'out-of-bounds-exception) (throw 'short us)) - (if (< us 32768) us (- us 65536)) - ) ; let - );caught - ) + (if (< us 32768) us (- us 65536))))) (defsubst nt:read-short-bigendian (s &optional index) @@ -100,8 +89,5 @@ (let ((us (nt:read-ushort-bigendian s index))) (if (eq us 'out-of-bounds-exception) (throw 'short us)) - (if (< us 32768) us (- us 65536)) - ) ; let - ) - ) + (if (< us 32768) us (- us 65536))))) (defmacro nt:read-short-littleendian (s &optional index) @@ -123,23 +109,16 @@ (if (or (< index 0) (< (- (length s) 4) index)) (throw 'long 'out-of-bounds-exception)) - (let* ( - (hh (aref s (+ index 3))) - (h0 (lsh hh -4)) - ) - + (let* ((hh (aref s (+ index 3))) + (h0 (lsh hh -4))) (cond ((zerop h0) nil) ; plus ((= h0 15) nil) ; minus ; (t (setq hh (logand 15 hh))) ((< h0 8) (throw 'long 'overflow-exception)) - ((>= h0 8) (throw 'long 'underflow-exception)) - ) + ((>= h0 8) (throw 'long 'underflow-exception))) ; (logior (lsh (aref s (+ index 3)) 24) (logior (lsh hh 24) (lsh (aref s (+ index 2)) 16) (lsh (aref s (1+ index)) 8) - (aref s index)) - ) - ) - ) + (aref s index))))) (defsubst nt:read-long-bigendian (s &optional index) @@ -150,23 +129,16 @@ (if (or (< index 0) (< (- (length s) 4) index)) (throw 'long 'out-of-bounds-exception)) - (let* ( - (hh (aref s index)) - (h0 (lsh hh -4)) - ) - + (let* ((hh (aref s index)) + (h0 (lsh hh -4))) (cond ((zerop h0) nil) ; plus ((= h0 15) nil) ; minus ; (t (setq hh (logand 15 hh))) ((< h0 8) (throw 'long 'overflow-exception)) - ((>= h0 8) (throw 'long 'underflow-exception)) - ) + ((>= h0 8) (throw 'long 'underflow-exception))) ; (logior (lsh (aref s (+ index 3)) 24) (logior (lsh hh 24) (lsh (aref s (1+ index)) 16) (lsh (aref s (+ index 2)) 8) - (aref s (+ index 3))) - ) - ) - ) + (aref s (+ index 3)))))) (defmacro nt:read-long-littleendian (s &optional index) @@ -188,9 +160,6 @@ (if (or (< index 0) (< (- (length s) 4) index)) (throw 'ulong 'out-of-bounds-exception)) - (let* ( - (hh (aref s (+ index 3))) - (h0 (lsh hh -4)) - ) - + (let* ((hh (aref s (+ index 3))) + (h0 (lsh hh -4))) (cond ((zerop h0) nil) ; plus ; (t (setq hh (logand 15 hh))) @@ -200,12 +169,5 @@ (lsh (aref s (+ index 2)) 16) (lsh (aref s (1+ index)) 8) - (aref s index)) - ) - ) - -; (let ((sl (long s index))) -; (if (>= sl 0) sl 0) -; ) - ) + (aref s index))))) (defsubst nt:read-ulong-bigendian (s &optional index) @@ -216,9 +178,6 @@ (if (or (< index 0) (< (- (length s) 4) index)) (throw 'ulong 'out-of-bounds-exception)) - (let* ( - (hh (aref s index)) - (h0 (lsh hh -4)) - ) - + (let* ((hh (aref s index)) + (h0 (lsh hh -4))) (cond ((zerop h0) nil) ; plus ; (t (setq hh (logand 15 hh))) @@ -228,12 +187,5 @@ (lsh (aref s (1+ index)) 16) (lsh (aref s (+ index 2)) 8) - (aref s (+ index 3))) - ) - ) - -; (let ((sl (long s index))) -; (if (>= sl 0) sl 0) -; ) - ) + (aref s (+ index 3)))))) (defmacro nt:read-ulong-littleendian (s &optional index) @@ -255,13 +207,8 @@ ; (if (> ofs-max 248) (setq ofs-max 248)) (while (< ofs ofs-max) - (if (zerop (aref s (+ index ofs))) - (throw 'cstring (cons (substring s index (+ index ofs)) ofs) ) - ) - (setq ofs (1+ ofs)) - ) - (cons (substring s index nil) ofs-max) - ) - ) - ) + (if (zerop (aref s (+ index ofs))) + (throw 'cstring (cons (substring s index (+ index ofs)) ofs) )) + (setq ofs (1+ ofs))) + (cons (substring s index nil) ofs-max)))) ;;============================================== @@ -278,8 +225,5 @@ (size (nt:read-uchar s index)) ) (if (> (1+ size) ofs-max) (throw 'pstring 'out-of-bounds-exception)) - (throw 'pstring (cons (substring s (1+ index) (+ index 1 size)) size) ) - ); let - ); caught - ) + (throw 'pstring (cons (substring s (1+ index) (+ index 1 size)) size) )))) (defsubst nt:read-bcd (s ofs bytes) @@ -289,9 +233,6 @@ (setq c (aref s (+ ofs i))) (setq n (+ (* n 100) (* (lsh c -4) 10) (logand c #x0f))) - (setq i (1+ i)) ;; (++ i) - );wend - n - );let - ) + (setq i (1+ i))) ;; (++ i) + n)) ;;; nt-readval.el ends here Index: /lang/elisp/pdicv-mode/trunk/nt-file.el =================================================================== --- /lang/elisp/pdicv-mode/trunk/nt-file.el (revision 67) +++ /lang/elisp/pdicv-mode/trunk/nt-file.el (revision 71) @@ -1,9 +1,10 @@ ;;; nt-file.el --- file-related functions ;; -;; Copyright (C) 2005 Naoya TOZUKA. All Rights Reserved. +;; Copyright (C) 2005-2009 naoya_t. All Rights Reserved. ;; -;; Author: Naoya TOZUKA -;; Maintainer: Naoya TOZUKA -;; Primary distribution site: http://pdicviewer.naochan.com/el/ +;; Author: naoya_t +;; Maintainer: naoya_t +;; Primary distribution site: +;; http://lambdarepos.svnrepository.com/svn/share/lang/elisp/pdicv-mode/trunk ;; ;; Created: 16 Feb 2005 (formerly nt-utils) @@ -36,8 +37,5 @@ (setq my-buffer (buffer-substring 1 (+ 1 read-length))) (kill-buffer buffer-name) - my-buffer - ) ; let - ) ; save-current-buffer - ) + my-buffer))) (defun nt:scan-latest-version (filename-format min max) @@ -47,12 +45,6 @@ (let ((file (format filename-format version))) (if (file-readable-p file) (throw 'scan-latest-version (list file version)) - (setq version (1- version)) - );fi - );let - );wend - nil - );let - );caught - ) + (setq version (1- version))))) + nil))) ;;; nt-file.el ends here Index: /lang/elisp/pdicv-mode/trunk/pdicviewer.el =================================================================== --- /lang/elisp/pdicv-mode/trunk/pdicviewer.el (revision 67) +++ /lang/elisp/pdicv-mode/trunk/pdicviewer.el (revision 71) @@ -1,13 +1,14 @@ ;; pdicviewer.el - PDIC Viewer for Emacs ;; -;; Copyright (C) 2005 Naoya TOZUKA. All Rights Reserved. +;; Copyright (C) 2005-2009 naoya_t. All Rights Reserved. ;; -;; Author: Naoya TOZUKA -;; Maintainer: Naoya TOZUKA -;; Primary distribution site: http://pdicviewer.naochan.com/el/ +;; Author: naoya_t +;; Maintainer: naoya_t +;; Primary distribution site: +;; http://lambdarepos.svnrepository.com/svn/share/lang/elisp/pdicv-mode/trunk ;; ;; Created: 14 Feb 2005 ;; Last modified: 23 Dec 2005 -;; Version: 0.9.1 +;; Version: 0.9.2 ;; Keywords: PDIC dictionary search eijiro ;; @@ -33,12 +34,14 @@ ; (sample "~/pdic/SAMPLE.DIC" ; ; (nil nil sjis sjis) t) - (cj2 "~/pdic/cj2.dic" ; - bocu nil) - (eijiro "~/pdic/eijiro81/EIJIRO81.DIC" - (nil nil sjis sjis)) - (waeijiro "~/pdic/eijiro81/WAEIJI81.DIC" - (sjis nil sjis sjis) t) - (fr "~/pdic/fr.dic" - (latin1 nil sjis latin1) nil) +; (cj2 "~/pdic/cj2.dic" ; +; bocu nil) + (eijiro "~/Library/EIJIRO 4th Edition/Eijiro112.dic" bocu nil) + (waeijiro "~/Library/EIJIRO 4th Edition/Waeiji112.dic" bocu nil) +; (eijiro "~/pdic/eijiro81/EIJIRO81.DIC" +; (nil nil sjis sjis)) +; (waeijiro "~/pdic/eijiro81/WAEIJI81.DIC" +; (sjis nil sjis sjis) t) +; (fr "~/pdic/fr.dic" +; (latin1 nil sjis latin1) nil) ; (ej ; (eijiro waeijiro)) Index: /lang/elisp/pdicv-mode/trunk/nt-macros.el =================================================================== --- /lang/elisp/pdicv-mode/trunk/nt-macros.el (revision 67) +++ /lang/elisp/pdicv-mode/trunk/nt-macros.el (revision 71) @@ -1,9 +1,10 @@ ;;; nt-macros.el --- useful (at least for NT) macros ;; -;; Copyright (C) 2005 Naoya TOZUKA. All Rights Reserved. +;; Copyright (C) 2005-2009 naoya_t. All Rights Reserved. ;; -;; Author: Naoya TOZUKA -;; Maintainer: Naoya TOZUKA -;; Primary distribution site: http://pdicviewer.naochan.com/el/ +;; Author: naoya_t +;; Maintainer: naoya_t +;; Primary distribution site: +;; http://lambdarepos.svnrepository.com/svn/share/lang/elisp/pdicv-mode/trunk ;; ;; Created: 16 Feb 2005 (formerly nt-utils.el) Index: /lang/elisp/pdicv-mode/trunk/nt-utf8.el =================================================================== --- /lang/elisp/pdicv-mode/trunk/nt-utf8.el (revision 67) +++ /lang/elisp/pdicv-mode/trunk/nt-utf8.el (revision 71) @@ -2,9 +2,10 @@ ;;; some functions require Mule-UCS ;; -;; Copyright (C) 2005 Naoya TOZUKA. All Rights Reserved. +;; Copyright (C) 2005-2009 naoya_t. All Rights Reserved. ;; -;; Author: Naoya TOZUKA -;; Maintainer: Naoya TOZUKA -;; Primary distribution site: http://pdicviewer.naochan.com/el/ +;; Author: naoya_t +;; Maintainer: naoya_t +;; Primary distribution site: +;; http://lambdarepos.svnrepository.com/svn/share/lang/elisp/pdicv-mode/trunk ;; ;; Created: 14 Feb 2005 Index: /lang/elisp/pdicv-mode/trunk/nt-bocu.el =================================================================== --- /lang/elisp/pdicv-mode/trunk/nt-bocu.el (revision 67) +++ /lang/elisp/pdicv-mode/trunk/nt-bocu.el (revision 71) @@ -1,9 +1,10 @@ ;;; nt-bocu.el --- decode/encode BOCU-1 string (via utf-8, so requires Mule-UCS) ;; -;; Copyright (C) 2005 Naoya TOZUKA. All Rights Reserved. +;; Copyright (C) 2005-2009 naoya_t. All Rights Reserved. ;; -;; Author: Naoya TOZUKA -;; Maintainer: Naoya TOZUKA -;; Primary distribution site: http://pdicviewer.naochan.com/el/ +;; Author: naoya_t +;; Maintainer: naoya_t +;; Primary distribution site: +;; http://lambdarepos.svnrepository.com/svn/share/lang/elisp/pdicv-mode/trunk ;; ;; Created: 12 Feb 2005 @@ -38,6 +39,6 @@ ((>= tr #x10) (- tr 10)) ;10 ... 19 >> 06 ... 0F (t (1- tr)) ;01 ... 06 >> 00 ... 05 - ); cond - ) + )) + (defsubst nt:bocu-encode-trail-char (c) "[BOCU] encode trail char" @@ -47,6 +48,5 @@ ((>= c #x06) (+ c 10)) ;06 ... 0F >> 10 ... 19 (t (1+ c)) ;00 ... 05 >> 01 ... 06 - ); cond - ) + )) (defun nt:bocustr-to-rawcode-list (s) @@ -67,6 +67,5 @@ ; trail 1 (setq tr (nt:bocu-decode-trail-char (aref s i)) i (1+ i)) - (setq diff (+ diff tr)) - ) + (setq diff (+ diff tr)) ) ((< lead #x25) ;22-24 (L T T) (setq diff (+ -10513 (* (- lead #x25) 243 243))) @@ -76,21 +75,17 @@ ; trail 1 (setq tr (nt:bocu-decode-trail-char (aref s i)) i (1+ i)) - (setq diff (+ diff tr)) - ) + (setq diff (+ diff tr)) ) ((< lead #x50) ;25-4f (L T) (setq diff (+ -64 (* (- lead #x50) 243))) ; trail 1 (setq tr (nt:bocu-decode-trail-char (aref s i)) i (1+ i)) - (setq diff (+ diff tr)) - ) + (setq diff (+ diff tr)) ) ((< lead #xd0) ;50-cf (L) - (setq diff (- lead #x90)) - ) + (setq diff (- lead #x90)) ) ((< lead #xfb) ;d0-fa (L T) (setq diff (+ 64 (* (- lead #xd0) 243))) ; trail 1 (setq tr (nt:bocu-decode-trail-char (aref s i)) i (1+ i)) - (setq diff (+ diff tr)) - ) + (setq diff (+ diff tr)) ) ((< lead #xfe) ;fb-fd (L T T) (setq diff (+ 10513 (* (- lead #xfb) 243 243))) @@ -100,6 +95,5 @@ ; trail 1 (setq tr (nt:bocu-decode-trail-char (aref s i)) i (1+ i)) - (setq diff (+ diff tr)) - ) + (setq diff (+ diff tr)) ) ((= lead #xfe) ;fe (L T T T) (setq diff 187660) @@ -112,9 +106,6 @@ ; trail 1 (setq tr (nt:bocu-decode-trail-char (aref s i)) i (1+ i)) - (setq diff (+ diff tr)) - ) - ((= lead #xff) ; reset - ) - ); end of cond. + (setq diff (+ diff tr)) ) + ((= lead #xff) )) ; reset (cond @@ -122,10 +113,8 @@ (push lead l) ; (setq r (concat r (string lead))) - (if (< lead #x20) (setq pc #x40)) ;#x20�ʤ餽�Τޤ� ) - ((< lead #xff) + (if (< lead #x20) (setq pc #x40)) ) ;#x20�ʤ餽�Τޤ� ((< lead #xff) (progn (setq code (+ pc diff)) (if (< code 0) (setq code 0));; error recovery - (push code l) ; (setq r (concat r (if (> code 0) (code-to-utf8 code) "?"))) @@ -140,10 +129,6 @@ )); pc )) - (t (setq pc #x40)); #xFF: reset - ) - ); wend - (nreverse l) - ); let - ) + (t (setq pc #x40)) )); #xFF: reset + (nreverse l) )) (defun nt:diff-to-bocustr (diff) @@ -160,7 +145,5 @@ (setq t1 (% diff 243)) (setq diff (/ diff 243)) ;(setq t0 diff) - (string #x21 (nt:bocu-encode-trail-char t1) (nt:bocu-encode-trail-char t2) (nt:bocu-encode-trail-char t3)) - ) - ) + (string #x21 (nt:bocu-encode-trail-char t1) (nt:bocu-encode-trail-char t2) (nt:bocu-encode-trail-char t3)) )) ((< diff -10513) ; [-187660,-10513) : 22-24 (progn @@ -169,7 +152,5 @@ (setq t1 (% diff 243)) (setq diff (/ diff 243)) (setq t0 diff) - (string (+ #x22 t0) (nt:bocu-encode-trail-char t1) (nt:bocu-encode-trail-char t2)) - ) - ) + (string (+ #x22 t0) (nt:bocu-encode-trail-char t1) (nt:bocu-encode-trail-char t2)) )) ((< diff -64) ; [-10513,-64) : 25-4F (progn @@ -177,14 +158,10 @@ (setq t1 (% diff 243)) (setq diff (/ diff 243)) (setq t0 diff) - (string (+ #x25 t0) (nt:bocu-encode-trail-char t1)) - ) - ) + (string (+ #x25 t0) (nt:bocu-encode-trail-char t1)) )) ((< diff 64) ; [-64,63) : 50-CF (progn (setq diff (- diff -64)) (setq t0 diff) - (string (+ #x50 t0)) - ) - ) + (string (+ #x50 t0)) )) ((< diff 10513) ; [64,10513) : D0-FA (progn @@ -192,7 +169,5 @@ (setq t1 (% diff 243)) (setq diff (/ diff 243)) (setq t0 diff) - (string (+ #xD0 t0) (nt:bocu-encode-trail-char t1)) - ) - ) + (string (+ #xD0 t0) (nt:bocu-encode-trail-char t1)) )) ((< diff 187660) ; [10513,187660) : FB-FD (progn @@ -201,7 +176,5 @@ (setq t1 (% diff 243)) (setq diff (/ diff 243)) (setq t0 diff) - (string (+ #xFB t0) (nt:bocu-encode-trail-char t1) (nt:bocu-encode-trail-char t2)) - ) - ) + (string (+ #xFB t0) (nt:bocu-encode-trail-char t1) (nt:bocu-encode-trail-char t2)) )) ((< diff 14536567) ; [187660,14536567) : FE (progn @@ -211,12 +184,6 @@ (setq t1 (% diff 243)) (setq diff (/ diff 243)) ;(setq t0 diff) - (string #xFE (nt:bocu-encode-trail-char t1) (nt:bocu-encode-trail-char t2) (nt:bocu-encode-trail-char t3)) - ) - ) - (t (throw 'bocu-encode-diff 'overflow-exception)) - ); cond - ); let - ); caught - ) + (string #xFE (nt:bocu-encode-trail-char t1) (nt:bocu-encode-trail-char t2) (nt:bocu-encode-trail-char t3)) )) + (t (throw 'bocu-encode-diff 'overflow-exception)) )))) (defun nt:rawcode-list-to-bocustr (l) ; not tested much @@ -234,10 +201,6 @@ ((and (<= #x4E00 code) (<= code #x9FA5)) #x7711) ((and (<= #xAC00 code) (<= code #xD7A3)) #xC1D1) - (t (+ (logand code #xffff80) #x40)))) - ); let* - ); wend - s - ); let* - ) + (t (+ (logand code #xffff80) #x40)))) )) + s)) (defsubst nt:bocu-decode (s) @@ -245,7 +208,5 @@ (let* ((rawcode-list (nt:bocustr-to-rawcode-list s)) (utf8str (nt:rawcode-list-to-utf8str rawcode-list))) - (decode-coding-string utf8str 'utf-8) - ) - ) + (decode-coding-string utf8str 'utf-8) )) (defsubst nt:bocu-encode (s) @@ -253,9 +214,6 @@ (let* ((utf8str (encode-coding-string s 'utf-8)) (rawcode-list (nt:utf8str-to-rawcode-list utf8str)) - (bocustr (nt:rawcode-list-to-bocustr rawcode-list)) - ) - bocustr - ) - ) + (bocustr (nt:rawcode-list-to-bocustr rawcode-list))) + bocustr)) ;;; nt-bocu.el ends here Index: /lang/elisp/pdicv-mode/trunk/nt-english.el =================================================================== --- /lang/elisp/pdicv-mode/trunk/nt-english.el (revision 67) +++ /lang/elisp/pdicv-mode/trunk/nt-english.el (revision 71) @@ -1,9 +1,10 @@ ;;; nt-english.el --- English ;; -;; Copyright (C) 2005 Naoya TOZUKA. All Rights Reserved. +;; Copyright (C) 2005-2009 naoya_t. All Rights Reserved. ;; -;; Author: Naoya TOZUKA -;; Maintainer: Naoya TOZUKA -;; Primary distribution site: http://pdicviewer.naochan.com/el/ +;; Author: naoya_t +;; Maintainer: naoya_t +;; Primary distribution site: +;; http://lambdarepos.svnrepository.com/svn/share/lang/elisp/pdicv-mode/trunk ;; ;; Created: 23 Dec 2005 @@ -261,6 +262,5 @@ ((null word) (throw 'block nil)) ((string= word "") (throw 'block nil)) - (t nil) - ) + (t nil)) (let* ((word-len (length word)) @@ -273,27 +273,19 @@ (setq suffix-1 (substring word -1 nil)) - (if (>= word-len 2) - (progn - (setq body-2 (substring word 0 -2)) - (setq suffix-2 (substring word -2 nil)) - - (if (>= word-len 3) - (progn - (setq body-3 (substring word 0 -3)) - (setq suffix-3 (substring word -3 nil)) - - (if (>= word-len 4) - (progn - (setq body-4 (substring word 0 -4)) - (setq suffix-4 (substring word -4 nil)) - )) - )) - )) + (when (>= word-len 2) + (setq body-2 (substring word 0 -2)) + (setq suffix-2 (substring word -2 nil)) + (when (>= word-len 3) + (setq body-3 (substring word 0 -3)) + (setq suffix-3 (substring word -3 nil)) + (when (>= word-len 4) + (setq body-4 (substring word 0 -4)) + (setq suffix-4 (substring word -4 nil))))) ;; irregular verbs/nouns first. (setq tmp (cdr (assoc word nt-english-irreg-verbs-list))) - (if tmp (throw 'block (list tmp))) + (when tmp (throw 'block (list tmp))) (setq tmp (cdr (assoc word nt-english-irreg-nouns-list))) - (if tmp (throw 'block (list tmp))) + (when tmp (throw 'block (list tmp))) (cond @@ -328,9 +320,5 @@ ((string= suffix-2 "'s") (list body-2)) - (t nil) ;; ������ʤ��������������� - ) ;cond - ) ;let - );caught - ) + (t nil))))) ;; ������ʤ��������������� (defmacro nt:skipit-p (word) Index: /lang/elisp/pdicv-mode/trunk/pdicv-search.el =================================================================== --- /lang/elisp/pdicv-mode/trunk/pdicv-search.el (revision 67) +++ /lang/elisp/pdicv-mode/trunk/pdicv-search.el (revision 71) @@ -1,13 +1,14 @@ ;;; pdicv-search.el --- upper layer ;; -;; Copyright (C) 2005 Naoya TOZUKA. All Rights Reserved. -;; -;; Author: Naoya TOZUKA -;; Maintainer: Naoya TOZUKA -;; Primary distribution site: http://pdicviewer.naochan.com/el/ +;; Copyright (C) 2005-2009 naoya_t. All Rights Reserved. +;; +;; Author: naoya_t +;; Maintainer: naoya_t +;; Primary distribution site: +;; http://lambdarepos.svnrepository.com/svn/share/lang/elisp/pdicv-mode/trunk ;; ;; Created: 06 Feb 2005 ;; Last modified: 23 Dec 2005 -;; Version: 0.9.1 +;; Version: 0.9.2 ;; Keywords: read-from-file @@ -73,11 +74,9 @@ "" ; (pdicv-search dicname nil regexp-to-search t field-to-search) - (pdicv-search dicname regexp-to-search nil t field-to-search) - ) + (pdicv-search dicname regexp-to-search nil t field-to-search)) (defun pdicv-search-just (dicname word-to-search &optional field-to-search) "" - (pdicv-search dicname word-to-search t nil field-to-search) - ) + (pdicv-search dicname word-to-search t nil field-to-search)) (defun pdicv-search (dicname word-to-search &optional just-p regexp-p field-to-search) @@ -89,9 +88,11 @@ (catch 'pdicv-search (let ((candidates - (if just-p (cons (downcase word-to-search) (nt:english-guess-original-form word-to-search)))) + (if just-p (cons (downcase word-to-search) (nt:english-guess-original-form word-to-search)) + (list word-to-search) + )) (candidate word-to-search) (first-round-p t) (dicinfo (assoc dicname pdicv-dictionary-list))) - + ;;(debug candidates);(nt:english-guess-original-form word-to-search)) (if (null dicinfo) (throw 'pdicv-search 'dictionary-not-found)) @@ -106,8 +107,6 @@ (while dicname-list (pdicv-search (car dicname-list) candidate just-p regexp-p field-to-search) - (setq dicname-list (cdr dicname-list)) - ) - ) - ;else... + (setq dicname-list (cdr dicname-list)))) + ;;else... (let* ((encoding-list (nth 2 dicinfo)) (word-encoding (if (listp encoding-list) (car encoding-list) encoding-list)) @@ -154,5 +153,4 @@ );let* ; (insert (format "%s" criteria)) - (pdicv-core-search dicinfo criteria simple-mode-p (not first-round-p)) ; clear only at the first time );let* @@ -163,4 +161,5 @@ );caught ) + ;;debug (defun pdicv-search-interactive () Index: /ng/elisp/pdicv-mode/trunk/README.sjis =================================================================== --- /lang/elisp/pdicv-mode/trunk/README.sjis (revision 67) +++ (revision ) @@ -1,33 +1,0 @@ -�� PDICViewer for Emacs ----- PDIC�`���̎�����acs (mule) ���猟����[�� - -�@�@Emacs �� PDIC �t�H�[�}�b�g�̎����t�@�C�����邽�߂̃v���O�����ł��B - -�@�@�A���N���u�p���Y�v�Ԗ{�E���{CD-ROM�Ɏ�������IC�`���̎����f�[�^�� -�@�@�C���^�[�l�b�g����\��DIC�`���̗l�X�Ȏ����f�[�^���\�[�X�����p�ł��܂��B - -�@�@Unicode(BOCU)�����ɂ������Ă��܂��B�i�v(?)Mule-UCS�j - -�� ���쌠 - -�@�@���̃v���O�����́AGNU ��������u�o�[�W����2�v�������@�@�����~�̓K���ȃo�[�W�����ɏ]��āA���p�܂��͍Ĕz�z���邱�Ƃ�‚��ꂽ -�@�@�t���[�\�t�g�E�F�A�ł��B -�@�@���m�ȍĔz�z���COPYING �ɋL�ڂ������܂��B - -�� �Ɛӎ��� - -�@�@���̃v���O�����̂����p�ɍۂ��Ĕ����������ځE�Ԑڂ̑��Q�ɑ΂��A�����@�@�����Ȃ��C�����܂�������p�́A���[�U���g�̐ӔC�ɂ����čs��ĉ������B - -�� ���̑��̏� - -�@�@�C���X�g�[���菇�ɂ‚��ẮAINSTALL ��Ƃ��ĉ������B - -�@�@�o�O�E���z�Ȃǂɂ‚��Ă͍��܂ł��A�����������B - -�� ���A�����@�@Naochan (Naoya TOZUKA) -�@�@http://www.naochan.com/ -�@�@http://d.hatena.ne.jp/naoya_t/ - -�� �ꎟ�z�z�� - -�@�@http://pdicviewer.naochan.com/el/ -