Mercurial > hg > xemacs-beta
diff lisp/egg/egg.el @ 114:8619ce7e4c50 r20-1b9
Import from CVS: tag r20-1b9
author | cvs |
---|---|
date | Mon, 13 Aug 2007 09:21:54 +0200 |
parents | fe104dbd9147 |
children | 1370575f1259 |
line wrap: on
line diff
--- a/lisp/egg/egg.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/egg/egg.el Mon Aug 13 09:21:54 2007 +0200 @@ -396,19 +396,22 @@ ;; XEmacs addition: (and remove disable-undo variable) ;; For Emacs V18/Nemacs compatibility -(and (not (fboundp 'buffer-disable-undo)) - (fboundp 'buffer-flush-undo) - (defalias 'buffer-disable-undo 'buffer-flush-undo)) +;(and (not (fboundp 'buffer-disable-undo)) +; (fboundp 'buffer-flush-undo) +; (defalias 'buffer-disable-undo 'buffer-flush-undo)) ;; 97.2.4 Created by J.Hein to simulate Mule-2.3 -(defun read-event () - "Cheap 'n cheesy event filter to facilitate translation from Mule-2.3" - (let ((event (make-event))) - (while (progn - (next-event event) - (not (key-press-event-p event))) - (dispatch-event event)) - (event-key event))) +(defun egg-read-event () + "FSFmacs event emulator that shoves non key events into +unread-command-events to facilitate translation from Mule-2.3" + (let ((event (make-event)) + (ch nil)) + (next-command-event event) + (if (key-press-event-p event) + (setq ch (event-key event)) + (setq unread-command-events (list event))) + (deallocate-event event) + ch)) (eval-when-compile (require 'egg-jsymbol)) @@ -683,7 +686,7 @@ ) ;; end of patch (while (not finished) - (let ((ch (read-event))) + (let ((ch (egg-read-event))) (setq quit-flag nil) (cond ((eq ch ?\C-a) @@ -1615,7 +1618,12 @@ (defun its:peek-char () (if (= (point) its:*buff-e*) (if its:*interactive* - (setq unread-command-events (list (character-to-event(read-event)))) + (let ((ch (egg-read-event))) + (if ch + (progn + (setq unread-command-events (list (character-to-event ch))) + ch) + nil)) nil) (following-char))) @@ -1624,7 +1632,7 @@ (progn (setq its:*char-from-buff* nil) (if its:*interactive* - (read-event) + (egg-read-event) nil)) (let ((ch (following-char))) (setq its:*char-from-buff* t) @@ -1816,7 +1824,7 @@ (ch 0)) (while (not (eq ch ?\^L)) (insert "<" (nth (car action-output)output) ">") - (setq ch (read-event)) + (setq ch (egg-read-event)) (cond ((eq ch ?\^N) (setcar action-output (mod (1+ (car action-output)) (length output)))) @@ -2115,7 +2123,6 @@ ;; (load-library "its-hankaku") ;; (load-library "its-zenkaku") - (defvar its:*current-map* nil) (make-variable-buffer-local 'its:*current-map*) ;; 92.3.13 by K.Handa @@ -2378,6 +2385,9 @@ 'egg-self-insert-command global-map) +;; wire us into pending-delete +(put 'egg-self-insert-command 'pending-delete t) + ;;; ;;; Currently entries C-\ and C-^ at global-map are undefined. ;;; @@ -2398,7 +2408,7 @@ (define-key mule-keymap "Z" 'its:select-zenkaku-upcase) ;;; -;;; auto fill controll +;;; auto fill control ;;; (defun egg:do-auto-fill () @@ -2581,7 +2591,8 @@ (defun enter-fence-mode () ;; XEmacs change: - (buffer-disable-undo (current-buffer)) +; (buffer-disable-undo (current-buffer)) + (undo-boundary) (setq egg:*in-fence-mode* t) (egg:mode-line-display) ;;;(setq egg:*global-map-backup* (current-global-map)) @@ -2692,7 +2703,11 @@ its:*previous-map* nil)) (egg:quit-egg-mode)) -(defvar egg-insert-after-hook nil) +;; jhod: This seems bogus to me, as it should be called either after each +;; egg-self-insert, or after accepting input, but not both. Otherwise, I can't +;; really think of a use for it. +(defvar egg-insert-after-hook nil "Hook to run when egg inserts a character +in the buffer") (make-variable-buffer-local 'egg-insert-after-hook) (defvar egg-exit-hook nil @@ -2718,7 +2733,7 @@ (set-marker egg:*region-start* nil) (set-marker egg:*region-end* nil) ;; XEmacs change: - (buffer-enable-undo (current-buffer)) +; (buffer-enable-undo (current-buffer)) (if egg-insert-after-hook (run-hooks 'egg-insert-after-hook)) ) @@ -2728,6 +2743,16 @@ (delete-region egg:*region-start* egg:*region-end*) (fence-exit-mode)) +(defun fence-mouse-protect () + "Cancel entry in progress if mouse events occur." + (if egg:*in-fence-mode* + (save-excursion + (its:reset-input) + (fence-cancel-input)))) + +(if (boundp 'mouse-track-cleanup-hook) + (add-hook 'mouse-track-cleanup-hook 'fence-mouse-protect)) + (defun fence-mode-help-command () "Display documentation for fence-mode." (interactive)