cgit.sxemacs.org Git - packages/blob - mule-packages/edict/edict.el

   1 ;; edict.el --- Word lookup (with deinflection) in EDICT
   2
   3 ;; Copyright (C) 1991, 1992 Per Hammarlund (perham@nada.kth.se)
   4 ;; Copyright (C) 1998, 2002 Free Software Foundation, Inc.
   5
   6 ;; Author:      Per Hammarlund <perham@nada.kth.se>
   7 ;; Keywords:    mule, edict, dictionary
   8 ;; Version:     0.9.9
   9 ;; Adapted-by:  Stephen J. Turnbull <stephen@xemacs.org> for XEmacs
  10 ;; Maintainer:  Stephen J. Turnbull <stephen@xemacs.org>
  11
  12 ;;   This file is part of XEmacs.
  13
  14 ;;   XEmacs is free software; you can redistribute it and/or modify it
  15 ;;   under the terms of the GNU General Public License as published by
  16 ;;   the Free Software Foundation; either version 2, or (at your
  17 ;;   option) any later version.
  18
  19 ;;   XEmacs is distributed in the hope that it will be useful, but
  20 ;;   WITHOUT ANY WARRANTY; without even the implied warranty of
  21 ;;   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  22 ;;   General Public License for more details.
  23 ;;
  24 ;;   You should have received a copy of the GNU General Public License
  25 ;;   along with XEmacs; if not, write to the Free Software Foundation,
  26 ;;   Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  27
  28 ;;; Commentary:
  29
  30 ;; Search for translations of English or Japanese terms in Jim Breen's
  31 ;; EDICT free Japanese/English dictionary.
  32
  33 ;; GNU Emacs-compatible editors including GNU Emacs versions 20 and 21
  34 ;; and XEmacs versions 20 and 21 when configured with Mule are supported.
  35 ;; This version is packaged for easy installation and management in XEmacs
  36 ;; versions 21 and above.
  37
  38 ;; Written by Per Hammarlund <perham@nada.kth.se>
  39 ;; Morphology and private dictionary handling/editing by Bob Kerns
  40 ;; <rwk@crl.dec.com>
  41 ;; Helpful remarks from Ken-Ichi Handa <handa@etl.go.jp>.
  42 ;; The EDICT dictionary is maintained by Jim Breen <jwb@monu6.cc.monash.edu.au>
  43
  44 ;; Short getting started guide, this assumes that you have not used
  45 ;; the install script and that you understand the "technical" words
  46 ;; used, if you don't, please read the documentation in edict.doc:
  47
  48 ;; 0. You need a *Japanese-capable Emacs*.  Previous versions of this package
  49 ;;    worked with NEmacs and Emacs with the Mule patchkit, but it is unknown
  50 ;;    whether this version does.  They are not supported, but if you must use
  51 ;;    early versions feel free to ask the maintainers for help.
  52 ;;    You need a *recent version of Per Abrahamsen's "Customize" library."
  53 ;;    You can work around by changing all the `defcustom' calls to `defvar'
  54 ;;
  55 ;; 1. Make sure that you have placed edict.el in a directory that is
  56 ;;    included in the nemacs's search path, look at the variable
  57 ;;    "load-path" to make sure that the directory is in that list.
  58
  59 ;; 2. Add something like this to your .emacs (or .nemacs) file:
  60 ;;      (autoload 'edict-search-english "edict"
  61 ;;                "Search for a translation of an English word")
  62 ;;      (global-set-key "\e*" 'edict-search-english)
  63 ;;      (autoload 'edict-search-kanji "edict"
  64 ;;                "Search for a translation of a Kanji sequence")
  65 ;;      (global-set-key "\e_" 'edict-search-kanji)
  66 ;;      (autoload 'edict-insert "edict" "Insert the last translation")
  67 ;;     (global-set-key "\e+" 'edict-insert)
  68 ;; Note that you can change the key binding to whatever you like,
  69 ;; these are only "examples".
  70
  71 ;; 3. The variable *edict-files* should be a list of filenames of
  72 ;;    edict dictionary files that you want edict to load and search
  73 ;;    in.  The real dictionary EDICTJ should be one of these files,
  74 ;;    you may also have have some local file(s) there.  Something
  75 ;;    like this *may* be appropriate to:
  76 ;;      (setq *edict-files*  '("edictj"
  77 ;;                            "~my-friend-the-user/.edict"
  78 ;;                            "~my-other-friend-the-user/.edict"))
  79 ;;    By default, it searches the load path (the same directories that
  80 ;;    are searched when you do m-X load-file<return>edict<return>),
  81 ;;    for a file named "edictj".
  82
  83 ;; 4. Set the name of your *own* local edictj file.  (Note that this
  84 ;;    file should not be included in the list above!)  Edict will
  85 ;;    include the additions that you do in this file.  The variable
  86 ;;    *edict-private-file* defaults to "~/.edict", if you want
  87 ;;    something else do a:
  88 ;;        (setq *edict-private-file* "~/somewhere/somethingelse/")
  89
  90 ;; (Don't forget to submit your useful words to Jim Breen once in a
  91 ;; while! His address is jwb@monu6.cc.monash.edu.au)
  92
  93 ;; You are done.  Report errors and comments to perham@nada.kth.se.
  94
  95 ;;; To do:
  96
  97 ;; See the file TODO
  98 ;; Testing
  99
 100 ;; edict.el commands
 101
 102 ;; global-map
 103 ;  dui-invoke-search-method  "\C-c $ s"
 104
 105 ;; via "\C-u\C-c$"
 106 ;  ispell-word (external)
 107 ;  edict-search-english
 108 ;  edict-search-kanji
 109 ;  edict-insert
 110 ;
 111 ;; edict-edit-mode-map
 112 ;  edict-standin              default
 113 ;  edict-exit                 "\C-c \C-c", "\C-x \C-s"
 114 ;  edict-tab                  "\t"
 115 ;  edict-new-entry            "\r"
 116 ;  edict-beginning-of-line    "\C-a"
 117 ;  edict-end-of-line          "\C-e"
 118 ;  edict-open-bracket         "["
 119 ;  edict-close-bracket        "]"
 120 ;  edict-slash                "/"
 121
 122 ;; not bound
 123 ;  edict-version
 124 ;  edict-force-init
 125 ;  edict-insert
 126 ;  edict-insert-english
 127 ;  edict-insert-\e$BF|K\8l\e(B
 128 ;  edict-delete-matches-window
 129 ;  edict-edit-mode
 130 ;  edict-add-word
 131 ;  edict-add-english
 132 ;  edict-add-kanji
 133
 134 ;; not fully implemented
 135 ;  edict-decircularize-rules
 136 ;  edict-circularize-rules
 137
 138 ;;; History:
 139 ;;
 140 ;; A full ChangeLog is provided as a separate file.
 141 ;;
 142 ;;      0.9.8          GNU Emacs and XEmacs 21 compatibility release
 143 ;;      0.9.7          XEmacs-beta beta release
 144 ;;      0.9.6-sjt-0.1  Modifications provided by Steven Baur and Olivier
 145 ;;                     Galibert to get it to compile; the character
 146 ;;                     categories for Japanese are not implemented in XEmacs
 147 ;;                     so they are emulated via ranges in variables.
 148 ;;                     Some lisp-mnt.el compatiblity.
 149 ;;                     Changes in spacing, typos, etc, but not major
 150 ;;                     formatting.
 151 ;;                     Change format to comply with lisp-mnt.el
 152 ;;      0.9.6          See ChangeLog.096 for history to this point.
 153
 154 ;;; Code:
 155
 156 ;;; User customization
 157
 158 (defgroup edict nil
 159   "Per Hammarlund's edict.el interface to Jim Breen's EDICT,
 160 an English-Japanese dictionary."
 161   :group 'mule)
 162
 163 ;; Require standard XEmacs packages.
 164
 165 (require 'cl)
 166
 167 ;; Require edict support files
 168
 169 (require 'dui)                          ; method registry and history
 170 (require 'edict-edit)                   ; edict-add-$language functions
 171 (require 'edict-morphology)
 172
 173 ;;; Variables:
 174
 175 (defconst edict-version-date "980524 [\e$BJ?@.\e(B10\e$BG/\e(B5\e$B7n\e(B24\e$BF|\e(B(\e$BLZ\e(B)]"
 176   "The variable edict-version-date contains a string with the
 177 date when this version was released.  In both Swedish and Japanese
 178 standards.")
 179
 180 (defconst edict-version "0.9.8"
 181  "The variable edict-version contains a string that describes
 182  what version of the edict software that you are running.")
 183
 184 (defcustom edict-default-coding-system 'euc-jp
 185   "Default coding system for reading dictionary files.
 186
 187 On Unix systems, EDICT is distributed as an EUC file.  For Windows systems
 188 'shift_jis is may be preferable."
 189   :type 'symbol
 190   :group 'edict)
 191
 192 (defcustom edict-user-dictionary "~/.edict"
 193   "*This is the edict dictionary where the user's entries will be added.
 194
 195 May be a string (filename), or a cons of a filename and a symbol
 196 \(coding system).  Will be searched first in dictionary lookup."
 197   :type '(choice file (cons file symbol))
 198   :group 'edict)
 199
 200 ;; Search paths
 201 (defcustom edict-dictionary-path nil
 202   "List of directories to search for edict dictionaries.
 203
 204 The default value contains only the edict subdirectory of the package
 205 data-directory, or if that is missing the package data-directory itself.
 206 Computed using `locate-data-directory' if available, or `package-path' (if
 207 available) and `data-directory'.
 208
 209 Will not find `<package-root>/<package>/etc'-style data directories."
 210   :type '(repeat directory)
 211   ;; How to create them vary by Emacs version.
 212   ;; This is really ugly.
 213   :initialize
 214   (lambda (symbol ignored)
 215     (unless (default-boundp symbol)
 216       (set-default symbol
 217         (let (path)
 218           (cond
 219            ;; XEmacs 21
 220            ((and (fboundp 'locate-data-directory)
 221                  (setq path (cond ((locate-data-directory "edict"))
 222                                   ((locate-data-directory ""))))))
 223            ;; GNU Emacs and XEmacs 20
 224            (t (dolist
 225                   (dir
 226                    ;; Use data-directory and package-path
 227                    (cons data-directory
 228                          ;; early betas of XEmacs 21 and betas of XEmacs 20.3
 229                          ;; and 20.4 used package-path; "undocumented
 230                          ;; feature" in 20.3 and 20.4 releases
 231                          (mapcar
 232                           ;; nil components of package-path stay nil
 233                           (lambda (dir) (if dir
 234                                             ;; don't add package roots
 235                                             (concat dir "etc/")))
 236                           (reverse (if (boundp 'package-path) package-path))))
 237                    path)
 238                 (if (and dir            ; drop nil components of package-path
 239                          (eq (car (file-attributes dir)) t))
 240                     (progn (setq path (cons dir path))
 241                            (let ((file (expand-file-name "edict" dir)))
 242                              (if (eq (car (file-attributes file)) t)
 243                                  (setq path (cons file path)))))))))
 244           (cond
 245            ((stringp path) (list path))
 246            ((null path)
 247             (message
 248              "Couldn't compute default for `edict-dictionary-path'!")
 249             nil)
 250            ((listp path) path)
 251            (t (message
 252                "Error in computing default for `edict-dictionary-path'!")))))))
 253   :group 'edict)
 254
 255 (defcustom edict-dictionaries '("edict")
 256   "*List of edict dictionary specifications.
 257
 258 A dictionary specification is either a string (file name), or a cons
 259 of a file name and a symbol (coding system).  Relative paths are
 260 searched for in each directory in edict-dictionary-path.
 261
 262 All dictionaries found are loaded into edict-buffer for searching.  Usually at
 263 least one of them should be the main edict file.  Use `edict-user-dictionary'
 264 to specify your private dictionary, not this variable.
 265
 266 The auxiliary dictionaries enamdict (proper names) and kanjidic (kanji
 267 database) may be used.
 268
 269 The up-to-date versions of these dictionaries are all available from
 270 ftp://ftp.monash.edu.au/pub/nihongo.  A very small sample dictionary,
 271 edictj.demo, is provided with this package."
 272   :type '(choice string (cons string symbol))
 273   :group 'edict)
 274
 275 ;;The edict dictionary buffer and its name
 276 (defvar edict-buffer nil
 277   "The buffer containing the concatenated dictionaries.")
 278 (defcustom edict-buffer-name "*edict*"
 279   "The name of `edict-buffer', default \"*edict*\"."
 280   :type 'string
 281   :group 'edict)
 282
 283 ;;The edict matches buffer and its name
 284 (defvar edict-match-buffer nil
 285   "The buffer displaying search results.")
 286 (defcustom edict-match-buffer-name "*edict matches*"
 287   "The name of `edict-match-buffer', default \"*edict matches*\"."
 288   :type 'string
 289   :group 'edict)
 290
 291 ;; #### is this appropriate?
 292 ;;;###autoload
 293 (defun edict-version ()
 294   "The function edict-version simply displays (as a message in the
 295 mini-buffer) the version of the edict software that you are running
 296 at the moment.  The same string is also returned from the function."
 297    (interactive)
 298    (message (concat "Edict version " edict-version  " of " edict-version-date)))
 299
 300 ;; Marker so we can find the individual files in the buffer.
 301 (defconst *edict-file-begin-marker* "<<<<<<<<<<<<<<<<")
 302 (defconst *edict-file-end-marker* ">>>>>>>>>>>>>>>>")
 303
 304 ;; This is the set of characters to be ignored in the middle of kanji
 305 ;; words being looked up.
 306 ;; The \e$B!:\e(B below should be \e$B!{\e(B, but there seems to be an off-by-one error
 307 ;; in the regexp code.
 308 ;; #### The comment above about "off-by-one" may be bogus as there are
 309 ;;      no less than three large circles in ku 1 and 2 of JIS X 0208.
 310 ;; #### The logic seems incorrect.  It is certainly an error to ignore the
 311 ;;      kanji and kana repetition marks (ku 1, ten 19-22,25; ## check if
 312 ;;      these are all!), probably wrong to ignore most punctuation,
 313 ;;      possibly wrong to ignore parentheses and quotation marks (these
 314 ;;      should mark word boundaries.
 315 ;; #### Probably this should be made conditional on a prefix arg,
 316 ;;      possibly with a customizable option to reverse the sense of
 317 ;;      the arg.
 318
 319 (defconst *edict-kanji-whitespace* "\e$B!!\e(B-\e$B!:!=\e(B-\e$B"`\e(B \n\t>;!:#?,.\"/@\e$B(!\e(B-\e$B(@\e(B")
 320
 321 ;; This is the set of characters to be ignored in the middle of english
 322 ;; words being looked up.
 323 ;; #### That comment is misleading, since spaces should indicate word breaks.
 324 ;; The \e$B!:\e(B below should be \e$B!{\e(B, but there seems to be an off-by-one error
 325 ;; in the regexp code.
 326 ;; #### Maybe it's better to filter for `not-eigo'?  Check the code.
 327
 328 (defconst *edict-eigo-whitespace* "\e$B!!\e(B-\e$B!:!=\e(B-\e$B"`\e(B \n\t>;!:#?,.\"/@\e$B(!\e(B-\e$B(@\e(B")
 329
 330 ;; #### This possibly is not correct as it will miss hyphenated words.
 331 ;; #### Can we just steal from ispell?
 332 (defconst *edict-eigo-characters* "[A-Za-z\e$B#A\e(B-\e$B#Z#a\e(B-\e$B#z\e(B]"
 333   "These are the characters that eigo is made up of.")
 334
 335 ;; #### These errors should be warnings.
 336 (defconst *edict-unreadable-error*
 337   "Edict file \"%s\": doesn't exist or isn't readable!")
 338
 339 ;(defvar *edict-non-existent-error*
 340 ;  "While loading edict files: \"%s\" doesn't exist!")
 341
 342 (defconst edict-bad-dict-spec-cons
 343   "In edict-dictionaries: %s - car not string or cdr not coding-system.")
 344
 345 (defconst edict-bad-dict-spec
 346   "In edict-dictionaries: %s - not string or cons.")
 347
 348 (defcustom edict-warn-missing-dictionaries-p t
 349   "Warn about dictionaries specified in edict-dictionaries but not found."
 350   :type 'boolean
 351   :group 'edict)
 352
 353 (defvar edict-missing-dictionaries nil
 354   "List of dictionaries not found at initialization.")
 355
 356 (defvar edict-unreadable-files nil
 357   "List of dictionaries found at initialization but unreadable.")
 358
 359 (defun edict-regularize-file-argument (dict-spec)
 360   "Return dictionary specification in the form (FILE . CODING-SYSTEM).
 361
 362 Argument can be a file name (string) or a cons of a string and a coding
 363 system.
 364
 365 Check for existence and readability of the file specified by the
 366 string component of DICT-SPEC.  Return 'nil if not found and readable."
 367   (let (filename coding-system)
 368     (cond ((stringp dict-spec)
 369            (setq filename dict-spec
 370                  coding-system edict-default-coding-system))
 371           ((consp dict-spec)
 372            (if (not (and (stringp (setq filename (car dict-spec)))
 373                          (coding-system-p
 374                           (setq coding-system
 375                                 ;; #### no `find-coding-system' in GNU Emacs
 376                                 (if (fboundp 'find-coding-system)
 377                                     (find-coding-system (cdr dict-spec))
 378                                   (cdr dict-spec))))))
 379                ;; Just because one spec is in error doesn't mean they
 380                ;; all are.  Tough.
 381                ;; I'm too lazy to be user-friendly here.
 382                (error edict-bad-dict-spec-cons dict-spec)))
 383           (t (error edict-bad-dict-spec dict-spec)))
 384     (catch 'found
 385       (dolist (dir edict-dictionary-path nil)
 386         (let ((file (expand-file-name filename dir)))
 387           (if (file-exists-p file)
 388               (if (file-readable-p file)
 389                   (throw 'found (cons file coding-system))
 390                 (setq edict-unreadable-files
 391                       (concat edict-unreadable-files filename "\n"))))))
 392       (setq edict-missing-dictionaries
 393             (concat edict-missing-dictionaries filename "\n"))
 394       nil)))
 395
 396 (defvar edict-dictionaries-loaded nil
 397   "List of dictionaries loaded into the edict-buffer.")
 398
 399 ;;Reads the edict files (the ones in the list edict-dictionaries) into a buffer
 400 ;; called what the string edict-buffer-name is set to.
 401 ;; #### I don't understand this function.
 402 ;  "Read the edict file into a buffer.
 403
 404 ;The buffer's name is the value of *edict*.  The buffer itself is the
 405 ;value of edict-buffer."
 406
 407 ;Normally initialization is done lazily, and only once.  Use the
 408 ;command edict-force-init to reread the edict files.  It is possible
 409 ;that Mule will incorrectly recognize the coding system in one or more
 410 ;dictionary files.  Customize the variable `file-coding-system-alist'
 411 ;(q.v.).  An entry of the form (FILE-REGEXP . CODING-SYS) is needed for
 412 ;each troublesome file.  For the main dictionary `edict' in EUC-JP
 413 ;format fresh from the Monash repository:  `(\"^edict$\" . euc-jp)'."
 414 (defun edict-init ()
 415
 416   ;;create a match buffer.
 417   (if (not (get-buffer edict-match-buffer-name))
 418     (setq edict-match-buffer (get-buffer-create
 419                                 edict-match-buffer-name)))
 420
 421   ;;Check that we have a list, we will check that they are readable below.
 422   (if (not (listp edict-dictionaries))
 423       (error "The variable edict-dictionaries should be a list!"))
 424
 425   ;;Create and read the edict files.
 426   (if (not (get-buffer edict-buffer-name))
 427     (progn
 428       (save-window-excursion
 429         ;;First create the buffer and make it the current one
 430         (setq edict-buffer (get-buffer-create edict-buffer-name))
 431         (set-buffer edict-buffer)
 432
 433         ;;Read in the files from the list.
 434         (message "Reading the dictionaries.  This may take a while...")
 435         (mapcar (function
 436                  (lambda (arg)
 437                    (let* ((arg (edict-regularize-file-argument arg))
 438                           (filename (car arg))
 439                           (coding-system (cdr arg)))
 440                      (edict-add-file filename coding-system))))
 441                 (if edict-user-dictionary
 442                     (cons edict-user-dictionary edict-dictionaries)
 443                   edict-dictionaries))
 444         ;;If none of the files were readable, puke.
 445         (if (null edict-dictionaries-loaded)
 446             (progn
 447               (kill-buffer edict-buffer)
 448               (error "No edict files found! Check value of edict-dictionaries.")))
 449         (message "Reading the dictionaries...done."))))
 450   t)
 451
 452 ;;
 453 ;;
 454 ;;
 455 ;;;###autoload
 456 (defun edict-force-init ()
 457   "Reread the edict files even if edict-buffer exists.
 458
 459 Useful when you have updated the edict-dictionaries variable or corrupted
 460 the edict buffer."
 461   (interactive)
 462   (setq edict-dictionaries-loaded nil)
 463   (kill-buffer edict-buffer)
 464   (edict-init))
 465
 466 ;;
 467 ;; Add file filename to the current buffer with the begin end markers around that file...
 468 ;;
 469 (defun edict-add-file (filename coding-system)
 470   "Add FILENAME to the current buffer using CODING-SYSTEM.
 471 *edict-file-begin-marker* and *edict-file-end-marker* are placed around
 472 the file contents.
 473
 474 If FILENAME is nil, do nothing (cf. edict-regularize-file-argument)."
 475   (if (not filename)
 476       nil
 477     (goto-char (point-max))
 478     (insert (format "%s %s\n" *edict-file-begin-marker* filename))
 479     (let ((pos (point)))
 480       (let ((coding-system-for-read coding-system))
 481         (insert-file-contents filename))
 482       (goto-char (point-max))
 483       (insert (format "%s %s\n" *edict-file-end-marker* filename))
 484       (goto-char pos)
 485       ;; #### Huh?  Unprintable characters in dictionary names?  and
 486       ;;            why not allow Japanese?  Ask Jim Breen.
 487       (when (looking-at "\e$B!)!)!)!)\e(B /\\([ -.0-\177]+\\)/")
 488         (message "Loaded dictionary %s."
 489                  (buffer-substring (match-beginning 1) (match-end 1))))
 490       (goto-char (point-max))
 491       (setq edict-dictionaries-loaded
 492             (append edict-dictionaries-loaded (list filename))))))
 493
 494 ;; Remove any leading, trailing, or embedded whitespace or other noise
 495 ;; characters (such as the inserted ">" etc. used to denote inserted
 496 ;; quotations in mail and news)
 497 ;; #### Supercite will hose that last!  Can we borrow from filladapt?
 498
 499 (defun edict-clean-up-kanji (key)
 500   (let ((start 0)
 501         (loc 0)
 502         (end (length key))
 503         (result "")
 504         (pattern (concat "[" *edict-kanji-whitespace* "]+")))
 505     (while (and (< start end) (setq start (string-match pattern key start)))
 506       (setq result (concat result (substring key loc start)))
 507       (setq loc (setq start (match-end 0))))
 508     (concat result (substring key loc))))
 509
 510 ;; #### Why strings and not characters?
 511 (defconst *edict-romaji-remaps*
 512   '(("\e$B#a\e(B" . "a") ("\e$B#b\e(B" . "b") ("\e$B#c\e(B" . "c") ("\e$B#d\e(B" . "d") ("\e$B#e\e(B" . "e") ("\e$B#f\e(B" . "f") ("\e$B#g\e(B" . "g")
 513     ("\e$B#h\e(B" . "h") ("\e$B#i\e(B" . "i") ("\e$B#j\e(B" . "j") ("\e$B#k\e(B" . "k") ("\e$B#l\e(B" . "l") ("\e$B#m\e(B" . "m")
 514     ("\e$B#n\e(B" . "n") ("\e$B#o\e(B" . "o") ("\e$B#p\e(B" . "p") ("\e$B#q\e(B" . "q") ("\e$B#r\e(B" . "r") ("\e$B#s\e(B" . "s") ("\e$B#t\e(B" . "t")
 515     ("\e$B#u\e(B" . "u") ("\e$B#v\e(B" . "v") ("\e$B#w\e(B" . "w") ("\e$B#x\e(B" . "x") ("\e$B#y\e(B" . "y") ("\e$B#z\e(B" . "z")
 516     ("\e$B#A\e(B" . "A") ("\e$B#B\e(B" . "B") ("\e$B#C\e(B" . "C") ("\e$B#D\e(B" . "D") ("\e$B#E\e(B" . "E") ("\e$B#F\e(B" . "F") ("\e$B#G\e(B" . "G")
 517     ("\e$B#H\e(B" . "H") ("\e$B#I\e(B" . "I") ("\e$B#J\e(B" . "J") ("\e$B#K\e(B" . "K") ("\e$B#L\e(B" . "L") ("\e$B#M\e(B" . "M")
 518     ("\e$B#N\e(B" . "N") ("\e$B#O\e(B" . "O") ("\e$B#P\e(B" . "P") ("\e$B#Q\e(B" . "Q") ("\e$B#R\e(B" . "R") ("\e$B#S\e(B" . "S") ("\e$B#T\e(B" . "T")
 519     ("\e$B#U\e(B" . "U") ("\e$B#V\e(B" . "V") ("\e$B#W\e(B" . "W") ("\e$B#X\e(B" . "X") ("\e$B#Y\e(B" . "Y") ("\e$B#Z\e(B" . "Z")))
 520
 521 ;;
 522 ;; Lookup a mapping for zenkaku roman characters to ASCII.
 523 ;; #### Wouldn't this be better done with assoc, if necessary with some
 524 ;;      type-checking on the args?
 525 ;;
 526 (defun edict-in-remap-list (item list)
 527   "Return first link in LIST whose car is `equal' to ITEM."
 528   (let ((ptr list)
 529         (done nil)
 530         (result '()))
 531     (while (not (or done (endp ptr)))
 532       (cond ((string= item (car (car ptr)))
 533              (setq done t)
 534              (setq result ptr)))
 535       (setq ptr (cdr ptr)))
 536     result))
 537
 538 ;;
 539 ;; Remap zenkaku roman characters to ASCII.
 540 ;;
 541 (defun edict-remap-romaji (eigo-string)
 542   (let ((stop (length eigo-string))
 543         (current 0)
 544         (match nil)
 545         (result ""))
 546     (while (< current stop)
 547       (if (<  (+ 1 current) stop)
 548         (setq match (edict-in-remap-list (substring eigo-string current (+ 2 current)) *edict-romaji-remaps*))
 549         (setq match nil))
 550       (if match
 551         (progn
 552           (setq result (concat result (cdr (car match))))
 553           (setq current (+ 2 current)))
 554         (progn
 555           (setq result (concat result (substring eigo-string current (1+ current))))
 556           (setq current (1+ current)))))
 557     result))
 558
 559 ;;
 560 ;;  Eliminate extra whitespace, newlines, punctuation, etc. which would
 561 ;;  interfere with our dictionary lookup.
 562 ;;
 563 (defun edict-clean-up-eigo (key)
 564   (let ((start 0)
 565         (loc 0)
 566         (end (length key))
 567         (result "")
 568         (pattern (concat "[" *edict-eigo-whitespace* "]+")))
 569     (while (and (< start end)
 570                 (setq start (string-match pattern key start)))
 571       (setq result (concat result (substring key loc start) " "))
 572       (setq loc  (setq start (match-end 0))))
 573
 574     (setf result (concat result (substring key loc)))
 575
 576     (edict-remap-romaji result)))
 577
 578 ;;
 579 ;;  slightly specialized function to be changed when the real backward
 580 ;;  word things are included.
 581 ;;
 582 (defun edict-eigo-one-word (direction)
 583   "The function edict-eigo-one-word goes one word forward (direction > 0)
 584 or backward (direction <= 0).  It assumes that it is looking at a word
 585 when invoked.  It returns the point either at the beginning of a word or
 586 at the whitespace after a word."
 587   (let ((stop-point (point))
 588         (stop nil))
 589     (if (> direction 0)
 590       ;;forward
 591       (progn
 592         (while (not stop)
 593           (setq stop-point (point))
 594           (if (< (point) (point-max))
 595             (if (looking-at *edict-eigo-characters*)
 596               (forward-char 1)
 597               (setq stop t))
 598             (setq stop t))))
 599       ;;backward
 600       (progn
 601         (while (not stop)
 602           (setq stop-point (point))
 603           (if (> (point) (point-min))
 604             (if (looking-at *edict-eigo-characters*)
 605               (backward-char 1)
 606               (progn
 607                 (setq stop t)
 608                 (forward-char 1)
 609                 (setq stop-point (point))))
 610             (setq stop t )))))
 611     stop-point))
 612
 613
 614 ;;
 615 ;; perham
 616 ;;
 617 (defun edict-find-word-at-point ()
 618   "Find an English word close to or behind point.
 619
 620 If it does not find any word it reports an error."
 621   (let (start end)
 622
 623     ;; Move backward for word if not already on one.
 624     (if (not (looking-at *edict-eigo-characters*))
 625       (re-search-backward *edict-eigo-characters* (point-min) 'stay))
 626
 627     (if (looking-at *edict-eigo-characters*)
 628       (progn
 629         (setq start (edict-eigo-one-word -1))
 630         (setq end   (edict-eigo-one-word 1))
 631
 632         (edict-clean-up-eigo (buffer-substring start end)))
 633       (error "Can't find English word!")
 634       )))
 635
 636 ;;
 637 ;;
 638 ;;
 639 ;;;###autoload
 640 (defun edict-search-english (arg)
 641   "Attempts to translate the english word we are looking at. Picks the word
 642 in the same way as ispell, ie backs up from whitespace, and then expands.
 643
 644 Result is presented in a window that is not selected. Clear the window by
 645 using a negative prefix argument.
 646
 647 If given an argument, adds an english word to the private dictionary."
 648
 649   (interactive "P")
 650   (if arg
 651       (if (< (prefix-numeric-value arg) 0)
 652           (edict-restore-display)
 653         (edict-add-english))
 654     (let ((word (edict-get-english-word)))
 655       ;;Search if there is a word.
 656       (when word
 657         (edict-search-and-display word 'english)))))
 658
 659 ;; Return the english word, or nil
 660 (defun edict-get-english-word ()
 661   (let (word real-word)
 662
 663     ;;Find the word
 664     (setq word (edict-find-word-at-point))
 665
 666     ;;ask the user if this is really the word that is interesting.
 667     (setq real-word (read-string
 668                      (format "Translate word (default \"%s\"): "
 669                              word)))
 670     (setq real-word (edict-clean-up-eigo real-word))
 671     (if (equal real-word "")
 672         (if (equal word "")
 673             nil
 674           word)
 675       real-word)))
 676
 677 ;;
 678 ;;
 679 ;;
 680 ;;;###autoload
 681 (defun edict-search-kanji (arg min max)
 682   "Attempts to translate the Kanji sequence between mark and point.
 683
 684 Result is presented in a window that is not selected. Clear the window
 685 with for instance C-X 1
 686
 687 Given a numeric argument, this adds the Kanji sequence to the user's
 688 private dictionary.
 689
 690 If all searches fail, initialization may be bogus.  See the documentation
 691 for `edict-init'."
 692
 693   ;;Interactive, with a region as argument
 694   (interactive "P
 695 r")
 696
 697   ;;make sure that the dictionary is read
 698   (edict-init)
 699
 700   (if arg
 701       (if (< (prefix-numeric-value arg) 0)
 702           (edict-restore-display)
 703         (edict-add-kanji min max))
 704     (let ((word (edict-clean-up-kanji (buffer-substring min max))))
 705       (if (equal word "")
 706           (error "No word to search for!")
 707         (edict-search-and-display word '\e$BF|K\8l\e(B))))
 708   t)
 709
 710 ;;
 711 ;;
 712 ;;
 713 (defun edict-copy-of-current-line ()
 714   "Copy-of-current-line creates and returns a copy of the line
 715 where point is. It does not affect the buffer it is working on,
 716 except for moving the point around.
 717
 718 It leaves the point at the end of the line, which is fine for this
 719 application."
 720
 721   ;;Find the start and end of the current line
 722   (let ((line-start (progn (beginning-of-line) (point)))
 723         (line-end   (progn (end-of-line) (point))))
 724
 725     ;;return a copy of his line, perham, is there something that
 726     ;; should be tested here?
 727     (buffer-substring line-start line-end)))
 728
 729
 730 ;;
 731 ;;
 732 ;;
 733 (defun edict-search (key buffer)
 734   "Searches the edict-buffer and returns a list of strings that are
 735 the matches.
 736
 737 If there are no matches this string will be nil."
 738
 739   ;;perham, should this really go here? Or what should we have? Look
 740   ;;at ispell.el...
 741   (save-window-excursion
 742     (message (format "Searching for word \"%s\"..." key))
 743     (let ((match-list nil))
 744       ;;select the database and goto to the first char
 745       (set-buffer buffer)
 746       (goto-char (point-min))
 747       ;;Search for lines that match the key and copy the over to the
 748       ;; match buffer.
 749       (while (edict-search-key key)
 750         (setq match-list (union match-list (list (edict-copy-of-current-line)))))
 751       match-list)))
 752
 753 (defun edict-search-key (key)
 754   (search-forward                       ;Ken-ichi says that one cannot
 755                                         ;use the re-search-forward
 756                                         ;function with actually having
 757                                         ;some reg exp in the target string.
 758                                         ;(concat "[\[/
 759                                         ;]" key "[\]/ ]")
 760    key nil t))
 761
 762 ;;
 763 ;;
 764 ;;
 765
 766 (defvar *edict-previous-configuration* nil)
 767
 768 (defun edict-note-windows ()
 769   (or *edict-previous-configuration*
 770       (setq *edict-previous-configuration* (current-window-configuration))))
 771
 772 ;; This doesn't work yet; leave it set to 'top!
 773 (defcustom *edict-window-location* 'top
 774   "*Location to place edict matches window.  top or bottom.
 775 Doesn't work yet."
 776   :type '(const top)
 777   :group 'edict)
 778
 779 (defun edict-display (key-list match-list)
 780   "Edict-display displayes the strings in a separate window that is
 781 not selected."
 782   (let* ((text-window (get-buffer-window (current-buffer)))
 783          (edict-window (get-buffer-window edict-match-buffer))
 784          ;; We have available some of this window's height plus any we've already
 785          ;; already gotten.
 786          (avail-height (+ (window-height text-window)
 787                           (if edict-window
 788                               (window-height edict-window)
 789                             0)))
 790          ;; We limit the height to half of what's available, but no more than we need,
 791          ;; and no less than window-min-height.  We must remember to include 1 line for
 792          ;; the mode-line in our minimum figure.
 793          (height (min (max window-min-height (+ (length match-list) 1))
 794                       (/ avail-height 2))))
 795     (if (not edict-window)
 796         (progn
 797           ;; We don't have a window, so remember our existing configuration,
 798           ;; and either find an acceptable window to split, or use the current
 799           ;; window.
 800           (edict-note-windows)
 801           (let ((use-window (edict-find-acceptable-window text-window)))
 802             (if use-window
 803                 (setq edict-window use-window
 804                       text-window (split-window text-window height))
 805               (setq edict-window text-window))))
 806       ;; We have a window already.  Just adjust its size appropriately.
 807       (unless (equal height (window-height edict-window))
 808         (let ((selected (selected-window)))
 809           (select-window edict-window)
 810           (enlarge-window (- height (window-height edict-window)))
 811           (select-window selected))))
 812     (set-buffer edict-match-buffer)
 813     (let ((min (point-min)))
 814       ;; Replace everything.
 815       (erase-buffer)
 816       (mapcar (function (lambda (string-item)
 817                           (insert string-item)
 818                           (newline)))
 819               match-list)
 820       (when (eq *edict-window-location* 'bottom)
 821         (let ((w text-window))
 822           (setq text-window edict-window
 823                 edict-window w)))
 824       ;; OK, now let's move the exact matches to the top.
 825       (goto-char min)
 826       ;; Be careful to preserve the order.
 827       ;; An exact match is any of "^key ", "[key]", "/key/", or "/to key/".
 828       (dolist (key (reverse key-list))
 829         (let* ((pattern (concat "^" key " \\|\\[" key "\\]\\|\\/" key
 830                                 "\\/\\|\\/to " key "\\/" ))
 831                (top-lines nil))
 832           ;; First pull them out of the buffer into a list (top-lines).
 833           ;; Then re-insert them at the top.
 834           (while (re-search-forward pattern nil t)
 835             (forward-line 0)
 836             (let ((p (point)))
 837               (forward-line 1)
 838               (push (buffer-substring p (point)) top-lines)
 839               (delete-region p (point))))
 840           (goto-char min)
 841           (mapcar 'insert top-lines)))
 842       ;; OK, display it all.
 843       (select-window text-window)
 844       (set-window-buffer edict-window edict-match-buffer)
 845       (set-window-start edict-window min)))
 846   t)
 847
 848 ;; Find a window which is of acceptable size to split.
 849 ;; It must be at least twice window-min-height.
 850 (defun edict-find-acceptable-window (window)
 851   (catch 'no-window
 852     (let ((new-window window))
 853       (while (< (window-height new-window) (* 2 window-min-height))
 854         (setq new-window (next-window new-window))
 855         (when (eq new-window window)
 856           (throw 'no-window nil)))
 857       new-window)))
 858
 859 ;; Try to put the display back the way it was before showing matches.
 860 (defun edict-restore-display ()
 861   "Remove the edict windows."
 862   (when *edict-previous-configuration*
 863     (set-window-configuration *edict-previous-configuration*))
 864   (setq *edict-previous-configuration* nil)
 865   t)
 866
 867 ;; Variables to remember the last insertion of a match into our
 868 ;; buffer, for later replacement.
 869
 870 (defvar edict-last-language nil)
 871 (defvar edict-insert-last-start)
 872 (defvar edict-insert-last-end)
 873
 874 ;;
 875 ;;
 876 ;;
 877 (defun edict-search-and-display (key &optional from-language)
 878   "Edict-search-and-display searches for matches to the argument key.
 879 If there are any matches these are displayed in a window that is not
 880 selected. This window can be removed with C-X 1."
 881   (edict-init)
 882   ;; Remember the last language looked up, so edict-insert can pick the
 883   ;; right one.
 884   (setq edict-last-language from-language)
 885   (save-excursion
 886     (let ((match-list nil)
 887           (one-char-keys nil)
 888           (key-list (edict-expand-string key () () (or from-language '\e$BF|K\8l\e(B))))
 889       ;; Sort them into the order we'd like exact matches to appear.
 890       (setq key-list (sort key-list (function (lambda (x y)
 891                                                 (let ((lx (length x))
 892                                                       (ly (length y)))
 893                                                   (if (= lx ly)
 894                                                       (string-lessp x y)
 895                                                     (> lx ly)))))))
 896       ;; For all the possibilities
 897       (dolist (key key-list)
 898         ;; Search for matches.  We exclude any one-character keys on
 899         ;; the theory that they're likely to be uninteresting
 900         ;; fragments.
 901         ;; #### This is a strange way to do this test.  What
 902         ;;      are we thinking?
 903         (if (string-match "^[\e$B!"\e(B-\e$Bt$\e(B]$" key) ;1 char
 904             (push key one-char-keys)
 905           (setq match-list (union match-list (edict-search key edict-buffer)))))
 906       ;; If we didn't get anything, we can try including the one-char keys.
 907       (or match-list
 908           (dolist (key one-char-keys)
 909             (setq match-list (union match-list
 910                                     (edict-search key edict-buffer)))))
 911       ;; #### I don't understand the logic of this whole function.
 912       (if (not match-list)
 913           (progn
 914             (edict-delete-matches-window)
 915             ;; This probably didn't need to be an error....
 916             (message "No matches for key \"%s\"." key))
 917         (edict-display key-list match-list)
 918         (message "Found it!")))))
 919
 920 (defun edict-insert (arg)
 921   "Insert the last value looked up at the current position.  If repeated,
 922 replace with the next possibility.  If given an argument N, use the
 923 Nth possibility.  Inserts in the opposite language from what was looked up,
 924 unless the argument is negative."
 925   (interactive "P")
 926   ;; If we were given a negative argument, we need to switch languages.
 927   (cond ((null arg))
 928         ((> (prefix-numeric-value arg) 0))
 929         (t (case arg
 930              (- (setq arg nil))
 931              (otherwise (setq arg (list (- (prefix-numeric-value arg))))))
 932            (setq edict-last-language
 933                  (ecase edict-last-language
 934                    (english '\e$BF|K\8l\e(B)
 935                    (\e$BF|K\8l\e(B 'english)))))
 936   (ecase edict-last-language
 937     (english (edict-insert-\e$BF|K\8l\e(B arg))
 938     (\e$BF|K\8l\e(B (edict-insert-english arg))))
 939
 940 (defun edict-insert-english (arg)
 941   "Insert the last english word looked up at the current position.
 942 If repeated, replace with the next possibility.  If given an argument N,
 943 use the Nth possibility."
 944   (interactive "P")
 945   (or edict-match-buffer
 946       (error "You must first look up a word."))
 947   (let ((value nil))
 948     (save-excursion
 949       (set-buffer edict-match-buffer)
 950       ;; If we're going to a specific one, always count from the beginning.
 951       (when arg
 952         (goto-char (point-min)))
 953       ;; If the last command was this, then we're going on to the next possibility.
 954       ;; Otherwise, start at the beginning.
 955       (case last-command
 956         (edict-insert-english)
 957         (t (goto-char (point-min))))
 958       ;; Seach forward for /<definitition>/  If we don't find one, start over from the
 959       ;; beginning.
 960       (unless (re-search-forward "/\\([^/\n]+\\)/" (point-max) t (prefix-numeric-value arg))
 961         (goto-char (point-min))
 962         (unless (or arg
 963                     (re-search-forward "/\\([^/\n]+\\)/" (point-max) t))
 964           (error "No match numbered %d found." (prefix-numeric-value arg))))
 965       ;; Extract the match.  Leave ourselves just before the final /,
 966       ;; so if it starts a new definition, we'll find it.
 967       (goto-char (match-end 1))
 968       (setq value (buffer-substring (match-beginning 1) (match-end 1))))
 969     ;; If we inserted one of our languages, then we should delete the old
 970     ;; one first.
 971     (case last-command
 972       ((edict-insert-english edict-insert-\e$BF|K\8l\e(B)
 973        (delete-region edict-insert-last-start edict-insert-last-end)))
 974     ;; Insert, remembering where we did it, so it can be replaced if we
 975     ;; repeat the command.
 976     (setq edict-insert-last-start (point-marker))
 977     (insert value)
 978     (setq edict-insert-last-end (point-marker)))
 979   ;; Remember this as the last command, not edict-insert.
 980   (setq this-command 'edict-insert-english)
 981   t)
 982
 983 (defun edict-insert-\e$BF|K\8l\e(B (arg)
 984   "Insert the last \e$BF|K\8l\e(B word looked up at the current position.
 985 If repeated, replace with the next possibility.  If given an argument N,
 986 use the Nth possibility."
 987   (interactive "P")
 988   (or edict-match-buffer
 989       (error "You must first look up a word."))
 990   (let ((value nil))
 991     (save-excursion
 992       (set-buffer edict-match-buffer)
 993       ;; If we're going to a specific one, always count from the beginning.
 994       (when arg
 995         (goto-char (point-min)))
 996       ;; If the last command was this, then we're going on to the next possibility.
 997       ;; Otherwise, start at the beginning.
 998       (case last-command
 999         (edict-insert-\e$BF|K\8l\e(B)
1000         (t (goto-char (point-min))))
1001       ;; Seach forward for a word at the start of a line.  If we don't find one,
1002       ;; start over from the beginning.
1003       (unless (re-search-forward edict-dictionary-entry-start-regexp
1004                                  (point-max) t (prefix-numeric-value arg))
1005         (goto-char (point-min))
1006         (unless (or arg
1007                     (re-search-forward edict-dictionary-entry-start-regexp
1008                                        (point-max) t))
1009           (error "No match numbered %d found." (prefix-numeric-value arg))))
1010       (goto-char (match-end 1))
1011       (setq value (buffer-substring (match-beginning 1) (match-end 1))))
1012     ;; If we inserted one of our languages, then we should delete the old
1013     ;; one first.
1014     (case last-command
1015       ((edict-insert-\e$BF|K\8l\e(B edict-insert-english)
1016        (delete-region edict-insert-last-start edict-insert-last-end)))
1017     ;; Insert, remembering where we did it, so it can be replaced if we
1018     ;; repeat the command.
1019     (setq edict-insert-last-start (point-marker))
1020     (insert value)
1021     (setq edict-insert-last-end (point-marker)))
1022   ;; Remember this as the last command, not edict-insert.
1023   (setq this-command 'edict-insert-\e$BF|K\8l\e(B)
1024   t)
1025
1026 ;; Remove the matches window from the screen.
1027 ;; This is harder than you'd think.
1028 ;; (SJT - if you try to be overly intelligent about it....)
1029 (defun edict-delete-matches-window ()
1030   (interactive)
1031   (let ((window (get-buffer-window edict-match-buffer)))
1032     (when window
1033       ;; SJT: `window-edges' doesn't seem to exist under XEmacs.  In
1034       ;; any case, I don't particularly see why it makes sense to
1035       ;; split the space among several windows.
1036       (if (featurep 'xemacs)
1037           (delete-window window)
1038         ;; #### The following is _not_ known to work in recent GNU Emacs :-(
1039         (let* ((selected (selected-window))
1040                (next (previous-window window))
1041                (height (window-height window))
1042                (nedges (window-edges next))
1043                (tedges (window-edges window)))
1044           (delete-window window)
1045           ;; The following is sheer magic.  Deleting a window is not
1046           ;; an inverse to splitting a window.  The space is returned
1047           ;; not to the window below, OR to the window above, but
1048           ;; rather is divided between them.
1049           (when (and (equal (car nedges) (car tedges))
1050                      (< (car (cdr nedges)) (car (cdr tedges))))
1051             (select-window next)
1052             (shrink-window (/ (- height 1) 2))
1053             (select-window selected)))))))
1054
1055 ;; #### This can't possibly work, since dictionary loading does not
1056 ;;      take place at library load time.  Move the relevant clauses to
1057 ;;      `edict-init'.
1058 (if (or edict-unreadable-files
1059         edict-missing-dictionaries)
1060     (with-output-to-temp-buffer "*edict load warnings*"
1061       (if edict-unreadable-files
1062           (progn
1063             (princ "The following files were found but are unreadable.
1064 This is probably an error.
1065 ")
1066             (princ edict-unreadable-files)
1067             (setq edict-unreadable-files nil)))
1068       (if (and edict-warn-missing-dictionaries-p
1069                edict-missing-dictionaries)
1070           (progn
1071             (princ "The following dictionaries were not found on the search path.
1072 ")
1073             (princ edict-missing-dictionaries)
1074             (setq edict-missing-dictionaries nil)))))
1075
1076 ;; Load morphology rewrite engine and grammar rules
1077 ;; This can be done a lot more lazily
1078 (require 'edict-english)
1079 (require 'edict-japanese)
1080
1081 (provide 'edict)
1082
1083 ;;; edict.el ends here