Mercurial > hg > xemacs-beta

comparison lisp/egg/egg.el @ 215:1f0dabaa0855 r20-4b6

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-4b6
author cvs
date Mon, 13 Aug 2007 10:07:35 +0200
parents e45d5e7c476e
children 262b8bb4a523
comparison
equal deleted inserted replaced
214:c5d88c05e1e9 215:1f0dabaa0855
62 ;;; 62 ;;;
63 63
64 ; last master version 64 ; last master version
65 ;;; (defvar egg-version "3.09" "Version number of this version of Egg. ") 65 ;;; (defvar egg-version "3.09" "Version number of this version of Egg. ")
66 ;;; 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. ") 67 (defvar egg-version "3.10 xemacs" "Version number of this version of Egg. ")
68 ;;; Last modified date: Wed Feb 05 20:45:00 1997 68 ;;; Last modified date: Wed Nov 29 20:45:00 1997
69 69
70 ;;;; $B=$@5MW5a%j%9%H(B 70 ;;;; $B=$@5MW5a%j%9%H(B
71 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 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 73
74 ;;;; $B=$@5%a%b(B 74 ;;;; $B=$@5%a%b(B
75
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.
75 82
76 ;;; 97.2.05 modified by J.Hein <jhod@po.iijnet.or.jp> 83 ;;; 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 84 ;;; 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. 85 ;;; 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 86 ;;; Also modified to work with the new charset names and API
404 unread-command-events to facilitate translation from Mule-2.3" 411 unread-command-events to facilitate translation from Mule-2.3"
405 (let ((event (make-event)) 412 (let ((event (make-event))
406 ch key) 413 ch key)
407 (next-command-event event) 414 (next-command-event event)
408 (setq key (event-key event)) 415 (setq key (event-key event))
409 (if (key-press-event-p event) 416 (if (and (key-press-event-p event)
417 (not (event-matches-key-specifier-p event 'backspace)))
410 (if (eq 0 (event-modifier-bits event)) 418 (if (eq 0 (event-modifier-bits event))
411 (setq ch (or (event-to-character event) key)) 419 (setq ch (or (event-to-character event) key))
412 (if (eq 1 (event-modifier-bits event)) 420 (if (eq 1 (event-modifier-bits event))
413 (setq ch 421 (setq ch
414 (if (characterp key) 422 (if (characterp key)
2175 (set-buffer (window-buffer (minibuffer-window))) 2183 (set-buffer (window-buffer (minibuffer-window)))
2176 (setq egg:*mode-on* (default-value 'egg:*mode-on*) 2184 (setq egg:*mode-on* (default-value 'egg:*mode-on*)
2177 egg:*input-mode* (default-value 'egg:*input-mode*) 2185 egg:*input-mode* (default-value 'egg:*input-mode*)
2178 egg:*in-fence-mode* (default-value 'egg:*in-fence-mode*)))) 2186 egg:*in-fence-mode* (default-value 'egg:*in-fence-mode*))))
2179 2187
2180 (if (boundp 'select-window-hook)
2181 (add-hook 'select-window-hook 'egg:select-window-hook)
2182 (add-hook 'minibuffer-exit-hook 'egg:minibuffer-exit-hook)
2183 (add-hook 'minibuffer-entry-hook 'egg:minibuffer-entry-hook))
2184 2188
2185 ;;; 2189 ;;;
2186 ;;; 2190 ;;;
2187 ;;; 2191 ;;;
2188 2192
2189 (defvar its:*reset-modeline-format* nil) 2193 (defvar its:*reset-modeline-format* nil)
2190 2194
2191 (if its:*reset-modeline-format* 2195
2192 (setq-default modeline-format
2193 (cdr modeline-format)))
2194
2195 (if (not (egg:find-symbol-in-tree 'mode-line-egg-mode modeline-format))
2196 (setq-default
2197 modeline-format
2198 (cons (list 'display-minibuffer-mode-in-minibuffer
2199 ;;; minibuffer mode in minibuffer
2200 (list
2201 (list 'its:*previous-map* "<" "[")
2202 'mode-line-egg-mode
2203 (list 'its:*previous-map* ">" "]")
2204 )
2205 ;;;; minibuffer mode in mode line
2206 (list
2207 (list 'minibuffer-window-selected
2208 (list 'display-minibuffer-mode
2209 "m"
2210 " ")
2211 " ")
2212 (list 'its:*previous-map* "<" "[")
2213 (list 'minibuffer-window-selected
2214 (list 'display-minibuffer-mode
2215 'mode-line-egg-mode-in-minibuffer
2216 'mode-line-egg-mode)
2217 'mode-line-egg-mode)
2218 (list 'its:*previous-map* ">" "]")
2219 ))
2220 modeline-format)))
2221 2196
2222 ;;; 2197 ;;;
2223 ;;; minibuffer $B$G$N%b!<%II=<($r$9$k$?$a$K(B nemacs 4 $B$GDj5A$5$l$?(B 2198 ;;; minibuffer $B$G$N%b!<%II=<($r$9$k$?$a$K(B nemacs 4 $B$GDj5A$5$l$?(B
2224 ;;; minibuffer-preprompt $B$rMxMQ$9$k!%(B 2199 ;;; minibuffer-preprompt $B$rMxMQ$9$k!%(B
2225 ;;; 2200 ;;;
2244 mode-line-egg-mode-in-minibuffer str)) 2219 mode-line-egg-mode-in-minibuffer str))
2245 (setq display-minibuffer-mode nil 2220 (setq display-minibuffer-mode nil
2246 mode-line-egg-mode str)) 2221 mode-line-egg-mode str))
2247 (redraw-modeline t)) 2222 (redraw-modeline t))
2248 2223
2249 (mode-line-egg-mode-update mode-line-egg-mode)
2250 2224
2251 ;;; 2225 ;;;
2252 ;;; egg mode line display 2226 ;;; egg mode line display
2253 ;;; 2227 ;;;
2254 2228
2581 (and egg:*fence-face* 2555 (and egg:*fence-face*
2582 (extentp egg:*fence-extent*) 2556 (extentp egg:*fence-extent*)
2583 (detach-extent egg:*fence-extent*) )) 2557 (detach-extent egg:*fence-extent*) ))
2584 2558
2585 (defun enter-fence-mode () 2559 (defun enter-fence-mode ()
2560
2586 ;; XEmacs change: 2561 ;; XEmacs change:
2587 ; (buffer-disable-undo (current-buffer)) 2562 ; (buffer-disable-undo (current-buffer))
2588 (undo-boundary) 2563 (undo-boundary)
2589 (setq egg:*in-fence-mode* t 2564 (setq egg:*in-fence-mode* t
2590 egg:fence-buffer (current-buffer)) 2565 egg:fence-buffer (current-buffer))
2702 (egg:quit-egg-mode)) 2677 (egg:quit-egg-mode))
2703 2678
2704 ;; jhod: This seems bogus to me, as it should be called either after each 2679 ;; jhod: This seems bogus to me, as it should be called either after each
2705 ;; egg-self-insert, or after accepting input, but not both. Otherwise, I can't 2680 ;; egg-self-insert, or after accepting input, but not both. Otherwise, I can't
2706 ;; really think of a use for it. 2681 ;; really think of a use for it.
2707 (defvar egg-insert-after-hook nil "Hook to run when egg inserts a character 2682 (defvar egg-insert-after-hook nil
2708 in the buffer") 2683 "Hook to run when egg inserts a character in the buffer")
2684
2709 (make-variable-buffer-local 'egg-insert-after-hook) 2685 (make-variable-buffer-local 'egg-insert-after-hook)
2710 2686
2711 (defvar egg-exit-hook nil 2687 (defvar egg-exit-hook nil
2712 "Hook to run when egg exits. Should take two arguments START and END 2688 "Hook to run when egg exits. Should take two arguments START and END
2713 correspoding to character position.") 2689 correspoding to character position.")
2778 (if (not (null func)) 2754 (if (not (null func))
2779 (funcall func))) 2755 (funcall func)))
2780 (egg:mode-line-display)) 2756 (egg:mode-line-display))
2781 2757
2782 (defun fence-mode-help-command () 2758 (defun fence-mode-help-command ()
2783 "Display documentation for fence-mode." 2759 "Display fence mode help"
2784 (interactive) 2760 (interactive "_")
2785 (let ((buf "*Help*")) 2761 (let ((w (selected-window)))
2786 (if (eq (get-buffer buf) (current-buffer)) 2762 (describe-function 'egg-mode)
2787 (henkan-quit) 2763 (ding)
2788 (with-output-to-temp-buffer buf 2764 (select-window w)))
2789 (princ (substitute-command-keys "The keys that are defined for the fence mode here are:\\{fence-mode-map}"))
2790 (print-help-return-message)))))
2791 2765
2792 (defvar fence-mode-map (make-keymap)) 2766 (defvar fence-mode-map (make-keymap))
2793 2767
2794 (substitute-key-definition 'egg-self-insert-command 2768 (substitute-key-definition 'egg-self-insert-command
2795 'fence-self-insert-command 2769 'fence-self-insert-command
2813 (define-key fence-mode-map "\C-c" 'fence-cancel-input) 2787 (define-key fence-mode-map "\C-c" 'fence-cancel-input)
2814 (define-key fence-mode-map "\C-d" 'fence-delete-char) 2788 (define-key fence-mode-map "\C-d" 'fence-delete-char)
2815 (define-key fence-mode-map "\C-e" 'fence-end-of-line) 2789 (define-key fence-mode-map "\C-e" 'fence-end-of-line)
2816 (define-key fence-mode-map "\C-f" 'fence-forward-char) 2790 (define-key fence-mode-map "\C-f" 'fence-forward-char)
2817 (define-key fence-mode-map "\C-g" 'fence-cancel-input) 2791 (define-key fence-mode-map "\C-g" 'fence-cancel-input)
2818 (define-key fence-mode-map "\C-h" 'fence-mode-help-command)
2819 (define-key fence-mode-map "\C-k" 'fence-kill-line) 2792 (define-key fence-mode-map "\C-k" 'fence-kill-line)
2820 (define-key fence-mode-map "\C-l" 'fence-exit-mode) 2793 (define-key fence-mode-map "\C-l" 'fence-exit-mode)
2821 (define-key fence-mode-map "\C-m" 'fence-exit-mode) ;;; RET 2794 (define-key fence-mode-map "\C-m" 'fence-exit-mode) ;;; RET
2822 (define-key fence-mode-map [return] 'fence-exit-mode) 2795 (define-key fence-mode-map [return] 'fence-exit-mode)
2823 (define-key fence-mode-map "\C-q" 'its:select-previous-mode) 2796 (define-key fence-mode-map "\C-q" 'its:select-previous-mode)
2826 (define-key fence-mode-map "\C-z" 'eval-expression) 2799 (define-key fence-mode-map "\C-z" 'eval-expression)
2827 (define-key fence-mode-map "\C-\\" 'fence-toggle-egg-mode) 2800 (define-key fence-mode-map "\C-\\" 'fence-toggle-egg-mode)
2828 (define-key fence-mode-map "\C-_" 'jis-code-input) 2801 (define-key fence-mode-map "\C-_" 'jis-code-input)
2829 (define-key fence-mode-map "\177" 'fence-backward-delete-char) 2802 (define-key fence-mode-map "\177" 'fence-backward-delete-char)
2830 (define-key fence-mode-map [delete] 'fence-backward-delete-char) 2803 (define-key fence-mode-map [delete] 'fence-backward-delete-char)
2831 (define-key fence-mode-map [backspace] 'fence-backward-delete-char) 2804 (define-key fence-mode-map 'backspace 'fence-backward-delete-char)
2805 (define-key fence-mode-map '(control h) 'fence-mode-help-command)
2832 (define-key fence-mode-map [right] 'fence-forward-char) 2806 (define-key fence-mode-map [right] 'fence-forward-char)
2833 (define-key fence-mode-map [left] 'fence-backward-char) 2807 (define-key fence-mode-map [left] 'fence-backward-char)
2834 2808
2835 ;;;---------------------------------------------------------------------- 2809 ;;;----------------------------------------------------------------------
2836 ;;; 2810 ;;;
2884 ;; end of patch 2858 ;; end of patch
2885 (cond((stringp code) (insert code)) 2859 (cond((stringp code) (insert code))
2886 ((consp code) (eval code)) 2860 ((consp code) (eval code))
2887 ))) 2861 )))
2888 2862
2889 (define-key global-map "\C-^" 'special-symbol-input)
2890 2863
2891 (autoload 'busyu-input "egg-busyu" nil t) 2864 (autoload 'busyu-input "egg-busyu" nil t)
2892 (autoload 'kakusuu-input "egg-busyu" nil t) 2865 (autoload 'kakusuu-input "egg-busyu" nil t)
2893 2866
2894 ;; put us into all existing buffer's modelines 2867 (defun egg-mode ()
2895 (if (not (featurep 'egg)) 2868 "The keys that are defined for the fence mode in egg are:\\{fence-mode-map}"
2896 (mapc-internal 2869 (interactive)
2897 (lambda (buf) 2870 (define-key global-map "\C-^" 'special-symbol-input)
2898 (save-excursion 2871 (if (not (egg:find-symbol-in-tree 'mode-line-egg-mode modeline-format))
2899 (set-buffer buf) 2872 (setq-default
2900 (setq modeline-format (cons (list 'display-minibuffer-mode-in-minibuffer 2873 modeline-format
2874 (cons (list 'display-minibuffer-mode-in-minibuffer
2901 ;;; minibuffer mode in minibuffer 2875 ;;; minibuffer mode in minibuffer
2902 (list 2876 (list
2903 (list 'its:*previous-map* "<" "[") 2877 (list 'its:*previous-map* "<" "[")
2904 'mode-line-egg-mode 2878 'mode-line-egg-mode
2905 (list 'its:*previous-map* ">" "]") 2879 (list 'its:*previous-map* ">" "]")
2906 ) 2880 )
2907 ;;;; minibuffer mode in mode line 2881 ;;;; minibuffer mode in mode line
2908 (list 2882 (list
2909 (list 'minibuffer-window-selected 2883 (list 'minibuffer-window-selected
2910 (list 'display-minibuffer-mode 2884 (list 'display-minibuffer-mode
2911 "m" 2885 "m"
2912 " ") 2886 " ")
2913 " ") 2887 " ")
2914 (list 'its:*previous-map* "<" "[") 2888 (list 'its:*previous-map* "<" "[")
2915 (list 'minibuffer-window-selected 2889 (list 'minibuffer-window-selected
2916 (list 'display-minibuffer-mode 2890 (list 'display-minibuffer-mode
2917 'mode-line-egg-mode-in-minibuffer 2891 'mode-line-egg-mode-in-minibuffer
2918 'mode-line-egg-mode) 2892 'mode-line-egg-mode)
2919 'mode-line-egg-mode) 2893 'mode-line-egg-mode)
2920 (list 'its:*previous-map* ">" "]") 2894 (list 'its:*previous-map* ">" "]")
2921 )) 2895 ))
2922 modeline-format)))) 2896 modeline-format)))
2923 (buffer-list))) 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 )
2924 2941
2925 (provide 'egg) 2942 (provide 'egg)
2926 2943
2927 ;; if set-lang-environment has already been called, call egg-lang-switch-callback
2928 (if (not (null current-language-environment))
2929 (egg-lang-switch-callback))
2930
2931 ;;; egg.el ends here 2944 ;;; egg.el ends here