Remove non-free old and crusty clearcase pkg
[packages] / mule-packages / edict / edict.el.096
1 ;;;
2 ;;; Copyright (C) 1991, 1992 Per Hammarlund (perham@nada.kth.se)
3 ;;;
4
5 ;;;
6 ;;; Some code that looks for translations of english and japanese using the
7 ;;; EDICTJ Public Domain japanese/english dictionary.
8 ;;;
9 ;;; Written by Per Hammarlund <perham@nada.kth.se>
10 ;;; Morphology and private dictionary handling/editing by Bob Kerns <rwk@crl.dec.com>
11 ;;; Helpful remarks from Ken-Ichi Handa <handa@etl.go.jp>.
12 ;;; The EDICTJ PD dictionary is maintained by Jim Breen <jwb@monu6.cc.monash.edu.au>
13 ;;;
14
15 ;;;
16 ;;;   This program is free software; you can redistribute it and/or modify
17 ;;;   it under the terms of the GNU General Public License as published by
18 ;;;   the Free Software Foundation; either version 1, or (at your option)
19 ;;;   any later version.
20 ;;; 
21 ;;;   This program is distributed in the hope that it will be useful,
22 ;;;   but WITHOUT ANY WARRANTY; without even the implied warranty of
23 ;;;   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
24 ;;;   GNU General Public License for more details.
25 ;;; 
26 ;;;   You should have received a copy of the GNU General Public License
27 ;;;   along with this program; if not, write to the Free Software
28 ;;;   Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
29 ;;; 
30
31 ;;;
32 ;;; Short getting started guide, this assumes that you have not used
33 ;;; the install script and that you understand the "technical" words
34 ;;; used, if you don't, please read the documentation in edict.doc:
35 ;;;
36 ;;; 1. Make sure that you have placed edict.el in a directory that is included
37 ;;;    in the nemacs's search path, look at the variable "load-path" to make sure
38 ;;;    that the directory is in that list.
39 ;;;
40 ;;; 2. Add something like this to your .emacs (or .nemacs) file:
41 ;;;     (autoload 'edict-search-english "edict" "Search for a translation of an English word")
42 ;;;     (global-set-key "\e*" 'edict-search-english)
43 ;;;     (autoload 'edict-search-kanji "edict" "Search for a translation of a Kanji sequence")
44 ;;;     (global-set-key "\e_" 'edict-search-kanji)
45 ;;;     (autoload 'edict-insert "edict" "Insert the last translation")
46 ;;;     (global-set-key "\e+" 'edict-insert)
47 ;;; Note that you can change the key binding to whatever you like, these are only "examples".
48 ;;;
49 ;;; 3. The variable *edict-files* should be a list of filenames of
50 ;;;    edict dictionary files that you want edict to load and search
51 ;;;    in.  The real dictionary EDICTJ should be one of these files,
52 ;;;    you may also have have some local file(s) there.  Something 
53 ;;;    like this *may* be appropriate to:
54 ;;;     (setq *edict-files*  '("edictj"
55 ;;;                            "~my-friend-the-user/.edict"
56 ;;;                            "~my-other-friend-the-user/.edict"))
57 ;;;    By default, it searches the load path (the same directories that are searched
58 ;;;    when you do m-X load-file<return>edict<return>), for a file named "edictj".
59 ;;;
60 ;;; 4. Set the name of your *own* local edictj file.  (Note that this file should
61 ;;;    not be included in the list above!)  Edict will include the additions that
62 ;;;    you do in this file.  The variable *edict-private-file* defaults to "~/.edict",
63 ;;;    if you want something else do a:
64 ;;;       (setq *edict-private-file* "~/somewhere/somethingelse/")
65 ;;; (Don't forget to submit your useful words to Jim Breen once in a
66 ;;; while! His address is jwb@monu6.cc.monash.edu.au)
67 ;;;
68 ;;; You are done.  Report errors and comments to perham@nada.kth.se.
69 ;;;
70
71 ;;;cl.el is part of gnuemacs, so it should be no problem to require
72 ;;;  these Common Lisp extensions.
73 (require 'cl)
74
75 ;;; This should exist, but doesn't.  See edict.install for the
76 ;;; compiler half of this.  You should be sure to load the same
77 ;;; hacks into your compiler if you compile this by hand, or you
78 ;;; won't get it byte compiled.
79
80 (defmacro eval-when (when &rest forms)
81   (and (or (member 'eval when)
82             (member ':execute when))
83        (mapcar (function eval) forms))
84   (and (or (member 'load when)
85            (member ':load-toplevel when))
86        (cons 'progn forms)))
87
88 (defvar *edict-private-file* "~/.edict"
89   "*This is the edict dictionary where the user's entries will be added.")
90
91 ;;*edict-files* should contain a list of filenames for the files that
92 ;; should be read up into the *edict* buffer.
93 (defvar *edict-files* '("edictj")
94 "*This is a list of edict files that are loaded into the *edict* buffer
95 and searched. You will probably want at least one of them to be the real
96 EDICT file.")
97
98 ;;The edict buffer where the data base, of sorts, is and the buffer
99 ;; variable.
100 (defvar *edict-buffer-name* "*edict*")
101 (defvar *edict-buffer* nil)
102
103 ;;The edict matches buffer and the name of it
104 (defvar *edict-match-buffer-name* "*edict matches*")
105 (defvar *edict-match-buffer* nil)
106
107 (defvar *edict-version-date* "920423 [Ê¿À®£´Ç¯£´·î£²£³Æü(ÌÚ)]"
108   "The variable *edict-version-date* contains a string with the
109 date when this version was released.  In both Swedish and Japanese
110 standards")
111
112 (defvar *edict-version* "0.9.6"
113  "The variable *edict-version* contains a string that describes
114  what version of the edict software that you are running.")
115
116 (defun edict-version ()
117   "The function edict-version simply displays (as a message in the
118 mini-buffer) the version of the edict software that you are running
119 at the moment.  The same string is also returned from the function."
120    (interactive)
121    (message (concat "Edict version " *edict-version*  " of " *edict-version-date*)))
122
123 ;;; Marker so we can find the individual files in the buffer.
124 (defvar *edict-file-begin-marker* "<<<<<<<<<<<<<<<<")
125 (defvar *edict-file-end-marker* ">>>>>>>>>>>>>>>>")
126
127 ;;; This is the set of characters to be ignored in the middle of kanji
128 ;;; words being looked up.
129 ;;; The ¡º below should be ¡û, but there seems to be an off-by-one error
130 ;;; in the regexp code.
131
132 (defvar *edict-kanji-whitespace* "¡¡-¡º¡½-¢à \n\t>;!:#?,.\"/@¨¡-¨À")
133
134 ;;; This is the set of characters to be ignored in the middle of english
135 ;;; words being looked up.
136 ;;; The ¡º below should be ¡û, but there seems to be an off-by-one error
137 ;;; in the regexp code.
138
139 (defvar *edict-eigo-whitespace* "¡¡-¡º¡½-¢à \n\t>;!:#?,.\"/@¨¡-¨À")
140
141 (defvar *edict-eigo-characters* "[A-Za-z£Á-£Ú£á-£ú]"
142   "These are the characters that eigo is made up of.")
143
144 (defvar *edict-unreadable-error* "While loading edict files: \"%s\" isn't readable!")
145
146 (defvar *edict-non-existent-error* "While loading edict files: \"%s\" doesn't exist!")
147
148
149
150 ;;;
151 ;;;Reads the edict files (the ones in the list *edict-files*) into a buffer
152 ;;; called what the string *edict-buffer-name* is set to.
153 ;;;
154 (defun edict-init ()
155   "Reads the edict file into a buffer called *edict*.
156
157 This is done only once and the *edict-buffer* is created.
158 Use the function edict-force-init to reread the edict files."
159
160   ;;create a match buffer.
161   (if (not (get-buffer *edict-match-buffer-name*))
162     (setq *edict-match-buffer* (get-buffer-create
163                                 *edict-match-buffer-name*)))
164
165   ;;Check that we have a list of strings, we will check that they are readable below.
166   (if (not (listp *edict-files*))
167     ;;report an error and fail...
168     (error "The variable *edict-files* should be a list of paths to edict files!")
169     ;;Check for strings if it was a list.
170     (if (notevery 'stringp *edict-files*)
171       (error "Something in the list *edict-files* is not a string (path)!")))
172
173   ;;Create and read the edict files.
174   (if (not (get-buffer *edict-buffer-name*))
175     (progn
176       (save-window-excursion
177         ;;First create the buffer and make it the current one
178         (setq *edict-buffer* (get-buffer-create *edict-buffer-name*))
179         (set-buffer *edict-buffer*)
180
181         ;;Read in the files from the list.
182         (mapcar (function (lambda (filename)
183                             (catch 'found-file
184                               (dolist (dir load-path)
185                                 (let ((file (expand-file-name filename dir)))
186                                   (if (file-exists-p file)
187                                       (if (file-readable-p file)
188                                           (throw 'found-file (edict-add-file file))
189                                         (message (format *edict-unreadable-error* filename)))
190                                     (message (format *edict-non-existent-error*
191                                                      filename))))
192                                 ;; If it's an absolute pathname, no need for a search.
193                                 (when (or (equal (substring filename 0 1) "/")
194                                           (equal (substring filename 0 1) "~"))
195                                   (throw 'found-file nil))))))
196                 (if *edict-private-file*
197                     (cons *edict-private-file* *edict-files*)
198                   *edict-files*))
199
200         ;;If none of the files were readable 
201         (if (= 0 (buffer-size))
202           (progn
203             (kill-buffer *edict-buffer*)
204             (error "No edict files found! Check value of *edict-files*.")))
205         )))
206   t)
207
208 ;;;
209 ;;;
210 ;;;
211 (defun edict-force-init ()
212   "This function always rereads the edict files even if there is a edict buffer, named
213 by the variable *edict-buffer-name*.
214
215 Usefule when you have updated the *edict-files* variable or corrupted the
216 edict buffer."
217   (interactive)
218   (kill-buffer *edict-buffer*)
219   (edict-init))
220
221 ;;;
222 ;;; Add file filename to the current buffer with the begin end markers around that file...
223 ;;;
224 (defun edict-add-file (filename)
225   "This function adds a file, filename, to the current buffer.  A
226 *edict-file-begin-marker* and *edict-file-end-marker* are placed around
227 the file contents."
228   (goto-char (point-max))
229   (insert (format "%s %s\n" *edict-file-begin-marker* filename))
230   (let ((pos (point)))
231     (insert-file-contents filename)
232     (goto-char (point-max))
233     (insert (format "%s %s\n" *edict-file-end-marker* filename))
234     (goto-char pos)
235     (when (looking-at "¡©¡©¡©¡© /\\([ -.0-\177]+\\)/")
236       (message "Loaded dictionary %s."
237                (buffer-substring (match-beginning 1) (match-end 1))))
238     (goto-char (point-max))))
239
240 ;;;
241 ;;; Remove any leading, trailing, or imbedded whitespace or other noise characters
242 ;;; (such as the inserted ">" etc. used to denote inserted quotations in mail and
243 ;;; news)
244 ;;;
245 (defun edict-clean-up-kanji (key)
246   (let ((start 0)
247         (loc 0)
248         (end (length key))
249         (result "")
250         (pattern (concat "[" *edict-kanji-whitespace* "]+")))
251     (while (and (< start end) (setq start (string-match pattern key start)))
252       (setq result (concat result (substring key loc start)))
253       (setq loc (setq start (match-end 0))))
254     (concat result (substring key loc))))
255
256 (defvar *edict-romaji-remaps* nil)
257 (setq *edict-romaji-remaps* 
258       '(("£á" . "a") ("£â" . "b") ("£ã" . "c") ("£ä" . "d") ("£å" . "e") ("£æ" . "f") ("£ç" . "g")
259         ("£è" . "h") ("£é" . "i") ("£ê" . "j") ("£ë" . "k") ("£ì" . "l") ("£í" . "m")
260         ("£î" . "n") ("£ï" . "o") ("£ð" . "p") ("£ñ" . "q") ("£ò" . "r") ("£ó" . "s") ("£ô" . "t")
261         ("£õ" . "u") ("£ö" . "v") ("£÷" . "w") ("£ø" . "x") ("£ù" . "y") ("£ú" . "z")
262         ("£Á" . "A") ("£Â" . "B") ("£Ã" . "C") ("£Ä" . "D") ("£Å" . "E") ("£Æ" . "F") ("£Ç" . "G")
263         ("£È" . "H") ("£É" . "I") ("£Ê" . "J") ("£Ë" . "K") ("£Ì" . "L") ("£Í" . "M")
264         ("£Î" . "N") ("£Ï" . "O") ("£Ð" . "P") ("£Ñ" . "Q") ("£Ò" . "R") ("£Ó" . "S") ("£Ô" . "T")
265         ("£Õ" . "U") ("£Ö" . "V") ("£×" . "W") ("£Ø" . "X") ("£Ù" . "Y") ("£Ú" . "Z")))
266
267 ;;;
268 ;;; Lookup a mapping for zenkaku roman characters to ASCII.
269 ;;;
270 (defun edict-in-remap-list (item list)
271   "Look for ITEM in LIST; return first link in LIST whose car is `equal' to ITEM."
272   (let ((ptr list)
273         (done nil)
274         (result '()))
275     (while (not (or done (endp ptr)))
276       (cond ((string= item (car (car ptr)))
277              (setq done t)
278              (setq result ptr)))
279       (setq ptr (cdr ptr)))
280     result))
281
282 ;;;
283 ;;; Remap zenkaku roman characters to ASCII.
284 ;;;
285 (defun edict-remap-romaji (eigo-string)
286   (let ((stop (length eigo-string))
287         (current 0)
288         (match nil)
289         (result ""))
290     (while (< current stop)
291       (if (<  (+ 1 current) stop)
292         (setq match (edict-in-remap-list (substring eigo-string current (+ 2 current)) *edict-romaji-remaps*))
293         (setq match nil))
294       (if match
295         (progn
296           (setq result (concat result (cdr (car match))))
297           (setq current (+ 2 current)))
298         (progn
299           (setq result (concat result (substring eigo-string current (1+ current))))
300           (setq current (1+ current)))))
301     result))
302
303 ;;;
304 ;;;  Eliminate extra whitespace, newlines, punctuation, etc. which would
305 ;;;  interfere with our dictionary lookup.
306 ;;;
307 (defun edict-clean-up-eigo (key)
308   (let ((start 0)
309         (loc 0)
310         (end (length key))
311         (result "")
312         (pattern (concat "[" *edict-eigo-whitespace* "]+")))
313     (while (and (< start end)
314                 (setq start (string-match pattern key start)))
315       (setq result (concat result (substring key loc start) " "))
316       (setq loc  (setq start (match-end 0))))
317
318     (setf result (concat result (substring key loc)))
319
320     (edict-remap-romaji result)))
321
322 ;;;
323 ;;;  slightly specialized function to be changed when the real backward word things are included.
324 ;;;
325 (defun edict-eigo-one-word (direction)
326   "The function edict-eigo-one-word goes one word forward (direction > 0)
327 or backward (direction <= 0).  It assumes that is is looking at a word
328 when invoked.  It returns the point either at the beginning of a word or
329 at the whitespace after a word."
330   (let ((stop-point (point))
331         (stop nil))
332     (if (> direction 0)
333       ;;forward
334       (progn
335         (while (not stop)
336           (setq stop-point (point))
337           (if (< (point) (point-max))
338             (if (looking-at *edict-eigo-characters*)
339               (forward-char 1)
340               (setq stop t))
341             (setq stop t))))
342       ;;backward
343       (progn
344         (while (not stop)
345           (setq stop-point (point))
346           (if (> (point) (point-min))
347             (if (looking-at *edict-eigo-characters*)
348               (backward-char 1)
349               (progn
350                 (setq stop t)
351                 (forward-char 1)
352                 (setq stop-point (point))))
353             (setq stop t )))))
354     stop-point))
355     
356
357 ;;;
358 ;;; perham
359 ;;;
360 (defun edict-find-word-at-point ()
361   "Find-word-at-point tries to find an English word close to or behind
362 point.
363
364 If it does not find any word it reports an error."
365   (let (start end)
366
367     ;; Move backward for word if not already on one.
368     (if (not (looking-at *edict-eigo-characters*))
369       (re-search-backward *edict-eigo-characters* (point-min) 'stay))
370
371     (if (looking-at *edict-eigo-characters*)
372       (progn
373         (setq start (edict-eigo-one-word -1))
374         (setq end   (edict-eigo-one-word 1))
375         
376         (edict-clean-up-eigo (buffer-substring start end)))
377       (error "Can't find English word!")
378       )))
379
380 ;;;
381 ;;;
382 ;;;
383 (defun edict-search-english (arg)
384   "Attempts to translate the english word we are looking at. Picks the word 
385 in the same way as ispell, ie backs up from whitespace, and then expands.
386
387 Result is presented in a window that is not selected. Clear the window by
388 using a negative prefix argument.
389
390 If given an argument, adds an english word to the private dictionary."
391
392   (interactive "P")
393   (if arg
394     (if (< (prefix-numeric-value arg) 0)
395         (edict-restore-display)
396       (edict-add-english))
397     (let ((word (edict-get-english-word)))
398       ;;Search if there is a word.
399       (when word
400         (edict-search-and-display word 'english)))))
401
402 ;;; Return the english word, or nil
403 (defun edict-get-english-word ()
404   (let (word real-word)
405
406     ;;Find the word
407     (setq word (edict-find-word-at-point))
408
409     ;;ask the user if this is really the word that is interesting.
410     (setq real-word (read-string
411                      (format "Translate word (default \"%s\"): "
412                              word)))
413     (setq real-word (edict-clean-up-eigo real-word))
414     (if (equal real-word "")
415         (if (equal word "")
416             nil
417           word)
418       real-word)))
419
420 ;;;
421 ;;;
422 ;;;
423 (defun edict-search-kanji (arg min max)
424   "Attempts to translate the Kanji sequence between mark and point.
425
426 Result is presented in a window that is not selected. Clear the window
427 with for instance C-X 1
428
429 Given a numeric argument, this adds the Kanji sequence to the user's
430 private dictionary."
431
432   ;;Interactive, with a region as argument
433   (interactive "P
434 r")
435
436   ;;make sure that the dictionary is read
437   (edict-init)
438
439   (if arg
440       (if (< (prefix-numeric-value arg) 0)
441           (edict-restore-display)
442         (edict-add-kanji min max))
443     (let ((word (edict-clean-up-kanji (buffer-substring min max))))
444       (if (equal word "")
445           (error "No word to search for!")
446         (edict-search-and-display word 'ÆüËܸì))))
447   t)
448
449 ;;;
450 ;;;
451 ;;;
452 (defun edict-copy-of-current-line ()
453   "Copy-of-current-line creates and returns a copy of the line
454 where point is. It does not affect the buffer it is working on,
455 except for moving the point around.
456
457 It leaves the point at the end of the line, which is fine for this
458 application."
459
460   ;;Find the start and end of the current line
461   (let ((line-start (progn (beginning-of-line) (point)))
462         (line-end   (progn (end-of-line) (point))))
463
464     ;;return a copy of his line, perham, is there something that
465     ;; should be tested here?
466     (buffer-substring line-start line-end)))
467
468
469 ;;;
470 ;;;
471 ;;;
472 (defun edict-search (key buffer)
473   "Searches the *edict-buffer* and returns a list of strings that are
474 the matches.
475
476 If there are no matches this string will be nil."
477
478   ;;perham, should this really go here? Or what should we have? Look
479   ;;at ispell.el...
480   (save-window-excursion
481     (message (format "Searching for word \"%s\"..." key))
482     (let ((match-list nil))
483       ;;select the database and goto to the first char
484       (set-buffer buffer)
485       (goto-char (point-min))
486       ;;Search for lines that match the key and copy the over to the
487       ;; match buffer.
488       (while (edict-search-key key)
489         (setq match-list (edict-union match-list (list (edict-copy-of-current-line)))))
490       match-list)))
491
492 (defun edict-search-key (key)
493   (search-forward                       ;Ken-ichi says that one cannot
494                                         ;use the re-search-forward
495                                         ;function with actually having
496                                         ;some reg exp in the starget string.
497                                         ;(concat "[\[/ 
498                                         ;]" key "[\]/ ]")
499    key nil t))
500
501 ;;;
502 ;;;
503 ;;;
504
505 (defvar *edict-previous-configuration* nil)
506
507 (defun edict-note-windows ()
508   (or *edict-previous-configuration*
509       (setq *edict-previous-configuration* (current-window-configuration))))
510
511 ;;; This doesn't work yet; leave it set to 'top!
512 (defvar *edict-window-location* 'top
513   "*Location to place edict matches window.  top or bottom.
514 Doesn't work yet.")
515
516 (defun edict-display (key-list match-list)
517   "Edict-display displayes the strings in a separate window that is
518 not selected."
519   (let* ((text-window (get-buffer-window (current-buffer)))
520          (edict-window (get-buffer-window *edict-match-buffer*))
521          ;; We have available some of this window's height plus any we've already
522          ;; already gotten.
523          (avail-height (+ (window-height text-window)
524                           (if edict-window
525                               (window-height edict-window)
526                             0)))
527          ;; We limit the height to half of what's available, but no more than we need,
528          ;; and no less than window-min-height.  We must remember to include 1 line for
529          ;; the mode-line in our minimum figure.
530          (height (min (max window-min-height (+ (length match-list) 1))
531                       (/ avail-height 2))))
532     (if (not edict-window)
533         (progn
534           ;; We don't have a window, so remember our existing configuration,
535           ;; and either find an acceptable window to split, or use the current
536           ;; window.
537           (edict-note-windows)
538           (let ((use-window (edict-find-acceptable-window text-window)))
539             (if use-window
540                 (setq edict-window use-window
541                       text-window (split-window text-window height))
542               (setq edict-window text-window))))
543       ;; We have a window already.  Just adjust its size appropriately.
544       (unless (equal height (window-height edict-window))
545         (let ((selected (selected-window)))
546           (select-window edict-window)
547           (enlarge-window (- height (window-height edict-window))))))
548     (set-buffer *edict-match-buffer*)
549     (let ((min (point-min)))
550       ;; Replace everything.
551       (erase-buffer)
552       (mapcar (function (lambda (string-item)
553                           (insert string-item)
554                           (newline)))
555               match-list)
556       (when (eq *edict-window-location* 'bottom)
557         (let ((w text-window)
558               (setq text-window edict-window
559                     edict-window text-window))))
560       ;; OK, now let's move the exact matches to the top.
561       (goto-char min)
562       ;; Be careful to preserve the order.
563       ;; An exact match is any of "^key ", "[key]", "/key/", or "/to key/".
564       (dolist (key (reverse key-list))
565         (let* ((pattern (concat "^" key " \\|\\[" key "\\]\\|\\/" key
566                                 "\\/\\|\\/to " key "\\/" ))
567                (top-lines nil))
568           ;; First pull them out of the buffer into a list (top-lines).
569           ;; Then re-insert them at the top.
570           (while (re-search-forward pattern nil t)
571             (forward-line 0)
572             (let ((p (point)))
573               (forward-line 1)
574               (push (buffer-substring p (point)) top-lines)
575               (delete-region p (point))))
576           (goto-char min)
577           (mapcar 'insert top-lines)))
578       ;; OK, display it all.
579       (select-window text-window)
580       (set-window-buffer edict-window *edict-match-buffer*)
581       (set-window-start edict-window min)))
582   t)
583
584 ;;; Find a window which is of acceptable size to split.
585 ;;; It must be at least twice window-min-height.
586 (defun edict-find-acceptable-window (window)
587   (catch 'no-window
588     (let ((new-window window))
589       (while (< (window-height new-window) (* 2 window-min-height))
590         (setq new-window (next-window new-window))
591         (when (eq new-window window)
592           (throw 'no-window nil)))
593       new-window)))
594
595 ;;; Try to put the display back the way it was before showing matches.
596 (defun edict-restore-display ()
597   "Remove the edict windows."
598   (when *edict-previous-configuration*
599     (set-window-configuration *edict-previous-configuration*))
600   (setq *edict-previous-configuration* nil)
601   t)
602
603 ;;; Variables to remember the last insertion of a match into our
604 ;;; buffer, for later replacement.
605
606 (defvar edict-last-language nil)
607 (defvar edict-insert-last-start)
608 (defvar edict-insert-last-end)
609
610 ;;;
611 ;;;
612 ;;;
613 (defun edict-search-and-display (key &optional from-language)
614   "Edict-search-and-display searches for matches to the argument key.
615 If there are any matches these are displayed in a window that is not
616 selected. This window can be removed with C-X 1."
617   (edict-init)
618   ;; Remember the last language looked up, so edict-insert can pick the
619   ;; right one.
620   (setq edict-last-language from-language)
621   (save-excursion
622     (let ((match-list nil)
623           (one-char-keys nil)
624           (key-list (edict-expand-string key () () (or from-language 'ÆüËܸì))))
625       ;; Sort them into the order we'd like exact matches to appear.
626       (setq key-list (sort key-list (function (lambda (x y)
627                                                 (let ((lx (length x))
628                                                       (ly (length y)))
629                                                   (if (= lx ly)
630                                                       (string-lessp x y)
631                                                     (> lx ly)))))))
632       ;; For all the possibilities
633       (dolist (key key-list)
634         ;; Search for matches.  We exlude any one-character keys on the theory that they're
635         ;; likely to be uninteresting fragments.
636         (if (string-match "^[¡¢-ô¤]$" key) ;1 char
637             (push key one-char-keys)
638           (setq match-list (edict-union match-list (edict-search key *edict-buffer*)))))
639       ;; If we didn't get anything, we can try including the one-char keys.
640       (or match-list
641           (dolist (key one-char-keys)
642             (setq match-list (edict-union match-list (edict-search key *edict-buffer*)))))
643       (if (not match-list)
644           (edict-delete-matches-window))
645       (edict-display key-list match-list))
646     (message "Found it!")))
647
648 (defun edict-insert (arg)
649   "Insert the last value looked up at the current position.  If repeated,
650 replace with the next possibility.  If given an argument N, use the
651 Nth possibility.  Inserts in the opposite language from what was looked up,
652 unless the argument is negative."
653   (interactive "P")
654   ;; If we were given a negative argument, we need to switch languages.
655   (cond ((null arg))
656         ((> (prefix-numeric-value arg) 0))
657         (t (case arg
658              (- (setq arg nil))
659              (otherwise (setq arg (list (- (prefix-numeric-value arg))))))
660            (setq edict-last-language
661                  (ecase edict-last-language
662                    (english 'ÆüËܸì)
663                    (ÆüËܸì 'english)))))
664   (ecase edict-last-language
665     (english (edict-insert-ÆüËܸì arg))
666     (ÆüËܸì (edict-insert-english arg))))
667
668 (defun edict-insert-english (arg)
669   "Insert the last english word looked up at the current position.
670 If repeated, replace with the next possibility.  If given an argument N,
671 use the Nth possibility."
672   (interactive "P")
673   (or *edict-match-buffer*
674       (error "You must first look up a word."))
675   (let ((value nil))
676     (save-excursion
677       (set-buffer *edict-match-buffer*)
678       ;; If we're going to a specific one, always count from the beginning.
679       (when arg
680         (goto-char (point-min)))
681       ;; If the last command was this, then we're going on to the next possibility.
682       ;; Otherwise, start at the beginning.
683       (case last-command
684         (edict-insert-english)
685         (t (goto-char (point-min))))
686       ;; Seach forward for /<definitition>/  If we don't find one, start over from the
687       ;; beginning.
688       (unless (re-search-forward "/\\([^/\n]+\\)/" (point-max) t (prefix-numeric-value arg))
689         (goto-char (point-min))
690         (unless (or arg
691                     (re-search-forward "/\\([^/\n]+\\)/" (point-max) t))
692           (error "No match numbered %d found." (prefix-numeric-value arg))))
693       ;; Extract the match.  Leave ourselves just before the final /,
694       ;; so if it starts a new definition, we'll find it.
695       (goto-char (match-end 1))
696       (setq value (buffer-substring (match-beginning 1) (match-end 1))))
697     ;; If we inserted one of our languages, then we should delete the old
698     ;; one first.
699     (case last-command
700       ((edict-insert-english edict-insert-ÆüËܸì)
701        (delete-region edict-insert-last-start edict-insert-last-end)))
702     ;; Insert, remembering where we did it, so it can be replaced if we
703     ;; repeat the command.
704     (setq edict-insert-last-start (point-marker))
705     (insert value)
706     (setq edict-insert-last-end (point-marker)))
707   ;; Remember this as the last command, not edict-insert.
708   (setq this-command 'edict-insert-english)
709   t)
710
711 (defun edict-insert-ÆüËܸì (arg)
712   "Insert the last ÆüËܸì word looked up at the current position.
713 If repeated, replace with the next possibility.  If given an argument N,
714 use the Nth possibility."
715   (interactive "P")
716   (or *edict-match-buffer*
717       (error "You must first look up a word."))
718   (let ((value nil))
719     (save-excursion
720       (set-buffer *edict-match-buffer*)
721       ;; If we're going to a specific one, always count from the beginning.
722       (when arg
723         (goto-char (point-min)))
724       ;; If the last command was this, then we're going on to the next possibility.
725       ;; Otherwise, start at the beginning.
726       (case last-command
727         (edict-insert-ÆüËܸì)
728         (t (goto-char (point-min))))
729       ;; Seach forward for a word at the start of a line.  If we don't find one,
730       ;; start over from the beginning.
731       (unless (re-search-forward "^\\(\\(\\ch\\|\\ck\\|\\cK\\|\\cc\\|\\cC\\)+\\)[ \t]" 
732                                  (point-max) t (prefix-numeric-value arg))
733         (goto-char (point-min))
734         (unless (or arg
735                     (re-search-forward "^\\(\\(\\ch\\|\\ck\\|\\cK\\|\\cc\\|\\cC\\)+\\)[ \t]"
736                                        (point-max) t))
737           (error "No match numbered %d found." (prefix-numeric-value arg))))
738       (goto-char (match-end 1))
739       (setq value (buffer-substring (match-beginning 1) (match-end 1))))
740     ;; If we inserted one of our languages, then we should delete the old
741     ;; one first.
742     (case last-command
743       ((edict-insert-ÆüËܸì edict-insert-english)
744        (delete-region edict-insert-last-start edict-insert-last-end)))
745     ;; Insert, remembering where we did it, so it can be replaced if we
746     ;; repeat the command.
747     (setq edict-insert-last-start (point-marker))
748     (insert value)
749     (setq edict-insert-last-end (point-marker)))
750   ;; Remember this as the last command, not edict-insert.
751   (setq this-command 'edict-insert-ÆüËܸì)
752   t)
753
754 ;;; Remove the matches window from the screen.
755 ;;; This is harder than you'd think.
756 (defun edict-delete-matches-window ()
757   (interactive)
758   (let ((window (get-buffer-window *edict-match-buffer*)))
759     (when window
760       (let* ((selected (selected-window))
761              (next (previous-window window))
762              (height (window-height window))
763              (nedges (window-edges next))
764              (tedges (window-edges window)))
765         (delete-window window)
766         ;; The following is sheer magic.  Deleting a window is not
767         ;; an inverse to splitting a window.  The space is returned
768         ;; not to the window below, OR to the window above, but
769         ;; rather is divided between them.
770         (when (and (equal (car nedges) (car tedges))
771                    (< (car (cdr nedges)) (car (cdr tedges))))
772           (select-window next)
773           (shrink-window (/ (- height 1) 2))
774           (select-window selected))))
775     (error "No matches for key \"%s\"." key)))
776
777 ;;; The previous configuration before adding an entry to a private dictionary.
778 (defvar edict-previous-window-configuration nil)
779 ;;; The previously-selected buffer before adding an entry.
780 (defvar edict-previous-buffer nil)
781 ;;; The filename of the file read in to add an entry to.
782 (defvar edict-filename nil)
783
784
785 ;;; Add an entry to a particular file, and update *edict-buffer*.
786 ;;; Any of kanji/yomi/eigo may be omitted.  The user will be given
787 ;;; an oportunity to edit and then it will be saved.
788
789 (defun edict-add-entry-to-file (filename kanji yomi eigo)
790   (edict-init)
791   (setq filename (expand-file-name filename))
792   (let* ((previous-buffer (current-buffer))
793          (buffer (find-file-noselect filename))
794          (window (get-buffer-window buffer)))
795     (set-buffer buffer)
796     ;; If it's a new file, give it a version string to print on loadup.
797     (when (equal (point-min) (point-max))
798       (insert (format "¡©¡©¡©¡© /%s's private dictionary/\n"
799                       (user-login-name))))
800     ;;  Unless it's already in edict-edit mode, put it in that mode.
801     ;; This gives us our fancy electric-dictionary editing.
802     (unless (eq major-mode 'edict-edit-mode)
803       (edict-edit-mode))
804     ;; Unless we already have a configuration to go back to, remember
805     ;; this one.
806     (unless edict-previous-window-configuration
807       (setq edict-previous-window-configuration
808             (current-window-configuration)))
809     (unless edict-previous-buffer
810       (setq edict-previous-buffer previous-buffer))
811     ;; Remember the filename, so we can update it in the *edict* buffer
812     ;; when we finish.
813     (setq edict-filename filename)
814     (if window
815         (select-window window)
816       (split-window nil 4))
817     (goto-char (point-max))
818     (edict-insert-entry kanji yomi eigo)
819     ;; Go into henkan mode if appropriate
820     (switch-to-buffer buffer)
821     (edict-set-henkan (or (null kanji) (null yomi)))))
822
823
824 ;;; Turn on or off henkan
825 (defun edict-set-henkan (henkan-flag)
826   (cond
827     ;;EGG
828     ((fboundp 'egg:mode-line-display)
829      (setq egg:*mode-on* henkan-flag
830            egg:*input-mode* t)
831      (egg:mode-line-display)
832      )
833     ;;SKK
834     ((fboundp 'skk-version)
835      ;;This is a crude way of doing it, but it should give no secondary effects.
836      (skk-mode (if henkan-flag 1 -1))
837      )
838     ))
839
840 ;;; Insert a dictionary entry at point.
841 (defun edict-insert-entry (kanji yomi eigo)
842   ;; Make sure this is on a line of its own.
843   (let ((p (point)))
844     (beginning-of-line)
845     (unless (equal p (point))
846       (end-of-line)
847       (newline)))
848   ;; Now insert a standard entry.
849   (let ((start (point))
850         (p nil))
851     ;; Insert a new entry, leaving out any items which are nil,
852     ;; and also leaving out the yomi if the entry consists of only kana.
853     ;; "ÆüËܸì"
854     (if kanji
855         (insert kanji)
856       (setq p (point)))
857     (when yomi
858       (unless (string-match "^\\(\\ch\\|\\cH\\|\\ck\\|\\cK\\)+$" yomi)
859         (error "yomi must be in kana: %s." yomi)))
860     ;; "ÆüËܸì [¤Ë¤Û¤ó¤´]"
861     (cond ((and kanji
862                 (string-match "^\\(\\ch\\|\\cH\\|\\ck\\|\\cK\\)+$" kanji)))
863           (t (insert " [")
864              (if yomi
865                  (insert yomi)
866                (if (not p)
867                    (setq p (point))))
868              (insert "]")))
869     ;; "ÆüËܸì [¤Ë¤Û¤ó¤´] /Japanese language/"
870     (cond ((null eigo)
871            (insert " /")
872            (unless p (setq p (point))))
873           ((stringp eigo)
874            (insert " /" eigo))
875           ((consp eigo)
876            (insert " ")
877            (dolist (def eigo)
878              (insert "/")
879              (insert def)))
880           (t (error "not a string or list of strings: %s" eigo)))
881     (insert "/\n")
882     ;; Go to the first un-filled-in field.
883     (goto-char (or p start))))
884
885 ;;; Inverse of edict-insert-entry.  Parse an entry.
886 ;;; (multiple-value-bind (kanji yomi english) (edict-parse-entry)
887 ;;;    (edict-insert-entry kanji yomi english))
888 ;;; duplicates the current line's entry.
889
890 (defun edict-parse-entry ()
891   (let ((kanji nil)
892         (yomi nil)
893         (english nil)
894         (start nil)
895         (p nil)
896         (end nil))
897     (save-excursion
898       (end-of-line)
899       (setq end (point))
900       (beginning-of-line)
901       (setq start (point))
902       (search-forward " " end)
903       (setq p (1- (point)))
904       (when (> p start)
905         (setq kanji (buffer-substring start p)))
906       ;; Pick up the [yomi] if there are any.
907       (when (re-search-forward "\\[\\(\\ch\\|\\cH\\|\\ck\\|\\cK\\)+\\]" end t)
908         (setq yomi (buffer-substring (match-beginning 1) (match-end 1)))
909         (goto-char (match-end 0)))
910       ;; Collect up all the definitions.
911       (while (re-search-forward "/\\([^/\n]+\\)/" end t)
912         (goto-char (match-end 1))
913         (push (buffer-substring (match-beginning 1) (match-end 1)) english)))
914     (values kanji yomi english)))
915
916 (defvar edict-edit-mode-map ()
917   "Mode map used by edict-add-english/kanji.")
918
919 ;;; Initialize our mode map.
920 (unless edict-edit-mode-map
921   (setq edict-edit-mode-map (make-keymap))
922   (dotimes (i 128)
923     ;; I don't know how to invoke multi-char commands, so don't hook
924     ;; those.
925     (unless (consp (aref edict-edit-mode-map i))
926       (setf (aref edict-edit-mode-map i) 'edict-standin)))
927   (setf (aref edict-edit-mode-map 3) nil
928         (aref edict-edit-mode-map 24) nil
929         (aref edict-edit-mode-map 27) nil)
930   (define-key edict-edit-mode-map "\C-c\C-c" 'edict-exit)
931   (define-key edict-edit-mode-map "\C-x\C-s" 'edict-exit)
932   (define-key edict-edit-mode-map "\t" 'edict-tab)
933   (define-key edict-edit-mode-map "\r" 'edict-new-entry)
934   (define-key edict-edit-mode-map "\C-A" 'edict-beginning-of-line)
935   (define-key edict-edit-mode-map "\C-E" 'edict-end-of-line)
936   (define-key edict-edit-mode-map "\C-x\C-s" 'edict-exit)
937   (define-key edict-edit-mode-map "\C-x\C-s" 'edict-exit)
938   (define-key edict-edit-mode-map "\C-x\C-s" 'edict-exit)
939   (define-key edict-edit-mode-map "[" 'edict-open-bracket)
940   (define-key edict-edit-mode-map "]" 'edict-close-bracket)
941   (define-key edict-edit-mode-map "/" 'edict-slash))
942
943 (defun edict-edit-mode ()
944   "Major mode for editing edict entries.
945 TAB      Tab to next field in this entry.
946 RETURN   Start a new entry on the next line.
947 c-A      Edit the kanji field, and start entering kanji.
948 c-E      Go to the end, and start editing english.
949 C-c C-c  Install the edited changes & save the file.
950 C-x C-s  Install the edited changes & save the file.
951 "
952   (interactive)
953   (kill-all-local-variables)
954   ;; Associate these with the buffer.
955   (make-local-variable 'edict-previous-window-configuration)
956   (make-local-variable 'edict-previous-bufffer)
957   (make-local-variable 'edict-filename)
958   (set-syntax-table text-mode-syntax-table)
959   (use-local-map edict-edit-mode-map)
960   (setq local-abbrev-table text-mode-abbrev-table)
961   (setq major-mode 'edict-edit-mode)
962   (setq mode-name "Edict")
963   (setq paragraph-start "^\\|$")
964   (setq paragraph-separate "^\\|$")
965   (run-hooks 'text-mode-hook))
966
967 ;;; Automagically pick the right mode, based on where we are in the string.
968 ;;; That's henkan mode when we're in the entry or yomi sections, and english
969 ;;; in the translation section.
970 (defun edict-auto-set-henkan ()
971   (save-excursion
972     (let ((x (point))
973           (end nil))
974       (end-of-line)
975       (setq end (point))
976       (beginning-of-line)
977       (edict-set-henkan
978        (or (looking-at "$")
979            (when (re-search-forward "[]/]" end t)
980              (<= x (match-beginning 0))))))))
981
982 (defun edict-standin ()
983   "Invoke the command we would otherwise have invoked, after being sure
984 we're in the right mode."
985   (interactive)
986   (setq this-command (aref global-map last-command-char))
987   (edict-execute-dictionary-command (function (lambda ()
988                                                 (command-execute this-command)))))
989
990 (defun edict-execute-dictionary-command (function)
991   (edict-auto-set-henkan)
992   (let ((buffer (current-buffer)))
993     ;; Canonicalize the end to end in exactly one slash.
994     (unless (<= (point) (point-min))
995       (save-excursion
996         (backward-char 1)
997         (when (looking-at "//\n")
998           (forward-char 1)
999           (delete-char 1))))
1000     (funcall function)
1001     ;; Canonicalize the end of the line to end in exactly one slash.
1002     (save-excursion
1003       (end-of-line)
1004       (delete-horizontal-space)
1005       (unless (<= (point) (point-min))
1006         (backward-char 2)
1007         (while (looking-at "//")
1008           ;; Two in a row; delete the second.
1009           (forward-char 1)
1010           (delete-char 1)
1011           (backward-char 2))
1012         (forward-char 1)
1013         (unless (looking-at "\n")
1014           (unless (looking-at "[/\n]")
1015             (end-of-line)
1016             (unless (edict-line-has-english)
1017               (insert " /"))
1018             (insert ?/)))))
1019     ;; Then if we are at the end, make it end in two, for the sake of visual feedback.
1020     ;; Except if we're on a blank line, don't add anything.
1021     (unless (<= (point) (point-min))
1022       (unless (save-excursion
1023                 (end-of-line)
1024                 (backward-char 1)
1025                 (looking-at "\n"))
1026         (when (looking-at "\n")
1027           (insert "/")
1028           (backward-char 1))
1029         (save-excursion
1030           (end-of-line)
1031           ;; Make sure there's a trailing newline.
1032           (when (>= (point) (point-max))
1033             (newline)
1034             (backward-char 1))
1035           (let ((end (point)))
1036             (beginning-of-line)
1037             (when (search-forward "/" end t)
1038               (when (looking-at "\n")
1039                 (insert "/")))))))
1040     ;; Only set the henkan if we're still in the same buffer.
1041     (when (eq buffer (current-buffer))
1042       (edict-auto-set-henkan))))
1043
1044 (defun edict-line-has-english (&optional complete)
1045   (save-excursion
1046     (let ((p (point)))
1047       (end-of-line)
1048       (let ((end (point)))
1049         (goto-char p)
1050         (beginning-of-line)
1051         (if complete
1052             (re-search-forward "/[^/\n]+/" end t)
1053           (re-search-forward "/" end t))))))
1054
1055 (defvar *brackets-allowed-in-english* nil
1056   "*Allow brackets in the english section of dictionary entries, if non-null.")
1057
1058 (defun edict-open-bracket ()
1059   "Begin editing the yomi section of the entry, at the beginning of the entry.
1060 Self-inserts if in the english section."
1061   (interactive)
1062   (edict-execute-dictionary-command (function (lambda ()
1063                                                 (edict-char-bracket t)))))
1064
1065 (defun edict-close-bracket ()
1066   "Begin editing the yomi section of the entry, at the end of the entry.
1067 Self-inserts if in the english section.."
1068   (interactive)
1069   (edict-execute-dictionary-command (function (lambda ()
1070                                                 (if (looking-at "\\]")
1071                                                     (edict-tab)
1072                                                   (edict-char-bracket nil))))))
1073
1074 (defun edict-char-bracket (open-p)
1075   (let ((p (point)))
1076     (end-of-line)
1077     (let ((end (point)))
1078       (beginning-of-line)
1079       (cond ((and *brackets-allowed-in-english*
1080                   (save-excursion
1081                     (re-search-forward "/[^\n/]*/" end t))
1082                   (<= (match-beginning 0) p))
1083              (goto-char p)
1084              (edict-standin))
1085             ((re-search-forward "\\[\\(\\ch\\|\\cH\\|\\ck\\|\\cK\\)*\\]" end t)
1086              (goto-char (or (if open-p
1087                                 (match-beginning 1)
1088                               (match-end 1))
1089                             ;; Empty
1090                             (1+ (match-beginning 0)))))
1091             ((re-search-forward "[ \t]" end t)
1092              (goto-char (match-beginning 0))
1093              (insert " []")
1094              (backward-char 1))
1095             (t (goto-char p)
1096                (edict-standin))))))
1097
1098 (defun edict-slash ()
1099   "Begin editing the english section of the entry, at the start of the entry.
1100 Self-inserts if in the english section."
1101   (interactive)
1102   (edict-execute-dictionary-command (function edict-slash-internal)))
1103
1104 (defun edict-slash-internal ()
1105   (if (looking-at "/\n")
1106       (forward-char)
1107     (let ((p (point)))
1108       (end-of-line)
1109       (let ((end (point)))
1110         (beginning-of-line)
1111         (cond ((and (save-excursion
1112                       (re-search-forward "/[^/\n]*/" end t))
1113                     (<= (match-beginning 0) p))
1114                (goto-char p)
1115                (edict-standin))
1116               ((search-forward "/" end t))
1117               ;; On an empty line, just insert a definition.
1118               ((looking-at "$")
1119                (insert " //")
1120                (backward-char 1))
1121               ;; Otherwise, this line has no english, go to the end and add one.
1122               (t (end-of-line)
1123                  (backward-char 1)
1124                  (unless (looking-at " ")
1125                    (insert " "))
1126                  (insert "//")
1127                  (backward-char 1)))))))
1128
1129 (defun edict-tab ()
1130   "Tab to the next edict field in this entry.
1131 At the end, wraps back to the beginning.."
1132   (interactive)
1133   (edict-execute-dictionary-command (function edict-tab-internal)))
1134
1135 (defun edict-tab-internal ()
1136   (let ((p (point))
1137         (end nil))
1138     (end-of-line)
1139     (setq end (point))
1140     (goto-char p)
1141     (cond ((re-search-forward "[ \t]\\(\\[\\)\\|\\(/\\)" end t)
1142            (let ((f-begin (or (match-beginning 1) (match-beginning 2)))
1143                  (f-end (or (match-end 1) (match-end 2))))
1144              (goto-char f-begin)
1145              (edict-set-henkan (looking-at "\\["))
1146              (goto-char f-end)))
1147           (t (beginning-of-line)
1148              (edict-set-henkan t)))))
1149
1150 (defun edict-beginning-of-line ()
1151   "Go to the beginning of the edict entry."
1152   (interactive)
1153   (edict-execute-dictionary-command (function (lambda ()
1154                                                 (beginning-of-line)
1155                                                 (edict-set-henkan t)))))
1156
1157 (defun edict-end-of-line ()
1158   "Go to the beginning of the edict entry."
1159   (interactive)
1160   (edict-execute-dictionary-command (function (lambda ()
1161                                                 (end-of-line)
1162                                                 (edict-set-henkan nil)))))
1163
1164 (defun edict-new-entry (arg)
1165   "Start a new edict entry on the next line.
1166 If given an argument, copies the word but not the yomi or english.
1167 If given an argument > 4 (i.e. c-U c-U), copies the word and definition,
1168 but not the yomi."
1169   (interactive "P")
1170   (edict-execute-dictionary-command (function (lambda ()
1171                                                 (edict-new-entry-internal arg)))))
1172
1173 (defun edict-new-entry-internal (arg)
1174   (end-of-line)
1175   ;;clean up in the dictionary to save space.
1176   (delete-horizontal-space)
1177   ;;first check that the last thing on this line is a '/', otherwise add one.
1178   (unless (<= (point) (point-min))
1179     (backward-char)
1180     (unless (looking-at "/")
1181       (end-of-line)
1182       (insert "/"))
1183     (multiple-value-bind (kanji yomi english)
1184         (edict-parse-entry)
1185       (end-of-line)
1186       (if (>= (point) (point-max))
1187           (newline)
1188         (forward-char 1))
1189       (cond ((null arg)
1190              (edict-insert-entry nil nil nil))
1191             ((<= (prefix-numeric-value arg) 4)
1192              (edict-insert-entry kanji nil nil))
1193             (t (edict-insert-entry kanji nil english))))))
1194
1195 (defun edict-exit ()
1196   "Exit the editing of a private edict file, saving the buffer and updating the
1197 running copy of the dictionary, and restoring the window configuration."
1198   (interactive)
1199   (save-buffer)
1200   (let* ((buffer (current-buffer))
1201          (edict-private-buffer (find-file-noselect (expand-file-name *edict-private-file*)))
1202          (filename (or edict-filename (buffer-file-name edict-private-buffer)))
1203          (configuration edict-previous-window-configuration)
1204          (previous-buffer edict-previous-buffer))
1205     (setq edict-previous-window-configuration nil
1206           edict-previous-buffer nil)
1207     (set-buffer *edict-buffer*)
1208     (goto-char (point-min))
1209     (search-forward (format "%s %s" *edict-file-begin-marker* filename))
1210     (forward-line)
1211     (let ((loc (point)))
1212       (search-forward (format "%s %s" *edict-file-end-marker* filename))
1213       (forward-line 0)
1214       (delete-region loc (point))
1215       (goto-char loc)
1216       (insert-buffer buffer)
1217       (when configuration
1218         (set-window-configuration configuration))
1219       (when previous-buffer
1220         (switch-to-buffer previous-buffer)))))
1221
1222 (defun edict-add-word ()
1223   "Add any word to the private dictionary."
1224   (interactive)
1225   (edict-add-entry-to-file *edict-private-file* nil nil nil))
1226
1227 (defun edict-add-english ()
1228   "Add the english word at point to the dictionary."
1229   (interactive)
1230   (let ((word (edict-get-english-word)))
1231     (when word
1232       (edict-add-entry-to-file *edict-private-file* nil nil word))))
1233
1234 (defun edict-add-kanji (min max)
1235   "Add the region as a kanji entry in the dictionary."
1236   (interactive "r")
1237   (edict-add-entry-to-file *edict-private-file*
1238                            (edict-clean-up-kanji (buffer-substring min max))
1239                            nil nil))
1240
1241 ;;; Table of morphological rules.
1242 (defvar *edict-syntax-types* nil)
1243
1244 ;;; defstruct's defsetfs should expand into this; sigh.
1245
1246 (eval-when (eval load compile)
1247 (defstruct edict-syntax-type
1248   name
1249   rules)
1250 )
1251
1252 (defun get-edict-syntax-type (name)
1253   (if (symbolp name)
1254       (catch 'found-it
1255         (dolist (s *edict-syntax-types*)
1256           (when (eq (edict-syntax-type-name s) name)
1257             (throw 'found-it s)))
1258         (let ((new (make-edict-syntax-type :name name :rules ())))
1259           (push new *edict-syntax-types*)
1260           new))
1261     name))
1262
1263 (eval-when (eval load compile)
1264 (defstruct edict-rule
1265   name
1266   pattern                               ;Pattern which it must match
1267   filter                                ;Syntactic filter on previous form
1268   function                              ;Function to transform the input
1269   additional-args                       ;Arguments to transform function
1270   from-syntax-types                     ;Syntaxes for which this is vali
1271   to-syntax-types)                      ;Syntaxes to consider after this rule.
1272 )
1273
1274 ;;; Delete all occurrances of a rule from the rule base.
1275 (defun edict-delete-rule (name)
1276   (dolist (s *edict-syntax-types*)
1277     (let ((old (edict-get-rule-from-syntax-type name s)))
1278       (when old
1279         (setf (edict-syntax-type-rules s)
1280               (delq old (edict-syntax-type-rules s)))))))
1281
1282 ;(defun edict-decircularize-rules ()
1283 ;  (interactive)
1284 ;  (dolist (s *edict-syntax-types*)
1285 ;    (dolist (r (edict-syntax-type-rules s))
1286 ;      (setf (edict-rule-from-syntax-types r)
1287 ;           (mapcar (function (lambda (type)
1288 ;                               (if (symbolp type)
1289 ;                                   type
1290 ;                                 (edict-syntax-type-name type))))
1291 ;                   (edict-rule-from-syntax-types r)))
1292 ;      (setf (edict-rule-to-syntax-types r)
1293 ;           (mapcar (function (lambda (type)
1294 ;                               (if (symbolp type)
1295 ;                                   type
1296 ;                                 (edict-syntax-type-name type))))
1297 ;                   (edict-rule-to-syntax-types r))))))
1298 ;
1299 ;(defun edict-circularize-rules ()
1300 ;  (interactive)
1301 ;  (dolist (s *edict-syntax-types*)
1302 ;    (dolist (r (edict-syntax-type-rules s))
1303 ;      (setf (edict-rule-from-syntax-types r)
1304 ;           (mapcar (function (lambda (type)
1305 ;                               (if (symbolp type)
1306 ;                                   (get-edict-syntax-type type)
1307 ;                                 type)))
1308 ;                   (edict-rule-from-syntax-types r)))
1309 ;      (setf (edict-rule-to-syntax-types r)
1310 ;           (mapcar (function (lambda (type)
1311 ;                               (if (symbolp type)
1312 ;                                   (get-edict-syntax-type type)
1313 ;                                 type)))
1314 ;                   (edict-rule-to-syntax-types r))))))
1315
1316 (defun edict-add-rule (name rule)
1317   (edict-delete-rule name)
1318   (dolist (s (edict-rule-from-syntax-types rule))
1319     (push rule (edict-syntax-type-rules s))))
1320
1321 (defun edict-get-rule-from-syntax-type (name syntax-type)
1322   (catch 'edict-get-rule
1323     (dolist (rule (edict-syntax-type-rules syntax-type))
1324       (if (eq name (edict-rule-name rule))
1325           (throw 'edict-get-rule rule)))))
1326
1327 (defmacro define-edict-rule (name pattern fromto function &rest additional-args)
1328   ;; First, some compatibility stuff.
1329   (let ((filter nil)
1330         (from nil)
1331         (to nil))
1332     (when (stringp fromto)
1333       (setq filter fromto
1334             fromto nil))
1335     (when (null fromto)
1336       (setq fromto '(ÆüËܸì ÆüËܸì)))
1337     (setq from (first fromto)
1338           to (second fromto))
1339     (unless (listp from)
1340       (setq from (list from)))
1341     (unless (listp to)
1342       (setq to (list to)))
1343     (unless (string-match "^\\^\\|\\$$" pattern)
1344       (error "Rule %s: pattern must start with ^ or end with $: \"%s\""
1345              name pattern))
1346     (when filter
1347       (unless (stringp filter)
1348         (error "Rule %s: filter must be a regexp"
1349                name)))
1350     (` (define-edict-rule-internal '(, name) '(, pattern) '(, filter)
1351          '(, from) '(, to)
1352          (function (, function)) (function (, additional-args))))))
1353
1354 (defun define-edict-rule-internal (name pattern filter 
1355                                         from-syntax-types to-syntax-types
1356                                         function additional-args)
1357   (unless (string-match "^\\^\\|\\$$" pattern)
1358     (error "Rule %s: pattern must start with ^ or end with $: \"%s\""
1359            name pattern))
1360   (when filter
1361     (unless (stringp filter)
1362       (error "Rule %s: filter must be a regexp"
1363              name)))
1364   (let ((from-types nil)
1365         (to-types nil))
1366     (dolist (f from-syntax-types)
1367       (push (get-edict-syntax-type f) from-types))
1368     (dolist (to to-syntax-types)
1369       (push (get-edict-syntax-type to) to-types))
1370     (edict-add-rule name 
1371                     (make-edict-rule :name name
1372                                      :pattern pattern
1373                                      :filter filter
1374                                      :from-syntax-types from-types
1375                                      :to-syntax-types to-types
1376                                      :function function
1377                                      :additional-args additional-args))
1378     name))
1379
1380 (defun edict-subst-affix (string &rest affixes)
1381   (let ((x nil)
1382         (i 1)
1383         (prev -1)
1384         (result ""))
1385     (dolist (x affixes)
1386       (let ((pos (match-beginning i)))
1387         (cond ((eq x 'edict-identity))
1388               ((eq x 'edict-ignore)
1389                (setq result (concat result
1390                                     (substring string
1391                                                (max prev 0) (match-beginning i)))
1392                      prev (match-end i)))
1393               ((and (symbolp x) (fboundp x))
1394                (setq result
1395                      (concat result
1396                              (substring string (max prev 0) (match-beginning i))
1397                              (funcall x (substring string
1398                                                    (match-beginning i)
1399                                                    (match-end i))))))
1400               ((not (stringp x))
1401                (error "%s is not a string or function name in edict-subst-affix"
1402                       x))
1403               ((and pos (>= pos prev))
1404                (setq result (concat result
1405                                     (substring string
1406                                                (max prev 0)
1407                                                (match-beginning i))
1408                                     x))
1409                (setq prev (match-end i))))
1410         (incf i)))
1411     (concat result (substring string (max prev 0)))))
1412
1413 ;;; Takes a series of alternating pairs of substitution functions
1414 ;;; and arguments for those substitution functions.  This can be
1415 ;;; used to algorithmically replace certain parts (typically involving
1416 ;;; changing an ¤¤¹Ô to ¤¦¹Ô final character.
1417
1418 (defun edict-subst-modified-affix (string &rest affixes)
1419   (let ((fun nil)
1420         (args nil)
1421         (i 1)
1422         (prev -1)
1423         (result ""))
1424     (while affixes
1425       (setq fun (car affixes)
1426             args (car (cdr affixes))
1427             affixes (cdr (cdr affixes)))
1428       (let ((pos (match-beginning i)))
1429         (cond ((eq fun 'edict-identity))
1430               ((eq fun 'edict-ignore)
1431                (setq result (concat result
1432                                     (substring string
1433                                                (max prev 0)
1434                                                (match-beginning i)))
1435                      prev (match-end i)))
1436               ((not (or (stringp fun) (and (symbolp fun) (fboundp fun))))
1437                (error "%s is not a string or function name in %s" 
1438                       'edict-subst-modified-affix
1439                       x))
1440               ((and pos (>= pos prev))
1441                (setq result (concat result
1442                                     (substring string (max prev 0) pos)
1443                                     (apply fun (substring string 
1444                                                           (match-beginning i)
1445                                                           (match-end i))
1446                                            args)))
1447                (setq prev (max prev (match-end i)))))
1448         (incf i)))
1449     (concat result (substring string (max prev 0)))))
1450
1451 ;;; Ignore this piece
1452 (defun edict-ignore (affix) "")
1453
1454 ;;; Keep this piece
1455 (defun edict-identity (affix) affix)
1456
1457 ;;; Substitute for this piece
1458 (defun edict-subst (affix data)
1459   data)
1460
1461 ;;; More or less a guon table, for converting doshi suffixes.
1462 (defvar *edict-doshi-suffix*
1463   '(["¤ï" "¤¤" "¤¦" "¤¨" "¤ª"];; u -> wa; kau->kawanai
1464     ["¤«" "¤­" "¤¯" "¤±" "¤³"]
1465     ["¤¬" "¤®" "¤°" "¤²" "¤´"]
1466     ["¤µ" "¤·" "¤¹" "¤»" "¤½"]
1467     ["¤¶" "¤¸" "¤º" "¤¼" "¤¾"]
1468     ["¤¿" "¤Á" "¤Ä" "¤Æ" "¤È"]
1469     ["¤À" "¤Â" "¤Å" "¤Ç" "¤É"]
1470     ["¤Ê" "¤Ë" "¤Ì" "¤Í" "¤Î"]
1471     ["¤Ï" "¤Ò" "¤Õ" "¤Ø" "¤Û"]
1472     ["¤Ð" "¤Ó" "¤Ö" "¤Ù" "¤Ü"]
1473     ["¤Ñ" "¤Ô" "¤×" "¤Ú" "¤Ý"]
1474     ["¤Þ" "¤ß" "¤à" "¤á" "¤â"]
1475     ["¤é" "¤ê" "¤ë" "¤ì" "¤í"]))
1476
1477 (defun edict-modify-verb (suffix from to)
1478   (catch 'exit
1479     (dolist (b *edict-doshi-suffix*)
1480       (if (equal suffix (aref b from))
1481           (throw 'exit (aref b to))))
1482     (throw 'skip-rule nil)))
1483
1484 ;;; Set this to true for debugging.
1485 (defvar *edict-expand-string-trace* nil)  
1486
1487 ;;; This returns a list of the results of applying all rules whose
1488 ;;; patterns match, to all levels of recursion.
1489 (defun edict-expand-string (string &optional others previous syntax)
1490   (let* ((result nil)
1491          (syntax (or syntax 'ÆüËܸì))
1492          (stype (get-edict-syntax-type syntax)))
1493     (dolist (rule (edict-syntax-type-rules stype))
1494       (when (string-match (edict-rule-pattern rule) string)
1495         (catch 'skip-rule
1496           (unless (and previous
1497                        (edict-rule-filter rule)
1498                        (edict-filter-rule rule previous))
1499             (let ((temp (apply (edict-rule-function rule) string
1500                                (edict-rule-additional-args rule))))
1501               (unless (or (equal temp string)
1502                           (edict-find temp others)
1503                           (edict-find temp result))
1504                 (when *edict-expand-string-trace*
1505                   (read-string (format "%s: %s -> %s -:" 
1506                                        (edict-rule-name rule)
1507                                        string temp)))
1508                 (setq result
1509                       (edict-union (edict-expand-string-recurse
1510                                     temp (cons string (append result others))
1511                                     string rule)
1512                                    result))))))))
1513     (if (edict-find string result)
1514         result
1515       (cons string result))))
1516
1517 (defun edict-expand-string-recurse (string others previous rule)
1518   (edict-expand-string-syntaxes string others previous 
1519                                 (edict-rule-to-syntax-types rule)))
1520
1521 (defun edict-expand-string-syntaxes (string others previous syntaxes)
1522   (let ((result nil))
1523     (dolist (syntax syntaxes)
1524       (setq result
1525             (edict-union (edict-expand-string string
1526                                               (append result others)
1527                                               previous
1528                                               syntax)
1529                          result)))
1530     result))
1531
1532
1533 ;;; Returns T if the rule should not be run, because of the past
1534 ;;; history of expansions.  I.e. if something started out with ¤¯
1535 ;;; on the end, and we've made it into an adjective, we should disable
1536 ;;; any expansions based on it being a the conjunctive/stem form of a verb.
1537 ;;; This is done purely based on the most immediately preceding expansion,
1538 ;;; because that is what determined the sense of the word.
1539
1540 (defun edict-filter-rule (rule previous)
1541   (let ((filter (edict-rule-filter rule)))
1542     (cond ((null filter) nil)
1543           ((null previous) nil)
1544           ((stringp filter)
1545            (string-match filter previous))
1546           ((symbolp filter)
1547            (funcall filter frob))
1548           ((consp filter)
1549            (apply (car filter) frob (cdr filter)))
1550           (t (error "Bogus filter in rule %s: %s" (edict-rule-name rule) filter)))))
1551
1552
1553 (defun edict-find (elt list)
1554   (catch 'edict-find
1555     (dolist (test list)
1556       (when (equal elt test)
1557         (throw 'edict-find test)))))
1558
1559 (defun edict-union (set1 set2)
1560   (let ((result set2))
1561     (dolist (frob set1)
1562       (unless (edict-find frob set2)
1563         (setq result (cons frob result))))
1564     result))
1565
1566 ;;; The syntax of the rules is:
1567 ;;; (define-edict-rule name <pattern> <conversion-function> <conversion-data>).
1568 ;;; 
1569 ;;;  <pattern> is a regular expression, with the parts to be substituted
1570 ;;;  being denoted by \\(<subpattern>\\).
1571 ;;; 
1572 ;;;  <conversion function> is a funtion responsible for determining the replacements.
1573 ;;;  The current choices are edict-subst-modified-affix and edict-subst-affix.
1574 ;;;  These functions are called just after doing match-string, so the regexp variables
1575 ;;;  are set up.  They are applied to the string, and <conversion-data>.  These functions
1576 ;;;  are responsible for determining and performing the substitutions to be made, and
1577 ;;;  returning a list of possiblities.
1578 ;;; 
1579 ;;;  edict-subst-affix is the simpler case.  It takes as conversion data one string
1580 ;;;  for each subpattern in the pattern.  This string will be used in place of the
1581 ;;;  original.
1582 ;;; 
1583 ;;;  edict-subst-modified-affix takes as conversion data, an alternating list of
1584 ;;;  functions and lists of additional arguments for those functions.  Each function
1585 ;;;  is applied to the substring being replaced and its additional arguments.
1586 ;;;  Likely functions to use include edict-modify-verb, edict-ignore, and edict-subst.
1587
1588 ;;; Strip "¤¤¤Þ¤¹"
1589 (define-edict-rule ¡Ö¤¤¤Þ¤¹¡×¤òºï½ü¤¹¤ë
1590   "\\(\\cc\\|\\ch\\)\\([¤¤¤­¤®¤·¤Á¤Ë¤Ó¤ß¤ê]\\)\\(¤Þ\\(¤¹\\|¤»¤ó\\)\\)$"
1591   "¤Þ¤»¤ë$"
1592   edict-subst-modified-affix
1593   edict-identity ()
1594   edict-modify-verb (1 2)
1595   edict-ignore ())
1596
1597 (define-edict-rule ¡Ö¤Þ¤¹¡×¤òºï½ü¤¹¤ë
1598   "\\(\\cc\\|[¤¤¤­¤®¤·¤Á¤Ë¤Ó¤ß¤ê¤¨¤±¤²¤»¤Æ¤Í¤Ù¤á¤ì]\\)\\(¤Þ\\(¤¹\\|¤»¤ó\\)\\)$"
1599   "¤Þ¤»¤ë$"
1600   edict-subst-affix edict-identity "¤ë")
1601
1602 (define-edict-rule ¡ÖÍè¤Þ¤¹¡×¤ÎÆÃÊ̥롼¥ë
1603   "\\(Íè¤Þ\\(¤¹\\|¤»¤ó\\)\\)$"
1604   ()
1605   edict-subst-affix "Íè¤ë")
1606
1607 (define-edict-rule ¡Ö¤­¤Þ¤¹¡×¤ÎÆÃÊ̥롼¥ë
1608   "\\(^\\|¤Æ\\|¤ó¤Ç\\)\\(¤­¤Þ\\(¤¹\\|¤»¤ó\\)\\)$"
1609   "¤Þ¤»¤ë$"
1610   edict-subst-modified-affix
1611   edict-identity ()
1612   edict-subst ("¤¯¤ë"))
1613
1614 (define-edict-rule ¡Ö¤·¤Þ¤¹¡×¤ÎÆÃÊ̥롼¥ë
1615   "\\(¤·¤Þ\\(¤¹\\|¤»¤ó\\)\\)$"
1616   ()
1617   edict-subst-affix "¤¹¤ë")
1618
1619 ;;; The several cases of ¤Æ¡¿¤Ã¤Æ.
1620 ;;;  Note either pattern may generate multiple possibilities.
1621 ;;; Also, ¤¿.
1622 (define-edict-rule ¡Ö¤Æ¡¿¤¿¡×¤«¤é¡Ö¤¦¡×¤Þ¤ÇÊÑ´¹¤¹¤ë
1623   "\\(¤Ã\\(¤Æ\\|¤¿[¤é]?\\)\\)$" 
1624   ()
1625   edict-subst-affix "¤¦")
1626
1627 (define-edict-rule ¡Ö¤Æ¡¿¤¿¡×¤«¤é¡Ö¤Ä¡×¤Þ¤ÇÊÑ´¹¤¹¤ë
1628   "\\(¤Ã\\(¤Æ\\|¤¿[¤é]?\\)\\)$" 
1629   ()
1630   edict-subst-affix "¤Ä")
1631 (define-edict-rule ¡Ö¤Æ¡¿¤¿¡×¤«¤é¡Ö¤ë¡×¤Þ¤ÇÊÑ´¹¤¹¤ë
1632   "\\(¤Ã\\(¤Æ\\|¤¿[¤é]?\\)\\)$" 
1633   ()
1634   edict-subst-affix "¤ë")
1635 (define-edict-rule °ìÃʤΡ֤ơ¿¤¿¡×¤«¤é¡Ö¤ë¡×¤Þ¤ÇÊÑ´¹¤¹¤ë
1636   "\\(\\cc\\|[¤¤¤­¤®¤·¤Á¤Ë¤Ó¤ß¤ê¤¨¤±¤²¤»¤Æ¤Í¤Ù¤á¤ì]\\)\\(\\(¤Æ\\|¤¿[¤é]?\\)\\)$" 
1637   ()
1638   edict-subst-affix edict-identity "¤ë")
1639 (define-edict-rule ¡Ö¤Æ¡¿¤¿¡×¤«¤é¡Ö¤¹¡×¤Þ¤ÇÊÑ´¹¤¹¤ë
1640   "\\(¤·\\(¤Æ\\|¤¿[¤é]?\\)\\)$" 
1641   ()
1642   edict-subst-affix "¤¹")
1643 (define-edict-rule ¡Ö¤Æ¡¿¤¿¡×¤«¤é¡Ö¤¯¡×¤Þ¤ÇÊÑ´¹¤¹¤ë
1644   "\\(¤¤\\(¤Æ\\|¤¿[¤é]?\\)\\)$" 
1645   ()
1646   edict-subst-affix "¤¯")
1647 (define-edict-rule ¡Ö¤Æ¡¿¤¿¡×¤«¤é¡Ö¤°¡×¤Þ¤ÇÊÑ´¹¤¹¤ë
1648   "\\(¤¤[¤Ç¤À]\\)$" 
1649   ()
1650   edict-subst-affix "¤°")
1651 (define-edict-rule ¡Ö¤Æ¡¿¤¿¡×¤«¤é¡Ö¤Ö¡×¤Þ¤ÇÊÑ´¹¤¹¤ë
1652   "\\(¤ó\\(¤Ç\\|¤À[¤é]?\\)\\)$" 
1653   ()
1654   edict-subst-affix "¤Ö")
1655 (define-edict-rule ¡Ö¤Æ¡¿¤¿¡×¤«¤é¡Ö¤à¡×¤Þ¤ÇÊÑ´¹¤¹¤ë
1656   "\\(¤ó\\(¤Ç\\|¤À[¤é]?\\)\\)$" 
1657   ()
1658   edict-subst-affix "¤à")
1659 (define-edict-rule ¡Ö¤Æ¡¿¤¿¡×¤«¤é¡Ö¤Ì¡×¤Þ¤ÇÊÑ´¹¤¹¤ë
1660   "\\(¤ó\\(¤Ç\\|¤À[¤é]?\\)\\)$" 
1661   ()
1662   edict-subst-affix "¤Ì")
1663
1664 ;;; ¹Ô¤¯ is an irregular verb.
1665 (define-edict-rule ¹Ô¤¯¤ÎÆÃÊ̥롼¥ë
1666   "¹Ô\\(¤Ã\\(¤Æ\\|¤¿[¤é]?\\)\\)$"
1667   ()
1668   edict-subst-affix "¤¯")
1669
1670 (define-edict-rule ¡ÖÍè¤Æ¡×¤ÎÆÃÊ̥롼¥ë
1671   "Íè\\(¤Æ\\|¤¿[¤é]?\\)$"
1672   ()
1673   edict-subst-affix "Íè¤ë")
1674
1675 (define-edict-rule ¡Ö¤­¤Æ¡×¤ÎÆÃÊ̥롼¥ë
1676   "\\(¤­¤Æ\\|¤­¤¿[¤é]?\\)$"
1677   ()
1678   edict-subst-affix "¤¯¤ë")
1679
1680 (define-edict-rule ¡Ö¤·¤Æ¡×¤ÎÆÃÊ̥롼¥ë
1681   "\\(¤·¤Æ\\|¤·¤¿[¤é]?\\)$"
1682   ()
1683   edict-subst-affix "¤¹¤ë")
1684
1685 ;;; Potential form.
1686 ;;; The filters here are due to ¡Ö°ìÃʤΡ֤ơ¿¤¿¡×¤«¤é¡Ö¤ë¡×¤Þ¤ÇÊÑ´¹¤¹¤ë¡×
1687
1688 (define-edict-rule ¤ì¤ë  "\\(\\cc\\|\\ch\\)\\(¤ì¤ë\\)$"
1689   "¤ì¤Æ$"
1690   edict-subst-affix edict-identity "¤ë")
1691 (define-edict-rule ¤±¤ë "\\(\\cc\\|\\ch\\)\\(¤±¤ë\\)$"
1692   "¤±¤Æ$"
1693   edict-subst-affix edict-identity "¤¯")
1694 (define-edict-rule ¤»¤ë "\\(\\cc\\|\\ch\\)\\(¤»¤ë\\)$"
1695   "¤»¤Æ$"
1696   edict-subst-affix edict-identity "¤¹")
1697 (define-edict-rule ¤Æ¤ë "\\(\\cc\\|\\ch\\)\\(¤Æ¤ë\\)$"
1698   "\\(¤Æ\\|¤Æ¤é¤ì¤ë\\)$"
1699   edict-subst-affix edict-identity "¤Ä")
1700 (define-edict-rule ¤Í¤ë "\\(\\cc\\|\\ch\\)\\(¤Í¤ë\\)$"
1701   "¤Í¤Æ"
1702   edict-subst-affix edict-identity "¤Ì")
1703 (define-edict-rule ¤á¤ë "\\(\\cc\\|\\ch\\)\\(¤á¤ë\\)$"
1704   "¤á¤Æ"
1705   edict-subst-affix edict-identity "¤à")
1706 (define-edict-rule ¤¨ "\\(\\cc\\|\\ch\\)\\(¤¨¤ë\\)$"
1707   "¤¨¤Æ"
1708   edict-subst-affix edict-identity "¤¦")
1709 (define-edict-rule ¤²¤ë "\\(\\cc\\|\\ch\\)\\(¤²¤ë\\)$"
1710   "¤±¤Æ"
1711   edict-subst-affix edict-identity "¤°")
1712 (define-edict-rule ¤Ù¤ë "\\(\\cc\\|\\ch\\)\\(¤Ù¤ë\\)$"
1713   "¤Ù¤Æ"
1714   edict-subst-affix edict-identity "¤Ö")
1715
1716 ;;; °ìÃÊÆ°»ì¡£ Also serves for the passive.
1717 (define-edict-rule ¤é¤ì¤ë
1718   "\\(\\cc\\|[¤¤¤­¤®¤·¤Á¤Ë¤Ó¤ß¤ê¤¨¤±¤²¤»¤Æ¤Í¤Ù¤á¤ì]\\)\\(¤é¤ì¤ë\\)$"
1719   ()
1720   edict-subst-affix edict-identity "¤ë")
1721
1722 ;;; Passive
1723 (define-edict-rule ¸ÞÃÊÆ°»ì¤Î¡Ö¤¢¤ì¤ë¡×¤òÊÑ´¹¤¹¤ë 
1724   "\\([¤ï¤«¤¬¤µ¤¿¤Ê¤Þ¤Ð¤é]\\)\\(¤ì¤ë\\)$"
1725   ()
1726   edict-subst-modified-affix
1727   edict-modify-verb (0 2)
1728   edict-ignore ())
1729
1730 (define-edict-rule Íè¤é¤ì¤ë¤Î¥ë¡¼¥ë
1731   "Íè\\(¤é¤ì¤ë\\)$"
1732   ()
1733   edict-subst-affix "¤ë")
1734
1735 (define-edict-rule ¤µ¤ì¤ë¤Î¥ë¡¼¥ë
1736   "\\(¤µ¤ì¤ë\\)$"
1737   ()
1738   edict-subst-affix "¤¹¤ë")
1739
1740 ;;; Causitive
1741 (define-edict-rule ¸ÞÃÊÆ°»ì¤Î¡Ö¤¢¤»¤ë¡×¤òÊÑ´¹¤¹¤ë 
1742   "\\([¤ï¤«¤¬¤µ¤¿¤Ê¤Þ¤Ð¤é]\\)\\(¤»¤ë\\)$"
1743   ()
1744   edict-subst-modified-affix
1745   edict-modify-verb (0 2)
1746   edict-ignore ())
1747
1748 (define-edict-rule °ìÃÊÆ°»ì¤Î¡Ö¤¢¤»¤ë¡×¤òÊÑ´¹¤¹¤ë 
1749   "\\(\\cc\\|[¤¤¤­¤®¤·¤Á¤Ë¤Ó¤ß¤ê¤¨¤±¤²¤»¤Æ¤Í¤Ù¤á¤ì]\\)\\(¤µ¤»¤ë\\)$"
1750   ()
1751   edict-subst-affix edict-identity "¤ë")
1752
1753 (define-edict-rule ¤µ¤»¤ë¤Î¥ë¡¼¥ë
1754   "\\(¤µ¤»¤ë\\)$"
1755   ()
1756   edict-subst-affix "¤¹¤ë")
1757
1758 ;;; eba conditional form.
1759 (define-edict-rule ¡Ö¤¨¤Ð¡×¤òÊÑ´¹¤¹¤ë "\\([¤¨¤±¤²¤»¤Æ¤Í¤Ù¤á¤ì]\\)\\(¤Ð\\)$"
1760   ()
1761   edict-subst-modified-affix
1762   edict-modify-verb (3 2)
1763   edict-ignore ())
1764
1765 ;;; tara conditional form is handled as part of the ¤Æ¡¿¤¿¡¿¤¿¤é rules.
1766
1767 ;;; The informal negative form.
1768 (define-edict-rule ¡Ö¤Ê¤¤¡×¤òÊÑ´¹¤¹¤ë "\\([¤ï¤«¤¬¤µ¤¿¤Ê¤Þ¤Ð¤é]\\)\\(¤Ê¤¤\\|¤º\\)$"
1769   ()
1770   edict-subst-modified-affix
1771   edict-modify-verb (0 2)
1772   edict-ignore ())
1773
1774 (define-edict-rule °ìÃʤΡ֤ʤ¤¡×¤òÊÑ´¹¤¹¤ë
1775   "\\(\\cc\\|[¤¤¤­¤®¤·¤Á¤Ë¤Ó¤ß¤ê¤¨¤±¤²¤»¤Æ¤Í¤Ù¤á¤ì]\\)\\(¤Ê¤¤\\|¤º\\)$"
1776   ()
1777   edict-subst-affix edict-identity "¤ë")
1778
1779 (define-edict-rule ¡Ö¤·¤Ê¤¤¡×¤ÎÆÃÊ̥롼¥ë
1780   "\\(¤·¤Ê¤¤\\|¤»¤º\\)$"
1781   ()
1782   edict-subst-affix "¤¹¤ë")
1783
1784 (define-edict-rule ¡Ö¤Ê¤¤¡×¤ÎÆÃÊ̥롼¥ë
1785   "^\\(¤Ê¤¤\\)$"
1786   ()
1787   edict-subst-affix "¤¢¤ë")
1788
1789 ;;; Conjunctive form
1790
1791 (define-edict-rule °ìÃʤÎconjunctive
1792   "\\(\\cc\\|\\ch\\)[¤¤¤­¤®¤·¤Á¤Ë¤Ó¤ß¤ê¤¨¤±¤²¤»¤Æ¤Í¤Ù¤á¤ì]\\(\\)$"
1793   "¤¯$\\|¤«¤Ã¤¿$\\|¤¯¤ë$\\|¤¯¤ì¤ë$\\|¤¯¤À¤µ¤¤$\\|¤¢¤²¤ë$\\|¾å¤²¤ë$\\|¤·¤Þ¤¦$\\|¤¯¤Æ$\\|¤¯¤Ê¤¤$\\|¤±¤ì¤Ð$\\|¤¤¤ë$\\|¤«¤é¤º$\\|¤¤¤Þ¤¹$\\|¤¢¤ë$\\|¤ß¤ë$\\|²¼¤µ¤¤$\\|¤Ê¤µ¤¤$\\|¤ä¤ë$\\|¤â¤é¤¦$"
1794   edict-subst-modified-affix
1795   edict-identity ()
1796   edict-subst ("¤ë"))
1797
1798 (define-edict-rule ¸ÞÃʤÎconjunctive
1799   "\\(\\cc\\|\\ch\\)\\([¤¤¤­¤®¤·¤Á¤Ë¤Ó¤ß¤ê]\\)$"
1800   "¤¯$\\|¤«¤Ã¤¿$\\|¤¯¤ë$\\|¤¯¤ì¤ë$\\|¤¯¤À¤µ¤¤$\\|¤¢¤²¤ë$\\|¾å¤²¤ë$\\|¤·¤Þ¤¦$\\|¤¯¤Æ$\\|¤¯¤Ê¤¤$\\|¤±¤ì¤Ð$\\|¤¤¤ë$\\|¤«¤é¤º$\\|¤¤¤Þ¤¹$\\|¤¢¤ë$\\|¤ß¤ë$\\|²¼¤µ¤¤$\\|¤Ê¤µ¤¤$\\|¤ä¤ë$\\|¤â¤é¤¦$"
1801   edict-subst-modified-affix
1802   edict-identity ()
1803   edict-modify-verb (1 2))
1804
1805 (define-edict-rule ¡Ö¤¹¤ë¡×¤ÎÆÃÊÌconjunctive
1806   "\\(\\cc\\|\\ch\\|\\ck\\|\\cK\\)\\(¤·\\)$"
1807   "¤¹$"
1808   edict-subst-affix edict-identity "¤¹¤ë")
1809
1810 (define-edict-rule ¡Ö¤¸¤ë¡×¤ÎÆÃÊÌconjunctive
1811   "\\(\\cc\\|\\ch\\)\\(¤¸\\)$"
1812   ()
1813   edict-subst-affix edict-identity "¤¸¤ë")
1814
1815 (define-edict-rule ¡Ö¤º¤ë¡×¤ÎÆÃÊÌconjunctive
1816   "\\(\\cc\\|\\ch\\)\\(¤¸\\)$"
1817   ()
1818   edict-subst-affix edict-identity "¤º¤ë")
1819
1820 ;;; The informal imperative form, ¸ÞÃÊÆ°»ì
1821 (define-edict-rule ¡Ö¤ì¡×¤Î¸ÞÃÊÆ°»ì¤òÊÑ´¹¤¹¤ë 
1822   "\\(\\cc\\|\\ch\\)\\([¤¨¤±¤²¤»¤Æ¤Í¤Ù¤á¤ì]\\)$"
1823   ()
1824   edict-subst-modified-affix
1825   edict-identity ()
1826   edict-modify-verb (3 2))
1827
1828 ;;; The informal imperative form, °ìÃÊÆ°»ì
1829 (define-edict-rule ¡Ö¤í¡×¤Î°ìÃÊÆ°»ì¤òÊÑ´¹¤¹¤ë
1830   "\\(\\cc\\|[¤¤¤­¤®¤·¤Á¤Ë¤Ó¤ß¤ê¤¨¤±¤²¤»¤Æ¤Í¤Ù¤á¤ì]\\)\\(¤í\\)$"
1831   ()
1832   edict-subst-affix edict-identity "¤ë")
1833
1834 ;;; Irregulars
1835 (define-edict-rule ¡ÖÍ褤¡×¤ÎÆÃÊ̥롼¥ë
1836   "^\\(Í褤\\)$"
1837   ()
1838   edict-subst-affix "Íè¤ë")
1839 (define-edict-rule ¡Ö¤³¤¤¡×¤ÎÆÃÊ̥롼¥ë
1840   "^\\(¤³¤¤\\)$"
1841   "¤¯$"
1842   edict-subst-affix "¤¯¤ë")
1843
1844 (define-edict-rule ¡Ö¤·¤í¡×¤ÎÆÃÊ̥롼¥ë
1845   "^\\(¤·¤í\\)$"
1846   ()
1847   edict-subst-affix "¤¹¤ë")
1848
1849 ;;; The plain desiderative
1850 (define-edict-rule ¡Ö¤¿¤¤¡×¤òºï½ü¤¹¤ë 
1851   "\\(\\cc\\|\\ch\\)\\([¤¤¤­¤®¤·¤Á¤Ë¤Ó¤ß¤ê]\\)\\(¤¿¤¤\\|¤¿¤¬¤ë\\)$"
1852   ()
1853   edict-subst-modified-affix
1854   edict-identity ()
1855   edict-modify-verb (1 2)
1856   edict-ignore ())
1857
1858 (define-edict-rule °ìÃʤΡ֤¿¤¤¡×¤òºï½ü¤¹¤ë
1859   "\\(\\cc\\|[¤¤¤­¤®¤·¤Á¤Ë¤Ó¤ß¤ê¤¨¤±¤²¤»¤Æ¤Í¤Ù¤á¤ì]\\)\\(¤¿¤¤\\|¤¿¤¬¤ë\\)$"
1860   ()
1861   edict-subst-affix edict-identity "¤ë")
1862
1863 (define-edict-rule ¡Ö¤·¤¿¤¤¡×¤ÎÆÃÊ̥롼¥ë
1864   "^\\(¤·¤¿¤¤\\|¤·¤¿¤¬¤ë\\)$"
1865   ()
1866   edict-subst-affix "¤¹¤ë")
1867
1868 (define-edict-rule ¡ÖÍ褿¤¤¡×¤ÎÆÃÊ̥롼¥ë
1869   "^\\(Í褿¤¤\\|Í褿¤¬¤ë\\)$"
1870   ()
1871   edict-subst-affix "Íè¤ë")
1872 (define-edict-rule ¡Ö¤­¤¿¤¤¡×¤ÎÆÃÊ̥롼¥ë
1873   "^\\(¤­¤¿¤¤\\|¤­¤¿¤¬¤ë\\)$"
1874   ()
1875   edict-subst-affix "¤¯¤ë")
1876
1877 ;;; Flush auxilliary verbs after te form.
1878 (define-edict-rule ½õÆ°»ì¡¼£±
1879   "\\(\\cc\\|\\ch\\)\\(¤¯\\|¤Æ\\|¤ó¤Ç\\)\\(¤¤¤ë\\|¤ª¤ë\\|¤¤¤Þ¤¹\\|¤¢¤ë\\|¤ª¤¯\\|¤ß¤ë\\)$"
1880   ()
1881   edict-subst-modified-affix
1882   edict-identity ()
1883   edict-identity ()
1884   edict-ignore ())
1885
1886 (define-edict-rule ½õÆ°»ì¡¼£±£á
1887   "\\(\\cc\\|\\ch\\)\\(¤Æ\\|¤ó¤Ç\\)\\(¤ë\\)$"
1888   ()
1889   edict-subst-modified-affix
1890   edict-identity ()
1891   edict-identity ()
1892   edict-ignore ())
1893
1894 (define-edict-rule ½õÆ°»ì¡¼£²
1895   "\\(\\cc\\|\\ch\\)\\(¤¯\\|¤Æ\\|¤ó¤Ç\\)\\(²¼¤µ¤¤\\|¤¯¤À¤µ¤¤\\|¤Ê¤µ¤¤\\|¤¤¤¯\\|¹Ô¤¯\\|¤¯¤ë\\|Íè¤ë\\)$"
1896   ()
1897   edict-subst-modified-affix
1898   edict-identity ()
1899   edict-identity ()
1900   edict-ignore ())
1901
1902 (define-edict-rule ½õÆ°»ì¡¼£³
1903   "\\(\\cc\\|\\ch\\)\\(¤¯\\|¤Æ\\|¤ó¤Ç\\)\\(\\([¤µº¹]¤·\\)?[¤¢¾å]¤²¤ë\\|¤ä¤ë\\|¤â¤é¤¦\\|¤¤¤¿¤À¤¯\\|ĺ¤¯\\|¤¯¤ì¤ë\\|¤¯¤À¤µ¤ë\\)$"
1904   ()
1905   edict-subst-modified-affix
1906   edict-identity ()
1907   edict-identity ()
1908   edict-ignore ())
1909
1910 (define-edict-rule ½õÆ°»ì¡¼£´
1911   "\\(\\cc\\|\\ch\\)\\(¤¯\\|¤Æ\\|¤ó¤Ç\\)\\(¤¹¤ë\\|À®¤ë\\|¤Ê¤ë\\|¤·¤Þ¤¦\\)$"
1912   ()
1913   edict-subst-modified-affix
1914   edict-identity ()
1915   edict-identity ()
1916   edict-ignore ())
1917
1918 (define-edict-rule modifiers
1919   "\\(\\cc\\|\\ch\\)[¤¤¤¿¤¦¤¯¤°¤¹¤Ä¤Ì¤Ö¤à¤ë]\\(¤é¤·¤¤\\|¤½¤¦\\|¤è¤¦\\)$"
1920   ()
1921   edict-subst-affix edict-identity "")
1922
1923 (define-edict-rule humble
1924   "\\(¤ª\\)\\(\\cc\\|\\ch\\)+\\([¤¤¤­¤®¤·¤Á¤Ë¤Ó¤ß¤ê]\\)\\(¤ËÀ®¤ë\\|¤Ë¤Ê¤ë\\|¤¹¤ë\\|¤¤¤¿¤¹\\|¿½¤·¾å¤²¤ë\\|¤â¤¦¤·¤¢¤²¤ë\\)$"
1925   ()
1926   edict-subst-modified-affix
1927   edict-ignore ()
1928   edict-identity ()
1929   edict-modify-verb (1 2)
1930   edict-ignore ())
1931
1932 ;;; Volitional
1933 (define-edict-rule ¸ÞÃʤΡ֤ª¤¦¡×
1934   "\\(\\cc\\|\\ch\\)\\([¤ª¤³¤´¤½¤È¤Î¤Ü¤â¤í]\\)\\(¤¦\\)$"
1935   ()
1936   edict-subst-modified-affix
1937   edict-identity ()
1938   edict-modify-verb (4 2)
1939   edict-ignore ())
1940
1941 (define-edict-rule °ìÃʤΡ֤褦¡×
1942   "\\(\\cc\\|[¤¤¤­¤®¤·¤Á¤Ë¤Ó¤ß¤ê¤¨¤±¤²¤»¤Æ¤Í¤Ù¤á¤ì]\\)\\(¤è¤¦\\)$"
1943   ()
1944   edict-subst-affix edict-identity "¤ë")
1945
1946 (define-edict-rule ¡ÖÍè¤è¤¦¡×¤ÎÆÃÊ̥롼¥ë
1947   "\\(Íè¤è¤¦\\)$"
1948   ()
1949   edict-subst-affix "Íè¤ë")
1950 (define-edict-rule ¡Ö¤³¤è¤¦¡×¤ÎÆÃÊ̥롼¥ë
1951   "\\(¤³¤è¤¦\\)$"
1952   ()
1953   edict-subst-affix "¤¯¤ë")
1954 (define-edict-rule ¡Ö¤·¤è¤¦¡×¤ÎÆÃÊ̥롼¥ë
1955   "\\(¤·¤è¤¦\\)$"
1956   ()
1957   edict-subst-affix "¤¹¤ë")
1958
1959 (define-edict-rule ¤Æ¤·¤Þ¤¦
1960   "[^¤ó]\\(¤Á¤ã¤¦\\)$"
1961   ()
1962   edict-subst-affix "¤Æ¤·¤Þ¤¦")
1963
1964 (define-edict-rule ¤Ç¤·¤Þ¤¦
1965   "¤ó\\(¤Á¤ã¤¦\\)$"
1966   ()
1967   edict-subst-affix "¤Ç¤·¤Þ¤¦")
1968
1969 ;; Honorific prefixes
1970 (define-edict-rule ·É¸ì¤ÎÀÜƬ¼­
1971   "^\\(¤ª\\|¸æ\\|¤´\\)"
1972   ()
1973   edict-subst-affix "")
1974
1975 ;; Various forms of adjectives.
1976 (define-edict-rule ·ÁÍƻ졼¤¯
1977   "\\(\\cc\\|\\ch\\)\\(¤¯\\)$"
1978   "\\(¤«\\(¤ì¤ë\\|¤»¤ë\\|¤Ê¤¤\\|¤º\\)\\|¤­\\(¤Þ¤¹\\|¤Þ¤»¤ó\\|¤¿¤¤\\|¤Ê¤«¤é\\|¤Ä¤Ä\\|¤ä¤µ¤¤\\|¤Ë¤¯¤¤\\|¤½¤¦¤Ê\\)\\|¤±\\(¤Ð\\|\\|¤ë\\)\\|¤³¤¦\\|¤¤\\(¤¿\\|¤¿¤é\\|¤¿¤ê\\|¤¿¤í¤¦\\|¤Æ\\|¤Æ¤¤¤ë\\)\\)$"
1979   edict-subst-affix edict-identity "¤¤")
1980 (define-edict-rule ·ÁÍƻ졼¤¯¤Æ
1981   "\\(\\cc\\|\\ch\\)\\(¤¯¤Æ\\)$"
1982   ()
1983   edict-subst-affix edict-identity "¤¤")
1984 (define-edict-rule ·ÁÍƻ졼¤¯¤Ê¤¤
1985   "\\(\\cc\\|\\ch\\)\\(¤¯¤Ê¤¤\\)$"
1986   ()
1987   edict-subst-affix edict-identity "¤¤")
1988 (define-edict-rule ·ÁÍƻ졼¤«¤é¤º
1989   "\\(\\cc\\|\\ch\\)\\(¤«¤é¤º\\)$"
1990   ()
1991   edict-subst-affix edict-identity "¤¤")
1992 (define-edict-rule ·ÁÍƻ졼¤«¤Ã¤¿
1993   "\\(\\cc\\|\\ch\\)\\(¤«¤Ã¤¿\\)$"
1994   ()
1995   edict-subst-affix edict-identity "¤¤")
1996 (define-edict-rule ·ÁÍƻ졼¤Ê¤¤
1997   "\\(\\cc\\|\\ch\\)\\(\\(¤¸¤ã\\|¤Ç¤Ï\\)\\(¤Ê¤¤\\|¤¢¤ê¤Þ¤»¤ó\\)\\)$"
1998   ()
1999   edict-subst-affix edict-identity "")
2000 (define-edict-rule ·ÁÍƻ졼¤±¤ì¤Ð
2001   "\\(\\cc\\|\\ch\\)\\(¤±¤ì¤Ð\\)$"
2002   ()
2003   edict-subst-affix edict-identity "¤¤")
2004
2005 ;;; Other affixes
2006
2007 (define-edict-rule other-suffixes
2008   "\\(\\cc\\|\\ch\\)\\(Ū\\|¤Æ¤­\\|¤â¤Î\\|ʪ\\|¼Ô\\|¼°\\|Ãæ\\|°÷\\|¤¹¤ë\\|¤µ¤ó\\|ÀèÀ¸\\|ÍÍ\\|¤µ¤Þ\\|¤Á¤ã¤ó\\|·¯\\|¤¯¤ó\\|²°\\)$"
2009   ()
2010   edict-subst-affix edict-identity "")
2011
2012 (define-edict-rule other-prefixes
2013   "^\\(ºò\\|Íè\\|Á´\\|Ⱦ\\|Ëè\\)\\cc"
2014   ()
2015   edict-subst-affix "")
2016
2017 ;;; Canonicalize number expressions
2018 (define-edict-rule numbers
2019   "^\\([0-9£°-£¹°ìÆ󻰻͸ÞÏ»¼·È¬¶å½½É´ÀéËü²¯]+\\)\\(\\cc\\|\\ch\\)"
2020   ()
2021   edict-subst-affix "°ì" edict-identity )
2022
2023 (define-edict-rule ¿ô¤Ê¤·
2024   "^\\([0-9£°-£¹°ìÆ󻰻͸ÞÏ»¼·È¬¶å½½É´ÀéËü²¯]+\\)\\(\\cc\\|\\ch\\)"
2025   ()
2026   edict-subst-affix edict-ignore edict-identity )
2027
2028 (define-edict-rule ¤À
2029   "\\(¤¸¤ã¤Ê¤¤\\|¤Ç¤Ï¤Ê¤¤\\|¤À¤Ã¤¿\\|¤À¤í¤¦\\)$"
2030   ()
2031   edict-subst-affix "¤À")
2032
2033 (define-edict-rule ¤Ç¤¹
2034   "\\(¤¸¤ã¤¢¤ê¤Þ¤»¤ó\\|¤Ç¤Ï¤¢¤ê¤Þ¤»¤ó\\|¤Ç¤·¤ç¤¦\\)$"
2035   ()
2036   edict-subst-affix "¤Ç¤¹")
2037
2038 (define-edict-rule ¤Ç¤¹/¤À
2039   "\\(¤Ç¤¹\\)$"
2040   ()
2041   edict-subst-affix "¤À")
2042
2043 (define-edict-rule cupola
2044   "\\(\\cc\\|\\ch\\)\\(¤À\\|¤Ç¤¹\\)$"
2045   ()
2046   edict-subst-affix edict-identity edict-ignore)
2047
2048 (define-edict-rule english-plural
2049   "\\([^i][^e]\\|i[^e]\\|[^i]e\\)\\(s\\)$"
2050   (english english-noun)
2051   edict-subst-affix edict-ignore)
2052
2053 (define-edict-rule english-plural-ies
2054   "\\(ies\\)$"
2055   (english english-noun)
2056   edict-subst-affix "y")
2057
2058 (provide 'edict)