diff lisp/cmdloop.el @ 5118:e0db3c197671 ben-lisp-object

merge up to latest default branch, doesn't compile yet
author Ben Wing <ben@xemacs.org>
date Sat, 26 Dec 2009 21:18:49 -0600
parents 38ef5a6da799
children fd36a980d701
line wrap: on
line diff
--- a/lisp/cmdloop.el	Sat Dec 26 00:20:27 2009 -0600
+++ b/lisp/cmdloop.el	Sat Dec 26 21:18:49 2009 -0600
@@ -183,11 +183,26 @@
 
 
 (defun truncate-command-history-for-gc ()
-  (let ((tail (nthcdr 30 command-history)))
-    (if tail (setcdr tail nil)))
-  (let ((tail (nthcdr 30 values)))
-    (if tail (setcdr tail nil)))
-  )
+  ;; We should try to avoid accessing any bindings to speak of in this
+  ;; function; as this hook is called asynchronously, the search for
+  ;; those bindings might search local bindings from essentially
+  ;; arbitrary functions. We force the body of the function to run at
+  ;; command-loop level, where the danger of local bindings is much
+  ;; reduced; the code can still do its job because the command history
+  ;; and values list will not grow before then anyway.
+  ;;
+  ;; Nothing is done in batch mode, both because it is a waste of time
+  ;; (there is no command loop!) and because this any GCs during dumping
+  ;; will invoke this code, and if it were to enqueue an eval event,
+  ;; the portable dumper would try to dump it and fail.
+  (if (not (noninteractive))
+      (enqueue-eval-event
+       (lambda (arg)
+         (let ((tail (nthcdr 30 command-history)))
+           (if tail (setcdr tail nil)))
+         (let ((tail (nthcdr 30 values)))
+           (if tail (setcdr tail nil))))
+       nil)))
 
 (add-hook 'pre-gc-hook 'truncate-command-history-for-gc)
 
@@ -473,7 +488,10 @@
 The user must confirm the answer with RET,
 and can edit it until it as been confirmed."
   (if (should-use-dialog-box-p)
-      (yes-or-no-p-dialog-box prompt)
+      ;; and-fboundp is redundant, since yes-or-no-p-dialog-box is only
+      ;; bound if (featurep 'dialog). But it eliminates a compile-time
+      ;; warning.
+      (and-fboundp #'yes-or-no-p-dialog-box (yes-or-no-p-dialog-box prompt))
     (yes-or-no-p-minibuf prompt)))
 
 (defun y-or-n-p (prompt)
@@ -542,12 +560,15 @@
   :group 'editing-basics)
 
 (defun read-quoted-char (&optional prompt)
+  ;; XEmacs change; description of the character code input
   "Like `read-char', but do not allow quitting.
-Also, if the first character read is an octal digit,
-we read any number of octal digits and return the
-specified character code.  Any nondigit terminates the sequence.
-If the terminator is RET, it is discarded;
-any other terminator is used itself as input.
+
+Also, if the first character read is a digit of base (the value of)
+`read-quoted-char-radix', we read as many of such digits as are
+typed and return a character with the corresponding Unicode code
+point.  Any input that is not a digit (in the base used) terminates
+the sequence.  If the terminator is RET, it is discarded; any other
+terminator is used itself as input.
 
 The optional argument PROMPT specifies a string to use to prompt the user.
 The variable `read-quoted-char-radix' controls which radix to use
@@ -558,19 +579,25 @@
 	)
     (while (not done)
       (let ((inhibit-quit first)
-	    ;; Don't let C-h get the help message--only help function keys.
+	    ;; Don't let C-h get the help message--only help
+	    ;; function keys. 
+	    ;; XEmacs: we don't support the help function keys as of
+	    ;; 2006-04-16. GNU have a Vhelp_event_list in addition
+	    ;; to help-char in src/keyboard.c, and it's only useful
+	    ;; to set help-form while help-char is nil when that
+	    ;; functionality is available.
 	    (help-char nil)
-	    (help-form
+	    (help-form (format 
 	     "Type the special character you want to use,
-or the octal character code.
+or the character code, base %d (the value of `read-quoted-char-radix')
 RET terminates the character code and is discarded;
-any other non-digit terminates the character code and is then used as input."))
+any other non-digit terminates the character code and is then used as input."
+	     read-quoted-char-radix)))
 	(and prompt (display-message 'prompt (format "%s-" prompt)))
 	(setq event (next-command-event)
-	      char (or (event-to-character event)
-		       (signal 'error
-			       (list "key read cannot be inserted in a buffer"
-				     event))))
+	      ;; If event-to-character fails, this is fine, we handle that
+	      ;; with the (null char) cond branch below.
+	      char (event-to-character event))
 	(if inhibit-quit (setq quit-flag nil)))
       ;; Translate TAB key into control-I ASCII character, and so on.
       (and char
@@ -579,7 +606,8 @@
 		 (setq char (aref translated 0)))))
       (cond ((null char))
 	    ((not (characterp char))
-	     (setq unread-command-events (list char)
+	     ;; XEmacs change; event instead of char. 
+	     (setq unread-command-events (list event)
 		   done t))
 ; 	    ((/= (logand char ?\M-\^@) 0)
 ; 	     ;; Turn a meta-character into a character with the 0200 bit set.
@@ -598,12 +626,14 @@
 	    ((and (not first) (eq char ?\C-m))
 	     (setq done t))
 	    ((not first)
-	     (setq unread-command-events (list char)
+	     ;; XEmacs change; event instead of char. 
+	     (setq unread-command-events (list event)
 		   done t))
 	    (t (setq code (char-to-int char)
 		     done t)))
       (setq first nil))
-    (int-to-char code)))
+    ;; XEmacs change; unicode-to-char instead of int-to-char
+    (unicode-to-char code)))
 
 ;; in passwd.el.
 ; (defun read-passwd (prompt &optional confirm default)