Mercurial > hg > xemacs-beta

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

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b1
author cvs
date Mon, 13 Aug 2007 09:13:56 +0200
parents 131b0175ea99
children fe104dbd9147
comparison
equal deleted inserted replaced
97:498bf5da1c90 98:0d2f883870bc
59 ;;;=================================================================== 59 ;;;===================================================================
60 ;;; 60 ;;;
61 ;;; (eval-when (load) (require 'wnn-client)) 61 ;;; (eval-when (load) (require 'wnn-client))
62 ;;; 62 ;;;
63 63
64 (defvar egg-version "3.09" "Version number of this version of Egg. ") 64 ; last master version
65 ;;; (defvar egg-version "3.09" "Version number of this version of Egg. ")
65 ;;; Last modified date: Fri Sep 25 12:59:00 1992 66 ;;; Last modified date: Fri Sep 25 12:59:00 1992
67 (defvar egg-version "3.09 xemacs" "Version number of this version of Egg. ")
68 ;;; Last modified date: Wed Feb 05 20:45:00 1997
66 69
67 ;;;; $B=$@5MW5a%j%9%H(B 70 ;;;; $B=$@5MW5a%j%9%H(B
68 71
69 ;;;; 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 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
70 73
71 ;;;; $B=$@5%a%b(B 74 ;;;; $B=$@5%a%b(B
75
76 ;;; 97.2.05 modified by J.Hein <jhod@po.iijnet.or.jp>
77 ;;; Lots of mods to make it XEmacs workable. Most fixes revolve around the fact that
78 ;;; Mule/et al assumes that all events are keypress events unless specified otherwise.
79 ;;; Also modified to work with the new charset names and API
72 80
73 ;;; 95.6.5 modified by S.Tomura <tomura@etl.go.jp> 81 ;;; 95.6.5 modified by S.Tomura <tomura@etl.go.jp>
74 ;;; $BJQ49D>8e$KO"B3$7$FJQ49$9$k>l9g$rG'<1$9$k$?$a$K!"(B"-in-cont" $B$K4XO"$7$?(B 82 ;;; $BJQ49D>8e$KO"B3$7$FJQ49$9$k>l9g$rG'<1$9$k$?$a$K!"(B"-in-cont" $B$K4XO"$7$?(B
75 ;;; $BItJ,$rDI2C$7$?!#!J$3$NItJ,$O>-Mh:F=$@5$9$kM=Dj!#!K(B 83 ;;; $BItJ,$rDI2C$7$?!#!J$3$NItJ,$O>-Mh:F=$@5$9$kM=Dj!#!K(B
76 84
382 ;;;; Aug-25-88 menu command$B$K(B\C-l: redraw $B$rDI2C$7$?!#(B 390 ;;;; Aug-25-88 menu command$B$K(B\C-l: redraw $B$rDI2C$7$?!#(B
383 391
384 ;;;; Aug-25-88 toroku-region$B$GEPO?$9$kJ8;zNs$+$i(Bno graphic character$B$r(B 392 ;;;; Aug-25-88 toroku-region$B$GEPO?$9$kJ8;zNs$+$i(Bno graphic character$B$r(B
385 ;;;; $B<+F0E*$K=|$/$3$H$K$7$?!#(B 393 ;;;; $B<+F0E*$K=|$/$3$H$K$7$?!#(B
386 394
395 (provide 'egg)
396
387 ;; XEmacs addition: (and remove disable-undo variable) 397 ;; XEmacs addition: (and remove disable-undo variable)
388 ;; For Emacs V18/Nemacs compatibility 398 ;; For Emacs V18/Nemacs compatibility
389 (and (not (fboundp 'buffer-disable-undo)) 399 (and (not (fboundp 'buffer-disable-undo))
390 (fboundp 'buffer-flush-undo) 400 (fboundp 'buffer-flush-undo)
391 (defalias 'buffer-disable-undo 'buffer-flush-undo)) 401 (defalias 'buffer-disable-undo 'buffer-flush-undo))
402
403 ;; 97.2.4 Created by J.Hein to simulate Mule-2.3
404 (defun read-event ()
405 "Cheap 'n cheesy event filter to facilitate translation from Mule-2.3"
406 (setq event (make-event))
407 (while (progn
408 (next-event event)
409 (not (key-press-event-p event)))
410 (dispatch-event event))
411 (event-key event))
392 412
393 (eval-when-compile (require 'egg-jsymbol)) 413 (eval-when-compile (require 'egg-jsymbol))
394 414
395 ;;;---------------------------------------------------------------------- 415 ;;;----------------------------------------------------------------------
396 ;;; 416 ;;;
428 ;;;---------------------------------------------------------------------- 448 ;;;----------------------------------------------------------------------
429 449
430 ;;; 450 ;;;
431 ;;;; 451 ;;;;
432 452
433 (defun characterp (form)
434 (numberp form))
435
436 (defun coerce-string (form) 453 (defun coerce-string (form)
437 (cond((stringp form) form) 454 (cond((stringp form) form)
438 ((characterp form) (char-to-string form)))) 455 ((characterp form) (char-to-string form))))
439 456
440 (defun coerce-internal-string (form) 457 (defun coerce-internal-string (form)
441 (cond((stringp form) 458 (cond((stringp form)
442 (if (= (chars-in-string form) 1) 459 (if (= (length form) 1)
443 (string-to-char form) 460 (string-to-char form)
444 form)) 461 form))
445 ((characterp form) form))) 462 ((characterp form) form)))
446 463
447 ;;; kill-all-local-variables $B$+$iJ]8n$9$k(B local variables $B$r;XDj$G$-$k(B 464 ;;; kill-all-local-variables $B$+$iJ]8n$9$k(B local variables $B$r;XDj$G$-$k(B
469 (defun insert-jis-code-from-minibuffer (prompt) 486 (defun insert-jis-code-from-minibuffer (prompt)
470 (let ((str (read-from-minibuffer prompt)) val) 487 (let ((str (read-from-minibuffer prompt)) val)
471 (while (null (setq val (read-jis-code-from-string str))) 488 (while (null (setq val (read-jis-code-from-string str)))
472 (beep) 489 (beep)
473 (setq str (read-from-minibuffer prompt str))) 490 (setq str (read-from-minibuffer prompt str)))
474 (insert (make-character lc-jp (car val) (cdr val))))) 491 (insert (make-char (find-charset 'japanese-jisx0208) (car val) (cdr val)))))
475 492
476 (defun hexadigit-value (ch) 493 (defun hexadigit-value (ch)
477 (cond((and (<= ?0 ch) (<= ch ?9)) 494 (cond((and (<= ?0 ch) (<= ch ?9))
478 (- ch ?0)) 495 (- ch ?0))
479 ((and (<= ?a ch) (<= ch ?f)) 496 ((and (<= ?a ch) (<= ch ?f))
763 (setq p (+ p (length (nth m menu:*select-menus*)))) 780 (setq p (+ p (length (nth m menu:*select-menus*))))
764 (setq m (1+ m))) 781 (setq m (1+ m)))
765 (+ p menu:*select-item-no*))) 782 (+ p menu:*select-item-no*)))
766 783
767 (defun menu:select-goto-item-position (pos) 784 (defun menu:select-goto-item-position (pos)
768 (let ((m 0) (i 0) (p 0)) 785 (let ((m 0) (p 0))
769 (while (<= (+ p (length (nth m menu:*select-menus*))) pos) 786 (while (<= (+ p (length (nth m menu:*select-menus*))) pos)
770 (setq p (+ p (length (nth m menu:*select-menus*)))) 787 (setq p (+ p (length (nth m menu:*select-menus*))))
771 (setq m (1+ m))) 788 (setq m (1+ m)))
772 (setq menu:*select-item-no* (- pos p)) 789 (setq menu:*select-item-no* (- pos p))
773 (menu:select-goto-menu m))) 790 (menu:select-goto-menu m)))
815 832
816 (defvar menu:*display-item-value* nil) 833 (defvar menu:*display-item-value* nil)
817 834
818 (defun menu:item-string (item) 835 (defun menu:item-string (item)
819 (cond((stringp item) item) 836 (cond((stringp item) item)
820 ((numberp item) (char-to-string item)) 837 ((characterp item) (char-to-string item))
821 ((consp item) 838 ((consp item)
822 (if menu:*display-item-value* 839 (if menu:*display-item-value*
823 (format "%s [%s]" 840 (format "%s [%s]"
824 (cond ((stringp (car item)) (car item)) 841 (cond ((stringp (car item)) (car item))
825 ((numberp (car item)) (char-to-string (car item))) 842 ((characterp (car item)) (char-to-string (car item)))
826 (t "")) 843 (t ""))
827 (cdr item)) 844 (cdr item))
828 (cond ((stringp (car item)) 845 (cond ((stringp (car item))
829 (car item)) 846 (car item))
830 ((numberp (car item)) 847 ((characterp (car item))
831 (char-to-string (car item))) 848 (char-to-string (car item)))
832 (t "")))) 849 (t ""))))
833 (t ""))) 850 (t "")))
834 851
835 (defun menu:item-value (item) 852 (defun menu:item-value (item)
903 (goto-char start) 920 (goto-char start)
904 (while (re-search-forward kanji-katakana end end) 921 (while (re-search-forward kanji-katakana end end)
905 (let ((ch (preceding-char))) 922 (let ((ch (preceding-char)))
906 (cond( (<= ch ?$B%s(B) 923 (cond( (<= ch ?$B%s(B)
907 (delete-char -1) 924 (delete-char -1)
908 (insert (make-character lc-jp ?\244 (char-component ch 2)))))))) 925 (insert (make-char (find-charset 'japanese-jisx0208) 36 (char-octet ch 1))))))))
909 926
910 (defun hiragana-paragraph () 927 (defun hiragana-paragraph ()
911 "hiragana paragraph at or after point." 928 "hiragana paragraph at or after point."
912 (interactive ) 929 (interactive )
913 (save-excursion 930 (save-excursion
929 ;;; $B%+%?%+%JJQ49(B 946 ;;; $B%+%?%+%JJQ49(B
930 ;;; 947 ;;;
931 948
932 (defun katakana-region (start end) 949 (defun katakana-region (start end)
933 (interactive "r") 950 (interactive "r")
934 (let ((point (point))) 951 (goto-char start)
935 (goto-char start) 952 (while (re-search-forward kanji-hiragana end end)
936 (while (re-search-forward kanji-hiragana end end) 953 (let ((ch (char-octet (preceding-char) 1)))
937 (let ((ch (char-component (preceding-char) 2))) 954 (delete-char -1)
938 (delete-char -1) 955 (insert (make-char (find-charset 'japanese-jisx0208) 37 ch)))))
939 (insert (make-character lc-jp ?\245 ch))))))
940 956
941 (defun katakana-paragraph () 957 (defun katakana-paragraph ()
942 "katakana paragraph at or after point." 958 "katakana paragraph at or after point."
943 (interactive ) 959 (interactive )
944 (save-excursion 960 (save-excursion
965 (save-restriction 981 (save-restriction
966 (narrow-to-region start end) 982 (narrow-to-region start end)
967 (goto-char (point-min)) 983 (goto-char (point-min))
968 (while (re-search-forward "\\cS\\|\\cA" (point-max) (point-max)) 984 (while (re-search-forward "\\cS\\|\\cA" (point-max) (point-max))
969 (let* ((ch (preceding-char)) 985 (let* ((ch (preceding-char))
970 (ch1 (char-component ch 1)) 986 (ch1 (char-octet ch 0))
971 (ch2 (char-component ch 2))) 987 (ch2 (char-octet ch 1)))
972 (cond ((= ?\241 ch1) 988 (cond ((= ?\241 ch1)
973 (let ((val (cdr (assq ch2 *hankaku-alist*)))) 989 (let ((val (cdr (assq ch2 *hankaku-alist*))))
974 (if val (progn 990 (if val (progn
975 (delete-char -1) 991 (delete-char -1)
976 (insert val))))) 992 (insert val)))))
1052 (if (and (<= ? ch) (<= ch ?~)) 1068 (if (and (<= ? ch) (<= ch ?~))
1053 (progn 1069 (progn
1054 (delete-char -1) 1070 (delete-char -1)
1055 (let ((zen (cdr (assq ch *zenkaku-alist*)))) 1071 (let ((zen (cdr (assq ch *zenkaku-alist*))))
1056 (if zen (insert zen) 1072 (if zen (insert zen)
1057 (insert (make-character lc-jp ?\243 (+ ?\200 ch))))))))))) 1073 (insert (make-char (find-charset 'japanese-jisx0208) 38 ch))))))))))
1058 1074
1059 (defun zenkaku-paragraph () 1075 (defun zenkaku-paragraph ()
1060 "zenkaku paragraph at or after point." 1076 "zenkaku paragraph at or after point."
1061 (interactive ) 1077 (interactive )
1062 (save-excursion 1078 (save-excursion
1337 "ACITION $B$,(B standard-action $B$G$"$k$+$I$&$+$rH=Dj$9$k!%(B" 1353 "ACITION $B$,(B standard-action $B$G$"$k$+$I$&$+$rH=Dj$9$k!%(B"
1338 (or (stringp action) 1354 (or (stringp action)
1339 (and (consp action) 1355 (and (consp action)
1340 (or (stringp (car action)) 1356 (or (stringp (car action))
1341 (and (consp (car action)) 1357 (and (consp (car action))
1342 (numberp (car (car action)))) 1358 (characterp (car (car action))))
1343 (null (car action))) 1359 (null (car action)))
1344 (or (null (car (cdr action))) 1360 (or (null (car (cdr action)))
1345 (stringp (car (cdr action))))))) 1361 (stringp (car (cdr action)))))))
1346 1362
1347 (defvar its:make-terminal-state 'its:default-make-terminal-state 1363 (defvar its:make-terminal-state 'its:default-make-terminal-state
1568 ;;; 1584 ;;;
1569 ;;; emacs $B$G$O(B $BJ8;z%3!<%I$O(B 0-127 $B$G07$&!#(B 1585 ;;; emacs $B$G$O(B $BJ8;z%3!<%I$O(B 0-127 $B$G07$&!#(B
1570 ;;; 1586 ;;;
1571 1587
1572 (defvar its:*buff-s* (make-marker)) 1588 (defvar its:*buff-s* (make-marker))
1573 (defvar its:*buff-e* (set-marker-type (make-marker) t)) 1589 (defvar its:*buff-e* (make-marker))
1590 (set-marker-insertion-type its:*buff-e* t)
1574 1591
1575 ;;; STATE unread 1592 ;;; STATE unread
1576 ;;; |<-s p->|<- e ->| 1593 ;;; |<-s p->|<- e ->|
1577 ;;; s : ch0 state0 map0 1594 ;;; s : ch0 state0 map0
1578 ;;; +1: ch1 state1 map1 1595 ;;; +1: ch1 state1 map1
1626 (setq from (1+ from))))) 1643 (setq from (1+ from)))))
1627 1644
1628 (defun its:peek-char () 1645 (defun its:peek-char ()
1629 (if (= (point) its:*buff-e*) 1646 (if (= (point) its:*buff-e*)
1630 (if its:*interactive* 1647 (if its:*interactive*
1631 (setq unread-command-events (list (read-event))) 1648 (setq unread-command-events (list (character-to-event(read-event))))
1632 nil) 1649 nil)
1633 (following-char))) 1650 (following-char)))
1634 1651
1635 (defun its:read-char () 1652 (defun its:read-char ()
1636 (if (= (point) its:*buff-e*) 1653 (if (= (point) its:*buff-e*)
1646 1663
1647 (defun its:push-char (ch) 1664 (defun its:push-char (ch)
1648 (if its:*char-from-buff* 1665 (if its:*char-from-buff*
1649 (save-excursion 1666 (save-excursion
1650 (its:insert-char ch)) 1667 (its:insert-char ch))
1651 (if ch (setq unread-command-events (list ch))))) 1668 (if ch (setq unread-command-events (list (character-to-event ch))))))
1652 1669
1653 (defun its:insert-char (ch) 1670 (defun its:insert-char (ch)
1654 (insert ch)) 1671 (insert ch))
1655 1672
1656 (defun its:ordinal-charp (ch) 1673 (defun its:ordinal-charp (ch)
1657 (and (numberp ch) (<= ch 127) 1674 (and (characterp ch) (<= ch 127)
1658 (eq (lookup-key fence-mode-map (char-to-string ch)) 'fence-self-insert-command))) 1675 (eq (lookup-key fence-mode-map (char-to-string ch)) 'fence-self-insert-command)))
1659 1676
1660 (defun its:delete-charp (ch) 1677 (defun its:delete-charp (ch)
1661 (and (numberp ch) (<= ch 127) 1678 (and (characterp ch) (<= ch 127)
1662 (eq (lookup-key fence-mode-map (char-to-string ch)) 'fence-backward-delete-char))) 1679 (eq (lookup-key fence-mode-map (char-to-string ch)) 'fence-backward-delete-char)))
1663 1680
1664 (defun fence-self-insert-command () 1681 (defun fence-self-insert-command ()
1665 (interactive) 1682 (interactive)
1683 (setq ch (event-to-character last-command-event))
1666 (cond((or (not egg:*input-mode*) 1684 (cond((or (not egg:*input-mode*)
1667 (null (get-next-map its:*current-map* last-command-event))) 1685 (null (get-next-map its:*current-map* ch)))
1668 (insert last-command-event)) 1686 (insert ch))
1669 (t 1687 (t
1670 (insert last-command-event) 1688 (insert ch)
1671 (its:translate-region (1- (point)) (point) t)))) 1689 (its:translate-region (1- (point)) (point) t))))
1672 1690
1673 ;;; 1691 ;;;
1674 ;;; its: completing-read system 1692 ;;; its: completing-read system
1675 ;;; 1693 ;;;
1705 ;;; 92.9.19 by Y. Kawabe, 92.10.30 by T.Saneto 1723 ;;; 92.9.19 by Y. Kawabe, 92.10.30 by T.Saneto
1706 (delete-region (point) (point-max)) 1724 (delete-region (point) (point-max))
1707 (if quit-flag 1725 (if quit-flag
1708 (progn 1726 (progn
1709 (setq quit-flag nil) 1727 (setq quit-flag nil)
1710 (setq unread-command-events (list ?\^G)))))) 1728 (setq unread-command-events (list (character-to-event ?\^G)))))))
1711 1729
1712 (defun car-string-lessp (item1 item2) 1730 (defun car-string-lessp (item1 item2)
1713 (string-lessp (car item1) (car item2))) 1731 (string-lessp (car item1) (car item2)))
1714 1732
1715 (defun its:minibuffer-completion-help () 1733 (defun its:minibuffer-completion-help ()
1802 (if action 1820 (if action
1803 (setq its:*make-alist-from-map-result* 1821 (setq its:*make-alist-from-map-result*
1804 (cons (list string 1822 (cons (list string
1805 (let ((action-output (action-output action))) 1823 (let ((action-output (action-output action)))
1806 (cond((and (consp action-output) 1824 (cond((and (consp action-output)
1807 (numberp (car action-output))) 1825 (characterp (car action-output)))
1808 (format "%s..." 1826 (format "%s..."
1809 (nth (car action-output) (cdr action-output)))) 1827 (nth (car action-output) (cdr action-output))))
1810 ((stringp action-output) 1828 ((stringp action-output)
1811 action-output) 1829 action-output)
1812 (t 1830 (t
1886 (setq ch (its:read-char)) 1904 (setq ch (its:read-char))
1887 (setq newmap (get-next-map map ch)) 1905 (setq newmap (get-next-map map ch))
1888 (setq action (get-action newmap)) 1906 (setq action (get-action newmap))
1889 1907
1890 (cond 1908 (cond
1891 ((and its:*interactive* (not its:*char-from-buff*) (numberp ch) (= ch ?\^@)) 1909 ((and its:*interactive* (not its:*char-from-buff*) (characterp ch) (= ch ?\^@))
1892 (delete-region its:*buff-s* (point)) 1910 (delete-region its:*buff-s* (point))
1893 (let ((i 1)) 1911 (let ((i 1))
1894 (while (<= i its:*level*) 1912 (while (<= i its:*level*)
1895 (insert (aref its:*inputs* i)) 1913 (insert (aref its:*inputs* i))
1896 (setq i (1+ i)))) 1914 (setq i (1+ i))))
2079 (funcall its:*display-status-string* (map-state map)) 2097 (funcall its:*display-status-string* (map-state map))
2080 (insert (map-state map)))))) 2098 (insert (map-state map))))))
2081 2099
2082 (set-marker its:*buff-s* nil) 2100 (set-marker its:*buff-s* nil)
2083 (set-marker its:*buff-e* nil) 2101 (set-marker its:*buff-e* nil)
2084 (if (and its:*interactive* ch) (setq unread-command-events (list ch))) 2102 (if (and its:*interactive* ch) (setq unread-command-events (list (character-to-event ch))))
2085 )) 2103 ))
2086 2104
2087 ;;;---------------------------------------------------------------------- 2105 ;;;----------------------------------------------------------------------
2088 ;;; 2106 ;;;
2089 ;;; ITS-map dump routine: 2107 ;;; ITS-map dump routine:
2187 2205
2188 ;;; 2206 ;;;
2189 ;;; 2207 ;;;
2190 ;;; 2208 ;;;
2191 2209
2192 (defvar its:*reset-mode-line-format* nil) 2210 (defvar its:*reset-modeline-format* nil)
2193 2211
2194 (if its:*reset-mode-line-format* 2212 (if its:*reset-modeline-format*
2195 (setq-default mode-line-format 2213 (setq-default modeline-format
2196 (cdr mode-line-format))) 2214 (cdr modeline-format)))
2197 2215
2198 (if (not (egg:find-symbol-in-tree 'mode-line-egg-mode mode-line-format)) 2216 (if (not (egg:find-symbol-in-tree 'mode-line-egg-mode modeline-format))
2199 (setq-default 2217 (setq-default
2200 mode-line-format 2218 modeline-format
2201 (cons (list 'mc-flag 2219 (cons (list 'display-minibuffer-mode-in-minibuffer
2202 (list 'display-minibuffer-mode-in-minibuffer 2220 ;;; minibuffer mode in minibuffer
2203 ;;; minibuffer mode in minibuffer 2221 (list
2204 (list 2222 (list 'its:*previous-map* "<" "[")
2205 (list 'its:*previous-map* "<" "[") 2223 'mode-line-egg-mode
2206 'mode-line-egg-mode 2224 (list 'its:*previous-map* ">" "]")
2207 (list 'its:*previous-map* ">" "]") 2225 )
2208 )
2209 ;;;; minibuffer mode in mode line 2226 ;;;; minibuffer mode in mode line
2210 (list 2227 (list
2211 (list 'minibuffer-window-selected 2228 (list 'minibuffer-window-selected
2212 (list 'display-minibuffer-mode 2229 (list 'display-minibuffer-mode
2213 "m" 2230 "m"
2214 " ")
2215 " ") 2231 " ")
2216 (list 'its:*previous-map* "<" "[") 2232 " ")
2217 (list 'minibuffer-window-selected 2233 (list 'its:*previous-map* "<" "[")
2218 (list 'display-minibuffer-mode 2234 (list 'minibuffer-window-selected
2219 'mode-line-egg-mode-in-minibuffer 2235 (list 'display-minibuffer-mode
2220 'mode-line-egg-mode) 2236 'mode-line-egg-mode-in-minibuffer
2221 'mode-line-egg-mode) 2237 'mode-line-egg-mode)
2222 (list 'its:*previous-map* ">" "]") 2238 'mode-line-egg-mode)
2223 ))) 2239 (list 'its:*previous-map* ">" "]")
2224 mode-line-format))) 2240 ))
2241 modeline-format)))
2225 2242
2226 ;;; 2243 ;;;
2227 ;;; minibuffer $B$G$N%b!<%II=<($r$9$k$?$a$K(B nemacs 4 $B$GDj5A$5$l$?(B 2244 ;;; minibuffer $B$G$N%b!<%II=<($r$9$k$?$a$K(B nemacs 4 $B$GDj5A$5$l$?(B
2228 ;;; minibuffer-preprompt $B$rMxMQ$9$k!%(B 2245 ;;; minibuffer-preprompt $B$rMxMQ$9$k!%(B
2229 ;;; 2246 ;;;
2274 (interactive (list (completing-read "ITS mode: " its:*mode-alist*))) 2291 (interactive (list (completing-read "ITS mode: " its:*mode-alist*)))
2275 (if (its:get-mode-map name) 2292 (if (its:get-mode-map name)
2276 (progn 2293 (progn
2277 (setq its:*current-map* (its:get-mode-map name)) 2294 (setq its:*current-map* (its:get-mode-map name))
2278 (egg:mode-line-display)) 2295 (egg:mode-line-display))
2279 (beep)) 2296 (beep)))
2280 )
2281 2297
2282 (defvar its:*select-mode-menu* '(menu "Mode:" nil)) 2298 (defvar its:*select-mode-menu* '(menu "Mode:" nil))
2283 2299
2284 (defun its:select-mode-from-menu () 2300 (defun its:select-mode-from-menu ()
2285 (interactive) 2301 (interactive)
2349 (egg:mode-line-display))) 2365 (egg:mode-line-display)))
2350 2366
2351 2367
2352 (defun toggle-egg-mode () 2368 (defun toggle-egg-mode ()
2353 (interactive) 2369 (interactive)
2354 (if mc-flag 2370 (if egg:*mode-on* (fence-toggle-egg-mode)
2355 (if egg:*mode-on* (fence-toggle-egg-mode) 2371 (progn
2356 (progn 2372 (setq egg:*mode-on* t)
2357 (setq egg:*mode-on* t) 2373 (egg:mode-line-display))))
2358 (egg:mode-line-display)))))
2359 2374
2360 (defun fence-toggle-egg-mode () 2375 (defun fence-toggle-egg-mode ()
2361 (interactive) 2376 (interactive)
2362 (if its:*current-map* 2377 (if its:*current-map*
2363 (progn 2378 (progn
2416 2431
2417 (defconst egg:*fence-open* "|" "*$B%U%'%s%9$N;OE@$r<($9J8;zNs(B") 2432 (defconst egg:*fence-open* "|" "*$B%U%'%s%9$N;OE@$r<($9J8;zNs(B")
2418 (defconst egg:*fence-close* "|" "*$B%U%'%s%9$N=*E@$r<($9J8;zNs(B") 2433 (defconst egg:*fence-close* "|" "*$B%U%'%s%9$N=*E@$r<($9J8;zNs(B")
2419 (defconst egg:*fence-face* nil "*$B%U%'%s%9I=<($KMQ$$$k(B face $B$^$?$O(B nil") 2434 (defconst egg:*fence-face* nil "*$B%U%'%s%9I=<($KMQ$$$k(B face $B$^$?$O(B nil")
2420 (make-variable-buffer-local 2435 (make-variable-buffer-local
2421 (defvar egg:*fence-overlay* nil "$B%U%'%s%9I=<(MQ(B overlay")) 2436 (defvar egg:*fence-extent* nil "$B%U%'%s%9I=<(MQ(B extent"))
2422 2437
2423 (defvar egg:*face-alist* 2438 (defvar egg:*face-alist*
2424 '(("nil" . nil) 2439 '(("nil" . nil)
2425 ("highlight" . highlight) ("modeline" . modeline) 2440 ("highlight" . highlight) ("modeline" . modeline)
2426 ("inverse" . modeline) ("underline" . underline) ("bold" . bold) 2441 ("inverse" . modeline) ("underline" . underline) ("bold" . bold)
2440 (or (null face) (memq face (face-list)))) 2455 (or (null face) (memq face (face-list))))
2441 (progn 2456 (progn
2442 (setq egg:*fence-open* (or open "") 2457 (setq egg:*fence-open* (or open "")
2443 egg:*fence-close* (or close "") 2458 egg:*fence-close* (or close "")
2444 egg:*fence-face* face) 2459 egg:*fence-face* face)
2445 (if (overlayp egg:*fence-overlay*) 2460 (if (extentp egg:*fence-extent*)
2446 (overlay-put egg:*fence-overlay* 'face egg:*fence-face*)) 2461 (set-extent-property egg:*fence-extent* 'face egg:*fence-face*))
2447 t) 2462 t)
2448 (error "Wrong type of argument: %s %s %s" open close face))) 2463 (error "Wrong type of argument: %s %s %s" open close face)))
2449 2464
2450 ;(defconst egg:*region-start* (make-marker))
2451 ;(defconst egg:*region-end* (set-marker-type (make-marker) t))
2452 (defvar egg:*region-start* nil) 2465 (defvar egg:*region-start* nil)
2453 (defvar egg:*region-end* nil)
2454 (make-variable-buffer-local 'egg:*region-start*) 2466 (make-variable-buffer-local 'egg:*region-start*)
2467 (set-default 'egg:*region-start* nil)
2468 (defvar egg:*region-end* nil)
2455 (make-variable-buffer-local 'egg:*region-end*) 2469 (make-variable-buffer-local 'egg:*region-end*)
2456 (set-default 'egg:*region-start* nil)
2457 (set-default 'egg:*region-end* nil) 2470 (set-default 'egg:*region-end* nil)
2458 (defvar egg:*global-map-backup* nil) 2471 (defvar egg:*global-map-backup* nil)
2459 (defvar egg:*local-map-backup* nil) 2472 (defvar egg:*local-map-backup* nil)
2460 2473
2461 2474
2468 "counter to hold repetition of egg-self-insert-command.") 2481 "counter to hold repetition of egg-self-insert-command.")
2469 2482
2470 (defun egg-self-insert-command (arg) 2483 (defun egg-self-insert-command (arg)
2471 (interactive "p") 2484 (interactive "p")
2472 (if (and (not buffer-read-only) 2485 (if (and (not buffer-read-only)
2473 mc-flag
2474 egg:*mode-on* egg:*input-mode* 2486 egg:*mode-on* egg:*input-mode*
2475 (not egg:*in-fence-mode*) ;;; inhibit recursive fence mode 2487 (not egg:*in-fence-mode*) ;;; inhibit recursive fence mode
2476 (not (= last-command-event ? ))) 2488 (not (= (event-to-character last-command-event) ? )))
2477 (egg:enter-fence-mode-and-self-insert) 2489 (egg:enter-fence-mode-and-self-insert)
2478 (progn 2490 (progn
2479 ;; treat continuous 20 self insert as a single undo chunk. 2491 ;; treat continuous 20 self insert as a single undo chunk.
2480 ;; `20' is a magic number copied from keyboard.c 2492 ;; `20' is a magic number copied from keyboard.c
2481 (if (or ;92.12.20 by T.Enami 2493 (if (or ;92.12.20 by T.Enami
2490 (run-hooks 'egg-insert-after-hook)) 2502 (run-hooks 'egg-insert-after-hook))
2491 (if self-insert-after-hook 2503 (if self-insert-after-hook
2492 (if (<= 1 arg) 2504 (if (<= 1 arg)
2493 (funcall self-insert-after-hook 2505 (funcall self-insert-after-hook
2494 (- (point) arg) (point))) 2506 (- (point) arg) (point)))
2495 (if (= last-command-event ? ) (egg:do-auto-fill)))))) 2507 (if (= (event-to-character last-command-event) ? ) (egg:do-auto-fill))))))
2496 2508
2497 ;; 2509 ;;
2498 ;; $BA03NDjJQ49=hM}4X?t(B 2510 ;; $BA03NDjJQ49=hM}4X?t(B
2499 ;; 2511 ;;
2500 (defvar egg:*fence-open-backup* nil) 2512 (defvar egg:*fence-open-backup* nil)
2523 (or (null face) (eq face t) (memq face (face-list)))) 2535 (or (null face) (eq face t) (memq face (face-list))))
2524 (progn 2536 (progn
2525 (setq egg:*fence-open-in-cont* (or open "") 2537 (setq egg:*fence-open-in-cont* (or open "")
2526 egg:*fence-close-in-cont* (or close "") 2538 egg:*fence-close-in-cont* (or close "")
2527 egg:*fence-face-in-cont* face) 2539 egg:*fence-face-in-cont* face)
2528 (if (overlayp egg:*fence-overlay*) 2540 (if (extentp egg:*fence-extent*)
2529 (overlay-put egg:*fence-overlay* 'face egg:*fence-face*)) 2541 (set-extent-property egg:*fence-extent* 'face egg:*fence-face*))
2530 t) 2542 t)
2531 (error "Wrong type of argument: %s %s %s" open close face))) 2543 (error "Wrong type of argument: %s %s %s" open close face)))
2532 2544
2533 (defvar *in-cont-flag* nil 2545 (defvar *in-cont-flag* nil
2534 "$BD>A0$KJQ49$7$?D>8e$NF~NO$+$I$&$+$r<($9!#(B") 2546 "$BD>A0$KJQ49$7$?D>8e$NF~NO$+$I$&$+$r<($9!#(B")
2566 (setq unread-command-events (list last-command-event))) 2578 (setq unread-command-events (list last-command-event)))
2567 2579
2568 (defun egg:fence-face-on () 2580 (defun egg:fence-face-on ()
2569 (if egg:*fence-face* 2581 (if egg:*fence-face*
2570 (progn 2582 (progn
2571 (if (overlayp egg:*fence-overlay*) 2583 (if (extentp egg:*fence-extent*)
2572 nil 2584 nil
2573 (setq egg:*fence-overlay* (make-overlay 1 1 nil t)) 2585 (setq egg:*fence-extent* (make-extent 1 1 nil t))
2574 (if egg:*fence-face* (overlay-put egg:*fence-overlay* 'face egg:*fence-face*))) 2586 (if egg:*fence-face* (set-extent-property egg:*fence-extent* 'face egg:*fence-face*)))
2575 (move-overlay egg:*fence-overlay* egg:*region-start* egg:*region-end* ) ))) 2587 (set-extent-endpoints egg:*fence-extent* egg:*region-start* egg:*region-end* ) )))
2576 2588
2577 (defun egg:fence-face-off () 2589 (defun egg:fence-face-off ()
2578 (and egg:*fence-face* 2590 (and egg:*fence-face*
2579 (overlayp egg:*fence-overlay*) 2591 (extentp egg:*fence-extent*)
2580 (delete-overlay egg:*fence-overlay*) )) 2592 (detach-extent egg:*fence-extent*) ))
2581 2593
2582 (defun enter-fence-mode () 2594 (defun enter-fence-mode ()
2583 ;; XEmacs change: 2595 ;; XEmacs change:
2584 (buffer-disable-undo (current-buffer)) 2596 (buffer-disable-undo (current-buffer))
2585 (setq egg:*in-fence-mode* t) 2597 (setq egg:*in-fence-mode* t)
2592 (egg:check-fence-in-cont) ; for Wnn6 2604 (egg:check-fence-in-cont) ; for Wnn6
2593 (insert egg:*fence-open*) 2605 (insert egg:*fence-open*)
2594 (or (markerp egg:*region-start*) (setq egg:*region-start* (make-marker))) 2606 (or (markerp egg:*region-start*) (setq egg:*region-start* (make-marker)))
2595 (set-marker egg:*region-start* (point)) 2607 (set-marker egg:*region-start* (point))
2596 (insert egg:*fence-close*) 2608 (insert egg:*fence-close*)
2597 (or (markerp egg:*region-end*) (setq egg:*region-end* (set-marker-type (make-marker) t))) 2609 (or (markerp egg:*region-end*) (set-marker-insertion-type (setq egg:*region-end* (make-marker)) t))
2598 (set-marker egg:*region-end* egg:*region-start*) 2610 (set-marker egg:*region-end* egg:*region-start*)
2599 (egg:fence-face-on) 2611 (egg:fence-face-on)
2600 (goto-char egg:*region-start*) 2612 (goto-char egg:*region-start*)
2601 ) 2613 )
2602 2614
2738 (princ (substitute-command-keys "The keys that are defined for the fence mode here are:\\{fence-mode-map}")) 2750 (princ (substitute-command-keys "The keys that are defined for the fence mode here are:\\{fence-mode-map}"))
2739 (print-help-return-message))))) 2751 (print-help-return-message)))))
2740 2752
2741 (defvar fence-mode-map (make-keymap)) 2753 (defvar fence-mode-map (make-keymap))
2742 2754
2743 (substitute-key-definition 'self-insert-command 2755 (substitute-key-definition 'egg-self-insert-command
2744 'fence-self-insert-command 2756 'fence-self-insert-command
2745 fence-mode-map global-map) 2757 fence-mode-map global-map)
2746 2758
2747 (define-key fence-mode-map "\eh" 'fence-hiragana) 2759 (define-key fence-mode-map "\eh" 'fence-hiragana)
2748 (define-key fence-mode-map "\ek" 'fence-katakana) 2760 (define-key fence-mode-map "\ek" 'fence-katakana)