Mercurial > hg > xemacs-beta
view lisp/egg/egg-sj3.el @ 205:92f8ad5d0d3f r20-4b1
Import from CVS: tag r20-4b1
| author | cvs |
|---|---|
| date | Mon, 13 Aug 2007 10:02:46 +0200 |
| parents | 131b0175ea99 |
| children | 262b8bb4a523 |
line wrap: on
line source
;; Kana Kanji Conversion Protocol Package for Egg ;; Coded by K.Ishii, Sony Corp. (kiyoji@sm.sony.co.jp) ;; This file is part of Egg on Mule (Multilingal Environment) ;; Egg is distributed in the forms of patches to GNU ;; Emacs under the terms of the GNU EMACS GENERAL PUBLIC ;; LICENSE which is distributed along with GNU Emacs by the ;; Free Software Foundation. ;; Egg is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied ;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR ;; PURPOSE. See the GNU EMACS GENERAL PUBLIC LICENSE for ;; more details. ;; You should have received a copy of the GNU EMACS GENERAL ;; PUBLIC LICENSE along with Nemacs; see the file COPYING. ;; If not, write to the Free Software Foundation, 675 Mass ;; Ave, Cambridge, MA 02139, USA. ;;; ;;; sj3-egg.el ;;; ;;; $B!V$?$^$4!W$N(B sj3 $B%P!<%8%g%s(B ;;; $B$+$J4A;zJQ49%5!<%P$K(B sj3serv $B$r;H$$$^$9!#(B ;;; ;;; sj3-egg $B$K4X$9$kDs0F!"Cn>pJs$O(B kiyoji@sm.sony.co.jp $B$K$*Aw$j2<$5$$!#(B ;;; ;;; $B@P0f(B $B@6<!(B (require 'egg) (provide 'sj3-egg) (if (not (boundp 'SJ3)) (require 'sj3-client)) ;;;; $B=$@5%a%b!(!((B ;;;; Jul-20-93 by age@softlab.is.tsukuba.ac.jp (Eiji FURUKAWA) ;;;; Bug fixed in diced-add, *sj3-bunpo-menu* and ;;;; set-egg-henkan-mode-format. ;;;; Mar-19-93 by K.Ishii ;;;; DicEd is changed, edit-dict-item -> edit-dict ;;;; Aug-6-92 by K.Ishii ;;;; length $B$r(B string-width $B$KJQ99(B ;;;; Jul-30-92 by K.Ishii ;;;; set-default-usr-dic-directory $B$G:n$k<-=q%G%#%l%/%H%jL>$N=$@5(B ;;;; jserver-host-name, $B4D6-JQ?t(B JSERVER $B$N:o=|(B ;;;; ;;;; Jul-7-92 by Y.Kawabe ;;;; jserver-host-name $B$r%;%C%H$9$k:]$K4D6-JQ?t(B SJ3SERV $B$bD4$Y$k!#(B ;;;; sj3fns.el $B$N%m!<%I$r$d$a$k!#(B ;;;; Jun-2-92 by K.Ishii ;;;; sj3-egg.el $B$r(B wnn-egg.el $B$HF1MM$KJ,3d(B ;;;; May-14-92 by K.Ishii ;;;; Mule $B$N(B wnn-egg.el $B$r(B sj3serv $B$H$NDL?.MQ$K=$@5(B ;; XEmacs addition: (and remove disable-undo variable) ;; For Emacs V18 compatibility (and (not (fboundp 'buffer-disable-undo)) (fboundp 'buffer-flush-undo) (defalias 'buffer-disable-undo 'buffer-flush-undo)) ;;;---------------------------------------------------------------------- ;;; ;;; Version control routine ;;; ;;;---------------------------------------------------------------------- (defvar sj3-egg-version "3.00" "Version number of this version of Egg. ") ;;; Last modified date: Thu Aug 4 21:18:11 1994 (and (equal (user-full-name) "Kiyoji Ishii") (defun sj3-egg-version-update (arg) (interactive "P") (if (equal (buffer-name (current-buffer)) "sj3-egg.el") (save-excursion (goto-char (point-min)) (re-search-forward "(defvar sj3-egg-version \"[0-9]+\\.") (let ((point (point)) (minor)) (search-forward "\"") (backward-char 1) (setq minor (string-to-int (buffer-substring point (point)))) (delete-region point (point)) (if (<= minor 8) (insert "0")) (insert (int-to-string (1+ minor))) (re-search-forward "Last modified date: ") (kill-line) (insert (current-time-string))) (save-buffer) (if arg (byte-compile-file (buffer-file-name))) ))) ) ;;;---------------------------------------------------------------------- ;;; ;;; KKCP package: Kana Kanji Conversion Protocol ;;; ;;; KKCP to SJ3SERV interface; ;;; ;;;---------------------------------------------------------------------- (defvar *KKCP:error-flag* t) (defun KKCP:error (errorCode &rest form) (cond((eq errorCode ':SJ3_SOCK_OPEN_FAIL) (notify "EGG: %s $B>e$K(B SJ3SERV $B$,$"$j$^$;$s!#(B" (or (get-sj3-host-name) "local")) (if debug-on-error (error "EGG: No SJ3SERV on %s is running." (or (get-sj3-host-name) "local")) (error "EGG: %s $B>e$K(B SJ3SERV $B$,$"$j$^$;$s!#(B" (or (get-sj3-host-name) "local")))) ((eq errorCode ':SJ3_SERVER_DEAD) (notify "EGG: %s $B>e$N(BSJ3SERV $B$,;`$s$G$$$^$9!#(B" (or (get-sj3-host-name) "local")) (if debug-on-error (error "EGG: SJ3SERV on %s is dead." (or (get-sj3-host-name) "local")) (error "EGG: %s $B>e$N(B SJ3SERV $B$,;`$s$G$$$^$9!#(B" (or (get-sj3-host-name) "local")))) ((and (consp errorCode) (eq (car errorCode) ':SJ3_UNKNOWN_HOST)) (notify "EGG: $B%[%9%H(B %s $B$,$_$D$+$j$^$;$s!#(B" (car(cdr errorCode))) (if debug-on-error (error "EGG: Host %s is unknown." (car(cdr errorCode))) (error "EGG: $B%[%9%H(B %s $B$,$_$D$+$j$^$;$s!#(B" (car(cdr errorCode))))) ((and (consp errorCode) (eq (car errorCode) ':SJ3_UNKNOWN_SERVICE)) (notify "EGG: Network service %s $B$,$_$D$+$j$^$;$s!#(B" (car(cdr errorCode))) (if debug-on-error (error "EGG: Service %s is unknown." (car(cdr errorCode))) (error "EGG: Network service %s $B$,$_$D$+$j$^$;$s!#(B" (cdr errorCode)))) (t (notify "KKCP: $B860x(B %s $B$G(B %s $B$K<:GT$7$^$7$?!#(B" errorCode form) (if debug-on-error (error "KKCP: %s failed because of %s." form errorCode) (error "KKCP: $B860x(B %s $B$G(B %s $B$K<:GT$7$^$7$?!#(B" errorCode form))))) (defun KKCP:server-open (hostname loginname) (let ((result (sj3-server-open hostname loginname))) (cond((null sj3-error-code) result) (t (KKCP:error sj3-error-code 'KKCP:server-open hostname loginname))))) (defun KKCP:use-dict (dict &optional passwd) (let ((result (sj3-server-open-dict dict passwd))) (cond((null sj3-error-code) result) ((eq sj3-error-code ':sj3-no-connection) (EGG:open-sj3) (KKCP:use-dict dict passwd)) ((null *KKCP:error-flag*) result) (t (KKCP:error sj3-error-code 'kkcp:use-dict dict))))) (defun KKCP:make-dict (dict) (let ((result (sj3-server-make-dict dict))) (cond((null sj3-error-code) result) ((eq sj3-error-code ':sj3-no-connection) (EGG:open-sj3) (KKCP:make-dict dict)) ((null *KKCP:error-flag*) result) (t (KKCP:error sj3-error-code 'kkcp:make-dict dict))))) (defun KKCP:use-stdy (stdy) (let ((result (sj3-server-open-stdy stdy))) (cond((null sj3-error-code) result) ((eq sj3-error-code ':sj3-no-connection) (EGG:open-sj3) (KKCP:use-stdy stdy)) ((null *KKCP:error-flag*) result) (t (KKCP:error sj3-error-code 'kkcp:use-stdy stdy))))) (defun KKCP:make-stdy (stdy) (let ((result (sj3-server-make-stdy stdy))) (cond((null sj3-error-code) result) ((eq sj3-error-code ':sj3-no-connection) (EGG:open-sj3) (KKCP:make-stdy stdy)) ((null *KKCP:error-flag*) result) (t (KKCP:error sj3-error-code 'kkcp:make-stdy stdy))))) (defun KKCP:henkan-begin (henkan-string) (let ((result (sj3-server-henkan-begin henkan-string))) (cond((null sj3-error-code) result) ((eq sj3-error-code ':sj3-no-connection) (EGG:open-sj3) (KKCP:henkan-begin henkan-string)) ((null *KKCP:error-flag*) result) (t (KKCP:error sj3-error-code 'KKCP:henkan-begin henkan-string))))) (defun KKCP:henkan-next (bunsetu-no) (let ((result (sj3-server-henkan-next bunsetu-no))) (cond ((null sj3-error-code) result) ((eq sj3-error-code ':sj3-no-connection) (EGG:open-sj3) (KKCP:henkan-next bunsetu-no)) ((null *KKCP:error-flag*) result) (t (KKCP:error sj3-error-code 'KKCP:henkan-next bunsetu-no))))) (defun KKCP:henkan-kakutei (bunsetu-no jikouho-no) ;;; NOTE: $B<!8uJd%j%9%H$,@_Dj$5$l$F$$$k$3$H$r3NG'$7$F;HMQ$9$k$3$H!#(B (let ((result (sj3-server-henkan-kakutei bunsetu-no jikouho-no))) (cond ((null sj3-error-code) result) ((eq sj3-error-code ':sj3-no-connection) (EGG:open-sj3) (KKCP:henkan-kakutei bunsetu-no jikouho-no)) ((null *KKCP:error-flag*) result) (t (KKCP:error sj3-error-code 'KKCP:henkan-kakutei bunsetu-no jikouho-no))))) (defun KKCP:bunsetu-henkou (bunsetu-no bunsetu-length) (let ((result (sj3-server-bunsetu-henkou bunsetu-no bunsetu-length))) (cond ((null sj3-error-code) result) ((eq sj3-error-code ':sj3-no-connection) (EGG:open-sj3) (KKCP:bunsetu-henkou bunsetu-no bunsetu-length)) ((null *KKCP:error-flag*) result) (t (KKCP:error sj3-error-code 'kkcp:bunsetu-henkou bunsetu-no bunsetu-length))))) (defun KKCP:henkan-quit () (let ((result (sj3-server-henkan-quit))) (cond ((null sj3-error-code) result) ((eq sj3-error-code ':sj3-no-connection) (EGG:open-sj3) (KKCP:henkan-quit)) ((null *KKCP:error-flag*) result) (t (KKCP:error sj3-error-code 'KKCP:henkan-quit))))) (defun KKCP:henkan-end (&optional bunsetuno) (let ((result (sj3-server-henkan-end bunsetuno))) (cond ((null sj3-error-code) result) ((eq sj3-error-code ':sj3-no-connection) (EGG:open-sj3) (KKCP:henkan-end bunsetuno)) ((null *KKCP:error-flag*) result) (t (KKCP:error sj3-error-code 'KKCP:henkan-end))))) (defun KKCP:dict-add (dictno kanji yomi bunpo) (let ((result (sj3-server-dict-add dictno kanji yomi bunpo))) (cond ((null sj3-error-code) result) ((eq sj3-error-code ':sj3-no-connection) (EGG:open-sj3) (KKCP:dict-add dictno kanji yomi bunpo)) ((null *KKCP:error-flag*) result) (t (KKCP:error sj3-error-code 'KKCP:dict-add dictno kanji yomi bunpo))))) (defun KKCP:dict-delete (dictno kanji yomi bunpo) (let ((result (sj3-server-dict-delete dictno kanji yomi bunpo))) (cond ((null sj3-error-code) result) ((eq sj3-error-code ':sj3-no-connection) (EGG:open-sj3) (KKCP:dict-delete dictno kanji yomi bunpo)) ((null *KKCP:error-flag*) result) (t (KKCP:error sj3-error-code 'KKCP:dict-delete dictno kanji yomi bunpo))))) (defun KKCP:dict-info (dictno) (let ((result (sj3-server-dict-info dictno))) (cond ((null sj3-error-code) result) ((eq sj3-error-code ':sj3-no-connection) (EGG:open-sj3) (KKCP:dict-info dictno)) ((null *KKCP:error-flag*) result) (t (KKCP:error sj3-error-code 'KKCP:dict-info dictno))))) (defun KKCP:make-directory (pathname) (let ((result (sj3-server-make-directory pathname))) (cond ((null sj3-error-code) result) ((eq sj3-error-code ':sj3-no-connection) (EGG:open-sj3) (KKCP:make-directory pathname)) ((null *KKCP:error-flag*) result) (t (KKCP:error sj3-error-code 'kkcp:make-directory pathname))))) (defun KKCP:file-access (pathname mode) (let ((result (sj3-server-file-access pathname mode))) (cond ((null sj3-error-code) (if (= result 0) t nil)) ((eq sj3-error-code ':sj3-no-connection) (EGG:open-sj3) (KKCP:file-access pathname mode)) ((null *KKCP:error-flag*) result) (t (KKCP:error sj3-error-code 'kkcp:file-access pathname mode))))) (defun KKCP:server-close () (let ((result (sj3-server-close))) (cond ((null sj3-error-code) result) ((null *KKCP:error-flag*) result) (t (KKCP:error sj3-error-code 'KKCP:server-close))))) ;;;---------------------------------------------------------------------- ;;; ;;; Kana Kanji Henkan ;;; ;;;---------------------------------------------------------------------- ;;; ;;; Entry functions for egg-startup-file ;;; (defvar *default-sys-dic-directory* "/usr/sony/dict/sj3") (defun set-default-sys-dic-directory (pathname) "$B%7%9%F%`<-=q$NI8=`(Bdirectory PATHNAME$B$r;XDj$9$k!#(B PATHNAME$B$O4D6-JQ?t$r4^$s$G$h$$!#(B" (setq pathname (substitute-in-file-name pathname)) (if (not (file-name-absolute-p pathname)) (error "Default directory must be absolute pathname") (if (null (KKCP:file-access pathname 0)) (error (format "System Default directory(%s) $B$,$"$j$^$;$s!#(B" pathname)) (setq *default-sys-dic-directory* (file-name-as-directory pathname))))) (defvar *default-usr-dic-directory* "/usr/sony/dict/sj3/user/$USER") (defun set-default-usr-dic-directory (pathname) "$BMxMQ<T<-=q$NI8=`(Bdirectory PATHNAME$B$r;XDj$9$k!#(B PATHNAME$B$O4D6-JQ?t$r4^$s$G$h$$!#(B" (setq pathname (file-name-as-directory (substitute-in-file-name pathname))) (if (not (file-name-absolute-p pathname)) (error "Default directory must be absolute pathname") (if (null (KKCP:file-access pathname 0)) (let ((updir (file-name-directory (substring pathname 0 -1)))) (if (null (KKCP:file-access updir 0)) (error (format "User Default directory(%s) $B$,$"$j$^$;$s!#(B" pathname)) (if (yes-or-no-p (format "User Default directory(%s) $B$r:n$j$^$9$+!)(B" pathname)) (progn (KKCP:make-directory (directory-file-name pathname)) (notify "User Default directory(%s) $B$r:n$j$^$7$?!#(B" pathname)) nil ;;; do nothing )))) (setq *default-usr-dic-directory* pathname))) (defun setsysdic (dict) (let ((dictfile (concat (if (not (file-name-absolute-p dict)) *default-sys-dic-directory* "") dict))) (egg:setsysdict (expand-file-name dictfile)))) (defun setusrdic (dict) (let ((dictfile (concat (if (not (file-name-absolute-p dict)) *default-usr-dic-directory* "") dict))) (egg:setusrdict (expand-file-name dictfile)))) (defvar egg:*dict-list* nil) (defun setusrstdy (stdy) (let ((stdyfile (concat (if (not (file-name-absolute-p stdy)) *default-usr-dic-directory* "") stdy))) (egg:setusrstdy (expand-file-name stdyfile)))) (defun egg:setsysdict (dict) (cond((assoc (file-name-nondirectory dict) egg:*dict-list*) (beep) (notify "$B4{$KF1L>$N%7%9%F%`<-=q(B %s $B$,EPO?$5$l$F$$$^$9!#(B" (file-name-nondirectory dict)) ) ((null (KKCP:file-access dict 0)) (beep) (notify "$B%7%9%F%`<-=q(B %s $B$,$"$j$^$;$s!#(B" dict)) (t(let* ((*KKCP:error-flag* nil) (rc (KKCP:use-dict dict))) (if (null rc) (error "EGG: setsysdict failed. :%s" dict) (setq egg:*dict-list* (cons (cons (file-name-nondirectory dict) dict) egg:*dict-list*))))))) ;;; dict-no --> dict-name (defvar egg:*usr-dict* nil) ;;; dict-name --> dict-no (defvar egg:*dict-menu* nil) (defmacro push-end (val loc) (list 'push-end-internal val (list 'quote loc))) (defun push-end-internal (val loc) (set loc (if (eval loc) (nconc (eval loc) (cons val nil)) (cons val nil)))) (defun egg:setusrdict (dict) (cond((assoc (file-name-nondirectory dict) egg:*dict-list*) (beep) (notify "$B4{$KF1L>$NMxMQ<T<-=q(B %s $B$,EPO?$5$l$F$$$^$9!#(B" (file-name-nondirectory dict)) ) ((null (KKCP:file-access dict 0)) (notify "$BMxMQ<T<-=q(B %s $B$,$"$j$^$;$s!#(B" dict) (if (yes-or-no-p (format "$BMxMQ<T<-=q(B %s $B$r:n$j$^$9$+!)(B" dict)) (let ((*KKCP:error-flag* nil)) (if (KKCP:make-dict dict) (progn (notify "$BMxMQ<T<-=q(B %s $B$r:n$j$^$7$?!#(B" dict) (let* ((*KKCP:error-flag* nil) (dict-no (KKCP:use-dict dict ""))) (cond((numberp dict-no) (setq egg:*usr-dict* (cons (cons dict-no dict) egg:*usr-dict*)) (push-end (cons (file-name-nondirectory dict) dict-no) egg:*dict-menu*)) (t (error "EGG: setusrdict failed. :%s" dict))))) (error "EGG: setusrdict failed. : %s" dict))))) (t (let* ((*KKCP:error-flag* nil) (dict-no (KKCP:use-dict dict ""))) (cond((numberp dict-no) (setq egg:*usr-dict* (cons(cons dict-no dict) egg:*usr-dict*)) (push-end (cons (file-name-nondirectory dict) dict-no) egg:*dict-menu*) (setq egg:*dict-list* (cons (cons (file-name-nondirectory dict) dict) egg:*dict-list*))) (t (error "EGG: setusrdict failed. : %s" dict))))))) (defun egg:setusrstdy (stdy) (cond((null (KKCP:file-access stdy 0)) (notify "$B3X=,%U%!%$%k(B %s $B$,$"$j$^$;$s!#(B" stdy) (if (yes-or-no-p (format "$B3X=,%U%!%$%k(B %s $B$r:n$j$^$9$+!)(B" stdy)) (if (null (KKCP:make-stdy stdy)) (error "EGG: setusrstdy failed. : %s" stdy) (notify "$B3X=,%U%!%$%k(B %s $B$r:n$j$^$7$?!#(B" stdy) (if (null (KKCP:use-stdy stdy)) (error "EGG: setusrstdy failed. : %s" stdy)) ))) (t (if (null (KKCP:use-stdy stdy)) (error "EGG: setusrstdy failed. : %s" stdy))))) ;;; ;;; SJ3 interface ;;; (defun get-sj3-host-name () (cond((and (boundp 'sj3-host-name) (stringp sj3-host-name)) sj3-host-name) ((and (boundp 'sj3serv-host-name) (stringp sj3serv-host-name)) sj3serv-host-name) (t(getenv "SJ3SERV")))) ; 92.7.7 by Y.Kawabe (fset 'get-sj3serv-host-name (symbol-function 'get-sj3-host-name)) (defun set-sj3-host-name (name) (interactive "sHost name: ") (let ((*KKCP:error-flag* nil)) (disconnect-sj3)) (setq sj3-host-name name) ) (defvar egg-default-startup-file "eggrc-sj3" "*Egg startup file name (system default)") (defvar egg-startup-file ".eggrc-sj3" "*Egg startup file name.") (defvar egg-startup-file-search-path (append '("~" ".") load-path) "*List of directories to search for start up file to load.") (defun egg:search-file (filename searchpath) (let ((result nil)) (if (null (file-name-directory filename)) (let ((path searchpath)) (while (and path (null result )) (let ((file (substitute-in-file-name (expand-file-name filename (if (stringp (car path)) (car path) nil))))) (if (file-exists-p file) (setq result file) (setq path (cdr path)))))) (let((file (substitute-in-file-name (expand-file-name filename)))) (if (file-exists-p file) (setq result file)))) result)) (defun EGG:open-sj3 () (KKCP:server-open (or (get-sj3-host-name) (system-name)) (user-login-name)) (setq egg:*usr-dict* nil egg:*dict-list* nil egg:*dict-menu* nil) (notify "$B%[%9%H(B %s $B$N(B SJ3 $B$r5/F0$7$^$7$?!#(B" (or (get-sj3-host-name) "local")) (let ((eggrc (or (egg:search-file egg-startup-file egg-startup-file-search-path) (egg:search-file egg-default-startup-file load-path)))) (if eggrc (load-file eggrc) (progn (KKCP:server-close) (error "eggrc-search-path $B>e$K(B egg-startup-file $B$,$"$j$^$;$s!#(B"))))) (defun disconnect-sj3 () (interactive) (KKCP:server-close)) (defun close-sj3 () (interactive) (KKCP:server-close)) ;;; ;;; Kanji henkan ;;; (defvar egg:*kanji-kanabuff* nil) (defvar *bunsetu-number* nil) (defun bunsetu-su () (sj3-bunsetu-suu)) (defun bunsetu-length (number) (sj3-bunsetu-yomi-moji-suu number)) (defun kanji-moji-suu (str) (let ((max (length str)) (count 0) (i 0)) (while (< i max) (setq count (1+ count)) (if (< (aref str i) 128) (setq i (1+ i)) (setq i (+ i 3)))) count)) (defun bunsetu-position (number) (let ((pos egg:*region-start*) (i 0)) (while (< i number) (setq pos (+ pos (bunsetu-kanji-length i) (length egg:*bunsetu-kugiri*))) (setq i (1+ i))) pos)) (defun bunsetu-kanji-length (bunsetu-no) (sj3-bunsetu-kanji-length bunsetu-no)) (defun bunsetu-kanji (number) (sj3-bunsetu-kanji number)) (defun bunsetu-kanji-insert (bunsetu-no) (sj3-bunsetu-kanji bunsetu-no (current-buffer))) (defun bunsetu-set-kanji (bunsetu-no kouho-no) (sj3-server-henkan-kakutei bunsetu-no kouho-no)) (defun bunsetu-yomi (number) (sj3-bunsetu-yomi number)) (defun bunsetu-yomi-insert (bunsetu-no) (sj3-bunsetu-yomi bunsetu-no (current-buffer))) (defun bunsetu-yomi-equal (number yomi) (sj3-bunsetu-yomi-equal number yomi)) (defun bunsetu-kouho-suu (bunsetu-no) (let ((no (sj3-bunsetu-kouho-suu bunsetu-no))) (if (< 1 no) no (KKCP:henkan-next bunsetu-no) (sj3-bunsetu-kouho-suu bunsetu-no)))) (defun bunsetu-kouho-list (number) (let ((no (bunsetu-kouho-suu number))) (if (= no 1) (KKCP:henkan-next number)) (sj3-bunsetu-kouho-list number))) (defun bunsetu-kouho-number (bunsetu-no) (sj3-bunsetu-kouho-number bunsetu-no)) ;;;; ;;;; User entry : henkan-region, henkan-paragraph, henkan-sentence ;;;; (defconst egg:*bunsetu-face* nil "*$BJ8@aI=<($KMQ$$$k(B face $B$^$?$O(B nil") (make-variable-buffer-local (defvar egg:*bunsetu-overlay* nil "$BJ8@a$NI=<($K;H$&(B overlay")) (defconst egg:*bunsetu-kugiri* " " "*$BJ8@a$N6h@Z$j$r<($9J8;zNs(B") (defconst egg:*henkan-face* nil "*$BJQ49NN0h$rI=<($9$k(B face $B$^$?$O(B nil") (make-variable-buffer-local (defvar egg:*henkan-overlay* nil "$BJQ49NN0h$NI=<($K;H$&(B overlay")) (defconst egg:*henkan-open* "|" "*$BJQ49$N;OE@$r<($9J8;zNs(B") (defconst egg:*henkan-close* "|" "*$BJQ49$N=*E@$r<($9J8;zNs(B") (defun egg:henkan-face-on () (if (overlayp egg:*henkan-overlay*) nil (setq egg:*henkan-overlay* (make-overlay 1 1 nil)) (overlay-put egg:*henkan-overlay* 'face egg:*henkan-face*) ) (move-overlay egg:*henkan-overlay* egg:*region-start* egg:*region-end* (current-buffer)) ) (defun egg:henkan-face-off () (and (overlayp egg:*henkan-overlay*) (delete-overlay egg:*henkan-overlay*) )) (defun henkan-region (start end) (interactive "r") (if (interactive-p) (set-mark (point))) ;;; to be fixed (henkan-region-internal start end)) (defvar henkan-mode-indicator "$B4A(B") (defun henkan-region-internal (start end) "region$B$r$+$J4A;zJQ49$9$k!#(B" (setq egg:*kanji-kanabuff* (buffer-substring start end)) (if overwrite-mode (setq egg:*overwrite-mode-deleted-chars* (if egg:*henkan-fence-mode* 0 (length egg:*kanji-kanabuff*)))) (setq *bunsetu-number* nil) (let ((result (KKCP:henkan-begin egg:*kanji-kanabuff*))) (if result (progn (mode-line-egg-mode-update henkan-mode-indicator) (goto-char start) (or (markerp egg:*region-start*) (setq egg:*region-start* (make-marker))) (or (markerp egg:*region-end*) (setq egg:*region-end* (set-marker-type (make-marker) t))) (if (null (marker-position egg:*region-start*)) (progn ;;;(setq egg:*global-map-backup* (current-global-map)) (setq egg:*local-map-backup* (current-local-map)) ;; XEmacs change: (buffer-disable-undo (current-buffer)) (goto-char start) (delete-region start end) (insert egg:*henkan-open*) (set-marker egg:*region-start* (point)) (insert egg:*henkan-close*) (set-marker egg:*region-end* egg:*region-start*) (egg:henkan-face-on) (goto-char egg:*region-start*) ) (progn (egg:fence-face-off) (delete-region (- egg:*region-start* (length egg:*fence-open*)) egg:*region-start*) (delete-region egg:*region-end* (+ egg:*region-end* (length egg:*fence-close*))) (goto-char egg:*region-start*) (insert egg:*henkan-open*) (set-marker egg:*region-start* (point)) (goto-char egg:*region-end*) (let ((point (point))) (insert egg:*henkan-close*) (set-marker egg:*region-end* point)) (goto-char start) (delete-region start end) (egg:henkan-face-on)) ) (henkan-insert-kouho 0) (henkan-goto-bunsetu 0) ;;;(use-global-map henkan-mode-map) ;;;(use-local-map nil) (use-local-map henkan-mode-map) ))) ) (defun henkan-paragraph () "Kana-kanji henkan paragraph at or after point." (interactive ) (save-excursion (forward-paragraph) (let ((end (point))) (backward-paragraph) (henkan-region-internal (point) end )))) (defun henkan-sentence () "Kana-kanji henkan sentence at or after point." (interactive ) (save-excursion (forward-sentence) (let ((end (point))) (backward-sentence) (henkan-region-internal (point) end )))) (defun henkan-word () "Kana-kanji henkan word at or after point." (interactive) (save-excursion (re-search-backward "\\b\\w" nil t) (let ((start (point))) (re-search-forward "\\w\\b" nil t) (henkan-region-internal start (point))))) ;;; ;;; Kana Kanji Henkan Henshuu mode ;;; (defun set-egg-henkan-mode-format (open close kugiri &optional henkan-face bunsetu-face) "$BJQ49(B mode $B$NI=<(J}K!$r@_Dj$9$k!#(BOPEN $B$OJQ49$N;OE@$r<($9J8;zNs$^$?$O(B nil$B!#(B CLOSE$B$OJQ49$N=*E@$r<($9J8;zNs$^$?$O(B nil$B!#(B KUGIRI$B$OJ8@a$N6h@Z$j$rI=<($9$kJ8;zNs$^$?$O(B nil$B!#(B HENKAN-FACE $B$,;XDj$5$l$F(B nil $B$G$J$1$l$P!"JQ496h4V$rI=<($9$k(B face $B$H$7$F;H$o$l$k!#(B BUNSETU-FACE $B$,;XDj$5$l$F(B nil $B$G$J$1$l$P!"CmL\$7$F$$$kJ8@a$rI=<($9$k(B face $B$H$7$F;H$o$l$k(B" (interactive (list (read-string "$BJQ493+;OJ8;zNs(B: ") (read-string "$BJQ49=*N;J8;zNs(B: ") (read-string "$BJ8@a6h@Z$jJ8;zNs(B: ") (cdr (assoc (completing-read "$BJQ496h4VI=<(B0@-(B: " egg:*face-alist*) egg:*face-alist*)) (cdr (assoc (completing-read "$BJ8@a6h4VI=<(B0@-(B: " egg:*face-alist*) egg:*face-alist*)) )) (if (and (or (stringp open) (null open)) (or (stringp close) (null close)) (or (stringp kugiri) (null kugiri)) (or (null henkan-face) (memq henkan-face (face-list))) (or (null bunsetu-face) (memq henkan-face (face-list)))) (progn (setq egg:*henkan-open* (or open "") egg:*henkan-close* (or close "") egg:*bunsetu-kugiri* (or kugiri "") egg:*henkan-face* henkan-face egg:*bunsetu-face* bunsetu-face) (if (overlayp egg:*henkan-overlay*) (overlay-put egg:*henkan-overlay* 'face egg:*henkan-face*)) (if (overlayp egg:*bunsetu-overlay*) (overlay-put egg:*bunsetu-overlay* 'face egg:*bunsetu-face*)) t) (error "Wrong type of arguments: %1 %2 %3 %4 %5" open close kugiri henkan-face bunsetu-face))) (defun henkan-insert-kouho (bunsetu-no) (let ((max (bunsetu-su)) (i bunsetu-no)) (while (< i max) (bunsetu-kanji-insert i) (insert egg:*bunsetu-kugiri* ) (setq i (1+ i))) (if (< bunsetu-no max) (delete-char (- (length egg:*bunsetu-kugiri*)))))) (defun henkan-kakutei () (interactive) (egg:bunsetu-face-off *bunsetu-number*) (egg:henkan-face-off) (delete-region (- egg:*region-start* (length egg:*henkan-open*)) egg:*region-start*) (delete-region egg:*region-start* egg:*region-end*) (delete-region egg:*region-end* (+ egg:*region-end* (length egg:*henkan-close*))) (goto-char egg:*region-start*) (let ((i 0) (max (bunsetu-su))) (while (< i max) ;;;(KKCP:henkan-kakutei i (bunsetu-kouho-number i)) (bunsetu-kanji-insert i) (if (not overwrite-mode) (undo-boundary)) (setq i (1+ i)) )) (KKCP:henkan-end) (egg:quit-egg-mode) ) (defun henkan-kakutei-before-point () (interactive) (egg:bunsetu-face-off *bunsetu-number*) (egg:henkan-face-off) (delete-region egg:*region-start* egg:*region-end*) (goto-char egg:*region-start*) (let ((i 0) (max *bunsetu-number*)) (while (< i max) ;;;(KKCP:henkan-kakutei i (bunsetu-kouho-number i)) (bunsetu-kanji-insert i) (if (not overwrite-mode) (undo-boundary)) (setq i (1+ i)) )) (KKCP:henkan-end *bunsetu-number*) (delete-region (- egg:*region-start* (length egg:*henkan-open*)) egg:*region-start*) (insert egg:*fence-open*) (set-marker egg:*region-start* (point)) (delete-region egg:*region-end* (+ egg:*region-end* (length egg:*henkan-close*))) (goto-char egg:*region-end*) (let ((point (point))) (insert egg:*fence-close*) (set-marker egg:*region-end* point)) (goto-char egg:*region-start*) (egg:fence-face-on) (let ((point (point)) (i *bunsetu-number*) (max (bunsetu-su))) (while (< i max) (bunsetu-yomi-insert i) (setq i (1+ i))) ;;;(insert "|") ;;;(insert egg:*fence-close*) ;;;(set-marker egg:*region-end* (point)) (goto-char point)) (setq egg:*mode-on* t) ;;;(use-global-map fence-mode-map) ;;;(use-local-map nil) (use-local-map fence-mode-map) (egg:mode-line-display)) (defun egg:set-bunsetu-face (no face switch) (if (not switch) (egg:bunsetu-face-off no) ;; JIC (if (overlayp egg:*bunsetu-overlay*) nil (setq egg:*bunsetu-overlay* (make-overlay 1 1 nil)) (overlay-put egg:*bunsetu-overlay* 'face egg:*bunsetu-face*)) (move-overlay egg:*bunsetu-overlay* (if (eq face 'modeline) (let ((point (bunsetu-position no))) (+ point (1+ (char-boundary-p point)))) (bunsetu-position no)) (if (= no (1- (bunsetu-su))) egg:*region-end* (- (bunsetu-position (1+ no)) (length egg:*bunsetu-kugiri*))) (current-buffer)))) (defun egg:bunsetu-face-on (no) (egg:set-bunsetu-face no egg:*bunsetu-face* t)) (defun egg:bunsetu-face-off (no) ;; ``no'' will be ignored (and (overlayp egg:*bunsetu-overlay*) (delete-overlay egg:*bunsetu-overlay*)) ) (defun henkan-goto-bunsetu (number) (setq *bunsetu-number* (check-number-range number 0 (1- (bunsetu-su)))) (goto-char (bunsetu-position *bunsetu-number*)) (egg:bunsetu-face-on *bunsetu-number*) ) (defun henkan-forward-bunsetu () (interactive) (henkan-goto-bunsetu (1+ *bunsetu-number*)) ) (defun henkan-backward-bunsetu () (interactive) (henkan-goto-bunsetu (1- *bunsetu-number*)) ) (defun henkan-first-bunsetu () (interactive) (henkan-goto-bunsetu 0)) (defun henkan-last-bunsetu () (interactive) (henkan-goto-bunsetu (1- (bunsetu-su))) ) (defun check-number-range (i min max) (cond((< i min) max) ((< max i) min) (t i))) (defun henkan-hiragana () (interactive) (henkan-goto-kouho (- (bunsetu-kouho-suu *bunsetu-number*) 1))) (defun henkan-katakana () (interactive) (henkan-goto-kouho (- (bunsetu-kouho-suu *bunsetu-number*) 2))) (defun henkan-next-kouho () (interactive) (henkan-goto-kouho (1+ (bunsetu-kouho-number *bunsetu-number*)))) (defun henkan-previous-kouho () (interactive) (henkan-goto-kouho (1- (bunsetu-kouho-number *bunsetu-number*)))) (defun henkan-goto-kouho (kouho-number) (let ((point (point)) (yomi (bunsetu-yomi *bunsetu-number*)) (i *bunsetu-number*) (max (bunsetu-su))) (setq kouho-number (check-number-range kouho-number 0 (1- (bunsetu-kouho-suu *bunsetu-number*)))) (while (< i max) (if (bunsetu-yomi-equal i yomi) (let ((p1 (bunsetu-position i))) (delete-region p1 (+ p1 (bunsetu-kanji-length i))) (goto-char p1) (bunsetu-set-kanji i kouho-number) (bunsetu-kanji-insert i))) (setq i (1+ i))) (goto-char point)) (egg:bunsetu-face-on *bunsetu-number*)) (defun henkan-bunsetu-chijime () (interactive) (or (= (bunsetu-length *bunsetu-number*) 1) (bunsetu-length-henko (1- (bunsetu-length *bunsetu-number*))))) (defun henkan-bunsetu-nobasi () (interactive) (if (not (= (1+ *bunsetu-number*) (bunsetu-su))) (bunsetu-length-henko (1+ (bunsetu-length *bunsetu-number*))))) (defun henkan-saishou-bunsetu () (interactive) (bunsetu-length-henko 1)) (defun henkan-saichou-bunsetu () (interactive) (let ((max (bunsetu-su)) (i *bunsetu-number*) (l 0)) (while (< i max) (setq l (+ l (bunsetu-length i))) (setq i (1+ i))) (bunsetu-length-henko l))) (defun bunsetu-length-henko (length) (let ((r (KKCP:bunsetu-henkou *bunsetu-number* length))) (cond(r (delete-region (bunsetu-position *bunsetu-number*) egg:*region-end*) (goto-char (bunsetu-position *bunsetu-number*)) (henkan-insert-kouho *bunsetu-number*) (henkan-goto-bunsetu *bunsetu-number*)) (t (egg:bunsetu-face-on *bunsetu-number*))))) (defun henkan-quit () (interactive) (egg:bunsetu-face-off *bunsetu-number*) (egg:henkan-face-off) (delete-region (- egg:*region-start* (length egg:*henkan-open*)) egg:*region-start*) (delete-region egg:*region-start* egg:*region-end*) (delete-region egg:*region-end* (+ egg:*region-end* (length egg:*henkan-close*))) (goto-char egg:*region-start*) (insert egg:*fence-open*) (set-marker egg:*region-start* (point)) (insert egg:*kanji-kanabuff*) (let ((point (point))) (insert egg:*fence-close*) (set-marker egg:*region-end* point) ) (goto-char egg:*region-end*) (egg:fence-face-on) (KKCP:henkan-quit) (setq egg:*mode-on* t) ;;;(use-global-map fence-mode-map) ;;;(use-local-map nil) (use-local-map fence-mode-map) (egg:mode-line-display) ) (defun henkan-select-kouho () (interactive) (if (not (eq (selected-window) (minibuffer-window))) (let ((kouho-list (bunsetu-kouho-list *bunsetu-number*)) menu) (setq menu (list 'menu "$B<!8uJd(B:" (let ((l kouho-list) (r nil) (i 0)) (while l (setq r (cons (cons (car l) i) r)) (setq i (1+ i)) (setq l (cdr l))) (reverse r)))) (henkan-goto-kouho (menu:select-from-menu menu (bunsetu-kouho-number *bunsetu-number*)))) (beep))) (defun henkan-kakutei-and-self-insert () (interactive) (setq unread-command-events (list last-command-char)) (henkan-kakutei)) (defvar henkan-mode-map (make-keymap)) (defvar henkan-mode-esc-map (make-keymap)) (let ((ch 0)) (while (<= ch 127) (define-key henkan-mode-map (make-string 1 ch) 'undefined) (define-key henkan-mode-esc-map (make-string 1 ch) 'undefined) (setq ch (1+ ch)))) (let ((ch 32)) (while (< ch 127) (define-key henkan-mode-map (make-string 1 ch) 'henkan-kakutei-and-self-insert) (setq ch (1+ ch)))) (define-key henkan-mode-map "\e" henkan-mode-esc-map) (define-key henkan-mode-map "\ei" 'undefined) ;; henkan-inspect-bunsetu ;; not support for sj3 (define-key henkan-mode-map "\es" 'henkan-select-kouho) (define-key henkan-mode-map "\eh" 'henkan-hiragana) (define-key henkan-mode-map "\ek" 'henkan-katakana) (define-key henkan-mode-map "\e<" 'henkan-saishou-bunsetu) (define-key henkan-mode-map "\e>" 'henkan-saichou-bunsetu) (define-key henkan-mode-map " " 'henkan-next-kouho) (define-key henkan-mode-map "\C-@" 'henkan-next-kouho) (define-key henkan-mode-map "\C-a" 'henkan-first-bunsetu) (define-key henkan-mode-map "\C-b" 'henkan-backward-bunsetu) (define-key henkan-mode-map "\C-c" 'henkan-quit) (define-key henkan-mode-map "\C-d" 'undefined) (define-key henkan-mode-map "\C-e" 'henkan-last-bunsetu) (define-key henkan-mode-map "\C-f" 'henkan-forward-bunsetu) (define-key henkan-mode-map "\C-g" 'henkan-quit) (define-key henkan-mode-map "\C-h" 'help-command) (define-key henkan-mode-map "\C-i" 'henkan-bunsetu-chijime) (define-key henkan-mode-map "\C-j" 'undefined) (define-key henkan-mode-map "\C-k" 'henkan-kakutei-before-point) (define-key henkan-mode-map "\C-l" 'henkan-kakutei) (define-key henkan-mode-map "\C-m" 'henkan-kakutei) (define-key henkan-mode-map "\C-n" 'henkan-next-kouho) (define-key henkan-mode-map "\C-o" 'henkan-bunsetu-nobasi) (define-key henkan-mode-map "\C-p" 'henkan-previous-kouho) (define-key henkan-mode-map "\C-q" 'undefined) (define-key henkan-mode-map "\C-r" 'undefined) (define-key henkan-mode-map "\C-s" 'undefined) (define-key henkan-mode-map "\C-t" 'undefined) (define-key henkan-mode-map "\C-u" 'undefined) (define-key henkan-mode-map "\C-v" 'undefined) (define-key henkan-mode-map "\C-w" 'undefined) (define-key henkan-mode-map "\C-x" 'undefined) (define-key henkan-mode-map "\C-y" 'undefined) (define-key henkan-mode-map "\C-z" 'undefined) (define-key henkan-mode-map "\177" 'henkan-quit) (defun henkan-help-command () "Display documentation fo henkan-mode." (interactive) (with-output-to-temp-buffer "*Help*" (princ (substitute-command-keys henkan-mode-document-string)) (print-help-return-message))) (defvar henkan-mode-document-string "$B4A;zJQ49%b!<%I(B: $BJ8@a0\F0(B \\[henkan-first-bunsetu]\t$B@hF,J8@a(B\t\\[henkan-last-bunsetu]\t$B8eHxJ8@a(B \\[henkan-backward-bunsetu]\t$BD>A0J8@a(B\t\\[henkan-forward-bunsetu]\t$BD>8eJ8@a(B $BJQ49JQ99(B $B<!8uJd(B \\[henkan-previous-kouho] \t$BA08uJd(B \\[henkan-next-kouho] $BJ8@a?-$7(B \\[henkan-bunsetu-nobasi] \t$BJ8@a=L$a(B \\[henkan-bunsetu-chijime] $BJQ498uJdA*Br(B \\[henkan-select-kouho] $BJQ493NDj(B $BA4J8@a3NDj(B \\[henkan-kakutei] \t$BD>A0J8@a$^$G3NDj(B \\[henkan-kakutei-before-point] $BJQ49Cf;_(B \\[henkan-quit] ") ;;;---------------------------------------------------------------------- ;;; ;;; Dictionary management Facility ;;; ;;;---------------------------------------------------------------------- ;;; ;;; $B<-=qEPO?(B ;;; ;;;; ;;;; User entry: toroku-region ;;;; (defun remove-regexp-in-string (regexp string) (cond((not(string-match regexp string)) string) (t(let ((str nil) (ostart 0) (oend (match-beginning 0)) (nstart (match-end 0))) (setq str (concat str (substring string ostart oend))) (while (string-match regexp string nstart) (setq ostart nstart) (setq oend (match-beginning 0)) (setq nstart (match-end 0)) (setq str (concat str (substring string ostart oend)))) str)))) (defun toroku-region (start end) (interactive "r") (let*((kanji (remove-regexp-in-string "[\0-\37]" (buffer-substring start end))) (yomi (read-hiragana-string (format "$B<-=qEPO?!X(B%s$B!Y(B $BFI$_(B :" kanji))) (type (menu:select-from-menu *sj3-bunpo-menu*)) (dict-no (menu:select-from-menu (list 'menu "$BEPO?<-=qL>(B:" egg:*dict-menu*)))) ;;;(if (string-match "[\0-\177]" kanji) ;;; (error "Kanji string contains hankaku character. %s" kanji)) ;;;(if (string-match "[\0-\177]" yomi) ;;; (error "Yomi string contains hankaku character. %s" yomi)) (KKCP:dict-add dict-no kanji yomi type) (let ((hinshi (nth 1 (assq type *sj3-bunpo-code*))) (gobi (nth 2 (assq type *sj3-bunpo-code*))) (dict-name (cdr (assq dict-no egg:*usr-dict*)))) (notify "$B<-=q9`L\!X(B%s$B!Y(B(%s: %s)$B$r(B%s$B$KEPO?$7$^$7$?!#(B" (if gobi (concat kanji " " gobi) kanji) (if gobi (concat yomi " " gobi) yomi) hinshi dict-name)))) ;;; (lsh 1 18) (defvar *sj3-bunpo-menu* '(menu "$BIJ;l(B:" (("$BL>;l(B" . (menu "$BIJ;l(B:$BL>;l(B:" (("$BL>;l(B" . 1) ("$BL>;l(B($B$*!D(B)" . 2) ("$BL>;l(B($B$4!D(B)" . 3) ("$BL>;l(B($B!DE*(B/$B2=(B)" . 4) ("$BL>;l(B($B$*!D$9$k(B)" . 5) ("$BL>;l(B($B!D$9$k(B)" . 6) ("$BL>;l(B($B$4!D$9$k(B)" . 7) ("$BL>;l(B($B!D$J(B/$B$K(B)" . 8) ("$BL>;l(B($B$*!D$J(B/$B$K(B)" . 9) ("$BL>;l(B($B$4!D$J(B/$B$K(B)" . 10) ("$BL>;l(B($BI{;l(B)" . 11)))) ("$BBeL>;l(B" . 12) ("$BID;z(B" . 21) ("$BL>A0(B" . 22) ("$BCOL>(B" . 24) ("$B8)(B/$B6hL>(B" . 25) ("$BF0;l(B" . (menu "$BIJ;l(B:$BF0;l(B:" (("$B%5JQ8l44(B" . 80) ("$B%6JQ8l44(B" . 81) ("$B0lCJITJQ2=It(B" . 90) ("$B%+9T8^CJ8l44(B" . 91) ("$B%,9T8^CJ8l44(B" . 92) ("$B%59T8^CJ8l44(B" . 93) ("$B%?9T8^CJ8l44(B" . 94) ("$B%J9T8^CJ8l44(B" . 95) ("$B%P9T8^CJ8l44(B" . 96) ("$B%^9T8^CJ8l44(B" . 97) ("$B%i9T8^CJ8l44(B" . 98) ("$B%o9T8^CJ8l44(B" . 99)))) ("$BO"BN;l(B" . 26) ("$B@\B3;l(B" . 27) ("$B=u?t;l(B" . 29) ("$B?t;l(B" . 30) ("$B@\F,8l(B" . 31) ("$B@\Hx8l(B" . 36) ("$BI{;l(B" . 45) ("$BI{;l(B2" . 46) ("$B7AMF;l8l44(B" . 60) ("$B7AMFF0;l8l44(B" . 71) ("$BC14A;z(B" . 189)))) (defvar *sj3-bunpo-code* '( ( 1 "$BL>;l(B" ) ( 2 "$BL>;l(B($B$*!D(B)" ) ( 3 "$BL>;l(B($B$4!D(B)" ) ( 4 "$BL>;l(B($B!DE*(B/$B2=(B)" "$BE*(B" nil) ( 5 "$BL>;l(B($B$*!D$9$k(B)" "$B$9$k(B" nil) ( 6 "$BL>;l(B($B!D$9$k(B)" "$B$9$k(B" nil) ( 7 "$BL>;l(B($B$4!D$9$k(B)" "$B$9$k(B" nil) ( 8 "$BL>;l(B($B!D$J(B/$B$K(B)" "$B$J(B/$B$K(B" nil) ( 9 "$BL>;l(B($B$*!D$J(B/$B$K(B)" "$B$J(B/$B$K(B" nil) ( 10 "$BL>;l(B($B$4!D$J(B/$B$K(B)" "$B$J(B/$B$K(B" nil) ( 11 "$BL>;l(B($BI{;l(B)" ) ( 12 "$BBeL>;l(B" ) ( 21 "$BID;z(B" ) ( 22 "$BL>A0(B" ) ( 24 "$BCOL>(B" ) ( 25 "$B8)(B/$B6hL>(B" ) ( 26 "$BO"BN;l(B" ) ( 27 "$B@\B3;l(B" ) ( 29 "$B=u?t;l(B" ) ( 30 "$B?t;l(B" ) ( 31 "$B@\F,8l(B" ) ( 36 "$B@\Hx8l(B" ) ( 45 "$BI{;l(B" ) ( 46 "$BI{;l(B2" ) ( 60 "$B7AMF;l8l44(B" "$B$$(B" ("" "" "" "" "")) ( 71 "$B7AMFF0;l8l44(B" "$B$K(B" ("" "" "" "" "") ) ( 80 "$B%5JQ8l44(B" "$B$9$k(B" ("" "" "" "" "")) ( 81 "$B%6JQ8l44(B" "$B$:$k(B" ("" "" "" "" "")) ( 90 "$B0lCJITJQ2=It(B" "$B$k(B" ("" "" "" "" "")) ( 91 "$B%+9T8^CJ8l44(B" "$B$/(B" ("$B$+$J$$(B" "$B$-$^$9(B" "$B$/(B" "$B$/$H$-(B" "$B$1(B")) ( 92 "$B%,9T8^CJ8l44(B" "$B$0(B" ("$B$,$J$$(B" "$B$.$^$9(B" "" "" "")) ( 93 "$B%59T8^CJ8l44(B" "$B$9(B" ("" "" "" "" "")) ( 94 "$B%?9T8^CJ8l44(B" "$B$D(B" ("" "" "" "" "")) ( 95 "$B%J9T8^CJ8l44(B" "$B$L(B" ("" "" "" "" "")) ( 96 "$B%P9T8^CJ8l44(B" "$B$V(B" ("" "" "" "" "")) ( 97 "$B%^9T8^CJ8l44(B" "$B$`(B" ("" "" "" "" "")) ( 98 "$B%i9T8^CJ8l44(B" "$B$k(B" ("" "" "" "" "")) ( 99 "$B%o9T8^CJ8l44(B" "$B$&(B" ("" "" "" "" "")) ( 189 "$BC14A;z(B" ) ( 190 "$BITDj(B" ) ( 1000 "$B$=$NB>(B" ) )) ;;; ;;; $B<-=qJT=87O(B DicEd ;;; (defvar *diced-window-configuration* nil) (defvar *diced-dict-info* nil) (defvar *diced-dno* nil) ;;;;; ;;;;; User entry : edit-dict ;;;;; (defun edit-dict () (interactive) (let*((dict-no (menu:select-from-menu (list 'menu "$B<-=qL>(B:" egg:*dict-menu*))) (dict-name (file-name-nondirectory (cdr (assq dict-no egg:*usr-dict*)))) (dict-info (KKCP:dict-info dict-no))) (if (null dict-info) (message "$B<-=q(B: %s $B$KEPO?$5$l$F$$$k9`L\$O$"$j$^$;$s!#(B" dict-name) (progn (setq *diced-dno* dict-no) (setq *diced-window-configuration* (current-window-configuration)) (pop-to-buffer "*Nihongo Dictionary Information*") (setq major-mode 'diced-mode) (setq mode-name "Diced") (setq mode-line-buffer-identification (concat "DictEd: " dict-name (make-string (max 0 (- 17 (string-width dict-name))) ? ) )) (sit-for 0) ;; will redislay. ;;;(use-global-map diced-mode-map) (use-local-map diced-mode-map) (diced-display dict-info) )))) (defun diced-redisplay () (let ((dict-info (KKCP:dict-info *diced-dno*))) (if (null dict-info) (progn (message "$B<-=q(B: %s $B$KEPO?$5$l$F$$$k9`L\$O$"$j$^$;$s!#(B" (file-name-nondirectory (cdr (assq *diced-dno* egg:*usr-dict*)))) (diced-quit)) (diced-display dict-info)))) (defun diced-display (dict-info) ;;; (values (list (record yomi kanji bunpo))) ;;; 0 1 2 (setq *diced-dict-info* dict-info) (setq buffer-read-only nil) (erase-buffer) (let ((l-yomi (apply 'max (mapcar (function (lambda (l) (string-width (nth 0 l)))) dict-info))) (l-kanji (apply 'max (mapcar (function (lambda (l) (string-width (nth 1 l)))) dict-info)))) (while dict-info (let*((yomi (nth 0 (car dict-info))) (kanji (nth 1 (car dict-info))) (bunpo (nth 2 (car dict-info))) (gobi (nth 2 (assq bunpo *sj3-bunpo-code*))) (hinshi (nth 1 (assq bunpo *sj3-bunpo-code*)))) (insert " " yomi) (if gobi (insert " " gobi)) (insert-char ? (- (+ l-yomi 10) (string-width yomi) (if gobi (+ 1 (string-width gobi)) 0))) (insert kanji) (if gobi (insert " " gobi)) (insert-char ? (- (+ l-kanji 10) (string-width kanji) (if gobi (+ 1 (string-width gobi)) 0))) (insert hinshi ?\n) (setq dict-info (cdr dict-info)))) (goto-char (point-min))) (setq buffer-read-only t)) (defun diced-add () (interactive) (diced-execute t) (let*((kanji (read-from-minibuffer "$B4A;z!'(B")) (yomi (read-from-minibuffer "$BFI$_!'(B")) (bunpo (menu:select-from-menu *sj3-bunpo-menu*)) (gobi (nth 2 (assq bunpo *sj3-bunpo-code*))) (hinshi (nth 1 (assq bunpo *sj3-bunpo-code*))) (item (if gobi (concat kanji " " gobi) kanji)) (item-yomi (if gobi (concat yomi " " gobi) yomi)) (dict-name (cdr (assq *diced-dno* egg:*usr-dict*)))) (if (notify-yes-or-no-p "$B<-=q9`L\!X(B%s$B!Y(B(%s: %s)$B$r(B%s$B$KEPO?$7$^$9!#(B" item item-yomi hinshi (file-name-nondirectory dict-name)) (progn (KKCP:dict-add *diced-dno* kanji yomi bunpo) (notify "$B<-=q9`L\!X(B%s$B!Y(B(%s: %s)$B$r(B%s$B$KEPO?$7$^$7$?!#(B" item item-yomi hinshi dict-name) (diced-redisplay))))) (defun diced-delete () (interactive) (beginning-of-line) (if (= (following-char) ? ) (let ((buffer-read-only nil)) (delete-char 1) (insert "D") (backward-char 1)))) (defun diced-undelete () (interactive) (beginning-of-line) (if (= (following-char) ?D) (let ((buffer-read-only nil)) (delete-char 1) (insert " ") (backward-char 1)) (beep))) (defun diced-quit () (interactive) (setq buffer-read-only nil) (erase-buffer) (setq buffer-read-only t) (bury-buffer (get-buffer "*Nihongo Dictionary Information*")) (set-window-configuration *diced-window-configuration*) ) (defun diced-execute (&optional display) (interactive) (goto-char (point-min)) (let ((no 0)) (while (not (eobp)) (if (= (following-char) ?D) (let* ((dict-item (nth no *diced-dict-info*)) (yomi (nth 0 dict-item)) (kanji (nth 1 dict-item)) (bunpo (nth 2 dict-item)) (gobi (nth 2 (assq bunpo *sj3-bunpo-code*))) (hinshi (nth 1 (assq bunpo *sj3-bunpo-code*))) (dict-name (cdr (assq *diced-dno* egg:*usr-dict*))) (item (if gobi (concat kanji " " gobi) kanji)) (item-yomi (if gobi (concat yomi " " gobi) yomi))) (if (notify-yes-or-no-p "$B<-=q9`L\!X(B%s$B!Y(B(%s: %s)$B$r(B%s$B$+$i:o=|$7$^$9!#(B" item item-yomi hinshi (file-name-nondirectory dict-name)) (progn (KKCP:dict-delete *diced-dno* kanji yomi bunpo) (notify "$B<-=q9`L\!X(B%s$B!Y(B(%s: %s)$B$r(B%s$B$+$i:o=|$7$^$7$?!#(B" item item-yomi hinshi dict-name) )))) (setq no (1+ no)) (forward-line 1))) (forward-line -1) (if (not display) (diced-redisplay))) (defun diced-next-line () (interactive) (beginning-of-line) (forward-line 1) (if (eobp) (progn (beep) (forward-line -1)))) (defun diced-end-of-buffer () (interactive) (end-of-buffer) (forward-line -1)) (defun diced-scroll-down () (interactive) (scroll-down) (if (eobp) (forward-line -1))) (defun diced-mode () "Mode for \"editing\" dictionaries. In diced, you are \"editing\" a list of the entries in dictionaries. You can move using the usual cursor motion commands. Letters no longer insert themselves. Instead, Type a to Add new entry. Type d to flag an entry for Deletion. Type n to move cursor to Next entry. Type p to move cursor to Previous entry. Type q to Quit from DicEd. Type u to Unflag an entry (remove its D flag). Type x to eXecute the deletions requested. " ) (defvar diced-mode-map (let ((map (make-keymap))) (suppress-keymap map) map)) (define-key diced-mode-map "a" 'diced-add) (define-key diced-mode-map "d" 'diced-delete) (define-key diced-mode-map "n" 'diced-next-line) (define-key diced-mode-map "p" 'previous-line) (define-key diced-mode-map "q" 'diced-quit) (define-key diced-mode-map "u" 'diced-undelete) (define-key diced-mode-map "x" 'diced-execute) (define-key diced-mode-map "\C-h" 'help-command) (define-key diced-mode-map "\C-n" 'diced-next-line) (define-key diced-mode-map "\C-p" 'previous-line) (define-key diced-mode-map "\C-v" 'scroll-up) (define-key diced-mode-map "\e<" 'beginning-of-buffer) (define-key diced-mode-map "\e>" 'diced-end-of-buffer) (define-key diced-mode-map "\ev" 'diced-scroll-down) ;;; End of sj3-egg.el ;; 92.7.7 by Y.Kawabe -- commented out ;; (if (boundp 'SJ3) ;; (load-library "sj3fns"))