cgit.sxemacs.org Git - packages/blob - mule-packages/skk/skk-foreword.el

   1 ;;; skk-foreword.el --- \e$BA0=q$-\e(B
   2 ;; Copyright (C) 1997, 1998, 1999 Mikio Nakajima <minakaji@osaka.email.ne.jp>
   3
   4 ;; Author: Mikio Nakajima <minakaji@osaka.email.ne.jp>
   5 ;; Maintainer: Hideki Sakurada <sakurada@kuis.kyoto-u.ac.jp>
   6 ;;             Murata Shuuichirou  <mrt@astec.co.jp>
   7 ;;             Mikio Nakajima <minakaji@osaka.email.ne.jp>
   8 ;; Version: $Id: skk-foreword.el,v 1.5 2002-04-28 07:12:27 youngs Exp $
   9 ;; Keywords: japanese
  10 ;; Last Modified: $Date: 2002-04-28 07:12:27 $
  11
  12 ;; This file is not part of SKK yet.
  13
  14 ;; SKK is free software; you can redistribute it and/or modify
  15 ;; it under the terms of the GNU General Public License as published by
  16 ;; the Free Software Foundation; either versions 2, or (at your option)
  17 ;; any later version.
  18
  19 ;; SKK is distributed in the hope that it will be useful
  20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22 ;; GNU General Public License for more details.
  23
  24 ;; You should have received a copy of the GNU General Public License
  25 ;; along with SKK, see the file COPYING.  If not, write to the Free
  26 ;; Software Foundation Inc., 59 Temple Place - Suite 330, Boston,
  27 ;; MA 02111-1307, USA.
  28
  29 ;;; Commentary:
  30
  31 ;; \e$B$3$N%U%!%$%k$O!"%f!<%6!<JQ?t$N@k8@<+BN$K;HMQ$9$k%^%/%m!"\e(Bskk-*.el \e$B$G\e(B
  32 ;; \e$B;HMQ$9$k%^%/%m$J$I!"JQ?t$N@k8@0JA0!"\e(Bskk-*.el \e$B$N:G=i$KDj5A$7$F$*$+$J\e(B
  33 ;; \e$B$1$l$P$J$i$J$$$b$N$r$^$H$a$?$b$N$G$9!#%f!<%6!<JQ?t$NDj5A$NA0$K!"$4\e(B
  34 ;; \e$B$A$c$4$A$c$H%f!<%6!<$K6=L#$,$J$$$b$N$,JB$s$G$$$?$N$G$O!"%f!<%6!<%U\e(B
  35 ;; \e$B%l%s%I%j!<$G$O$J$$$H9M$($k$+$i$G$9!#\e(B
  36 ;;
  37 ;;; Code:
  38 (cond ((or (and (boundp 'epoch::version) epoch::version)
  39            (string< (substring emacs-version 0 2) "18") )
  40        (error "THIS SKK requires Emacs 19 or later") )
  41       ((not (featurep 'mule))
  42        (error "THIS SKK requires MULE features") ))
  43
  44 (eval-when-compile
  45   (defvar skk-abbrev-cursor-color)
  46   (defvar skk-abbrev-mode)
  47   (defvar skk-abbrev-mode-string)
  48   (defvar skk-current-rule-tree)
  49   (defvar skk-default-cursor-color)
  50   (defvar skk-downcase-alist)
  51   (defvar skk-echo)
  52   (defvar skk-hankaku-alist)
  53   (defvar skk-henkan-count)
  54   (defvar skk-henkan-list)
  55   (defvar skk-hiragana-cursor-color)
  56   (defvar skk-hiragana-mode-string)
  57   (defvar skk-input-mode-string)
  58   (defvar skk-j-mode)
  59   (defvar skk-jisx0208-latin-cursor-color)
  60   (defvar skk-jisx0208-latin-mode)
  61   (defvar skk-jisx0208-latin-mode-string)
  62   (defvar skk-kana-cleanup-command-list)
  63   (defvar skk-kana-input-search-function)
  64   (defvar skk-kana-start-point)
  65   (defvar skk-katakana)
  66   (defvar skk-katakana-cursor-color)
  67   (defvar skk-katakana-mode-string)
  68   (defvar skk-last-henkan-data)
  69   (defvar skk-latin-cursor-color)
  70   (defvar skk-latin-mode)
  71   (defvar skk-latin-mode-string)
  72   (defvar skk-look-completion-words)
  73   (defvar skk-mode)
  74   (defvar skk-prefix)
  75   (defvar skk-previous-point)
  76   (defvar skk-use-numeric-conversion) )
  77
  78 (require 'advice)
  79 (require 'easymenu)
  80 ;; APEL 9.22 or later required.
  81 (eval-when-compile (require 'static))
  82 (require 'poe)
  83 (require 'poem) ; requires pces.
  84 (require 'pcustom)
  85 (require 'alist)
  86 ;; Elib 1.0 is required.
  87 (require 'queue-m)
  88
  89 ;;;###autoload
  90 (eval-and-compile
  91   (defconst skk-emacs-type (cond ((featurep 'xemacs) 'xemacs)
  92                                  ((and (boundp 'mule-version)
  93                                        (string< "4.0" mule-version) 'mule4 ))
  94                                  ((and (boundp 'mule-version)
  95                                        (string< "3.0" mule-version) 'mule3 ))
  96                                  ((and (boundp 'mule-version)
  97                                        (string< "2.0" mule-version) 'mule2 )))))
  98
  99 ;; necessary macro and functions to be declared before user variable declarations.
 100
 101 ;;;; macros
 102 ;; Why I use non-intern temporary variable in the macro --- see comment in
 103 ;; save-match-data of subr.el of GNU Emacs. And should we use the same manner
 104 ;; in the save-current-buffer, with-temp-buffer and with-temp-file macro
 105 ;; definition?
 106 (defmacro skk-save-point (&rest body)
 107   (` (let ((skk-save-point (point-marker)))
 108        (unwind-protect
 109            (progn (,@ body))
 110          (goto-char skk-save-point)
 111          (skk-set-marker skk-save-point nil) ))))
 112
 113 (defmacro skk-message (japanese english &rest arg)
 114   ;; skk-japanese-message-and-error \e$B$,\e(B non-nil \e$B$@$C$?$i\e(B JAPANESE \e$B$r\e(B nil \e$B$G$"$l\e(B
 115   ;; \e$B$P\e(B ENGLISH \e$B$r%(%3!<%(%j%"$KI=<($9$k!#\e(B
 116   ;; ARG \e$B$O\e(B message \e$B4X?t$NBh#20z?t0J9_$N0z?t$H$7$FEO$5$l$k!#\e(B
 117   (append (list 'message (list 'if 'skk-japanese-message-and-error
 118                                japanese english ))
 119           arg ))
 120
 121 (defmacro skk-error (japanese english &rest arg)
 122   ;; skk-japanese-message-and-error \e$B$,\e(B non-nil \e$B$@$C$?$i\e(B JAPANESE \e$B$r\e(B nil \e$B$G$"$l\e(B
 123   ;; \e$B$P\e(B ENGLISH \e$B$r%(%3!<%(%j%"$KI=<($7!"%(%i!<$rH/@8$5$;$k!#\e(B
 124   ;; ARG \e$B$O\e(B error \e$B4X?t$NBh#20z?t0J9_$N0z?t$H$7$FEO$5$l$k!#\e(B
 125   (append (list 'error (list 'if 'skk-japanese-message-and-error
 126                              japanese english ))
 127           arg ))
 128
 129 (defmacro skk-yes-or-no-p (japanese english)
 130   ;; skk-japanese-message-and-error \e$B$,\e(B non-nil \e$B$G$"$l$P!"\e(Bjapanese \e$B$r\e(B nil \e$B$G$"\e(B
 131   ;; \e$B$l$P\e(B english \e$B$r%W%m%s%W%H$H$7$F\e(B yes-or-no-p \e$B$r<B9T$9$k!#\e(B
 132   ;; yes-or-no-p \e$B$N0z?t$N%W%m%s%W%H$,J#;($KF~$l9~$s$G$$$k>l9g$O$3$N%^%/%m$r;H\e(B
 133   ;; \e$B$&$h$j%*%j%8%J%k$N\e(B yes-or-no-p \e$B$r;HMQ$7$?J}$,%3!<%I$,J#;($K$J$i$J$$>l9g$,\e(B
 134   ;; \e$B$"$k!#\e(B
 135   (list 'yes-or-no-p (list 'if 'skk-japanese-message-and-error
 136                                    japanese english )))
 137
 138 (defmacro skk-y-or-n-p (japanese english)
 139   ;; skk-japanese-message-and-error \e$B$,\e(B non-nil \e$B$G$"$l$P!"\e(Bjapanese \e$B$r\e(B nil \e$B$G$"\e(B
 140   ;; \e$B$l$P\e(B english \e$B$r%W%m%s%W%H$H$7$F\e(B y-or-n-p \e$B$r<B9T$9$k!#\e(B
 141   (list 'y-or-n-p (list 'if 'skk-japanese-message-and-error
 142                                 japanese english )))
 143
 144 (defmacro skk-set-marker (marker position &optional buffer)
 145   ;; \e$B%P%C%U%!%m!<%+%kCM$G$"$k\e(B skk-henkan-start-point, skk-henkan-end-point,
 146   ;; skk-kana-start-point, \e$B$"$k$$$O\e(B skk-okurigana-start-point \e$B$,\e(B nil \e$B$@$C$?$i!"\e(B
 147   ;; \e$B?75,%^!<%+!<$r:n$C$FBeF~$9$k!#\e(B
 148   (list 'progn
 149         (list 'if (list 'not marker)
 150               (list 'setq marker (list 'make-marker)) )
 151         (list 'set-marker marker position buffer) ))
 152
 153 ;; From viper-util.el.  Welcome!
 154 (defmacro skk-deflocalvar (var default-value &optional documentation)
 155   (` (progn
 156        (defvar (, var) (, default-value)
 157                (, (format "%s\n\(buffer local\)" documentation)))
 158        (make-variable-buffer-local '(, var))
 159      )))
 160
 161 (defmacro skk-with-point-move (&rest form)
 162   ;; \e$B%]%$%s%H$r0\F0$9$k$,%U%C%/$r<B9T$7$F$[$7$/$J$$>l9g$K;H$&!#\e(B
 163   (` (unwind-protect
 164          (progn (,@ form))
 165        (setq skk-previous-point (point)) )))
 166
 167 (defmacro skk-face-on (object start end face &optional priority)
 168   (static-cond
 169    ((eq skk-emacs-type 'xemacs)
 170     (` (let ((inhibit-quit t))
 171          (if (not (extentp (, object)))
 172              (progn
 173                (setq (, object) (make-extent (, start) (, end)))
 174                (if (not (, priority))
 175                    (set-extent-face (, object) (, face))
 176                  (set-extent-properties
 177                   (, object) (list 'face (, face) 'priority (, priority)) )))
 178            (set-extent-endpoints (, object) (, start) (, end))  ))))
 179    (t
 180     (` (let ((inhibit-quit t))
 181          (if (not (overlayp (, object)))
 182              (progn
 183                (setq (, object) (make-overlay (, start) (, end)))
 184                (and (, priority) (overlay-put (, object) 'priority (, priority)))
 185                (overlay-put (, object) 'face (, face)) )
 186            (move-overlay (, object) (, start) (, end)) ))))))
 187
 188 (put 'skk-deflocalvar 'lisp-indent-function 'defun)
 189
 190 ;;;; inline functions
 191 (defsubst skk-file-exists-and-writable-p (file)
 192   (and (setq file (expand-file-name file))
 193        (file-exists-p file) (file-writable-p file) ))
 194
 195 (defsubst skk-lower-case-p (char)
 196   ;; CHAR \e$B$,>.J8;z$N%"%k%U%!%Y%C%H$G$"$l$P!"\e(Bt \e$B$rJV$9!#\e(B
 197   (and (<= ?a char) (>= ?z char) ))
 198
 199 (defsubst skk-downcase (char)
 200   (or (cdr (assq char skk-downcase-alist)) (downcase char)) )
 201
 202 (defsubst skk-mode-off ()
 203   (setq skk-mode nil
 204         skk-abbrev-mode nil
 205         skk-latin-mode nil
 206         skk-j-mode nil
 207         skk-jisx0208-latin-mode nil
 208         ;; j's sub mode.
 209         skk-katakana nil )
 210   ;; initialize
 211   (setq skk-input-mode-string skk-hiragana-mode-string)
 212   (force-mode-line-update)
 213   (remove-hook 'pre-command-hook 'skk-pre-command 'local) )
 214
 215 (defsubst skk-j-mode-on (&optional katakana)
 216   (setq skk-mode t
 217         skk-abbrev-mode nil
 218         skk-latin-mode nil
 219         skk-j-mode t
 220         skk-jisx0208-latin-mode nil
 221         ;; j's sub mode.
 222         skk-katakana katakana )
 223   ;; mode line
 224   (setq skk-input-mode-string (if katakana skk-katakana-mode-string
 225                                 skk-hiragana-mode-string ))
 226   (force-mode-line-update) )
 227
 228 (defsubst skk-latin-mode-on ()
 229   (setq skk-mode t
 230         skk-abbrev-mode nil
 231         skk-latin-mode t
 232         skk-j-mode nil
 233         skk-jisx0208-latin-mode nil
 234         ;; j's sub mode.
 235         skk-katakana nil
 236         skk-input-mode-string skk-latin-mode-string )
 237   (force-mode-line-update) )
 238
 239 (defsubst skk-jisx0208-latin-mode-on ()
 240   (setq skk-mode t
 241         skk-abbrev-mode nil
 242         skk-latin-mode nil
 243         skk-j-mode nil
 244         skk-jisx0208-latin-mode t
 245         ;; j's sub mode.
 246         skk-katakana nil
 247         skk-input-mode-string skk-jisx0208-latin-mode-string )
 248   (force-mode-line-update) )
 249
 250 (defsubst skk-abbrev-mode-on ()
 251   (setq skk-mode t
 252         skk-abbrev-mode t
 253         skk-latin-mode nil
 254         skk-j-mode nil
 255         skk-jisx0208-latin-mode nil
 256         ;; j's sub mode.
 257         skk-katakana nil
 258         skk-input-mode-string skk-abbrev-mode-string )
 259   (force-mode-line-update) )
 260
 261 (defsubst skk-in-minibuffer-p ()
 262   ;; \e$B%+%l%s%H%P%C%U%!$,%_%K%P%C%U%!$+$I$&$+$r%A%'%C%/$9$k!#\e(B
 263   (window-minibuffer-p (selected-window)) )
 264
 265 (defsubst skk-insert-prefix (&optional char)
 266   ;; skk-echo \e$B$,\e(B non-nil \e$B$G$"$l$P%+%l%s%H%P%C%U%!$K\e(B skk-prefix \e$B$rA^F~$9$k!#\e(B
 267   (and skk-echo
 268        ;; skk-prefix \e$B$NA^F~$r%"%s%I%%$NBP>]$H$7$J$$!#A^F~$7$?%W%l%U%#%C%/%9$O!"\e(B
 269        ;; \e$B$+$JJ8;z$rA^F~$9$kA0$KA4$F>C5n$9$k$N$G!"$=$N4V!"\e(Bbuffer-undo-list \e$B$r\e(B
 270        ;; t \e$B$K$7$F%"%s%I%%>pJs$rC_$($J$/$H$bLdBj$,$J$$!#\e(B
 271        (let ((buffer-undo-list t))
 272          (insert-and-inherit (or char skk-prefix)) )))
 273
 274 (defsubst skk-erase-prefix (&optional clean)
 275   ;; skk-echo \e$B$,\e(B non-nil \e$B$G$"$l$P%+%l%s%H%P%C%U%!$KA^F~$5$l$?\e(B skk-prefix \e$B$r>C\e(B
 276   ;; \e$B$9!#%*%W%7%g%J%k0z?t$N\e(B CLEAN \e$B$,;XDj$5$l$k$H!"JQ?t$H$7$F$N\e(B skk-prefix \e$B$r\e(B
 277   ;; null \e$BJ8;z$K!"\e(Bskk-current-rule-tree \e$B$r\e(B nil \e$B=i4|2=$9$k!#\e(B
 278   ;;
 279   ;; \e$B$+$JJ8;z$NF~NO$,$^$@40@.$7$F$$$J$$>l9g$K$3$N4X?t$,8F$P$l$?$H$-$J$I$O!"%P%C\e(B
 280   ;; \e$B%U%!$KA^F~$5$l$F$$$k\e(B skk-prefix \e$B$O:o=|$7$?$$$,!"JQ?t$H$7$F$N\e(B skk-prefix \e$B$O\e(B
 281   ;; null \e$BJ8;z$K$7$?$/$J$$!#\e(B
 282   (and skk-echo skk-kana-start-point
 283        (not (string= skk-prefix ""))    ; fail safe.
 284        ;; skk-prefix \e$B$N>C5n$r%"%s%I%%$NBP>]$H$7$J$$!#\e(B
 285        (let ((buffer-undo-list t)
 286              (start (marker-position skk-kana-start-point)) )
 287          (and start
 288               (condition-case nil
 289                   (delete-region start (+ start (length skk-prefix)))
 290                 (error
 291                  (skk-set-marker skk-kana-start-point nil)
 292                  (setq skk-prefix ""
 293                        skk-current-rule-tree nil ))))))
 294   (and clean (setq skk-prefix ""
 295                    skk-current-rule-tree nil ))) ; fail safe
 296
 297 (defsubst skk-string<= (str1 str2)
 298   ;; STR1 \e$B$H\e(B STR2 \e$B$H$rHf3S$7$F!"\e(Bstring< \e$B$+\e(B string= \e$B$G$"$l$P!"\e(Bt \e$B$rJV$9!#\e(B
 299   (or (string< str1 str2) (string= str1 str2)) )
 300
 301 (defsubst skk-do-auto-fill ()
 302   ;; auto-fill-function \e$B$KCM$,BeF~$5$l$F$*$l$P!"\e(Bdo-auto-fill \e$B$r%3!<%k$9$k!#\e(B
 303   (and auto-fill-function (funcall auto-fill-function)) )
 304
 305 ;;;; from dabbrev.el.  Welcome!
 306 ;; \e$BH=Dj4V0c$$$rHH$9>l9g$"$j!#MW2~NI!#\e(B
 307 (defsubst skk-minibuffer-origin ()
 308   (nth 1 (buffer-list)) )
 309
 310 (defsubst skk-current-insert-mode ()
 311   (cond (skk-abbrev-mode 'abbrev)
 312         (skk-latin-mode 'latin)
 313         (skk-jisx0208-latin-mode 'jisx0208-latin)
 314         (skk-katakana 'katakana)
 315         (skk-j-mode 'hiragana) ))
 316
 317 (defsubst skk-numeric-p ()
 318   (and skk-use-numeric-conversion (require 'skk-num) skk-num-list) )
 319
 320 (defsubst skk-substring-head-character (string)
 321   (char-to-string (string-to-char string)) )
 322
 323 (defsubst skk-get-current-candidate-simply (&optional noconv)
 324   (if (> 0 skk-henkan-count)
 325       (skk-error "\e$B8uJd$r<h$j=P$9$3$H$,$G$-$^$;$s\e(B"
 326                  "Cannot get current candidate" )
 327     ;; (nth -1 '(A B C)) \e$B$O!"\e(BA \e$B$rJV$9$N$G!"Ii$G$J$$$+$I$&$+%A%'%C%/$9$k!#\e(B
 328     (let ((word (nth skk-henkan-count skk-henkan-list)))
 329       (and word
 330            (if (and (skk-numeric-p) (consp word))
 331                (if noconv (car word) (cdr word))
 332              word )))))
 333
 334 ;; convert skk-rom-kana-rule-list to skk-rule-tree.
 335 ;; The rule tree follows the following syntax:
 336 ;; <branch-list>    ::= nil | (<tree> . <branch-list>)
 337 ;; <tree>         ::= (<char> <prefix> <nextstate> <kana> <branch-list>)
 338 ;; <kana>         ::= (<\e$B$R$i$,$JJ8;zNs\e(B> . <\e$B%+%?%+%JJ8;zNs\e(B>) | nil
 339 ;; <char>         ::= <\e$B1Q>.J8;z\e(B>
 340 ;; <nextstate>    ::= <\e$B1Q>.J8;zJ8;zNs\e(B> | nil
 341
 342 ;; \e$B%D%j!<$K%"%/%;%9$9$k$?$a$N%$%s%?!<%U%'!<%9\e(B
 343
 344 (defsubst skk-make-rule-tree (char prefix nextstate kana branch-list)
 345   (list char
 346         prefix
 347         (if (string= nextstate "") nil nextstate)
 348         kana
 349         branch-list ))
 350
 351 (defsubst skk-get-char (tree)
 352   (car tree) )
 353
 354 (defsubst skk-set-char (tree char)
 355   (setcar tree char) )
 356
 357 (defsubst skk-set-prefix (tree prefix)
 358   (setcar (nthcdr 1 tree) prefix) )
 359
 360 (defsubst skk-get-prefix (tree)
 361   (nth 1 tree) )
 362
 363 (defsubst skk-get-nextstate (tree)
 364   (nth 2 tree) )
 365
 366 (defsubst skk-set-nextstate (tree nextstate)
 367   (if (string= nextstate "") (setq nextstate nil))
 368   (setcar (nthcdr 2 tree) nextstate) )
 369
 370 (defsubst skk-get-kana (tree)
 371   (nth 3 tree) )
 372
 373 (defsubst skk-set-kana (tree kana)
 374   (setcar (nthcdr 3 tree) kana) )
 375
 376 (defsubst skk-get-branch-list (tree)
 377   (nth 4 tree) )
 378
 379 (defsubst skk-set-branch-list (tree branch-list)
 380   (setcar (nthcdr 4 tree) branch-list) )
 381
 382 ;; tree procedure for skk-kana-input.
 383 (defsubst skk-add-branch (tree branch)
 384   (skk-set-branch-list tree (cons branch (skk-get-branch-list tree))) )
 385
 386 (defsubst skk-select-branch (tree char)
 387   (assq char (skk-get-branch-list tree)) )
 388
 389 (defsubst skk-kana-cleanup (&optional force)
 390   (let ((data (or
 391                (and skk-current-rule-tree
 392                     (null (skk-get-nextstate skk-current-rule-tree))
 393                     (skk-get-kana skk-current-rule-tree) )
 394                (and skk-kana-input-search-function
 395                     (car (funcall skk-kana-input-search-function)) )))
 396         kana )
 397         (if (or force data)
 398             (progn
 399               (skk-erase-prefix 'clean)
 400               (setq kana (if (functionp data) (funcall data nil) data))
 401               (if (consp kana)
 402                   (setq kana (if skk-katakana (car kana) (cdr kana))) )
 403               (if (stringp kana) (skk-insert-str kana))
 404               (skk-set-marker skk-kana-start-point nil)
 405               t ))))
 406
 407 (defsubst skk-pre-command ()
 408   (and (memq last-command '(skk-insert skk-previous-candidate))
 409        (null (memq this-command skk-kana-cleanup-command-list))
 410        (skk-kana-cleanup t) ))
 411
 412 (defsubst skk-make-raw-arg (arg)
 413   (cond ((= arg 1) nil)
 414         ((= arg -1) '-)
 415         ((numberp arg) (list arg)) ))
 416
 417 (defsubst skk-unread-event (event)
 418   ;; Unread single EVENT.
 419   (setq unread-command-events (nconc unread-command-events (list event))) )
 420
 421 (defsubst skk-after-point-move ()
 422   (and (or (not skk-previous-point) (not (= skk-previous-point (point))))
 423        (skk-get-prefix skk-current-rule-tree)
 424        (skk-with-point-move (skk-erase-prefix 'clean)) ))
 425
 426 (defsubst skk-get-last-henkan-data (key)
 427   (cdr (assq key skk-last-henkan-data)) )
 428
 429 (defsubst skk-put-last-henkan-data (key val)
 430   (setq skk-last-henkan-data (put-alist key val skk-last-henkan-data)) )
 431
 432 (defun skk-terminal-face-p ()
 433   (and (not window-system)
 434        ;;; XEmacs does not have this function...
 435        (fboundp 'frame-face-alist) ; \e$BJQ?tL>$_$?$$$J4X?t$@$J\e(B...\e$B!#\e(B
 436        (fboundp 'selected-frame) ))
 437
 438 ;;;; aliases
 439 ;; for backward compatibility.
 440 (define-obsolete-function-alias 'skk-zenkaku-mode 'skk-jisx0208-latin-mode)
 441 (define-obsolete-function-alias 'skk-zenkaku-mode-on 'skk-jisx0208-latin-mode-on)
 442 (define-obsolete-function-alias 'skk-zenkaku-insert 'skk-jisx0208-latin-insert)
 443 (define-obsolete-function-alias 'skk-zenkaku-region 'skk-jisx0208-latin-region)
 444 (define-obsolete-function-alias 'skk-zenkaku-henkan 'skk-jisx0208-latin-henkan)
 445 (define-obsolete-function-alias 'skk-ascii-mode-on 'skk-latin-mode-on)
 446 (define-obsolete-function-alias 'skk-ascii-mode 'skk-latin-mode)
 447 (define-obsolete-function-alias 'skk-ascii-region 'skk-latin-region)
 448 (define-obsolete-function-alias 'skk-ascii-henkan 'skk-latin-henkan)
 449 (define-obsolete-function-alias 'skk-convert-ad-to-gengo 'skk-ad-to-gengo)
 450 (define-obsolete-function-alias 'skk-convert-gengo-to-ad 'skk-gengo-to-ad)
 451 (define-obsolete-function-alias 'skk-isearch-forward 'isearch-forward)
 452 (define-obsolete-function-alias 'skk-isearch-forward-regexp 'isearch-forward-regexp)
 453 (define-obsolete-function-alias 'skk-isearch-backward 'isearch-backward)
 454 (define-obsolete-function-alias 'skk-isearch-backward-regexp 'isearch-backward-regexp)
 455
 456 (defconst skk-background-mode
 457   ;; from font-lock-make-faces of font-lock.el  Welcome!
 458   (cond
 459    ((eq skk-emacs-type 'xemacs)
 460     (if (< (apply '+ (color-rgb-components
 461                       (face-property 'default 'background) ))
 462            (/ (apply '+ (color-rgb-components
 463                          (make-color-specifier "white"))) 3))
 464         'dark
 465       'light ))
 466    ((and window-system (x-display-color-p))
 467     (let ((bg-resource (x-get-resource ".backgroundMode"
 468                                        "BackgroundMode"))
 469           params )
 470       (if bg-resource
 471           (intern (downcase bg-resource))
 472         (setq params (frame-parameters))
 473         (cond ((cdr (assq 'background-mode params)));; Emacs20.x (Meadow)
 474               ((and (eq system-type 'windows-nt);; Mule for Win32
 475                     (fboundp 'win32-color-values) )
 476                (< (apply '+ (win32-color-values
 477                              (cdr (assq 'background-color params)) ))
 478                   (/ (apply '+ (win32-color-values "white")) 3) )
 479                'dark )
 480               ((and (memq system-type '(ms-dos windows-nt))
 481                     (fboundp 'x-color-values) )
 482                (if (string-match "light"
 483                                  (cdr (assq 'background-color params)) )
 484                    'light
 485                  'dark ))
 486               ((< (apply '+ (x-color-values
 487                              (cdr (assq 'background-color params)) ))
 488                   (/ (apply '+ (x-color-values "white")) 3) )
 489                'dark )
 490               (t 'light) ))))
 491    (t 'mono) ))
 492
 493 ;;;; version specific matter.
 494 ;;; inline functions.
 495 (defsubst skk-str-length (str)
 496   (static-cond
 497    ((memq skk-emacs-type '(xemacs mule4))
 498     (length str) )
 499    ((eq skk-emacs-type 'mule3)
 500     (length (string-to-vector str)) )
 501    ((eq skk-emacs-type 'mule2)
 502     (length (string-to-list str)) )))
 503
 504 (defsubst skk-substring (str pos1 pos2)
 505   (static-cond
 506    ((memq skk-emacs-type '(xemacs mule4))
 507     (substring str pos1 pos2) )
 508    ((eq skk-emacs-type 'mule3)
 509     (if (< pos1 0)
 510         (setq pos1 (+ (skk-str-length str) pos1)) )
 511     (if (< pos2 0)
 512         (setq pos2 (+ (skk-str-length str) pos2)) )
 513     (if (>= pos1 pos2)
 514         ""
 515       (let ((sl (nthcdr pos1 (string-to-list str))))
 516         (setcdr (nthcdr (- pos2 pos1 1) sl) nil)
 517         (concat sl) )))
 518    ((eq skk-emacs-type 'mule2)
 519     (if (< pos1 0)
 520         (setq pos1 (+ (skk-str-length str) pos1)) )
 521     (if (< pos2 0)
 522         (setq pos2 (+ (skk-str-length str) pos2)) )
 523     (if (>= pos1 pos2)
 524         ""
 525       (let ((sl (nthcdr pos1 (string-to-list str))))
 526         (setcdr (nthcdr (- pos2 pos1 1) sl) nil)
 527         (mapconcat 'char-to-string sl "") )))))
 528
 529 ;; no argument use only in SKK.
 530 (defsubst skk-read-event ()
 531   (static-cond
 532    ((eq skk-emacs-type 'xemacs)
 533     (next-command-event) )
 534    (t (read-event)) ))
 535
 536 (defsubst skk-char-to-string (char)
 537   (static-cond
 538    ((eq skk-emacs-type 'xemacs)
 539     (char-to-string char) )
 540    ((string< "20" emacs-version)
 541     (condition-case nil (char-to-string char) (error)) )
 542    (t (char-to-string char)) ))
 543
 544 (defsubst skk-ascii-char-p (char)
 545   ;; CHAR \e$B$,\e(B ascii \e$BJ8;z$@$C$?$i\e(B t \e$B$rJV$9!#\e(B
 546   (static-cond
 547    ((memq skk-emacs-type '(xemacs mule4 mule3))
 548     (eq (char-charset char) 'ascii) )
 549    ((eq skk-emacs-type 'mule2)
 550     (= (char-leading-char char) 0) )))
 551
 552 (defsubst skk-str-ref (str pos)
 553   (static-cond
 554    ((memq skk-emacs-type '(xemacs mule4))
 555     (aref str pos) )
 556    ((eq skk-emacs-type 'mule3)
 557     (aref (string-to-vector str) pos ) )
 558    ((eq skk-emacs-type 'mule2)
 559     (nth pos (string-to-list str)) )))
 560
 561 (defsubst skk-jisx0208-p (char)
 562   (static-cond
 563    ((memq skk-emacs-type '(xemacs mule4 mule3))
 564     (eq (char-charset char) 'japanese-jisx0208) )
 565    ((eq skk-emacs-type 'mule2)
 566     (= (char-leading-char char) lc-jp) )))
 567
 568 (defsubst skk-char-octet (ch &optional n)
 569   (static-cond
 570    ((eq skk-emacs-type 'xemacs)
 571     (or (nth (if n (1+ n) 1) (split-char ch)) 0) )
 572    (t (char-octet ch n)) ))
 573
 574 ;;; normal functions.
 575 ;; tiny function, but called once in skk-kcode.el.  So not make it inline.
 576 ;; or should I think to move to skk-kcode.el?
 577 (defun skk-make-char (charset n1 n2)
 578   (static-cond
 579    ((eq skk-emacs-type 'xemacs)
 580     (make-char charset (logand (lognot 128) n1) (logand (lognot 128) n2)) )
 581    ((memq skk-emacs-type '(mule4 mule3))
 582     (make-char charset n1 n2) )
 583    ((eq skk-emacs-type 'mule2)
 584     (make-character charset n1 n2) )))
 585
 586 ;; this one is called once in skk-kcode.el, too.
 587 (defsubst skk-charsetp (object)
 588   (static-cond
 589    ((and (eq skk-emacs-type 'xemacs) (fboundp 'charsetp))
 590     (charsetp object) )
 591    ((eq skk-emacs-type 'xemacs)
 592     ;; Is there XEmacs that doesn't have `charsetp'?
 593     (find-charset object) )
 594    ((memq skk-emacs-type '(mule4 mule3))
 595     (charsetp object) )
 596    ((eq skk-emacs-type 'mule2)
 597     (character-set object) )))
 598
 599 (defun skk-jisx0208-to-ascii (string)
 600   (static-cond
 601    ((memq skk-emacs-type '(xemacs mule4 mule3))
 602     (require 'japan-util)
 603     (let ((char
 604            (get-char-code-property (string-to-char string) 'ascii) ))
 605       (and char (char-to-string char)) ))
 606    ((eq skk-emacs-type 'mule2)
 607     (let ((char
 608            (let* ((ch (string-to-char string))
 609                   (ch1 (char-component ch 1)) )
 610              (cond ((eq 161 ch1)        ; ?\241
 611                     (cdr (assq (char-component ch 2) skk-hankaku-alist)) )
 612                    ((eq 163 ch1)        ; ?\243
 613                     (- (char-component ch 2) 128) ; ?\200
 614                     )))))
 615       (and char (char-to-string char)) ))))
 616
 617 (defun skk-define-menu-bar-map (map)
 618   ;; SKK \e$B%a%K%e!<$N%H%C%W$K=P8=$9$k%3%^%s%I$N%a%K%e!<$X$NDj5A$r9T$J$&!#\e(B
 619   (easy-menu-define
 620    skk-menu map
 621    "Menu used in SKK mode."
 622    '("SKK"
 623      ("Convert Region and Echo"
 624       ("Gyakubiki"
 625        ["to Hiragana" skk-gyakubiki-message
 626         (or (not (boundp 'skktut-problem-count)) (eq skktut-problem-count 0)) ]
 627        ["to Hiragana, All Candidates"
 628         ;; \e$B$"$l$l!"\e(Blambda \e$B4X?t$ODj5A$G$-$J$$$N$+!)!)!)\e(B  \e$BF0$+$J$$$>\e(B...\e$B!#\e(B
 629         (function (lambda (start end) (interactive "r")
 630                     (skk-gyakubiki-message start end 'all-candidates) ))
 631         (or (not (boundp 'skktut-problem-count)) (eq skktut-problem-count 0)) ]
 632        ["to Katakana" skk-gyakubiki-katakana-message
 633         (or (not (boundp 'skktut-problem-count)) (eq skktut-problem-count 0)) ]
 634        ["to Katakana, All Candidates"
 635         (function (lambda (start end) (interactive "r")
 636                     (skk-gyakubiki-katakana-message
 637                      start end 'all-candidates ) ))
 638         (or (not (boundp 'skktut-problem-count)) (eq skktut-problem-count 0)) ]
 639        )
 640       ("Hurigana"
 641        ["to Hiragana" skk-hurigana-message
 642         (or (not (boundp 'skktut-problem-count)) (eq skktut-problem-count 0)) ]
 643        ["to Hiragana, All Candidates"
 644         (function (lambda (start end) (interactive "r")
 645                     (skk-hurigana-message start end 'all-candidates) ))
 646         (or (not (boundp 'skktut-problem-count)) (eq skktut-problem-count 0)) ]
 647        ["to Katakana" skk-hurigana-katakana-message
 648         (or (not (boundp 'skktut-problem-count)) (eq skktut-problem-count 0)) ]
 649        ["to Katakana, All Candidates"
 650         (function (lambda (start end) (interactive "r")
 651                     (skk-hurigana-katakana-message
 652                      start end 'all-candidates) ))
 653         (or (not (boundp 'skktut-problem-count)) (eq skktut-problem-count 0)) ]
 654        )
 655       )
 656      ("Convert Region and Replace"
 657       ["Ascii" skk-ascii-region
 658        (or (not (boundp 'skktut-problem-count)) (eq skktut-problem-count 0)) ]
 659       ("Gyakubiki"
 660        ["to Hiragana" skk-gyakubiki-region
 661         (or (not (boundp 'skktut-problem-count)) (eq skktut-problem-count 0)) ]
 662        ["to Hiragana, All Candidates"
 663         (function (lambda (start end) (interactive "r")
 664                     (skk-gyakubiki-region start end 'all-candidates) ))
 665         (or (not (boundp 'skktut-problem-count)) (eq skktut-problem-count 0)) ]
 666        ["to Katakana" skk-gyakubiki-katakana-region
 667         (or (not (boundp 'skktut-problem-count)) (eq skktut-problem-count 0)) ]
 668        ["to Katakana, All Candidates"
 669         (function (lambda (start end) (interactive "r")
 670                     (skk-gyakubiki-katakana-region
 671                      start end 'all-candidates ) ))
 672         (or (not (boundp 'skktut-problem-count)) (eq skktut-problem-count 0)) ]
 673        )
 674       ["Hiragana" skk-hiragana-region
 675        (or (not (boundp 'skktut-problem-count)) (eq skktut-problem-count 0)) ]
 676       ("Hurigana"
 677        ["to Hiragana" skk-hurigana-region
 678         (or (not (boundp 'skktut-problem-count)) (eq skktut-problem-count 0)) ]
 679        ["to Hiragana, All Candidates"
 680         (function (lambda (start end) (interactive "r")
 681                     (skk-hurigana-region start end 'all-candidates) ))
 682         (or (not (boundp 'skktut-problem-count)) (eq skktut-problem-count 0)) ]
 683        ["to Katakana" skk-hurigana-katakana-region
 684         (or (not (boundp 'skktut-problem-count)) (eq skktut-problem-count 0)) ]
 685        ["to Katakana, All Candidates" (function
 686                                        (lambda (start end) (interactive "r")
 687                                          (skk-hurigana-katakana-region
 688                                           start end 'all-candidates) ))
 689         (or (not (boundp 'skktut-problem-count)) (eq skktut-problem-count 0)) ]
 690        )
 691       ["Katakana" skk-katakana-region
 692        (or (not (boundp 'skktut-problem-count)) (eq skktut-problem-count 0)) ]
 693       ["Romaji" skk-romaji-region
 694        (or (not (boundp 'skktut-problem-count)) (eq skktut-problem-count 0)) ]
 695       ["Zenkaku" skk-jisx0208-latin-region
 696        (or (not (boundp 'skktut-problem-count)) (eq skktut-problem-count 0)) ]
 697       )
 698      ["Count Jisyo Candidates" skk-count-jisyo-candidates
 699       (or (not (boundp 'skktut-problem-count)) (eq skktut-problem-count 0)) ]
 700      ["Save Jisyo" skk-save-jisyo
 701       (or (not (boundp 'skktut-problem-count)) (eq skktut-problem-count 0)) ]
 702      ["Undo Kakutei" skk-undo-kakutei
 703       (or (not (boundp 'skktut-problem-count)) (eq skktut-problem-count 0)) ]
 704      ["Version" skk-version
 705       (or (not (boundp 'skktut-problem-count))
 706           (eq skktut-problem-count 0)) ]
 707      )))
 708
 709 (provide 'skk-foreword)
 710 ;;; Local Variables:
 711 ;;; End:
 712 ;;; skk-forwords.el ends here