1;;; skk-foreword.el --- ���� 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.1 2002/11/27 13:17:35 tatari Exp $ 9;; Keywords: japanese 10;; Last Modified: $Date: 2002/11/27 13:17:35 $ 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;; ���Υե�����ϡ��桼�����ѿ���������Τ˻��Ѥ���ޥ���skk-*.el �� 32;; ���Ѥ���ޥ���ʤɡ��ѿ������������skk-*.el �κǽ��������Ƥ����� 33;; ����Фʤ�ʤ���Τ�ޤȤ��ΤǤ����桼�����ѿ�����������ˡ��� 34;; ���㤴����ȥ桼�����˶�̣���ʤ���Τ��¤�Ǥ����ΤǤϡ��桼������ 35;; ���ɥ�ǤϤʤ��ȹͤ��뤫��Ǥ��� 36;; 37;;; Code: 38(require 'advice) 39 40;; necessary macro and functions to be declared before user variable declarations. 41 42;;;; macros 43;; Why I use non-intern temporary variable in the macro --- see comment in 44;; save-match-data of subr.el of GNU Emacs. And should we use the same manner 45;; in the save-current-buffer, with-temp-buffer and with-temp-file macro 46;; definition? 47(defmacro skk-save-point (&rest body) 48 (` (let ((skk-save-point (point-marker))) 49 (unwind-protect 50 (progn (,@ body)) 51 (goto-char skk-save-point) 52 (skk-set-marker skk-save-point nil) )))) 53 54(defmacro skk-message (japanese english &rest arg) 55 ;; skk-japanese-message-and-error �� non-nil ���ä��� JAPANESE �� nil �Ǥ��� 56 ;; �� ENGLISH �������ꥢ��ɽ�����롣 57 ;; ARG �� message �ؿ����裲�����ʹߤΰ����Ȥ����Ϥ���롣 58 (append (list 'message (list 'if 'skk-japanese-message-and-error 59 japanese english )) 60 arg )) 61 62(defmacro skk-error (japanese english &rest arg) 63 ;; skk-japanese-message-and-error �� non-nil ���ä��� JAPANESE �� nil �Ǥ��� 64 ;; �� ENGLISH �������ꥢ��ɽ���������顼��ȯ�������롣 65 ;; ARG �� error �ؿ����裲�����ʹߤΰ����Ȥ����Ϥ���롣 66 (append (list 'error (list 'if 'skk-japanese-message-and-error 67 japanese english )) 68 arg )) 69 70(defmacro skk-yes-or-no-p (japanese english) 71 ;; skk-japanese-message-and-error �� non-nil �Ǥ���С�japanese �� nil �Ǥ� 72 ;; ��� english ��ץ��ץȤȤ��� yes-or-no-p ��¹Ԥ��롣 73 ;; yes-or-no-p �ΰ����Υץ��ץȤ�ʣ�����������Ǥ�����Ϥ��Υޥ����� 74 ;; ����ꥪ�ꥸ�ʥ�� yes-or-no-p ����Ѥ������������ɤ�ʣ���ˤʤ�ʤ���礬 75 ;; ���롣 76 (list 'yes-or-no-p (list 'if 'skk-japanese-message-and-error 77 japanese english ))) 78 79(defmacro skk-y-or-n-p (japanese english) 80 ;; skk-japanese-message-and-error �� non-nil �Ǥ���С�japanese �� nil �Ǥ� 81 ;; ��� english ��ץ��ץȤȤ��� y-or-n-p ��¹Ԥ��롣 82 (list 'y-or-n-p (list 'if 'skk-japanese-message-and-error 83 japanese english ))) 84 85(defmacro skk-set-marker (marker position &optional buffer) 86 ;; �Хåե��������ͤǤ��� skk-henkan-start-point, skk-henkan-end-point, 87 ;; skk-kana-start-point, ���뤤�� skk-okurigana-start-point �� nil ���ä��顢 88 ;; �����ޡ��������ä��������롣 89 (list 'progn 90 (list 'if (list 'not marker) 91 (list 'setq marker (list 'make-marker)) ) 92 (list 'set-marker marker position buffer) )) 93 94;; From viper-util.el. Welcome! 95(defmacro skk-deflocalvar (var default-value &optional documentation) 96 (` (progn 97 (defvar (, var) (, default-value) 98 (, (format "%s\n\(buffer local\)" documentation))) 99 (make-variable-buffer-local '(, var)) 100 ))) 101 102(defmacro skk-with-point-move (&rest form) 103 ;; �ݥ���Ȥ��ư���뤬�եå���¹Ԥ��Ƥۤ����ʤ����˻Ȥ��� 104 (` (unwind-protect 105 (progn (,@ form)) 106 (setq skk-previous-point (point)) ))) 107 108(defmacro skk-face-on (object start end face &optional priority) 109 (static-cond 110 ((eq skk-emacs-type 'xemacs) 111 (` (let ((inhibit-quit t)) 112 (if (not (extentp (, object))) 113 (progn 114 (setq (, object) (make-extent (, start) (, end))) 115 (if (not (, priority)) 116 (set-extent-face (, object) (, face)) 117 (set-extent-properties 118 (, object) (list 'face (, face) 'priority (, priority)) ))) 119 (set-extent-endpoints (, object) (, start) (, end)) )))) 120 (t 121 (` (let ((inhibit-quit t)) 122 (if (not (overlayp (, object))) 123 (progn 124 (setq (, object) (make-overlay (, start) (, end))) 125 (and (, priority) (overlay-put (, object) 'priority (, priority))) 126 (overlay-put (, object) 'face (, face)) ) 127 (move-overlay (, object) (, start) (, end)) )))))) 128 129(put 'skk-deflocalvar 'lisp-indent-function 'defun) 130 131;;;; inline functions 132(defun skk-file-exists-and-writable-p (file) 133 (and (setq file (expand-file-name file)) 134 (file-exists-p file) (file-writable-p file) )) 135 136(defun skk-lower-case-p (char) 137 ;; CHAR ����ʸ���Υ���ե��٥åȤǤ���С�t ���֤��� 138 (and (<= ?a char) (>= ?z char) )) 139 140(defun skk-downcase (char) 141 (or (cdr (assq char skk-downcase-alist)) (downcase char)) ) 142 143(defun skk-mode-off () 144 (setq skk-mode nil 145 skk-abbrev-mode nil 146 skk-latin-mode nil 147 skk-j-mode nil 148 skk-jisx0208-latin-mode nil 149 ;; j's sub mode. 150 skk-katakana nil ) 151 ;; initialize 152 (setq skk-input-mode-string skk-hiragana-mode-string) 153 (force-mode-line-update) 154 (remove-hook 'pre-command-hook 'skk-pre-command 'local) ) 155 156(defun skk-j-mode-on (&optional katakana) 157 (setq skk-mode t 158 skk-abbrev-mode nil 159 skk-latin-mode nil 160 skk-j-mode t 161 skk-jisx0208-latin-mode nil 162 ;; j's sub mode. 163 skk-katakana katakana ) 164 ;; mode line 165 (setq skk-input-mode-string (if katakana skk-katakana-mode-string 166 skk-hiragana-mode-string )) 167 (force-mode-line-update) ) 168 169(defun skk-latin-mode-on () 170 (setq skk-mode t 171 skk-abbrev-mode nil 172 skk-latin-mode t 173 skk-j-mode nil 174 skk-jisx0208-latin-mode nil 175 ;; j's sub mode. 176 skk-katakana nil 177 skk-input-mode-string skk-latin-mode-string ) 178 (force-mode-line-update) ) 179 180(defun skk-jisx0208-latin-mode-on () 181 (setq skk-mode t 182 skk-abbrev-mode nil 183 skk-latin-mode nil 184 skk-j-mode nil 185 skk-jisx0208-latin-mode t 186 ;; j's sub mode. 187 skk-katakana nil 188 skk-input-mode-string skk-jisx0208-latin-mode-string ) 189 (force-mode-line-update) ) 190 191(defun skk-abbrev-mode-on () 192 (setq skk-mode t 193 skk-abbrev-mode t 194 skk-latin-mode nil 195 skk-j-mode nil 196 skk-jisx0208-latin-mode nil 197 ;; j's sub mode. 198 skk-katakana nil 199 skk-input-mode-string skk-abbrev-mode-string ) 200 (force-mode-line-update) ) 201 202(defun skk-in-minibuffer-p () 203 ;; �����ȥХåե����ߥ˥Хåե����ɤ���������å����롣 204 (window-minibuffer-p (selected-window)) ) 205 206(defun skk-insert-prefix (&optional char) 207 ;; skk-echo �� non-nil �Ǥ���Х����ȥХåե��� skk-prefix ���������롣 208 (and skk-echo 209 ;; skk-prefix ��������ɥ����оݤȤ��ʤ������������ץ�ե��å����ϡ� 210 ;; ����ʸ�������������������ƾõ��Τǡ����δ֡�buffer-undo-list �� 211 ;; t �ˤ��ƥ���ɥ�������ߤ��ʤ��Ȥ����꤬�ʤ��� 212 (let ((buffer-undo-list t)) 213 (insert (or char skk-prefix)) ))) 214 215(defun skk-erase-prefix (&optional clean) 216 ;; skk-echo �� non-nil �Ǥ���Х����ȥХåե����������줿 skk-prefix ��� 217 ;; �������ץ���ʥ������ CLEAN �����ꤵ���ȡ��ѿ��Ȥ��Ƥ� skk-prefix �� 218 ;; null ʸ���ˡ�skk-current-rule-tree �� nil ��������롣 219 ;; 220 ;; ����ʸ�������Ϥ��ޤ��������Ƥ��ʤ����ˤ��δؿ����ƤФ줿�Ȥ��ʤɤϡ��Х� 221 ;; �ե�����������Ƥ��� skk-prefix �Ϻ�������������ѿ��Ȥ��Ƥ� skk-prefix �� 222 ;; null ʸ���ˤ������ʤ��� 223 (and skk-echo skk-kana-start-point 224 (not (string= skk-prefix "")) ; fail safe. 225 ;; skk-prefix �ξõ��ɥ����оݤȤ��ʤ��� 226 (let ((buffer-undo-list t) 227 (start (marker-position skk-kana-start-point)) ) 228 (and start 229 (condition-case nil 230 (delete-region start (+ start (length skk-prefix))) 231 (error 232 (skk-set-marker skk-kana-start-point nil) 233 (setq skk-prefix "" 234 skk-current-rule-tree nil )))))) 235 (and clean (setq skk-prefix "" 236 skk-current-rule-tree nil ))) ; fail safe 237 238(defun skk-string<= (str1 str2) 239 ;; STR1 �� STR2 �Ȥ���Ӥ��ơ�string< �� string= �Ǥ���С�t ���֤��� 240 (or (string< str1 str2) (string= str1 str2)) ) 241 242(defun skk-do-auto-fill () 243 ;; auto-fill-function ���ͤ���������Ƥ���С�do-auto-fill ���뤹�롣 244 (and auto-fill-function (funcall auto-fill-function)) ) 245 246;;;; from dabbrev.el. Welcome! 247;; Ƚ��ְ㤤���Ȥ���礢�ꡣ�ײ��ɡ� 248(defun skk-minibuffer-origin () 249 (nth 1 (buffer-list)) ) 250 251(defun skk-current-insert-mode () 252 (cond (skk-abbrev-mode 'abbrev) 253 (skk-latin-mode 'latin) 254 (skk-jisx0208-latin-mode 'jisx0208-latin) 255 (skk-katakana 'katakana) 256 (skk-j-mode 'hiragana) )) 257 258(defun skk-numeric-p () 259 (and skk-use-numeric-conversion (require 'skk-num) skk-num-list) ) 260 261(defun skk-substring-head-character (string) 262 (char-to-string (string-to-char string)) ) 263 264(defun skk-get-current-candidate-simply (&optional noconv) 265 (if (> 0 skk-henkan-count) 266 (skk-error "�������Ф����Ȥ��Ǥ��ޤ���" 267 "Cannot get current candidate" ) 268 ;; (nth -1 '(A B C)) �ϡ�A ���֤��Τǡ���Ǥʤ����ɤ��������å����롣 269 (let ((word (nth skk-henkan-count skk-henkan-list))) 270 (and word 271 (if (and (skk-numeric-p) (consp word)) 272 (if noconv (car word) (cdr word)) 273 word ))))) 274 275;; convert skk-rom-kana-rule-list to skk-rule-tree. 276;; The rule tree follows the following syntax: 277;; <branch-list> ::= nil | (<tree> . <branch-list>) 278;; <tree> ::= (<char> <prefix> <nextstate> <kana> <branch-list>) 279;; <kana> ::= (<�Ҥ餬��ʸ����> . <��������ʸ����>) | nil 280;; <char> ::= <�Ѿ�ʸ��> 281;; <nextstate> ::= <�Ѿ�ʸ��ʸ����> | nil 282 283;; �ĥ�˥����������뤿��Υ����ե����� 284 285(defun skk-make-rule-tree (char prefix nextstate kana branch-list) 286 (list char 287 prefix 288 (if (string= nextstate "") nil nextstate) 289 kana 290 branch-list )) 291 292(defun skk-get-char (tree) 293 (car tree) ) 294 295(defun skk-set-char (tree char) 296 (setcar tree char) ) 297 298(defun skk-set-prefix (tree prefix) 299 (setcar (nthcdr 1 tree) prefix) ) 300 301(defun skk-get-prefix (tree) 302 (nth 1 tree) ) 303 304(defun skk-get-nextstate (tree) 305 (nth 2 tree) ) 306 307(defun skk-set-nextstate (tree nextstate) 308 (if (string= nextstate "") (setq nextstate nil)) 309 (setcar (nthcdr 2 tree) nextstate) ) 310 311(defun skk-get-kana (tree) 312 (nth 3 tree) ) 313 314(defun skk-set-kana (tree kana) 315 (setcar (nthcdr 3 tree) kana) ) 316 317(defun skk-get-branch-list (tree) 318 (nth 4 tree) ) 319 320(defun skk-set-branch-list (tree branch-list) 321 (setcar (nthcdr 4 tree) branch-list) ) 322 323;; tree procedure for skk-kana-input. 324(defun skk-add-branch (tree branch) 325 (skk-set-branch-list tree (cons branch (skk-get-branch-list tree))) ) 326 327(defun skk-select-branch (tree char) 328 (assq char (skk-get-branch-list tree)) ) 329 330(defun skk-kana-cleanup (&optional force) 331 (let ((data (or 332 (and skk-current-rule-tree 333 (null (skk-get-nextstate skk-current-rule-tree)) 334 (skk-get-kana skk-current-rule-tree) ) 335 (and skk-kana-input-search-function 336 (car (funcall skk-kana-input-search-function)) ))) 337 kana ) 338 (if (or force data) 339 (progn 340 (skk-erase-prefix 'clean) 341 (setq kana (if (functionp data) (funcall data nil) data)) 342 (if (consp kana) 343 (setq kana (if skk-katakana (car kana) (cdr kana))) ) 344 (if (stringp kana) (skk-insert-str kana)) 345 (skk-set-marker skk-kana-start-point nil) 346 t )))) 347 348(defun skk-pre-command () 349 (and (memq last-command '(skk-insert skk-previous-candidate)) 350 (null (memq this-command skk-kana-cleanup-command-list)) 351 (skk-kana-cleanup t) )) 352 353(defun skk-make-raw-arg (arg) 354 (cond ((= arg 1) nil) 355 ((= arg -1) '-) 356 ((numberp arg) (list arg)) )) 357 358(defun skk-unread-event (event) 359 ;; Unread single EVENT. 360 (setq unread-command-events (nconc unread-command-events (list event))) ) 361 362(defun skk-after-point-move () 363 (and (or (not skk-previous-point) (not (= skk-previous-point (point)))) 364 (skk-get-prefix skk-current-rule-tree) 365 (skk-with-point-move (skk-erase-prefix 'clean)) )) 366 367(defun skk-get-last-henkan-data (key) 368 (cdr (assq key skk-last-henkan-data)) ) 369 370(defun skk-put-last-henkan-data (key val) 371 (setq skk-last-henkan-data (put-alist key val skk-last-henkan-data)) ) 372 373(defun skk-terminal-face-p () 374 (and (not window-system) 375 ;;; XEmacs does not have this funciton... 376 (fboundp 'frame-face-alist) ; �ѿ�̾�ߤ����ʴؿ�����...�� 377 (fboundp 'selected-frame) )) 378 379;;;; aliases 380;; for backward compatibility. 381;(define-obsolete-function-alias 'skk-zenkaku-mode 'skk-jisx0208-latin-mode) 382;(define-obsolete-function-alias 'skk-zenkaku-mode-on 'skk-jisx0208-latin-mode-on) 383;(define-obsolete-function-alias 'skk-zenkaku-insert 'skk-jisx0208-latin-insert) 384;(define-obsolete-function-alias 'skk-zenkaku-region 'skk-jisx0208-latin-region) 385;(define-obsolete-function-alias 'skk-zenkaku-henkan 'skk-jisx0208-latin-henkan) 386;(define-obsolete-function-alias 'skk-ascii-mode-on 'skk-latin-mode-on) 387;(define-obsolete-function-alias 'skk-ascii-mode 'skk-latin-mode) 388;(define-obsolete-function-alias 'skk-ascii-region 'skk-latin-region) 389;(define-obsolete-function-alias 'skk-ascii-henkan 'skk-latin-henkan) 390;(define-obsolete-function-alias 'skk-convert-ad-to-gengo 'skk-ad-to-gengo) 391;(define-obsolete-function-alias 'skk-convert-gengo-to-ad 'skk-gengo-to-ad) 392;(define-obsolete-function-alias 'skk-isearch-forward 'isearch-forward) 393;(define-obsolete-function-alias 'skk-isearch-forward-regexp 'isearch-forward-regexp) 394;(define-obsolete-function-alias 'skk-isearch-backward 'isearch-backward) 395;(define-obsolete-function-alias 'skk-isearch-backward-regexp 'isearch-backward-regexp) 396 397(defconst skk-background-mode 398 ;; from font-lock-make-faces of font-lock.el Welcome! 399 'mono) 400 401;;;; version specific matter. 402;;; inline functions. 403(defun skk-str-length (str) 404 (length str)) 405 406(defun skk-substring (str pos1 pos2) 407 (substring str pos1 pos2)) 408 409;; no argument use only in SKK. 410(defun skk-read-event () 411 (read-event)) 412 413(defun skk-char-to-string (char) 414 (char-to-string char)) 415 416(defun skk-ascii-char-p (char) 417 ;; CHAR �� ascii ʸ�����ä��� t ���֤��� 418 (eq (char-charset char) 'ascii)) 419 420(defun skk-str-ref (str pos) 421 (aref str pos)) 422 423(defun skk-jisx0208-p (char) 424 (eq (char-charset char) 'japanese-jisx0208)) 425 426(defun skk-char-octet (ch &optional n) 427 (char-octet ch n)) 428 429;;; normal functions. 430;; tiny function, but called once in skk-kcode.el. So not make it inline. 431;; or should I think to move to skk-kcode.el? 432(defun skk-make-char (charset n1 n2) 433 (make-char charset n1 n2)) 434 435;; this one is called once in skk-kcode.el, too. 436(defun skk-charsetp (object) 437 (charsetp object)) 438 439(defun skk-jisx0208-to-ascii (string) 440 (let ((char 441 (get-char-code-property (string-to-char string) 'ascii) )) 442 (and char (char-to-string char)) )) 443 444(provide 'skk-foreword) 445;;; Local Variables: 446;;; End: 447;;; skk-forwords.el ends here 448