diff lisp/simple.el @ 3929:94ecba3ecd77

[xemacs-hg @ 2007-04-30 16:16:48 by stephent] Improve echo area resizing. <87wszthlwi.fsf@uwakimon.sk.tsukuba.ac.jp>
author stephent
date Mon, 30 Apr 2007 16:16:52 +0000
parents 6b2ef948e140
children 38ef5a6da799
line wrap: on
line diff
--- a/lisp/simple.el	Sun Apr 29 21:53:05 2007 +0000
+++ b/lisp/simple.el	Mon Apr 30 16:16:52 2007 +0000
@@ -4127,9 +4127,10 @@
   "List of regular expressions matching messages which shouldn't be logged.
 See `log-message'.
 
-Ideally, packages which generate messages which might need to be ignored
-should label them with 'progress, 'prompt, or 'no-log, so they can be
-filtered by the log-message-ignore-labels."
+Adding entries to this list slows down messaging significantly.  Wherever
+possible, messages which might need to be ignored should be labeled with
+'progress, 'prompt, or 'no-log, so they can be filtered by
+log-message-ignore-labels."
   :type '(repeat regexp)
   :group 'log-message)
 
@@ -4146,9 +4147,39 @@
 :group 'log-message)
 
 (defcustom undisplay-echo-area-function nil
-  "The function to call to undisplay echo area buffer."
-:type 'function
-:group 'log-message)
+  "The function to call to undisplay echo area buffer.
+WARNING: any problem with your function is likely to result in an
+uninterruptible infinite loop.  Use of custom functions is therefore not
+recommended."
+  :type '(choice (const nil)
+		 function)
+  :group 'log-message)
+
+(defvar undisplay-echo-area-resize-window-allowed t
+  "INTERNAL USE ONLY.
+Guards against `undisplay-echo-area-resize-window' infloops.
+Touch this at your own risk.")
+
+(defun undisplay-echo-area-resize-window ()
+  "Resize idle echo area window to `resize-minibuffer-idle-height'.
+If either `resize-minibuffer-idle-height' or `resize-minibuffer-mode' is nil,
+does nothing.  If `resize-minibuffer-window-exactly' is non-nil, always resize
+to this height exactly, otherwise if current height is no larger than this,
+leave it as is."
+  (when (default-value undisplay-echo-area-resize-window-allowed)
+    (setq-default undisplay-echo-area-resize-window-allowed nil)
+    (let* ((mbw (minibuffer-window))
+	   (height (window-height mbw)))
+      (with-boundp '(resize-minibuffer-idle-height)
+	(and resize-minibuffer-mode
+	     (numberp resize-minibuffer-idle-height)
+	     (> resize-minibuffer-idle-height 0)
+	     (unless (if resize-minibuffer-window-exactly
+			 (= resize-minibuffer-idle-height height)
+		       (<= resize-minibuffer-idle-height height))
+	       (enlarge-window (- resize-minibuffer-idle-height height)
+			       nil mbw))))
+      (setq-default undisplay-echo-area-resize-window-allowed t))))
 
 ;;Subsumed by view-lossage
 ;; Not really, I'm adding it back by popular demand. -slb
@@ -4235,6 +4266,9 @@
 is nil, it will be displayed.  The string which remains in the echo
 area will be returned, or nil if the message-stack is now empty.
 If LABEL is nil, the entire message-stack is cleared.
+STDOUT-P is ignored, except for output to stream devices.  For streams,
+STDOUT-P non-nil directs output to stdout, otherwise to stderr.  \(This is
+used only in case of restoring an earlier message from the stack.)
 
 Unless you need the return value or you need to specify a label,
 you should just use (message nil)."
@@ -4293,13 +4327,19 @@
       (setq log (cdr log)))))
 
 (defun append-message (label message &optional frame stdout-p)
+  "Add MESSAGE to the message-stack, or append it to the existing text.
+LABEL is the class of the message.  If it is the same as that of the top of
+the message stack, MESSAGE is appended to the existing message, otherwise
+it is pushed on the stack.
+FRAME determines the minibuffer window to send the message to.
+STDOUT-P is ignored, except for output to stream devices.  For streams,
+STDOUT-P non-nil directs output to stdout, otherwise to stderr."
   (or frame (setq frame (selected-frame)))
   ;; If outputting to the terminal, make sure output from anyone else clears
   ;; the left side first, but don't do it ourselves, otherwise we won't be
   ;; able to append to an existing message.
   (if (eq 'stream (frame-type frame))
       (set-device-clear-left-side (frame-device frame) nil))
-  ;; Add a new entry to the message-stack, or modify an existing one
   (let ((top (car message-stack)))
     (if (eq label (car top))
 	(setcdr top (concat (cdr top) message))
@@ -4308,31 +4348,60 @@
   (if (eq 'stream (frame-type frame))
       (set-device-clear-left-side (frame-device frame) t)))
 
-;; Really append the message to the echo area.  no fiddling with
+;; Really append the message to the echo area.  No fiddling with
 ;; message-stack.
 (defun raw-append-message (message &optional frame stdout-p)
   (unless (equal message "")
     (let ((inhibit-read-only t))
       (with-current-buffer " *Echo Area*"
 	(insert-string message)
-	;; (fill-region (point-min) (point-max))
-	(enlarge-window
-	 (- 
-	  (ceiling
-	   (/ (- (point-max) (point-min)) 
-	      (- (window-width (minibuffer-window)) 1.0)))
-	  (window-height (minibuffer-window)))
-	 nil (minibuffer-window)))
-      ;; Conditionalizing on the device type in this way is not that clean,
-      ;; but neither is having a device method, as I originally implemented
-      ;; it: all non-stream devices behave in the same way.  Perhaps
-      ;; the cleanest way is to make the concept of a "redisplayable"
-      ;; device, which stream devices are not.  Look into this more if
-      ;; we ever create another non-redisplayable device type (e.g.
-      ;; processes?  printers?).
+	;; #### This needs to be conditional; cf discussion by Stefan Monnier
+	;; et al on emacs-devel in mid-to-late April 2007.  One problem is
+	;; there is no known good way to guess whether the user wants to have
+	;; the echo area height changed on him asynchronously, especially
+	;; after message display.
+	;; There is also a problem where Lisp backtraces get sent to the echo
+	;; area, thus maxing out the window height.  Unfortunately, it doesn't
+	;; return to a reasonable size very quickly.
+	;; It is not clear that echo area and minibuffer behavior should be
+	;; linked as we do here.  It's OK for now; at least this obeys the
+	;; minibuffer resizing conventions which seem a pretty good guess
+	;; at user preference.
+	(when resize-minibuffer-mode
+	  ;; #### interesting idea, unbearable implementation
+	  ;; (fill-region (point-min) (point-max))
+	  ;;
+	  ;; #### We'd like to be able to do something like
+	  ;;
+	  ;;   (save-window-excursion
+	  ;;     (select-window (minibuffer-window frame))
+	  ;;     (resize-minibuffer-window))))
+	  ;;
+	  ;; but that can't work, because the echo area isn't a real window!
+	  ;; We should fix that, but this is an approximation, duplicating the
+	  ;; resize-minibuffer code.
+	  (let* ((mbw (minibuffer-window frame))
+		 (height (window-height mbw))
+		 (lines (ceiling (/ (- (point-max) (point-min))
+				    (- (window-width mbw) 1.0)))))
+	    (and (numberp resize-minibuffer-window-max-height)
+		 (> resize-minibuffer-window-max-height 0)
+		 (setq lines (min lines
+				  resize-minibuffer-window-max-height)))
+	    (or (if resize-minibuffer-window-exactly
+		    (= lines height)
+		  (<= lines height))
+		(enlarge-window (- lines height) nil mbw)))))
 
       ;; Don't redisplay the echo area if we are executing a macro.
       (if (not executing-kbd-macro)
+	  ;; Conditionalizing on the device type in this way isn't clean, but
+	  ;; neither is having a device method, as I originally implemented
+	  ;; it: all non-stream devices behave in the same way.  Perhaps
+	  ;; the cleanest way is to make the concept of a "redisplayable"
+	  ;; device, which stream devices are not.  Look into this more if
+	  ;; we ever create another non-redisplayable device type (e.g.
+	  ;; processes?  printers?).
 	  (if (eq 'stream (frame-type frame))
 	      (send-string-to-terminal message stdout-p (frame-device frame))
 	    (funcall redisplay-echo-area-function))))))
@@ -4341,6 +4410,8 @@
   "Print a one-line message at the bottom of the frame.  First argument
 LABEL is an identifier for this message.  MESSAGE is the string to display.
 Use `clear-message' to remove a labelled message.
+STDOUT-P is ignored, except for output to stream devices.  For streams,
+STDOUT-P non-nil directs output to stdout, otherwise to stderr.
 
 Here are some standard labels (those marked with `*' are not logged
 by default--see the `log-message-ignore-labels' variable):