|
70
|
1 ;; Japanese Character Input Package for Egg
|
|
|
2 ;; Coded by S.Tomura, Electrotechnical Lab. (tomura@etl.go.jp)
|
|
|
3
|
|
|
4 ;; This file is part of Egg on Mule (Multilingal Environment)
|
|
|
5
|
|
|
6 ;; Egg is free software; you can redistribute it and/or modify
|
|
|
7 ;; it under the terms of the GNU General Public License as published by
|
|
|
8 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
9 ;; any later version.
|
|
|
10
|
|
|
11 ;; Egg is distributed in the hope that it will be useful,
|
|
|
12 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
13 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
14 ;; GNU General Public License for more details.
|
|
|
15
|
|
|
16 ;; You should have received a copy of the GNU General Public License
|
|
|
17 ;; along with GNU Emacs; see the file COPYING. If not, write to
|
|
|
18 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
|
19
|
|
|
20 ;;;==================================================================
|
|
|
21 ;;;
|
|
|
22 ;;; $BF|K\8l4D6-(B $B!V$?$^$4!W(B $BBh#3HG(B
|
|
|
23 ;;;
|
|
|
24 ;;;===================================================================
|
|
|
25
|
|
|
26 ;;;
|
|
|
27 ;;;$B!V$?$^$4!W$O%M%C%H%o!<%/$+$J4A;zJQ49%5!<%P$rMxMQ$7!"(BMule $B$G$NF|K\(B
|
|
|
28 ;;; $B8l4D6-$rDs6!$9$k%7%9%F%`$G$9!#!V$?$^$4!WBh#2HG$G$O(B Wnn V3 $B$*$h$S(B
|
|
|
29 ;;; Wnn V4 $B$N$+$J4A;zJQ49%5!<%P$r;HMQ$7$F$$$^$9!#(B
|
|
|
30 ;;;
|
|
|
31
|
|
|
32 ;;; $BL>A0$O(B $B!VBt;3(B/$BBT$?$;$F(B/$B$4$a$s$J$5$$!W$N3FJ8@a$N@hF,#12;$G$"$k!V$?!W(B
|
|
|
33 ;;; $B$H!V$^!W$H!V$4!W$r<h$C$F!"!V$?$^$4!W$H8@$$$^$9!#EE;R5;=QAm9g8&5f=j(B
|
|
|
34 ;;; $B$N6S8+(B $BH~5.;R;a$NL?L>$K0M$k$b$N$G$9!#(Begg $B$O!V$?$^$4!W$N1QLu$G$9!#(B
|
|
|
35
|
|
|
36 ;;;
|
|
|
37 ;;; $B;HMQK!$O(B info/egg-jp $B$r8+$F2<$5$$!#(B
|
|
|
38 ;;;
|
|
|
39
|
|
|
40 ;;;
|
|
|
41 ;;; $B!V$?$^$4!W$K4X$9$kDs0F!"Cn>pJs$O(B tomura@etl.go.jp $B$K$*Aw$j2<$5$$!#(B
|
|
|
42 ;;;
|
|
|
43
|
|
|
44 ;;;
|
|
|
45 ;;; $B")(B 305 $B0q>k8)$D$/$P;TG_1`(B1-1-4
|
|
|
46 ;;; $BDL;:>J9)6H5;=Q1!EE;R5;=QAm9g8&5f=j(B
|
|
|
47 ;;; $B>pJs%"!<%-%F%/%A%cIt8@8l%7%9%F%`8&5f<<(B
|
|
|
48 ;;;
|
|
|
49 ;;; $B8MB<(B $BE/(B
|
|
|
50
|
|
|
51 ;;;
|
|
|
52 ;;; ($BCm0U(B)$B$3$N%U%!%$%k$O4A;z%3!<%I$r4^$s$G$$$^$9!#(B
|
|
|
53 ;;;
|
|
|
54 ;;; $BBh#3HG(B $B#1#9#9#1G/#27n(B $B#4F|(B
|
|
|
55 ;;; $BBh#2HG(B $B#1#9#8#9G/#67n(B $B#1F|(B
|
|
|
56 ;;; $BBh#1HG(B $B#1#9#8#8G/#77n#1#4F|(B
|
|
|
57 ;;; $B;CDjHG(B $B#1#9#8#8G/#67n#2#4F|(B
|
|
|
58
|
|
|
59 ;;;===================================================================
|
|
|
60 ;;;
|
|
|
61 ;;; (eval-when (load) (require 'wnn-client))
|
|
|
62 ;;;
|
|
|
63
|
|
98
|
64 ; last master version
|
|
|
65 ;;; (defvar egg-version "3.09" "Version number of this version of Egg. ")
|
|
70
|
66 ;;; Last modified date: Fri Sep 25 12:59:00 1992
|
|
215
|
67 (defvar egg-version "3.10 xemacs" "Version number of this version of Egg. ")
|
|
|
68 ;;; Last modified date: Wed Nov 29 20:45:00 1997
|
|
70
|
69
|
|
|
70 ;;;; $B=$@5MW5a%j%9%H(B
|
|
|
71
|
|
|
72 ;;;; read-hiragana-string, read-kanji-string $B$G;HMQ$9$kJ?2>L>F~NO%^%C%W$r(B roma-kana $B$K8GDj$7$J$$$GM_$7$$!%(B
|
|
|
73
|
|
|
74 ;;;; $B=$@5%a%b(B
|
|
|
75
|
|
215
|
76 ;;; 97.10.29 modified by J.Hein <jareth@camelot-soft.com>
|
|
|
77 ;;; fix to get rid of problem with C-h/backspace fuckage when in fence mode. Note
|
|
|
78 ;;; that the entire egg-read-event thing is a hack and really needs to be re-implemented.
|
|
|
79 ;;; I REALLY don't like the bandaids there...
|
|
|
80 ;;; Also added the egg-mode function, and modified the behavior so that just loading
|
|
|
81 ;;; egg will not change the user's state.
|
|
|
82
|
|
98
|
83 ;;; 97.2.05 modified by J.Hein <jhod@po.iijnet.or.jp>
|
|
|
84 ;;; Lots of mods to make it XEmacs workable. Most fixes revolve around the fact that
|
|
|
85 ;;; Mule/et al assumes that all events are keypress events unless specified otherwise.
|
|
|
86 ;;; Also modified to work with the new charset names and API
|
|
|
87
|
|
70
|
88 ;;; 95.6.5 modified by S.Tomura <tomura@etl.go.jp>
|
|
|
89 ;;; $BJQ49D>8e$KO"B3$7$FJQ49$9$k>l9g$rG'<1$9$k$?$a$K!"(B"-in-cont" $B$K4XO"$7$?(B
|
|
|
90 ;;; $BItJ,$rDI2C$7$?!#!J$3$NItJ,$O>-Mh:F=$@5$9$kM=Dj!#!K(B
|
|
|
91
|
|
|
92 ;;; 93.6.19 modified by T.Shingu <shingu@cpr.canon.co.jp>
|
|
|
93 ;;; egg:*in-fence-mode* should be buffer local.
|
|
|
94
|
|
|
95 ;;; 93.6.4 modified by T.Shingu <shingu@cpr.canon.co.jp>
|
|
|
96 ;;; In its-defrule**, length is called instead of chars-in-string.
|
|
|
97
|
|
|
98 ;;; 93.3.15 modified by T.Enami <enami@sys.ptg.sony.co.jp>
|
|
|
99 ;;; egg-self-insert-command simulates the original more perfectly.
|
|
|
100
|
|
|
101 ;;; 92.12.20 modified by S.Tomura <tomura@etl.go.jp>
|
|
|
102 ;;; In its:simulate-input, sref is called instead of aref.
|
|
|
103
|
|
|
104 ;;; 92.12.20 modified by T.Enami <enami@sys.ptg.sony.co.jp>
|
|
|
105 ;;; egg-self-insert-command calls cancel-undo-boundary to simulate original.
|
|
|
106
|
|
|
107 ;;; 92.11.4 modified by M.Higashida <manabu@sigmath.osaka-u.ac.jp>
|
|
|
108 ;;; read-hiragana-string sets minibuffer-preprompt correctly.
|
|
|
109
|
|
|
110 ;;; 92.10.26, 92.10.30 modified by T.Saneto sanewo@pdp.crl.sony.co.jp
|
|
|
111 ;;; typo fixed.
|
|
|
112
|
|
|
113 ;;; 92.10.18 modified by K. Handa <handa@etl.go.jp>
|
|
|
114 ;;; special-symbol-input $BMQ$N%F!<%V%k$r(B autoload $B$K!#(B
|
|
|
115 ;;; busyu.el $B$N(B autoload $B$N;XDj$r(B mule-init.el $B$+$i(B egg.el $B$K0\$9!#(B
|
|
|
116
|
|
|
117 ;;; 92.9.20 modified by S. Tomura
|
|
|
118 ;;;; hiragana-region $B$NCn$N=$@5(B
|
|
|
119
|
|
|
120 ;;;; 92.9.19 modified by Y. Kawabe
|
|
|
121 ;;;; some typos
|
|
|
122
|
|
|
123 ;;;; 92.9.19 modified by Y. Kawabe<kawabe@sramhc.sra.co.jp>
|
|
|
124 ;;;; menu $B$NI=<(4X78$N(B lenght $B$r(B string-width $B$KCV$-49$($k!%(B
|
|
|
125
|
|
|
126 ;;; 92.8.19 modified for Mule Ver.0.9.6 by K.Handa <handa@etl.go.jp>
|
|
|
127 ;;;; menu:select-from-menu calls string-width instead of length.
|
|
|
128
|
|
|
129 ;;;; 92.8.1 modified by S. Tomura
|
|
|
130 ;;;; internal mode $B$rDI2C!%(Bits:*internal-mode-alist* $BDI2C!%(B
|
|
|
131
|
|
|
132 ;;;; 92.7.31 modified by S. Tomura
|
|
|
133 ;;;; its-mode-map $B$,(B super mode map $B$r;}$D$h$&$KJQ99$7$?!%$3$l$K$h$j(B
|
|
|
134 ;;;; mode map $B$,6&M-$G$-$k!%(B its-define-mode, get-next-map $B$J$I$rJQ99!%(B
|
|
|
135 ;;;; get-next-map-locally $B$rDI2C!%(Bits-defrule** $B$rJQ99!%(B
|
|
|
136
|
|
|
137 ;;;; 92.7.31 modified by S. Tomura
|
|
|
138 ;;;; its:make-kanji-buffer , its:*kanji* $B4XO"%3!<%I$r:o=|$7$?!%(B
|
|
|
139
|
|
|
140 ;;;; 92.7.31 modified by S. Tomura
|
|
|
141 ;;;; egg:select-window-hook $B$r=$@5$7!$(Bminibuffer $B$+$i(B exit $B$9$k$H$-$K!$(B
|
|
|
142 ;;;; $B3F<oJQ?t$r(B default-value $B$KLa$9$h$&$K$7$?!%$3$l$K$h$C$F(B
|
|
|
143 ;;;; minibufffer $B$KF~$kA0$K3F<o@_Dj$,2DG=$H$J$k!%(B
|
|
|
144
|
|
|
145 ;;; 92.7.14 modified for Mule Ver.0.9.5 by T.Ito <toshi@his.cpl.melco.co.jp>
|
|
|
146 ;;; Attribute bold can be used.
|
|
|
147 ;;; Unnecessary '*' in comments of variables deleted.
|
|
|
148 ;;; 92.7.8 modified for Mule Ver.0.9.5 by Y.Kawabe <kawabe@sra.co.jp>
|
|
|
149 ;;; special-symbol-input keeps the position selected last.
|
|
|
150 ;;; 92.7.8 modified for Mule Ver.0.9.5 by T.Shingu <shingu@cpr.canon.co.jp>
|
|
|
151 ;;; busyu-input and kakusuu-input are added in *symbol-input-menu*.
|
|
|
152 ;;; 92.7.7 modified for Mule Ver.0.9.5 by K.Handa <handa@etl.go.jp>
|
|
|
153 ;;; In egg:quit-mode, overwrite-mode is supported correctly.
|
|
|
154 ;;; egg:*overwrite-mode-deleted-chars* is not used now.
|
|
|
155 ;;; 92.6.26 modified for Mule Ver.0.9.5 by K.Handa <handa@etl.go.jp>
|
|
|
156 ;;; Funtion dump-its-mode-map gets obsolete.
|
|
|
157 ;;; 92.6.26 modified for Mule Ver.0.9.5 by M.Shikida <shikida@cs.titech.ac.jp>
|
|
|
158 ;;; Backquote ` is registered in *hankaku-alist* and *zenkaku-alist*.
|
|
|
159 ;;; 92.6.17 modified for Mule Ver.0.9.5 by T.Shingu <shingu@cpr.canon.co.jp>
|
|
|
160 ;;; Bug in make-jis-second-level-code-alist fixed.
|
|
|
161 ;;; 92.6.14 modified for Mule Ver.0.9.5 by T.Enami <enami@sys.ptg.sony.co.jp>
|
|
|
162 ;;; menu:select-from-menu is replaced with new version.
|
|
|
163 ;;; 92.5.18 modified for Mule Ver.0.9.4 by T.Shingu <shingu@cpr.canon.co.jp>
|
|
|
164 ;;; lisp/wnn-egg.el is devided into two parts: this file and wnn*-egg.el.
|
|
|
165
|
|
|
166 ;;;;
|
|
|
167 ;;;; Mule Ver.0.9.3 $B0JA0(B
|
|
|
168 ;;;;
|
|
|
169
|
|
|
170 ;;;; April-15-92 for Mule Ver.0.9.3
|
|
|
171 ;;;; by T.Enami <enami@sys.ptg.sony.co.jp> and K.Handa <handa@etl.go.jp>
|
|
|
172 ;;;; notify-internal calls 'message' with correct argument.
|
|
|
173
|
|
|
174 ;;;; April-11-92 for Mule Ver.0.9.3
|
|
|
175 ;;;; by T.Enami <enami@sys.ptg.sony.co.jp> and K.Handa <handa@etl.go.jp>
|
|
|
176 ;;;; minibuffer $B$+$iH4$1$k;~(B egg:select-window-hook $B$G(B egg:*input-mode* $B$r(B
|
|
|
177 ;;;; t $B$K$9$k!#(Bhook $B$N7A$rBgI}=$@5!#(B
|
|
|
178
|
|
|
179 ;;;; April-3-92 for Mule Ver.0.9.2 by T.Enami <enami@sys.ptg.sony.co.jp>
|
|
|
180 ;;;; minibuffer $B$+$iH4$1$k;~(B egg:select-window-hook $B$,(B new-buffer $B$N(B
|
|
|
181 ;;;; egg:*mode-on* $B$J$I$r(B nil $B$K$7$F$$$k$N$r=$@5!#(B
|
|
|
182
|
|
|
183 ;;;; Mar-22-92 by K.Handa
|
|
|
184 ;;;; etags $B$,:n$k(B TAGS $B$KITI,MW$J$b$N$rF~$l$J$$$h$&$K$9$k$?$a4X?tL>JQ99(B
|
|
|
185 ;;;; define-its-mode -> its-define-mode, defrule -> its-defrule
|
|
|
186
|
|
|
187 ;;;; Mar-16-92 by K.Handa
|
|
|
188 ;;;; global-map $B$X$N(B define-key $B$r(B mule-keymap $B$KJQ99!#(B
|
|
|
189
|
|
|
190 ;;;; Mar-13-92 by K.Handa
|
|
|
191 ;;;; Language specific part $B$r(B japanese.el,... $B$K0\$7$?!#(B
|
|
|
192
|
|
|
193 ;;;; Feb-*-92 by K. Handa
|
|
|
194 ;;;; nemacs 4 $B$G$O(B minibuffer-window-selected $B$,GQ;_$K$J$j!$4XO"$9$k%3!<%I$r:o=|$7$?!%(B
|
|
|
195
|
|
|
196 ;;;; Jan-13-92 by S. Tomura
|
|
|
197 ;;;; mc-emacs or nemacs 4 $BBP1~:n6H3+;O!%(B
|
|
|
198
|
|
|
199 ;;;; Aug-9-91 by S. Tomura
|
|
|
200 ;;;; ?\^ $B$r(B ?^ $B$K=$@5!%(B
|
|
|
201
|
|
|
202 ;;;; menu $B$r(B key map $B$r8+$k$h$&$K$9$k!%(B
|
|
|
203
|
|
|
204 ;;;; Jul-6-91 by S. Tomura
|
|
|
205 ;;;; setsysdict $B$N(B error $B%a%C%;!<%8$rJQ99!%(B
|
|
|
206
|
|
|
207 ;;;; Jun-11-91 by S. Tomura
|
|
|
208 ;;;; its:*defrule-verbose* $B$rDI2C!%(B
|
|
|
209 ;;;;
|
|
|
210
|
|
|
211 ;;;; Mar-25-91 by S. Tomura
|
|
|
212 ;;;; reset-its-mode $B$rGQ;_(B
|
|
|
213
|
|
|
214 ;;;; Mar-23-91 by S. Tomura
|
|
|
215 ;;;; read-hiragana-string $B$r=$@5!$(B read-kanji-string $B$rDI2C!$(B
|
|
|
216 ;;;; isearch:read-kanji-string $B$r@_Dj!%(B
|
|
|
217
|
|
|
218 ;;;; Mar-22-91 by S. Tomura
|
|
|
219 ;;;; defrule-conditional, defrule-select-mode-temporally $B$rDI2C!#(B
|
|
|
220 ;;;; for-each $B$N4J0WHG$H$7$F(B dolist $B$rDI2C!#(B
|
|
|
221 ;;;; enable-double-n-syntax $B$r3hMQ!%$[$+$K(B use-kuten-for-comma, use-touten-for-period $B$rDI2C(B
|
|
|
222
|
|
|
223 ;;;; Mar-5-91 by S. Tomura
|
|
|
224 ;;;; roma-kana-word, henkan-word, roma-kanji-word $B$rDI2C$7$?!%(B
|
|
|
225
|
|
|
226 ;;;; Jan-14-91 by S. Tomura
|
|
|
227 ;;;; $BF~NOJ8;zJQ497O(B ITS(Input character Translation System) $B$r2~B$$9$k!%(B
|
|
|
228 ;;;; $BJQ49$O:G:8:GD9JQ49$r9T$J$$!$JQ49$N$J$$$b$N$O$b$H$N$^$^$H$J$k!%(B
|
|
|
229 ;;;; $B2~B$$NF05!$ON)LZ!w7D1~$5$s$N%O%s%0%kJ8;z$NF~NOMW5a$G$"$k!%(B
|
|
|
230 ;;;; its:* $B$rDI2C$7$?!%$^$?=>Mh(B fence-self-insert-command $B$H(B roma-kana-region
|
|
|
231 ;;;; $BFs2U=j$K$o$+$l$F$$$?%3!<%I$r(B its:translate-region $B$K$h$C$F0lK\2=$7$?!%(B
|
|
|
232
|
|
|
233 ;;;; July-30-90 by S. Tomura
|
|
|
234 ;;;; henkan-region $B$r(Boverwrite-mode $B$KBP1~$5$;$k!%JQ?t(B
|
|
|
235 ;;;; egg:*henkan-fence-mode*, egg:*overwrite-mode-deleted-chars*
|
|
|
236 ;;;; $B$rDI2C$7!$(Bhenkan-fence-region, henkan-region-internal,
|
|
|
237 ;;;; quit-egg-mode $B$rJQ99$9$k!%(B
|
|
|
238
|
|
|
239 ;;;; Mar-4-90 by K.Handa
|
|
|
240 ;;;; New variable alphabet-mode-indicator, transparent-mode-indicator,
|
|
|
241 ;;;; and henkan-mode-indicator.
|
|
|
242
|
|
|
243 ;;;; Feb-27-90 by enami@ptgd.sony.co.jp
|
|
|
244 ;;;; menu:select-from-menu $B$G#22U=j$"$k(B ((and (<= ?0 ch) (<= ch ?9)...
|
|
|
245 ;;;; $B$N0lJ}$r(B ((and (<= ?0 ch) (<= ch ?9)... $B$K=$@5(B
|
|
|
246
|
|
|
247 ;;;; Feb-07-89
|
|
|
248 ;;;; bunsetu-length-henko $B$NCf$N(B egg:*attribute-off $B$N0LCV$r(B KKCP $B$r8F$VA0$K(B
|
|
|
249 ;;;; $BJQ99$9$k!#(B wnn-client $B$G$O(B KKCP $B$r8F$V$HJ8@a>pJs$,JQ2=$9$k!#(B
|
|
|
250
|
|
|
251 ;;;; Feb-01-89
|
|
|
252 ;;;; henkan-goto-kouho $B$N(B egg:set-bunsetu-attribute $B$N0z?t(B
|
|
|
253 ;;;; $B$N=gHV$,4V0c$C$F$$$?$N$r=$@5$7$?!#!J(Btoshi@isvax.isl.melco.co.jp
|
|
|
254 ;;;; (Toshiyuki Ito)$B$N;XE&$K$h$k!#!K(B
|
|
|
255
|
|
|
256 ;;;; Dec-25-89
|
|
|
257 ;;;; meta-flag t $B$N>l9g$NBP1~$r:F=$@5$9$k!#(B
|
|
|
258 ;;;; overwrite-mode $B$G$N(B undo $B$r2~A1$9$k!#(B
|
|
|
259
|
|
|
260 ;;;; Dec-21-89
|
|
|
261 ;;;; bug fixed by enami@ptdg.sony.co.jp
|
|
|
262 ;;;; (fboundp 'minibuffer-window-selected )
|
|
|
263 ;;;; -->(boundp 'minibuffer-window-selected )
|
|
|
264 ;;;; self-insert-after-hook $B$r(B buffer local $B$K$7$FDj5A$r(B kanji.el $B$X0\F0!#(B
|
|
|
265
|
|
|
266 ;;;; Dec-15-89
|
|
|
267 ;;;; kill-all-local-variables $B$NDj5A$r(B kanji.el $B$X0\F0$9$k!#(B
|
|
|
268
|
|
|
269 ;;;; Dec-14-89
|
|
|
270 ;;;; meta-flag t $B$N>l9g$N=hM}$r=$@5$9$k(B
|
|
|
271 ;;;; overwrite-mode $B$KBP1~$9$k!#(B
|
|
|
272
|
|
|
273 ;;;; Dec-12-89
|
|
|
274 ;;;; egg:*henkan-open*, egg:*henkan-close* $B$rDI2C!#(B
|
|
|
275 ;;;; egg:*henkan-attribute* $B$rDI2C(B
|
|
|
276 ;;;; set-egg-fence-mode-format, set-egg-henkan-mode-format $B$rDI2C(B
|
|
|
277
|
|
|
278 ;;;; Dec-12-89
|
|
|
279 ;;;; *bunpo-code* $B$K(B 1000: "$B$=$NB>(B" $B$rDI2C(B
|
|
|
280
|
|
|
281 ;;;; Dec-11-89
|
|
|
282 ;;;; egg:*fence-attribute* $B$r?7@_(B
|
|
|
283 ;;;; egg:*bunsetu-attribute* $B$r?7@_(B
|
|
|
284
|
|
|
285 ;;;; Dec-11-89
|
|
|
286 ;;;; attribute-*-region $B$rMxMQ$9$k$h$&$KJQ99$9$k!#(B
|
|
|
287 ;;;; menu:make-selection-list $B$O(B width $B$,>.$5$$;~$K(Bloop $B$9$k!#$3$l$r=$@5$7$?!#(B
|
|
|
288
|
|
|
289 ;;;; Dec-10-89
|
|
|
290 ;;;; set-marker-type $B$rMxMQ$9$kJ}<0$KJQ99!#(B
|
|
|
291
|
|
|
292 ;;;; Dec-07-89
|
|
|
293 ;;;; egg:search-path $B$rDI2C!#(B
|
|
|
294 ;;;; egg-default-startup-file $B$rDI2C$9$k!#(B
|
|
|
295
|
|
|
296 ;;;; Nov-22-89
|
|
|
297 ;;;; egg-startup-file $B$rDI2C$9$k!#(B
|
|
|
298 ;;;; eggrc-search-path $B$r(B egg-startup-file-search-path $B$KL>A0JQ99!#(B
|
|
|
299
|
|
|
300 ;;;; Nov-21-89
|
|
|
301 ;;;; Nemacs 3.2 $B$KBP1~$9$k!#(Bkanji-load* $B$rGQ;_$9$k!#(B
|
|
|
302 ;;;; wnnfns.c $B$KBP1~$7$?=$@5$r2C$($k!#(B
|
|
|
303 ;;;; *Notification* buffer $B$r8+$($J$/$9$k!#(B
|
|
|
304
|
|
|
305 ;;;; Oct-2-89
|
|
|
306 ;;;; *zenkaku-alist* $B$N(B $BJ8;zDj?t$N=q$-J}$,4V0c$C$F$$$?!#(B
|
|
|
307
|
|
|
308 ;;;; Sep-19-89
|
|
|
309 ;;;; toggle-egg-mode $B$N=$@5!J(Bkanji-flag$B!K(B
|
|
|
310 ;;;; egg-self-insert-command $B$N=$@5(B $B!J(Bkanji-flag$B!K(B
|
|
|
311
|
|
|
312 ;;;; Sep-18-89
|
|
|
313 ;;;; self-insert-after-hook $B$NDI2C(B
|
|
|
314
|
|
|
315 ;;;; Sep-15-89
|
|
|
316 ;;;; EGG:open-wnn bug fix
|
|
|
317 ;;;; provide wnn-egg feature
|
|
|
318
|
|
|
319 ;;;; Sep-13-89
|
|
|
320 ;;;; henkan-kakutei-before-point $B$r=$@5$7$?!#(B
|
|
|
321 ;;;; enter-fence-mode $B$NDI2C!#(B
|
|
|
322 ;;;; egg-exit-hook $B$NDI2C!#(B
|
|
|
323 ;;;; henkan-region-internal $B$NDI2C!#(Bhenkan-region$B$O(B point $B$r(Bmark $B$9$k!#(B
|
|
|
324 ;;;; eggrc-search-path $B$NDI2C!#(B
|
|
|
325
|
|
|
326 ;;;; Aug-30-89
|
|
|
327 ;;;; kanji-kanji-1st $B$rD{@5$7$?!#(B
|
|
|
328
|
|
|
329 ;;;; May-30-89
|
|
|
330 ;;;; EGG:open-wnn $B$O(B get-wnn-host-name $B$,(B nil $B$N>l9g!"(B(system-name) $B$r;HMQ$9$k!#(B
|
|
|
331
|
|
|
332 ;;;; May-9-89
|
|
|
333 ;;;; KKCP:make-directory added.
|
|
|
334 ;;;; KKCP:file-access bug fixed.
|
|
|
335 ;;;; set-default-usr-dic-directory modified.
|
|
|
336
|
|
|
337 ;;;; Mar-16-89
|
|
|
338 ;;;; minibuffer-window-selected $B$r;H$C$F(B minibuffer $B$N(B egg-mode$BI=<(5!G=DI2C(B
|
|
|
339
|
|
|
340 ;;;; Mar-13-89
|
|
|
341 ;;;; mode-line-format changed.
|
|
|
342
|
|
|
343 ;;;; Feb-27-89
|
|
|
344 ;;;; henkan-saishou-bunsetu added
|
|
|
345 ;;;; henkan-saichou-bunsetu added
|
|
|
346 ;;;; M-< henkan-saishou-bunsetu
|
|
|
347 ;;;; M-> henkan-saichou-bunsetu
|
|
|
348
|
|
|
349 ;;;; Feb-14-89
|
|
|
350 ;;;; C-h in henkan mode: help-command added
|
|
|
351
|
|
|
352 ;;;; Feb-7-89
|
|
|
353 ;;;; egg-insert-after-hook is added.
|
|
|
354
|
|
|
355 ;;;; M-h fence-hiragana
|
|
|
356 ;;;; M-k fence-katakana
|
|
|
357 ;;;; M-> fence-zenkaku
|
|
|
358 ;;;; M-< fence-hankaku
|
|
|
359
|
|
|
360 ;;;; Dec-19-88 henkan-hiragana, henkan-katakara$B$rDI2C!'(B
|
|
|
361 ;;;; M-h henkan-hiragana
|
|
|
362 ;;;; M-k henkan-katakana
|
|
|
363
|
|
|
364 ;;;; Ver. 2.00 kana2kanji.c $B$r;H$o$:(B wnn-client.el $B$r;HMQ$9$k$h$&$KJQ99!#(B
|
|
|
365 ;;;; $B4XO"$7$F0lIt4X?t$rJQ99(B
|
|
|
366
|
|
|
367 ;;;; Dec-2-88 special-symbol-input $B$rDI2C!((B
|
|
|
368 ;;;; C-^ special-symbol-input
|
|
|
369
|
|
|
370 ;;;; Nov-18-88 henkan-mode-map $B0lItJQ99!((B
|
|
|
371 ;;;; M-i henkan-inspect-bunsetu
|
|
|
372 ;;;; M-s henkan-select-kouho
|
|
|
373 ;;;; C-g henkan-quit
|
|
|
374
|
|
|
375 ;;;; Nov-18-88 jserver-henkan-kakutei $B$N;EMMJQ99$KH<$$!"(Bkakutei $B$N%3!<(B
|
|
|
376 ;;;; $B%I$rJQ99$7$?!#(B
|
|
|
377
|
|
|
378 ;;;; Nov-17-88 kakutei-before-point $B$G(B point $B0J9_$N4V0c$C$?ItJ,$NJQ49(B
|
|
|
379 ;;;; $B$,IQEY>pJs$KEPO?$5$l$J$$$h$&$K=$@5$7$?!#$3$l$K$O(BKKCC:henkan-end
|
|
|
380 ;;;; $B$N0lIt;EMM$HBP1~$9$k(Bkana2kanji.c$B$bJQ99$7$?!#(B
|
|
|
381
|
|
|
382 ;;;; Nov-17-88 henkan-inspect-bunsetu $B$rDI2C$7$?!#(B
|
|
|
383
|
|
|
384 ;;;; Nov-17-88 $B?7$7$$(B kana2kanji.c $B$KJQ99$9$k!#(B
|
|
|
385
|
|
|
386 ;;;; Sep-28-88 defrule$B$,CM$H$7$F(Bnil$B$rJV$9$h$&$KJQ99$7$?!#(B
|
|
|
387
|
|
|
388 ;;;; Aug-25-88 $BJQ493X=,$r@5$7$/9T$J$&$h$&$KJQ99$7$?!#(B
|
|
|
389 ;;;; KKCP:henkan-kakutei$B$O(BKKCP:jikouho-list$B$r8F$s$@J8@a$KBP$7$F$N$_E,(B
|
|
|
390 ;;;; $BMQ$G$-!"$=$l0J30$N>l9g$N7k2L$OJ]>Z$5$l$J$$!#$3$N>r7o$rK~$?$9$h$&(B
|
|
|
391 ;;;; $B$K(BKKCP:jikouho-list$B$r8F$s$G$$$J$$J8@a$KBP$7$F$O(B
|
|
|
392 ;;;; KKCP:henkan-kakutei$B$r8F$P$J$$$h$&$K$7$?!#(B
|
|
|
393
|
|
|
394 ;;;; Aug-25-88 egg:do-auto-fill $B$r=$@5$7!"J#?t9T$K$o$?$k(Bauto-fill$B$r@5(B
|
|
|
395 ;;;; $B$7$/9T$J$&$h$&$K=$@5$7$?!#(B
|
|
|
396
|
|
|
397 ;;;; Aug-25-88 menu command$B$K(B\C-l: redraw $B$rDI2C$7$?!#(B
|
|
|
398
|
|
|
399 ;;;; Aug-25-88 toroku-region$B$GEPO?$9$kJ8;zNs$+$i(Bno graphic character$B$r(B
|
|
|
400 ;;;; $B<+F0E*$K=|$/$3$H$K$7$?!#(B
|
|
|
401
|
|
|
402 ;; XEmacs addition: (and remove disable-undo variable)
|
|
|
403 ;; For Emacs V18/Nemacs compatibility
|
|
114
|
404 ;(and (not (fboundp 'buffer-disable-undo))
|
|
|
405 ; (fboundp 'buffer-flush-undo)
|
|
|
406 ; (defalias 'buffer-disable-undo 'buffer-flush-undo))
|
|
70
|
407
|
|
98
|
408 ;; 97.2.4 Created by J.Hein to simulate Mule-2.3
|
|
114
|
409 (defun egg-read-event ()
|
|
|
410 "FSFmacs event emulator that shoves non key events into
|
|
|
411 unread-command-events to facilitate translation from Mule-2.3"
|
|
|
412 (let ((event (make-event))
|
|
183
|
413 ch key)
|
|
114
|
414 (next-command-event event)
|
|
183
|
415 (setq key (event-key event))
|
|
215
|
416 (if (and (key-press-event-p event)
|
|
|
417 (not (event-matches-key-specifier-p event 'backspace)))
|
|
142
|
418 (if (eq 0 (event-modifier-bits event))
|
|
183
|
419 (setq ch (or (event-to-character event) key))
|
|
142
|
420 (if (eq 1 (event-modifier-bits event))
|
|
183
|
421 (setq ch
|
|
|
422 (if (characterp key)
|
|
|
423 (or (int-to-char (- (char-to-int key) 96))
|
|
|
424 (int-to-char (- (char-to-int key) 64)))
|
|
|
425 (event-to-character event)))
|
|
142
|
426 (setq unread-command-events (list event))))
|
|
|
427 (setq unread-command-events (list event)))
|
|
114
|
428 ch))
|
|
98
|
429
|
|
70
|
430 (eval-when-compile (require 'egg-jsymbol))
|
|
|
431
|
|
|
432 ;;;
|
|
|
433 ;;;----------------------------------------------------------------------
|
|
|
434 ;;;
|
|
|
435 ;;; Utilities
|
|
|
436 ;;;
|
|
|
437 ;;;----------------------------------------------------------------------
|
|
|
438
|
|
|
439 ;;;
|
|
|
440 ;;;;
|
|
|
441
|
|
|
442 (defun coerce-string (form)
|
|
|
443 (cond((stringp form) form)
|
|
|
444 ((characterp form) (char-to-string form))))
|
|
|
445
|
|
|
446 (defun coerce-internal-string (form)
|
|
|
447 (cond((stringp form)
|
|
98
|
448 (if (= (length form) 1)
|
|
70
|
449 (string-to-char form)
|
|
|
450 form))
|
|
|
451 ((characterp form) form)))
|
|
|
452
|
|
|
453 ;;; kill-all-local-variables $B$+$iJ]8n$9$k(B local variables $B$r;XDj$G$-$k(B
|
|
|
454 ;;; $B$h$&$KJQ99$9$k!#(B
|
|
|
455
|
|
|
456 (put 'egg:*input-mode* 'permanent-local t)
|
|
|
457 (put 'egg:*mode-on* 'permanent-local t)
|
|
|
458 (put 'its:*current-map* 'permanent-local t)
|
|
|
459 (put 'mode-line-egg-mode 'permanent-local t)
|
|
|
460
|
|
|
461 ;;;----------------------------------------------------------------------
|
|
|
462 ;;;
|
|
|
463 ;;; 16$B?JI=8=$N(BJIS $B4A;z%3!<%I$r(B minibuffer $B$+$iFI$_9~$`(B
|
|
|
464 ;;;
|
|
|
465 ;;;----------------------------------------------------------------------
|
|
|
466
|
|
|
467 ;;;
|
|
|
468 ;;; User entry: jis-code-input
|
|
|
469 ;;;
|
|
|
470
|
|
|
471 (defun jis-code-input ()
|
|
|
472 (interactive)
|
|
|
473 (insert-jis-code-from-minibuffer "JIS $B4A;z%3!<%I(B(16$B?J?tI=8=(B): "))
|
|
|
474
|
|
|
475 (defun insert-jis-code-from-minibuffer (prompt)
|
|
|
476 (let ((str (read-from-minibuffer prompt)) val)
|
|
|
477 (while (null (setq val (read-jis-code-from-string str)))
|
|
|
478 (beep)
|
|
|
479 (setq str (read-from-minibuffer prompt str)))
|
|
98
|
480 (insert (make-char (find-charset 'japanese-jisx0208) (car val) (cdr val)))))
|
|
70
|
481
|
|
|
482 (defun hexadigit-value (ch)
|
|
|
483 (cond((and (<= ?0 ch) (<= ch ?9))
|
|
|
484 (- ch ?0))
|
|
|
485 ((and (<= ?a ch) (<= ch ?f))
|
|
|
486 (+ (- ch ?a) 10))
|
|
|
487 ((and (<= ?A ch) (<= ch ?F))
|
|
|
488 (+ (- ch ?A) 10))))
|
|
|
489
|
|
|
490 (defun read-jis-code-from-string (str)
|
|
|
491 (if (and (= (length str) 4)
|
|
|
492 (<= 2 (hexadigit-value (aref str 0)))
|
|
|
493 (hexadigit-value (aref str 1))
|
|
|
494 (<= 2 (hexadigit-value (aref str 2)))
|
|
|
495 (hexadigit-value (aref str 3)))
|
|
|
496 (cons (+ (* 16 (hexadigit-value (aref str 0)))
|
|
|
497 (hexadigit-value (aref str 1)))
|
|
|
498 (+ (* 16 (hexadigit-value (aref str 2)))
|
|
|
499 (hexadigit-value (aref str 3))))))
|
|
|
500
|
|
|
501 ;;;----------------------------------------------------------------------
|
|
|
502 ;;;
|
|
|
503 ;;; $B!V$?$^$4!W(B Notification System
|
|
|
504 ;;;
|
|
|
505 ;;;----------------------------------------------------------------------
|
|
|
506
|
|
|
507 (defconst *notification-window* " *Notification* ")
|
|
|
508
|
|
|
509 ;;;(defmacro notify (str &rest args)
|
|
|
510 ;;; (list 'notify-internal
|
|
|
511 ;;; (cons 'format (cons str args))))
|
|
|
512
|
|
|
513 (defun notify (str &rest args)
|
|
|
514 (notify-internal (apply 'format (cons str args))))
|
|
|
515
|
|
|
516 (defun notify-internal (message &optional noerase)
|
|
|
517 (save-excursion
|
|
|
518 (let ((notify-buff (get-buffer-create *notification-window*)))
|
|
|
519 (set-buffer notify-buff)
|
|
|
520 (goto-char (point-max))
|
|
|
521 (setq buffer-read-only nil)
|
|
|
522 (insert (substring (current-time-string) 4 19) ":: " message ?\n )
|
|
|
523 (setq buffer-read-only t)
|
|
|
524 (bury-buffer notify-buff)
|
|
|
525 (message "%s" message) ; 92.4.15 by T.Enami
|
|
|
526 (if noerase nil
|
|
|
527 (sleep-for 1) (message "")))))
|
|
|
528
|
|
|
529 ;;;(defmacro notify-yes-or-no-p (str &rest args)
|
|
|
530 ;;; (list 'notify-yes-or-no-p-internal
|
|
|
531 ;;; (cons 'format (cons str args))))
|
|
|
532
|
|
|
533 (defun notify-yes-or-no-p (str &rest args)
|
|
|
534 (notify-yes-or-no-p-internal (apply 'format (cons str args))))
|
|
|
535
|
|
|
536 (defun notify-yes-or-no-p-internal (message)
|
|
|
537 (save-window-excursion
|
|
|
538 (pop-to-buffer *notification-window*)
|
|
|
539 (goto-char (point-max))
|
|
|
540 (setq buffer-read-only nil)
|
|
|
541 (insert (substring (current-time-string) 4 19) ":: " message ?\n )
|
|
|
542 (setq buffer-read-only t)
|
|
|
543 (yes-or-no-p "$B$$$$$G$9$+!)(B")))
|
|
|
544
|
|
|
545 (defun notify-y-or-n-p (str &rest args)
|
|
|
546 (notify-y-or-n-p-internal (apply 'format (cons str args))))
|
|
|
547
|
|
|
548 (defun notify-y-or-n-p-internal (message)
|
|
|
549 (save-window-excursion
|
|
|
550 (pop-to-buffer *notification-window*)
|
|
|
551 (goto-char (point-max))
|
|
|
552 (setq buffer-read-only nil)
|
|
|
553 (insert (substring (current-time-string) 4 19) ":: " message ?\n )
|
|
|
554 (setq buffer-read-only t)
|
|
|
555 (y-or-n-p "$B$$$$$G$9$+!)(B")))
|
|
|
556
|
|
|
557 (defun select-notification ()
|
|
|
558 (interactive)
|
|
|
559 (pop-to-buffer *notification-window*)
|
|
|
560 (setq buffer-read-only t))
|
|
|
561
|
|
|
562 ;;;----------------------------------------------------------------------
|
|
|
563 ;;;
|
|
|
564 ;;; $B!V$?$^$4!W(B Menu System
|
|
|
565 ;;;
|
|
|
566 ;;;----------------------------------------------------------------------
|
|
|
567
|
|
|
568 ;;;
|
|
|
569 ;;; minibuffer $B$K(B menu $B$rI=<(!&A*Br$9$k(B
|
|
|
570 ;;;
|
|
|
571
|
|
|
572 ;;;
|
|
|
573 ;;; menu $B$N;XDjJ}K!!'(B
|
|
|
574 ;;;
|
|
|
575 ;;; <menu item> ::= ( menu <prompt string> <menu-list> )
|
|
|
576 ;;; <menu list> ::= ( <menu element> ... )
|
|
|
577 ;;; <menu element> ::= ( <string> . <value> ) | <string>
|
|
|
578 ;;; ( <char> . <value> ) | <char>
|
|
|
579
|
|
|
580 ;;; select-menu-in-minibuffer
|
|
|
581
|
|
|
582 (defvar menu:*select-items* nil)
|
|
|
583 (defvar menu:*select-menus* nil)
|
|
|
584 (defvar menu:*select-item-no* nil)
|
|
|
585 (defvar menu:*select-menu-no* nil)
|
|
|
586 (defvar menu:*select-menu-stack* nil)
|
|
|
587 (defvar menu:*select-start* nil)
|
|
|
588 (defvar menu:*select-positions* nil)
|
|
|
589
|
|
|
590 (defvar menu-mode-map (make-keymap))
|
|
|
591
|
|
|
592 (define-key menu-mode-map "\C-a" 'menu:begining-of-menu)
|
|
|
593 (define-key menu-mode-map "\C-e" 'menu:end-of-menu)
|
|
|
594 (define-key menu-mode-map "\C-f" 'menu:next-item)
|
|
|
595 (define-key menu-mode-map "\C-b" 'menu:previous-item)
|
|
|
596 (define-key menu-mode-map "\C-n" 'menu:next-item-old)
|
|
|
597 (define-key menu-mode-map "\C-g" 'menu:quit)
|
|
|
598 (define-key menu-mode-map "\C-p" 'menu:previous-item-old)
|
|
|
599 (define-key menu-mode-map "\C-l" 'menu:refresh)
|
|
|
600 ;;; 0 .. 9 a .. z A .. z
|
|
|
601 (define-key menu-mode-map "\C-m" 'menu:select)
|
|
|
602 (define-key menu-mode-map [return] 'menu:select)
|
|
|
603 (define-key menu-mode-map [left] 'menu:previous-item)
|
|
|
604 (define-key menu-mode-map [right] 'menu:next-item)
|
|
|
605 (define-key menu-mode-map [up] 'menu:previous-item-old)
|
|
|
606 (define-key menu-mode-map [down] 'menu:next-item-old)
|
|
|
607
|
|
|
608 ;; 92.6.14 by T.Enami -- This function was completely modified.
|
|
|
609 (defun menu:select-from-menu (menu &optional initial position)
|
|
|
610 (let ((echo-keystrokes 0)
|
|
|
611 (inhibit-quit t)
|
|
|
612 (menubuffer (get-buffer-create " *menu*"))
|
|
|
613 (minibuffer (window-buffer (minibuffer-window)))
|
|
|
614 value)
|
|
|
615 (save-window-excursion
|
|
|
616 (set-window-buffer (minibuffer-window) menubuffer)
|
|
|
617 (select-window (minibuffer-window))
|
|
|
618 (set-buffer menubuffer)
|
|
|
619 (delete-region (point-min) (point-max))
|
|
|
620 (insert (nth 1 menu))
|
|
|
621 (let* ((window-width (window-width (selected-window)))
|
|
|
622 (finished nil))
|
|
|
623 (setq menu:*select-menu-stack* nil
|
|
|
624 menu:*select-positions* nil
|
|
|
625 menu:*select-start* (point)
|
|
|
626 menu:*select-menus*
|
|
|
627 (menu:make-selection-list (nth 2 menu)
|
|
|
628 (- window-width
|
|
|
629 ;;; 92.8.19 by K.Handa
|
|
|
630 (string-width (nth 1 menu)))))
|
|
|
631 ;; 92.7.8 by Y.Kawabe
|
|
|
632 (cond
|
|
|
633 ((and (numberp initial)
|
|
|
634 (<= 0 initial)
|
|
|
635 (< initial (length (nth 2 menu))))
|
|
|
636 (menu:select-goto-item-position initial))
|
|
|
637 ((and (listp initial) (car initial)
|
|
|
638 (<= 0 (car initial))
|
|
|
639 (< (car initial) (length (nth 2 menu))))
|
|
|
640 (menu:select-goto-item-position (car initial))
|
|
|
641 (while (and (setq initial (cdr initial))
|
|
|
642 (setq value (menu:item-value (nth menu:*select-item-no*
|
|
|
643 menu:*select-items*)))
|
|
|
644 (listp value) (eq (car value) 'menu))
|
|
|
645 (setq menu:*select-positions*
|
|
|
646 (cons (menu:select-item-position) menu:*select-positions*))
|
|
|
647 (setq menu:*select-menu-stack*
|
|
|
648 (cons (list menu:*select-items* menu:*select-menus*
|
|
|
649 menu:*select-item-no* menu:*select-menu-no*
|
|
|
650 menu)
|
|
|
651 menu:*select-menu-stack*))
|
|
|
652 (setq menu value)
|
|
|
653 (delete-region (point-min) (point-max)) (insert (nth 1 menu))
|
|
|
654 (setq menu:*select-start* (point))
|
|
|
655 (setq menu:*select-menus*
|
|
|
656 (menu:make-selection-list
|
|
|
657 ;;; 92.9.19 by Y. Kawabe
|
|
|
658 (nth 2 menu) (- window-width (string-width (nth 1 menu)))))
|
|
|
659 (if (and (numberp (car initial))
|
|
|
660 (<= 0 (car initial))
|
|
|
661 (< (car initial) (length (nth 2 menu))))
|
|
|
662 (menu:select-goto-item-position (car initial))
|
|
|
663 (setq menu:*select-item-no* 0)
|
|
|
664 (menu:select-goto-menu 0)))
|
|
|
665 (setq value nil))
|
|
|
666 (t
|
|
|
667 (setq menu:*select-item-no* 0)
|
|
|
668 (menu:select-goto-menu 0))
|
|
|
669 )
|
|
|
670 ;; end of patch
|
|
|
671 (while (not finished)
|
|
114
|
672 (let ((ch (egg-read-event)))
|
|
70
|
673 (setq quit-flag nil)
|
|
|
674 (cond
|
|
|
675 ((eq ch ?\C-a)
|
|
|
676 (menu:select-goto-item 0))
|
|
|
677 ((eq ch ?\C-e)
|
|
|
678 (menu:select-goto-item (1- (length menu:*select-items*))))
|
|
|
679 ((or (eq ch ?\C-f) (eq ch 'right))
|
|
|
680 ;;(menu:select-goto-item (1+ menu:*select-item-no*))
|
|
|
681 (menu:select-next-item)
|
|
|
682 )
|
|
|
683 ((or (eq ch ?\C-b) (eq ch 'left))
|
|
|
684 ;;(menu:select-goto-item (1- menu:*select-item-no*))
|
|
|
685 (menu:select-previous-item)
|
|
|
686 )
|
|
|
687 ((or (eq ch ?\C-n) (eq ch 'down))
|
|
|
688 (menu:select-goto-menu (1+ menu:*select-menu-no*)))
|
|
|
689 ((eq ch ?\C-g)
|
|
|
690 (if menu:*select-menu-stack*
|
|
|
691 (let ((save (car menu:*select-menu-stack*)))
|
|
|
692 (setq menu:*select-menu-stack*
|
|
|
693 (cdr menu:*select-menu-stack*))
|
|
|
694 (setq menu:*select-items* (nth 0 save);92.10.26 by T.Saneto
|
|
|
695 menu:*select-menus* (nth 1 save)
|
|
|
696 menu:*select-item-no* (nth 2 save)
|
|
|
697 menu:*select-menu-no* (nth 3 save)
|
|
|
698 menu (nth 4 save))
|
|
|
699 (setq menu:*select-positions*
|
|
|
700 (cdr menu:*select-positions*))
|
|
|
701 (delete-region (point-min) (point-max))
|
|
|
702 (insert (nth 1 menu))
|
|
|
703 (setq menu:*select-start* (point))
|
|
|
704 (menu:select-goto-menu menu:*select-menu-no*)
|
|
|
705 (menu:select-goto-item menu:*select-item-no*)
|
|
|
706 )
|
|
|
707 (setq finished t
|
|
|
708 value nil)))
|
|
|
709 ((or (eq ch ?\C-p) (eq ch 'up))
|
|
|
710 (menu:select-goto-menu (1- menu:*select-menu-no*)))
|
|
|
711 ((eq ch ?\C-l) ;;; redraw menu
|
|
|
712 (menu:select-goto-menu menu:*select-menu-no*))
|
|
134
|
713 ((and (characterp ch) (<= ?0 ch) (<= ch ?9)
|
|
70
|
714 (<= ch (+ ?0 (1- (length menu:*select-items*)))))
|
|
|
715 (menu:select-goto-item (- ch ?0)))
|
|
134
|
716 ((and (characterp ch) (<= ?a ch) (<= ch ?z)
|
|
70
|
717 (<= (+ 10 ch) (+ ?a (1- (length menu:*select-items*)))))
|
|
|
718 (menu:select-goto-item (+ 10 (- ch ?a))))
|
|
134
|
719 ((and (characterp ch) (<= ?A ch) (<= ch ?Z)
|
|
70
|
720 (<= (+ 10 ch) (+ ?A (1- (length menu:*select-items*)))))
|
|
|
721 (menu:select-goto-item (+ 10 (- ch ?A))))
|
|
|
722 ((or (eq ch ?\C-m) (eq ch 'return))
|
|
|
723 (setq value (menu:item-value (nth menu:*select-item-no*
|
|
|
724 menu:*select-items*)))
|
|
|
725 (setq menu:*select-positions*
|
|
|
726 (cons (menu:select-item-position)
|
|
|
727 menu:*select-positions*))
|
|
|
728 (if (and (listp value)
|
|
|
729 (eq (car value) 'menu))
|
|
|
730 (progn
|
|
|
731 (setq menu:*select-menu-stack*
|
|
|
732 (cons
|
|
|
733 (list menu:*select-items* menu:*select-menus*
|
|
|
734 menu:*select-item-no* menu:*select-menu-no*
|
|
|
735 menu)
|
|
|
736 menu:*select-menu-stack*))
|
|
|
737 (setq menu value)
|
|
|
738 (delete-region (point-min) (point-max))
|
|
|
739 (insert (nth 1 menu))
|
|
|
740 (setq menu:*select-start* (point))
|
|
|
741 (setq menu:*select-menus*
|
|
|
742 ;;; 92.9.19 by Y. Kawabe
|
|
|
743 (menu:make-selection-list
|
|
|
744 (nth 2 menu)
|
|
|
745 (- window-width
|
|
|
746 (string-width (nth 1 menu)))))
|
|
|
747 (setq menu:*select-item-no* 0)
|
|
|
748 (menu:select-goto-menu 0)
|
|
|
749 (setq value nil)
|
|
|
750 )
|
|
|
751 (setq finished t)))
|
|
|
752 (t (beep))))))
|
|
|
753 (delete-region (point-min) (point-max))
|
|
|
754 (setq menu:*select-positions*
|
|
|
755 (nreverse menu:*select-positions*))
|
|
|
756 (set-window-buffer (minibuffer-window) minibuffer)
|
|
|
757 (if (null value)
|
|
|
758 (setq quit-flag t)
|
|
|
759 (if position
|
|
|
760 (cons value menu:*select-positions*)
|
|
|
761 value)))))
|
|
|
762
|
|
|
763 (defun menu:select-item-position ()
|
|
|
764 (let ((p 0) (m 0))
|
|
|
765 (while (< m menu:*select-menu-no*)
|
|
|
766 (setq p (+ p (length (nth m menu:*select-menus*))))
|
|
|
767 (setq m (1+ m)))
|
|
|
768 (+ p menu:*select-item-no*)))
|
|
|
769
|
|
|
770 (defun menu:select-goto-item-position (pos)
|
|
98
|
771 (let ((m 0) (p 0))
|
|
70
|
772 (while (<= (+ p (length (nth m menu:*select-menus*))) pos)
|
|
|
773 (setq p (+ p (length (nth m menu:*select-menus*))))
|
|
|
774 (setq m (1+ m)))
|
|
|
775 (setq menu:*select-item-no* (- pos p))
|
|
|
776 (menu:select-goto-menu m)))
|
|
|
777
|
|
|
778 (defun menu:select-goto-menu (no)
|
|
|
779 (setq menu:*select-menu-no*
|
|
|
780 (check-number-range no 0 (1- (length menu:*select-menus*))))
|
|
|
781 (setq menu:*select-items* (nth menu:*select-menu-no* menu:*select-menus*))
|
|
|
782 (delete-region menu:*select-start* (point-max))
|
|
|
783 (if (<= (length menu:*select-items*) menu:*select-item-no*)
|
|
|
784 (setq menu:*select-item-no* (1- (length menu:*select-items*))))
|
|
|
785 (goto-char menu:*select-start*)
|
|
|
786 (let ((l menu:*select-items*) (i 0))
|
|
|
787 (while l
|
|
|
788 (insert (if (<= i 9) (format " %d." i)
|
|
|
789 (format " %c." (+ (- i 10) ?a)))
|
|
|
790 (menu:item-string (car l)))
|
|
|
791 (setq l (cdr l)
|
|
|
792 i (1+ i))))
|
|
|
793 (menu:select-goto-item menu:*select-item-no*))
|
|
|
794
|
|
|
795 (defun menu:select-goto-item (no)
|
|
|
796 (setq menu:*select-item-no*
|
|
|
797 (check-number-range no 0
|
|
|
798 (1- (length menu:*select-items*))))
|
|
|
799 (let ((p (+ 2 menu:*select-start*)) (i 0))
|
|
|
800 (while (< i menu:*select-item-no*)
|
|
|
801 (setq p (+ p (length (menu:item-string (nth i menu:*select-items*))) 4))
|
|
|
802 (setq i (1+ i)))
|
|
|
803 (goto-char p)))
|
|
|
804
|
|
|
805 (defun menu:select-next-item ()
|
|
|
806 (if (< menu:*select-item-no* (1- (length menu:*select-items*)))
|
|
|
807 (menu:select-goto-item (1+ menu:*select-item-no*))
|
|
|
808 (progn
|
|
|
809 (setq menu:*select-item-no* 0)
|
|
|
810 (menu:select-goto-menu (1+ menu:*select-menu-no*)))))
|
|
|
811
|
|
|
812 (defun menu:select-previous-item ()
|
|
|
813 (if (< 0 menu:*select-item-no*)
|
|
|
814 (menu:select-goto-item (1- menu:*select-item-no*))
|
|
|
815 (progn
|
|
|
816 (setq menu:*select-item-no* 1000)
|
|
|
817 (menu:select-goto-menu (1- menu:*select-menu-no*)))))
|
|
|
818
|
|
|
819 (defvar menu:*display-item-value* nil)
|
|
|
820
|
|
|
821 (defun menu:item-string (item)
|
|
|
822 (cond((stringp item) item)
|
|
98
|
823 ((characterp item) (char-to-string item))
|
|
70
|
824 ((consp item)
|
|
|
825 (if menu:*display-item-value*
|
|
|
826 (format "%s [%s]"
|
|
|
827 (cond ((stringp (car item)) (car item))
|
|
98
|
828 ((characterp (car item)) (char-to-string (car item)))
|
|
70
|
829 (t ""))
|
|
|
830 (cdr item))
|
|
|
831 (cond ((stringp (car item))
|
|
|
832 (car item))
|
|
98
|
833 ((characterp (car item))
|
|
70
|
834 (char-to-string (car item)))
|
|
|
835 (t ""))))
|
|
|
836 (t "")))
|
|
|
837
|
|
|
838 (defun menu:item-value (item)
|
|
|
839 (cond((stringp item) item)
|
|
|
840 (t (cdr item))))
|
|
|
841
|
|
|
842 (defun menu:make-selection-list (items width)
|
|
|
843 (let ((whole nil) (line nil) (size 0))
|
|
|
844 (while items
|
|
|
845 ;;; 92.9.19 by Y. Kawabe
|
|
|
846 (if (<= width (+ size 4 (string-width (menu:item-string(car items)))))
|
|
|
847 (if line
|
|
|
848 (setq whole (cons (reverse line) whole)
|
|
|
849 line nil
|
|
|
850 size 0)
|
|
|
851 (setq whole (cons (list (car items)) whole)
|
|
|
852 size 0
|
|
|
853 items (cdr items)))
|
|
|
854 ;;; 92.9.19 by Y. Kawabe
|
|
|
855 (setq line (cons (car items) line)
|
|
|
856 size (+ size 4 (string-width(menu:item-string (car items))))
|
|
|
857 items (cdr items))))
|
|
|
858 (if line
|
|
|
859 (reverse (cons (reverse line) whole))
|
|
|
860 (reverse whole))))
|
|
|
861
|
|
|
862
|
|
|
863 ;;;----------------------------------------------------------------------
|
|
|
864 ;;;
|
|
|
865 ;;; $B0l3g7?JQ495!G=(B
|
|
|
866 ;;;
|
|
|
867 ;;;----------------------------------------------------------------------
|
|
|
868
|
|
|
869
|
|
|
870 ;;;
|
|
|
871 ;;; $B$R$i$,$JJQ49(B
|
|
|
872 ;;;
|
|
|
873
|
|
|
874 (defun hiragana-region (start end)
|
|
|
875 (interactive "r")
|
|
|
876 (goto-char start)
|
|
|
877 (while (re-search-forward kanji-katakana end end)
|
|
181
|
878 (let ((ch (char-before (point))))
|
|
|
879 (cond( (not (or (> ch ?$B%s(B)
|
|
|
880 (eq ch ?$B!<(B)
|
|
|
881 (eq ch ?$B!+(B)
|
|
|
882 (eq ch ?$B!,(B)))
|
|
70
|
883 (delete-char -1)
|
|
98
|
884 (insert (make-char (find-charset 'japanese-jisx0208) 36 (char-octet ch 1))))))))
|
|
70
|
885
|
|
|
886 (defun hiragana-paragraph ()
|
|
|
887 "hiragana paragraph at or after point."
|
|
|
888 (interactive )
|
|
|
889 (save-excursion
|
|
|
890 (forward-paragraph)
|
|
|
891 (let ((end (point)))
|
|
|
892 (backward-paragraph)
|
|
|
893 (hiragana-region (point) end ))))
|
|
|
894
|
|
|
895 (defun hiragana-sentence ()
|
|
|
896 "hiragana sentence at or after point."
|
|
|
897 (interactive )
|
|
|
898 (save-excursion
|
|
|
899 (forward-sentence)
|
|
|
900 (let ((end (point)))
|
|
|
901 (backward-sentence)
|
|
|
902 (hiragana-region (point) end ))))
|
|
|
903
|
|
|
904 ;;;
|
|
|
905 ;;; $B%+%?%+%JJQ49(B
|
|
|
906 ;;;
|
|
|
907
|
|
|
908 (defun katakana-region (start end)
|
|
|
909 (interactive "r")
|
|
98
|
910 (goto-char start)
|
|
|
911 (while (re-search-forward kanji-hiragana end end)
|
|
181
|
912 (let ((ch (char-before (point))))
|
|
|
913 (cond ((not (memq ch '(?$B!<(B ?$B!+(B ?$B!,(B)))
|
|
|
914 (delete-char -1)
|
|
|
915 (insert (make-char (find-charset 'japanese-jisx0208) 37 (char-octet ch 1))))))))
|
|
70
|
916
|
|
|
917 (defun katakana-paragraph ()
|
|
|
918 "katakana paragraph at or after point."
|
|
|
919 (interactive )
|
|
|
920 (save-excursion
|
|
|
921 (forward-paragraph)
|
|
|
922 (let ((end (point)))
|
|
|
923 (backward-paragraph)
|
|
|
924 (katakana-region (point) end ))))
|
|
|
925
|
|
|
926 (defun katakana-sentence ()
|
|
|
927 "katakana sentence at or after point."
|
|
|
928 (interactive )
|
|
|
929 (save-excursion
|
|
|
930 (forward-sentence)
|
|
|
931 (let ((end (point)))
|
|
|
932 (backward-sentence)
|
|
|
933 (katakana-region (point) end ))))
|
|
|
934
|
|
|
935 ;;;
|
|
|
936 ;;; $BH>3QJQ49(B
|
|
|
937 ;;;
|
|
|
938
|
|
|
939 (defun hankaku-region (start end)
|
|
|
940 (interactive "r")
|
|
|
941 (save-restriction
|
|
|
942 (narrow-to-region start end)
|
|
|
943 (goto-char (point-min))
|
|
181
|
944 (while (re-search-forward "\\cS\\|\\cA\\|\\cK" (point-max) (point-max))
|
|
183
|
945 (let* ((ch (char-before (point)))
|
|
98
|
946 (ch1 (char-octet ch 0))
|
|
|
947 (ch2 (char-octet ch 1)))
|
|
181
|
948 (cond ((= ch1 33) ;Symbols
|
|
70
|
949 (let ((val (cdr (assq ch2 *hankaku-alist*))))
|
|
|
950 (if val (progn
|
|
|
951 (delete-char -1)
|
|
|
952 (insert val)))))
|
|
181
|
953 ; ((= ch1 37) ;Katakana
|
|
|
954 ; (delete-char -1)
|
|
|
955 ; (insert (- ch2 ?\200 )))
|
|
|
956 ((= ch1 35) ;Alphas
|
|
70
|
957 (delete-char -1)
|
|
181
|
958 (insert ch2)))))))
|
|
70
|
959
|
|
|
960 (defun hankaku-paragraph ()
|
|
|
961 "hankaku paragraph at or after point."
|
|
|
962 (interactive )
|
|
|
963 (save-excursion
|
|
|
964 (forward-paragraph)
|
|
|
965 (let ((end (point)))
|
|
|
966 (backward-paragraph)
|
|
|
967 (hankaku-region (point) end ))))
|
|
|
968
|
|
|
969 (defun hankaku-sentence ()
|
|
|
970 "hankaku sentence at or after point."
|
|
|
971 (interactive )
|
|
|
972 (save-excursion
|
|
|
973 (forward-sentence)
|
|
|
974 (let ((end (point)))
|
|
|
975 (backward-sentence)
|
|
|
976 (hankaku-region (point) end ))))
|
|
|
977
|
|
|
978 (defun hankaku-word (arg)
|
|
|
979 (interactive "p")
|
|
|
980 (let ((start (point)))
|
|
|
981 (forward-word arg)
|
|
|
982 (hankaku-region start (point))))
|
|
|
983
|
|
|
984 (defvar *hankaku-alist*
|
|
|
985 '(( 161 . ?\ )
|
|
|
986 ( 170 . ?\! )
|
|
|
987 ( 201 . ?\" )
|
|
|
988 ( 244 . ?\# )
|
|
|
989 ( 240 . ?\$ )
|
|
|
990 ( 243 . ?\% )
|
|
|
991 ( 245 . ?\& )
|
|
|
992 ( 199 . ?\' )
|
|
|
993 ( 202 . ?\( )
|
|
|
994 ( 203 . ?\) )
|
|
|
995 ( 246 . ?\* )
|
|
|
996 ( 220 . ?\+ )
|
|
|
997 ( 164 . ?\, )
|
|
|
998 ( 221 . ?\- )
|
|
|
999 ( 165 . ?\. )
|
|
|
1000 ( 191 . ?\/ )
|
|
|
1001 ( 167 . ?\: )
|
|
|
1002 ( 168 . ?\; )
|
|
|
1003 ( 227 . ?\< )
|
|
|
1004 ( 225 . ?\= )
|
|
|
1005 ( 228 . ?\> )
|
|
|
1006 ( 169 . ?\? )
|
|
|
1007 ( 247 . ?\@ )
|
|
|
1008 ( 206 . ?\[ )
|
|
|
1009 ( 239 . ?\\ )
|
|
|
1010 ( 207 . ?\] )
|
|
|
1011 ( 176 . ?^ )
|
|
|
1012 ( 178 . ?\_ )
|
|
|
1013 ( 208 . ?\{ )
|
|
|
1014 ( 195 . ?\| )
|
|
|
1015 ( 209 . ?\} )
|
|
|
1016 ( 177 . ?\~ )
|
|
|
1017 ( 198 . ?` ) ; 92.6.26 by M.Shikida
|
|
|
1018 ))
|
|
|
1019
|
|
|
1020 ;;;
|
|
|
1021 ;;; $BA43QJQ49(B
|
|
|
1022 ;;;
|
|
|
1023
|
|
|
1024 (defun zenkaku-region (start end)
|
|
|
1025 (interactive "r")
|
|
|
1026 (save-restriction
|
|
|
1027 (narrow-to-region start end)
|
|
|
1028 (goto-char (point-min))
|
|
|
1029 (while (re-search-forward "[ -~]" (point-max) (point-max))
|
|
183
|
1030 (let ((ch (char-before (point))))
|
|
70
|
1031 (if (and (<= ? ch) (<= ch ?~))
|
|
|
1032 (progn
|
|
|
1033 (delete-char -1)
|
|
|
1034 (let ((zen (cdr (assq ch *zenkaku-alist*))))
|
|
|
1035 (if zen (insert zen)
|
|
183
|
1036 (insert (make-char (find-charset 'japanese-jisx0208) 38
|
|
|
1037 (char-to-int ch)))))))))))
|
|
70
|
1038
|
|
|
1039 (defun zenkaku-paragraph ()
|
|
|
1040 "zenkaku paragraph at or after point."
|
|
|
1041 (interactive )
|
|
|
1042 (save-excursion
|
|
|
1043 (forward-paragraph)
|
|
|
1044 (let ((end (point)))
|
|
|
1045 (backward-paragraph)
|
|
|
1046 (zenkaku-region (point) end ))))
|
|
|
1047
|
|
|
1048 (defun zenkaku-sentence ()
|
|
|
1049 "zenkaku sentence at or after point."
|
|
|
1050 (interactive )
|
|
|
1051 (save-excursion
|
|
|
1052 (forward-sentence)
|
|
|
1053 (let ((end (point)))
|
|
|
1054 (backward-sentence)
|
|
|
1055 (zenkaku-region (point) end ))))
|
|
|
1056
|
|
|
1057 (defun zenkaku-word (arg)
|
|
|
1058 (interactive "p")
|
|
|
1059 (let ((start (point)))
|
|
|
1060 (forward-word arg)
|
|
|
1061 (zenkaku-region start (point))))
|
|
|
1062
|
|
|
1063 (defvar *zenkaku-alist*
|
|
|
1064 '((? . "$B!!(B")
|
|
|
1065 (?! . "$B!*(B")
|
|
|
1066 (?\" . "$B!I(B")
|
|
|
1067 (?# . "$B!t(B")
|
|
|
1068 (?$ . "$B!p(B")
|
|
|
1069 (?% . "$B!s(B")
|
|
|
1070 (?& . "$B!u(B")
|
|
|
1071 (?' . "$B!G(B")
|
|
|
1072 (?( . "$B!J(B")
|
|
|
1073 (?) . "$B!K(B")
|
|
|
1074 (?* . "$B!v(B")
|
|
|
1075 (?+ . "$B!\(B")
|
|
|
1076 (?, . "$B!$(B")
|
|
|
1077 (?- . "$B!](B")
|
|
|
1078 (?. . "$B!%(B")
|
|
|
1079 (?/ . "$B!?(B")
|
|
|
1080 (?: . "$B!'(B")
|
|
|
1081 (?\; . "$B!((B")
|
|
|
1082 (?< . "$B!c(B")
|
|
|
1083 (?= . "$B!a(B")
|
|
|
1084 (?> . "$B!d(B")
|
|
|
1085 (?? . "$B!)(B")
|
|
|
1086 (?@ . "$B!w(B")
|
|
|
1087 (?[ . "$B!N(B")
|
|
|
1088 (?\\ . "$B!o(B")
|
|
|
1089 (?] . "$B!O(B")
|
|
|
1090 (?^ . "$B!0(B")
|
|
|
1091 (?_ . "$B!2(B")
|
|
|
1092 (?{ . "$B!P(B")
|
|
|
1093 (?| . "$B!C(B")
|
|
|
1094 (?} . "$B!Q(B")
|
|
|
1095 (?~ . "$B!1(B")
|
|
|
1096 (?` . "$B!F(B"))) ; 92.6.26 by M.Shikida
|
|
|
1097
|
|
|
1098 ;;;
|
|
|
1099 ;;; $B%m!<%^;z$+$JJQ49(B
|
|
|
1100 ;;;
|
|
|
1101
|
|
|
1102 (defun roma-kana-region (start end )
|
|
|
1103 (interactive "r")
|
|
|
1104 (its:translate-region start end nil (its:get-mode-map "roma-kana")))
|
|
|
1105
|
|
|
1106 (defun roma-kana-paragraph ()
|
|
|
1107 "roma-kana paragraph at or after point."
|
|
|
1108 (interactive )
|
|
|
1109 (save-excursion
|
|
|
1110 (forward-paragraph)
|
|
|
1111 (let ((end (point)))
|
|
|
1112 (backward-paragraph)
|
|
|
1113 (roma-kana-region (point) end ))))
|
|
|
1114
|
|
|
1115 (defun roma-kana-sentence ()
|
|
|
1116 "roma-kana sentence at or after point."
|
|
|
1117 (interactive )
|
|
|
1118 (save-excursion
|
|
|
1119 (forward-sentence)
|
|
|
1120 (let ((end (point)))
|
|
|
1121 (backward-sentence)
|
|
|
1122 (roma-kana-region (point) end ))))
|
|
|
1123
|
|
|
1124 (defun roma-kana-word ()
|
|
|
1125 "roma-kana word at or after point."
|
|
|
1126 (interactive)
|
|
|
1127 (save-excursion
|
|
|
1128 (re-search-backward "\\b\\w" nil t)
|
|
|
1129 (let ((start (point)))
|
|
|
1130 (re-search-forward "\\w\\b" nil t)
|
|
|
1131 (roma-kana-region start (point)))))
|
|
|
1132
|
|
|
1133 ;;;
|
|
|
1134 ;;; $B%m!<%^;z4A;zJQ49(B
|
|
|
1135 ;;;
|
|
|
1136
|
|
|
1137 (defun roma-kanji-region (start end)
|
|
|
1138 (interactive "r")
|
|
|
1139 (roma-kana-region start end)
|
|
|
1140 (save-restriction
|
|
|
1141 (narrow-to-region start (point))
|
|
|
1142 (goto-char (point-min))
|
|
|
1143 (replace-regexp "\\($B!!(B\\| \\)" "")
|
|
|
1144 (goto-char (point-max)))
|
|
|
1145 (henkan-region-internal start (point)))
|
|
|
1146
|
|
|
1147 (defun roma-kanji-paragraph ()
|
|
|
1148 "roma-kanji paragraph at or after point."
|
|
|
1149 (interactive )
|
|
|
1150 (save-excursion
|
|
|
1151 (forward-paragraph)
|
|
|
1152 (let ((end (point)))
|
|
|
1153 (backward-paragraph)
|
|
|
1154 (roma-kanji-region (point) end ))))
|
|
|
1155
|
|
|
1156 (defun roma-kanji-sentence ()
|
|
|
1157 "roma-kanji sentence at or after point."
|
|
|
1158 (interactive )
|
|
|
1159 (save-excursion
|
|
|
1160 (forward-sentence)
|
|
|
1161 (let ((end (point)))
|
|
|
1162 (backward-sentence)
|
|
|
1163 (roma-kanji-region (point) end ))))
|
|
|
1164
|
|
|
1165 (defun roma-kanji-word ()
|
|
|
1166 "roma-kanji word at or after point."
|
|
|
1167 (interactive)
|
|
|
1168 (save-excursion
|
|
|
1169 (re-search-backward "\\b\\w" nil t)
|
|
|
1170 (let ((start (point)))
|
|
|
1171 (re-search-forward "\\w\\b" nil t)
|
|
|
1172 (roma-kanji-region start (point)))))
|
|
|
1173
|
|
|
1174
|
|
|
1175 ;;;----------------------------------------------------------------------
|
|
|
1176 ;;;
|
|
|
1177 ;;; $B!V$?$^$4!WF~NOJ8;zJQ497O(B ITS
|
|
|
1178 ;;;
|
|
|
1179 ;;;----------------------------------------------------------------------
|
|
|
1180
|
|
|
1181 (defun egg:member (elt list)
|
|
|
1182 (while (not (or (null list) (equal elt (car list))))
|
|
|
1183 (setq list (cdr list)))
|
|
|
1184 list)
|
|
|
1185
|
|
|
1186 ;;;
|
|
|
1187 ;;; Mode name --> map
|
|
|
1188 ;;;
|
|
|
1189 ;;; ITS mode name: string
|
|
|
1190
|
|
|
1191 (defvar its:*mode-alist* nil)
|
|
|
1192 (defvar its:*internal-mode-alist* nil)
|
|
|
1193
|
|
|
1194 (defun its:get-mode-map (name)
|
|
|
1195 (or (cdr (assoc name its:*mode-alist*))
|
|
|
1196 (cdr (assoc name its:*internal-mode-alist*))))
|
|
|
1197
|
|
|
1198 (defun its:set-mode-map (name map &optional internalp)
|
|
|
1199 (let ((place (assoc name
|
|
|
1200 (if internalp its:*internal-mode-alist*
|
|
|
1201 its:*mode-alist*))))
|
|
|
1202 (if place (let ((mapplace (cdr place)))
|
|
|
1203 (setcar mapplace (car map))
|
|
|
1204 (setcdr mapplace (cdr map)))
|
|
|
1205 (progn (setq place (cons name map))
|
|
|
1206 (if internalp
|
|
|
1207 (setq its:*internal-mode-alist*
|
|
|
1208 (append its:*internal-mode-alist* (list place)))
|
|
|
1209 (setq its:*mode-alist*
|
|
|
1210 (append its:*mode-alist* (list place))))))))
|
|
|
1211
|
|
|
1212 ;;;
|
|
|
1213 ;;; ITS mode indicators
|
|
|
1214 ;;; Mode name --> indicator
|
|
|
1215 ;;;
|
|
|
1216
|
|
|
1217 (defun its:get-mode-indicator (name)
|
|
|
1218 (let ((map (its:get-mode-map name)))
|
|
|
1219 (if map (map-indicator map)
|
|
|
1220 name)))
|
|
|
1221
|
|
|
1222 (defun its:set-mode-indicator (name indicator)
|
|
|
1223 (let ((map (its:get-mode-map name)))
|
|
|
1224 (if map
|
|
|
1225 (map-set-indicator map indicator)
|
|
|
1226 (its-define-mode name indicator))))
|
|
|
1227
|
|
|
1228 ;;;
|
|
|
1229 ;;; ITS mode declaration
|
|
|
1230 ;;;
|
|
|
1231
|
|
|
1232 (defvar its:*processing-map* nil)
|
|
|
1233
|
|
|
1234 (defun its-define-mode (name &optional indicator reset supers internalp)
|
|
|
1235 "its-mode NAME $B$rDj5AA*Br$9$k!%B>$N(B its-mode $B$,A*Br$5$l$k$^$G$O(B
|
|
|
1236 its-defrule $B$J$I$O(B NAME $B$KBP$7$F5,B'$rDI2C$9$k!%(BINDICATOR $B$,(B non-nil
|
|
|
1237 $B$N;~$K$O(B its-mode NAME $B$rA*Br$9$k$H(B mode-line $B$KI=<($5$l$k!%(BRESET $B$,(B
|
|
|
1238 non-nil $B$N;~$K$O(B its-mode $B$NDj5A$,6u$K$J$k!%(BSUPERS $B$O>e0L$N(B its-mode
|
|
|
1239 $BL>$r%j%9%H$G;XDj$9$k!%(BINTERNALP $B$O(B mode name $B$rFbItL>$H$9$k!%(B
|
|
|
1240 its-defrule, its-defrule-conditional, defule-select-mode-temporally $B$r(B
|
|
|
1241 $B;2>H(B"
|
|
|
1242
|
|
|
1243 (if (null(its:get-mode-map name))
|
|
|
1244 (progn
|
|
|
1245 (setq its:*processing-map*
|
|
|
1246 (make-map nil (or indicator name) nil (mapcar 'its:get-mode-map supers)))
|
|
|
1247 (its:set-mode-map name its:*processing-map* internalp)
|
|
|
1248 )
|
|
|
1249 (progn (setq its:*processing-map* (its:get-mode-map name))
|
|
|
1250 (if indicator
|
|
|
1251 (map-set-indicator its:*processing-map* indicator))
|
|
|
1252 (if reset
|
|
|
1253 (progn
|
|
|
1254 (map-set-state its:*processing-map* nil)
|
|
|
1255 (map-set-alist its:*processing-map* nil)
|
|
|
1256 ))
|
|
|
1257 (if supers
|
|
|
1258 (progn
|
|
|
1259 (map-set-supers its:*processing-map* (mapcar 'its:get-mode-map supers))))))
|
|
|
1260 nil)
|
|
|
1261
|
|
|
1262 ;;;
|
|
|
1263 ;;; defrule related utilities
|
|
|
1264 ;;;
|
|
|
1265
|
|
|
1266 (put 'for-each 'lisp-indent-hook 1)
|
|
|
1267
|
|
|
1268 (defmacro for-each (vars &rest body)
|
|
|
1269 "(for-each ((VAR1 LIST1) ... (VARn LISTn)) . BODY) $B$OJQ?t(B VAR1 $B$NCM(B
|
|
|
1270 $B$r%j%9%H(B LIST1 $B$NMWAG$KB+G{$7!$!%!%!%JQ?t(B VARn $B$NCM$r%j%9%H(B LISTn $B$NMW(B
|
|
|
1271 $BAG$KB+G{$7$F(B BODY $B$r<B9T$9$k!%(B"
|
|
|
1272
|
|
|
1273 (for-each* vars (cons 'progn body)))
|
|
|
1274
|
|
|
1275 (defun for-each* (vars body)
|
|
|
1276 (cond((null vars) body)
|
|
|
1277 (t (let((tvar (make-symbol "temp"))
|
|
|
1278 (var (car (car vars)))
|
|
|
1279 (val (car (cdr (car vars)))))
|
|
|
1280 (list 'let (list (list tvar val)
|
|
|
1281 var)
|
|
|
1282 (list 'while tvar
|
|
|
1283 (list 'setq var (list 'car tvar))
|
|
|
1284 (for-each* (cdr vars) body)
|
|
|
1285 (list 'setq tvar (list 'cdr tvar))))))))
|
|
|
1286
|
|
|
1287 (put 'dolist 'lisp-indent-hook 1)
|
|
|
1288
|
|
|
1289 (defmacro dolist (pair &rest body)
|
|
|
1290 "(dolist (VAR LISTFORM) . BODY) $B$O(BVAR $B$K=g<!(B LISTFORM $B$NMWAG$rB+G{$7(B
|
|
|
1291 $B$F(B BODY $B$r<B9T$9$k(B"
|
|
|
1292
|
|
|
1293 (for-each* (list pair) (cons 'progn body)))
|
|
|
1294
|
|
|
1295 ;;;
|
|
|
1296 ;;; defrule
|
|
|
1297 ;;;
|
|
|
1298
|
|
|
1299 (defun its:make-standard-action (output next)
|
|
|
1300 "OUTPUT $B$H(B NEXT $B$+$i$J$k(B standard-action $B$r:n$k!%(B"
|
|
|
1301
|
|
|
1302 (if (and (stringp output) (string-equal output ""))
|
|
|
1303 (setq output nil))
|
|
|
1304 (if (and (stringp next) (string-equal next ""))
|
|
|
1305 (setq next nil))
|
|
|
1306 (cond((null output)
|
|
|
1307 (cond ((null next) nil)
|
|
|
1308 (t (list nil next))))
|
|
|
1309 ((consp output)
|
|
|
1310 ;;; alternative output
|
|
|
1311 (list (cons 0 output) next))
|
|
|
1312 ((null next) output)
|
|
|
1313 (t
|
|
|
1314 (list output next))))
|
|
|
1315
|
|
|
1316 (defun its:standard-actionp (action)
|
|
|
1317 "ACITION $B$,(B standard-action $B$G$"$k$+$I$&$+$rH=Dj$9$k!%(B"
|
|
|
1318 (or (stringp action)
|
|
|
1319 (and (consp action)
|
|
|
1320 (or (stringp (car action))
|
|
|
1321 (and (consp (car action))
|
|
98
|
1322 (characterp (car (car action))))
|
|
70
|
1323 (null (car action)))
|
|
|
1324 (or (null (car (cdr action)))
|
|
|
1325 (stringp (car (cdr action)))))))
|
|
|
1326
|
|
|
1327 (defvar its:make-terminal-state 'its:default-make-terminal-state
|
|
|
1328 "$B=*C<$N>uBV$G$NI=<($r:n@.$9$k4X?t$r;XDj$9$k(B. $B4X?t$O(B map input
|
|
|
1329 action state $B$r0z?t$H$7$F8F$P$l!$>uBVI=<($NJ8;zNs$rJV$9!%(B")
|
|
|
1330
|
|
|
1331 (defun its:default-make-terminal-state (map input action state)
|
|
|
1332 (cond(state state)
|
|
|
1333 (t input)))
|
|
|
1334
|
|
|
1335 (defun its:make-terminal-state-hangul (map input action state)
|
|
|
1336 (cond((its:standard-actionp action) (action-output action))
|
|
|
1337 (t nil)))
|
|
|
1338
|
|
|
1339 (defvar its:make-non-terminal-state 'its:default-make-standard-non-terminal-state
|
|
|
1340 "$BHs=*C<$N>uBV$G$NI=<($r:n@.$9$k4X?t$r;XDj$9$k!%4X?t$O(B map input $B$r(B
|
|
|
1341 $B0z?t$H$7$F8F$P$l!$>uBVI=<($NJ8;zNs$rJV$9(B" )
|
|
|
1342
|
|
|
1343 (defun its:default-make-standard-non-terminal-state (map input)
|
|
|
1344 " ****"
|
|
|
1345 (concat
|
|
|
1346 (map-state-string map)
|
|
|
1347 (char-to-string (aref input (1- (length input))))))
|
|
|
1348
|
|
|
1349 (defun its-defrule (input output &optional next state map)
|
|
|
1350
|
|
|
1351 "INPUT $B$,F~NO$5$l$k$H(B OUTPUT $B$KJQ49$9$k!%(BNEXT $B$,(B nil $B$G$J$$$H$-$OJQ(B
|
|
|
1352 $B49$7$?8e$K(B NEXT $B$,F~NO$5$l$?$h$&$KJQ49$rB3$1$k!%(BINPUT$B$,F~NO$5$l$?;~E@(B
|
|
|
1353 $B$GJQ49$,3NDj$7$F$$$J$$;~$O(B STATE $B$r%U%'%s%9>e$KI=<($9$k!%JQ49$,3NDj$7(B
|
|
|
1354 $B$F$$$J$$;~$KI=<($9$kJ8;zNs$OJQ?t(B its:make-terminal-state $B$*$h$S(B $BJQ?t(B
|
|
|
1355 its:make-non-terminal-state $B$K;X<($5$l$?4X?t$K$h$C$F@8@.$5$l$k!%JQ495,(B
|
|
|
1356 $BB'$O(B MAP $B$G;XDj$5$l$?JQ49I=$KEPO?$5$l$k!%(BMAP $B$,(B nil $B$N>l9g$O$b$C$H$b:G(B
|
|
|
1357 $B6a$K(B its-define-mode $B$5$l$?JQ49I=$KEPO?$5$l$k!%$J$*(B OUTPUT $B$,(B nil $B$N>l(B
|
|
|
1358 $B9g$O(B INPUT $B$KBP$9$kJQ495,B'$,:o=|$5$l$k!%(B"
|
|
|
1359
|
|
|
1360 (its-defrule* input
|
|
|
1361 (its:make-standard-action output next) state
|
|
|
1362 (if (stringp map) map
|
|
|
1363 its:*processing-map*)))
|
|
|
1364
|
|
|
1365 (defmacro its-defrule-conditional (input &rest conds)
|
|
|
1366 "(its-defrule-conditional INPUT ((COND1 OUTPUT1) ... (CONDn OUTPUTn)))$B$O(B
|
|
|
1367 INPUT $B$,F~NO$5$l$?;~$K>r7o(B CONDi $B$r=g<!D4$Y!$@.N)$7$?;~$K$O(B OUTPUTi $B$r(B
|
|
|
1368 $B=PNO$9$k!%(B"
|
|
|
1369 (list 'its-defrule* input (list 'quote (cons 'cond conds))))
|
|
|
1370
|
|
|
1371 (defmacro its-defrule-conditional* (input state map &rest conds)
|
|
|
1372 "(its-defrule-conditional INPUT STATE MAP ((COND1 OUTPUT1) ... (CONDn
|
|
|
1373 OUTPUTn)))$B$O(B INPUT $B$,F~NO$5$l$?;~$K>uBV(B STATE $B$rI=<($7!$>r7o(B CONDi $B$r(B
|
|
|
1374 $B=g<!D4$Y!$@.N)$7$?;~$K$O(B OUTPUTi $B$r=PNO$9$k!%(B"
|
|
|
1375 (list 'its-defrule* input (list 'quote (cons 'cond conds)) state map))
|
|
|
1376
|
|
|
1377 (defun its-defrule-select-mode-temporally (input name)
|
|
|
1378 "INPUT $B$,F~NO$5$l$k$H(B temporally-mode $B$H$7$F(B NAME $B$,A*Br$5$l$k!%(B"
|
|
|
1379
|
|
|
1380 (its-defrule* input (list 'quote (list 'its:select-mode-temporally name))))
|
|
|
1381
|
|
|
1382 (defun its-defrule* (input action &optional state map)
|
|
|
1383 (its:resize (length input))
|
|
|
1384 (setq map (cond((stringp map) (its:get-mode-map map))
|
|
|
1385 ((null map) its:*processing-map*)
|
|
|
1386 (t map)))
|
|
|
1387 (its-defrule** 0 input action state map)
|
|
|
1388 map)
|
|
|
1389
|
|
|
1390 (defvar its:*defrule-verbose* t "nil$B$N>l9g(B, its-defrule $B$N7Y9p$rM^@)$9$k(B")
|
|
|
1391
|
|
|
1392 (defun its-defrule** (i input action state map)
|
|
|
1393 (cond((= (length input) i) ;93.6.4 by T.Shingu
|
|
|
1394 (map-set-state
|
|
|
1395 map
|
|
|
1396 (coerce-internal-string
|
|
|
1397 (funcall its:make-terminal-state map input action state)))
|
|
|
1398 (if (and its:*defrule-verbose* (map-action map))
|
|
|
1399 (if action
|
|
|
1400 (notify "(its-defrule \"%s\" \"%s\" ) $B$r:FDj5A$7$^$7$?!%(B"
|
|
|
1401 input action)
|
|
|
1402 (notify "(its-defrule \"%s\" \"%s\" )$B$r:o=|$7$^$7$?!%(B"
|
|
|
1403 input (map-action map))))
|
|
|
1404 (if (and (null action) (map-terminalp map)) nil
|
|
|
1405 (progn (map-set-action map action)
|
|
|
1406 map)))
|
|
|
1407 (t
|
|
|
1408 (let((newmap
|
|
|
1409 (or (get-next-map-locally map (sref input i))
|
|
|
1410 (make-map (funcall its:make-non-terminal-state
|
|
|
1411 map
|
|
|
1412 (substring input 0 (+ i (char-bytes (sref input i)))))))))
|
|
|
1413 (set-next-map map (sref input i)
|
|
|
1414 (its-defrule** (+ i (char-bytes (sref input i))) input action state newmap)))
|
|
|
1415 (if (and (null (map-action map))
|
|
|
1416 (map-terminalp map))
|
|
|
1417 nil
|
|
|
1418 map))))
|
|
|
1419
|
|
|
1420 ;;;
|
|
|
1421 ;;; map:
|
|
|
1422 ;;;
|
|
|
1423 ;;; <map-alist> ::= ( ( <char> . <map> ) ... )
|
|
|
1424 ;;; <topmap> ::= ( nil <indicator> <map-alist> <supers> )
|
|
|
1425 ;;; <supers> ::= ( <topmap> .... )
|
|
|
1426 ;;; <map> ::= ( <state> <action> <map-alist> )
|
|
|
1427 ;;; <action> ::= <output> | ( <output> <next> ) ....
|
|
|
1428
|
|
|
1429 (defun make-map (&optional state action alist supers)
|
|
|
1430 (list state action alist supers))
|
|
|
1431
|
|
|
1432 (defun map-topmap-p (map)
|
|
|
1433 (null (map-state map)))
|
|
|
1434
|
|
|
1435 (defun map-supers (map)
|
|
|
1436 (nth 3 map))
|
|
|
1437
|
|
|
1438 (defun map-set-supers (map val)
|
|
|
1439 (setcar (nthcdr 3 map) val))
|
|
|
1440
|
|
|
1441 (defun map-terminalp (map)
|
|
|
1442 (null (map-alist map)))
|
|
|
1443
|
|
|
1444 (defun map-state (map)
|
|
|
1445 (nth 0 map))
|
|
|
1446
|
|
|
1447 (defun map-state-string (map)
|
|
|
1448 (coerce-string (map-state map)))
|
|
|
1449
|
|
|
1450 (defun map-set-state (map val)
|
|
|
1451 (setcar (nthcdr 0 map) val))
|
|
|
1452
|
|
|
1453 (defun map-indicator (map)
|
|
|
1454 (map-action map))
|
|
|
1455 (defun map-set-indicator (map indicator)
|
|
|
1456 (map-set-action map indicator))
|
|
|
1457
|
|
|
1458 (defun map-action (map)
|
|
|
1459 (nth 1 map))
|
|
|
1460 (defun map-set-action (map val)
|
|
|
1461 (setcar (nthcdr 1 map) val))
|
|
|
1462
|
|
|
1463 (defun map-alist (map)
|
|
|
1464 (nth 2 map))
|
|
|
1465
|
|
|
1466 (defun map-set-alist (map alist)
|
|
|
1467 (setcar (nthcdr 2 map) alist))
|
|
|
1468
|
|
|
1469 (defun get-action (map)
|
|
|
1470 (if (null map) nil
|
|
|
1471 (let ((action (map-action map)))
|
|
|
1472 (cond((its:standard-actionp action)
|
|
|
1473 action)
|
|
|
1474 ((symbolp action) (condition-case nil
|
|
|
1475 (funcall action)
|
|
|
1476 (error nil)))
|
|
|
1477 (t (condition-case nil
|
|
|
1478 (eval action)
|
|
|
1479 (error nil)))))))
|
|
|
1480
|
|
|
1481 (defun action-output (action)
|
|
|
1482 (cond((stringp action) action)
|
|
|
1483 (t (car action))))
|
|
|
1484
|
|
|
1485 (defun action-next (action)
|
|
|
1486 (cond((stringp action) nil)
|
|
|
1487 (t (car (cdr action)))))
|
|
|
1488
|
|
|
1489 (defun get-next-map (map ch)
|
|
|
1490 (or (cdr (assq ch (map-alist map)))
|
|
|
1491 (if (map-topmap-p map)
|
|
|
1492 (let ((supers (map-supers map))
|
|
|
1493 (result nil))
|
|
|
1494 (while supers
|
|
|
1495 (setq result (get-next-map (car supers) ch))
|
|
|
1496 (if result
|
|
|
1497 (setq supers nil)
|
|
|
1498 (setq supers (cdr supers))))
|
|
|
1499 result))))
|
|
|
1500
|
|
|
1501 (defun get-next-map-locally (map ch)
|
|
|
1502 (cdr (assq ch (map-alist map))))
|
|
|
1503
|
|
|
1504 (defun set-next-map (map ch val)
|
|
|
1505 (let ((place (assq ch (map-alist map))))
|
|
|
1506 (if place
|
|
|
1507 (if val
|
|
|
1508 (setcdr place val)
|
|
|
1509 (map-set-alist map (delq place (map-alist map))))
|
|
|
1510 (if val
|
|
|
1511 (map-set-alist map (cons (cons ch val)
|
|
|
1512 (map-alist map)))
|
|
|
1513 val))))
|
|
|
1514
|
|
|
1515 (defun its:simple-actionp (action)
|
|
|
1516 (stringp action))
|
|
|
1517
|
|
|
1518 (defun collect-simple-action (map)
|
|
|
1519 (if (map-terminalp map)
|
|
|
1520 (if (its:simple-actionp (map-action map))
|
|
|
1521 (list (map-action map))
|
|
|
1522 nil)
|
|
|
1523 (let ((alist (map-alist map))
|
|
|
1524 (result nil))
|
|
|
1525 (while alist
|
|
|
1526 (setq result
|
|
|
1527 ;;; 92.9.19 by Y. Kawabe
|
|
|
1528 (append (collect-simple-action (cdr (car alist)))
|
|
|
1529 result))
|
|
|
1530 (setq alist (cdr alist)))
|
|
|
1531 result)))
|
|
|
1532
|
|
|
1533 ;;;----------------------------------------------------------------------
|
|
|
1534 ;;;
|
|
|
1535 ;;; Runtime translators
|
|
|
1536 ;;;
|
|
|
1537 ;;;----------------------------------------------------------------------
|
|
|
1538
|
|
|
1539 (defun its:simulate-input (i j input map)
|
|
|
1540 (while (<= i j)
|
|
|
1541 (setq map (get-next-map map (sref input i))) ;92.12.26 by S.Tomura
|
|
|
1542 (setq i (+ i (char-bytes (sref input i))))) ;92.12.26 by S.Tomura
|
|
|
1543 map)
|
|
|
1544
|
|
|
1545 ;;; meta-flag $B$,(B on $B$N;~$K$O!"F~NO%3!<%I$K(B \200 $B$r(B or $B$7$?$b$N$,F~NO$5(B
|
|
|
1546 ;;; $B$l$k!#$3$NItJ,$N;XE&$OEl9)Bg$NCf@n(B $B5.G7$5$s$K$h$k!#(B
|
|
|
1547 ;;; pointted by nakagawa@titisa.is.titech.ac.jp Dec-11-89
|
|
|
1548 ;;;
|
|
|
1549 ;;; emacs $B$G$O(B $BJ8;z%3!<%I$O(B 0-127 $B$G07$&!#(B
|
|
|
1550 ;;;
|
|
|
1551
|
|
|
1552 (defvar its:*buff-s* (make-marker))
|
|
98
|
1553 (defvar its:*buff-e* (make-marker))
|
|
|
1554 (set-marker-insertion-type its:*buff-e* t)
|
|
70
|
1555
|
|
|
1556 ;;; STATE unread
|
|
|
1557 ;;; |<-s p->|<- e ->|
|
|
|
1558 ;;; s : ch0 state0 map0
|
|
|
1559 ;;; +1: ch1 state1 map1
|
|
|
1560 ;;; ....
|
|
|
1561 ;;; (point):
|
|
|
1562
|
|
|
1563 ;;; longest matching region : [s m]
|
|
|
1564 ;;; suspending region: [m point]
|
|
|
1565 ;;; unread region : [point e]
|
|
|
1566
|
|
|
1567
|
|
|
1568 (defvar its:*maxlevel* 10)
|
|
|
1569 (defvar its:*maps* (make-vector its:*maxlevel* nil))
|
|
|
1570 (defvar its:*actions* (make-vector its:*maxlevel* nil))
|
|
|
1571 (defvar its:*inputs* (make-vector its:*maxlevel* 0))
|
|
|
1572 (defvar its:*level* 0)
|
|
|
1573
|
|
|
1574 (defun its:resize (size)
|
|
|
1575 (if (<= its:*maxlevel* size)
|
|
|
1576 (setq its:*maxlevel* size
|
|
|
1577 its:*maps* (make-vector size nil)
|
|
|
1578 its:*actions* (make-vector size nil)
|
|
|
1579 its:*inputs* (make-vector size 0))))
|
|
|
1580
|
|
|
1581 (defun its:reset-maps (&optional init)
|
|
|
1582 (setq its:*level* 0)
|
|
|
1583 (if init
|
|
|
1584 (aset its:*maps* its:*level* init)))
|
|
|
1585
|
|
|
1586 (defun its:current-map () (aref its:*maps* its:*level*))
|
|
|
1587 (defun its:previous-map () (aref its:*maps* (max 0 (1- its:*level*))))
|
|
|
1588
|
|
|
1589 (defun its:level () its:*level*)
|
|
|
1590
|
|
|
1591 (defun its:enter-newlevel (map ch output)
|
|
|
1592 (setq its:*level* (1+ its:*level*))
|
|
|
1593 (aset its:*maps* its:*level* map)
|
|
|
1594 (aset its:*inputs* its:*level* ch)
|
|
|
1595 (aset its:*actions* its:*level* output))
|
|
|
1596
|
|
|
1597 (defvar its:*char-from-buff* nil)
|
|
|
1598 (defvar its:*interactive* t)
|
|
|
1599
|
|
|
1600 (defun its:reset-input ()
|
|
|
1601 (setq its:*char-from-buff* nil))
|
|
|
1602
|
|
|
1603 (defun its:flush-input-before-point (from)
|
|
|
1604 (save-excursion
|
|
|
1605 (while (<= from its:*level*)
|
|
|
1606 (its:insert-char (aref its:*inputs* from))
|
|
|
1607 (setq from (1+ from)))))
|
|
|
1608
|
|
|
1609 (defun its:peek-char ()
|
|
|
1610 (if (= (point) its:*buff-e*)
|
|
|
1611 (if its:*interactive*
|
|
114
|
1612 (let ((ch (egg-read-event)))
|
|
|
1613 (if ch
|
|
|
1614 (progn
|
|
|
1615 (setq unread-command-events (list (character-to-event ch)))
|
|
|
1616 ch)
|
|
|
1617 nil))
|
|
70
|
1618 nil)
|
|
183
|
1619 (char-after (point))))
|
|
70
|
1620
|
|
|
1621 (defun its:read-char ()
|
|
|
1622 (if (= (point) its:*buff-e*)
|
|
|
1623 (progn
|
|
|
1624 (setq its:*char-from-buff* nil)
|
|
|
1625 (if its:*interactive*
|
|
114
|
1626 (egg-read-event)
|
|
70
|
1627 nil))
|
|
183
|
1628 (let ((ch (char-after (point))))
|
|
70
|
1629 (setq its:*char-from-buff* t)
|
|
|
1630 (delete-char 1)
|
|
|
1631 ch)))
|
|
|
1632
|
|
|
1633 (defun its:push-char (ch)
|
|
|
1634 (if its:*char-from-buff*
|
|
|
1635 (save-excursion
|
|
|
1636 (its:insert-char ch))
|
|
98
|
1637 (if ch (setq unread-command-events (list (character-to-event ch))))))
|
|
70
|
1638
|
|
|
1639 (defun its:insert-char (ch)
|
|
|
1640 (insert ch))
|
|
|
1641
|
|
|
1642 (defun its:ordinal-charp (ch)
|
|
98
|
1643 (and (characterp ch) (<= ch 127)
|
|
70
|
1644 (eq (lookup-key fence-mode-map (char-to-string ch)) 'fence-self-insert-command)))
|
|
|
1645
|
|
|
1646 (defun its:delete-charp (ch)
|
|
98
|
1647 (and (characterp ch) (<= ch 127)
|
|
70
|
1648 (eq (lookup-key fence-mode-map (char-to-string ch)) 'fence-backward-delete-char)))
|
|
|
1649
|
|
142
|
1650 (defvar egg:fence-buffer nil "Buffer fence is active in")
|
|
|
1651
|
|
70
|
1652 (defun fence-self-insert-command ()
|
|
|
1653 (interactive)
|
|
142
|
1654 (if (not (eq (current-buffer) egg:fence-buffer))
|
|
|
1655 nil ;; #### This is to bandaid a deep event-handling bug
|
|
|
1656 (let ((ch (event-to-character last-command-event)))
|
|
|
1657 (cond((or (not egg:*input-mode*)
|
|
|
1658 (null (get-next-map its:*current-map* ch)))
|
|
|
1659 (insert ch))
|
|
|
1660 (t
|
|
|
1661 (insert ch)
|
|
|
1662 (its:translate-region (1- (point)) (point) t))))))
|
|
70
|
1663
|
|
|
1664 ;;;
|
|
|
1665 ;;; its: completing-read system
|
|
|
1666 ;;;
|
|
|
1667
|
|
|
1668 (defun its:all-completions (string alist &optional pred)
|
|
|
1669 "A variation of all-completions.\n\
|
|
|
1670 Arguments are STRING, ALIST and optional PRED. ALIST must be no obarray."
|
|
|
1671 (let ((tail alist) (allmatches nil))
|
|
|
1672 (while tail
|
|
|
1673 (let* ((elt (car tail))
|
|
|
1674 (eltstring (car elt)))
|
|
|
1675 (setq tail (cdr tail))
|
|
|
1676 (if (and (stringp eltstring)
|
|
|
1677 (<= (length string) (length eltstring))
|
|
|
1678 ;;;(not (= (aref eltstring 0) ? ))
|
|
|
1679 (string-equal string (substring eltstring 0 (length string))))
|
|
|
1680 (if (or (and pred
|
|
|
1681 (if (if (eq pred 'commandp)
|
|
|
1682 (commandp elt)
|
|
|
1683 (funcall pred elt))))
|
|
|
1684 (null pred))
|
|
|
1685 (setq allmatches (cons elt allmatches))))))
|
|
|
1686 (nreverse allmatches)))
|
|
|
1687
|
|
|
1688 (defun its:temp-echo-area-contents (message)
|
|
|
1689 (let ((inhibit-quit inhibit-quit)
|
|
|
1690 (point-max (point-max)))
|
|
|
1691 (goto-char point-max)
|
|
|
1692 (insert message)
|
|
|
1693 (goto-char point-max)
|
|
|
1694 (setq inhibit-quit t)
|
|
|
1695 (sit-for 2 nil)
|
|
|
1696 ;;; 92.9.19 by Y. Kawabe, 92.10.30 by T.Saneto
|
|
|
1697 (delete-region (point) (point-max))
|
|
|
1698 (if quit-flag
|
|
|
1699 (progn
|
|
|
1700 (setq quit-flag nil)
|
|
98
|
1701 (setq unread-command-events (list (character-to-event ?\^G)))))))
|
|
70
|
1702
|
|
|
1703 (defun car-string-lessp (item1 item2)
|
|
|
1704 (string-lessp (car item1) (car item2)))
|
|
|
1705
|
|
|
1706 (defun its:minibuffer-completion-help ()
|
|
|
1707 "Display a list of possible completions of the current minibuffer contents."
|
|
|
1708 (interactive)
|
|
|
1709 (let ((completions))
|
|
|
1710 (message "Making completion list...")
|
|
|
1711 (setq completions (its:all-completions (buffer-string)
|
|
|
1712 minibuffer-completion-table
|
|
|
1713 minibuffer-completion-predicate))
|
|
|
1714 (if (null completions)
|
|
|
1715 (progn
|
|
|
1716 ;;; 92.9.19 by Y. Kawabe
|
|
|
1717 (beep)
|
|
|
1718 (its:temp-echo-area-contents " [No completions]"))
|
|
|
1719 (with-output-to-temp-buffer "*Completions*"
|
|
|
1720 (display-completion-list
|
|
|
1721 (sort completions 'car-string-lessp))))
|
|
|
1722 nil))
|
|
|
1723
|
|
|
1724 (defconst its:minibuffer-local-completion-map
|
|
|
1725 (copy-keymap minibuffer-local-completion-map))
|
|
|
1726 (define-key its:minibuffer-local-completion-map "?" 'its:minibuffer-completion-help)
|
|
|
1727 (define-key its:minibuffer-local-completion-map " " 'its:minibuffer-completion-help)
|
|
|
1728
|
|
|
1729 (defconst its:minibuffer-local-must-match-map
|
|
|
1730 (copy-keymap minibuffer-local-must-match-map))
|
|
|
1731 (define-key its:minibuffer-local-must-match-map "?" 'its:minibuffer-completion-help)
|
|
|
1732 (define-key its:minibuffer-local-must-match-map " " 'its:minibuffer-completion-help)
|
|
|
1733
|
|
|
1734 (fset 'si:all-completions (symbol-function 'all-completions))
|
|
|
1735 (fset 'si:minibuffer-completion-help (symbol-function 'minibuffer-completion-help))
|
|
|
1736
|
|
|
1737 (defun its:completing-read (prompt table &optional predicate require-match initial-input)
|
|
|
1738 "See completing-read"
|
|
|
1739 (let ((minibuffer-local-completion-map its:minibuffer-local-completion-map)
|
|
|
1740 (minibuffer-local-must-match-map its:minibuffer-local-must-match-map)
|
|
|
1741 (completion-auto-help nil))
|
|
|
1742 (completing-read prompt table predicate t initial-input)))
|
|
|
1743
|
|
|
1744 (defvar its:*completing-input-menu* '(menu "Which?" nil)) ;92.10.26 by T.Saneto
|
|
|
1745
|
|
|
1746 (defun its:completing-input (map)
|
|
|
1747 ;;;
|
|
|
1748 (let ((action (get-action map)))
|
|
|
1749 (cond((and (null action)
|
|
|
1750 (= (length (map-alist map)) 1))
|
|
|
1751 (its:completing-input (cdr (nth 0 (map-alist map)))))
|
|
|
1752 (t
|
|
|
1753 (setcar (nthcdr 2 its:*completing-input-menu*)
|
|
|
1754 (map-alist map))
|
|
|
1755 (let ((values
|
|
|
1756 (menu:select-from-menu its:*completing-input-menu*
|
|
|
1757 0 t)))
|
|
|
1758 (cond((consp values)
|
|
|
1759 ;;; get input char from menu
|
|
|
1760 )
|
|
|
1761 (t
|
|
|
1762 (its:completing-input map))))))))
|
|
|
1763
|
|
|
1764 (defvar its:*make-menu-from-map-result* nil)
|
|
|
1765
|
|
|
1766 (defun its:make-menu-from-map (map)
|
|
|
1767 (let ((its:*make-menu-from-map-result* nil))
|
|
|
1768 (its:make-menu-from-map* map "")
|
|
|
1769 (list 'menu "Which?" (reverse its:*make-menu-from-map-result*) )))
|
|
|
1770
|
|
|
1771 (defun its:make-menu-from-map* (map string)
|
|
|
1772 (let ((action (get-action map)))
|
|
|
1773 (if action
|
|
|
1774 (setq its:*make-menu-from-map-result*
|
|
|
1775 (cons (format "%s[%s]" string (action-output action))
|
|
|
1776 its:*make-menu-from-map-result*)))
|
|
|
1777 (let ((alist (map-alist map)))
|
|
|
1778 (while alist
|
|
|
1779 (its:make-menu-from-map*
|
|
|
1780 (cdr (car alist))
|
|
|
1781 (concat string (char-to-string (car (car alist)))))
|
|
|
1782 (setq alist (cdr alist))))))
|
|
|
1783
|
|
|
1784 (defvar its:*make-alist-from-map-result* nil)
|
|
|
1785
|
|
|
1786 (defun its:make-alist-from-map (map &optional string)
|
|
|
1787 (let ((its:*make-alist-from-map-result* nil))
|
|
|
1788 (its:make-alist-from-map* map (or string ""))
|
|
|
1789 (reverse its:*make-alist-from-map-result*)))
|
|
|
1790
|
|
|
1791 (defun its:make-alist-from-map* (map string)
|
|
|
1792 (let ((action (get-action map)))
|
|
|
1793 (if action
|
|
|
1794 (setq its:*make-alist-from-map-result*
|
|
|
1795 (cons (list string
|
|
|
1796 (let ((action-output (action-output action)))
|
|
|
1797 (cond((and (consp action-output)
|
|
98
|
1798 (characterp (car action-output)))
|
|
70
|
1799 (format "%s..."
|
|
|
1800 (nth (car action-output) (cdr action-output))))
|
|
|
1801 ((stringp action-output)
|
|
|
1802 action-output)
|
|
|
1803 (t
|
|
|
1804 (format "%s" action-output)))))
|
|
|
1805 its:*make-alist-from-map-result*)))
|
|
|
1806 (let ((alist (map-alist map)))
|
|
|
1807 (while alist
|
|
|
1808 (its:make-alist-from-map*
|
|
|
1809 (cdr (car alist))
|
|
|
1810 (concat string (char-to-string (car (car alist)))))
|
|
|
1811 (setq alist (cdr alist))))))
|
|
|
1812
|
|
|
1813 (defvar its:*select-alternative-output-menu* '(menu "Which?" nil))
|
|
|
1814
|
|
|
1815 (defun its:select-alternative-output (action-output)
|
|
|
1816 ;;;; action-output : (pos item1 item2 item3 ....)
|
|
|
1817 (let ((point (point))
|
|
|
1818 (output (cdr action-output))
|
|
|
1819 (ch 0))
|
|
|
1820 (while (not (eq ch ?\^L))
|
|
|
1821 (insert "<" (nth (car action-output)output) ">")
|
|
114
|
1822 (setq ch (egg-read-event))
|
|
70
|
1823 (cond ((eq ch ?\^N)
|
|
|
1824 (setcar action-output
|
|
|
1825 (mod (1+ (car action-output)) (length output))))
|
|
|
1826 ((eq ch ?\^P)
|
|
|
1827 (setcar action-output
|
|
|
1828 (if (= 0 (car action-output))
|
|
|
1829 (1- (length output))
|
|
|
1830 (1- (car action-output)))))
|
|
|
1831 ((eq ch ?\^M)
|
|
|
1832 (setcar (nthcdr 2 its:*select-alternative-output-menu* )
|
|
|
1833 output)
|
|
|
1834 (let ((values
|
|
|
1835 (menu:select-from-menu its:*select-alternative-output-menu*
|
|
|
1836 (car action-output)
|
|
|
1837 t)))
|
|
|
1838 (cond((consp values)
|
|
|
1839 (setcar action-output (nth 1 values))
|
|
|
1840 (setq ch ?\^L)))))
|
|
|
1841 ((eq ch ?\^L)
|
|
|
1842 )
|
|
|
1843 (t
|
|
|
1844 (beep)
|
|
|
1845 ))
|
|
|
1846 (delete-region point (point)))
|
|
|
1847 (if its:*insert-output-string*
|
|
|
1848 (funcall its:*insert-output-string* (nth (car action-output) output))
|
|
|
1849 (insert (nth (car action-output) output)))))
|
|
|
1850
|
|
|
1851
|
|
|
1852
|
|
|
1853 ;;; translate until
|
|
|
1854 ;;; interactive --> not ordinal-charp
|
|
|
1855 ;;; or
|
|
|
1856 ;;; not interactive --> end of input
|
|
|
1857
|
|
|
1858 (defvar its:*insert-output-string* nil)
|
|
|
1859 (defvar its:*display-status-string* nil)
|
|
|
1860
|
|
|
1861 (defun its:translate-region (start end its:*interactive* &optional topmap)
|
|
|
1862 (set-marker its:*buff-s* start)
|
|
|
1863 (set-marker its:*buff-e* end)
|
|
|
1864 (its:reset-input)
|
|
|
1865 (goto-char its:*buff-s*)
|
|
|
1866 (let ((topmap (or topmap its:*current-map*))
|
|
|
1867 (map nil)
|
|
|
1868 (ch nil)
|
|
|
1869 (action nil)
|
|
|
1870 (newmap nil)
|
|
|
1871 (inhibit-quit t)
|
|
|
1872 (its-quit-flag nil)
|
|
|
1873 (echo-keystrokes 0))
|
|
|
1874 (setq map topmap)
|
|
|
1875 (its:reset-maps topmap)
|
|
|
1876 (while (not its-quit-flag)
|
|
|
1877 (setq ch (its:read-char))
|
|
|
1878 (setq newmap (get-next-map map ch))
|
|
|
1879 (setq action (get-action newmap))
|
|
|
1880
|
|
|
1881 (cond
|
|
98
|
1882 ((and its:*interactive* (not its:*char-from-buff*) (characterp ch) (= ch ?\^@))
|
|
70
|
1883 (delete-region its:*buff-s* (point))
|
|
|
1884 (let ((i 1))
|
|
|
1885 (while (<= i its:*level*)
|
|
|
1886 (insert (aref its:*inputs* i))
|
|
|
1887 (setq i (1+ i))))
|
|
|
1888 (let ((inputs (its:completing-read "ITS:>"
|
|
|
1889 (its:make-alist-from-map topmap)
|
|
|
1890 nil
|
|
|
1891 t
|
|
|
1892 (buffer-substring its:*buff-s* (point)))))
|
|
|
1893 (delete-region its:*buff-s* (point))
|
|
|
1894 (save-excursion (insert inputs))
|
|
|
1895 (its:reset-maps)
|
|
|
1896 (setq map topmap)
|
|
|
1897 ))
|
|
|
1898 ((or (null newmap)
|
|
|
1899 (and (map-terminalp newmap)
|
|
|
1900 (null action)))
|
|
|
1901
|
|
|
1902 (cond((and its:*interactive* (its:delete-charp ch))
|
|
|
1903 (delete-region its:*buff-s* (point))
|
|
|
1904 (cond((= its:*level* 0)
|
|
|
1905 (setq its-quit-flag t))
|
|
|
1906 ((= its:*level* 1)
|
|
|
1907 (its:insert-char (aref its:*inputs* 1))
|
|
|
1908 (setq its-quit-flag t))
|
|
|
1909 (t
|
|
|
1910 (its:flush-input-before-point (1+ its:*level*))
|
|
|
1911 (setq its:*level* (1- its:*level*))
|
|
|
1912 (setq map (its:current-map))
|
|
|
1913 (if (and its:*interactive*
|
|
|
1914 its:*display-status-string*)
|
|
|
1915 (funcall its:*display-status-string* (map-state map))
|
|
|
1916 (insert (map-state map)))
|
|
|
1917 )))
|
|
|
1918 (t
|
|
|
1919 (let ((output nil))
|
|
|
1920 (let ((i its:*level*) (newlevel (1+ its:*level*)))
|
|
|
1921 (aset its:*inputs* newlevel ch)
|
|
|
1922 (while (and (< 0 i) (null output))
|
|
|
1923 (if (and (aref its:*actions* i)
|
|
|
1924 (its:simulate-input (1+ i) newlevel its:*inputs* topmap))
|
|
|
1925 (setq output i))
|
|
|
1926 (setq i (1- i)))
|
|
|
1927 (if (null output)
|
|
|
1928 (let ((i its:*level*))
|
|
|
1929 (while (and (< 0 i) (null output))
|
|
|
1930 (if (aref its:*actions* i)
|
|
|
1931 (setq output i))
|
|
|
1932 (setq i (1- i)))))
|
|
|
1933
|
|
|
1934 (cond(output
|
|
|
1935 (delete-region its:*buff-s* (point))
|
|
|
1936 (cond((its:standard-actionp (aref its:*actions* output))
|
|
|
1937 (let ((action-output (action-output (aref its:*actions* output))))
|
|
|
1938 (if (and (not its:*interactive*)
|
|
|
1939 (consp action-output))
|
|
|
1940 (setq action-output (nth (car action-output) (cdr action-output))))
|
|
|
1941 (cond((stringp action-output)
|
|
|
1942 (if (and its:*interactive*
|
|
|
1943 its:*insert-output-string*)
|
|
|
1944 (funcall its:*insert-output-string* action-output)
|
|
|
1945 (insert action-output)))
|
|
|
1946 ((consp action-output)
|
|
|
1947 (its:select-alternative-output action-output)
|
|
|
1948 )
|
|
|
1949 (t
|
|
|
1950 (beep) (beep)
|
|
|
1951 )))
|
|
|
1952 (set-marker its:*buff-s* (point))
|
|
|
1953 (its:push-char ch)
|
|
|
1954 (its:flush-input-before-point (1+ output))
|
|
|
1955 (if (action-next (aref its:*actions* output))
|
|
|
1956 (save-excursion
|
|
|
1957 (insert (action-next (aref its:*actions* output)))))
|
|
|
1958 )
|
|
|
1959 ((symbolp (aref its:*actions* output))
|
|
|
1960 (its:push-char ch)
|
|
|
1961 (funcall (aref its:*actions* output))
|
|
|
1962 (its:reset-maps its:*current-map*)
|
|
|
1963 (setq topmap its:*current-map*)
|
|
|
1964 (set-marker its:*buff-s* (point)))
|
|
|
1965 (t
|
|
|
1966 (its:push-char ch)
|
|
|
1967 ;92.10.26 by T.Saneto
|
|
|
1968 (eval (aref its:*actions* output))
|
|
|
1969 (its:reset-maps its:*current-map*)
|
|
|
1970 (setq topmap its:*current-map*)
|
|
|
1971 (set-marker its:*buff-s* (point))
|
|
|
1972 ))
|
|
|
1973 )
|
|
|
1974 ((= 0 its:*level*)
|
|
|
1975 (cond ((or (its:ordinal-charp ch)
|
|
|
1976 its:*char-from-buff*)
|
|
|
1977 (its:insert-char ch))
|
|
|
1978 (t (setq its-quit-flag t))))
|
|
|
1979
|
|
|
1980 ((< 0 its:*level*)
|
|
|
1981 (delete-region its:*buff-s* (point))
|
|
|
1982 (its:insert-char (aref its:*inputs* 1))
|
|
|
1983 (set-marker its:*buff-s* (point))
|
|
|
1984 (its:push-char ch)
|
|
|
1985 (its:flush-input-before-point 2)))))
|
|
|
1986
|
|
|
1987 (cond((null ch)
|
|
|
1988 (setq its-quit-flag t))
|
|
|
1989 ((not its-quit-flag)
|
|
|
1990 (its:reset-maps)
|
|
|
1991 (set-marker its:*buff-s* (point))
|
|
|
1992 (setq map topmap))))))
|
|
|
1993
|
|
|
1994 ((map-terminalp newmap)
|
|
|
1995 (its:enter-newlevel (setq map newmap) ch action)
|
|
|
1996 (delete-region its:*buff-s* (point))
|
|
|
1997 (let ((output nil) (m nil) (i (1- its:*level*)))
|
|
|
1998 (while (and (< 0 i) (null output))
|
|
|
1999 (if (and (aref its:*actions* i)
|
|
|
2000 (setq m (its:simulate-input (1+ i) its:*level* its:*inputs* topmap))
|
|
|
2001 (not (map-terminalp m)))
|
|
|
2002 (setq output i))
|
|
|
2003 (setq i (1- i)))
|
|
|
2004
|
|
|
2005 (cond((null output)
|
|
|
2006 (cond ((its:standard-actionp action)
|
|
|
2007 (let ((action-output (action-output action)))
|
|
|
2008 (if (and (not its:*interactive*)
|
|
|
2009 (consp action-output))
|
|
|
2010 (setq action-output (nth (car action-output) (cdr action-output))))
|
|
|
2011 (cond((stringp action-output)
|
|
|
2012 (if (and its:*interactive*
|
|
|
2013 its:*insert-output-string*)
|
|
|
2014 (funcall its:*insert-output-string* action-output)
|
|
|
2015 (insert action-output)))
|
|
|
2016 ((consp action-output)
|
|
|
2017 (its:select-alternative-output action-output)
|
|
|
2018 )
|
|
|
2019 (t
|
|
|
2020 (beep) (beep)
|
|
|
2021 )))
|
|
|
2022 (cond((null (action-next action))
|
|
|
2023 (cond ((and (= (point) its:*buff-e*)
|
|
|
2024 its:*interactive*
|
|
|
2025 (its:delete-charp (its:peek-char)))
|
|
|
2026 nil)
|
|
|
2027 (t
|
|
|
2028 (set-marker its:*buff-s* (point))
|
|
|
2029 (its:reset-maps)
|
|
|
2030 (setq map topmap)
|
|
|
2031 )))
|
|
|
2032 (t
|
|
|
2033 (save-excursion (insert (action-next action)))
|
|
|
2034 (set-marker its:*buff-s* (point))
|
|
|
2035 (its:reset-maps)
|
|
|
2036 (setq map topmap))))
|
|
|
2037 ((symbolp action)
|
|
|
2038 (funcall action)
|
|
|
2039 (its:reset-maps its:*current-map*)
|
|
|
2040 (setq topmap its:*current-map*)
|
|
|
2041 (setq map topmap)
|
|
|
2042 (set-marker its:*buff-s* (point)))
|
|
|
2043 (t
|
|
|
2044 (eval action)
|
|
|
2045 (its:reset-maps its:*current-map*)
|
|
|
2046 (setq topmap its:*current-map*)
|
|
|
2047 (setq map topmap)
|
|
|
2048 (set-marker its:*buff-s* (point)))))
|
|
|
2049 (t
|
|
|
2050 (if (and its:*interactive*
|
|
|
2051 its:*display-status-string*)
|
|
|
2052 (funcall its:*display-status-string* (map-state map))
|
|
|
2053 (insert (map-state map)))))))
|
|
|
2054
|
|
|
2055 ((null action)
|
|
|
2056 (delete-region its:*buff-s* (point))
|
|
|
2057 (if (and its:*interactive*
|
|
|
2058 its:*display-status-string*)
|
|
|
2059 (funcall its:*display-status-string* (map-state newmap))
|
|
|
2060 (insert (map-state newmap)))
|
|
|
2061 (its:enter-newlevel (setq map newmap)
|
|
|
2062 ch action))
|
|
|
2063
|
|
|
2064 (t
|
|
|
2065 (its:enter-newlevel (setq map newmap) ch action)
|
|
|
2066 (delete-region its:*buff-s* (point))
|
|
|
2067 (if (and its:*interactive*
|
|
|
2068 its:*display-status-string*)
|
|
|
2069 (funcall its:*display-status-string* (map-state map))
|
|
|
2070 (insert (map-state map))))))
|
|
|
2071
|
|
|
2072 (set-marker its:*buff-s* nil)
|
|
|
2073 (set-marker its:*buff-e* nil)
|
|
98
|
2074 (if (and its:*interactive* ch) (setq unread-command-events (list (character-to-event ch))))
|
|
70
|
2075 ))
|
|
|
2076
|
|
|
2077 ;;;----------------------------------------------------------------------
|
|
|
2078 ;;;
|
|
|
2079 ;;; ITS-map dump routine:
|
|
|
2080 ;;;
|
|
|
2081 ;;;----------------------------------------------------------------------
|
|
|
2082
|
|
|
2083 ;;;;;
|
|
|
2084 ;;;;; User entry: dump-its-mode-map
|
|
|
2085 ;;;;;
|
|
|
2086
|
|
|
2087 ;; 92.6.26 by K.Handa
|
|
|
2088 (defun dump-its-mode-map (name filename)
|
|
|
2089 "Obsolete."
|
|
|
2090 (interactive)
|
|
|
2091 (message "This function is obsolete in the current version of Mule."))
|
|
|
2092 ;;;
|
|
|
2093 ;;; EGG mode variables
|
|
|
2094 ;;;
|
|
|
2095
|
|
|
2096 (defvar egg:*mode-on* nil "T if egg mode is on.")
|
|
|
2097 (make-variable-buffer-local 'egg:*mode-on*)
|
|
|
2098 (set-default 'egg:*mode-on* nil)
|
|
|
2099
|
|
|
2100 (defvar egg:*input-mode* t "T if egg map is active.")
|
|
|
2101 (make-variable-buffer-local 'egg:*input-mode*)
|
|
|
2102 (set-default 'egg:*input-mode* t)
|
|
|
2103
|
|
|
2104 (defvar egg:*in-fence-mode* nil "T if in fence mode.")
|
|
|
2105 (make-variable-buffer-local 'egg:*in-fence-mode*)
|
|
|
2106 (set-default 'egg:*in-fence-mode* nil)
|
|
|
2107
|
|
|
2108 ;;(load-library "its-dump/roma-kana") ;;;(define-its-mode "roma-kana" " a$B$"(B")
|
|
|
2109 ;;(load-library "its-dump/roma-kata") ;;;(define-its-mode "roma-kata" " a$B%"(B")
|
|
|
2110 ;;(load-library "its-dump/downcase") ;;;(define-its-mode "downcase" " a a")
|
|
|
2111 ;;(load-library "its-dump/upcase") ;;;(define-its-mode "upcase" " a A")
|
|
|
2112 ;;(load-library "its-dump/zenkaku-downcase") ;;;(define-its-mode "zenkaku-downcase" " a$B#a(B")
|
|
|
2113 ;;(load-library "its-dump/zenkaku-upcase") ;;;(define-its-mode "zenkaku-upcase" " a$B#A(B")
|
|
|
2114 ;; 92.3.13 by K.Handa
|
|
|
2115 ;; (load "its-hira")
|
|
|
2116 ;; (load-library "its-kata")
|
|
|
2117 ;; (load-library "its-hankaku")
|
|
|
2118 ;; (load-library "its-zenkaku")
|
|
|
2119
|
|
|
2120 (defvar its:*current-map* nil)
|
|
|
2121 (make-variable-buffer-local 'its:*current-map*)
|
|
|
2122 ;; 92.3.13 by K.Handa
|
|
|
2123 ;; moved to each language specific setup files (japanese.el, ...)
|
|
|
2124 ;; (setq-default its:*current-map* (its:get-mode-map "roma-kana"))
|
|
|
2125
|
|
|
2126 (defvar its:*previous-map* nil)
|
|
|
2127 (make-variable-buffer-local 'its:*previous-map*)
|
|
|
2128 (setq-default its:*previous-map* nil)
|
|
|
2129
|
|
|
2130 ;;;----------------------------------------------------------------------
|
|
|
2131 ;;;
|
|
|
2132 ;;; Mode line control functions;
|
|
|
2133 ;;;
|
|
|
2134 ;;;----------------------------------------------------------------------
|
|
|
2135
|
|
|
2136 (defconst mode-line-egg-mode "--")
|
|
|
2137 (make-variable-buffer-local 'mode-line-egg-mode)
|
|
|
2138
|
|
|
2139 (defvar mode-line-egg-mode-in-minibuffer "--" "global variable")
|
|
|
2140
|
|
|
2141 (defun egg:find-symbol-in-tree (item tree)
|
|
|
2142 (if (consp tree)
|
|
|
2143 (or (egg:find-symbol-in-tree item (car tree))
|
|
|
2144 (egg:find-symbol-in-tree item (cdr tree)))
|
|
|
2145 (equal item tree)))
|
|
|
2146
|
|
|
2147 ;;;
|
|
|
2148 ;;; nemacs Ver. 3.0 $B$G$O(B Fselect_window $B$,JQ99$K$J$j!"(Bminibuffer-window
|
|
|
2149 ;;; $BB>$N(B window $B$H$N4V$G=PF~$j$,$"$k$H!"(Bmode-line $B$N99?7$r9T$J$$!"JQ?t(B
|
|
|
2150 ;;; minibuffer-window-selected $B$NCM$,99?7$5$l$k(B
|
|
|
2151 ;;;
|
|
|
2152
|
|
|
2153 ;;; nemacs Ver. 4 $B$G$O(B Fselect_window $B$,JQ99$K$J$j!$(Bselect-window-hook
|
|
|
2154 ;;; $B$,Dj5A$5$l$?!%$3$l$K$H$b$J$$=>Mh!$:FDj5A$7$F$$$?(B select-window,
|
|
|
2155 ;;; other-window, keyborad-quit, abort-recursive-edit, exit-minibuffer
|
|
|
2156 ;;; $B$r:o=|$7$?!%(B
|
|
|
2157
|
|
|
2158 (defconst display-minibuffer-mode-in-minibuffer t)
|
|
|
2159
|
|
|
2160 (defvar minibuffer-window-selected nil)
|
|
|
2161
|
|
|
2162 (defun egg:select-window-hook (old new)
|
|
|
2163 (if (and (eq old (minibuffer-window))
|
|
|
2164 (not (eq new (minibuffer-window))))
|
|
|
2165 (save-excursion
|
|
|
2166 (set-buffer (window-buffer (minibuffer-window)))
|
|
110
|
2167 (set-minibuffer-preprompt nil)
|
|
|
2168 (setq egg:*mode-on* (default-value 'egg:*mode-on*)
|
|
70
|
2169 egg:*input-mode* (default-value 'egg:*input-mode*)
|
|
|
2170 egg:*in-fence-mode* (default-value 'egg:*in-fence-mode*))))
|
|
|
2171 (if (eq new (minibuffer-window))
|
|
|
2172 (setq minibuffer-window-selected t)
|
|
|
2173 (setq minibuffer-window-selected nil)))
|
|
|
2174
|
|
110
|
2175 (defun egg:minibuffer-entry-hook ()
|
|
|
2176 (setq minibuffer-window-selected t))
|
|
|
2177
|
|
|
2178 (defun egg:minibuffer-exit-hook ()
|
|
|
2179 "Call upon exit from minibufffer"
|
|
|
2180 (set-minibuffer-preprompt nil)
|
|
|
2181 (setq minibuffer-window-selected nil)
|
|
|
2182 (save-excursion
|
|
|
2183 (set-buffer (window-buffer (minibuffer-window)))
|
|
|
2184 (setq egg:*mode-on* (default-value 'egg:*mode-on*)
|
|
|
2185 egg:*input-mode* (default-value 'egg:*input-mode*)
|
|
|
2186 egg:*in-fence-mode* (default-value 'egg:*in-fence-mode*))))
|
|
|
2187
|
|
70
|
2188
|
|
|
2189 ;;;
|
|
|
2190 ;;;
|
|
|
2191 ;;;
|
|
|
2192
|
|
98
|
2193 (defvar its:*reset-modeline-format* nil)
|
|
|
2194
|
|
215
|
2195
|
|
70
|
2196
|
|
|
2197 ;;;
|
|
|
2198 ;;; minibuffer $B$G$N%b!<%II=<($r$9$k$?$a$K(B nemacs 4 $B$GDj5A$5$l$?(B
|
|
|
2199 ;;; minibuffer-preprompt $B$rMxMQ$9$k!%(B
|
|
|
2200 ;;;
|
|
|
2201
|
|
|
2202 (defconst egg:minibuffer-preprompt '("[" nil "]"))
|
|
|
2203
|
|
|
2204 (defun mode-line-egg-mode-update (str)
|
|
|
2205 (if (eq (current-buffer) (window-buffer (minibuffer-window)))
|
|
|
2206 (if display-minibuffer-mode-in-minibuffer
|
|
|
2207 (progn
|
|
|
2208 (aset (nth 0 egg:minibuffer-preprompt) 0
|
|
|
2209 (if its:*previous-map* ?\< ?\[))
|
|
|
2210 (setcar (nthcdr 1 egg:minibuffer-preprompt)
|
|
|
2211 str)
|
|
|
2212 (aset (nth 2 egg:minibuffer-preprompt) 0
|
|
|
2213 (if its:*previous-map* ?\> ?\]))
|
|
110
|
2214 (set-minibuffer-preprompt (concat
|
|
|
2215 (car egg:minibuffer-preprompt)
|
|
|
2216 (car (nthcdr 1 egg:minibuffer-preprompt))
|
|
|
2217 (car (nthcdr 2 egg:minibuffer-preprompt)))))
|
|
70
|
2218 (setq display-minibuffer-mode t
|
|
|
2219 mode-line-egg-mode-in-minibuffer str))
|
|
|
2220 (setq display-minibuffer-mode nil
|
|
|
2221 mode-line-egg-mode str))
|
|
|
2222 (redraw-modeline t))
|
|
|
2223
|
|
|
2224
|
|
|
2225 ;;;
|
|
|
2226 ;;; egg mode line display
|
|
|
2227 ;;;
|
|
|
2228
|
|
|
2229 (defvar alphabet-mode-indicator "aA")
|
|
|
2230 (defvar transparent-mode-indicator "--")
|
|
|
2231
|
|
|
2232 (defun egg:mode-line-display ()
|
|
|
2233 (mode-line-egg-mode-update
|
|
|
2234 (cond((and egg:*in-fence-mode* (not egg:*input-mode*))
|
|
|
2235 alphabet-mode-indicator)
|
|
|
2236 ((and egg:*mode-on* egg:*input-mode*)
|
|
|
2237 (map-indicator its:*current-map*))
|
|
|
2238 (t transparent-mode-indicator))))
|
|
|
2239
|
|
|
2240 (defun egg:toggle-egg-mode-on-off ()
|
|
|
2241 (interactive)
|
|
|
2242 (setq egg:*mode-on* (not egg:*mode-on*))
|
|
|
2243 (egg:mode-line-display))
|
|
|
2244
|
|
|
2245 (defun its:select-mode (name)
|
|
|
2246 (interactive (list (completing-read "ITS mode: " its:*mode-alist*)))
|
|
|
2247 (if (its:get-mode-map name)
|
|
|
2248 (progn
|
|
|
2249 (setq its:*current-map* (its:get-mode-map name))
|
|
|
2250 (egg:mode-line-display))
|
|
98
|
2251 (beep)))
|
|
70
|
2252
|
|
|
2253 (defvar its:*select-mode-menu* '(menu "Mode:" nil))
|
|
|
2254
|
|
|
2255 (defun its:select-mode-from-menu ()
|
|
|
2256 (interactive)
|
|
|
2257 (setcar (nthcdr 2 its:*select-mode-menu*) its:*mode-alist*)
|
|
|
2258 (setq its:*current-map* (menu:select-from-menu its:*select-mode-menu*))
|
|
|
2259 (egg:mode-line-display))
|
|
|
2260
|
|
|
2261 (defvar its:*standard-modes* nil
|
|
|
2262 "List of standard mode-map of EGG."
|
|
|
2263 ;; 92.3.13 by K.Handa
|
|
|
2264 ;; moved to each language specific setup files (japanese.el, ...)
|
|
|
2265 ;; (list (its:get-mode-map "roma-kana")
|
|
|
2266 ;; (its:get-mode-map "roma-kata")
|
|
|
2267 ;; (its:get-mode-map "downcase")
|
|
|
2268 ;; (its:get-mode-map "upcase")
|
|
|
2269 ;; (its:get-mode-map "zenkaku-downcase")
|
|
|
2270 ;; (its:get-mode-map "zenkaku-upcase"))
|
|
|
2271 )
|
|
|
2272
|
|
|
2273 (defun its:find (map list)
|
|
|
2274 (let ((n 0))
|
|
|
2275 (while (and list (not (eq map (car list))))
|
|
|
2276 (setq list (cdr list)
|
|
|
2277 n (1+ n)))
|
|
|
2278 (if list n nil)))
|
|
|
2279
|
|
|
2280 (defun its:next-mode ()
|
|
|
2281 (interactive)
|
|
|
2282 (let ((pos (its:find its:*current-map* its:*standard-modes*)))
|
|
|
2283 (setq its:*current-map*
|
|
|
2284 (nth (% (1+ pos) (length its:*standard-modes*))
|
|
|
2285 its:*standard-modes*))
|
|
|
2286 (egg:mode-line-display)))
|
|
|
2287
|
|
|
2288 (defun its:previous-mode ()
|
|
|
2289 (interactive)
|
|
|
2290 (let ((pos (its:find its:*current-map* its:*standard-modes*)))
|
|
|
2291 (setq its:*current-map*
|
|
|
2292 (nth (1- (if (= pos 0) (length its:*standard-modes*) pos))
|
|
|
2293 its:*standard-modes*))
|
|
|
2294 (egg:mode-line-display)))
|
|
|
2295
|
|
|
2296 (defun its:select-hiragana () (interactive) (its:select-mode "roma-kana"))
|
|
|
2297 (defun its:select-katakana () (interactive) (its:select-mode "roma-kata"))
|
|
|
2298 (defun its:select-downcase () (interactive) (its:select-mode "downcase"))
|
|
|
2299 (defun its:select-upcase () (interactive) (its:select-mode "upcase"))
|
|
|
2300 (defun its:select-zenkaku-downcase () (interactive) (its:select-mode "zenkaku-downcase"))
|
|
|
2301 (defun its:select-zenkaku-upcase () (interactive) (its:select-mode "zenkaku-upcase"))
|
|
|
2302
|
|
|
2303 (defun its:select-mode-temporally (name)
|
|
|
2304 (interactive (list (completing-read "ITS mode: " its:*mode-alist*)))
|
|
|
2305 (let ((map (its:get-mode-map name)))
|
|
|
2306 (if map
|
|
|
2307 (progn
|
|
|
2308 (if (null its:*previous-map*)
|
|
|
2309 (setq its:*previous-map* its:*current-map*))
|
|
|
2310 (setq its:*current-map* map)
|
|
|
2311 (egg:mode-line-display))
|
|
|
2312 (beep))))
|
|
|
2313
|
|
|
2314 (defun its:select-previous-mode ()
|
|
|
2315 (interactive)
|
|
|
2316 (if (null its:*previous-map*)
|
|
|
2317 (beep)
|
|
|
2318 (setq its:*current-map* its:*previous-map*
|
|
|
2319 its:*previous-map* nil)
|
|
|
2320 (egg:mode-line-display)))
|
|
|
2321
|
|
|
2322
|
|
|
2323 (defun toggle-egg-mode ()
|
|
|
2324 (interactive)
|
|
98
|
2325 (if egg:*mode-on* (fence-toggle-egg-mode)
|
|
|
2326 (progn
|
|
|
2327 (setq egg:*mode-on* t)
|
|
|
2328 (egg:mode-line-display))))
|
|
70
|
2329
|
|
|
2330 (defun fence-toggle-egg-mode ()
|
|
|
2331 (interactive)
|
|
|
2332 (if its:*current-map*
|
|
|
2333 (progn
|
|
|
2334 (setq egg:*input-mode* (not egg:*input-mode*))
|
|
|
2335 (egg:mode-line-display))
|
|
|
2336 (beep)))
|
|
|
2337
|
|
|
2338 ;;;
|
|
|
2339 ;;; Changes on Global map
|
|
|
2340 ;;;
|
|
|
2341
|
|
|
2342 (defvar si:*global-map* (copy-keymap global-map))
|
|
|
2343
|
|
|
2344 (substitute-key-definition 'self-insert-command
|
|
|
2345 'egg-self-insert-command
|
|
|
2346 global-map)
|
|
|
2347
|
|
114
|
2348 ;; wire us into pending-delete
|
|
|
2349 (put 'egg-self-insert-command 'pending-delete t)
|
|
|
2350
|
|
70
|
2351 ;;;
|
|
|
2352 ;;; Currently entries C-\ and C-^ at global-map are undefined.
|
|
|
2353 ;;;
|
|
|
2354
|
|
207
|
2355 ;; Make this no-op if LEIM interface is used.
|
|
|
2356 (cond ((featurep 'egg-leim) t)
|
|
|
2357 (t (define-key global-map "\C-\\" 'toggle-egg-mode)) )
|
|
|
2358 ;; #### Should hide bindings like this, too? However, `convert-region'
|
|
|
2359 ;; probably isn't going to be a LEIM feature, it's really pretty
|
|
|
2360 ;; Japanese and Korean specific.
|
|
70
|
2361 (define-key global-map "\C-x " 'henkan-region)
|
|
|
2362
|
|
|
2363 ;; 92.3.16 by K.Handa
|
|
|
2364 ;; global-map => mule-keymap
|
|
|
2365 (define-key mule-keymap "m" 'its:select-mode-from-menu)
|
|
|
2366 (define-key mule-keymap ">" 'its:next-mode)
|
|
|
2367 (define-key mule-keymap "<" 'its:previous-mode)
|
|
|
2368 (define-key mule-keymap "h" 'its:select-hiragana)
|
|
|
2369 (define-key mule-keymap "k" 'its:select-katakana)
|
|
|
2370 (define-key mule-keymap "q" 'its:select-downcase)
|
|
|
2371 (define-key mule-keymap "Q" 'its:select-upcase)
|
|
|
2372 (define-key mule-keymap "z" 'its:select-zenkaku-downcase)
|
|
|
2373 (define-key mule-keymap "Z" 'its:select-zenkaku-upcase)
|
|
|
2374
|
|
|
2375 ;;;
|
|
114
|
2376 ;;; auto fill control
|
|
70
|
2377 ;;;
|
|
|
2378
|
|
|
2379 (defun egg:do-auto-fill ()
|
|
|
2380 (if (and auto-fill-function (not buffer-read-only)
|
|
|
2381 (> (current-column) fill-column))
|
|
|
2382 (let ((ocolumn (current-column)))
|
|
|
2383 (funcall auto-fill-function)
|
|
|
2384 (while (and (< fill-column (current-column))
|
|
|
2385 (< (current-column) ocolumn))
|
|
|
2386 (setq ocolumn (current-column))
|
|
|
2387 (funcall auto-fill-function)))))
|
|
|
2388
|
|
|
2389 ;;;----------------------------------------------------------------------
|
|
|
2390 ;;;
|
|
|
2391 ;;; Egg fence mode
|
|
|
2392 ;;;
|
|
|
2393 ;;;----------------------------------------------------------------------
|
|
|
2394
|
|
|
2395 (defconst egg:*fence-open* "|" "*$B%U%'%s%9$N;OE@$r<($9J8;zNs(B")
|
|
|
2396 (defconst egg:*fence-close* "|" "*$B%U%'%s%9$N=*E@$r<($9J8;zNs(B")
|
|
|
2397 (defconst egg:*fence-face* nil "*$B%U%'%s%9I=<($KMQ$$$k(B face $B$^$?$O(B nil")
|
|
|
2398 (make-variable-buffer-local
|
|
98
|
2399 (defvar egg:*fence-extent* nil "$B%U%'%s%9I=<(MQ(B extent"))
|
|
70
|
2400
|
|
|
2401 (defvar egg:*face-alist*
|
|
|
2402 '(("nil" . nil)
|
|
|
2403 ("highlight" . highlight) ("modeline" . modeline)
|
|
|
2404 ("inverse" . modeline) ("underline" . underline) ("bold" . bold)
|
|
|
2405 ("region" . region)))
|
|
|
2406
|
|
|
2407 (defun set-egg-fence-mode-format (open close &optional face)
|
|
|
2408 "fence mode $B$NI=<(J}K!$r@_Dj$9$k!#(BOPEN $B$O%U%'%s%9$N;OE@$r<($9J8;zNs$^$?$O(B nil$B!#(B\n\
|
|
|
2409 CLOSE$B$O%U%'%s%9$N=*E@$r<($9J8;zNs$^$?$O(B nil$B!#(B\n\
|
|
|
2410 $BBh(B3$B0z?t(B FACE $B$,;XDj$5$l$F(B nil $B$G$J$1$l$P!"%U%'%s%96h4V$NI=<($K$=$l$r;H$&!#(B"
|
|
|
2411 (interactive (list (read-string "$B%U%'%s%93+;OJ8;zNs(B: ")
|
|
|
2412 (read-string "$B%U%'%s%9=*N;J8;zNs(B: ")
|
|
|
2413 (cdr (assoc (completing-read "$B%U%'%s%9I=<(B0@-(B: " egg:*face-alist*)
|
|
|
2414 egg:*face-alist*))))
|
|
|
2415
|
|
|
2416 (if (and (or (stringp open) (null open))
|
|
|
2417 (or (stringp close) (null close))
|
|
|
2418 (or (null face) (memq face (face-list))))
|
|
|
2419 (progn
|
|
|
2420 (setq egg:*fence-open* (or open "")
|
|
|
2421 egg:*fence-close* (or close "")
|
|
|
2422 egg:*fence-face* face)
|
|
98
|
2423 (if (extentp egg:*fence-extent*)
|
|
|
2424 (set-extent-property egg:*fence-extent* 'face egg:*fence-face*))
|
|
70
|
2425 t)
|
|
|
2426 (error "Wrong type of argument: %s %s %s" open close face)))
|
|
|
2427
|
|
|
2428 (defvar egg:*region-start* nil)
|
|
|
2429 (make-variable-buffer-local 'egg:*region-start*)
|
|
98
|
2430 (set-default 'egg:*region-start* nil)
|
|
|
2431 (defvar egg:*region-end* nil)
|
|
70
|
2432 (make-variable-buffer-local 'egg:*region-end*)
|
|
|
2433 (set-default 'egg:*region-end* nil)
|
|
|
2434 (defvar egg:*global-map-backup* nil)
|
|
|
2435 (defvar egg:*local-map-backup* nil)
|
|
|
2436
|
|
|
2437
|
|
|
2438 ;;; Moved to kanji.el
|
|
|
2439 ;;; (defvar self-insert-after-hook nil
|
|
|
2440 ;;; "Hook to run when extended self insertion command exits. Should take
|
|
|
2441 ;;; two arguments START and END correspoding to character position.")
|
|
|
2442
|
|
|
2443 (defvar egg:*self-insert-non-undo-count* 0
|
|
|
2444 "counter to hold repetition of egg-self-insert-command.")
|
|
|
2445
|
|
|
2446 (defun egg-self-insert-command (arg)
|
|
|
2447 (interactive "p")
|
|
|
2448 (if (and (not buffer-read-only)
|
|
|
2449 egg:*mode-on* egg:*input-mode*
|
|
|
2450 (not egg:*in-fence-mode*) ;;; inhibit recursive fence mode
|
|
98
|
2451 (not (= (event-to-character last-command-event) ? )))
|
|
70
|
2452 (egg:enter-fence-mode-and-self-insert)
|
|
|
2453 (progn
|
|
|
2454 ;; treat continuous 20 self insert as a single undo chunk.
|
|
|
2455 ;; `20' is a magic number copied from keyboard.c
|
|
|
2456 (if (or ;92.12.20 by T.Enami
|
|
|
2457 (not (eq last-command 'egg-self-insert-command))
|
|
|
2458 (>= egg:*self-insert-non-undo-count* 20))
|
|
|
2459 (setq egg:*self-insert-non-undo-count* 1)
|
|
|
2460 (cancel-undo-boundary)
|
|
|
2461 (setq egg:*self-insert-non-undo-count*
|
|
|
2462 (1+ egg:*self-insert-non-undo-count*)))
|
|
|
2463 (self-insert-command arg)
|
|
|
2464 (if egg-insert-after-hook
|
|
|
2465 (run-hooks 'egg-insert-after-hook))
|
|
|
2466 (if self-insert-after-hook
|
|
|
2467 (if (<= 1 arg)
|
|
|
2468 (funcall self-insert-after-hook
|
|
|
2469 (- (point) arg) (point)))
|
|
98
|
2470 (if (= (event-to-character last-command-event) ? ) (egg:do-auto-fill))))))
|
|
70
|
2471
|
|
|
2472 ;;
|
|
|
2473 ;; $BA03NDjJQ49=hM}4X?t(B
|
|
|
2474 ;;
|
|
|
2475 (defvar egg:*fence-open-backup* nil)
|
|
|
2476 (defvar egg:*fence-close-backup* nil)
|
|
|
2477 (defvar egg:*fence-face-backup* nil)
|
|
|
2478
|
|
|
2479 (defconst egg:*fence-open-in-cont* "+" "*$BA03NDj>uBV$G$N(B *fence-open*")
|
|
|
2480 (defconst egg:*fence-close-in-cont* t "*$BA03NDj>uBV$G$N(B *fence-close*")
|
|
|
2481 (defconst egg:*fence-face-in-cont* t
|
|
|
2482 "*$BA03NDj>uBV$G$N(B *fence-face*")
|
|
|
2483
|
|
|
2484 (defun set-egg-fence-mode-format-in-cont (open close face)
|
|
|
2485 "$BA03NDj>uBV$G$N(B fence mode $B$NI=<(J}K!$r@_Dj$9$k!#(BOPEN $B$O%U%'%s%9$N;OE@$r<($9J8(B
|
|
|
2486 $B;zNs!"(Bt $B$^$?$O(B nil$B!#(B\n\
|
|
|
2487 CLOSE$B$O%U%'%s%9$N=*E@$r<($9J8;zNs!"(Bt $B$^$?$O(B nil$B!#(B\n\
|
|
|
2488 FACE $B$O(B nil $B$G$J$1$l$P!"%U%'%s%96h4V$NI=<($K$=$l$r;H$&!#(B\n\
|
|
|
2489 $B$=$l$>$l$NCM$,(B t $B$N>l9g!"DL>o$N(B egg:*fence-open* $BEy$NCM$r0z$-7Q$0!#(B"
|
|
|
2490 (interactive (list (read-string "$B%U%'%s%93+;OJ8;zNs(B: ")
|
|
|
2491 (read-string "$B%U%'%s%9=*N;J8;zNs(B: ")
|
|
|
2492 (cdr (assoc (completing-read "$B%U%'%s%9I=<(B0@-(B: " egg:*face
|
|
|
2493 -alist*)
|
|
|
2494 egg:*face-alist*))))
|
|
|
2495
|
|
|
2496 (if (and (or (stringp open) (eq open t) (null open))
|
|
|
2497 (or (stringp close) (eq close t) (null close))
|
|
|
2498 (or (null face) (eq face t) (memq face (face-list))))
|
|
|
2499 (progn
|
|
|
2500 (setq egg:*fence-open-in-cont* (or open "")
|
|
|
2501 egg:*fence-close-in-cont* (or close "")
|
|
|
2502 egg:*fence-face-in-cont* face)
|
|
98
|
2503 (if (extentp egg:*fence-extent*)
|
|
|
2504 (set-extent-property egg:*fence-extent* 'face egg:*fence-face*))
|
|
70
|
2505 t)
|
|
|
2506 (error "Wrong type of argument: %s %s %s" open close face)))
|
|
|
2507
|
|
|
2508 (defvar *in-cont-flag* nil
|
|
|
2509 "$BD>A0$KJQ49$7$?D>8e$NF~NO$+$I$&$+$r<($9!#(B")
|
|
|
2510
|
|
|
2511 (defvar *in-cont-backup-flag* nil)
|
|
|
2512
|
|
|
2513 (defun egg:check-fence-in-cont ()
|
|
|
2514 (if *in-cont-flag*
|
|
|
2515 (progn
|
|
|
2516 (setq *in-cont-backup-flag* t)
|
|
|
2517 (setq egg:*fence-open-backup* egg:*fence-open*)
|
|
|
2518 (setq egg:*fence-close-backup* egg:*fence-close*)
|
|
|
2519 (setq egg:*fence-face-backup* egg:*fence-face*)
|
|
|
2520 (or (eq egg:*fence-open-in-cont* t)
|
|
|
2521 (setq egg:*fence-open* egg:*fence-open-in-cont*))
|
|
|
2522 (or (eq egg:*fence-close-in-cont* t)
|
|
|
2523 (setq egg:*fence-close* egg:*fence-close-in-cont*))
|
|
|
2524 (or (eq egg:*fence-face-in-cont* t)
|
|
|
2525 (setq egg:*fence-face* egg:*fence-face-in-cont*)))))
|
|
|
2526
|
|
|
2527 (defun egg:restore-fence-in-cont ()
|
|
|
2528 "Restore egg:*fence-open* and egg:*fence-close*"
|
|
|
2529 (if *in-cont-backup-flag*
|
|
|
2530 (progn
|
|
|
2531 (setq egg:*fence-open* egg:*fence-open-backup*)
|
|
|
2532 (setq egg:*fence-close* egg:*fence-close-backup*)
|
|
|
2533 (setq egg:*fence-face* egg:*fence-face-backup*)))
|
|
|
2534 (setq *in-cont-backup-flag* nil)
|
|
|
2535 )
|
|
|
2536
|
|
|
2537 (defun egg:enter-fence-mode-and-self-insert ()
|
|
|
2538 (setq *in-cont-flag*
|
|
|
2539 (memq last-command '(henkan-kakutei henkan-kakutei-and-self-insert)))
|
|
|
2540 (enter-fence-mode)
|
|
|
2541 (setq unread-command-events (list last-command-event)))
|
|
|
2542
|
|
|
2543 (defun egg:fence-face-on ()
|
|
|
2544 (if egg:*fence-face*
|
|
|
2545 (progn
|
|
98
|
2546 (if (extentp egg:*fence-extent*)
|
|
153
|
2547 (set-extent-endpoints egg:*fence-extent* egg:*region-start* egg:*region-end*)
|
|
|
2548 (setq egg:*fence-extent* (make-extent egg:*region-start* egg:*region-end*))
|
|
|
2549 (set-extent-property egg:*fence-extent* 'start-open nil)
|
|
|
2550 (set-extent-property egg:*fence-extent* 'end-open nil)
|
|
|
2551 (set-extent-property egg:*fence-extent* 'detachable nil))
|
|
|
2552 (set-extent-face egg:*fence-extent* egg:*fence-face*))))
|
|
70
|
2553
|
|
|
2554 (defun egg:fence-face-off ()
|
|
|
2555 (and egg:*fence-face*
|
|
98
|
2556 (extentp egg:*fence-extent*)
|
|
|
2557 (detach-extent egg:*fence-extent*) ))
|
|
70
|
2558
|
|
|
2559 (defun enter-fence-mode ()
|
|
215
|
2560
|
|
70
|
2561 ;; XEmacs change:
|
|
114
|
2562 ; (buffer-disable-undo (current-buffer))
|
|
|
2563 (undo-boundary)
|
|
140
|
2564 (setq egg:*in-fence-mode* t
|
|
|
2565 egg:fence-buffer (current-buffer))
|
|
70
|
2566 (egg:mode-line-display)
|
|
|
2567 ;;;(setq egg:*global-map-backup* (current-global-map))
|
|
|
2568 (setq egg:*local-map-backup* (current-local-map))
|
|
|
2569 ;;;(use-global-map fence-mode-map)
|
|
|
2570 ;;;(use-local-map nil)
|
|
|
2571 (use-local-map fence-mode-map)
|
|
|
2572 (egg:check-fence-in-cont) ; for Wnn6
|
|
|
2573 (insert egg:*fence-open*)
|
|
|
2574 (or (markerp egg:*region-start*) (setq egg:*region-start* (make-marker)))
|
|
|
2575 (set-marker egg:*region-start* (point))
|
|
|
2576 (insert egg:*fence-close*)
|
|
98
|
2577 (or (markerp egg:*region-end*) (set-marker-insertion-type (setq egg:*region-end* (make-marker)) t))
|
|
70
|
2578 (set-marker egg:*region-end* egg:*region-start*)
|
|
|
2579 (egg:fence-face-on)
|
|
|
2580 (goto-char egg:*region-start*)
|
|
142
|
2581 (add-hook 'post-command-hook 'fence-post-command-hook)
|
|
70
|
2582 )
|
|
|
2583
|
|
|
2584 (defun henkan-fence-region-or-single-space ()
|
|
|
2585 (interactive)
|
|
|
2586 (if egg:*input-mode*
|
|
|
2587 (henkan-fence-region)
|
|
|
2588 (insert ? )))
|
|
|
2589
|
|
|
2590 (defvar egg:*henkan-fence-mode* nil)
|
|
|
2591
|
|
|
2592 (defun henkan-fence-region ()
|
|
|
2593 (interactive)
|
|
|
2594 (setq egg:*henkan-fence-mode* t)
|
|
|
2595 (egg:fence-face-off)
|
|
|
2596 (henkan-region-internal egg:*region-start* egg:*region-end* ))
|
|
|
2597
|
|
|
2598 (defun fence-katakana ()
|
|
|
2599 (interactive)
|
|
|
2600 (katakana-region egg:*region-start* egg:*region-end* ))
|
|
|
2601
|
|
|
2602 (defun fence-hiragana ()
|
|
|
2603 (interactive)
|
|
|
2604 (hiragana-region egg:*region-start* egg:*region-end*))
|
|
|
2605
|
|
|
2606 (defun fence-hankaku ()
|
|
|
2607 (interactive)
|
|
|
2608 (hankaku-region egg:*region-start* egg:*region-end*))
|
|
|
2609
|
|
|
2610 (defun fence-zenkaku ()
|
|
|
2611 (interactive)
|
|
|
2612 (zenkaku-region egg:*region-start* egg:*region-end*))
|
|
|
2613
|
|
|
2614 (defun fence-backward-char ()
|
|
|
2615 (interactive)
|
|
|
2616 (if (< egg:*region-start* (point))
|
|
|
2617 (backward-char)
|
|
|
2618 (beep)))
|
|
|
2619
|
|
|
2620 (defun fence-forward-char ()
|
|
|
2621 (interactive)
|
|
|
2622 (if (< (point) egg:*region-end*)
|
|
|
2623 (forward-char)
|
|
|
2624 (beep)))
|
|
|
2625
|
|
|
2626 (defun fence-beginning-of-line ()
|
|
|
2627 (interactive)
|
|
|
2628 (goto-char egg:*region-start*))
|
|
|
2629
|
|
|
2630 (defun fence-end-of-line ()
|
|
|
2631 (interactive)
|
|
|
2632 (goto-char egg:*region-end*))
|
|
|
2633
|
|
|
2634 (defun fence-transpose-chars (arg)
|
|
|
2635 (interactive "P")
|
|
|
2636 (if (and (< egg:*region-start* (point))
|
|
|
2637 (< (point) egg:*region-end*))
|
|
|
2638 (transpose-chars arg)
|
|
|
2639 (beep)))
|
|
|
2640
|
|
|
2641 (defun egg:exit-if-empty-region ()
|
|
|
2642 (if (= egg:*region-start* egg:*region-end*)
|
|
142
|
2643 (fence-exit-internal)))
|
|
70
|
2644
|
|
|
2645 (defun fence-delete-char ()
|
|
|
2646 (interactive)
|
|
|
2647 (if (< (point) egg:*region-end*)
|
|
|
2648 (progn
|
|
|
2649 (delete-char 1)
|
|
|
2650 (egg:exit-if-empty-region))
|
|
|
2651 (beep)))
|
|
|
2652
|
|
|
2653 (defun fence-backward-delete-char ()
|
|
|
2654 (interactive)
|
|
|
2655 (if (< egg:*region-start* (point))
|
|
|
2656 (progn
|
|
|
2657 (delete-char -1)
|
|
|
2658 (egg:exit-if-empty-region))
|
|
|
2659 (beep)))
|
|
|
2660
|
|
|
2661 (defun fence-kill-line ()
|
|
|
2662 (interactive)
|
|
|
2663 (delete-region (point) egg:*region-end*)
|
|
|
2664 (egg:exit-if-empty-region))
|
|
|
2665
|
|
|
2666 (defun fence-exit-mode ()
|
|
|
2667 (interactive)
|
|
142
|
2668 (fence-exit-internal))
|
|
|
2669
|
|
|
2670 (defun fence-exit-internal ()
|
|
183
|
2671 (egg:fence-face-off)
|
|
70
|
2672 (delete-region (- egg:*region-start* (length egg:*fence-open*)) egg:*region-start*)
|
|
|
2673 (delete-region egg:*region-end* (+ egg:*region-end* (length egg:*fence-close*)))
|
|
|
2674 (if its:*previous-map*
|
|
|
2675 (setq its:*current-map* its:*previous-map*
|
|
|
2676 its:*previous-map* nil))
|
|
|
2677 (egg:quit-egg-mode))
|
|
|
2678
|
|
114
|
2679 ;; jhod: This seems bogus to me, as it should be called either after each
|
|
|
2680 ;; egg-self-insert, or after accepting input, but not both. Otherwise, I can't
|
|
|
2681 ;; really think of a use for it.
|
|
215
|
2682 (defvar egg-insert-after-hook nil
|
|
|
2683 "Hook to run when egg inserts a character in the buffer")
|
|
|
2684
|
|
70
|
2685 (make-variable-buffer-local 'egg-insert-after-hook)
|
|
|
2686
|
|
|
2687 (defvar egg-exit-hook nil
|
|
|
2688 "Hook to run when egg exits. Should take two arguments START and END
|
|
|
2689 correspoding to character position.")
|
|
|
2690
|
|
|
2691 (defun egg:quit-egg-mode ()
|
|
|
2692 ;;;(use-global-map egg:*global-map-backup*)
|
|
|
2693 (use-local-map egg:*local-map-backup*)
|
|
142
|
2694 (remove-hook 'post-command-hook 'fence-post-command-hook)
|
|
70
|
2695 (setq egg:*in-fence-mode* nil)
|
|
|
2696 (egg:mode-line-display)
|
|
|
2697 (if overwrite-mode
|
|
|
2698 (let ((str (buffer-substring egg:*region-end* egg:*region-start*)))
|
|
|
2699 (delete-text-in-column nil (+ (current-column) (string-width str)))))
|
|
|
2700 (egg:restore-fence-in-cont) ; for Wnn6
|
|
|
2701 (setq egg:*henkan-fence-mode* nil)
|
|
|
2702 (if self-insert-after-hook
|
|
|
2703 (funcall self-insert-after-hook egg:*region-start* egg:*region-end*)
|
|
|
2704 (if egg-exit-hook
|
|
|
2705 (funcall egg-exit-hook egg:*region-start* egg:*region-end*)
|
|
|
2706 (if (not (= egg:*region-start* egg:*region-end*))
|
|
|
2707 (egg:do-auto-fill))))
|
|
|
2708 (set-marker egg:*region-start* nil)
|
|
|
2709 (set-marker egg:*region-end* nil)
|
|
|
2710 ;; XEmacs change:
|
|
114
|
2711 ; (buffer-enable-undo (current-buffer))
|
|
70
|
2712 (if egg-insert-after-hook
|
|
|
2713 (run-hooks 'egg-insert-after-hook))
|
|
|
2714 )
|
|
|
2715
|
|
|
2716 (defun fence-cancel-input ()
|
|
142
|
2717 "Cancel all fence operations in the current buffer"
|
|
70
|
2718 (interactive)
|
|
142
|
2719 (fence-kill-operation))
|
|
|
2720
|
|
|
2721 (defun fence-kill-operation ()
|
|
|
2722 "Internal method to remove fences"
|
|
70
|
2723 (delete-region egg:*region-start* egg:*region-end*)
|
|
142
|
2724 (fence-exit-internal))
|
|
|
2725
|
|
|
2726 (defun fence-post-command-hook ()
|
|
|
2727 ;; For use as the value of `post-command-hook' when fence is active.
|
|
|
2728 ;; If we got out of the region specified by the fence,
|
|
140
|
2729 ;; kill the fence before that command is executed.
|
|
|
2730 ;;
|
|
|
2731 (cond ((not (eq (current-buffer) egg:fence-buffer))
|
|
|
2732 ;; If the buffer (likely meaning "frame") has changed, bail.
|
|
|
2733 ;; This can also happen if a proc filter has popped up another
|
|
|
2734 ;; buffer, which is arguably a bad thing for it to have done,
|
|
|
2735 ;; but the way in which egg would have hosed you in that
|
|
|
2736 ;; case is unarguably even worse.
|
|
|
2737 (save-excursion
|
|
|
2738 (set-buffer egg:fence-buffer)
|
|
|
2739 (its:reset-input)
|
|
142
|
2740 (fence-kill-operation)))
|
|
|
2741 ((or (< (point) egg:*region-start*)
|
|
|
2742 (> (point) egg:*region-end*))
|
|
|
2743 (save-excursion
|
|
|
2744 (its:reset-input)
|
|
|
2745 (fence-kill-operation)))))
|
|
140
|
2746
|
|
138
|
2747 (defun egg-lang-switch-callback ()
|
|
|
2748 "Do whatever processing is necessary when the language-environment changes."
|
|
|
2749 (if egg:*in-fence-mode*
|
|
|
2750 (progn
|
|
|
2751 (its:reset-input)
|
|
142
|
2752 (fence-kill-operation)))
|
|
138
|
2753 (let ((func (get current-language-environment 'set-egg-environ)))
|
|
|
2754 (if (not (null func))
|
|
140
|
2755 (funcall func)))
|
|
|
2756 (egg:mode-line-display))
|
|
138
|
2757
|
|
70
|
2758 (defun fence-mode-help-command ()
|
|
215
|
2759 "Display fence mode help"
|
|
|
2760 (interactive "_")
|
|
|
2761 (let ((w (selected-window)))
|
|
|
2762 (describe-function 'egg-mode)
|
|
|
2763 (ding)
|
|
|
2764 (select-window w)))
|
|
70
|
2765
|
|
|
2766 (defvar fence-mode-map (make-keymap))
|
|
|
2767
|
|
98
|
2768 (substitute-key-definition 'egg-self-insert-command
|
|
70
|
2769 'fence-self-insert-command
|
|
|
2770 fence-mode-map global-map)
|
|
|
2771
|
|
|
2772 (define-key fence-mode-map "\eh" 'fence-hiragana)
|
|
|
2773 (define-key fence-mode-map "\ek" 'fence-katakana)
|
|
|
2774 (define-key fence-mode-map "\e<" 'fence-hankaku)
|
|
|
2775 (define-key fence-mode-map "\e>" 'fence-zenkaku)
|
|
|
2776 (define-key fence-mode-map "\e\C-h" 'its:select-hiragana)
|
|
|
2777 (define-key fence-mode-map "\e\C-k" 'its:select-katakana)
|
|
|
2778 (define-key fence-mode-map "\eq" 'its:select-downcase)
|
|
|
2779 (define-key fence-mode-map "\eQ" 'its:select-upcase)
|
|
|
2780 (define-key fence-mode-map "\ez" 'its:select-zenkaku-downcase)
|
|
|
2781 (define-key fence-mode-map "\eZ" 'its:select-zenkaku-upcase)
|
|
|
2782 (define-key fence-mode-map " " 'henkan-fence-region-or-single-space)
|
|
|
2783 (define-key fence-mode-map "\C-@" 'henkan-fence-region)
|
|
|
2784 (define-key fence-mode-map [(control \ )] 'henkan-fence-region)
|
|
|
2785 (define-key fence-mode-map "\C-a" 'fence-beginning-of-line)
|
|
|
2786 (define-key fence-mode-map "\C-b" 'fence-backward-char)
|
|
|
2787 (define-key fence-mode-map "\C-c" 'fence-cancel-input)
|
|
|
2788 (define-key fence-mode-map "\C-d" 'fence-delete-char)
|
|
|
2789 (define-key fence-mode-map "\C-e" 'fence-end-of-line)
|
|
|
2790 (define-key fence-mode-map "\C-f" 'fence-forward-char)
|
|
|
2791 (define-key fence-mode-map "\C-g" 'fence-cancel-input)
|
|
|
2792 (define-key fence-mode-map "\C-k" 'fence-kill-line)
|
|
|
2793 (define-key fence-mode-map "\C-l" 'fence-exit-mode)
|
|
|
2794 (define-key fence-mode-map "\C-m" 'fence-exit-mode) ;;; RET
|
|
|
2795 (define-key fence-mode-map [return] 'fence-exit-mode)
|
|
|
2796 (define-key fence-mode-map "\C-q" 'its:select-previous-mode)
|
|
|
2797 (define-key fence-mode-map "\C-t" 'fence-transpose-chars)
|
|
|
2798 (define-key fence-mode-map "\C-w" 'henkan-fence-region)
|
|
|
2799 (define-key fence-mode-map "\C-z" 'eval-expression)
|
|
|
2800 (define-key fence-mode-map "\C-\\" 'fence-toggle-egg-mode)
|
|
|
2801 (define-key fence-mode-map "\C-_" 'jis-code-input)
|
|
|
2802 (define-key fence-mode-map "\177" 'fence-backward-delete-char)
|
|
|
2803 (define-key fence-mode-map [delete] 'fence-backward-delete-char)
|
|
215
|
2804 (define-key fence-mode-map 'backspace 'fence-backward-delete-char)
|
|
|
2805 (define-key fence-mode-map '(control h) 'fence-mode-help-command)
|
|
70
|
2806 (define-key fence-mode-map [right] 'fence-forward-char)
|
|
|
2807 (define-key fence-mode-map [left] 'fence-backward-char)
|
|
|
2808
|
|
|
2809 ;;;----------------------------------------------------------------------
|
|
|
2810 ;;;
|
|
|
2811 ;;; Read hiragana from minibuffer
|
|
|
2812 ;;;
|
|
|
2813 ;;;----------------------------------------------------------------------
|
|
|
2814
|
|
|
2815 (defvar egg:*minibuffer-local-hiragana-map* (copy-keymap minibuffer-local-map))
|
|
|
2816
|
|
|
2817 (substitute-key-definition 'self-insert-command
|
|
|
2818 'fence-self-insert-command
|
|
|
2819 egg:*minibuffer-local-hiragana-map*
|
|
|
2820 minibuffer-local-map)
|
|
|
2821
|
|
|
2822 (defun read-hiragana-string (prompt &optional initial-input)
|
|
|
2823 (save-excursion
|
|
|
2824 (let ((minibuff (window-buffer (minibuffer-window))))
|
|
|
2825 (set-buffer minibuff)
|
|
|
2826 (setq egg:*input-mode* t
|
|
|
2827 egg:*mode-on* t
|
|
|
2828 its:*current-map* (its:get-mode-map "roma-kana"))
|
|
185
|
2829 (mode-line-egg-mode-update (its:get-mode-indicator "roma-kana"))))
|
|
70
|
2830 (read-from-minibuffer prompt initial-input
|
|
|
2831 egg:*minibuffer-local-hiragana-map*))
|
|
|
2832
|
|
|
2833 (defun read-kanji-string (prompt &optional initial-input)
|
|
|
2834 (save-excursion
|
|
|
2835 (let ((minibuff (window-buffer (minibuffer-window))))
|
|
|
2836 (set-buffer minibuff)
|
|
|
2837 (setq egg:*input-mode* t
|
|
|
2838 egg:*mode-on* t
|
|
|
2839 its:*current-map* (its:get-mode-map "roma-kana"))
|
|
|
2840 (mode-line-egg-mode-update (its:get-mode-indicator "roma-kana"))))
|
|
|
2841 (read-from-minibuffer prompt initial-input))
|
|
|
2842
|
|
|
2843 (defconst isearch:read-kanji-string 'read-kanji-string)
|
|
|
2844
|
|
|
2845 ;;; $B5-9fF~NO(B
|
|
|
2846
|
|
|
2847 (defvar special-symbol-input-point nil)
|
|
|
2848
|
|
|
2849 (defun special-symbol-input ()
|
|
|
2850 (interactive)
|
|
|
2851 (require 'egg-jsymbol)
|
|
|
2852 ;; 92.7.8 by Y.Kawabe
|
|
|
2853 (let ((item (menu:select-from-menu
|
|
|
2854 *symbol-input-menu* special-symbol-input-point t))
|
|
|
2855 (code t))
|
|
|
2856 (and (listp item)
|
|
|
2857 (setq code (car item) special-symbol-input-point (cdr item)))
|
|
|
2858 ;; end of patch
|
|
|
2859 (cond((stringp code) (insert code))
|
|
|
2860 ((consp code) (eval code))
|
|
|
2861 )))
|
|
|
2862
|
|
|
2863
|
|
138
|
2864 (autoload 'busyu-input "egg-busyu" nil t)
|
|
|
2865 (autoload 'kakusuu-input "egg-busyu" nil t)
|
|
70
|
2866
|
|
215
|
2867 (defun egg-mode ()
|
|
|
2868 "The keys that are defined for the fence mode in egg are:\\{fence-mode-map}"
|
|
|
2869 (interactive)
|
|
|
2870 (define-key global-map "\C-^" 'special-symbol-input)
|
|
|
2871 (if (not (egg:find-symbol-in-tree 'mode-line-egg-mode modeline-format))
|
|
|
2872 (setq-default
|
|
|
2873 modeline-format
|
|
|
2874 (cons (list 'display-minibuffer-mode-in-minibuffer
|
|
142
|
2875 ;;; minibuffer mode in minibuffer
|
|
215
|
2876 (list
|
|
|
2877 (list 'its:*previous-map* "<" "[")
|
|
|
2878 'mode-line-egg-mode
|
|
|
2879 (list 'its:*previous-map* ">" "]")
|
|
|
2880 )
|
|
142
|
2881 ;;;; minibuffer mode in mode line
|
|
215
|
2882 (list
|
|
|
2883 (list 'minibuffer-window-selected
|
|
|
2884 (list 'display-minibuffer-mode
|
|
|
2885 "m"
|
|
|
2886 " ")
|
|
|
2887 " ")
|
|
|
2888 (list 'its:*previous-map* "<" "[")
|
|
|
2889 (list 'minibuffer-window-selected
|
|
|
2890 (list 'display-minibuffer-mode
|
|
|
2891 'mode-line-egg-mode-in-minibuffer
|
|
|
2892 'mode-line-egg-mode)
|
|
|
2893 'mode-line-egg-mode)
|
|
|
2894 (list 'its:*previous-map* ">" "]")
|
|
|
2895 ))
|
|
|
2896 modeline-format)))
|
|
|
2897 ;; put us into the modeline of all existing buffers
|
|
|
2898 (mapc (lambda (buf)
|
|
|
2899 (save-excursion
|
|
|
2900 (set-buffer buf)
|
|
|
2901 (if (not (egg:find-symbol-in-tree 'mode-line-egg-mode modeline-format))
|
|
|
2902 (setq modeline-format
|
|
|
2903 (cons (list 'display-minibuffer-mode-in-minibuffer
|
|
|
2904 ;;; minibuffer mode in minibuffer
|
|
|
2905 (list
|
|
|
2906 (list 'its:*previous-map* "<" "[")
|
|
|
2907 'mode-line-egg-mode
|
|
|
2908 (list 'its:*previous-map* ">" "]")
|
|
|
2909 )
|
|
|
2910 ;;;; minibuffer mode in mode line
|
|
|
2911 (list
|
|
|
2912 (list 'minibuffer-window-selected
|
|
|
2913 (list 'display-minibuffer-mode
|
|
|
2914 "m"
|
|
|
2915 " ")
|
|
|
2916 " ")
|
|
|
2917 (list 'its:*previous-map* "<" "[")
|
|
|
2918 (list 'minibuffer-window-selected
|
|
|
2919 (list 'display-minibuffer-mode
|
|
|
2920 'mode-line-egg-mode-in-minibuffer
|
|
|
2921 'mode-line-egg-mode)
|
|
|
2922 'mode-line-egg-mode)
|
|
|
2923 (list 'its:*previous-map* ">" "]")
|
|
|
2924 ))
|
|
|
2925 modeline-format)))))
|
|
|
2926 (buffer-list))
|
|
|
2927 (if (boundp 'select-window-hook)
|
|
|
2928 (add-hook 'select-window-hook 'egg:select-window-hook)
|
|
|
2929 (add-hook 'minibuffer-exit-hook 'egg:minibuffer-exit-hook)
|
|
|
2930 (add-hook 'minibuffer-entry-hook 'egg:minibuffer-entry-hook))
|
|
|
2931 (mode-line-egg-mode-update mode-line-egg-mode)
|
|
|
2932 (if its:*reset-modeline-format*
|
|
|
2933 (setq-default modeline-format
|
|
|
2934 (cdr modeline-format)))
|
|
|
2935
|
|
|
2936 ;; if set-lang-environment has already been called,
|
|
|
2937 ;; call egg-lang-switch-callback
|
|
|
2938 (if (not (null current-language-environment))
|
|
|
2939 (egg-lang-switch-callback))
|
|
|
2940 )
|
|
142
|
2941
|
|
126
|
2942 (provide 'egg)
|
|
|
2943
|
|
70
|
2944 ;;; egg.el ends here
|
