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