;;; diclookup-mule.el --- a client of ndtp server

;; Copyright (C) 1991 Shingo NISHIOKA <nishioka@sanken.osaka-u.ac.jp>

;; Author: Shingo NISHIOKA <nishioka@sanken.osaka-u.ac.jp>
;;	SAITO Yutaka <yutaka@vsp.cpg.sony.co.jp>
;;	YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
;; Maintainer: YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
;; Version: 2.3.4

;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY.  No author or distributor
;; accepts responsibility to anyone for the consequences of using it
;; or for whether it serves any particular purpose or works at all,
;; unless he says so in writing.  Refer to the GNU Emacs General Public
;; License for full details.

;; Everyone is granted permission to copy, modify and redistribute
;; this file, but only under the conditions described in the
;; GNU Emacs General Public License.   A copy of this license is
;; supposed to have been given to you along with GNU Emacs so you
;; can know your rights and responsibilities.  It should be in a
;; file named COPYING.	Among other things, the copyright notice
;; and this notice must be preserved on all copies.

;;; Commentary:

;; インストールの仕方は、パッケージに附属の README を御覧下さい。

;; 設定のヒント:(必要に応じて .emacs に書いて下さい)
;;
;; ・最小限の設定は？
;; (autoload 'online-dictionary "diclookup-mule" "Online dictionary." t nil)
;; (autoload 'diclookup "diclookup-mule"
;;   "Online dictionary. Display diclookup buffer in the current frame." t nil)
;; (autoload 'diclookup-other-frame "diclookup-mule"
;;   "Like `diclookup' command, but display diclookup buffer in another frame."
;;   t nil)
;; M-x online-dictionary で起動します。"?" で簡単なヘルプが出ます。
;;
;; ・日本語入力の時に Canna やかな入力を使いたい。
;; 例1: (setq od-fep-type 'canna)	; egg, canna, t-code, skk, or no-fep
;; 例2: (setq od-fep-type "kanainput")	; input-method or its-mode name
;;
;; ・見た目は気にしないから速く表示して欲しい。
;; 次のいずれかを書いて下さい。
;; (setq od-fill-function nil) ; fill を行わない。結構速い。
;; (setq od-fill-function 'od-fill-region) ; 禁則処理なし。いくらか速い。
;;
;; ・デフォルトで辞書を起動するときにフレームを開くようにしたい。
;; 変数 od-frame-geometry に X の geometory を指定して下さい。
;; M-x online-dictionary で辞書用のフレームが開きます。
;; 例1: (setq od-frame-geometry "80x50+20-0")
;; 例2: (setq od-frame-geometry "80x50")
;; 例3: (setq od-frame-geometry "")
;;
;; ・辞書用のフレームのフォントを指定したい。
;; 変数 od-frame-font に fontset を指定して下さい。リソースを適当に設
;; 定すれば、普段は 12x24 を使って、辞書の表示の時には発音記号に合わせ
;; て ETL フォントを使うといったこともできます。
;; 例: (setq od-frame-font "ETL24")
;;
;; ・"q" で辞書を終る時に辞書用のフレームを隠したい。
;; 変数 od-hide-frame に次のいずれかを指定して下さい。
;;	'iconify	--- アイコン化される。
;;	'make-invisible	--- 見えなくなる。
;;	'lower		--- 下に隠れる。
;;	その他 nil 以外	--- 前のフレームに移る。
;; より細かい設定をしたい場合は、od-quit-hook,
;; od-pre-pop-to-buffer-hook, od-post-pop-to-buffer-hook などを使って
;; 下さい。
;;
;; ・"Q" で辞書を終るときに辞書用のフレームを削除したい。
;; (add-hook 'od-really-quit-hook 'od-delete-frame)
;;
;; ・デフォルトで例文を隠したい。
;; (setq od-summary-mode t)
;; 例文表示の ON/OFF の切替えは、"E" または ":" で行います。
;;
;; ・参照部分をたどった履歴を縦に表示したい。
;; (setq od-genealogy-delimiters
;;     '("  " "\n  " "\n" " >" "\n  "
;;	"\n ========================================\n"))
;;
;; ・menu-bar から起動したい。
;; (define-key-after
;;   (if (boundp 'menu-bar-tools-menu) menu-bar-tools-menu menu-bar-file-menu)
;;   [dictionary] '("Online Dictionary" . online-dictionary) 'calendar)
;; とすると、menu-bar の File(あるいは Tools) というところから起動できます。
;;
;; ・カーソルの下の単語を調べたい。
;; (define-key help-map "o" 'od-lookup-pattern-edit)
;; (define-key menu-bar-help-menu [diclookup]
;;   '("Diclookup word" . od-lookup-pattern-edit))
;; (autoload 'od-lookup-pattern-edit "diclookup-mule" "Look up a word." t nil)
;; とすると、C-h o や menu-bar Help -> Diclookup word でカーソルの下の
;; 単語を調べます。
;;
;; ・英単語を簡単に調べられるモードが欲しい。
;; lup-mode という副モードがあります。
;; (autoload 'lup-mode "diclookup-mule"
;;   "Minor mode for online-dictionary." t nil)
;; と書くと、M-x lup-mode で mouse-1 をダブルクリックしてマウスカーソ
;; ルの周辺の単語を調べたり、mouse-1 をドラッグして、指定した範囲を調
;; べることができます。もう一度 M-x lup-mode で抜けます。
;;
;; ・いちいち lup-mode に入るのは面倒。またはマウスによるカット＆ペー
;;   ストが使えなくなるのはいや。
;; Shift + mouse-1 はユーザーが指定できるところなので、ここに指定して
;; しまえばいつでも Shift を押しながらダブルクリックしたりすることで英
;; 単語を引くことができます。
;; [注] Emacs 19.30 から Shift + mouse-1 に Font menu が入りました。;_;
;; (global-set-key [S-down-mouse-1] 'lup-mouse-drag-region)
;; (global-set-key [S-mouse-1] 'mouse-set-point)
;; (global-set-key [S-drag-mouse-1] 'lup-mouse-set-region)
;; (global-set-key [S-double-mouse-1] 'lup-mouse-set-point)
;; (global-set-key [S-triple-mouse-1] 'lup-mouse-set-point)
;; (autoload 'lup-mouse-drag-region "diclookup-mule"
;;   "Lookup a double-clicked(or dragged) word." t nil)

;;; ChangeLog:

;; 92.11.18 modified for Mule Ver.0.9.7
;;			by M.Higashida <manabu@sigmath.osaka-u.ac.jp>
;;	凡例や奥付を表示させると文字化けするバグのフィクス
;;	read-hiragana-string に関する変更も入っています。
;; 93.2.11  modified for Mule Ver.0.9.7.1 by T.Ito <toshi@his.cpl.melco.co.jp>
;;	In od:really-change-dictionary, avoid multiple connection.
;; 94.3.29 modified for Mule Ver.1.0 by M.Yamamoto <mituharu@is.s.u-tokyo.ac.jp>
;;     Rename the program diclookup-mule to avoid a conflict.
;;	Reference search and picture search are supported.
;; 94.5.20 modified by M.Yamamoto <mituharu@is.s.u-tokyo.ac.jp>
;;	Multiple pictures are supported.
;; 94.8.31 Release Version 2.0 (for Mule Ver.2.0).
;; 94.11.5 Release Version 2.1 (for Mule Ver.2.1).
;; 94.12.14 Chujiten supported.
;;	 Thanks to T.Katayama <toshioji@darkover.iijnet.or.jp>
;; 95.1.12 Release Version 2.2 (for Mule Ver.2.2).
;; 95.10.16 Release Version 2.3 (for Mule Ver.2.3).

;;; Code:

(require 'outline)
(require 'ndtp)

;; Please customize the following variables for your local site.

(defvar dserver-server-list '("dserver" "localhost")
  "*Site default value of the list of dservers.
Each element must be of the form either

	\"hostname\"
or
	'(\"hostname\" . \"service\").

If an element is of the first form, the value of
`dserver-service' is used for dserver service name or its port number.")
(defvar dserver-service
  (if (boundp 'dserver-protocol)	; for compatibility
      (symbol-value 'dserver-protocol)	; suppress warnings
    ndtp-default-service)
  "*Name of dserver service or its port number.")
(defvar od-chujiten-flag nil
  "*Non-nil means the gaiji-table for chujiten is used.")
(defvar od-dictfile-list
  (if od-chujiten-flag
      '("od-chujiten" "od-kojien")
    '("od-eiwa" "od-kojien")))

;; These are user variables. Customize them in your startup file.

(defvar od-server-list (or (ndtp-parse-dserver-env t) dserver-server-list)
  "*User configurable value of the list of dservers.
See the documentation of `dserver-server-list'.
The defalut value may be created from the value of the environment
variable `DSERVER', which is of the following form:
	host1[:service1][,host2[:service2],...,hostn[:servicen]]")
(defvar od-window-config 6
  "*Height of `*Dict-Header*' buffer.")
(defvar od-body-fillcolumn nil
  "*Non-nil value defines fill-column of `*Dict-Body*' buffer.")
(defvar od-body-right-border 10)
(defvar od-select-unique-entry-immediately t
  "*Non-nil means the unique entry is displayed automatically.")
(defvar od-scroll-step 'full
  "*Define scroll step used by functions od-scroll-entry-*.
See also the documentation of odic-mode.")
(defvar od-summary-mode
  (if (boundp 'od-eiwa-summary-mode)	; for compatibility
      (symbol-value 'od-eiwa-summary-mode) ; suppress warnings
    nil)
  "*Non-nil means example sentences are hidden by outline mode.")
(defvar od-fep-type
  (cond ((boundp 'EGG) 'egg)
	((boundp 'CANNA) 'canna)
	((boundp 'skk-mode) 'skk)
	((and (boundp 'input-method-alist)
	      (assoc "japanese-hiragana"
		     (symbol-value 'input-method-alist))) ; suppress warnings
	 "japanese-hiragana")
	(t 'no-fep))
  "*Define how to input a pattern in Japanese.
This value must be either an fep symbol (egg, canna, t-code, skk, or no-fep),
an its-mode name string, or an input-method string.")
(defvar od-ispell-ver-3 t
  "*Define whether you use the ispell3 or not.")
(defvar od-show-help-automatically nil
  "*Non-nil means show help messages when invoking online-dictionary.")
(defvar od-tcode-toggle-events '(?\034)
  "*List of events used for toggling tcode mode.")
(defvar od-fill-function)
;  "*Function used for filling text."
(defvar od-display-before-fill-limit 10000
  "*Text is displayed before filling if its size exceeds this value.")
(defvar od-history-length 16
  "*Length of history.")
(defvar od-use-only-ascii-and-jisx0208 (not window-system)
  "*Non-nil means only ASCII and JISX0208 are used.")
(defvar od-view-picture-program-and-args '("xv" "-")
  "*List of a program and arguments for displaying picture data.
Picture data are piped to this program in PBM format.")
(defvar od-play-sound-wave-program-and-args '("xanim" "-")
  "*List of a program and arguments for playing sound data.
Sound data are piped to this program in WAVE format.")
(defvar od-view-color-picture-program-and-args '("xv" "-")
  "*List of a program and arguments for displaying color picture data.
Picture data are piped to this program in BMP format.")
(defvar od-frame-name "Online-Dictionary"
  "*Name of dictionary frame.")
(defvar od-frame-geometry nil
  "*Define the geometry of the frame for online-dictionary.
This value must be nil or a standard X-style geometry
string. Nil means that the current frame is used for
online-dictionary. If this value is \"\", the geometry is
left to your window manager.")
(defvar od-frame-font nil
  "*Font used in frames for online-dictionary")
(defvar od-frame-alist nil
  "*Alist of frame parameters used when creating frames for dictionary.")
(defvar od-hide-frame nil
  "*Non-nil means the selected frame used for dictionary is hidden when quitting.
Non-nil value defines how to hide the frame.

	'iconify	--- iconify the frame
	'make-invisible	--- make the frame invisible
	'lower		--- lower the frame")
(defvar od-quit-hook
  (and od-hide-frame
       (or (cdr (assq od-hide-frame
		      '((iconify . od-iconify)
			(make-invisible . od-make-invisible)
			(lower . od-lower-and-select-previous-frame))))
	   'od-select-and-raise-previous-frame)))
(defvar od-really-quit-hook nil)
(defvar od-pre-pop-to-buffer-hook
  (cdr (assq od-hide-frame
	     '((lower . od-raise-dictionary-frames)
	       (make-invisible . od-make-dictionary-frames-visible)))))
(defvar od-post-pop-to-buffer-hook nil)
(defvar od-genealogy-delimiters
      '("  " " / " "\n" " >" " / "
	"\n ========================================\n"))
(defvar od-frame-cache-size 5)
(defvar od-body-cache-size 10)
(defvar od-ispell-exit-timeout 2
  "*Number of seconds to wait ispell process to exit after sending EOF.")
(defvar od-parenthesize-adscript-flag (not (boundp 'image-types))
  "*Non-nil means subscripts and superscripts are parenthesized.")
(defvar od-superscript-plist '(display ((height (- 1)) (raise 0.3))))
(setplist 'od-superscript od-superscript-plist)
(defvar od-subscript-plist '(display ((height (- 1)) (raise -0.3))))
(setplist 'od-subscript od-subscript-plist)

;; Set up other variables and macros.

(defconst od-version "2.3.4"
  "version of current diclookup-mule.el")
(defun od-version () (interactive)
  (message "diclookup-mule.el Version %s" od-version))
(defvar dserver-current-server nil)
(defmacro od-server-name (server)
  (` (if (consp (, server)) (car (, server)) (, server))))
(defmacro od-server-service (server)
  (` (if (consp (, server)) (cdr (, server)) dserver-service)))
(defvar od-dict-list nil)
(defconst od-dict-header-buffer-name
  "*Dict-Header*" "Buffer name for Dict Header.")
(defvar od-dict-header-buffer nil "Buffer for Dict Header.")
(defconst od-dict-body-buffer-name
  "*Dict-Body*" "Buffer name for Dict Body.")
(defvar od-dict-body-buffer nil "Buffer for Dict Body.")
(defvar od-previous-config nil)
(defvar od-dict nil)
(defvar od-dict-info)
(defvar od-headers)
(defvar od-home-headers nil)
(defvar od-base-fno)
(defvar od-base-ofs)
(defvar od-eno)
(defvar od-references nil)
(defvar od-current-entry -1)
(defvar od-genealogy)
(defvar od-current-pattern nil)
(defvar od-body-genealogy)
(defvar od-body-current-pattern nil)
(defvar od-history-alist nil)
(defvar od-history (make-vector od-history-length nil))
(defvar od-history-current-point 0)
(defvar od-history-drifting-point 0)
(defvar od-recent-entry-in-body-flag nil)
(defvar od-word-types)
(defvar od-index-types)
(defvar od-server-implementation)
(defvar od-summary-current-display-mode "")
(defvar od-ccl-status (make-vector 9 nil))
(defvar od-overlay-list nil)
(defvar od-overlay-list-unused nil)
(defvar od-body-cache-buffer-name-format " *od-cache%d*")

(defconst od-index-type-tables
  '((EB
     (?\xf2 (?G) "外字２" od-show-gaiji-entry t)
     (?\xf1 (?F) "外字１" od-show-gaiji-entry t)
     (?\x02 (?O) "著作権表示" od-show-entry t)
     (?\x01 (?H) "メニュー検索" od-show-entry t)
     (?\x71 (?A) "アルファベット後方 ... 語頭に * を付けることができる."
	    od-lookup-pattern-alphabet nil)
     (?\x70 (?K) "かな後方           ... 語頭に * を付けることができる."
	    od-lookup-pattern-kana nil)
     (?\x91 (?a) "アルファベット前方 ... 語尾に * を付けることができる."
	    od-lookup-pattern-alphabet nil)
     (?\x90 (?k) "かな前方           ... 語尾に * を付けることができる."
	    od-lookup-pattern-kana nil))
    (EPWING
     (?\x02 (?O) "著作権表示" od-show-entry t)
     (?\x01 (?H) "メニュー検索" od-show-entry t)
     (?\x71 (?A ?K) "表記後方 ... 語頭に * を付けることができる."
	    od-lookup-pattern-alphabet nil)
     (?\x70 (?K) "かな後方 ... 語頭に * を付けることができる."
	    od-lookup-pattern-kana nil)
     (?\x91 (?a ?k) "表記前方 ... 語尾に * を付けることができる."
	    od-lookup-pattern-alphabet nil)
     (?\x90 (?k) "かな前方 ... 語尾に * を付けることができる."
	    od-lookup-pattern-kana nil))))

(defvar od-one-digit-superscript-table
  '((?1 . ",A9") (?2 . ",A2") (?3 . ",A3")))

(defvar od-undo-dserver-translation-table
  '(("(C)" . "#xa1#x42") ("(U)" . "#xa1#x43") ("−" . "-")))

(defvar od-title-name nil)
(defvar od-title-trademark nil)

(defun od-add-title-name (name)
  (if (not (member name od-title-name))
      (setq od-title-name (cons name od-title-name))))

(defun od-add-title-trademark (trademark)
  (if (not (member trademark od-title-trademark))
      (setq od-title-trademark (cons trademark od-title-trademark))))

;; dictionary parameters
(defvar od-dict-name nil)
(defvar od-dict-pretty-name "")
(defvar od-dict-ccl)
(defvar od-dict-japanese-input nil)
(defvar od-dict-filter-func-list nil)
(defvar od-dict-filter-regexp-list nil)
(defvar od-dict-fill-function)
(defvar od-dict-compute-fill-prefix-func nil)
(defvar od-dict-summary nil)
(defvar od-dict-header-column nil)
(defvar od-dict-secondary-dictionary nil)
(defvar od-dict-capfunc-table nil)
(defvar od-dict-type nil)
(defvar od-dict-strip-stress-on-isearch nil)

(defvar od-default-dict-alist
  (nconc
   (list
    (cons 'fill-function
	  (if (boundp 'od-fill-function) ; for compatibility
	      od-fill-function
	    'od-fill-region-adaptive))
    (cons 'summary
	  (cons (default-value 'outline-regexp)
		(default-value 'outline-heading-end-regexp))))
   '((japanese-input . nil)
     (filter-func-list . nil)
     (filter-regexp-list . nil)
     (compute-fill-prefix-func . nil)
     (header-column . nil)
     (secondary-dictionary . nil)
     (capfunc-table . nil)
     (type . EB)
     (strip-stress-on-isearch . nil))))

(defvar od-dict-parameters nil)

(defun od-set-dict-parameters (alist)
  (while alist
    (set (intern (concat "od-dict-" (symbol-name (car (car alist)))))
	 (cdr (car alist)))
    (setq alist (cdr alist))))

(defun od-del-key-from-alist (key alist)
  (let ((tail alist)
	(prev nil))
    (while tail
      (if (eq key (car (car tail)))
	  (if (null prev)
	      (setq alist (cdr tail))
	    (setcdr prev (cdr tail)))
	(setq prev tail))
      (setq tail (cdr tail)))
    alist))

(defun od-del-keys-from-alist (keys alist)
  (while keys
    (setq alist (od-del-key-from-alist (car keys) alist))
    (setq keys (cdr keys)))
  alist)

(defun od-modify-dict-parameters (name dict-alist &optional del-list)
  (let ((name-alist (assoc name od-dict-parameters)))
    (if (null name-alist)
	(setq od-dict-parameters
	      (nconc od-dict-parameters
		     (list
		      (cons name
			    (od-del-keys-from-alist del-list dict-alist)))))
      (let ((new-alist
	     (append (od-del-keys-from-alist del-list dict-alist)
		     (od-del-keys-from-alist del-list (cdr name-alist))))
	    uniq-alist)
	(while new-alist
	  (setq uniq-alist (cons (car new-alist) uniq-alist))
	  (setq new-alist (od-del-key-from-alist
			   (car (car new-alist)) (cdr new-alist))))
	(setcdr name-alist uniq-alist)))))

(defun od-search-default-dict-name (japanese-input)
  (let ((dict-parameters od-dict-parameters)
	(key (cons 'japanese-input japanese-input)))
    (while (and dict-parameters
		(not (member key (cdr (car dict-parameters)))))
      (setq dict-parameters (cdr dict-parameters)))
    (car (car dict-parameters))))

(mapcar 'load-library od-dictfile-list)
(defvar od-default-jisyo-english (or (od-search-default-dict-name nil) "eiwa")
  "*Dictionary used when od-lookup-pattern-edit reads English.")
(defvar od-default-jisyo-japanese (or (od-search-default-dict-name t) "eiwa")
  "*Dictionary used when od-lookup-pattern-edit reads Japanese.")
(defvar od-default-jisyo od-default-jisyo-english
  "*Define the dictionary selected when invoking online-dictionary.")
(defvar od-default-jisyo-ispell od-default-jisyo-english
  "*Dictionary used when looking up a word with ispell.")


;;; Variables and functions which absorb some differences between Mule
;;; 2.x and Mule 3.x
(defvar od-no-conversion
  (if (coding-system-p '*noconv*) '*noconv* 'no-conversion))
(defvar od-japanese-jisx0208
  (if (boundp 'lc-jp)
      (symbol-value 'lc-jp)		; suppress warnings
    'japanese-jisx0208))

(defalias 'od-ccl-execute-on-string
  (if (not (fboundp 'ccl-execute-on-string))
      (function (lambda (ccl-prog status str &optional contin)
		  (exec-ccl-string ccl-prog status str)))
    (if (not (eq (aref (compose-string "AB") 0) ?A))
	'ccl-execute-on-string
      (function
       (lambda (ccl-prog status str &optional contin)
	 (with-temp-buffer
	   (set-buffer-multibyte nil)
	   (insert (ccl-execute-on-string ccl-prog status str contin t))
	   (goto-char (point-min))
	   (let (comp-bytepos-list comp-start case-fold-search)
	     (while (search-forward "\200" nil t)
	       (delete-char -1)
	       (setq comp-start (point))
	       (while (looking-at "[\240-\275]")
		 (cond ((eq (following-char) ?\240) ; ascii
			(delete-char 1)
			(insert (- (following-char) ?\200))
			(delete-char 1))
		       (t
			(let* ((leading-byte (- (following-char) ?\x20))
			       (bytes (cond ((< leading-byte ?\x90) 1)
					    ;;((< leading-byte ?\x9A) 2)
					    ((< leading-byte ?\x9C) 2)
					    (t 3))))
			  (delete-char 1)
			  (insert leading-byte)
			  (forward-char bytes)))))
	       (setq comp-bytepos-list
		     (cons (cons comp-start (point)) comp-bytepos-list)))
	     (set-buffer-multibyte t)
	     (while comp-bytepos-list
	       (compose-region (byte-to-position (car (car comp-bytepos-list)))
			       (byte-to-position (cdr (car comp-bytepos-list))))
	       (setq comp-bytepos-list (cdr comp-bytepos-list)))
	     (buffer-string))))))))

(defalias 'od-make-char
  (if (fboundp 'make-character)
      'make-character
    ;; 'make-char can't be used because it's a macro.
    ;; (macros cannot be `funcall'ed in a bytecode.)
    (function (lambda (charset &optional c1 c2)
		(make-char charset c1 c2)))))

(defalias 'od-char-japanese-p
  (if (fboundp 'char-category-set)
      (function (lambda (ch)
		  (aref (char-category-set ch) ?j)))
    (function (lambda (ch)
		(string-match "j" (char-category ch))))))

(defalias 'od-char-kana-p
  (if (fboundp 'char-category-set)
      (function (lambda (ch)
		  (setq ch (char-category-set ch))
		  (or (aref ch ?H)
		      (aref ch ?K))))
    (function (lambda (ch)
		(string-match "[HK]" (char-category ch))))))

(defalias 'od-string-as-multibyte
  ;; (fboundp 'string-as-multibyte) may be foiled by `emu' package.
  (if (>= ndtp-mule-version 4)
      'string-as-multibyte
    'identity))

(defalias 'od-string-bytes
  (if (and (fboundp 'string-bytes) (> (char-bytes ?あ) 1))
      'string-bytes
    'length))

;;;(defmacro od-char-ascii-p (char)
;;;  (if (fboundp 'char-leading-char)
;;;      (` (= (char-leading-char (, char)) 0))
;;;    (` (eq (char-charset (, char)) 'ascii))))


;;; Some utility functions.
;;; These are coded a little trickily so that the byte code compiler
;;; can minimize variable references inside the compiled code.
(defmacro od-save-n-setq (bindings &rest body)
  "(od-save-n-setq ((SYM1 EXP1) ...) BODY): eval EXPs and save them, eval BODY, and then set SYMs to the saved values.
The return value of the `od-save-n-setq' form is the value of EXP1.
Note: You should not use this for saving global variables; you can not
restore the correct value if quitting or error occurs inside BODY."
  (setq bindings (reverse bindings))
  (while bindings
    (setq body
	  (` ((setq (, (car (car bindings)))
		    (prog1 (, (car (cdr (car bindings))))
		      (,@ body))))))
    (setq bindings (cdr bindings)))
  (car body))

(put 'od-save-n-setq 'lisp-indent-function 1)

(defun od-nreverse (list &optional trailer)
  "Like `nreverse', but TRAILER is attached to the tail of the reversed list."
  (if (null list)
      trailer
    (setcdr (prog1 list (setq list (nreverse list)))
	    trailer)
    list))

(defun od-xtoi (string &optional from to)
  "Convert STRING to an integer by parsing it as a hexadecimal number.
Optional arguments FROM and TO specify end points of STRING.
If omitted, 0 and (length STRING) are used respectively."
  (let ((result 0))
    (or to (setq to (length string)))
    (setq from (or from 0))
    (while (< from to)
      (od-save-n-setq ((from (1+ from)))
	(setq from (aref string from))
	(setq result (+ (- from
			   (cond ((and (>= from ?0) (<= from ?9))
				  ?0)
				 ((and (>= from ?a) (<= from ?f))
				  (- ?a 10))
				 ((and (>= from ?A) (<= from ?F))
				  (- ?A 10))
				 (t
				  from)))
			(* result 16)))))
    result))
;; Using `string-to-number' for parsing hexadecimal numbers is
;; sometimes problematic because "15e2" may be treated as a floating
;; number 1500.0
(if (condition-case nil
	(= (string-to-number "15e2" 16) 5602)
      (error nil))
    (fset 'od-xtoi
	  (function
	   (lambda (string &optional from to)
	     (string-to-number (substring string (or from 0) to) 16)))))

(defun od-bcd-to-int (string &optional from to)
  "Convert STRING to an integer by parsing it as a Binary Coded Decimal.
Optional arguments FROM and TO specify end points of STRING.
If omitted, 0 and (length STRING) are used respectively."
  (let ((result 0))
    (or to (setq to (length string)))
    (setq from (or from 0))
    (while (< from to)
      (od-save-n-setq ((from (1+ from)))
	(setq from (aref string from))
	(setq result (+ from (* (/ from 16) (- 10 16)) (* result 100)))))
    result))

(defun od-int-to-little-endian (integer nbytes)
  (let ((result (make-string nbytes 0))
	(i 0))
    (while (< i nbytes)
      (aset result i (% (prog1 integer (setq integer (/ integer 256)))
			256))
      (setq i (1+ i)))
    result))

(defun od-little-endian-to-int (string &optional from to)
  (let ((result 0))
    (or from (setq from 0))
    (setq to (or to (length string)))
    (while (> to from)
      (setq result (+ (aref string (setq to (1- to)))
		      (* result 256))))
    result))

(defun od-mirror-byte (byte)
  (+ (* (aref "\000\010\004\014\002\012\006\016\
\001\011\005\015\003\013\007\017" (% byte 16)) 16)
     (aref "\000\010\004\014\002\012\006\016\
\001\011\005\015\003\013\007\017" (/ byte 16))))

(defun od-mirror-string-bytes (string)
  (let* ((i (length string))
	 (result (make-string i 0)))
    (while (>= (setq i (1- i)) 0)
      (aset result i (od-mirror-byte (aref string i))))
    result))

(defalias 'od-previous-overlay-change
  (if (fboundp 'previous-overlay-change)
      (function (lambda (pos)
		  ;; `(previous-overlay-change POS)' doesn't work
		  ;; properly if the overlays' center position
		  ;; precedes POS and some overlays end at POS.
		  (overlay-recenter pos)
		  (previous-overlay-change pos)))
    (function
     (lambda (pos)
       (if (= pos (point-min))
	   (point-min)
	 (let ((overlays (overlays-at pos))
	       (prev (point-min)))
	   (while overlays
	     (let ((ostart (overlay-start (car overlays))))
	       (if (and (< prev ostart) (< ostart pos))
		   (setq prev ostart)))
	     (setq overlays (cdr overlays)))
	   (overlay-recenter pos)
	   (setq overlays (car (overlay-lists)))
	   (while overlays
	     (let ((oend (overlay-end (car overlays))))
	       (cond ((< oend pos)
		      (if (< prev oend) (setq prev oend)))
		     ;; (= oend pos)
		     ((< prev (overlay-start (car overlays)))
		      (setq prev (overlay-start (car overlays))))))
	     (setq overlays (cdr overlays)))
	   prev))))))


(defun od-filter-buffer ()
  (let ((tmp od-dict-filter-regexp-list)
	case-fold-search)
    (while tmp
      (goto-char (point-min))
      (while (re-search-forward (car (car tmp)) nil t)
	(replace-match (cdr (car tmp)) t))
      (setq tmp (cdr tmp)))))

(defun od-convert-one-digit-superscript ()
  (while (re-search-forward "\\^{[0-9]}" nil t)
    (let ((digit (char-after (+ (match-beginning 0) 2))))
      (replace-match
       (or (and (not od-use-only-ascii-and-jisx0208)
		(cdr (assq digit od-one-digit-superscript-table)))
	   (format "^%c" digit)) t t))))


(defvar odic-lookup-map nil "")
(if odic-lookup-map
    ()
  (setq odic-lookup-map (make-sparse-keymap "Lookup"))
  (define-key odic-lookup-map [show-home-headers]
    '("Home Menu" . od-show-home-headers))
  (define-key odic-lookup-map [make-headers-from-references]
    '("Menu from References" . od-make-headers-from-references))
  (define-key odic-lookup-map [lookup-pattern-with-ispell]
    '("Lookup Pattern with Ispell" . od-lookup-pattern-with-ispell))
  (define-key odic-lookup-map [lookup-pattern]
    '("Lookup Pattern" . od-lookup-pattern)))

(put 'od-make-headers-from-references 'menu-enable 'od-references)
(let ((lookup-pattern-enable
       '(or (memq ?a od-word-types) (memq ?A od-word-types)
	    (memq ?k od-word-types) (memq ?K od-word-types))))
  (put 'od-lookup-pattern-with-ispell 'menu-enable
       lookup-pattern-enable)
  (put 'od-lookup-pattern 'menu-enable
       lookup-pattern-enable))

(defalias 'od-change-dictionary-menu
  (let ((dics (reverse od-dict-parameters))
	(change-dictionary-map '("Change Dictionary")))
    (while dics
      (setq change-dictionary-map
	    (cons (cons (car (car dics))
			(cons (car (car dics))
			      (cons '(nil)
				    'od-menu-bar-change-dictionary)))
		  change-dictionary-map))
      (setq dics (cdr dics)))
    (cons 'keymap change-dictionary-map)))

(defvar odic-dict-map nil "")
(if odic-dict-map
    ()
  (setq odic-dict-map (make-sparse-keymap "Dict"))
  (define-key odic-dict-map [really-quit]
    '("Quit and Disconnect" . od-really-quit))
  (define-key odic-dict-map [quit]
    '("Quit" . od-quit))
  (define-key odic-dict-map [toggle-character-sets]
    '("Toggle Character Sets" . od-toggle-character-sets))
  (define-key odic-dict-map [toggle-summary-mode]
    '("Toggle Summary" . od-toggle-summary-mode))
  (define-key odic-dict-map [next-history]
    '("Next History" . od-next-history))
  (define-key odic-dict-map [previous-history]
    '("Previous History" . od-previous-history))
  (define-key odic-dict-map [change-dictionary]
    '("Change Dictionary" . od-change-dictionary-menu)))

(put 'od-previous-history 'menu-enable
     '(let ((previous-point
	     (% (+ od-history-drifting-point od-history-length -1)
		od-history-length)))
	(and (/= od-history-current-point previous-point)
	     (od-histelm previous-point))))
(put 'od-next-history 'menu-enable
     '(let ((next-point
	     (% (1+ od-history-drifting-point) od-history-length)))
	(and (/= od-history-current-point od-history-drifting-point)
	     (od-histelm next-point))))

(put 'od-toggle-summary-mode 'menu-enable 'od-dict-summary)

(defvar odic-pretty-name-map nil "")
(if odic-pretty-name-map
    ()
  (setq odic-pretty-name-map (make-sparse-keymap))
  (define-key odic-pretty-name-map [mode-line down-mouse-1]
    'od-change-dictionary-menu)
  (define-key odic-pretty-name-map [top-line down-mouse-1]
    'od-change-dictionary-menu))

(defvar odic-fundamental-map nil)
(if odic-fundamental-map
    nil
  (setq odic-fundamental-map (make-keymap))
  (let ((self-insert-command (lookup-key global-map "0")))
    (substitute-key-definition self-insert-command 'undefined
			       odic-fundamental-map global-map))
  (define-key odic-fundamental-map "f" 'od-lookup-pattern)
  (define-key odic-fundamental-map "i" 'od-lookup-pattern-with-ispell)
  (define-key odic-fundamental-map "a" 'od-lookup-pattern-alphabet)
  (define-key odic-fundamental-map "z" 'od-lookup-pattern-kana)
  (define-key odic-fundamental-map "o" 'other-window)
  (define-key odic-fundamental-map "h" 'backward-char)
  (define-key odic-fundamental-map "j" 'next-line)
  (define-key odic-fundamental-map "k" 'previous-line)
  (define-key odic-fundamental-map "l" 'forward-char)
  (define-key odic-fundamental-map "w" 'forward-word)
  (define-key odic-fundamental-map "b" 'backward-word)
  (define-key odic-fundamental-map "e" 'od-lookup-pattern-edit)
  (define-key odic-fundamental-map "q" 'od-quit)
  (define-key odic-fundamental-map "Q" 'od-really-quit)
  (define-key odic-fundamental-map "v" 'od-version)
  (define-key odic-fundamental-map "C" 'od-change-dictionary)
  (define-key odic-fundamental-map "E" 'od-toggle-summary-mode)
  (define-key odic-fundamental-map ":" 'od-toggle-summary-mode)
  (define-key odic-fundamental-map "S" 'od-toggle-character-sets)
  (define-key odic-fundamental-map "H" 'od-show-home-headers)
  (define-key odic-fundamental-map "m" 'od-make-headers-from-references)
  (define-key odic-fundamental-map "\e " 'od-make-headers-from-references)
  (define-key odic-fundamental-map "<" 'beginning-of-buffer)
  (define-key odic-fundamental-map ">" 'end-of-buffer)
  (define-key odic-fundamental-map [down-mouse-2] nil)
  (define-key odic-fundamental-map [menu-bar dict]
    (cons "Dict" odic-dict-map))
  (define-key odic-fundamental-map [menu-bar lookup]
    (cons "Lookup" odic-lookup-map)))

(defvar odic-mode-syntax-table nil
  "Syntax table used while in odic mode.")

(defvar odic-mode-abbrev-table nil
  "Abbrev table used while in odic mode.")
(define-abbrev-table 'odic-mode-abbrev-table ())

(if odic-mode-syntax-table
    ()
  (setq odic-mode-syntax-table (make-syntax-table)))

(defvar odic-mode-map nil "")
(if odic-mode-map
    ()
  (setq odic-mode-map (cons 'keymap odic-fundamental-map))
  (define-key odic-mode-map "." 'od-show-current-entry)
  (define-key odic-mode-map " " 'od-scroll-entry-up-or-select-genealogy)
  (define-key odic-mode-map "\177" 'od-scroll-entry-down)
  (define-key odic-mode-map "d" 'od-scroll-entry-up-half)
  (define-key odic-mode-map "u" 'od-scroll-entry-down-half)
  (define-key odic-mode-map "\C-m" 'od-scroll-entry-up-line-or-select-genealogy)
  (define-key odic-mode-map "\e\C-m" 'od-scroll-entry-down-line)
  (define-key odic-mode-map "\ep" 'od-previous-history)
  (define-key odic-mode-map "\en" 'od-next-history)
  (define-key odic-mode-map "p" 'od-previous-entry)
  (define-key odic-mode-map "n" 'od-next-entry)
  (define-key odic-mode-map "s" 'od-select-entry)
  (define-key odic-mode-map "1" 'od-direct-select-entry)
  (define-key odic-mode-map "2" 'od-direct-select-entry)
  (define-key odic-mode-map "3" 'od-direct-select-entry)
  (define-key odic-mode-map "4" 'od-direct-select-entry)
  (define-key odic-mode-map "5" 'od-direct-select-entry)
  (define-key odic-mode-map "6" 'od-direct-select-entry)
  (define-key odic-mode-map "7" 'od-direct-select-entry)
  (define-key odic-mode-map "8" 'od-direct-select-entry)
  (define-key odic-mode-map "9" 'od-direct-select-entry)
  (define-key odic-mode-map [mouse-2] 'od-mouse-select-entry)
  (define-key odic-mode-map "?" 'describe-mode))

(defun od-set-mode-line-format ()
  (setq mode-line-buffer-identification
	'("Dict: " od-dict-pretty-name
	  (od-current-pattern ("<"od-current-pattern ">") nil)
	  od-summary-current-display-mode)))

(defun od-set-mode-line-format-body ()
  (setq mode-line-buffer-identification
	'("Dict: " od-dict-pretty-name
	  (od-body-current-pattern ("<"od-body-current-pattern ">") nil)
	  od-summary-current-display-mode)))

(defun odic-mode ()
  "Major mode for editing odic intended for humans to read.

Commands:(共通)\\<odic-fundamental-map>
\\[od-lookup-pattern]\
	検索を行ないます.
	パターンは半角アルファベット(アルファベット検索),
	平仮名, 片仮名(かな検索) で入力します.
	パターンを入力せずに、リターンのみを入力すると,
	アルファベット入力と日本語入力とを切り替えます.
	パターンは語頭または語尾に1つの \"*\" を付けることができます.
	その際, \"*\" は0文字以上の任意の文字列を意味します.
	パターンは任意の位置に \"?\" をいくつでも含むことができます.
	その際, \"?\" は任意の1文字を意味します.
\\[od-lookup-pattern-with-ispell]\
	ispellを用いてあやふやな綴から入力パターンを選びます.
	(英和辞書の時便利)
\\[od-quit]\
	オンライン辞書起動前のウインドウコンフィグレーションに戻ります.
\\[od-really-quit]\
	オンライン辞書の持つバッファを全て削除し,
	オンライン辞書起動前のウインドウコンフィグレーションに戻ります.
\\[od-change-dictionary]\
	辞書を切替えます.  コンプリーション入力が可能です.
\\[od-toggle-summary-mode]\
	英和辞典での例文の表示の ON/OFF を切替えます.
\\[od-toggle-character-sets]\
	本文の表示に用いられる文字集合の集まり(端末用と X 用)を切替えます.
\\[od-show-home-headers]\
	現在使っている辞書で利用可能な検索方法を新しい見出しとします.
	メニュー検索や著作権表示はここからたどります.
\\[od-make-headers-from-references]\
	本文中に他の部分を参照しているところ(下線部)があれば、
	その参照している部分を集めて新しい見出しとします.

Commands:(候補を表示しているバッファ)\\<odic-mode-map>
\\[od-show-current-entry]\
	現在の候補の説明文を表示します.
\\[od-previous-entry]\
	直前の候補の説明文を表示します.
\\[od-next-entry]\
	直後の候補の説明文を表示します.
\\[od-select-entry]\
	候補を番号で選び, その説明文を表示します.
\\[od-mouse-select-entry]\
	マウスカーソルの下にある候補の説明文を表示します.
	(X で使用しているときのみ)
1-9	1-9番の候補を直接選び, その説明文を表示します.
	10番以降は \"\\[od-select-entry]\" または \"\\[od-next-entry]\" コマンドを使って下さい.
\\[od-scroll-entry-up-or-select-genealogy]\
	説明文を od-scroll-step で示された値だけ上にスクロールします.
\\[od-scroll-entry-down]\
	説明文を od-scroll-step で示された値だけ下にスクロールします.
\\[od-scroll-entry-up-half]\
	説明文を od-scroll-step で示された値の半分だけ上にスクロールします.
\\[od-scroll-entry-down-half]\
	説明文を od-scroll-step で示された値の半分だけ下にスクロールします.
\\[od-scroll-entry-up-line-or-select-genealogy]\
	説明文を一行だけ上にスクロールします.
\\[od-scroll-entry-down-line]\
	説明文を一行だけ下にスクロールします.
	これらのコマンドは説明文が表示されていなければ \"\\[od-show-current-entry]\" と同じ動作をします.
	od-scroll-step には, 整数, half, full のいずれかが指定できます.
	デフォルトは full です.
	また, \"\\[od-scroll-entry-up-or-select-genealogy]\" と \"\\[od-scroll-entry-up-line-or-select-genealogy]\" に関しては, prefix を付けることにより,
	参照関係の履歴を移動することができます.
	(例えば, \"\\[negative-argument]\" の後に \"\\[od-scroll-entry-up-or-select-genealogy]\" か \"\\[od-scroll-entry-up-line-or-select-genealogy]\" を行うと, 参照元に戻ります.)
\\[od-previous-history]\
	ヒストリーを遡ります.
\\[od-next-history]\
	遡ったヒストリーを戻ります.

Commands:(本文を表示しているバッファ)\\<odic-body-mode-map>
\\[od-mouse-lookup-reference]\
	マウスカーソルの下に他の部分を参照しているところ(下線部)がある場合,
	その説明文を表示します.(X で使用しているときのみ)
	例文の表示の部分的な ON/OFF にも使われます.
\\[od-lookup-reference]\
	カーソルの下に他の部分を参照しているところ(下線部)がある場合,
	その説明文を表示します.
	例文の表示の部分的な ON/OFF にも使われます.

Special commands:\\{odic-mode-map}
Turning on odic-mode calls the value of the variable odic-mode-hook,
if that value is non-nil."
  (interactive)
  (kill-all-local-variables)
  (use-local-map odic-mode-map)
  (setq mode-name "Dict")
  (setq major-mode 'odic-mode)
  (setq local-abbrev-table odic-mode-abbrev-table)
  (set-syntax-table odic-mode-syntax-table)
  (setq buffer-read-only t)
  (make-local-variable 'goal-column)
  (setq goal-column 4)
  (od-set-mode-line-format)
  (buffer-disable-undo)
  (if (fboundp 'make-local-hook)
      (progn
	(make-local-hook 'isearch-mode-hook)
	(add-hook 'isearch-mode-hook 'od-strip-stress-buffer nil t)
	(make-local-hook 'isearch-mode-end-hook)
	(add-hook 'isearch-mode-end-hook 'od-restore-stress-buffer nil t)))
  (make-face 'od-bold-inverse-default)
  (copy-face 'bold 'od-bold-inverse-default)
  (if (fboundp 'set-face-inverse-video-p)
      (set-face-inverse-video-p 'od-bold-inverse-default t)
    (invert-face 'od-bold-inverse-default))
  (run-hooks 'odic-mode-hook))

(defvar odic-body-mode-syntax-table nil
  "Syntax table used while in odic body mode.")

(defvar odic-body-mode-abbrev-table nil
  "Abbrev table used while in odic body mode.")
(define-abbrev-table 'odic-body-mode-abbrev-table ())

(if odic-body-mode-syntax-table
    ()
  (setq odic-body-mode-syntax-table (make-syntax-table)))

(defvar odic-body-mode-map nil "")
(if odic-body-mode-map
    ()
  (setq odic-body-mode-map (cons 'keymap odic-fundamental-map))
  (define-key odic-body-mode-map "p" 'previous-line)
  (define-key odic-body-mode-map "n" 'next-line)
  (define-key odic-body-mode-map "[" 'backward-page)
  (define-key odic-body-mode-map "]" 'forward-page)
  (define-key odic-body-mode-map "=" 'od-toggle-narrow-to-page)
  (define-key odic-body-mode-map " " 'scroll-up)
  (define-key odic-body-mode-map "\177" 'scroll-down)
  (define-key odic-body-mode-map "0" 'beginning-of-line)
  (define-key odic-body-mode-map "$" 'end-of-line)
  (define-key odic-body-mode-map [mouse-2] 'od-mouse-lookup-reference)
  (define-key odic-body-mode-map "\C-m" 'od-lookup-reference)
  (define-key odic-body-mode-map "\C-i" 'od-next-link)
  (define-key odic-body-mode-map "\e\C-i" 'od-previous-link)
  (define-key odic-body-mode-map "\C-o" 'od-previous-link))

(defun odic-body-mode ()
  "Major mode for editing odic intended for humans to read.
Special commands:\\{odic-body-mode-map}
Turning on odic-body-mode calls the value of the variable odic-body-mode-hook,
if that value is non-nil.
See the documentation of `odic-mode' for more information on this mode."
  (interactive)
  (kill-all-local-variables)
  (use-local-map odic-body-mode-map)
  (setq mode-name "DictBody")
  (setq major-mode 'odic-body-mode)
  (setq local-abbrev-table odic-body-mode-abbrev-table)
  (set-syntax-table odic-body-mode-syntax-table)
  (setq buffer-read-only t)
  (od-set-mode-line-format-body)
  (make-local-variable 'outline-regexp)
  (make-local-variable 'outline-heading-end-regexp)
  ;; As of Emacs 21.3.50, the default value of `paragraph-start' is
  ;; changed to that of text-mode.
  (make-local-variable 'paragraph-start)
  (setq paragraph-start "[ \t\n\f]")
  (if od-dict-summary
      (setq outline-regexp (car od-dict-summary)
	    outline-heading-end-regexp (cdr od-dict-summary)))
  (outline-minor-mode 1)
  (buffer-disable-undo)
  (if (fboundp 'make-local-hook)
      (progn
	(make-local-hook 'isearch-mode-hook)
	(add-hook 'isearch-mode-hook 'od-strip-stress-buffer nil t)
	(make-local-hook 'isearch-mode-end-hook)
	(add-hook 'isearch-mode-end-hook 'od-restore-stress-buffer nil t)))
  (run-hooks 'odic-body-mode-hook))


(defun od-open-dictionary ()
  (cond ((null od-dict-name)
	 (od-change-dictionary)
	 (or od-dict-list
	     (error "接続可能なサーバがありません.")))
	((not (eq (process-status od-dict) 'open))
	 (od-really-change-dictionary od-dict-name))))

(defun od-connect-to-servers ()
  (let ((server-list od-server-list)
	new-dict-list dict)
    (while server-list
      (let ((server (car server-list)))
	(setq dict (car od-dict-list))
	(if (not (and od-dict-list
		      (or (null dict) (eq (process-status dict) 'open))))
	    (progn
	      (message "Connecting to %s server on %s..."
		       (od-server-service server) (od-server-name server))
	      (if (condition-case nil
		      (setq dict (ndtp-open (od-server-name server)
					    (od-server-service server)))
		    (file-error (setq dict nil)))
		  (if (not (eq (ndtp-command-status
				(ndtp-get-access-permission dict)) t))
		      (progn
			(ndtp-close dict t)
			(setq dict nil))))
	      (message nil)))
	(setq od-dict-list (cdr od-dict-list))
	(setq new-dict-list (cons dict new-dict-list))
	(if (equal (od-server-name dserver-current-server) server)
	    (setq od-dict dict)))
      (setq server-list (cdr server-list)))
    (if (eval (cons 'or new-dict-list))
	(setq od-dict-list (nreverse new-dict-list))
      (setq od-dict-list nil)))
  od-dict-list)

(defun od-setup-windows ()
  (delete-other-windows)
  (split-window (selected-window) od-window-config)
  ;; In emacs 19.30-34 window won't scroll after delete-other-window
  ;; even if the cursor position enters invisible area afterward.
  (if (or (and (string< "19.30" emacs-version)
	       (string< emacs-version "19.34.91"))
	  (not (eq (window-buffer) od-dict-header-buffer)))
      (switch-to-buffer od-dict-header-buffer-name))
  (other-window 1)
  (switch-to-buffer od-dict-body-buffer-name)
  (other-window 1))

(defun od-kill-active-buffers ()
  (kill-buffer od-dict-header-buffer-name)
  (kill-buffer od-dict-body-buffer-name))

(defun od-set-header ()
  (od-setup-windows)
  (set-buffer od-dict-header-buffer-name))

(defun od-set-body ()
  (od-setup-windows)
  (set-buffer od-dict-body-buffer-name))

;;;###autoload
(defun online-dictionary ()
  (interactive)
  (if (and (eq window-system 'x) od-frame-geometry)
      (diclookup-other-frame)
    (diclookup)))

;;;###autoload
(defun diclookup ()
  (interactive)
  (let ((is-first (not od-dict)))
    (if (or is-first (not dserver-current-server))
	(setq dserver-current-server (car od-server-list)))
    (if (not (or (od-dictionary-frame-p)
		 (eq major-mode 'odic-mode)
		 (eq major-mode 'odic-body-mode)))
	(setq od-previous-config (current-window-configuration)))
    (setq od-dict-header-buffer
	  (get-buffer-create od-dict-header-buffer-name))
    (setq od-dict-body-buffer
	  (get-buffer-create od-dict-body-buffer-name))
    (set-buffer od-dict-header-buffer)
    (or (eq major-mode 'odic-mode) (odic-mode))
    (set-buffer od-dict-body-buffer)
    (or (eq major-mode 'odic-body-mode) (odic-body-mode))
    (od-set-header)
    (if is-first
	(if (and od-default-jisyo
		 (od-really-change-dictionary od-default-jisyo))
	    nil
	  (delete-other-windows)
	  (od-show-title)))
    (if od-show-help-automatically
	(describe-mode))))

(defun od-make-dictionary-frames-visible ()
  (let ((frames (frame-list)))
    (while frames
      (if (od-dictionary-frame-p (car frames))
	  (make-frame-visible (car frames)))
      (setq frames (cdr frames)))))

(defun od-raise-dictionary-frames ()
  (let ((frames (frame-list)))
    (while frames
      (if (od-dictionary-frame-p (car frames))
	  (raise-frame (car frames)))
      (setq frames (cdr frames)))))

;;;###autoload
(defun diclookup-other-frame ()
  "Like `diclookup' command, but display diclookup buffer in another frame."
  (interactive)
  (run-hooks 'od-pre-pop-to-buffer-hook)
  (let* ((pop-up-frames t)
	 (frame-geometry (or od-frame-geometry ""))
	 (pop-up-frame-alist
	  (append
	   (list (cons 'name od-frame-name))
	   (and od-frame-font
		(list (cons 'font od-frame-font)))
	   (x-parse-geometry frame-geometry)
	   od-frame-alist))
	 (special-display-frame-alist pop-up-frame-alist))
    (pop-to-buffer od-dict-header-buffer-name))
  (run-hooks 'od-post-pop-to-buffer-hook)
  (diclookup))

(defun od-show-title ()
  (let (buffer-read-only)
    (erase-buffer)
    (insert "

		     電子ブック版辞書検索システム
"
	    (mapconcat 'identity od-title-name "\n")
	    "

		 Copyright (C) Shingo NISHIOKA, 1991
		    nishioka@sanken.osaka-u.ac.jp

		 Modified by SAITO Yutaka, 1993
		    yutaka@sys1.cpg.sony.co.jp

		 Modified by YAMAMOTO Mitsuharu, 1994-2002 (*)
		    mituharu@math.s.chiba-u.ac.jp

			(*) ... Maintainer

"
	    (mapconcat 'identity od-title-trademark "\n") "\n"))
  (set-buffer-modified-p nil)
  (goto-char (point-min)))

(defun od-show-home-references ()
  (switch-to-buffer-other-window od-dict-body-buffer)
  (let (buffer-read-only)
    (erase-buffer)
    (if window-system
	(insert (substitute-command-keys
		 "Click \\[od-mouse-lookup-reference] \
on a method to select it.\n")))
    (insert (substitute-command-keys
	     "In this buffer, type \\[od-lookup-reference] \
to select the method near point.\n\n")
	    (format "\nこの辞書は以下の%d種類の検索が可能です.\n\n"
		    (length od-home-headers)))
    (let ((home-headers od-home-headers)
	  (i 1))
      (while home-headers
	(od-alloc-overlay (point)
			  (progn (insert (car (car home-headers))) (point))
			  (prog1 i (setq i (1+ i))))
	(insert ?\n)
	(setq home-headers (cdr home-headers)))
      (od-free-overlay)
      (setq od-references od-home-headers)))
  (set-buffer-modified-p nil)
  (setq od-body-current-pattern nil)
  (setq od-body-genealogy nil)
  (goto-char (point-min))
  (other-window 1))

(defun od-menu-bar-change-dictionary ()
  (interactive)
  (od-really-change-dictionary last-command-event))

(defun od-change-dictionary ()
  (interactive)
;  (cond ((eql od-fep-type 'canna)
;	 (save-excursion
;	   (set-buffer (window-buffer (minibuffer-window)))
;	   (if canna:*japanese-mode-in-minibuffer*
;	       (canna-toggle-japanese-mode)))))
  (let ((new-dic (completing-read "Select jisyo: " od-dict-parameters nil t)))
    (od-really-change-dictionary new-dic)))

(defun od-really-change-dictionary (new-dic)
  (if (null (od-connect-to-servers))
      nil
    (let ((dict-list od-dict-list)
	  (dserver-list od-server-list)
	  new-dict dict old-dict-name)
      (while dict-list
	(setq dict (car dict-list))
	(if dict
	    (if (string= (ndtp-command-result
			  (ndtp-get-dictionary dict new-dic))
			 "$*")
		(setq new-dict dict
		      dserver-current-server (car dserver-list)
		      dict-list nil)))
	(setq dserver-list (cdr dserver-list))
	(setq dict-list (cdr dict-list)))
      (if (null new-dict)
	  (error "辞書をセットできませんでした.")
	(setq od-dict new-dict))
      (od-set-dict-parameters od-default-dict-alist)
      (od-set-dict-parameters (cdr (assoc new-dic od-dict-parameters)))
      (set-buffer od-dict-body-buffer)
      (if od-dict-summary
	  (setq outline-regexp (car od-dict-summary)
		outline-heading-end-regexp (cdr od-dict-summary)))
      (setq old-dict-name od-dict-name)
      (setq od-dict-name new-dic)
      (add-text-properties 0 (length od-dict-pretty-name)
			   (list 'local-map odic-pretty-name-map
				 'help-echo "mouse-1: change dictionary")
			   od-dict-pretty-name)
      (setq od-dict-info (od-get-info))
      (od-set-home-headers-and-index-types)
      (setq od-server-implementation
	    (ndtp-guess-server-implementation od-dict))
      (if (string= od-dict-name old-dict-name)
	  (od-set-header)
	(od-reset-history old-dict-name od-dict-name)
	(od-set-body)
	(let ((buffer-read-only nil))
	  (erase-buffer))
	(set-buffer-modified-p nil)
	(setq od-recent-entry-in-body-flag nil)
	(setq od-summary-current-display-mode
	      (if (and od-dict-summary od-summary-mode) "[Summary]" ""))
	(od-set-header)
	(delete-other-windows)
	(if (not od-headers)
	    (od-show-title)
	  (od-show-headers)
	  (setq od-current-entry -1))
	(od-show-home-references))
      (message "辞書が「%s(%s)」にセットされました."
	       od-dict-pretty-name
	       (od-server-name dserver-current-server)))))

(defun od-get-info ()
  "Return the list of available search types.
Each element is in the form (search-type-id . frame-number)."
  (let* ((i 16)
	 (info-block (od-get-frame 1))
	 (len (* (aref info-block 1) 16))
	 (info (list (cons 'protection (aref info-block 3)))))
    (while (<= i len)
      (setq info
	    (cons
	     (cons (aref info-block i)
		   (+ (* (+ (* (+ (* (aref info-block (+ i 2)) 256)
				  (aref info-block (+ i 3))) 256)
			    (aref info-block (+ i 4))) 256)
		      (aref info-block (+ i 5))))
	     info))
      (setq i (+ i 16)))
    info))

;;;
;;; modified by yutaka@sys1.cpg.sony.co.jp
;;;
(defun od-lookup-pattern (&optional input-type)
  (interactive)
  (od-open-dictionary)
  (let* ((japanese-input
	  (cond ((null input-type) od-dict-japanese-input)
		((eq input-type 'alphabet) nil)
		((eq input-type 'kana) t)))
	 (pat (od-read-pattern japanese-input)))
    (od-really-lookup-pattern pat)))

(defun od-lookup-pattern-alphabet ()
  (interactive)
  (od-lookup-pattern 'alphabet))

(defun od-lookup-pattern-kana ()
  (interactive)
  (od-lookup-pattern 'kana))

;;; hope this obviates `kana=hyouki' in dserver's *.tbl configuration files
(defun od-emulate-kana=hyouki (type)
  (if (and (eq od-server-implementation 'dserver)
	   (or (eq type ?k) (eq type ?K))
	   (not (memq type od-index-types)))
      (+ type (- ?a ?k))
    type))

(defun od-really-lookup-pattern (pat)
  (od-open-dictionary)
  (let* ((type (od-type-and-regular-pattern pat))
	 (regular-pat (cdr type))
	 (type (car type))
	 (original-dict-name od-dict-name)
	 (secondary-dict-name (cdr (assq type od-dict-secondary-dictionary))))
    (cond (secondary-dict-name
	   (od-really-change-dictionary secondary-dict-name)
	   (if (not (memq type od-word-types))
	       (progn
		 (od-really-change-dictionary original-dict-name)
		 (error "その検索方法は使えません."))))
	  ((not (memq type od-word-types))
	   (error "その検索方法は使えません.")))
    (let ((rev-headers
	   (od-find-entries (od-emulate-kana=hyouki type) regular-pat)))
      (if (null rev-headers)
	  (od-no-entries-found pat)
	(setq od-current-pattern pat)
	(setq od-headers (nreverse rev-headers))
	(od-show-headers-delete-body-window)
	(if (and od-select-unique-entry-immediately
		 (= 1 (length od-headers)))
	    (od-select-entry 1))))))

(defun od-type-and-regular-pattern (pat)
  (let ((bytes (od-string-bytes pat))
	(i 0) kana alpha kanji first char-list)
    (while (< i bytes)
      (let ((c (sref pat i)))
	(setq char-list
	      (cons
	       (cond ((or (= ?* c) (= ?＊ c))
		      (cond ((= i 0) ;at beginning
			     (setq first t))
			    ((= (+ i (char-bytes c)) bytes) ;at last
			     (if first
				 (error "\"*\"は1個しか使えません.")))
			    (t
			     (error "\"*\"はパターンの端以外では使えません.")))
		      ?*)
		     ((and (= ?? c)	;do nothing
			   (eq od-server-implementation 'dserver))
		      ??)
		     ((or (and (<= ?a c) (<= c ?z))
			  (and (<= ?A c) (<= c ?Z)))
		      (setq alpha t)
		      (+ c (- ?Ａ ?A)))
		     ((or (and (<= ?ａ c) (<= c ?ｚ))
			  (and (<= ?Ａ c) (<= c ?Ｚ)))
		      (setq alpha t)
		      c)
;;;		     ((od-char-ascii-p c))	; do nothing
		     ((od-char-kana-p c)
		      (setq kana t)
		      c)
		     ((od-char-japanese-p c)
		      (setq kanji t)
		      c)
		     (t
		      (error "検索に使えない文字`%c'が含まれています." c)))
	       char-list))
	(setq i (+ i (char-bytes c)))))
    (if (eq od-dict-type 'EB)
	(cond (kanji
	       (error "漢字による検索はできません."))
	      ((and kana alpha)
	       (message
		"仮名と英字が混ざっていますが, 仮名として検索を続けます."))))
    (cons (cond ((and (or kana kanji)
		      (or (not kanji)
			  (eq od-server-implementation 'ndtpd)))
		 (if first ?K ?k))
		((or alpha
		     (and kanji
			  (eq od-server-implementation 'dserver)))
		 (if first ?A ?a))
		(t
		 (error "検索方法が決定できません.")))
	  (mapconcat
	   (if (or kana kanji)
	       'char-to-string
	     (function
	      (lambda (c)
		(char-to-string
		 (if (and (>= c ?Ａ) (<= c ?ｚ))
		     (- c (- ?Ａ ?A))
		   c)))))
	   (if first char-list (nreverse char-list))
	   ""))))

(defun od-ndtp-pick-entry (result)
  (let ((entry (buffer-string)))
    (string-match "\n[^:]*:" entry)
    (setq entry
	  (list 'od-show-entry
		(od-xtoi entry
			 (1+ (match-beginning 0)) (1- (match-end 0)))
		(od-xtoi entry (match-end 0))))
    (setq entry
	  (cons (od-decode-header-region 1 (1+ (match-beginning 0)))
		entry))
    (if (member entry result)
	result
      (cons entry result))))

(defconst od-ndtp-entries-reader
  (ndtp-make-2lines-reader nil 'od-ndtp-pick-entry t))

(defun od-find-entries (type regular-pat &optional rev-headers)
  (ndtp-command-result
   (ndtp-get-entries od-dict type regular-pat rev-headers
		     od-ndtp-entries-reader)))

(defun od-get-ccl (only-ascii-and-jisx0208)
  (let ((vector-or-symbol
	 (if only-ascii-and-jisx0208 (cdr od-dict-ccl) (car od-dict-ccl))))
    (if (vectorp vector-or-symbol)
	vector-or-symbol
      (funcall vector-or-symbol))))

(defun od-decode-header-region (b e)
  (let ((tmp od-undo-dserver-translation-table)
	case-fold-search)
    (save-restriction
      (narrow-to-region b e)
      (ndtp-decode-euc-jp-region (point-min) (point-max))
      (if (eq od-server-implementation 'dserver)
	  (while tmp
	    (goto-char (point-min))
	    (while (search-forward (car (car tmp)) nil t)
	      (replace-match (cdr (car tmp)) t t))
	    (setq tmp (cdr tmp))))
      (goto-char (point-min))
      (while (re-search-forward "\\(#x[0-9a-f][0-9a-f]\\)+" nil t)
	(let* ((hexstr (buffer-substring (match-beginning 0) (match-end 0)))
	       (len (/ (length hexstr) 4))
	       (str (make-string (+ len 2) 0)))
	  (setq tmp 0)
	  (while (< tmp len)
	    (aset str tmp (od-xtoi hexstr (+ (* tmp 4) 2) (+ (* tmp 4) 4)))
	    (setq tmp (1+ tmp)))
	  (fillarray od-ccl-status 0)
	  (if od-dict-header-column
	      (aset od-ccl-status 3 1))
	  (delete-region (match-beginning 0) (match-end 0))
	  (insert (od-ccl-execute-on-string (od-get-ccl (null window-system))
					    od-ccl-status str))))
      (od-convert-adscript)
      (od-convert-one-digit-superscript)
      (od-string-as-multibyte (buffer-string)))))

(defun od-show-headers (&optional headers current-entry)
  (interactive)
  (setq headers (or headers od-headers))
  (setq current-entry (or current-entry od-current-entry))
  (od-set-header)
  (let (buffer-read-only)
    (erase-buffer)
    (insert (format "%d entries." (length od-headers)) ?\n)
    (let ((i 1))
      (while headers
	(insert (format "%3d: " (prog1 i (setq i (1+ i)))))
	(put-text-property
	 (point) (progn (insert (car (car headers))) (point))
	 'mouse-face 'highlight)
	(insert ?\n)
	(setq headers (cdr headers)))))
  (set-buffer-modified-p nil)
  (if (> current-entry 0)
      (goto-line (1+ current-entry))
    (goto-line 2))
  (forward-char 4))

(defun od-show-headers-delete-body-window ()
  (setq od-current-entry -1)
  (setq od-recent-entry-in-body-flag nil)
  (od-show-headers)
  (od-add-to-history 'clear)
  (delete-other-windows))

(defun od-set-home-headers-and-index-types ()
  (setq od-home-headers nil
	od-word-types nil
	od-index-types nil)
  (let ((index-type-table (cdr (assq od-dict-type od-index-type-tables))))
    (while index-type-table
      (let* ((index-type (car index-type-table))
	     (match (assq (car index-type) od-dict-info)))
	(if match
	    (progn
	      (setq od-home-headers
		    (cons
		     (if (nth 4 index-type)
			 (list (nth 2 index-type) (nth 3 index-type)
			       (cdr match))
		       (list (nth 2 index-type) (nth 3 index-type)))
		     od-home-headers))
	      (if (car (cdr index-type))
		  (setq od-word-types
			(append (car (cdr index-type)) od-word-types)
			od-index-types
			(cons (car (car (cdr index-type))) od-index-types))))))
      (setq index-type-table (cdr index-type-table)))))

(defun od-show-home-headers ()
  (interactive)
  (setq od-headers od-home-headers)
  (setq od-current-pattern nil)
  (od-show-headers-delete-body-window))

(defun od-mouse-select-entry (click)
  (interactive "e")
  (let ((start (event-start click)))
    (select-window (posn-window start))
    (goto-char (posn-point start)))
  (od-select-entry (od-current-header-line)))

(defun od-select-entry (n)
  (interactive "nNumber:")
  (if (or (< n 1) (> n (length od-headers)))
      (if od-headers
	  (message "%d out of range" n))
    (setq od-current-entry n)
    (od-set-header)
    (goto-line (1+ n))
    (forward-char 4)
    (let ((nthheader (nth (1- n) od-headers)))
      (eval (cdr nthheader))
      (if (not (memq (car (cdr nthheader))
		     '(od-show-entry od-show-gaiji od-show-gaiji-entry)))
	  (setq od-recent-entry-in-body-flag nil)
	(od-add-to-history 'select)
	(setq od-body-current-pattern od-current-pattern)
	(od-show-genealogy)
	(setq od-recent-entry-in-body-flag t)))))

(defun od-direct-select-entry ()
  (interactive)
  (od-select-entry (string-to-int (char-to-string last-command-char))))

(defun od-current-header-line ()
  (save-excursion
    (beginning-of-line)
    (count-lines 1 (point))))

(defun od-previous-entry ()
  (interactive)
  (let ((curr (od-current-header-line)))
    (if (< 1 curr)
	(od-select-entry (1- curr))
      (message "No previous entry."))))

(defun od-show-current-entry ()
  (interactive)
  (od-select-entry (od-current-header-line)))

(defun od-next-entry ()
  (interactive)
  (let ((curr (od-current-header-line)))
    (if (< curr (length od-headers))
	(od-select-entry (1+ curr))
      (message "No following entry."))))

(defun od-scroll-step ()
  (cond ((integerp od-scroll-step)
	 od-scroll-step)
	((eq od-scroll-step 'full)
	 (- (window-height (next-window (selected-window))) 2))
	((eq od-scroll-step 'half)
	 (- (/ (window-height (next-window (selected-window))) 2) 1))))

(defun od-scroll-entry (step)
  (let ((curr (od-current-header-line)))
    (if (or (not od-recent-entry-in-body-flag)
	    (/= od-current-entry curr)
	    (/= od-history-drifting-point od-history-current-point))
	(od-select-entry curr)
      (od-set-header)
      (scroll-other-window step))))

(defun od-scroll-entry-up ()
  (interactive)
  (od-scroll-entry (od-scroll-step)))

(defun od-scroll-entry-down ()
  (interactive)
  (od-scroll-entry (- (od-scroll-step))))

(defun od-scroll-entry-up-half ()
  (interactive)
  (od-scroll-entry (/ (od-scroll-step) 2)))

(defun od-scroll-entry-down-half ()
  (interactive)
  (od-scroll-entry (- (/ (od-scroll-step) 2))))

(defun od-scroll-entry-up-line ()
  (interactive)
  (od-scroll-entry 1))

(defun od-scroll-entry-down-line ()
  (interactive)
  (od-scroll-entry -1))

(defun od-scroll-entry-up-or-select-genealogy (arg)
  (interactive "P")
  (if (null arg)
      (od-scroll-entry-up)
    (setq arg (prefix-numeric-value arg))
    (let ((nancestor (length (car od-body-genealogy)))
	  (ndescendant (length (cdr od-body-genealogy))))
      (if (and (<= (- nancestor) arg) (< arg ndescendant))
	  (od-select-from-genealogy (+ nancestor arg))))))

(defun od-scroll-entry-up-line-or-select-genealogy (arg)
  (interactive "P")
  (if (null arg)
      (od-scroll-entry-up-line)
    (setq arg (prefix-numeric-value arg))
    (let ((nancestor (length (car od-body-genealogy)))
	  (ndescendant (length (cdr od-body-genealogy))))
      (if (and (<= (- nancestor) arg) (< arg ndescendant))
	  (od-select-from-genealogy (+ nancestor arg))))))


;; history manipulation
(defmacro od-histelm (point)
  (` (aref od-history (, point))))

(defmacro od-history-make-element (headers entry pattern genealogy)
  (` (list (, headers) (, entry) (, pattern) (, genealogy))))

(defmacro od-histelm-headers (histelm)
  (` (car (, histelm))))

(defmacro od-histelm-entry (histelm)
  (` (car (cdr (, histelm)))))

(defmacro od-histelm-pattern (histelm)
  (` (nth 2 (, histelm))))

(defmacro od-histelm-genealogy (histelm)
  (` (nth 3 (, histelm))))

(defun od-save-histelm (headers entry pattern genealogy)
  (aset od-history od-history-current-point
	(od-history-make-element headers entry pattern genealogy)))

(defun od-restore-histelm (&optional point)
  (let ((histelm
	 (od-histelm (or point od-history-current-point))))
    (if histelm
	(setq od-headers (od-histelm-headers histelm)
	      od-current-entry (od-histelm-entry histelm)
	      od-current-pattern (od-histelm-pattern histelm)
	      od-genealogy (od-histelm-genealogy histelm))
      (setq od-headers nil
	    od-current-entry -1
	    od-current-pattern nil
	    od-genealogy nil))))

(defun od-clear-history ()
  (setq od-history-alist nil)
  (fillarray od-history nil)
  (setq od-history-current-point 0)
  (setq od-history-drifting-point 0))

(defun od-previous-history ()
  (interactive)
  (let ((previous-point
	 (% (+ od-history-drifting-point od-history-length -1)
	    od-history-length)))
    (if (or (= od-history-current-point previous-point)
	    (not (od-histelm previous-point)))
	(message "No more history.")
      (setq od-history-drifting-point previous-point)
      (od-restore-histelm previous-point)
      (od-show-headers))))

(defun od-next-history ()
  (interactive)
  (let ((next-point
	 (% (1+ od-history-drifting-point) od-history-length)))
    (if (or (= od-history-current-point od-history-drifting-point)
	    (not (od-histelm next-point)))
	(message "No more history.")
      (setq od-history-drifting-point next-point)
      (od-restore-histelm next-point)
      (od-show-headers))))

(defun od-reset-history (old-dic new-dic)
  (let ((old-history (assoc old-dic od-history-alist))
	(new-history (assoc new-dic od-history-alist)))
    (if old-history
	(setcdr old-history (cons od-history od-history-current-point))
      (setq od-history-alist
	    (cons (cons old-dic (cons od-history od-history-current-point))
		  od-history-alist)))
    (if (not new-history)
	(setq od-history (make-vector od-history-length nil)
	      od-history-current-point 0
	      od-headers nil
	      od-current-pattern nil
	      od-genealogy nil)
      (setq od-history (car (cdr new-history))
	    od-history-current-point (cdr (cdr new-history)))
      (od-restore-histelm))
    (setq od-history-drifting-point od-history-current-point)))

(defun od-add-to-history (comm)
  (cond ((eq comm 'clear)
	 (setq od-genealogy nil))
	((eq comm 'select)
	 (cond ((null od-genealogy)
		(setq od-genealogy
		      (cons nil (list (cons od-headers od-current-entry))))
		(setq od-body-genealogy od-genealogy))
	       ((< (cdr (car (cdr od-genealogy))) 0)
		(setq od-genealogy
		      (cons (car od-genealogy)
			    (cons (cons od-headers od-current-entry)
				  (cdr (cdr od-genealogy)))))
		(setq od-body-genealogy od-genealogy))
	       ((= od-current-entry (cdr (car (cdr od-genealogy))))
		(setq od-body-genealogy od-genealogy))
	       (t
		(setq od-body-genealogy
		      (cons (car od-genealogy)
			    (list (cons od-headers od-current-entry)))))))
	((eq comm 'push)
	 (setq od-genealogy
	       (cons (and (cdr od-genealogy)
			  (cons (car (cdr od-genealogy)) (car od-genealogy)))
		     (list (cons od-headers od-current-entry))))))
  (if (equal (car (od-histelm od-history-current-point)) od-headers)
      nil
    (setq od-history-current-point
	  (% (1+ od-history-current-point) od-history-length)))
  (setq od-history-drifting-point od-history-current-point)
  (od-save-histelm od-headers od-current-entry
		   od-current-pattern od-genealogy))


;; cache manipulation
(defun od-make-cache (size)
  (let ((n 0) lru-list)
    (while (< n size)
      (setq lru-list (cons n lru-list))
      (setq n (1+ n)))
    (cons (make-vector size nil) lru-list)))

(defmacro od-cache-table (cache)
  (` (car (, cache))))

(defmacro od-cache-lru-list (cache)
  (` (cdr (, cache))))

(defmacro od-cache-size (cache)
  (` (length (od-cache-table (, cache)))))

(defmacro od-make-cacheelm (key data)
  (` (cons (, key) (, data))))

(defmacro od-cacheelm-key (cacheelm)
  (` (car (, cacheelm))))

(defmacro od-cacheelm-data (cacheelm)
  (` (cdr (, cacheelm))))

(defun od-cache-update-lru-list (cache n)
  (if (not (= n (car (od-cache-lru-list cache))))
      (setcdr cache
	      (cons n (delq n (od-cache-lru-list cache))))))

(defun od-cache-lookup (cache key &optional update-lru value-when-failed)
  (let ((cache-table (od-cache-table cache))
	(n (od-cache-size cache)))
    (while (and (>= (setq n (1- n)) 0)
		(not (equal key (od-cacheelm-key (aref cache-table n))))))
    (if (< n 0)
	value-when-failed
      (if update-lru
	  (od-cache-update-lru-list cache n))
      (od-cacheelm-data
       (aref (od-cache-table cache) n)))))

(defsubst od-cache-lru-no (cache)
  (nth (1- (od-cache-size cache))
       (od-cache-lru-list cache)))

(defun od-cache-set (cache key data)
  (let ((cache-no (od-cache-lru-no cache)))
    (aset (od-cache-table cache)
	  cache-no
	  (od-make-cacheelm key data))
    (od-cache-update-lru-list cache cache-no)))

(defun od-clear-cache (cache)
  (fillarray (od-cache-table cache) nil))

;; frame cache
(defvar od-frame-cache (od-make-cache od-frame-cache-size))

(defmacro od-frame-cache-lookup (fno)
  (` (od-cache-lookup od-frame-cache (cons od-dict-name (, fno)) 'update-lru)))

(defmacro od-frame-cache-set (fno data)
  (` (od-cache-set od-frame-cache (cons od-dict-name (, fno)) (, data))))

(defsubst od-clear-frame-cache ()
  (od-clear-cache od-frame-cache))

;; body cache
(defvar od-body-cache (od-make-cache od-body-cache-size))

(defmacro od-body-cache-lookup (fno ofs)
  (` (od-cache-lookup od-body-cache
		      (list od-dict-name (, fno) (or (, ofs) 0)
			    od-use-only-ascii-and-jisx0208 fill-column)
		      'update-lru)))

(defun od-body-cache-set (fno ofs buf refs overlay-pos)
  (save-excursion
    (let ((orig-fill-column fill-column))
      (set-buffer
       (get-buffer-create
	(format od-body-cache-buffer-name-format
		(od-cache-lru-no od-body-cache))))
      (erase-buffer)
      (insert-buffer-substring buf)
      (od-cache-set od-body-cache
		    (list od-dict-name fno (or ofs 0)
			  od-use-only-ascii-and-jisx0208 orig-fill-column)
		    (cons (current-buffer) (cons refs overlay-pos))))))

(defun od-clear-body-cache ()
  (od-clear-cache od-body-cache)
  (let ((i 0))
    (while (< i od-body-cache-size)
      (let ((buffer-name (format od-body-cache-buffer-name-format i)))
	(if (get-buffer buffer-name)
	    (kill-buffer buffer-name)))
      (setq i (1+ i)))))

(defun od-make-overlay-pos ()
  (let ((overlay-list od-overlay-list)
	overlay-pos overlay-pos1)
    (if (eq overlay-list od-overlay-list-unused)
	nil
      (while (/= (overlay-get (car overlay-list) 'od-eno) 1)
	(setq overlay-pos
	      (cons (cons (overlay-start (car overlay-list))
			  (overlay-end (car overlay-list)))
		    overlay-pos))
	(setq overlay-list (cdr overlay-list)))
      (while (not (eq overlay-list od-overlay-list-unused))
	(setq overlay-pos1
	      (cons (cons (overlay-start (car overlay-list))
			  (overlay-end (car overlay-list)))
		    overlay-pos1))
	(setq overlay-list (cdr overlay-list)))
      (od-nreverse overlay-pos1 overlay-pos))))

(defun od-restore-overlay-pos (overlay-pos)
  (let ((i 1))
    (while overlay-pos
      (od-alloc-overlay (car (car overlay-pos)) (cdr (car overlay-pos))
			(prog1 i (setq i (1+ i))))
      (setq overlay-pos (cdr overlay-pos)))))


(defun od-show-genealogy ()
  (od-set-body)
  (let ((ancestors (reverse (car od-body-genealogy)))
	(descendants (cdr od-body-genealogy))
	(i 0)
	(delimiters od-genealogy-delimiters)
	buffer-read-only)
    (goto-char (point-min))
    (if ancestors
	(progn
	  (insert (car (prog1 delimiters
			 (setq delimiters (cdr delimiters)))))
	  (while (progn
		   (if (> (cdr (car ancestors)) 0)
		       (od-alloc-overlay
			(point)
			(progn (insert (car (nth (1- (cdr (car ancestors)))
						 (car (car ancestors)))))
			       (point)) i)
		     (insert (car (car (car (car ancestors))))))
		   (setq i (1- i))
		   (setq ancestors (cdr ancestors)))
	    (insert (car delimiters)))
	  (setq delimiters (cdr delimiters))
	  (insert (car (prog1 delimiters
			 (setq delimiters (cdr delimiters))))))
      (setq delimiters (nthcdr 3 delimiters)))
    (if descendants
	(progn
	  (insert (car (prog1 delimiters
			 (setq delimiters (cdr delimiters)))))
	  (while (progn
		   (od-alloc-overlay
		    (point)
		    (progn (insert (car (nth (1- (cdr (car descendants)))
					     (car (car descendants)))))
			   (point))
		    (prog1 i (setq i (1- i))))
		   (setq descendants (cdr descendants)))
	    (insert (car delimiters)))
	  (setq delimiters (cdr delimiters))
	  (insert (car delimiters))))
    (od-free-overlay)
    (set-buffer-modified-p nil)
    (goto-char (point-min))))

(defun od-alloc-overlay (start end eno)
  (let (overlay)
    (cond (od-overlay-list-unused
	   (setq overlay (car od-overlay-list-unused))
	   (setq od-overlay-list-unused (cdr od-overlay-list-unused))
	   (move-overlay overlay start end))
	  (t
	   (setq overlay (make-overlay start end))
	   (overlay-put overlay 'face 'underline)
	   (overlay-put overlay 'mouse-face 'highlight)
	   (setq od-overlay-list (cons overlay od-overlay-list))))
    (overlay-put overlay 'od-eno eno)
    overlay))

(defun od-free-overlay ()
  (setq od-overlay-list-unused od-overlay-list))

(defmacro od-bufstr-to-int (p q)
  (` (string-to-int (buffer-substring (, p) (, q)))))

;;; `nconc' is getting slower as it takes more arguments since
;;; `(nconc l1 l2 ... ln-1 ln)' is expanded into
;;; `(nconc (nconc ... (nconc l1 l2) ... ln-1) ln)'.
(defmacro od-cascade-setcdr (first &rest list)
  (while list
    (setq first (list 'setcdr first (car list)))
    (setq list (cdr list)))
  first)

(defun od-collect-references ()
  (goto-char (point-min))
  (let (case-fold-search
	;; enable-multibyte-characters mc-flag
	ref caption-prefix references)
    (while (re-search-forward
	    "\x1f\\([9BCGJM]\\|D................\\|E\x1f[23]\\)" nil t)
      (let* ((head (char-after (match-beginning 1)))
	     (start (match-beginning 0))
	     (caption
	      (buffer-substring (point)
				(progn (re-search-forward "\x1f[RSYbcdgjm]")
				       (match-beginning 0))))
	     fno ofs)
	(cond ((and (>= head ?B) (<= head ?E))
	       (setq fno (od-bufstr-to-int (point) (+ 8 (point))))
	       (setq ofs (od-bufstr-to-int (+ 8 (point)) (+ 12 (point))))
	       (cond ((or (eq head ?B) (eq head ?C))
		      (setq ref (list 'od-show-entry fno ofs))
		      (setq caption-prefix "")
		      (forward-char 12))
		     ((eq head ?D)
		      (setq ref
			    (list 'od-transfer-picture fno ofs
				  (od-bufstr-to-int (+ 10 start) (+ 18 start))
				  (od-bufstr-to-int (+ 2 start) (+ 10 start))))
		      (setq caption-prefix "図:")
		      (forward-char 12))
		     (t			; (eq head ?E)
		      (cond ((eq (preceding-char) ?R)
			     (setq ref (list 'od-show-picture fno ofs))
			     (setq caption-prefix "図:")
			     (forward-char 12))
			    ((eq (preceding-char) ?S)
			     (setq head
				   (buffer-substring (point) (+ (point) 16)))
			     (setq ref (list 'od-play-sound))
			     (od-cascade-setcdr ref
						(read-from-string head 0 4)
						(read-from-string head 4 10)
						(read-from-string head 10 16)
						nil)
			     (setq caption-prefix "音:")
			     (forward-char 16))))))
	      ((eq head ?G)
	       (setq fno 0)
	       (while (eq (following-char) ?\x1e)
		 (setq fno (+ (* fno 10)
			      (od-bufstr-to-int (1+ (point)) (+ 3 (point)))))
		 (forward-char 3))
	       (setq ref (list 'od-show-color-sample fno))
	       (setq caption-prefix "色:"))
	      ((eq head ?9)
	       (setq ref (list 'od-show-movie
			       (substring caption 0 88)))
	       (setq caption (substring caption 88))
	       (setq caption-prefix "動:"))
	      ((eq head ?J)
	       (setq ref (list 'od-play-sound-wave))
	       (od-cascade-setcdr ref
				  (read-from-string caption 0 4)
				  (read-from-string caption 4 6)
				  (read-from-string caption 6 8)
				  (read-from-string caption 8 16)
				  (read-from-string caption 16 20)
				  (read-from-string caption 20 28)
				  (read-from-string caption 28 32) nil)
	       (setq caption (substring caption 32))
	       (setq caption-prefix "音:"))
	      ((eq head ?M)
	       (setq ref
		     (list 'od-show-color-picture (substring caption 0 24)))
	       (od-cascade-setcdr (cdr ref)
				  (read-from-string caption 24 32)
				  (read-from-string caption 32 36) nil)
	       (setq caption (substring caption 36))
	       (setq caption-prefix
		     (if (= (logand (cdr (assq 'protection od-dict-info)) 8) 0)
			 "絵[引用禁止]:"
		       "絵:"))))
	(delete-region start (point))
	(cond
	 ((string-match "\x1e\\([0-9]*\\)\x1e" caption)
	  (funcall (cdr (assq (car (read-from-string
				    caption (match-beginning 1) (match-end 1)))
			      od-dict-capfunc-table))
		   fno ofs))
	 (t
	  (od-alloc-overlay (point) (progn (insert caption) (point))
			    (prog1 od-eno (setq od-eno (1+ od-eno))))
	  (let (;;(enable-multibyte-characters t)
		;;(mc-flag t)
		)
	    (if (string= (char-to-string (string-to-char caption)) caption)
		(setq caption
		      (concat caption
			      (buffer-substring
			       (point)
			       (save-excursion
				 (re-search-forward "\x1f\\|$" nil t)
				 (match-beginning 0)))))))
	  (setq references (cons
			    (cons (concat caption-prefix caption) ref)
			    references))))))
;;    (od-free-overlay)			; now freed in od-show-genealogy
    references))

(defun od-convert-adscript ()
  (goto-char (point-min))
  (while (re-search-forward "\x1f[\x06\x0e]" nil t)
    (let* ((start (match-beginning 0))
	   (type (char-after (1+ start))))
      (replace-match "")
      (search-forward (format "\x1f%c" (1+ type)))
      (replace-match "")
      (put-text-property start (point) 'category
			 (if (eq type ?\x06) 'od-subscript 'od-superscript))))
  (if (or od-use-only-ascii-and-jisx0208 od-parenthesize-adscript-flag)
      (progn
	(goto-char (point-min))
	(let ((next-change (make-marker))
	      category)
	  (while (not (eobp))
	    (setq category (get-text-property (point) 'category))
	    (set-marker next-change
			(or (next-single-property-change (point) 'category)
			    (point-max)))
	    (cond ((eq category 'od-subscript)
		   (insert "_{")
		   (goto-char next-change)
		   (insert ?}))
		  ((eq category 'od-superscript)
		   (insert "^{")
		   (goto-char next-change)
		   (insert ?}))
		  (t
		   (goto-char next-change))))))))

(defun od-set-fill-column ()
  (setq fill-column
	(or od-body-fillcolumn
	    (let ((fillcol (- (window-width) od-body-right-border)))
	      (if (< 0 fillcol)
		  fillcol))
	    fill-column)))

(defun od-show-entry (fno &optional ofs page)
  (save-excursion
    (od-set-body)
    (od-set-fill-column)
    (let (buffer-read-only)
      (erase-buffer)
      (let ((cache-data (od-body-cache-lookup fno ofs)))
	(if cache-data
	    (od-show-body-cache cache-data)
	  (od-show-entry-nocache fno ofs))))
    (set-buffer-modified-p nil)
    (if (and od-dict-summary
	     od-summary-mode)
	(hide-body))
    (goto-char (point-min))
    (if page
	(progn
	  (forward-page page)
	  (set-window-point (get-buffer-window (current-buffer)) (point))
	  (set-window-start (get-buffer-window (current-buffer))
			    (1- (point)))))
    (if od-references
	(message "%s"
	 (substitute-command-keys
	  "\\<odic-mode-map>\
Type \"\\[od-make-headers-from-references]\" to see references."))
      (message nil))))

(defun od-show-body-cache (cache-data)
  (insert-buffer-substring (car cache-data))
  (setq od-references (car (cdr cache-data)))
  (od-restore-overlay-pos (cdr (cdr cache-data))))

(defun od-show-entry-nocache (fno ofs)
  (message "reading...")
  (od-insert-frames fno ofs)
  (indent-rigidly 1 (point-max) 1)
  (message "collecting references...")
  (setq od-eno 1)
  (let ((od-base-fno fno)
	(od-base-ofs ofs))
    (setq od-references (nreverse (od-collect-references))))
  (message "filtering...")
  (od-convert-adscript)
  (let ((tmp od-dict-filter-func-list)
	(case-fold-search nil))
    (while tmp
      (goto-char (point-min))
      (funcall (car tmp))
      (setq tmp (cdr tmp))))
  (if od-dict-fill-function
      (progn
	(message "filling ...")
	(if (and od-display-before-fill-limit
		 (> (buffer-size) od-display-before-fill-limit))
	    (sit-for 0))
	(funcall od-dict-fill-function 1 (point-max))))
  (od-body-cache-set fno ofs od-dict-body-buffer od-references
		      (od-make-overlay-pos)))

(defun od-fill-region (start end)
  (let ((end-marker (make-marker)))
    (set-marker end-marker end)
    (goto-char start)
    (while (< (point) end-marker)
      (if (< (move-to-column fill-column) fill-column)
	  (if (< (point) (point-max))
	      (forward-char))
	(while (and (not (eq (following-char) ?\n))
		    (looking-at "[A-Za-z]"))
	  (backward-char))
	(forward-char)
	(insert ?\n)
	(delete-horizontal-space)))))

(defun od-fill-region-adaptive (from to &optional justify-flag)
  (interactive "r\nP")
  (save-restriction
    (narrow-to-region from to)
    (goto-char (point-min))
    (while (not (eobp))
      (let ((initial (point))
	    (end (progn
		   (forward-paragraph 1) (point))))
	(forward-paragraph -1)
	(if (>= (point) initial)
	    (let ((fill-prefix
		   (and od-dict-compute-fill-prefix-func
			(funcall od-dict-compute-fill-prefix-func))))
	      (fill-region-as-paragraph (point) end justify-flag))
	  (goto-char end))))))

(defun od-insert-frames (fno &optional ofs double-stop)
  (let* ((ticket (od-request-frame fno))
	 (start-point (point))
	 (end-marker (make-marker))
	 (previous-pos (point))
	 (previous-face 'default)
	 (face-list (face-list))
	 (bold (if (memq 'od-bold face-list) 'od-bold 'bold))
	 (inverse (if (memq 'od-inverse face-list) 'od-inverse 'modeline))
	 (bold-inverse (if (memq 'od-bold-inverse face-list)
			   'od-bold-inverse 'od-bold-inverse-default))
	 (mask (if double-stop 64 2)))
    (aset (fillarray od-ccl-status 0) 3 1)
    (while
	(progn
	  (insert (od-ccl-execute-on-string
		   (od-get-ccl od-use-only-ascii-and-jisx0208)
		   od-ccl-status (od-receive-frame ticket ofs) 'continue))
	  (setq ofs 0)
	  (if (= (logand (aref od-ccl-status 3) mask) 0)
	      (setq ticket (od-request-frame (setq fno (1+ fno)))))
	  (set-marker end-marker (point))
	  (goto-char start-point)
	  (while (search-forward "\e[" end-marker t)
	    (let ((face (cond ((looking-at "0m")   'default)
			      ((looking-at "1m")   bold)
			      ((looking-at "7m")   inverse)
			      ((looking-at "1;7m") bold-inverse)
			      ;; otherwise, nil
			      )))
	      (if face
		  (progn
		    (delete-region (- (point) 2) (match-end 0))
		    (if (not (eq previous-face 'default))
			(add-text-properties previous-pos (point)
					     (list 'face previous-face
						   'rear-nonsticky '(face))))
		    (setq previous-pos (point)
			  previous-face face)))))
	  (= (logand (aref od-ccl-status 3) mask) 0))
      ;; Grrrr!!! `goto-char' in Emacs 20.3 does not return a POINT
      ;; but a POSITION (possibly a MARKER).
      (goto-char end-marker)
      (setq start-point (point)))
    (goto-char start-point)
    (if (not (search-forward (if double-stop "\C-c\C-c" "\C-c") end-marker t))
	(error "diclookup-mule internal error: can't find endmark."))
    (if (not (eq previous-face 'default))
	(add-text-properties previous-pos (1- (point))
			     (list 'face previous-face
				   'rear-nonsticky '(face))))
    (delete-region (1- (point)) end-marker)))

(defun od-no-entries-found (pat)
  (message "\"%s\" not found." pat)
  (ding))

(defun od-beginning-of-link-p (pos)
  (let ((overlays (overlays-at pos)))
    (while (and overlays
		(not (and (overlay-get (car overlays) 'od-eno)
			  (= (overlay-start (car overlays)) pos))))
      (setq overlays (cdr overlays)))
    overlays))

(defun od-next-link-pos (pos &optional backward limit)
  (or limit (setq limit (if backward (point-min) (point-max))))
  (let ((overlay-change-function
	 (if backward 'od-previous-overlay-change 'next-overlay-change)))
    (if (= pos limit)
	nil
      (while (and (not (od-beginning-of-link-p
			(setq pos (funcall overlay-change-function pos))))
		  (or (/= pos limit)
		      (setq pos nil))))
      pos)))

(defun od-beginning-of-link-pos (pos)
  (let ((overlays (overlays-at pos)))
    (while overlays
      (if (and (overlay-get (car overlays) 'od-eno)
 	       (< (overlay-start (car overlays)) pos))
 	  (setq pos (overlay-start (car overlays)))
 	(setq overlays (cdr overlays)))))
  pos)

(defun od-next-link (count)
  (interactive "p")
  (let ((backward (< count 0))
	(pos (point)))
    (if backward (setq pos (od-beginning-of-link-pos (point))
		       count (- count)))
    (while (and (> count 0)
		(setq pos (od-next-link-pos pos backward)))
      (setq count (1- count)))
    (if pos
	(goto-char pos)
      (message (if backward "no previous link" "no next link")))))

(defun od-previous-link (count)
  (interactive "p")
  (od-next-link (- count)))


(defun od-toggle-summary-mode ()
  (interactive)
  (if od-dict-summary
      (progn
	(setq od-summary-mode (not od-summary-mode))
	(setq od-summary-current-display-mode
	      (if od-summary-mode "[Summary]" ""))
	(save-excursion
	  (set-buffer od-dict-body-buffer)
	  (if od-summary-mode
	      (hide-body)
	    (show-all))))))

(defun od-toggle-character-sets ()
  (interactive)
  (setq od-use-only-ascii-and-jisx0208
	(not od-use-only-ascii-and-jisx0208))
  (od-show-current-entry))

(defun od-toggle-narrow-to-page ()
  (interactive)
  (if (and (= (point-min) 1) (= (point-max) (1+ (buffer-size))))
      (narrow-to-page)
    (widen)))


(defun od-bury-buffers ()
  (bury-buffer od-dict-header-buffer)
  (bury-buffer od-dict-body-buffer))

(defun od-dictionary-frame-p (&optional frame)
  (string= od-frame-name
	   (cdr (assq 'name (frame-parameters frame)))))

(defun od-iconify ()
  (if (od-dictionary-frame-p)
      (progn
	(iconify-frame)
	(if (string< "19.27" emacs-version)
	    (select-frame (previous-frame)))
	(set-mouse-position (selected-frame) (1- (frame-width)) 0)
	(unfocus-frame))))

(defun od-make-invisible ()
  (if (od-dictionary-frame-p)
      (progn
	(make-frame-invisible)
	(if (string< "19.27" emacs-version)
	    (select-frame (previous-frame)))
	(set-mouse-position (selected-frame) (1- (frame-width)) 0)
	(unfocus-frame))))

(defun od-lower-and-select-previous-frame ()
  (if (od-dictionary-frame-p)
      (progn
	(lower-frame (selected-frame))
	(select-frame (previous-frame))
	(set-mouse-position (selected-frame) (1- (frame-width)) 0)
	(unfocus-frame))))

(defun od-select-and-raise-previous-frame ()
  (if (od-dictionary-frame-p)
      (progn
	(select-frame (previous-frame))
	(raise-frame (selected-frame))
	(set-mouse-position (selected-frame) (1- (frame-width)) 0)
	(unfocus-frame))))

(defun od-quit ()
  (interactive)
  (od-bury-buffers)
  (run-hooks 'od-quit-hook)
  (if (and (not (od-dictionary-frame-p)) od-previous-config)
      (progn
	(set-window-configuration od-previous-config)
	(setq od-previous-config nil))))

(defun od-delete-frame ()
  (if (od-dictionary-frame-p)
      (delete-frame)))

(defun od-really-quit ()
  (interactive)
  (od-bury-buffers)
  (let ((dict-list od-dict-list))
    (while dict-list
      (if (and (processp (car dict-list))
	       (eq (process-status (car dict-list)) 'open))
	  (ndtp-close (car dict-list)))
      (setq dict-list (cdr dict-list))))
  (od-ispell-quit)
  (od-kill-active-buffers)
  (setq od-dict nil)
  (setq od-dict-list nil)
  (setq od-dict-name nil)
  (setq od-overlay-list nil od-overlay-list-unused nil)
  (od-clear-history)
  (od-clear-frame-cache)
  (od-clear-body-cache)
  (run-hooks 'od-really-quit-hook)
  (if (and (not (od-dictionary-frame-p)) od-previous-config)
      (progn
	(set-window-configuration od-previous-config)
	(setq od-previous-config nil))))


(defvar od-ispell-program-name "ispell"
  "Program invoked by ispell-word and ispell-region commands.")

(defconst od-ispell-out-name " *od-ispell*"
  "Name of the buffer that is associated with the 'ispell' process")

(defvar od-ispell-process nil
  "Holds the process object for 'ispell'")

(defun od-ispell-init-process ()
  (if (and od-ispell-process
	   (eq (process-status od-ispell-process) 'run))
      (save-excursion
	(set-buffer od-ispell-out-name)
	(erase-buffer))
    (message "Starting new ispell process...")
    (and (get-buffer od-ispell-out-name) (kill-buffer od-ispell-out-name))
    (setq od-ispell-process
	  (start-process "ispell"
			 od-ispell-out-name od-ispell-program-name "-a"))
    (process-kill-without-query od-ispell-process)
    (if od-ispell-ver-3
	(save-excursion
	  (set-buffer od-ispell-out-name)
	  (while (not (eq (char-before (point-max)) ?\n))
	    (accept-process-output od-ispell-process))
	  (erase-buffer)))
    (message "Starting new ispell process... done")))

(defun od-ispell-quit ()
  (if (and (processp od-ispell-process)
	   (eq (process-status od-ispell-process) 'run))
      (progn
	(process-send-eof od-ispell-process)
	(accept-process-output od-ispell-process od-ispell-exit-timeout)
	(delete-process od-ispell-out-name)))
  (if (get-buffer od-ispell-out-name)
      (kill-buffer od-ispell-out-name)))

(defun od-lookup-pattern-with-ispell ()
  (interactive)
  (let ((orig-pat (read-string "Pattern: ")))
    (od-lookup-pattern-with-ispell-sub orig-pat)))

(defun od-lookup-pattern-with-ispell-sub (orig-pat)
  (od-ispell-init-process)
  (process-send-string od-ispell-process orig-pat)
  (process-send-string od-ispell-process "\n")
  (set-buffer od-ispell-out-name)
  (while (progn (goto-char (point-min))
		(while (eq (following-char) ?\n) (delete-char 1))
		(not (eq (char-before (point-max)) ?\n)))
    (accept-process-output od-ispell-process))
  (goto-char (point-min))
  (let ((ch (following-char)))
    (cond ((eq ch ?*)
	   ;; correct!
	   (od-really-lookup-pattern orig-pat))
	  ((eq ch ?+)
	   ;; a word follows
	   (od-lookup-candidates orig-pat))
	  ((eq ch ?&)
	   ;; some words follows
	   (od-lookup-candidates orig-pat))
	  ((eq ch ?#)
	   ;; cannot find any candidates
	   (message "No candidate.")))))

(defun od-lookup-candidates (orig-pat)
  (cond ((and od-ispell-ver-3 (looking-at "&"))
	 (goto-char 3)
	 (delete-region (point)
			(progn (search-forward ":" nil t) (1+ (point))))))
  (goto-char (point-min))
  (delete-char 2)
  (if od-ispell-ver-3
      (while (search-forward ", " nil t)
	(replace-match "\" \"" t t))
    (while (search-forward " " nil t)
      (replace-match "\" \"" t t)))
  (goto-char (point-min))
  (insert "(\"")
  (end-of-line)
  (insert "\")")
  (goto-char (point-min))
  (let ((pattern-list (read (current-buffer)))
	rev-headers)
    (while pattern-list
      (setq rev-headers
	    (od-find-entries ?a (car pattern-list) rev-headers))
      (setq pattern-list (cdr pattern-list)))
    (if (null rev-headers)
	(od-no-entries-found (concat "綴:" orig-pat))
      (setq od-current-pattern (concat "綴:" orig-pat))
      (setq od-headers (nreverse rev-headers))
      (od-show-headers-delete-body-window)
      (if (and od-select-unique-entry-immediately
	       (= 1 (length od-headers)))
	  (od-select-entry 1)))))

(defun od-read-pattern (japanese-input)
  (let (pattern)
    (while (progn
	     (setq pattern
		   (od-read-string-with-fep
		    (if japanese-input "パターン: " "Pattern: ")
		    nil japanese-input))
	     (string= pattern ""))
      (setq japanese-input (not japanese-input)))
    pattern))

(defun od-read-string-with-fep (prompt initial japanese-input)
  (cond ((or (not japanese-input)
	     (eq od-fep-type 'no-fep))
	 (read-string prompt (or initial "")))
	((eq od-fep-type 'egg)
	 (read-hiragana-string prompt (or initial "")))
	((eq od-fep-type 'canna)
	 (save-excursion
	   (set-buffer (window-buffer (minibuffer-window)))
	   (if (not canna:*japanese-mode-in-minibuffer*)
	       (canna-toggle-japanese-mode)))
	 (read-string prompt (or initial "")))
	((eq od-fep-type 't-code)
	 (setq tcode-on-in-minibuffer nil)
	 (setq unread-command-events od-tcode-toggle-events)
	 (read-string prompt (or initial "")))
	((eq od-fep-type 'skk)
	 (require 'skk)
	 ;; (skk-setup-minibuff-map)
	 ;; (read-from-minibuffer prompt (or initial "") skk-minibuff-map)
	 (let ((minibuffer-setup-hook
		(cons 'skk-mode minibuffer-setup-hook)))
	   (read-string prompt (or initial ""))))
	((and (boundp 'input-method-alist)
	      (assoc od-fep-type
		     (symbol-value 'input-method-alist))) ;suppress warnings
	 (read-multilingual-string prompt (or initial "") od-fep-type))
	(t
	 (let ((its:*current-map* (its:get-mode-map od-fep-type)))
	   (if its:*current-map*
	       (read-current-its-string prompt (or initial ""))
	     (error "Unknown fep-type %s" od-fep-type))))))


(defun od-request-frame (fno)
  (or (od-frame-cache-lookup fno)
      (cons fno
	    (progn
	      (od-open-dictionary)
	      (ndtp-get-frame od-dict fno nil nil t)))))

(defun od-receive-frame (ticket &optional ofs)
  (if (consp ticket)
      (od-frame-cache-set (car ticket)
			  (setq ticket
				(ndtp-command-result
				 (ndtp-wait-command (cdr ticket))))))
  (if (zerop (or ofs 0))
      ticket
    (substring ticket ofs)))

(defun od-get-frame (fno &optional ofs min)
  (if (null min) (setq min 1))
  (od-open-dictionary)
  (let ((str (ndtp-command-result (ndtp-get-frame od-dict fno))))
    (if (and ofs (/= ofs 0))
	(setq str (substring str ofs)))
    (while (< (length str) min)
      (setq str (concat str (ndtp-command-result
			     (ndtp-get-frame od-dict (setq fno (1+ fno)))))))
    str))


;;; reference, picture, and gaiji

(defun od-mouse-lookup-reference (click)
  (interactive "e")
  (let ((start (event-start click)))
    (set-buffer (window-buffer (posn-window start)))
    (goto-char (posn-point start)))
  (od-lookup-reference))

(defun od-lookup-reference ()
  (interactive)
  (let* ((saved (point))
	 (overlays (overlays-at saved))
	 case-fold-search eno)
    (while (and overlays
		(null (setq eno (overlay-get (car overlays) 'od-eno))))
      (setq overlays (cdr overlays)))
    (if eno
	(if (<= eno 0)
	    (od-select-from-genealogy (- eno))
	  (od-make-headers-from-references)
	  (od-select-entry eno))
      (if od-dict-summary
	  (condition-case nil
	      (let (next)
		(outline-back-to-heading)
		(save-excursion
		  (outline-next-heading)
		  (setq next (point)))
		(if (re-search-forward outline-heading-end-regexp next t)
		    (progn
		      (forward-char -1)
		      (set-window-point (get-buffer-window (current-buffer))
					(point))
		      (if (or (eq (following-char) ?\C-m)
			      (and (fboundp 'outline-visible)
				   (progn
				     (end-of-line)
				     (not (outline-visible)))))
			  (show-entry)
			(hide-entry))
		      (setq overlays t))))
	    (error nil)))
      (if (null overlays)
	  ;; no reference or outlining
	  (progn
	    (goto-char saved)
	    (message "No reference."))))))

(defun od-make-headers-from-references ()
  (interactive)
  (if (not od-references)
      (message "No reference in the body.")
    (setq od-headers od-references)
    (setq od-current-pattern od-body-current-pattern)
    (setq od-genealogy od-body-genealogy)
    (setq od-current-entry -1)
    (od-show-headers)
    (od-add-to-history 'push)
    (setq od-recent-entry-in-body-flag nil)))

(defun od-select-from-genealogy (n)
  (setq od-current-pattern od-body-current-pattern)
  (let* ((descendants (cdr od-body-genealogy))
	 (ancestors (car od-body-genealogy))
	 (len (length ancestors)))
    (while (> len n)
      (setq descendants
	    (cons (car (prog1 ancestors
			 (setq ancestors (cdr ancestors))))
		  descendants))
      (setq len (1- len)))
    (while (< len n)
      (setq ancestors
	    (cons (car (prog1 descendants
			 (setq descendants (cdr descendants))))
		  ancestors))
      (setq len (1+ len)))
    (setq od-headers (car (car descendants)))
    (setq od-current-entry (cdr (car descendants)))
    (setq od-genealogy (cons ancestors descendants))
    (od-show-headers)
    (od-select-entry od-current-entry)))

(defun od-show-picture (fno ofs)
  (let ((page 1)
	profile sx sy pf po references)
    (while (progn
	     (setq profile (od-get-frame fno ofs 52))
	     (setq sx (od-bcd-to-int profile 8 10))
	     (setq sy (od-bcd-to-int profile 10 12))
	     (setq pf (od-bcd-to-int profile 14 18))
	     (setq po (od-bcd-to-int profile 18 20))
	     (setq references
		   (cons (list (format "Page%d" page)
			       'od-transfer-picture pf po sx sy)
			 references))
	     (/= (aref profile 3) 1))
      (setq fno (od-bcd-to-int profile 44 48))
      (setq ofs (od-bcd-to-int profile 48 50))
      (setq page (1+ page)))
    (if (= page 1)
	(od-transfer-picture pf po sx sy)
      (setq od-references (nreverse references))
      (od-make-headers-from-references))))

(defun od-transfer-picture (fno ofs sx sy)
  (if (not (or (eq window-system 'x) (getenv "DISPLAY")))
      (error "X Window System is not running.")
    (let (process)
      (condition-case nil
	  (let* ((size (* (/ (+ sx 7) 8) sy))
		 (rest (+ size ofs)))
	    (setq process
		  (let (process-connection-type)
		    (apply 'start-process "dict-view-picture" nil
			   od-view-picture-program-and-args)))
	    (set-process-coding-system
	     process od-no-conversion od-no-conversion)
	    (message "transferring picture data...")
	    (process-send-string process (format "P4\n%d %d\n" sx sy))
	    (setq sx (od-request-frame fno))
	    (while (> rest 2048)
	      (process-send-string process (od-receive-frame sx ofs))
	      (setq ofs 0)
	      (setq sx (od-request-frame (setq fno (1+ fno))))
	      (message "transferring picture data... %d%%"
		       (/ (* 100 rest) size))
	      (setq rest (- rest 2048)))
	    (process-send-string process
				 (substring (od-receive-frame sx) ofs rest))
	    (process-send-eof process)
	    (message "transferring picture data... done"))
	(quit
	 (and process (delete-process process))
	 (signal 'quit nil))))))

(defun od-play-sound (&rest args)
  (message "sorry, this type of entry is not supported."))

;; Argument `type' may specify a data format (PCM,...) and/or a number
;; of channels (MONO = 1, STEREO = 2).  Currently we just ignore it.
(defun od-play-sound-wave (type unknown rate fno ofs fno-end ofs-end)
  (if (not (or (eq window-system 'x) (getenv "DISPLAY")))
      (error "X Window System is not running.")
    (let (process)
      (condition-case nil
	  (let* ((size (1+ (+ (* (- fno-end fno) 2048) (- ofs-end ofs))))
		 (rest size)
		 (nbytes 1)
		 (nchannels 1))
	    (setq process
		  (let (process-connection-type)
		    (apply 'start-process "dict-play-sound-wave" nil
			   od-play-sound-wave-program-and-args)))
	    (set-process-coding-system
	     process od-no-conversion od-no-conversion)
	    (message "transferring sound data...")
	    (setq rate (* rate 1000))
	    (process-send-string
	     process
	     (concat "RIFF"
		     (od-int-to-little-endian (+ size 36) 4)
		     "WAVEfmt \020\000\000\000\001\000"
		     (od-int-to-little-endian nchannels 2)
		     (od-int-to-little-endian rate 4)
		     (od-int-to-little-endian (* nbytes rate) 4)
		     (od-int-to-little-endian (* nbytes nchannels) 2)
		     (od-int-to-little-endian (* nbytes 8) 2)
		     "data"
		     (od-int-to-little-endian size 4)))
	    (while (< fno fno-end)
	      (process-send-string process (od-get-frame fno ofs))
	      (message "transferring sound data... %d%%"
		       (/ (* 100 rest) size))
	      (setq rest (- rest 2048))
	      (setq ofs 0)
	      (setq fno (1+ fno)))
	    (process-send-string process
				 (substring (od-get-frame fno)
					    ofs (1+ ofs-end)))
	    (process-send-eof process)
	    (message "transferring sound data... done"))
	(quit
	 (and process (delete-process process))
	 (signal 'quit nil))))))

(defun od-show-color-picture (unknown fno ofs)
  (od-transfer-color-picture
   (+ fno (/ (+ ofs 8) 2048))
   (% (+ ofs 8) 2048)
   (od-little-endian-to-int (od-get-frame fno ofs 8) 4 8)))

(defun od-transfer-color-picture (fno ofs size)
  (if (not (or (eq window-system 'x) (getenv "DISPLAY")))
      (error "X Window System is not running.")
    (let (process)
      (condition-case nil
	  (let ((rest (+ size ofs))
		sx)
    	    (setq process
		  (let (process-connection-type)
		    (apply 'start-process "dict-view-color-picture" nil
			   od-view-color-picture-program-and-args)))
	    (set-process-coding-system
	     process od-no-conversion od-no-conversion)
	    (message "transferring picture data...")
	    (setq sx (od-request-frame fno))
	    (while (> rest 2048)
	      (process-send-string process (od-receive-frame sx ofs))
	      (setq ofs 0)
	      (setq sx (od-request-frame (setq fno (1+ fno))))
	      (message "transferring picture data... %d%%"
		       (/ (* 100 rest) size))
	      (setq rest (- rest 2048)))
	    (process-send-string process
				 (substring (od-receive-frame sx) ofs rest))
	    (process-send-eof process)
	    (message "transferring picture data... done"))
	(quit
	 (and process (delete-process process))
	 (signal 'quit nil))))))

(defun od-show-movie (&rest args)
  (message "sorry, this type of entry is not supported."))

(defun od-show-color-sample (cno)
  (save-excursion
    (od-set-body)
    (let ((str (od-get-frame (1- (+ (cdr (assq 224 od-dict-info)) cno))))
	  (i 0) buffer-read-only)
      (erase-buffer)
      (while (< i 20)
	(insert (format "%02x" (aref str i)))
	(setq i (1+ i))))
    (set-buffer-modified-p nil)
    (message "sorry, this type of entry is not supported.")))

(defun od-show-gaiji-entry (fno)
  (setq od-references (od-make-gaiji-references fno))
  (od-set-body)
  (let (buffer-read-only)
    (erase-buffer)
    (let ((references od-references)
	  (i 1))
      (while references
	(insert ?\t)
	(od-alloc-overlay
	 (point) (progn (insert (car (car references))) (point)) i)
	(if (= (mod i 4) 0) (insert ?\n))
	(setq i (1+ i))
	(setq references (cdr references)))))
  (set-buffer-modified-p nil)
  (goto-char (point-min)))

(defun od-make-gaiji-references (fno)
  (let* ((catalog (od-get-frame fno))
	 (size (/ (* (aref catalog 8) (aref catalog 9)) 8))
	 (hi (aref catalog 10))
	 (lo (aref catalog 11))
	 (limit (if (= lo 1) 255 126))
	 (len (+ (* 256 (aref catalog 12)) (aref catalog 13)))
	 (fonts (od-get-frame (1+ fno) 0 (* len size)))
	 (i 0)
	 headers)
    (while (< i len)
      (setq headers
	    (cons (list (format "外:%02x%02x" hi lo)
			'od-show-gaiji hi lo
			(substring fonts (* i size) (* (1+ i) size)))
		  headers))
      (setq lo (1+ lo))
      (if (> lo limit)
	  (progn
	    (setq lo 33)
	    (setq hi (1+ hi))))
      (setq i (1+ i)))
    (nreverse headers)))

(defun od-show-gaiji (hi lo data)
  (save-excursion
    (od-set-body)
    (let* ((width (/ (length data) 16))
	   (y2 0)
	   (str (concat (format "%c%c" hi lo) (make-string 8 0)))
	   (boundary (concat (make-string (* 8 width) ?-) "\n"))
	   (image-displayable-flag
	    (and (boundp 'image-types) (memq 'xbm image-types)))
	   buffer-read-only mask w bitmap-start)
      (erase-buffer)
      (insert boundary)
      (setq bitmap-start (point))
      (while (< y2 (* 8 2))
	(setq w 0)
	(while (< w width)
	  (setq hi (aref data (+       (* width y2) w)))
	  (setq lo (aref data (+ width (* width y2) w)))
	  (setq mask 128)
	  (while (> mask 0)
	    (insert
	     (if (= (logand hi mask) 0)
		 (if (= (logand lo mask) 0) ?\  ?,)
	       (if (= (logand lo mask) 0) ?' ?\;)))
	    (setq mask (/ mask 2)))
	  (setq w (1+ w)))
	(insert ?\n)
	(setq y2 (1+ (1+ y2))))
      (if image-displayable-flag
	  (put-text-property
	   bitmap-start (1- (point)) 'display
	   (` (image :type xbm :width (, (* 8 width)) :height 16
		     :data (, (od-mirror-string-bytes data))))))
      (if od-use-only-ascii-and-jisx0208
	  nil
	(insert boundary)
	(aset (fillarray od-ccl-status 0) 3 (1- width))
	(insert (od-ccl-execute-on-string
		 (od-get-ccl nil) od-ccl-status str) ?\n))
      (insert boundary)
      (aset (fillarray od-ccl-status 0) 3 (1- width))
      (insert (od-ccl-execute-on-string
	       (od-get-ccl t) od-ccl-status str) ?\n)
      (insert boundary))
    (set-buffer-modified-p nil)))


(defun od-strip-stress-buffer ()
  (if (and (memq (current-buffer)
		 (list od-dict-header-buffer od-dict-body-buffer))
	   od-dict-strip-stress-on-isearch)
      (let (buffer-read-only)
	(buffer-enable-undo)
	(save-excursion
	  (goto-char (point-min))
	  (while (re-search-forward "[,0pq(B]\\|#[',]" nil t)
	    (delete-region (match-beginning 0) (match-end 0))))
	(if isearch-mode
	    (setq isearch-opoint (point)
		  isearch-barrier (point)))
	(set-buffer-modified-p nil))))

(defun od-restore-stress-buffer ()
  (if (and (memq (current-buffer)
		 (list od-dict-header-buffer od-dict-body-buffer))
	   od-dict-strip-stress-on-isearch)
      (let ((undo-list buffer-undo-list)
	    buffer-read-only)
	(buffer-disable-undo)
	(save-excursion
	  (primitive-undo (length undo-list) undo-list))
	(set-buffer-modified-p nil))))

(if (not (fboundp 'make-local-hook))
    (progn
      (add-hook 'isearch-mode-hook 'od-strip-stress-buffer)
      (add-hook 'isearch-mode-end-hook 'od-restore-stress-buffer)))

;;;
;;; Additional new interface [lookup-current-word].
;;;  look up a current point word.
;;;
;;;  15 Nov 91	Tetsuya Nishimaki   (t-nishim@dn.softbank.co.jp)
;;;
(defun od-word-at-point ()
  (interactive)
  (condition-case ()
      (save-excursion
	(if (looking-at "\\([a-zA-Z]\\|\\cH\\|\\cK\\)")
	    (forward-word 1))
	(re-search-backward
	 "\\(\\<[a-zA-Z]+\\|\\CH\\cH+\\|\\CK\\cK+\\)\\>" nil t)
	(goto-char (match-beginning 0))
	(let ((end (match-end 0)))
	  (if (not (looking-at "[a-zA-Z]")) (forward-char 1))
	  (buffer-substring (point) end)))
   (error nil)))

;;;
;;; modified by yutaka@sys1.cpg.sony.co.jp
;;;
;;;###autoload
(defun od-lookup-pattern-edit ()
  (interactive)
  (let* ((v (od-word-at-point))
	 (enable-recursive-minibuffers t)
	 (pat (read-string (if od-dict-japanese-input
			       "Pattern(in kana): "
			     "Pattern: ")
			   v)))
    (online-dictionary)
    (if (string-match "\\cj" pat)
	;; search japanese
	(or (string= od-dict-name od-default-jisyo-japanese)
	    (od-really-change-dictionary od-default-jisyo-japanese))
      (or (string= od-dict-name od-default-jisyo-english)
	  (od-really-change-dictionary od-default-jisyo-english)))
    (od-really-lookup-pattern pat)))

;;;###autoload
(defun od-lookup-pattern-ispell ()
  (interactive)
  (let* ((c (current-window-configuration))
	 (v (od-word-at-point))
	 (enable-recursive-minibuffers t)
	 (pat v))
    (set-window-configuration c)
    (online-dictionary)
    (or (string= od-dict-name od-default-jisyo-ispell)
	(od-really-change-dictionary od-default-jisyo-ispell))
    (od-lookup-pattern-with-ispell-sub pat)))


(defvar lup-mode nil)
(make-variable-buffer-local 'lup-mode)

(or (assq 'lup-mode minor-mode-alist)
    (setq minor-mode-alist (cons '(lup-mode " LUP") minor-mode-alist)))

(defvar lup-mode-prefix "\C-c\C-l"
  "*Prefix key to use for Lup commands in Lup minor mode.")
(defvar lup-mode-map nil)
(if lup-mode-map
    nil
  (setq lup-mode-map (make-sparse-keymap))
  (if lup-mode-prefix
      (let ((map (make-sparse-keymap)))
	(define-key map "i" 'od-lookup-pattern-ispell)
	(define-key map "l" 'od-lookup-pattern-edit)
	(define-key map "q" 'lup-quit)
	(define-key lup-mode-map lup-mode-prefix map)))
  (define-key lup-mode-map [down-mouse-1] 'lup-mouse-drag-region)
  (define-key lup-mode-map [drag-mouse-1] 'lup-mouse-set-region)
  (define-key lup-mode-map [double-mouse-1] 'lup-mouse-set-point)
  (define-key lup-mode-map [triple-mouse-1] 'lup-mouse-set-point)
  (define-key lup-mode-map [menu-bar lup]
    (cons "Lup" (make-sparse-keymap "Lup")))
  (define-key lup-mode-map [menu-bar lup quit]
    '("Quit" . lup-quit))
  (define-key lup-mode-map [menu-bar lup lookup-pattern-ispell]
    '("Lookup Word with Ispell" . od-lookup-pattern-ispell))
  (define-key lup-mode-map [menu-bar lup lookup-pattern-edit]
    '("Lookup Word" . od-lookup-pattern-edit)))

(or (assq 'lup-mode minor-mode-map-alist)
    (setq minor-mode-map-alist
	  (cons (cons 'lup-mode lup-mode-map)
		minor-mode-map-alist)))

;;;###autoload
(defun lup-mode (arg)
  "Toggle Lup minor mode.
With arg, turn Lup minor mode on if arg is positive, off otherwise.

Commands:\\<lup-mode-map>
\\[lup-mode]\
	lupモードになります.
\\[od-lookup-pattern-edit]\
	カーソル上の語を切り出し検索します.
\\[od-lookup-pattern-ispell]\
	カーソル上の語を切り出しispellで原型に直した後検索します.
\\[lup-quit]\
	lupモードをぬけます."
  (interactive "P")
  (setq lup-mode
	(if (null arg) (not lup-mode)
	    (> (prefix-numeric-value arg) 0)))
  (if lup-mode
      (run-hooks 'lup-mode-hook))
  (set-buffer-modified-p (buffer-modified-p)))

(defun lup-quit ()
  (interactive)
  (lup-mode -1))

(defun lup-mouse-set-point (event)
  (interactive "e")
  (unwind-protect
      (if (not (= (overlay-start mouse-drag-overlay)
		  (overlay-end mouse-drag-overlay)))
	  (let (this-command)
	    (push-mark (overlay-start mouse-drag-overlay) t t)
	    (goto-char (overlay-end mouse-drag-overlay))
	    (copy-region-as-kill (point) (mark t))
	    (online-dictionary)
	    (or (string= od-dict-name od-default-jisyo-ispell)
		(od-really-change-dictionary od-default-jisyo-ispell))
	    (od-lookup-pattern-with-ispell-sub (current-kill 0)))
	(goto-char (overlay-end mouse-drag-overlay)))
    (delete-overlay mouse-drag-overlay)))

(defun lup-mouse-set-region (click)
  (interactive "e")
  (unwind-protect
      (progn
	(mouse-set-region click)
	(online-dictionary)
	(or (string= od-dict-name od-default-jisyo-ispell)
	    (od-really-change-dictionary od-default-jisyo-ispell))
	(od-lookup-pattern-with-ispell-sub (current-kill 0)))
    (delete-overlay mouse-drag-overlay)))

;;;###autoload
(defun lup-mouse-drag-region (start-event)
  "Set the region to the text that the mouse is dragged over.
Highlight the drag area as you move the mouse.
This must be bound to a button-down mouse event.
In Transient Mark mode, the highlighting remains once you
release the mouse button.  Otherwise, it does not."
  (interactive "e")
  (mouse-minibuffer-check start-event)
  (let* ((start-posn (event-start start-event))
	 (start-point (posn-point start-posn))
	 (start-window (posn-window start-posn))
	 (start-frame (window-frame start-window))
	 (bounds (window-edges start-window))
	 (top (nth 1 bounds))
	 (bottom (if (window-minibuffer-p start-window)
		     (nth 3 bounds)
		   ;; Don't count the mode line.
		   (1- (nth 3 bounds))))
	 (click-count (1- (event-click-count start-event))))
    (setq mouse-selection-click-count click-count)
    (mouse-set-point start-event)
    (let ((range (mouse-start-end start-point start-point click-count)))
      (move-overlay mouse-drag-overlay (car range) (nth 1 range)
		    (window-buffer start-window)))
    (deactivate-mark)
    (let (event end end-point)
      (track-mouse
	(while (progn
		 (setq event (read-event))
		 (or (mouse-movement-p event)
		     (eq (car-safe event) 'switch-frame)))
	  (if (eq (car-safe event) 'switch-frame)
	      nil
	    (setq end (event-end event)
		  end-point (posn-point end))

	    (cond
	     ;; Are we moving within the original window?
	     ((and (eq (posn-window end) start-window)
		   (integer-or-marker-p end-point))
	      (goto-char end-point)
	      (let ((range (mouse-start-end start-point (point) click-count)))
		(move-overlay mouse-drag-overlay (car range) (nth 1 range))))

	     (t
	      (let ((mouse-row (cdr (cdr (mouse-position)))))
		(cond
		 ((null mouse-row))
		 ((< mouse-row top)
		  (mouse-scroll-subr start-window (- mouse-row top)
				     mouse-drag-overlay start-point))
		 ((>= mouse-row bottom)
		  (mouse-scroll-subr start-window (1+ (- mouse-row bottom))
				     mouse-drag-overlay start-point)))))))))
      (if (consp event)
;;; When we scroll into the mode line or menu bar, or out of the window,
;;; we get events that don't fit these criteria.
;;;	       (eq (get (event-basic-type event) 'event-kind) 'mouse-click)
;;;	       (eq (posn-window (event-end event)) start-window)
;;;	       (numberp (posn-point (event-end event)))
	  (let ((fun (key-binding (vector (car event)))))
	    (if (not (memq fun '(mouse-set-region mouse-set-point)))
		(if (fboundp fun)
		    (funcall fun event))
	      (if (not (= (overlay-start mouse-drag-overlay)
			  (overlay-end mouse-drag-overlay)))
		  (let (last-command this-command)
		    (push-mark (overlay-start mouse-drag-overlay) t t)
		    (goto-char (overlay-end mouse-drag-overlay))
		    (copy-region-as-kill (point) (mark t)))
		(goto-char (overlay-end mouse-drag-overlay))
		(setq this-command 'mouse-set-point)))))
      (delete-overlay mouse-drag-overlay))))

(if (string< emacs-version "19.27")
    (fset 'lup-mouse-drag-region (symbol-function 'mouse-drag-region)))


(defun od-dump-frame (fno)
  (insert "\n")
  (let ((frame (od-get-frame fno))
	(count1 0)
	(count2 0))
    (while (< count1 2048)
      (while (progn
	       (insert (format "%02x" (aref frame count1)))
	       (setq count1 (1+ count1))
	       (/= (% count1 16) 0)))
      (insert "\t")
      (while (progn
	       (let ((hi (aref frame count2))
		     (lo (aref frame (1+ count2))))
		 (if (and (> hi 32) (> lo 32)
			  (< hi 128) (< lo 128))
		     (insert ?\[ (od-make-char od-japanese-jisx0208 hi lo) ?\])
		   (insert (format "%02x%02x" hi lo))))
	       (setq count2 (1+ (1+ count2)))
	       (/= (% count2 16) 0)))
      (insert "\n"))))

(defun od-dump-frame-ascii (fno)
  (insert "\n")
  (let ((frame (od-get-frame fno))
	(count1 0)
	(count2 0))
    (while (< count1 2048)
      (while (progn
	       (insert (format "%02x" (aref frame count1)))
	       (setq count1 (1+ count1))
	       (/= (% count1 16) 0)))
      (insert "\t")
      (while (progn
	       (let ((c (aref frame count2)))
		 (if (and (>= c 32) (< c 128))
		     (insert ?_ c)
		   (insert (format "%02x" c))))
	       (setq count2 (1+ count2))
	       (/= (% count2 16) 0)))
      (insert "\n"))))

(provide 'diclookup-mule)

;;; diclookup-mule.el ends here
