xemacs-beta: lisp/egg/egg.el comparison

comparison 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

comparison

equal deleted inserted replaced

-:2ec2fe4a4c89
+:8619ce7e4c50
 (provide 'egg)
 ;; XEmacs addition: (and remove disable-undo variable)
 ;; For Emacs V18/Nemacs compatibility
-(and (not (fboundp 'buffer-disable-undo))
+;(and (not (fboundp 'buffer-disable-undo))
-(fboundp 'buffer-flush-undo)
+;     (fboundp 'buffer-flush-undo)
-(defalias 'buffer-disable-undo '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 ()
+(defun egg-read-event ()
-"Cheap 'n cheesy event filter to facilitate translation from Mule-2.3"
+"FSFmacs event emulator that shoves non key events into
-(let ((event (make-event)))
+unread-command-events to facilitate translation from Mule-2.3"
-(while (progn
+(let ((event (make-event))
-	     (next-event event)
+	(ch nil))
-	     (not (key-press-event-p event)))
+(next-command-event event)
-(dispatch-event event))
+(if (key-press-event-p event)
-(event-key event)))
+	(setq ch (event-key event))
+(setq unread-command-events (list event)))
+(deallocate-event event)
+ch))
 (eval-when-compile (require 'egg-jsymbol))
 ;;;----------------------------------------------------------------------
 ;;;
 	  (setq menu:*select-item-no* 0)
 	  (menu:select-goto-menu 0))
 	 )
 	;; end of patch
 	(while (not finished)
-	  (let ((ch (read-event)))
+	  (let ((ch (egg-read-event)))
 	    (setq quit-flag nil)
 	    (cond
 	     ((eq ch ?\C-a)
 	      (menu:select-goto-item 0))
 	     ((eq ch ?\C-e)
 (setq from (1+ from)))))
 (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)))
 (defun its:read-char ()
 (if (= (point) its:*buff-e*)
 (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)
 (delete-char 1)
 ch)))
 (let ((point (point))
 	(output (cdr action-output))
 	(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))))
 	    ((eq ch ?\^P)
 	     (setcar action-output
 ;; (load "its-hira")
 ;; (load-library "its-kata")
 ;; (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
 ;; moved to each language specific setup files (japanese.el, ...)
 ;; (setq-default its:*current-map* (its:get-mode-map "roma-kana"))
 (substitute-key-definition 'self-insert-command
 			   '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.
 ;;;
 (define-key global-map "\C-\\" 'toggle-egg-mode)
 (define-key mule-keymap "Q" 'its:select-upcase)
 (define-key mule-keymap "z" 'its:select-zenkaku-downcase)
 (define-key mule-keymap "Z" 'its:select-zenkaku-upcase)
 ;;;
-;;; auto fill controll
+;;; auto fill control
 ;;;
 (defun egg:do-auto-fill ()
 (if (and auto-fill-function (not buffer-read-only)
 	   (> (current-column) fill-column))
 (extentp egg:*fence-extent*)
 (detach-extent egg:*fence-extent*) ))
 (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))
 (setq egg:*local-map-backup*  (current-local-map))
 ;;;(use-global-map fence-mode-map)
 (if its:*previous-map*
 (setq its:*current-map* its:*previous-map*
 	    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
 "Hook to run when egg exits. Should take two arguments START and END
 correspoding to character position.")
 (if (not (= egg:*region-start* egg:*region-end*))
 	  (egg:do-auto-fill))))
 (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))
 )
 (defun fence-cancel-input ()
 (interactive)
 (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)
 (let ((buf "*Help*"))

Mercurial > hg > xemacs-beta

comparison lisp/egg/egg.el @ 114:8619ce7e4c50 r20-1b9