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

Revision 71, 8.9 kB (checked in by naoya_t, 16 years ago)
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            );fi
64          );let*
65        (setq diclist (cdr diclist))
66        );wend
67      (setq pdicv-inited-p t)
68      (message "Done.")
69      ); let
70    );caught
71  )
72
73(defun pdicv-search-regexp (dicname regexp-to-search &optional field-to-search)
74  ""
75;  (pdicv-search dicname nil regexp-to-search t field-to-search)
76  (pdicv-search dicname regexp-to-search nil t field-to-search))
77
78(defun pdicv-search-just (dicname word-to-search &optional field-to-search)
79  ""
80  (pdicv-search dicname word-to-search t nil field-to-search))
81
82(defun pdicv-search (dicname word-to-search &optional just-p regexp-p field-to-search)
83  ""
84  (if (null just-p) (setq just-p nil))
85  (if (null regexp-p) (setq regexp-p nil))
86  (if (null field-to-search) (setq field-to-search 'e))
87
88  (catch 'pdicv-search
89    (let ((candidates
90           (if just-p (cons (downcase word-to-search) (nt:english-guess-original-form word-to-search))
91                         (list word-to-search)
92                         ))
93          (candidate word-to-search)
94          (first-round-p t)
95          (dicinfo (assoc dicname pdicv-dictionary-list)))
96          ;;(debug candidates);(nt:english-guess-original-form word-to-search))
97      (if (null dicinfo) (throw 'pdicv-search 'dictionary-not-found))
98
99;      (push (downcase word-to-search) candidates)
100      (if (not (string= (downcase word-to-search) word-to-search))
101          (push word-to-search candidates))
102
103      (while (setq candidate (pop candidates))
104                                        ;path
105        (if (listp (cadr dicinfo))
106            (let ((dicname-list (cadr dicinfo)))
107              (while dicname-list
108                (pdicv-search (car dicname-list) candidate just-p regexp-p field-to-search)
109                (setq dicname-list (cdr dicname-list))))
110                  ;;else...
111          (let* ((encoding-list (nth 2 dicinfo))
112                 (word-encoding (if (listp encoding-list) (car encoding-list) encoding-list))
113                 (word-in-dic-encoding (cond
114                                        ((eq word-encoding 'bocu)
115                                         (nt:bocu-encode candidate))
116                                        ((eq word-encoding 'sjis)
117                                         (encode-coding-string candidate 'japanese-shift-jis-dos))
118                                        ((eq word-encoding 'latin1)
119                                         (encode-coding-string candidate 'iso-latin-1-dos))
120                                        (word-encoding
121                                         (encode-coding-string candidate word-encoding))
122                                        (t candidate)))
123                 (needle1 word-in-dic-encoding)
124                 (needle1-len (length needle1))
125                 (needle2 (concat (substring needle1 0 -1)
126                                  (string (1+ (aref needle1 (1- needle1-len))))))
127                 (simple-mode-p just-p)
128
129                 (criteria
130                  (if regexp-p (list
131                                (concat "/" candidate "/")
132                                (if (string-match "^^[^[]" candidate) ; optimizable
133                                    (cons (substring candidate 1 2)
134                                          (string (1+ (aref candidate 1))))
135                                  nil)
136;                               '(lambda (ix) (let ((word (cadr (car ix))))
137;                                               (string-match needle1 word)))
138;                               )
139                                `(lambda (e p j x) (string-match ,needle1 ,field-to-search))
140                                );list
141                    (list
142                     candidate    ; �����������ɽ���ˤ���������ʤ���                     (cons needle1 needle2) ; index�����nil�ʤ�ʸ����                                      ;                '(lambda (ix) (let ((word (cadr (car ix))))
143                                        ;                                  (and (not (string< word needle1))
144                                       ;                                        (string< word needle2))))
145                     (if just-p
146                         `(lambda (e p j x) (zerop (nt:strcmp ,field-to-search ,needle1)))
147                       `(lambda (e p j x) (and (not (string< ,field-to-search ,needle1))
148                                               (string< ,field-to-search ,needle2))) ; �ǡ����֥��������
149                       );just-p
150                     );list
151                    ));fi,criteria
152
153                 );let*
154                                        ;         (insert (format "%s" criteria))
155            (pdicv-core-search dicinfo criteria simple-mode-p (not first-round-p)) ; clear only at the first time
156            );let*
157          );fi
158        (setq first-round-p nil)
159        );wend
160      );let
161    );caught
162  )
163 ;;debug
164
165(defun pdicv-search-interactive ()
166  (interactive)
167  (catch 'block
168    (let ((dicname (completing-read "Target dictionary: " pdicv-dictionary-list nil t ""))
169          (word-to-search nil))
170;        (completing-read "Target dictionary:" (mapcar 'car pdicv-dictionary-list) nil t ""))
171      (if (null dicname) (throw 'block nil))
172
173      (setq word-to-search
174            (read-from-minibuffer "Word to search: "))
175      (if (> (length word-to-search) 0)
176          (pdicv-search (intern dicname) word-to-search))
177      );let
178    );caught
179  )
180
181
182(defun pdicv-search-region (from to)
183  ""
184  (interactive "r")
185  (let ((dicname (completing-read "Target dictionary: " pdicv-dictionary-list nil t "")))
186    (if dicname (pdicv-search (intern dicname) (buffer-substring from to)))
187    );let
188  )
189
190(defun pdicv-set-target-dictionary ()
191  ""
192  (interactive)
193  (let ((dicname (completing-read "Target dictionary: " pdicv-dictionary-list nil t "")))
194    (if dicname (setq pdicv-target-dictionary (intern dicname)))
195    );let
196  )
197
198(defun pdicv-search-current-word ()
199  ""
200  (interactive)
201  (if (null pdicv-target-dictionary) (pdicv-set-target-dictionary))
202
203  (let ((word (thing-at-point 'word)))
204    (if word;(and word (not (nt:skipit-p word-to-search)))
205        (pdicv-search-just pdicv-target-dictionary word)
206      (message "no word at cursor"))
207    );let
208  )
209
210(defun pdicv-search-next-word ()
211  ""
212  (interactive)
213  (if (null pdicv-target-dictionary) (pdicv-set-target-dictionary))
214
215  (forward-word 1) (forward-char)
216;  (pdicv-search-current-word)
217
218  (let ((word (thing-at-point 'word)))
219    (if (and word (not (nt:skipit-p word)))
220        (pdicv-search-just pdicv-target-dictionary word)
221      (progn
222        (forward-word 1) (forward-char)
223        (setq word (thing-at-point 'word))
224        (if (and word (not (nt:skipit-p word)))
225            (pdicv-search-just pdicv-target-dictionary word)
226          (message "no word at cursor"));fi
227        );progn
228      );fi
229    );let
230  )
231
232(defun pdicv-search-previous-word ()
233  ""
234  (interactive)
235  (forward-word -1) ; (backward-word 1)
236  (pdicv-search-current-word)
237  )
238
239;;; pdicv-search.el ends here
Note: See TracBrowser for help on using the browser.