Mercurial > hg > xemacs-beta

comparison lisp/egg/egg-wnn.el @ 98:0d2f883870bc r20-1b1

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b1
author cvs
date Mon, 13 Aug 2007 09:13:56 +0200
parents 131b0175ea99
children 8619ce7e4c50
comparison
equal deleted inserted replaced
97:498bf5da1c90 98:0d2f883870bc
33 ;;; Wnn V4 $B$N(B jl $B%i%$%V%i%j$r;H$$$^$9!#(B 33 ;;; Wnn V4 $B$N(B jl $B%i%$%V%i%j$r;H$$$^$9!#(B
34 ;;; $B%i%$%V%i%j$H$N%$%s%?!<%U%'!<%9$O(B wnnfns.c $B$GDj5A$5$l$F$$$^$9!#(B 34 ;;; $B%i%$%V%i%j$H$N%$%s%?!<%U%'!<%9$O(B wnnfns.c $B$GDj5A$5$l$F$$$^$9!#(B
35 35
36 ;;; $B=$@5%a%b(B 36 ;;; $B=$@5%a%b(B
37 37
38 ;;; 97/2/4 Modified for use with XEmacs by J.Hein <jhod@po.iijnet.or.jp>
39 ;;; (mostly changes regarding extents and markers)
38 ;;; 94/2/3 kWnn support by H.Kuribayashi 40 ;;; 94/2/3 kWnn support by H.Kuribayashi
39 ;;; 93/11/24 henkan-select-kouho: bug fixed 41 ;;; 93/11/24 henkan-select-kouho: bug fixed
40 ;;; 93/7/22 hinsi-from-menu updated 42 ;;; 93/7/22 hinsi-from-menu updated
41 ;;; 93/5/12 remove-regexp-in-string 43 ;;; 93/5/12 remove-regexp-in-string
42 ;;; fixed by Shuji NARAZAKI <narazaki@csce.kyushu-u.ac.jp> 44 ;;; fixed by Shuji NARAZAKI <narazaki@csce.kyushu-u.ac.jp>
90 (make-variable-buffer-local 'wnn-server-type) 92 (make-variable-buffer-local 'wnn-server-type)
91 (make-variable-buffer-local 'cwnn-zhuyin) 93 (make-variable-buffer-local 'cwnn-zhuyin)
92 94
93 (defvar egg:*sho-bunsetu-face* nil "*$B>.J8@aI=<($KMQ$$$k(B face $B$^$?$O(B nil") 95 (defvar egg:*sho-bunsetu-face* nil "*$B>.J8@aI=<($KMQ$$$k(B face $B$^$?$O(B nil")
94 (make-variable-buffer-local 96 (make-variable-buffer-local
95 (defvar egg:*sho-bunsetu-overlay* nil "$B>.J8@a$NI=<($K;H$&(B overlay")) 97 (defvar egg:*sho-bunsetu-extent* nil "$B>.J8@a$NI=<($K;H$&(B extent"))
96 98
97 (defvar egg:*sho-bunsetu-kugiri* "-" "*$B>.J8@a$N6h@Z$j$r<($9J8;zNs(B") 99 (defvar egg:*sho-bunsetu-kugiri* "-" "*$B>.J8@a$N6h@Z$j$r<($9J8;zNs(B")
98 100
99 (defvar egg:*dai-bunsetu-face* nil "*$BBgJ8@aI=<($KMQ$$$k(B face $B$^$?$O(B nil") 101 (defvar egg:*dai-bunsetu-face* nil "*$BBgJ8@aI=<($KMQ$$$k(B face $B$^$?$O(B nil")
100 (make-variable-buffer-local 102 (make-variable-buffer-local
101 (defvar egg:*dai-bunsetu-overlay* nil "$BBgJ8@a$NI=<($K;H$&(B overlay")) 103 (defvar egg:*dai-bunsetu-extent* nil "$BBgJ8@a$NI=<($K;H$&(B extent"))
102 104
103 (defvar egg:*dai-bunsetu-kugiri* " " "*$BBgJ8@a$N6h@Z$j$r<($9J8;zNs(B") 105 (defvar egg:*dai-bunsetu-kugiri* " " "*$BBgJ8@a$N6h@Z$j$r<($9J8;zNs(B")
104 106
105 (defvar egg:*henkan-face* nil "*$BJQ49NN0h$rI=<($9$k(B face $B$^$?$O(B nil") 107 (defvar egg:*henkan-face* nil "*$BJQ49NN0h$rI=<($9$k(B face $B$^$?$O(B nil")
106 (make-variable-buffer-local 108 (make-variable-buffer-local
107 (defvar egg:*henkan-overlay* nil "$BJQ49NN0h$NI=<($K;H$&(B overlay")) 109 (defvar egg:*henkan-extent* nil "$BJQ49NN0h$NI=<($K;H$&(B extent"))
108 110
109 (defvar egg:*henkan-open* "|" "*$BJQ49$N;OE@$r<($9J8;zNs(B") 111 (defvar egg:*henkan-open* "|" "*$BJQ49$N;OE@$r<($9J8;zNs(B")
110 (defvar egg:*henkan-close* "|" "*$BJQ49$N=*E@$r<($9J8;zNs(B") 112 (defvar egg:*henkan-close* "|" "*$BJQ49$N=*E@$r<($9J8;zNs(B")
111 113
112 (defvar egg:henkan-mode-in-use nil) 114 (defvar egg:henkan-mode-in-use nil)
451 (defun set-wnn-fuzokugo (ffile) 453 (defun set-wnn-fuzokugo (ffile)
452 ; (open-wnn-if-disconnected) 454 ; (open-wnn-if-disconnected)
453 (if (null (wnn-server-fuzokugo-set (substitute-in-file-name ffile))) 455 (if (null (wnn-server-fuzokugo-set (substitute-in-file-name ffile)))
454 (egg:error (wnn-server-get-msg)))) 456 (egg:error (wnn-server-get-msg))))
455 457
458 ;; ###jhod Currently very broken. Needs to be rewritten for the new
459 ;; wnn-server-set-param
456 (defun set-wnn-param (&rest param) 460 (defun set-wnn-param (&rest param)
457 (interactive) 461 (interactive)
458 ; (open-wnn-if-disconnected) 462 ; (open-wnn-if-disconnected)
459 (let ((current-param (wnn-server-get-param)) 463 (let ((current-param (wnn-server-get-param))
460 (new-param) 464 (new-param)
774 ;;;; 778 ;;;;
775 ;;;; User entry : henkan-region, henkan-paragraph, henkan-sentence 779 ;;;; User entry : henkan-region, henkan-paragraph, henkan-sentence
776 ;;;; 780 ;;;;
777 781
778 (defun egg:henkan-face-on () 782 (defun egg:henkan-face-on ()
779 ;; Make an overlay if henkan overlay does not exist. 783 ;; Make an extent if henkan extent does not exist.
780 ;; Move henkan overlay to henkan region. 784 ;; Move henkan extent to henkan region.
781 (if egg:*henkan-face* 785 (if egg:*henkan-face*
782 (progn 786 (progn
783 (if (overlayp egg:*henkan-overlay*) 787 (if (extentp egg:*henkan-extent*)
784 nil 788 nil
785 (setq egg:*henkan-overlay* (make-overlay 1 1 nil t)) 789 ;; ###jhod this was a 'point-type' overlay
786 (overlay-put egg:*henkan-overlay* 'face egg:*henkan-face*)) 790 (setq egg:*henkan-extent* (make-extent 1 1))
787 (move-overlay egg:*henkan-overlay* egg:*region-start* egg:*region-end*)))) 791 (set-extent-property egg:*henkan-extent* 'face egg:*henkan-face*))
792 (set-extent-endpoints egg:*henkan-extent* egg:*region-start* egg:*region-end*))))
788 793
789 (defun egg:henkan-face-off () 794 (defun egg:henkan-face-off ()
790 ;; detach henkan overlay from the current buffer. 795 ;; detach henkan extent from the current buffer.
791 (and egg:*henkan-face* 796 (and egg:*henkan-face*
792 (overlayp egg:*henkan-overlay*) 797 (extentp egg:*henkan-extent*)
793 (delete-overlay egg:*henkan-overlay*) )) 798 (delete-extent egg:*henkan-extent*) ))
794 799
795 800
796 (defun henkan-region (start end) 801 (defun henkan-region (start end)
797 "Convert a text in the region between START and END from kana to kanji." 802 "Convert a text in the region between START and END from kana to kanji."
798 (interactive "r") 803 (interactive "r")
835 (mode-line-egg-mode-update (egg:msg-get 'henkan-mode-indicator)) 840 (mode-line-egg-mode-update (egg:msg-get 'henkan-mode-indicator))
836 (goto-char start) 841 (goto-char start)
837 (or (markerp egg:*region-start*) 842 (or (markerp egg:*region-start*)
838 (setq egg:*region-start* (make-marker))) 843 (setq egg:*region-start* (make-marker)))
839 (or (markerp egg:*region-end*) 844 (or (markerp egg:*region-end*)
840 (setq egg:*region-end* (set-marker-type (make-marker) t))) 845 (setq egg:*region-end* (set-marker-insertion-type (make-marker) t)))
841 (if (null (marker-position egg:*region-start*)) 846 (if (null (marker-position egg:*region-start*))
842 (progn 847 (progn
843 ;;;(setq egg:*global-map-backup* (current-global-map)) 848 ;;;(setq egg:*global-map-backup* (current-global-map))
844 (setq egg:*local-map-backup* (current-local-map)) 849 (setq egg:*local-map-backup* (current-local-map))
845 (and (boundp 'disable-undo) (setq disable-undo t)) 850 (and (boundp 'disable-undo) (setq disable-undo t))
972 (egg:error "Wrong type of arguments(kugiri-sho): %s" kugiri-sho)) 977 (egg:error "Wrong type of arguments(kugiri-sho): %s" kugiri-sho))
973 978
974 (if (or (null henkan-face) (memq henkan-face (face-list))) 979 (if (or (null henkan-face) (memq henkan-face (face-list)))
975 (progn 980 (progn
976 (setq egg:*henkan-face* henkan-face) 981 (setq egg:*henkan-face* henkan-face)
977 (if (overlayp egg:*henkan-overlay*) 982 (if (extentp egg:*henkan-extent*)
978 (overlay-put egg:*henkan-overlay* 'face egg:*henkan-face*))) 983 (set-extent-property egg:*henkan-extent* 'face egg:*henkan-face*)))
979 (egg:error "Wrong type of arguments(henkan-face): %s" henkan-face)) 984 (egg:error "Wrong type of arguments(henkan-face): %s" henkan-face))
980 985
981 (if (or (null dai-bunsetu-face) (memq dai-bunsetu-face (face-list))) 986 (if (or (null dai-bunsetu-face) (memq dai-bunsetu-face (face-list)))
982 (progn 987 (progn
983 (setq egg:*dai-bunsetu-face* dai-bunsetu-face) 988 (setq egg:*dai-bunsetu-face* dai-bunsetu-face)
984 (if (overlayp egg:*dai-bunsetu-overlay*) 989 (if (extentp egg:*dai-bunsetu-extent*)
985 (overlay-put egg:*dai-bunsetu-overlay* 'face egg:*dai-bunsetu-face*))) 990 (set-extent-property egg:*dai-bunsetu-extent* 'face egg:*dai-bunsetu-face*)))
986 (egg:error "Wrong type of arguments(dai-bunsetu-face): %s" dai-bunsetu-face)) 991 (egg:error "Wrong type of arguments(dai-bunsetu-face): %s" dai-bunsetu-face))
987 992
988 (if (or (null sho-bunsetu-face) (memq sho-bunsetu-face (face-list))) 993 (if (or (null sho-bunsetu-face) (memq sho-bunsetu-face (face-list)))
989 (progn 994 (progn
990 (setq egg:*sho-bunsetu-face* sho-bunsetu-face) 995 (setq egg:*sho-bunsetu-face* sho-bunsetu-face)
991 (if (overlayp egg:*sho-bunsetu-overlay*) 996 (if (extentp egg:*sho-bunsetu-extent*)
992 (overlay-put egg:*sho-bunsetu-overlay* 'face egg:*sho-bunsetu-face*))) 997 (set-extent-property egg:*sho-bunsetu-extent* 'face egg:*sho-bunsetu-face*)))
993 (egg:error "Wrong type of arguments(sho-bunsetu-face): %s" sho-bunsetu-face)) 998 (egg:error "Wrong type of arguments(sho-bunsetu-face): %s" sho-bunsetu-face))
994 ) 999 )
995 1000
996 (defun henkan-insert-kouho (start number) 1001 (defun henkan-insert-kouho (start number)
997 (let ((i start)) 1002 (let ((i start))
1121 (setq finished t)) 1126 (setq finished t))
1122 (or finished (setq disable-undo nil) (setq egg:henkan-mode-in-use nil))))) 1127 (or finished (setq disable-undo nil) (setq egg:henkan-mode-in-use nil)))))
1123 ) 1128 )
1124 1129
1125 (defun egg:bunsetu-face-on () 1130 (defun egg:bunsetu-face-on ()
1126 ;; make dai-bunsetu overlay and sho-bunsetu overlay if they do not exist. 1131 ;; make dai-bunsetu extent and sho-bunsetu extent if they do not exist.
1127 ;; put thier faces to overlays and move them to each bunsetu. 1132 ;; put thier faces to extents and move them to each bunsetu.
1128 (let* ((bunsetu-begin *bunsetu-number*) 1133 (let* ((bunsetu-begin *bunsetu-number*)
1129 (bunsetu-end) 1134 (bunsetu-end)
1130 (bunsetu-suu (wnn-server-bunsetu-suu))) 1135 (bunsetu-suu (wnn-server-bunsetu-suu)))
1131 ; dai bunsetu 1136 ; dai bunsetu
1132 (if egg:*dai-bunsetu-face* 1137 (if egg:*dai-bunsetu-face*
1133 (progn 1138 (progn
1134 (if (overlayp egg:*dai-bunsetu-overlay*) 1139 (if (extentp egg:*dai-bunsetu-extent*)
1135 nil 1140 nil
1136 (setq egg:*dai-bunsetu-overlay* (make-overlay 1 1)) 1141 (setq egg:*dai-bunsetu-extent* (make-extent 1 1))
1137 (overlay-put egg:*dai-bunsetu-overlay* 'face egg:*dai-bunsetu-face*)) 1142 (set-extent-property egg:*dai-bunsetu-extent* 'face egg:*dai-bunsetu-face*))
1138 (setq bunsetu-end (wnn-server-dai-end *bunsetu-number*)) 1143 (setq bunsetu-end (wnn-server-dai-end *bunsetu-number*))
1139 (while (not (wnn-server-dai-top bunsetu-begin)) 1144 (while (not (wnn-server-dai-top bunsetu-begin))
1140 (setq bunsetu-begin (1- bunsetu-begin))) 1145 (setq bunsetu-begin (1- bunsetu-begin)))
1141 (move-overlay egg:*dai-bunsetu-overlay* 1146 (set-extent-endpoints egg:*dai-bunsetu-extent*
1142 (bunsetu-position bunsetu-begin) 1147 (bunsetu-position bunsetu-begin)
1143 (+ (bunsetu-position (1- bunsetu-end)) 1148 (+ (bunsetu-position (1- bunsetu-end))
1144 (length (bunsetu-kanji (1- bunsetu-end))))))) 1149 (length (bunsetu-kanji (1- bunsetu-end)))))))
1145 ; sho bunsetu 1150 ; sho bunsetu
1146 (if egg:*sho-bunsetu-face* 1151 (if egg:*sho-bunsetu-face*
1147 (progn 1152 (progn
1148 (if (overlayp egg:*sho-bunsetu-overlay*) 1153 (if (extentp egg:*sho-bunsetu-extent*)
1149 nil 1154 nil
1150 (setq egg:*sho-bunsetu-overlay* (make-overlay 1 1)) 1155 (setq egg:*sho-bunsetu-extent* (make-extent 1 1))
1151 (overlay-put egg:*sho-bunsetu-overlay* 'face egg:*sho-bunsetu-face*)) 1156 (set-extent-property egg:*sho-bunsetu-extent* 'face egg:*sho-bunsetu-face*))
1152 (setq bunsetu-end (1+ *bunsetu-number*)) 1157 (setq bunsetu-end (1+ *bunsetu-number*))
1153 (move-overlay egg:*sho-bunsetu-overlay* 1158 (set-extent-endpoints egg:*sho-bunsetu-extent*
1154 (let ((point (bunsetu-position *bunsetu-number*))) 1159 (let ((point (bunsetu-position *bunsetu-number*)))
1160 ;; ###jhod Removed the char-boundary stuff, as I *THINK* we can only move by whole chars...
1161 ;; (if (eq egg:*sho-bunsetu-face* 'modeline)
1162 ;; (+ point (1+ (char-boundary-p point)))
1163 ;; point))
1155 (if (eq egg:*sho-bunsetu-face* 'modeline) 1164 (if (eq egg:*sho-bunsetu-face* 'modeline)
1156 (+ point (1+ (char-boundary-p point))) 1165 (+ point 1)
1157 point)) 1166 point))
1167
1158 (+ (bunsetu-position (1- bunsetu-end)) 1168 (+ (bunsetu-position (1- bunsetu-end))
1159 (length (bunsetu-kanji (1- bunsetu-end))))))))) 1169 (length (bunsetu-kanji (1- bunsetu-end)))))))))
1160 1170
1161 (defun egg:bunsetu-face-off () 1171 (defun egg:bunsetu-face-off ()
1162 (and egg:*dai-bunsetu-face* 1172 (and egg:*dai-bunsetu-face*
1163 (overlayp egg:*dai-bunsetu-overlay*) 1173 (extentp egg:*dai-bunsetu-extent*)
1164 (delete-overlay egg:*dai-bunsetu-overlay*)) 1174 (delete-extent egg:*dai-bunsetu-extent*))
1165 (and egg:*sho-bunsetu-face* 1175 (and egg:*sho-bunsetu-face*
1166 (overlayp egg:*sho-bunsetu-overlay*) 1176 (extentp egg:*sho-bunsetu-extent*)
1167 (delete-overlay egg:*sho-bunsetu-overlay*)) 1177 (delete-extent egg:*sho-bunsetu-extent*))
1168 ) 1178 )
1169 1179
1170 (defun henkan-goto-bunsetu (number) 1180 (defun henkan-goto-bunsetu (number)
1171 (setq *bunsetu-number* 1181 (setq *bunsetu-number*
1172 (check-number-range number 0 (1- (wnn-server-bunsetu-suu)))) 1182 (check-number-range number 0 (1- (wnn-server-bunsetu-suu))))
1173 (goto-char (bunsetu-position *bunsetu-number*)) 1183 (goto-char (bunsetu-position *bunsetu-number*))
1174 ; (egg:move-bunsetu-overlay) 1184 ; (egg:move-bunsetu-extent)
1175 (egg:bunsetu-face-on) 1185 (egg:bunsetu-face-on)
1176 ) 1186 )
1177 1187
1178 (defun henkan-forward-bunsetu () 1188 (defun henkan-forward-bunsetu ()
1179 (interactive) 1189 (interactive)
1257 (delete-region 1267 (delete-region
1258 (bunsetu-position min) egg:*region-end*) 1268 (bunsetu-position min) egg:*region-end*)
1259 (goto-char (bunsetu-position min)) 1269 (goto-char (bunsetu-position min))
1260 (henkan-insert-kouho min max) 1270 (henkan-insert-kouho min max)
1261 (goto-char point)) 1271 (goto-char point))
1262 ; (egg:move-bunsetu-overlay) 1272 ; (egg:move-bunsetu-extent)
1263 (egg:bunsetu-face-on) 1273 (egg:bunsetu-face-on)
1264 (egg:henkan-face-on) 1274 (egg:henkan-face-on)
1265 ) 1275 )
1266 1276
1267 (defun henkan-bunsetu-chijime-dai () 1277 (defun henkan-bunsetu-chijime-dai ()