cgit.sxemacs.org Git - packages/blob - mule-packages/egg-its/egg-sj3.el

   1 ;; Kana Kanji Conversion Protocol Package for Egg
   2 ;; Coded by K.Ishii, Sony Corp. (kiyoji@sm.sony.co.jp)
   3
   4 ;; This file is part of Egg on Mule (Multilingal Environment)
   5
   6 ;; Egg is distributed in the forms of patches to GNU
   7 ;; Emacs under the terms of the GNU EMACS GENERAL PUBLIC
   8 ;; LICENSE which is distributed along with GNU Emacs by the
   9 ;; Free Software Foundation.
  10
  11 ;; Egg is distributed in the hope that it will be useful,
  12 ;; but WITHOUT ANY WARRANTY; without even the implied
  13 ;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
  14 ;; PURPOSE.  See the GNU EMACS GENERAL PUBLIC LICENSE for
  15 ;; more details.
  16
  17 ;; You should have received a copy of the GNU EMACS GENERAL
  18 ;; PUBLIC LICENSE along with Nemacs; see the file COPYING.
  19 ;; If not, write to the Free Software Foundation, 675 Mass
  20 ;; Ave, Cambridge, MA 02139, USA.
  21
  22
  23 ;;;
  24 ;;; sj3-egg.el
  25 ;;;
  26 ;;; \e$B!V$?$^$4!W$N\e(B sj3 \e$B%P!<%8%g%s\e(B
  27 ;;; \e$B$+$J4A;zJQ49%5!<%P$K\e(B sj3serv \e$B$r;H$$$^$9!#\e(B
  28 ;;;
  29 ;;; sj3-egg \e$B$K4X$9$kDs0F!"Cn>pJs$O\e(B kiyoji@sm.sony.co.jp \e$B$K$*Aw$j2<$5$$!#\e(B
  30 ;;;
  31 ;;;                                                \e$B@P0f\e(B \e$B@6<!\e(B
  32
  33 (require 'egg)
  34 (provide 'egg-sj3)
  35 (when (not (boundp 'SJ3))
  36   (require 'egg-sj3-client))
  37
  38 ;;;;  \e$B=$@5%a%b!(!(\e(B
  39 ;;;; Jul-20-93 by age@softlab.is.tsukuba.ac.jp (Eiji FURUKAWA)
  40 ;;;;  Bug fixed in diced-add, *sj3-bunpo-menu* and
  41 ;;;;  set-egg-henkan-mode-format.
  42
  43 ;;;; Mar-19-93 by K.Ishii
  44 ;;;;  DicEd is changed, edit-dict-item -> edit-dict
  45
  46 ;;;; Aug-6-92 by K.Ishii
  47 ;;;;  length \e$B$r\e(B string-width \e$B$KJQ99\e(B
  48
  49 ;;;; Jul-30-92 by K.Ishii
  50 ;;;;  set-default-usr-dic-directory \e$B$G:n$k<-=q%G%#%l%/%H%jL>$N=$@5\e(B
  51 ;;;;  jserver-host-name, \e$B4D6-JQ?t\e(B JSERVER \e$B$N:o=|\e(B
  52 ;;;;
  53
  54 ;;;; Jul-7-92 by Y.Kawabe
  55 ;;;;  jserver-host-name \e$B$r%;%C%H$9$k:]$K4D6-JQ?t\e(B SJ3SERV \e$B$bD4$Y$k!#\e(B
  56 ;;;;  sj3fns.el \e$B$N%m!<%I$r$d$a$k!#\e(B
  57
  58 ;;;; Jun-2-92 by K.Ishii
  59 ;;;;  sj3-egg.el \e$B$r\e(B wnn-egg.el \e$B$HF1MM$KJ,3d\e(B
  60
  61 ;;;; May-14-92 by K.Ishii
  62 ;;;;  Mule \e$B$N\e(B wnn-egg.el \e$B$r\e(B sj3serv \e$B$H$NDL?.MQ$K=$@5\e(B
  63
  64 ;;;----------------------------------------------------------------------
  65 ;;;
  66 ;;; Version control routine
  67 ;;;
  68 ;;;----------------------------------------------------------------------
  69
  70 (defvar sj3-egg-version "3.00" "Version number of this version of Egg. ")
  71 ;;; Last modified date: Thu Aug  4 21:18:11 1994
  72
  73 ;;;----------------------------------------------------------------------
  74 ;;;
  75 ;;; KKCP package: Kana Kanji Conversion Protocol
  76 ;;;
  77 ;;; KKCP to SJ3SERV interface;
  78 ;;;
  79 ;;;----------------------------------------------------------------------
  80
  81 (defvar *KKCP:error-flag* t)
  82
  83 (defun KKCP:error (errorCode &rest form)
  84   (cond((eq errorCode ':SJ3_SOCK_OPEN_FAIL)
  85         (notify "EGG: %s \e$B>e$K\e(B SJ3SERV \e$B$,$"$j$^$;$s!#\e(B" (or (get-sj3-host-name) "local"))
  86         (if debug-on-error
  87             (error "EGG: No SJ3SERV on %s is running." (or (get-sj3-host-name) "local"))
  88           (error  "EGG: %s \e$B>e$K\e(B SJ3SERV \e$B$,$"$j$^$;$s!#\e(B" (or (get-sj3-host-name) "local"))))
  89        ((eq errorCode ':SJ3_SERVER_DEAD)
  90         (notify "EGG: %s \e$B>e$N\e(BSJ3SERV \e$B$,;`$s$G$$$^$9!#\e(B" (or (get-sj3-host-name) "local"))
  91         (if debug-on-error
  92             (error "EGG: SJ3SERV on %s is dead." (or (get-sj3-host-name) "local"))
  93           (error  "EGG: %s \e$B>e$N\e(B SJ3SERV \e$B$,;`$s$G$$$^$9!#\e(B" (or (get-sj3-host-name) "local"))))
  94        ((and (consp errorCode)
  95              (eq (car errorCode) ':SJ3_UNKNOWN_HOST))
  96         (notify "EGG: \e$B%[%9%H\e(B %s \e$B$,$_$D$+$j$^$;$s!#\e(B" (car(cdr errorCode)))
  97         (if debug-on-error
  98             (error "EGG: Host %s is unknown." (car(cdr errorCode)))
  99           (error "EGG: \e$B%[%9%H\e(B %s \e$B$,$_$D$+$j$^$;$s!#\e(B" (car(cdr errorCode)))))
 100        ((and (consp errorCode)
 101              (eq (car errorCode) ':SJ3_UNKNOWN_SERVICE))
 102         (notify "EGG: Network service %s \e$B$,$_$D$+$j$^$;$s!#\e(B" (car(cdr errorCode)))
 103         (if debug-on-error
 104             (error "EGG: Service %s is unknown." (car(cdr errorCode)))
 105           (error "EGG: Network service %s \e$B$,$_$D$+$j$^$;$s!#\e(B" (cdr errorCode))))
 106        (t
 107         (notify "KKCP: \e$B860x\e(B %s \e$B$G\e(B %s \e$B$K<:GT$7$^$7$?!#\e(B" errorCode form)
 108         (if debug-on-error
 109             (error "KKCP: %s failed because of %s." form errorCode)
 110           (error  "KKCP: \e$B860x\e(B %s \e$B$G\e(B %s \e$B$K<:GT$7$^$7$?!#\e(B" errorCode form)))))
 111
 112 (defun KKCP:server-open (hostname loginname)
 113   (let ((result (sj3-server-open hostname loginname)))
 114     (cond((null sj3-error-code) result)
 115          (t (KKCP:error sj3-error-code 'KKCP:server-open hostname loginname)))))
 116
 117 (defun KKCP:use-dict (dict &optional passwd)
 118   (let ((result (sj3-server-open-dict dict passwd)))
 119     (cond((null sj3-error-code) result)
 120          ((eq sj3-error-code ':sj3-no-connection)
 121           (EGG:open-sj3)
 122           (KKCP:use-dict dict passwd))
 123          ((null *KKCP:error-flag*) result)
 124          (t (KKCP:error sj3-error-code
 125                         'kkcp:use-dict dict)))))
 126
 127 (defun KKCP:make-dict (dict)
 128   (let ((result (sj3-server-make-dict dict)))
 129     (cond((null sj3-error-code) result)
 130          ((eq sj3-error-code ':sj3-no-connection)
 131           (EGG:open-sj3)
 132           (KKCP:make-dict dict))
 133          ((null *KKCP:error-flag*) result)
 134          (t (KKCP:error sj3-error-code
 135                         'kkcp:make-dict dict)))))
 136
 137 (defun KKCP:use-stdy (stdy)
 138   (let ((result (sj3-server-open-stdy stdy)))
 139     (cond((null sj3-error-code) result)
 140          ((eq sj3-error-code ':sj3-no-connection)
 141           (EGG:open-sj3)
 142           (KKCP:use-stdy stdy))
 143          ((null *KKCP:error-flag*) result)
 144          (t (KKCP:error sj3-error-code
 145                         'kkcp:use-stdy stdy)))))
 146
 147 (defun KKCP:make-stdy (stdy)
 148   (let ((result (sj3-server-make-stdy stdy)))
 149     (cond((null sj3-error-code) result)
 150          ((eq sj3-error-code ':sj3-no-connection)
 151           (EGG:open-sj3)
 152           (KKCP:make-stdy stdy))
 153          ((null *KKCP:error-flag*) result)
 154          (t (KKCP:error sj3-error-code
 155                         'kkcp:make-stdy stdy)))))
 156
 157 (defun KKCP:henkan-begin (henkan-string)
 158   (let ((result (sj3-server-henkan-begin henkan-string)))
 159     (cond((null sj3-error-code) result)
 160          ((eq sj3-error-code ':sj3-no-connection)
 161           (EGG:open-sj3)
 162           (KKCP:henkan-begin henkan-string))
 163          ((null *KKCP:error-flag*) result)
 164          (t (KKCP:error sj3-error-code 'KKCP:henkan-begin henkan-string)))))
 165
 166 (defun KKCP:henkan-next (bunsetu-no)
 167   (let ((result (sj3-server-henkan-next bunsetu-no)))
 168     (cond ((null sj3-error-code) result)
 169           ((eq sj3-error-code ':sj3-no-connection)
 170            (EGG:open-sj3)
 171            (KKCP:henkan-next bunsetu-no))
 172           ((null *KKCP:error-flag*) result)
 173           (t (KKCP:error sj3-error-code 'KKCP:henkan-next bunsetu-no)))))
 174
 175 (defun KKCP:henkan-kakutei (bunsetu-no jikouho-no)
 176   ;;; NOTE: \e$B<!8uJd%j%9%H$,@_Dj$5$l$F$$$k$3$H$r3NG'$7$F;HMQ$9$k$3$H!#\e(B
 177   (let ((result (sj3-server-henkan-kakutei bunsetu-no jikouho-no)))
 178     (cond ((null sj3-error-code) result)
 179           ((eq sj3-error-code ':sj3-no-connection)
 180            (EGG:open-sj3)
 181            (KKCP:henkan-kakutei bunsetu-no jikouho-no))
 182           ((null *KKCP:error-flag*) result)
 183           (t (KKCP:error sj3-error-code 'KKCP:henkan-kakutei bunsetu-no jikouho-no)))))
 184
 185 (defun KKCP:bunsetu-henkou (bunsetu-no bunsetu-length)
 186   (let ((result (sj3-server-bunsetu-henkou bunsetu-no bunsetu-length)))
 187     (cond ((null sj3-error-code) result)
 188           ((eq sj3-error-code ':sj3-no-connection)
 189            (EGG:open-sj3)
 190            (KKCP:bunsetu-henkou bunsetu-no bunsetu-length))
 191           ((null *KKCP:error-flag*) result)
 192           (t (KKCP:error sj3-error-code 'kkcp:bunsetu-henkou bunsetu-no bunsetu-length)))))
 193
 194
 195 (defun KKCP:henkan-quit ()
 196   (let ((result (sj3-server-henkan-quit)))
 197     (cond ((null sj3-error-code) result)
 198           ((eq sj3-error-code ':sj3-no-connection)
 199            (EGG:open-sj3)
 200            (KKCP:henkan-quit))
 201           ((null *KKCP:error-flag*) result)
 202           (t (KKCP:error sj3-error-code 'KKCP:henkan-quit)))))
 203
 204 (defun KKCP:henkan-end (&optional bunsetuno)
 205   (let ((result (sj3-server-henkan-end bunsetuno)))
 206     (cond ((null sj3-error-code) result)
 207           ((eq sj3-error-code ':sj3-no-connection)
 208            (EGG:open-sj3)
 209            (KKCP:henkan-end bunsetuno))
 210           ((null *KKCP:error-flag*) result)
 211           (t (KKCP:error sj3-error-code 'KKCP:henkan-end)))))
 212
 213 (defun KKCP:dict-add (dictno kanji yomi bunpo)
 214   (let ((result (sj3-server-dict-add dictno kanji yomi bunpo)))
 215     (cond ((null sj3-error-code) result)
 216           ((eq sj3-error-code ':sj3-no-connection)
 217            (EGG:open-sj3)
 218            (KKCP:dict-add dictno kanji yomi bunpo))
 219           ((null *KKCP:error-flag*) result)
 220           (t (KKCP:error sj3-error-code 'KKCP:dict-add dictno kanji yomi bunpo)))))
 221
 222 (defun KKCP:dict-delete (dictno kanji yomi bunpo)
 223   (let ((result (sj3-server-dict-delete dictno kanji yomi bunpo)))
 224     (cond ((null sj3-error-code) result)
 225           ((eq sj3-error-code ':sj3-no-connection)
 226            (EGG:open-sj3)
 227            (KKCP:dict-delete dictno kanji yomi bunpo))
 228           ((null *KKCP:error-flag*) result)
 229           (t (KKCP:error sj3-error-code 'KKCP:dict-delete dictno kanji yomi bunpo)))))
 230
 231 (defun KKCP:dict-info (dictno)
 232   (let ((result (sj3-server-dict-info dictno)))
 233     (cond ((null sj3-error-code) result)
 234           ((eq sj3-error-code ':sj3-no-connection)
 235            (EGG:open-sj3)
 236            (KKCP:dict-info dictno))
 237           ((null *KKCP:error-flag*) result)
 238           (t (KKCP:error sj3-error-code 'KKCP:dict-info dictno)))))
 239
 240 (defun KKCP:make-directory (pathname)
 241   (let ((result (sj3-server-make-directory pathname)))
 242     (cond ((null sj3-error-code) result)
 243           ((eq sj3-error-code ':sj3-no-connection)
 244            (EGG:open-sj3)
 245            (KKCP:make-directory pathname))
 246           ((null *KKCP:error-flag*) result)
 247           (t (KKCP:error sj3-error-code 'kkcp:make-directory pathname)))))
 248
 249 (defun KKCP:file-access (pathname mode)
 250   (let ((result (sj3-server-file-access pathname mode)))
 251     (cond ((null sj3-error-code)
 252            (if (= result 0) t nil))
 253           ((eq sj3-error-code ':sj3-no-connection)
 254            (EGG:open-sj3)
 255            (KKCP:file-access pathname mode))
 256           ((null *KKCP:error-flag*) result)
 257           (t (KKCP:error sj3-error-code 'kkcp:file-access pathname mode)))))
 258
 259 (defun KKCP:server-close ()
 260   (let ((result (sj3-server-close)))
 261     (cond ((null sj3-error-code) result)
 262           ((null *KKCP:error-flag*) result)
 263           (t (KKCP:error sj3-error-code 'KKCP:server-close)))))
 264
 265 ;;;----------------------------------------------------------------------
 266 ;;;
 267 ;;; Kana Kanji Henkan
 268 ;;;
 269 ;;;----------------------------------------------------------------------
 270
 271 ;;;
 272 ;;; Entry functions for egg-startup-file
 273 ;;;
 274
 275 (defvar *default-sys-dic-directory* (if (file-directory-p "/usr/sony/dict")
 276                                         "/usr/sony/dict/sj3"
 277                                       "/usr/local/lib/sj3/dict"))
 278
 279 (defun set-default-sys-dic-directory (pathname)
 280   "\e$B%7%9%F%`<-=q$NI8=`\e(Bdirectory PATHNAME\e$B$r;XDj$9$k!#\e(B
 281 PATHNAME\e$B$O4D6-JQ?t$r4^$s$G$h$$!#\e(B"
 282
 283   (setq pathname (substitute-in-file-name pathname))
 284
 285   (if (file-name-absolute-p pathname)
 286       (if (null (KKCP:file-access pathname 0))
 287           (error
 288            (format "System Default directory(%s) \e$B$,$"$j$^$;$s!#\e(B" pathname))
 289         (setq *default-sys-dic-directory* (file-name-as-directory pathname)))
 290     (error "Default directory must be absolute pathname")))
 291
 292 (defvar *default-usr-dic-directory*
 293   (if (file-directory-p "/usr/sony/dict/sj3/user")
 294       "/usr/sony/dict/sj3/user/$USER"
 295     "/usr/local/lib/sj3/dict/user/$USER"))
 296
 297 (defun set-default-usr-dic-directory (pathname)
 298   "\e$BMxMQ<T<-=q$NI8=`\e(Bdirectory PATHNAME\e$B$r;XDj$9$k!#\e(B
 299 PATHNAME\e$B$O4D6-JQ?t$r4^$s$G$h$$!#\e(B"
 300
 301   (setq pathname (file-name-as-directory (substitute-in-file-name pathname)))
 302
 303   (if (file-name-absolute-p pathname)
 304       (if (null (KKCP:file-access pathname 0))
 305           (let ((updir (file-name-directory (substring pathname 0 -1))))
 306             (if (null (KKCP:file-access updir 0))
 307                 (error
 308                  (format "User Default directory(%s) \e$B$,$"$j$^$;$s!#\e(B" pathname))
 309               (when
 310                   (yes-or-no-p
 311                    (format "User Default directory(%s) \e$B$r:n$j$^$9$+!)\e(B"
 312                            pathname))
 313                 (KKCP:make-directory (directory-file-name pathname))
 314                 (notify "User Default directory(%s) \e$B$r:n$j$^$7$?!#\e(B"
 315                         pathname))))
 316         (setq *default-usr-dic-directory* pathname))
 317     (error "Default directory must be absolute pathname")))
 318
 319 (defun setsysdic (dict)
 320   (egg:setsysdict (expand-file-name
 321                    (concat (if (file-name-absolute-p dict)
 322                                ""
 323                              *default-sys-dic-directory*)
 324                            dict))))
 325
 326 (defun setusrdic (dict)
 327   (egg:setusrdict (expand-file-name
 328                    (concat (if (file-name-absolute-p dict)
 329                                ""
 330                              *default-usr-dic-directory*)
 331                            dict))))
 332
 333 (defvar egg:*dict-list* nil)
 334
 335 (defun setusrstdy (stdy)
 336   (egg:setusrstdy (expand-file-name
 337                    (concat (if (file-name-absolute-p stdy)
 338                                ""
 339                              *default-usr-dic-directory*)
 340                            stdy))))
 341
 342 (defun egg:setsysdict (dict)
 343   (cond((assoc (file-name-nondirectory dict) egg:*dict-list*)
 344         (beep)
 345         (notify "\e$B4{$KF1L>$N%7%9%F%`<-=q\e(B %s \e$B$,EPO?$5$l$F$$$^$9!#\e(B"
 346                 (file-name-nondirectory dict))
 347         )
 348        ((null (KKCP:file-access dict 0))
 349         (beep)
 350         (notify "\e$B%7%9%F%`<-=q\e(B %s \e$B$,$"$j$^$;$s!#\e(B" dict))
 351        (t(let* ((*KKCP:error-flag* nil)
 352                 (rc (KKCP:use-dict dict)))
 353            (if (null rc)
 354                (error "EGG: setsysdict failed. :%s" dict)
 355                (setq egg:*dict-list*
 356                      (cons (cons (file-name-nondirectory dict) dict)
 357                            egg:*dict-list*)))))))
 358
 359 ;;; dict-no --> dict-name
 360 (defvar egg:*usr-dict* nil)
 361
 362 ;;; dict-name --> dict-no
 363 (defvar egg:*dict-menu* nil)
 364
 365 (defmacro push-end (val loc)
 366   (list 'push-end-internal val (list 'quote loc)))
 367
 368 (defun push-end-internal (val loc)
 369   (set loc
 370        (if (eval loc)
 371            (nconc (eval loc) (cons val nil))
 372          (cons val nil))))
 373
 374 (defun egg:setusrdict (dict)
 375   (cond((assoc (file-name-nondirectory dict) egg:*dict-list*)
 376         (beep)
 377         (notify "\e$B4{$KF1L>$NMxMQ<T<-=q\e(B %s \e$B$,EPO?$5$l$F$$$^$9!#\e(B"
 378                 (file-name-nondirectory dict))
 379         )
 380        ((null (KKCP:file-access dict 0))
 381         (notify "\e$BMxMQ<T<-=q\e(B %s \e$B$,$"$j$^$;$s!#\e(B" dict)
 382         (if (yes-or-no-p (format "\e$BMxMQ<T<-=q\e(B %s \e$B$r:n$j$^$9$+!)\e(B" dict))
 383             (let ((*KKCP:error-flag* nil))
 384               (if (KKCP:make-dict dict)
 385                   (progn
 386                     (notify "\e$BMxMQ<T<-=q\e(B %s \e$B$r:n$j$^$7$?!#\e(B" dict)
 387                     (let* ((*KKCP:error-flag* nil)
 388                            (dict-no (KKCP:use-dict dict "")))
 389                       (cond((numberp dict-no)
 390                             (setq egg:*usr-dict*
 391                                   (cons (cons dict-no dict) egg:*usr-dict*))
 392                             (push-end (cons (file-name-nondirectory dict)
 393                                             dict-no) egg:*dict-menu*))
 394                            (t (error "EGG: setusrdict failed. :%s" dict)))))
 395                 (error "EGG: setusrdict failed. : %s" dict)))))
 396        (t (let* ((*KKCP:error-flag* nil)
 397                  (dict-no (KKCP:use-dict dict "")))
 398             (cond((numberp dict-no)
 399                   (setq egg:*usr-dict* (cons(cons dict-no dict)
 400                                             egg:*usr-dict*))
 401                   (push-end (cons (file-name-nondirectory dict) dict-no)
 402                             egg:*dict-menu*)
 403                   (setq egg:*dict-list*
 404                         (cons (cons (file-name-nondirectory dict) dict)
 405                               egg:*dict-list*)))
 406                  (t (error "EGG: setusrdict failed. : %s" dict)))))))
 407
 408 (defun egg:setusrstdy (stdy)
 409   (cond((null (KKCP:file-access stdy 0))
 410         (notify "\e$B3X=,%U%!%$%k\e(B %s \e$B$,$"$j$^$;$s!#\e(B" stdy)
 411         (if (yes-or-no-p (format "\e$B3X=,%U%!%$%k\e(B %s \e$B$r:n$j$^$9$+!)\e(B" stdy))
 412             (if (null (KKCP:make-stdy stdy))
 413                 (error "EGG: setusrstdy failed. : %s" stdy)
 414               (notify "\e$B3X=,%U%!%$%k\e(B %s \e$B$r:n$j$^$7$?!#\e(B" stdy)
 415               (if (null (KKCP:use-stdy stdy))
 416                   (error "EGG: setusrstdy failed. : %s" stdy))
 417               )))
 418         (t (if (null (KKCP:use-stdy stdy))
 419                (error "EGG: setusrstdy failed. : %s" stdy)))))
 420
 421
 422 ;;;
 423 ;;; SJ3 interface
 424 ;;;
 425
 426 (defun get-sj3-host-name ()
 427   (cond((and (boundp 'sj3-host-name) (stringp sj3-host-name))
 428         sj3-host-name)
 429        ((and (boundp 'sj3serv-host-name) (stringp sj3serv-host-name))
 430         sj3serv-host-name)
 431        (t(getenv "SJ3SERV"))))                          ; 92.7.7 by Y.Kawabe
 432
 433 (fset 'get-sj3serv-host-name (symbol-function 'get-sj3-host-name))
 434
 435 (defun set-sj3-host-name (name)
 436   (interactive "sHost name: ")
 437   (let (*KKCP:error-flag*)
 438     (disconnect-sj3))
 439   (setq sj3-host-name name)
 440   )
 441
 442 (defvar egg-default-startup-file "eggrc"
 443   "*Egg startup file name (system default)")
 444
 445 (defvar egg-startup-file ".eggrc"
 446   "*Egg startup file name.")
 447
 448 (defvar egg-startup-file-search-path (append '("~" ".") load-path)
 449   "*List of directories to search for start up file to load.")
 450
 451 (defun egg:search-file (filename searchpath)
 452   (let (result)
 453     (if (null (file-name-directory filename))
 454         (let ((path searchpath))
 455           (while (and path (null result ))
 456             (let ((file (substitute-in-file-name
 457                          (expand-file-name filename (if (stringp (car path)) (car path) nil)))))
 458               (if (file-exists-p file) (setq result file)
 459                 (setq path (cdr path))))))
 460       (let((file (substitute-in-file-name (expand-file-name filename))))
 461         (if (file-exists-p file) (setq result file))))
 462     result))
 463
 464 (defun EGG:open-sj3 ()
 465   (KKCP:server-open (or (get-sj3-host-name) (system-name))
 466                     (user-login-name))
 467   (setq egg:*usr-dict* nil
 468         egg:*dict-list* nil
 469         egg:*dict-menu* nil)
 470   (notify "\e$B%[%9%H\e(B %s \e$B$N\e(B SJ3 \e$B$r5/F0$7$^$7$?!#\e(B" (or (get-sj3-host-name) "local"))
 471   (let ((eggrc (or (egg:search-file egg-startup-file egg-startup-file-search-path)
 472                    (egg:search-file egg-default-startup-file load-path))))
 473     (if eggrc (load-file eggrc)
 474       (progn
 475         (KKCP:server-close)
 476         (error
 477          "egg-startup-file-search-path \e$B>e$K\e(B egg-startup-file \e$B$,$"$j$^$;$s!#\e(B"
 478          )))))
 479
 480 (defun disconnect-sj3 ()
 481   (interactive)
 482   (KKCP:server-close))
 483
 484 (defun close-sj3 ()
 485   (interactive)
 486   (KKCP:server-close))
 487
 488 ;;;
 489 ;;; Kanji henkan
 490 ;;;
 491
 492 (defvar egg:*kanji-kanabuff* nil)
 493
 494 (defvar *bunsetu-number* nil)
 495
 496 (defun bunsetu-su ()
 497   (sj3-bunsetu-suu))
 498
 499 (defun bunsetu-length (number)
 500   (sj3-bunsetu-yomi-moji-suu number))
 501
 502 ;; #### This looks like a stupid multi-byte kludge.
 503 (defun kanji-moji-suu (str)
 504   "Do Not Call This."
 505   (length str))
 506
 507 (defun bunsetu-position (number)
 508   (let ((pos egg:*region-start*)
 509         (i 0))
 510     (while (< i number)
 511       (setq pos
 512             (+ pos
 513                (or (bunsetu-kanji-length  i) 0)
 514                (length egg:*bunsetu-kugiri*)))
 515       (incf i))
 516     pos))
 517
 518 (defun bunsetu-kanji-length (bunsetu-no)
 519   (sj3-bunsetu-kanji-length bunsetu-no))
 520
 521 (defun bunsetu-kanji (number)
 522   (sj3-bunsetu-kanji number))
 523
 524 (defun bunsetu-kanji-insert (bunsetu-no)
 525   (sj3-bunsetu-kanji bunsetu-no (current-buffer)))
 526
 527 (defun bunsetu-set-kanji (bunsetu-no kouho-no)
 528   (sj3-server-henkan-kakutei bunsetu-no kouho-no))
 529
 530 (defun bunsetu-yomi  (number)
 531   (sj3-bunsetu-yomi number))
 532
 533 (defun bunsetu-yomi-insert (bunsetu-no)
 534   (sj3-bunsetu-yomi bunsetu-no (current-buffer)))
 535
 536 (defun bunsetu-yomi-equal (number yomi)
 537   (sj3-bunsetu-yomi-equal number yomi))
 538
 539 (defun bunsetu-kouho-suu (bunsetu-no)
 540   (let ((no (sj3-bunsetu-kouho-suu bunsetu-no)))
 541     (if (< 1 no) no
 542       (KKCP:henkan-next bunsetu-no)
 543       (sj3-bunsetu-kouho-suu bunsetu-no))))
 544
 545 (defun bunsetu-kouho-list (number)
 546   (let ((no (bunsetu-kouho-suu number)))
 547     (if (= no 1)
 548         (KKCP:henkan-next number))
 549     (sj3-bunsetu-kouho-list number)))
 550
 551 (defun bunsetu-kouho-number (bunsetu-no)
 552   (sj3-bunsetu-kouho-number bunsetu-no))
 553
 554 ;;;;
 555 ;;;; User entry : henkan-region, henkan-paragraph, henkan-sentence
 556 ;;;;
 557
 558 (defconst egg:*bunsetu-face* nil "*\e$BJ8@aI=<($KMQ$$$k\e(B face \e$B$^$?$O\e(B nil")
 559 (make-variable-buffer-local
 560  (defvar egg:*bunsetu-extent* nil "\e$BJ8@a$NI=<($K;H$&\e(B extent"))
 561
 562 (defconst egg:*bunsetu-kugiri* " " "*\e$BJ8@a$N6h@Z$j$r<($9J8;zNs\e(B")
 563
 564
 565 (defconst egg:*henkan-face* nil "*\e$BJQ49NN0h$rI=<($9$k\e(B face \e$B$^$?$O\e(B nil")
 566 (make-variable-buffer-local
 567  (defvar egg:*henkan-extent* nil "\e$BJQ49NN0h$NI=<($K;H$&\e(B extent"))
 568
 569 (defconst egg:*henkan-open*  "|" "*\e$BJQ49$N;OE@$r<($9J8;zNs\e(B")
 570 (defconst egg:*henkan-close* "|" "*\e$BJQ49$N=*E@$r<($9J8;zNs\e(B")
 571
 572 (make-variable-buffer-local
 573  (defvar egg:henkan-mode-in-use nil "buffer \e$B$,JQ49Cf$N;~\e(B t"))
 574
 575 (defun egg:henkan-face-on ()
 576   (when egg:*henkan-face*
 577     (if (extentp egg:*henkan-extent*)
 578         (set-extent-endpoints egg:*henkan-extent*
 579                               egg:*region-start* egg:*region-end*)
 580       (setq egg:*henkan-extent*
 581             (make-extent egg:*region-start* egg:*region-end*))
 582       (mapcar
 583        (lambda (prop)
 584          (set-extent-property egg:*henkan-extent* prop nil))
 585        '(start-open end-open detachable)))
 586     (set-extent-face egg:*henkan-extent* egg:*henkan-face*)))
 587
 588 (defun egg:henkan-face-off ()
 589   ;; detach henkan extent from the current buffer.
 590   (and egg:*henkan-face*
 591        (extentp egg:*henkan-extent*)
 592        (detach-extent egg:*henkan-extent*)))
 593
 594 (defun henkan-region (start end)
 595   (interactive "r")
 596   (if (interactive-p) (set-mark (point))) ;;; to be fixed
 597   (henkan-region-internal start end))
 598
 599 (defvar henkan-mode-indicator "\e$B4A\e(B")
 600
 601 (defun henkan-region-internal (start end)
 602   "region\e$B$r$+$J4A;zJQ49$9$k!#\e(B"
 603   (or egg:henkan-mode-in-use
 604       (let ((finished nil))
 605         (unwind-protect
 606             (progn
 607               (setq egg:henkan-mode-in-use t
 608                     egg:*kanji-kanabuff* (buffer-substring-no-properties
 609                                           start end))
 610               (setq *bunsetu-number* 0)
 611               (let ((result (KKCP:henkan-begin egg:*kanji-kanabuff*)))
 612                 (when result
 613                   (mode-line-egg-mode-update henkan-mode-indicator)
 614                   (goto-char start)
 615                   (or (markerp egg:*region-start*)
 616                       (setq egg:*region-start* (make-marker)))
 617                   (or (markerp egg:*region-end*)
 618                       (set-marker-insertion-type
 619                        (setq egg:*region-end* (make-marker)) t))
 620                   (if (null (marker-position egg:*region-start*))
 621                       (progn
 622                       ;;;(setq egg:*global-map-backup* (current-global-map))
 623                         ;;(setq egg:*local-map-backup* (current-local-map))
 624                         ;; XEmacs change:
 625                         ;;(buffer-disable-undo (current-buffer))
 626                         (goto-char start)
 627                         (delete-region start end)
 628                         (suspend-undo)
 629                         (insert egg:*henkan-open*)
 630                         (set-marker egg:*region-start* (point))
 631                         (insert egg:*henkan-close*)
 632                         (set-marker egg:*region-end* egg:*region-start*)
 633                         (goto-char egg:*region-start*)
 634                         )
 635                     (egg:fence-face-off)
 636                     (delete-region
 637                      (- egg:*region-start* (length egg:*fence-open*))
 638                      egg:*region-start*)
 639                     (delete-region
 640                      egg:*region-end*
 641                      (+ egg:*region-end* (length egg:*fence-close*)))
 642                     (goto-char egg:*region-start*)
 643                     (insert egg:*henkan-open*)
 644                     (set-marker egg:*region-start* (point))
 645                     (goto-char egg:*region-end*)
 646                     (let ((point (point)))
 647                       (insert egg:*henkan-close*)
 648                       (set-marker egg:*region-end* point))
 649                     (goto-char start)
 650                     (delete-region start end)
 651                     )
 652                     (henkan-insert-kouho 0)
 653                     (egg:henkan-face-on)
 654                     (egg:bunsetu-face-on *bunsetu-number*)
 655                     (henkan-goto-bunsetu 0)
 656                     ;;(use-global-map henkan-mode-map)
 657                     ;;(use-local-map nil)
 658                     ;;(use-local-map henkan-mode-map)
 659                     ))
 660                 (setq finished t))
 661               (or finished
 662                   (setq egg:henkan-mode-in-use nil))))))
 663
 664 (defun henkan-paragraph ()
 665   "Kana-kanji henkan  paragraph at or after point."
 666   (interactive )
 667   (save-excursion
 668     (forward-paragraph)
 669     (let ((end (point)))
 670       (backward-paragraph)
 671       (henkan-region-internal (point) end ))))
 672
 673 (defun henkan-sentence ()
 674   "Kana-kanji henkan sentence at or after point."
 675   (interactive )
 676   (save-excursion
 677     (forward-sentence)
 678     (let ((end (point)))
 679       (backward-sentence)
 680       (henkan-region-internal (point) end ))))
 681
 682 (defun henkan-word ()
 683   "Kana-kanji henkan word at or after point."
 684   (interactive)
 685   (save-excursion
 686     (re-search-backward "\\b\\w" nil t)
 687     (let ((start (point)))
 688       (re-search-forward "\\w\\b" nil t)
 689       (henkan-region-internal start (point)))))
 690
 691 ;;;
 692 ;;; Kana Kanji Henkan Henshuu mode
 693 ;;;
 694
 695 (defun set-egg-henkan-mode-format (open close kugiri &optional henkan-face bunsetu-face)
 696    "\e$BJQ49\e(B mode \e$B$NI=<(J}K!$r@_Dj$9$k!#\e(BOPEN \e$B$OJQ49$N;OE@$r<($9J8;zNs$^$?$O\e(B nil\e$B!#\e(B
 697 CLOSE\e$B$OJQ49$N=*E@$r<($9J8;zNs$^$?$O\e(B nil\e$B!#\e(B
 698 KUGIRI\e$B$OJ8@a$N6h@Z$j$rI=<($9$kJ8;zNs$^$?$O\e(B nil\e$B!#\e(B
 699 HENKAN-FACE \e$B$,;XDj$5$l$F\e(B nil \e$B$G$J$1$l$P!"JQ496h4V$rI=<($9$k\e(B face \e$B$H$7$F;H$o$l$k!#\e(B
 700 BUNSETU-FACE \e$B$,;XDj$5$l$F\e(B nil \e$B$G$J$1$l$P!"CmL\$7$F$$$kJ8@a$rI=<($9$k\e(B face \e$B$H$7$F;H$o$l$k\e(B"
 701
 702   (interactive (list (read-string "\e$BJQ493+;OJ8;zNs\e(B: ")
 703                      (read-string "\e$BJQ49=*N;J8;zNs\e(B: ")
 704                      (read-string "\e$BJ8@a6h@Z$jJ8;zNs\e(B: ")
 705                      (cdr (assoc (completing-read "\e$BJQ496h4VI=<(B0@-\e(B: " egg:*face-alist*)
 706                                  egg:*face-alist*))
 707                      (cdr (assoc (completing-read "\e$BJ8@a6h4VI=<(B0@-\e(B: " egg:*face-alist*)
 708                                  egg:*face-alist*))
 709                      ))
 710
 711   (if (and (or (stringp open)  (null open))
 712            (or (stringp close) (null close))
 713            (or (stringp kugiri) (null kugiri))
 714            (or (null henkan-face) (memq henkan-face (face-list)))
 715            (or (null bunsetu-face) (memq henkan-face (face-list))))
 716       (progn
 717         (setq egg:*henkan-open* (or open "")
 718               egg:*henkan-close* (or close "")
 719               egg:*bunsetu-kugiri* (or kugiri "")
 720               egg:*henkan-face* henkan-face
 721               egg:*bunsetu-face* bunsetu-face)
 722         (and (extentp egg:*henkan-extent*)
 723              (set-extent-property
 724               egg:*henkan-extent* 'face egg:*henkan-face*))
 725         (and (extentp egg:*bunsetu-extent*)
 726              (set-extent-property
 727               egg:*bunsetu-extent* 'face egg:*bunsetu-face*))
 728
 729         t)
 730     (error "Wrong type of arguments: %1 %2 %3 %4 %5" open close kugiri henkan-face bunsetu-face)))
 731
 732 (defun henkan-insert-kouho (bunsetu-no)
 733   (let ((max (bunsetu-su)) (i bunsetu-no))
 734     (while (< i max)
 735       (bunsetu-kanji-insert i)
 736       (insert  egg:*bunsetu-kugiri* )
 737       (setq i (1+ i)))
 738     (if (< bunsetu-no max) (delete-char (- (length egg:*bunsetu-kugiri*))))))
 739
 740 (defun henkan-kakutei ()
 741   (interactive)
 742   (egg:bunsetu-face-off)
 743   (egg:henkan-face-off)
 744   (setq egg:henkan-mode-in-use nil)
 745   (setq egg:*in-fence-mode* nil)
 746   (delete-region (- egg:*region-start* (length egg:*henkan-open*))
 747                  egg:*region-start*)
 748   (delete-region egg:*region-start* egg:*region-end*)
 749   (delete-region egg:*region-end* (+ egg:*region-end* (length egg:*henkan-close*)))
 750   (goto-char egg:*region-start*)
 751   (resume-undo-list)
 752   (let ((i 0) (max (bunsetu-su)))
 753     (while (< i max)
 754       ;;;(KKCP:henkan-kakutei i (bunsetu-kouho-number i))
 755       (bunsetu-kanji-insert i)
 756       (if (not overwrite-mode)
 757           (undo-boundary))
 758       (setq i (1+ i))
 759       ))
 760   (KKCP:henkan-end)
 761   (egg:quit-egg-mode)
 762   )
 763
 764 (defun henkan-kakutei-before-point ()
 765   (interactive)
 766   (egg:bunsetu-face-off)
 767   (egg:henkan-face-off)
 768   (delete-region egg:*region-start* egg:*region-end*)
 769   (goto-char egg:*region-start*)
 770   (let ((i 0) (max *bunsetu-number*))
 771     (while (< i max)
 772       ;;;(KKCP:henkan-kakutei i (bunsetu-kouho-number i))
 773       (bunsetu-kanji-insert i)
 774       (if (not overwrite-mode)
 775           (undo-boundary))
 776       (setq i (1+ i))
 777       ))
 778   (KKCP:henkan-end *bunsetu-number*)
 779   (delete-region (- egg:*region-start* (length egg:*henkan-open*))
 780                  egg:*region-start*)
 781   (insert egg:*fence-open*)
 782   (set-marker egg:*region-start* (point))
 783   (delete-region egg:*region-end* (+ egg:*region-end* (length egg:*henkan-close*)))
 784   (goto-char egg:*region-end*)
 785   (let ((point (point)))
 786     (insert egg:*fence-close*)
 787     (set-marker egg:*region-end* point))
 788   (goto-char egg:*region-start*)
 789   (egg:fence-face-on)
 790   (let ((point (point))
 791         (i *bunsetu-number*) (max (bunsetu-su)))
 792     (while (< i max)
 793       (bunsetu-yomi-insert i)
 794       (setq i (1+ i)))
 795     ;;;(insert "|")
 796     ;;;(insert egg:*fence-close*)
 797     ;;;(set-marker egg:*region-end* (point))
 798     (goto-char point))
 799   (setq egg:*mode-on* t)
 800   ;;;(use-global-map fence-mode-map)
 801   ;;;(use-local-map  nil)
 802   (setq egg:henkan-mode-in-use nil)
 803   ;;(use-local-map fence-mode-map)
 804   (egg:mode-line-display))
 805
 806 (defun egg:set-bunsetu-face (no face switch)
 807   (if (not switch)
 808       (egg:bunsetu-face-off) ;; JIC
 809     (unless (extentp egg:*bunsetu-extent*)
 810       (setq egg:*bunsetu-extent* (make-extent 1 1 nil))
 811       (set-extent-property egg:*bunsetu-extent* 'face egg:*bunsetu-face*))
 812     (set-extent-endpoints egg:*bunsetu-extent*
 813                           (if (eq face 'modeline)
 814                               (let ((point (bunsetu-position no)))
 815                                 (1+ point))
 816                             (bunsetu-position no))
 817
 818                           (if (= no (1- (bunsetu-su)))
 819                               egg:*region-end*
 820                             (- (bunsetu-position (1+ no))
 821                                (length egg:*bunsetu-kugiri*)))
 822                           (current-buffer))))
 823
 824 (defun egg:bunsetu-face-on (no)
 825   (egg:set-bunsetu-face no egg:*bunsetu-face* t))
 826
 827 (defun egg:bunsetu-face-off ()
 828   ;; detach henkan extent from the current buffer.
 829   (and (extentp egg:*bunsetu-extent*)
 830        (detach-extent egg:*bunsetu-extent*)))
 831
 832 (defun henkan-goto-bunsetu (number)
 833   (setq *bunsetu-number*
 834         (check-number-range number 0 (1- (bunsetu-su))))
 835   (goto-char (bunsetu-position *bunsetu-number*))
 836   (egg:bunsetu-face-on *bunsetu-number*)
 837   )
 838
 839 (defun henkan-forward-bunsetu ()
 840   (interactive)
 841   (henkan-goto-bunsetu (1+ *bunsetu-number*))
 842   )
 843
 844 (defun henkan-backward-bunsetu ()
 845   (interactive)
 846   (henkan-goto-bunsetu (1- *bunsetu-number*))
 847   )
 848
 849 (defun henkan-first-bunsetu ()
 850   (interactive)
 851   (henkan-goto-bunsetu 0))
 852
 853 (defun henkan-last-bunsetu ()
 854   (interactive)
 855   (henkan-goto-bunsetu (1- (bunsetu-su)))
 856   )
 857
 858 (defun check-number-range (i min max)
 859   (cond((< i min) max)
 860        ((< max i) min)
 861        (t i)))
 862
 863 (defun henkan-hiragana ()
 864   (interactive)
 865   (henkan-goto-kouho (- (bunsetu-kouho-suu *bunsetu-number*) 1)))
 866
 867 (defun henkan-katakana ()
 868   (interactive)
 869   (henkan-goto-kouho (- (bunsetu-kouho-suu *bunsetu-number*) 2)))
 870
 871 (defun henkan-next-kouho ()
 872   (interactive)
 873   (henkan-goto-kouho (1+ (bunsetu-kouho-number *bunsetu-number*))))
 874
 875 (defun henkan-previous-kouho ()
 876   (interactive)
 877   (henkan-goto-kouho (1- (bunsetu-kouho-number *bunsetu-number*))))
 878
 879 (defun henkan-goto-kouho (kouho-number)
 880   (let ((point (point))
 881         (yomi  (bunsetu-yomi *bunsetu-number*))
 882         (i *bunsetu-number*)
 883         (max (bunsetu-su)))
 884     (setq kouho-number
 885           (check-number-range kouho-number
 886                               0
 887                               (1- (bunsetu-kouho-suu *bunsetu-number*))))
 888     (while (< i max)
 889       (if (bunsetu-yomi-equal i yomi)
 890           (let ((p1 (bunsetu-position i)))
 891             (delete-region p1
 892                            (+ p1 (bunsetu-kanji-length i)))
 893             (goto-char p1)
 894             (bunsetu-set-kanji i kouho-number)
 895             (bunsetu-kanji-insert i)))
 896       (setq i (1+ i)))
 897     (goto-char point))
 898   (egg:bunsetu-face-on *bunsetu-number*))
 899
 900 (defun henkan-bunsetu-chijime ()
 901   (interactive)
 902   (or (= (bunsetu-length *bunsetu-number*) 1)
 903       (bunsetu-length-henko (1-  (bunsetu-length *bunsetu-number*)))))
 904
 905 (defun henkan-bunsetu-nobasi ()
 906   (interactive)
 907   (if (not (= (1+ *bunsetu-number*) (bunsetu-su)))
 908       (bunsetu-length-henko (1+ (bunsetu-length *bunsetu-number*)))))
 909
 910 (defun henkan-saishou-bunsetu ()
 911   (interactive)
 912   (bunsetu-length-henko 1))
 913
 914 (defun henkan-saichou-bunsetu ()
 915   (interactive)
 916   (let ((max (bunsetu-su)) (i *bunsetu-number*)
 917         (l 0))
 918     (while (< i max)
 919       (setq l (+ l (bunsetu-length i)))
 920       (setq i (1+ i)))
 921     (bunsetu-length-henko l)))
 922
 923 (defun bunsetu-length-henko (length)
 924   (let ((r (KKCP:bunsetu-henkou *bunsetu-number* length)))
 925     (cond(r
 926           (delete-region
 927            (bunsetu-position *bunsetu-number*) egg:*region-end*)
 928           (goto-char (bunsetu-position *bunsetu-number*))
 929           (henkan-insert-kouho *bunsetu-number*)
 930           (henkan-goto-bunsetu *bunsetu-number*))
 931          (t
 932           (egg:bunsetu-face-on *bunsetu-number*)))))
 933
 934 (defun henkan-quit ()
 935   (interactive)
 936   (egg:bunsetu-face-off)
 937   (egg:henkan-face-off)
 938   (delete-region (- egg:*region-start* (length egg:*henkan-open*))
 939                  egg:*region-start*)
 940   (delete-region egg:*region-start* egg:*region-end*)
 941   (delete-region egg:*region-end* (+ egg:*region-end* (length egg:*henkan-close*)))
 942   (goto-char egg:*region-start*)
 943   (insert egg:*fence-open*)
 944   (set-marker egg:*region-start* (point))
 945   (insert egg:*kanji-kanabuff*)
 946   (let ((point (point)))
 947     (insert egg:*fence-close*)
 948     (set-marker egg:*region-end* point)
 949     )
 950   (goto-char egg:*region-end*)
 951   (egg:fence-face-on)
 952   (KKCP:henkan-quit)
 953   (setq egg:*mode-on* t)
 954   ;;;(use-global-map fence-mode-map)
 955   ;;;(use-local-map  nil)
 956   (setq egg:henkan-mode-in-use nil)
 957   ;;(use-local-map fence-mode-map)
 958   (setq egg:*in-fence-mode* t)
 959   (egg:mode-line-display)
 960   )
 961
 962 (defun henkan-select-kouho ()
 963   (interactive)
 964   (if (not (eq (selected-window) (minibuffer-window)))
 965       (let ((kouho-list (bunsetu-kouho-list *bunsetu-number*))
 966             menu)
 967         (setq menu
 968               (list 'menu "\e$B<!8uJd\e(B:"
 969                     (let ((l kouho-list) (r nil) (i 0))
 970                       (while l
 971                         (setq r (cons (cons (car l) i) r))
 972                         (setq i (1+ i))
 973                         (setq l (cdr l)))
 974                       (reverse r))))
 975         (henkan-goto-kouho
 976          (menu:select-from-menu menu
 977                                (bunsetu-kouho-number *bunsetu-number*))))
 978     (beep)))
 979
 980 (defun henkan-kakutei-and-self-insert ()
 981   (interactive)
 982   (setq unread-command-events (list last-command-event))
 983   (henkan-kakutei))
 984
 985
 986 (defvar henkan-mode-map (make-sparse-keymap))
 987 (set-keymap-default-binding henkan-mode-map 'undefined)
 988
 989 (let ((ch 32))
 990   (while (< ch 127)
 991     (define-key henkan-mode-map (make-string 1 ch) 'henkan-kakutei-and-self-insert)
 992     (setq ch (1+ ch))))
 993
 994 (define-key henkan-mode-map "\ei" 'henkan-bunsetu-chijime)
 995 (define-key henkan-mode-map "\eo" 'henkan-bunsetu-nobasi)
 996 (define-key henkan-mode-map "\es" 'henkan-select-kouho)
 997 (define-key henkan-mode-map "\eh" 'henkan-hiragana)
 998 (define-key henkan-mode-map "\ek" 'henkan-katakana)
 999 (define-key henkan-mode-map "\e<" 'henkan-saishou-bunsetu)
1000 (define-key henkan-mode-map "\e>" 'henkan-saichou-bunsetu)
1001
1002 (define-key henkan-mode-map " "    'henkan-next-kouho)
1003 (define-key henkan-mode-map "\C-@" 'henkan-next-kouho)
1004 (define-key henkan-mode-map "\C-a" 'henkan-first-bunsetu)
1005 (define-key henkan-mode-map "\C-b" 'henkan-backward-bunsetu)
1006 (define-key henkan-mode-map "\C-c" 'henkan-quit)
1007 (define-key henkan-mode-map "\C-e" 'henkan-last-bunsetu)
1008 (define-key henkan-mode-map "\C-f" 'henkan-forward-bunsetu)
1009 (define-key henkan-mode-map "\C-g" 'henkan-quit)
1010 (define-key henkan-mode-map "\C-h" 'henkan-help-command)
1011 (define-key henkan-mode-map "\C-i" 'henkan-bunsetu-chijime)
1012 (define-key henkan-mode-map "\C-k" 'henkan-kakutei-before-point)
1013 (define-key henkan-mode-map "\C-l" 'henkan-kakutei)
1014 (define-key henkan-mode-map "\C-m" 'henkan-kakutei)
1015 (define-key henkan-mode-map "\C-n" 'henkan-next-kouho)
1016 (define-key henkan-mode-map "\C-o" 'henkan-bunsetu-nobasi)
1017 (define-key henkan-mode-map "\C-p" 'henkan-previous-kouho)
1018 (define-key henkan-mode-map "\177" 'henkan-quit)
1019 (define-key henkan-mode-map [backspace] 'henkan-quit)
1020 (define-key henkan-mode-map [clear]     'henkan-quit)
1021 (define-key henkan-mode-map [delete]    'henkan-quit)
1022 (define-key henkan-mode-map [down]      'henkan-next-kouho)
1023 (define-key henkan-mode-map [help]      'henkan-help-command)
1024 (define-key henkan-mode-map [kp-enter]  'henkan-kakutei)
1025 (define-key henkan-mode-map [kp-down]   'henkan-next-kouho)
1026 (define-key henkan-mode-map [kp-left]   'henkan-backward-bunsetu)
1027 (define-key henkan-mode-map [kp-right]  'henkan-forward-bunsetu)
1028 (define-key henkan-mode-map [kp-up]     'henkan-previous-kouho)
1029 (define-key henkan-mode-map [left]      'henkan-backward-bunsetu)
1030 (define-key henkan-mode-map [next]      'henkan-next-kouho)
1031 (define-key henkan-mode-map [prior]     'henkan-previous-kouho)
1032 (define-key henkan-mode-map [return]    'henkan-kakutei)
1033 (define-key henkan-mode-map [right]     'henkan-forward-bunsetu)
1034 (define-key henkan-mode-map [up]        'henkan-previous-kouho)
1035
1036 (unless (assq 'egg:henkan-mode-in-use minor-mode-map-alist)
1037   (setq minor-mode-map-alist
1038         (cons (cons 'egg:henkan-mode-in-use henkan-mode-map)
1039               minor-mode-map-alist)))
1040
1041 (defun henkan-help-command ()
1042   "Display documentation fo henkan-mode."
1043   (interactive)
1044   (with-output-to-temp-buffer "*Help*"
1045     (princ (substitute-command-keys henkan-mode-document-string))
1046     (print-help-return-message)))
1047
1048 (defvar henkan-mode-document-string "\e$B4A;zJQ49%b!<%I\e(B:
1049 \e$BJ8@a0\F0\e(B
1050   \\[henkan-first-bunsetu]\t\e$B@hF,J8@a\e(B\t\\[henkan-last-bunsetu]\t\e$B8eHxJ8@a\e(B
1051   \\[henkan-backward-bunsetu]\t\e$BD>A0J8@a\e(B\t\\[henkan-forward-bunsetu]\t\e$BD>8eJ8@a\e(B
1052 \e$BJQ49JQ99\e(B
1053   \e$B<!8uJd\e(B    \\[henkan-previous-kouho]  \t\e$BA08uJd\e(B    \\[henkan-next-kouho]
1054   \e$BJ8@a?-$7\e(B  \\[henkan-bunsetu-nobasi]  \t\e$BJ8@a=L$a\e(B  \\[henkan-bunsetu-chijime]
1055   \e$BJQ498uJdA*Br\e(B  \\[henkan-select-kouho]
1056 \e$BJQ493NDj\e(B
1057   \e$BA4J8@a3NDj\e(B  \\[henkan-kakutei]  \t\e$BD>A0J8@a$^$G3NDj\e(B  \\[henkan-kakutei-before-point]
1058 \e$BJQ49Cf;_\e(B    \\[henkan-quit]
1059 ")
1060
1061 ;;;----------------------------------------------------------------------
1062 ;;;
1063 ;;; Dictionary management Facility
1064 ;;;
1065 ;;;----------------------------------------------------------------------
1066
1067 ;;;
1068 ;;; \e$B<-=qEPO?\e(B
1069 ;;;
1070
1071 ;;;;
1072 ;;;; User entry: toroku-region
1073 ;;;;
1074
1075 (defun remove-regexp-in-string (regexp string)
1076   (cond((not(string-match regexp string))
1077         string)
1078        (t(let ((str nil)
1079              (ostart 0)
1080              (oend   (match-beginning 0))
1081              (nstart (match-end 0)))
1082          (setq str (concat str (substring string ostart oend)))
1083          (while (string-match regexp string nstart)
1084            (setq ostart nstart)
1085            (setq oend   (match-beginning 0))
1086            (setq nstart (match-end 0))
1087            (setq str (concat str (substring string ostart oend))))
1088          str))))
1089
1090 (defun toroku-region (start end)
1091   (interactive "r")
1092   (let*((kanji
1093          (remove-regexp-in-string "[\0-\37]" (buffer-substring start end)))
1094         (yomi (read-hiragana-string
1095                (format "\e$B<-=qEPO?!X\e(B%s\e$B!Y\e(B  \e$BFI$_\e(B :" kanji)))
1096         (type (menu:select-from-menu *sj3-bunpo-menu*))
1097         (dict-no
1098          (menu:select-from-menu (list 'menu "\e$BEPO?<-=qL>\e(B:" egg:*dict-menu*))))
1099     ;;;(if (string-match "[\0-\177]" kanji)
1100     ;;; (error "Kanji string contains hankaku character. %s" kanji))
1101     ;;;(if (string-match "[\0-\177]" yomi)
1102     ;;; (error "Yomi string contains hankaku character. %s" yomi))
1103     (KKCP:dict-add dict-no kanji yomi type)
1104     (let ((hinshi (nth 1 (assq type *sj3-bunpo-code*)))
1105           (gobi   (nth 2 (assq type *sj3-bunpo-code*)))
1106           (dict-name (cdr (assq dict-no egg:*usr-dict*))))
1107       (notify "\e$B<-=q9`L\!X\e(B%s\e$B!Y\e(B(%s: %s)\e$B$r\e(B%s\e$B$KEPO?$7$^$7$?!#\e(B"
1108               (if gobi (concat kanji " " gobi) kanji)
1109               (if gobi (concat yomi  " " gobi) yomi)
1110               hinshi dict-name))))
1111
1112
1113
1114 ;;; (lsh 1 18)
1115 (defvar *sj3-bunpo-menu*
1116   '(menu "\e$BIJ;l\e(B:"
1117    (("\e$BL>;l\e(B"      .
1118      (menu "\e$BIJ;l\e(B:\e$BL>;l\e(B:"
1119            (("\e$BL>;l\e(B"               . 1)
1120             ("\e$BL>;l\e(B(\e$B$*!D\e(B)"   . 2)
1121             ("\e$BL>;l\e(B(\e$B$4!D\e(B)"   . 3)
1122             ("\e$BL>;l\e(B(\e$B!DE*\e(B/\e$B2=\e(B)"  . 4)
1123             ("\e$BL>;l\e(B(\e$B$*!D$9$k\e(B)"       . 5)
1124             ("\e$BL>;l\e(B(\e$B!D$9$k\e(B)" . 6)
1125             ("\e$BL>;l\e(B(\e$B$4!D$9$k\e(B)"       . 7)
1126             ("\e$BL>;l\e(B(\e$B!D$J\e(B/\e$B$K\e(B)"  . 8)
1127             ("\e$BL>;l\e(B(\e$B$*!D$J\e(B/\e$B$K\e(B)"        . 9)
1128             ("\e$BL>;l\e(B(\e$B$4!D$J\e(B/\e$B$K\e(B)"        . 10)
1129             ("\e$BL>;l\e(B(\e$BI{;l\e(B)"   . 11))))
1130     ("\e$BBeL>;l\e(B"    . 12)
1131     ("\e$BID;z\e(B"      . 21)
1132     ("\e$BL>A0\e(B"      . 22)
1133     ("\e$BCOL>\e(B"      . 24)
1134     ("\e$B8)\e(B/\e$B6hL>\e(B"   . 25)
1135     ("\e$BF0;l\e(B"      .
1136           (menu "\e$BIJ;l\e(B:\e$BF0;l\e(B:"
1137                 (("\e$B%5JQ8l44\e(B"      . 80)
1138                  ("\e$B%6JQ8l44\e(B"      . 81)
1139                  ("\e$B0lCJITJQ2=It\e(B"  . 90)
1140                  ("\e$B%+9T8^CJ8l44\e(B"  . 91)
1141                  ("\e$B%,9T8^CJ8l44\e(B"  . 92)
1142                  ("\e$B%59T8^CJ8l44\e(B"  . 93)
1143                  ("\e$B%?9T8^CJ8l44\e(B"  . 94)
1144                  ("\e$B%J9T8^CJ8l44\e(B"  . 95)
1145                  ("\e$B%P9T8^CJ8l44\e(B"  . 96)
1146                  ("\e$B%^9T8^CJ8l44\e(B"  . 97)
1147                  ("\e$B%i9T8^CJ8l44\e(B"  . 98)
1148                  ("\e$B%o9T8^CJ8l44\e(B"  . 99))))
1149     ("\e$BO"BN;l\e(B"         . 26)
1150     ("\e$B@\B3;l\e(B"         . 27)
1151     ("\e$B=u?t;l\e(B"         . 29)
1152     ("\e$B?t;l\e(B"           . 30)
1153     ("\e$B@\F,8l\e(B"         . 31)
1154     ("\e$B@\Hx8l\e(B"         . 36)
1155     ("\e$BI{;l\e(B"           . 45)
1156     ("\e$BI{;l\e(B2"          . 46)
1157     ("\e$B7AMF;l8l44\e(B"     . 60)
1158     ("\e$B7AMFF0;l8l44\e(B"   . 71)
1159     ("\e$BC14A;z\e(B"         . 189))))
1160
1161 (defvar *sj3-bunpo-code*
1162   '(
1163     ( 1   "\e$BL>;l\e(B" )
1164     ( 2   "\e$BL>;l\e(B(\e$B$*!D\e(B)" )
1165     ( 3   "\e$BL>;l\e(B(\e$B$4!D\e(B)" )
1166     ( 4   "\e$BL>;l\e(B(\e$B!DE*\e(B/\e$B2=\e(B)" "\e$BE*\e(B" nil)
1167     ( 5   "\e$BL>;l\e(B(\e$B$*!D$9$k\e(B)" "\e$B$9$k\e(B" nil)
1168     ( 6   "\e$BL>;l\e(B(\e$B!D$9$k\e(B)" "\e$B$9$k\e(B" nil)
1169     ( 7   "\e$BL>;l\e(B(\e$B$4!D$9$k\e(B)" "\e$B$9$k\e(B" nil)
1170     ( 8   "\e$BL>;l\e(B(\e$B!D$J\e(B/\e$B$K\e(B)" "\e$B$J\e(B/\e$B$K\e(B" nil)
1171     ( 9   "\e$BL>;l\e(B(\e$B$*!D$J\e(B/\e$B$K\e(B)" "\e$B$J\e(B/\e$B$K\e(B" nil)
1172     ( 10  "\e$BL>;l\e(B(\e$B$4!D$J\e(B/\e$B$K\e(B)" "\e$B$J\e(B/\e$B$K\e(B" nil)
1173     ( 11  "\e$BL>;l\e(B(\e$BI{;l\e(B)" )
1174     ( 12  "\e$BBeL>;l\e(B" )
1175     ( 21  "\e$BID;z\e(B" )
1176     ( 22  "\e$BL>A0\e(B" )
1177     ( 24  "\e$BCOL>\e(B" )
1178     ( 25  "\e$B8)\e(B/\e$B6hL>\e(B" )
1179     ( 26  "\e$BO"BN;l\e(B" )
1180     ( 27  "\e$B@\B3;l\e(B" )
1181     ( 29  "\e$B=u?t;l\e(B" )
1182     ( 30  "\e$B?t;l\e(B"   )
1183     ( 31  "\e$B@\F,8l\e(B" )
1184     ( 36  "\e$B@\Hx8l\e(B" )
1185     ( 45  "\e$BI{;l\e(B" )
1186     ( 46  "\e$BI{;l\e(B2" )
1187     ( 60  "\e$B7AMF;l8l44\e(B"           "\e$B$$\e(B" ("" "" "" "" ""))
1188     ( 71  "\e$B7AMFF0;l8l44\e(B"         "\e$B$K\e(B" ("" "" "" "" "") )
1189     ( 80  "\e$B%5JQ8l44\e(B"             "\e$B$9$k\e(B" ("" "" "" "" ""))
1190     ( 81  "\e$B%6JQ8l44\e(B"             "\e$B$:$k\e(B" ("" "" "" "" ""))
1191     ( 90  "\e$B0lCJITJQ2=It\e(B"         "\e$B$k\e(B" ("" "" "" "" ""))
1192     ( 91  "\e$B%+9T8^CJ8l44\e(B"         "\e$B$/\e(B" ("\e$B$+$J$$\e(B" "\e$B$-$^$9\e(B" "\e$B$/\e(B" "\e$B$/$H$-\e(B" "\e$B$1\e(B"))
1193     ( 92  "\e$B%,9T8^CJ8l44\e(B"         "\e$B$0\e(B" ("\e$B$,$J$$\e(B" "\e$B$.$^$9\e(B" "" "" ""))
1194     ( 93  "\e$B%59T8^CJ8l44\e(B"         "\e$B$9\e(B" ("" "" "" "" ""))
1195     ( 94  "\e$B%?9T8^CJ8l44\e(B"         "\e$B$D\e(B" ("" "" "" "" ""))
1196     ( 95  "\e$B%J9T8^CJ8l44\e(B"         "\e$B$L\e(B" ("" "" "" "" ""))
1197     ( 96  "\e$B%P9T8^CJ8l44\e(B"         "\e$B$V\e(B" ("" "" "" "" ""))
1198     ( 97  "\e$B%^9T8^CJ8l44\e(B"         "\e$B$`\e(B" ("" "" "" "" ""))
1199     ( 98  "\e$B%i9T8^CJ8l44\e(B"         "\e$B$k\e(B" ("" "" "" "" ""))
1200     ( 99  "\e$B%o9T8^CJ8l44\e(B"         "\e$B$&\e(B" ("" "" "" "" ""))
1201     ( 189  "\e$BC14A;z\e(B"  )
1202     ( 190  "\e$BITDj\e(B"  )
1203     ( 1000  "\e$B$=$NB>\e(B"  )
1204     ))
1205
1206 ;;;
1207 ;;; \e$B<-=qJT=87O\e(B DicEd
1208 ;;;
1209
1210 (defvar *diced-window-configuration* nil)
1211
1212 (defvar *diced-dict-info* nil)
1213
1214 (defvar *diced-dno* nil)
1215
1216 ;;;;;
1217 ;;;;; User entry : edit-dict
1218 ;;;;;
1219
1220 (defun edit-dict ()
1221   (interactive)
1222   (let*((dict-no
1223          (menu:select-from-menu (list 'menu "\e$B<-=qL>\e(B:" egg:*dict-menu*)))
1224         (dict-name (file-name-nondirectory
1225                     (cdr (assq dict-no egg:*usr-dict*))))
1226         (dict-info (KKCP:dict-info dict-no)))
1227     (if (null dict-info)
1228         (message "\e$B<-=q\e(B: %s \e$B$KEPO?$5$l$F$$$k9`L\$O$"$j$^$;$s!#\e(B" dict-name)
1229       (progn
1230         (setq *diced-dno* dict-no)
1231         (setq *diced-window-configuration* (current-window-configuration))
1232         (pop-to-buffer "*Nihongo Dictionary Information*")
1233         (setq major-mode 'diced-mode)
1234         (setq mode-name "Diced")
1235         (setq mode-line-buffer-identification
1236               (concat "DictEd: " dict-name
1237                       (make-string
1238                        (max 0 (- 17 (string-width dict-name))) ?  )
1239                       ))
1240         (sit-for 0) ;; will redislay.
1241         ;;;(use-global-map diced-mode-map)
1242         (use-local-map diced-mode-map)
1243         (diced-display dict-info)
1244         ))))
1245
1246 (defun diced-redisplay ()
1247   (let ((dict-info (KKCP:dict-info *diced-dno*)))
1248     (if (null dict-info)
1249         (progn
1250           (message "\e$B<-=q\e(B: %s \e$B$KEPO?$5$l$F$$$k9`L\$O$"$j$^$;$s!#\e(B"
1251                    (file-name-nondirectory
1252                     (cdr (assq *diced-dno* egg:*usr-dict*))))
1253           (diced-quit))
1254       (diced-display dict-info))))
1255
1256 (defun diced-display (dict-info)
1257         ;;; (values (list (record yomi kanji bunpo)))
1258         ;;;                         0    1     2
1259   (setq *diced-dict-info* dict-info)
1260   (setq buffer-read-only nil)
1261   (erase-buffer)
1262   (let ((l-yomi
1263          (apply 'max
1264                 (mapcar (function (lambda (l) (string-width (nth 0 l))))
1265                         dict-info)))
1266         (l-kanji
1267          (apply 'max
1268                 (mapcar (function (lambda (l) (string-width (nth 1 l))))
1269                         dict-info))))
1270     (while dict-info
1271       (let*((yomi (nth 0 (car dict-info)))
1272             (kanji (nth 1 (car dict-info)))
1273             (bunpo (nth 2 (car dict-info)))
1274             (gobi   (nth 2 (assq bunpo *sj3-bunpo-code*)))
1275             (hinshi (nth 1 (assq bunpo *sj3-bunpo-code*))))
1276
1277         (insert "  " yomi)
1278         (if gobi (insert " " gobi))
1279         (insert-char ?
1280                      (- (+ l-yomi 10) (string-width yomi)
1281                         (if gobi (+ 1 (string-width gobi)) 0)))
1282         (insert kanji)
1283         (if gobi (insert " " gobi))
1284         (insert-char ?
1285                      (- (+ l-kanji 10) (string-width kanji)
1286                         (if gobi (+ 1 (string-width gobi)) 0)))
1287         (insert hinshi ?\n)
1288         (setq dict-info (cdr dict-info))))
1289     (goto-char (point-min)))
1290   (setq buffer-read-only t))
1291
1292 (defun diced-add ()
1293   (interactive)
1294   (diced-execute t)
1295   (let*((kanji (read-kanji-string "\e$B4A;z!'\e(B"))
1296         (yomi (read-hiragana-string "\e$BFI$_!'\e(B"))
1297         (bunpo (menu:select-from-menu *sj3-bunpo-menu*))
1298         (gobi   (nth 2 (assq bunpo *sj3-bunpo-code*)))
1299         (hinshi (nth 1 (assq bunpo *sj3-bunpo-code*)))
1300         (item (if gobi (concat kanji " " gobi) kanji))
1301         (item-yomi (if gobi (concat yomi " " gobi) yomi))
1302         (dict-name (cdr (assq *diced-dno* egg:*usr-dict*))))
1303     (if (notify-yes-or-no-p "\e$B<-=q9`L\!X\e(B%s\e$B!Y\e(B(%s: %s)\e$B$r\e(B%s\e$B$KEPO?$7$^$9!#\e(B"
1304               item item-yomi hinshi (file-name-nondirectory dict-name))
1305         (progn
1306           (KKCP:dict-add *diced-dno* kanji yomi bunpo)
1307           (notify "\e$B<-=q9`L\!X\e(B%s\e$B!Y\e(B(%s: %s)\e$B$r\e(B%s\e$B$KEPO?$7$^$7$?!#\e(B"
1308                   item item-yomi hinshi dict-name)
1309           (diced-redisplay)))))
1310
1311 (defun diced-delete ()
1312   (interactive)
1313   (beginning-of-line)
1314   (if (eq (char-after) ?  )
1315       (let ((buffer-read-only nil))
1316         (delete-char 1) (insert "D") (backward-char 1))))
1317
1318 (defun diced-undelete ()
1319   (interactive)
1320   (beginning-of-line)
1321   (if (eq (char-after) ?D)
1322       (let ((buffer-read-only nil))
1323         (delete-char 1) (insert " ") (backward-char 1))
1324     (beep)))
1325
1326 (defun diced-quit ()
1327   (interactive)
1328   (setq buffer-read-only nil)
1329   (erase-buffer)
1330   (setq buffer-read-only t)
1331   (bury-buffer (get-buffer "*Nihongo Dictionary Information*"))
1332   (set-window-configuration *diced-window-configuration*)
1333   )
1334
1335 (defun diced-execute (&optional display)
1336   (interactive)
1337   (goto-char (point-min))
1338   (let ((no  0))
1339     (while (not (eobp))
1340       (if (eq (char-after) ?D)
1341           (let* ((dict-item (nth no *diced-dict-info*))
1342                  (yomi (nth 0 dict-item))
1343                  (kanji (nth 1 dict-item))
1344                  (bunpo (nth 2 dict-item))
1345                  (gobi   (nth 2 (assq bunpo *sj3-bunpo-code*)))
1346                  (hinshi (nth 1 (assq bunpo *sj3-bunpo-code*)))
1347                  (dict-name (cdr (assq *diced-dno* egg:*usr-dict*)))
1348                  (item (if gobi (concat kanji " " gobi) kanji))
1349                  (item-yomi (if gobi (concat yomi " " gobi) yomi)))
1350             (if (notify-yes-or-no-p "\e$B<-=q9`L\!X\e(B%s\e$B!Y\e(B(%s: %s)\e$B$r\e(B%s\e$B$+$i:o=|$7$^$9!#\e(B"
1351                                 item item-yomi hinshi (file-name-nondirectory
1352                                                        dict-name))
1353                 (progn
1354                   (KKCP:dict-delete *diced-dno* kanji yomi bunpo)
1355                   (notify "\e$B<-=q9`L\!X\e(B%s\e$B!Y\e(B(%s: %s)\e$B$r\e(B%s\e$B$+$i:o=|$7$^$7$?!#\e(B"
1356                           item item-yomi hinshi dict-name)
1357                   ))))
1358       (setq no (1+ no))
1359       (forward-line 1)))
1360   (forward-line -1)
1361   (if (not display) (diced-redisplay)))
1362
1363 (defun diced-next-line ()
1364   (interactive)
1365   (beginning-of-line)
1366   (forward-line 1)
1367   (if (eobp) (progn (beep) (forward-line -1))))
1368
1369 (defun diced-end-of-buffer ()
1370   (interactive)
1371   (end-of-buffer)
1372   (forward-line -1))
1373
1374 (defun diced-scroll-down ()
1375   (interactive)
1376   (scroll-down)
1377   (if (eobp) (forward-line -1)))
1378
1379 (defun diced-mode ()
1380   "Mode for \"editing\" dictionaries.
1381 In diced, you are \"editing\" a list of the entries in dictionaries.
1382 You can move using the usual cursor motion commands.
1383 Letters no longer insert themselves. Instead,
1384
1385 Type  a to Add new entry.
1386 Type  d to flag an entry for Deletion.
1387 Type  n to move cursor to Next entry.
1388 Type  p to move cursor to Previous entry.
1389 Type  q to Quit from DicEd.
1390 Type  u to Unflag an entry (remove its D flag).
1391 Type  x to eXecute the deletions requested.
1392 "
1393  )
1394
1395 (defvar diced-mode-map (make-sparse-keymap))
1396 (set-keymap-default-binding diced-mode-map 'undefined)
1397
1398 (define-key diced-mode-map "a"    'diced-add)
1399 (define-key diced-mode-map "d"    'diced-delete)
1400 (define-key diced-mode-map "n"    'diced-next-line)
1401 (define-key diced-mode-map "p"    'previous-line)
1402 (define-key diced-mode-map "q"    'diced-quit)
1403 (define-key diced-mode-map "u"    'diced-undelete)
1404 (define-key diced-mode-map "x"    'diced-execute)
1405
1406 (define-key diced-mode-map "\C-h" 'help-command)
1407 (define-key diced-mode-map "\C-n" 'diced-next-line)
1408 (define-key diced-mode-map "\C-p" 'previous-line)
1409 (define-key diced-mode-map "\C-v" 'scroll-up)
1410 (define-key diced-mode-map "\e<"  'beginning-of-buffer)
1411 (define-key diced-mode-map "\e>"  'diced-end-of-buffer)
1412 (define-key diced-mode-map "\ev"  'diced-scroll-down)
1413
1414 (define-key diced-mode-map [down]  'diced-next-line)
1415 (define-key diced-mode-map [help]  'help-command)
1416 (define-key diced-mode-map [next]  'diced-next-line)
1417 (define-key diced-mode-map [prior] 'previous-line)
1418 (define-key diced-mode-map [up]    'previous-line)
1419
1420 ;;; egg-sj3.el ends here