root/lang/elisp/pdicv-mode/trunk/pdicv-search.el @ 113

Revision 74, 8.5 kB (checked in by naoya_t, 16 years ago)

modified around entry word tabsep

Line 
1;;; pdicv-search.el --- upper layer
2;;
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
9;;
10;; Created: 06 Feb 2005
11;; Last modified: 23 Dec 2005
12;; Version: 0.9.2
13;; Keywords: read-from-file
14
15(provide 'pdicv-search)
16
17;;; Copmmentary:
18;;
19; (pdicv-init)
20;   - ���������񥤥�å�����߹��������
21;
22; (pdicv-search-regexp DICNAME REGEXP-TO-SEARCH [FIELD-TO-SEARCH])
23;   - ���ɽ������(pdicv-search-just DICNAME WORD-TO-SEARCH [FIELD-TO-SEARCH])
24;   - exact����(pdicv-search DICNAME WORD-TO-SEARCH [JUST-P REGEXP-P FILED-TO-SEARCH])
25;   - ���񸡺�; (pdicv-search-interactive)
26;   - <interactive> �ߥ˥Хåե����������ñ������(pdicv-search-region FROM TO)
27;   - <interactive> ��ꤷ����Ϥ��������(pdicv-set-target-dictionary)
28;   - <interactive> ����ݼ����� (pdicv-search-current-word)
29;   - <interactive> ����������ˤ���������(pdicv-search-next-word)
30;   - <interactive> ���ĸ�ñ������(pdicv-search-previous-word)
31;   - <interactive> ��������������
32;;; Code:
33(require 'nt-macros)
34(require 'nt-bocu)
35(require 'nt-english)
36(require 'pdicv-core)
37
38(defvar pdicv-dictionary-list ())
39(defvar pdicv-index-table-list ())
40
41(defvar pdicv-target-dictionary nil)
42(defvar pdicv-inited-p nil)
43
44(defun pdicv-init ()
45  "preload index-tables"
46  (catch 'pdicv-init
47    (if pdicv-inited-p (throw 'pdicv-init nil))
48    (setq pdicv-index-table-list '())
49    (garbage-collect)
50    (let ((diclist pdicv-dictionary-list))
51      (while diclist
52        (let* ((dicinfo (car diclist))
53               (dicname (car dicinfo))
54               (path (nth 1 dicinfo))
55               (encoding-list (nth 2 dicinfo))
56               (word-encoding (if (atom encoding-list) encoding-list (car encoding-list)))
57               (index-table nil))
58          (if (atom path)
59              (progn
60                (message "Loading index-table for %s (\"%s\")..." dicname path)
61                (setq index-table (pdicv-get-index-list path word-encoding))
62                (push (cons dicname index-table) pdicv-index-table-list)) ))
63        (setq diclist (cdr diclist)))
64      (setq pdicv-inited-p t)
65      (message "Done.") )))
66
67(defun pdicv-search-regexp (dicname regexp-to-search &optional field-to-search)
68  ""
69;  (pdicv-search dicname nil regexp-to-search t field-to-search)
70  (pdicv-search dicname regexp-to-search nil t field-to-search))
71
72(defun pdicv-search-just (dicname word-to-search &optional field-to-search)
73  ""
74  (pdicv-search dicname word-to-search t nil field-to-search))
75
76(defun pdicv-search (dicname word-to-search &optional just-p regexp-p field-to-search)
77  ""
78  (if (null just-p) (setq just-p nil))
79  (if (null regexp-p) (setq regexp-p nil))
80  (if (null field-to-search) (setq field-to-search 'e))
81
82  (catch 'pdicv-search
83    (let ((candidates
84           (if just-p (cons (downcase word-to-search) (nt:english-guess-original-form word-to-search))
85                         (list word-to-search)
86                         ))
87          (candidate word-to-search)
88          (first-round-p t)
89          (dicinfo (assoc dicname pdicv-dictionary-list)))
90          ;;(debug candidates);(nt:english-guess-original-form word-to-search))
91      (if (null dicinfo) (throw 'pdicv-search 'dictionary-not-found))
92
93;      (push (downcase word-to-search) candidates)
94      (if (not (string= (downcase word-to-search) word-to-search))
95          (push word-to-search candidates))
96
97      (while (setq candidate (pop candidates))
98                                        ;path
99        (if (listp (cadr dicinfo))
100            (let ((dicname-list (cadr dicinfo)))
101              (while dicname-list
102                (pdicv-search (car dicname-list) candidate just-p regexp-p field-to-search)
103                (setq dicname-list (cdr dicname-list))))
104                  ;;else...
105          (let* ((encoding-list (nth 2 dicinfo))
106                 (word-encoding (if (listp encoding-list) (car encoding-list) encoding-list))
107                 (word-in-dic-encoding (cond
108                                        ((eq word-encoding 'bocu)
109                                         (nt:bocu-encode candidate))
110                                        ((eq word-encoding 'sjis)
111                                         (encode-coding-string candidate 'japanese-shift-jis-dos))
112                                        ((eq word-encoding 'latin1)
113                                         (encode-coding-string candidate 'iso-latin-1-dos))
114                                        (word-encoding
115                                         (encode-coding-string candidate word-encoding))
116                                        (t candidate)))
117                 (needle1 word-in-dic-encoding)
118                 (needle1-len (length needle1))
119                 (needle2 (concat (substring needle1 0 -1)
120                                  (string (1+ (aref needle1 (1- needle1-len))))))
121                 (simple-mode-p just-p)
122
123                 (criteria
124                  (if regexp-p (list
125                                (concat "/" candidate "/")
126                                (if (string-match "^^[^[]" candidate) ; optimizable
127                                    (cons (substring candidate 1 2)
128                                          (string (1+ (aref candidate 1))))
129                                  nil)
130;                               '(lambda (ix) (let ((word (cadr (car ix))))
131;                                               (string-match needle1 word)))
132;                               )
133                                `(lambda (e_ e p j x) (string-match ,needle1 ,field-to-search))
134                                );list
135                    (list
136                     candidate    ; �����������ɽ���ˤ���������ʤ���                     (cons needle1 needle2) ; index�����nil�ʤ�ʸ����                                      ;                '(lambda (ix) (let ((word (cadr (car ix))))
137                                        ;                                  (and (not (string< word needle1))
138                                       ;                                        (string< word needle2))))
139                     (if just-p
140                         `(lambda (e_ e p j x) (zerop (nt:strcmp ,field-to-search ,needle1)))
141                       `(lambda (e_ e p j x) (and (not (string< ,field-to-search ,needle1))
142                                                                                                  (string< ,field-to-search ,needle2))) ; �ǡ����֥��������
143                       )))))
144                                        ;         (insert (format "%s" criteria))
145            (pdicv-core-search dicinfo criteria simple-mode-p (not first-round-p)) ; clear only at the first time
146            ))
147        (setq first-round-p nil)))))
148
149(defun pdicv-search-interactive ()
150  (interactive)
151  (catch 'block
152    (let ((dicname (completing-read "Target dictionary: " pdicv-dictionary-list nil t ""))
153          (word-to-search nil))
154;        (completing-read "Target dictionary:" (mapcar 'car pdicv-dictionary-list) nil t ""))
155      (if (null dicname) (throw 'block nil))
156
157      (setq word-to-search
158            (read-from-minibuffer "Word to search: "))
159      (if (> (length word-to-search) 0)
160          (pdicv-search (intern dicname) word-to-search)) )))
161
162(defun pdicv-search-region (from to)
163  ""
164  (interactive "r")
165  (let ((dicname (completing-read "Target dictionary: " pdicv-dictionary-list nil t "")))
166    (if dicname (pdicv-search (intern dicname) (buffer-substring from to))) ))
167
168(defun pdicv-set-target-dictionary ()
169  ""
170  (interactive)
171  (let ((dicname (completing-read "Target dictionary: " pdicv-dictionary-list nil t "")))
172    (if dicname (setq pdicv-target-dictionary (intern dicname))) ))
173
174(defun pdicv-search-current-word ()
175  ""
176  (interactive)
177  (if (null pdicv-target-dictionary) (pdicv-set-target-dictionary))
178
179  (let ((word (thing-at-point 'word)))
180    (if word;(and word (not (nt:skipit-p word-to-search)))
181        (pdicv-search-just pdicv-target-dictionary word)
182      (message "no word at cursor")) ))
183
184(defun pdicv-search-next-word ()
185  ""
186  (interactive)
187  (if (null pdicv-target-dictionary) (pdicv-set-target-dictionary))
188
189  (forward-word 1) (forward-char)
190;  (pdicv-search-current-word)
191
192  (let ((word (thing-at-point 'word)))
193    (if (and word (not (nt:skipit-p word)))
194        (pdicv-search-just pdicv-target-dictionary word)
195      (progn
196        (forward-word 1) (forward-char)
197        (setq word (thing-at-point 'word))
198        (if (and word (not (nt:skipit-p word)))
199            (pdicv-search-just pdicv-target-dictionary word)
200          (message "no word at cursor")) ))))
201
202(defun pdicv-search-previous-word ()
203  ""
204  (interactive)
205  (forward-word -1) ; (backward-word 1)
206  (pdicv-search-current-word))
207
208;;; pdicv-search.el ends here
Note: See TracBrowser for help on using the browser.