APPROVE COMMIT 21.5
This patch causes Adrian's patch of 2006-10-28 for resizing the echo
area to respect resize-minibuffer-mode. I'm of two minds about that,
but I think that these two facilities are so closely related that we
should try to keep their behavior as similar as possible. Also, I've
experienced a bit of annoyance (things like debug backtraces will max
out the echo area, which won't return to normal size until you force a
message), so I think it's important to have a way to turn it off.
It also respects the defcustoms of resize-minibuffer-mode. I added a
new defcustom, `resize-minibuffer-idle-height', which is the target
height of the echo area/minibuffer window when it is idle. (Only
partially unimplemented.) As with resize-minibuffer, there are two
modes: adjust height exactly, and reduce only when too big.
I'm reverting behavior to that of 21.5.27: those who do not enable
resize-minibuffer mode won't get echo area resizing any more. If
nobody objects, I'll enable resize-minibuffer-mode by default later.
(This takes a little work since it was designed as a minor mode.)
I've also added a function to use as an undisplay-echo-area-function,
which reverts the echo area/minibuffer to small size when it's idle.
Unfortunately, it seems really easy to get an uninterruptible infloop
if that function signals or produces any output. Therefore it is
disabled by default, and has lots of warnings in the code and
documentation until I have more experience with it. Feel free to try
it ... I *think* I've got all angles (except deliberate sabotage :-)
covered in the current version.
lisp/ChangeLog addition:
2007-04-30 Stephen J. Turnbull <stephen(a)xemacs.org>
* simple.el (raw-append-message):
Improve resizing of echo area --- now obeys resize-minibuffer
conventions.
* resize-minibuffer.el (resize-minibuffer-idle-height): New.
* simple.el (undisplay-echo-area-resize-window-allowed): New.
* simple.el (undisplay-echo-area-resize-window): New.
Add function to shrink echo area when idle. (incomplete)
* simple.el (log-message-ignore-regexps):
* simple.el (undisplay-echo-area-function):
* simple.el (clear-message):
* simple.el (append-message):
* simple.el (display-message):
Improve docstrings.
21.5 source patch:
Diff command: cvs -q diff -u
Index: lisp/resize-minibuffer.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/resize-minibuffer.el,v
retrieving revision 1.4
diff -u -u -r1.4 resize-minibuffer.el
--- lisp/resize-minibuffer.el 15 Mar 2002 07:43:21 -0000 1.4
+++ lisp/resize-minibuffer.el 30 Apr 2007 13:48:01 -0000
＠＠ -88,6 +88,15 ＠＠
:type '(choice (const nil) integer)
:group 'resize-minibuffer)
+;; #### Yeah, I know. The relation between the echo area and the
+;; minibuffer needs rethinking. It's not really possible to unify them at
+;; present. -- sjt
+(defcustom resize-minibuffer-idle-height nil
+ "When minibuffer is idle, crop its window to this height.
+Must be a positive integer or nil. nil indicates no limit.
+Effective only when `undisplay-echo-area-function' respects it. One such
+function is `undisplay-echo-area-resize-window'.")
+
(defcustom resize-minibuffer-window-exactly t
"*If non-`nil', make minibuffer exactly the size needed to display all its contents.
Otherwise, the minibuffer window can temporarily increase in size but
Index: lisp/simple.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/simple.el,v
retrieving revision 1.58
diff -u -u -r1.58 simple.el
--- lisp/simple.el 29 Dec 2006 18:09:43 -0000 1.58
+++ lisp/simple.el 30 Apr 2007 13:48:03 -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):
---------------- end of patch ----------------
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches

This is the fix for the dreaded memory leak, which isn't a memory leak
at all (which kind of explains why it was so hard to find when I was
looking for leaks).
A clue to the problem is that you can make the leak go away by setting
`gc-cons-percentage' to zero.
I instrumented recompute_need_to_garbage_collect() in gc.c to report the
total memory usage at GC and the percentage used whenever the
percentage-based counting should kick in. It kicked in when I'd
expected: with the default setting for gc-cons-percentage of 40 and a
gc-cons-threshold of 40000000, when the total memory consumed
approximated 70Mb. It soon became obvious that something was very wrong:
total gc usage: 56471356; GC percentage used: -5
[...]
total gc usage: 56471356; GC percentage used: -1
total gc usage: 56471356; GC percentage used: 0
total gc usage: 56471356; GC percentage used: 1
[...]
(consing-since-gc was rising all along, at about 75000000 at this
point, but I wasn't printing it out in this debugging dump.)
The problem is numeric overflow in the percentage-comparison code:
(!total_gc_usage_set ||
(100 * consing_since_gc) / total_gc_usage >=
gc_cons_percentage)
Obviously if consing-since-gc is bigger than about 20Mb (since this is a
*signed* integer) we're pretty much dead; each time around, we allow the
heap to bloat more and more, and GC less and less often: heap
fragmentation just makes things worse, because memory's vanishingly
rarely going to get given back to the OS as long as GCs get less and
less frequent like this.
(This also explains why this leak takes some time to kick in: XEmacs has
to load enough to be governed by gc-cons-percentage rather than
gc-cons-threshold in the first place, particularly if you've got it set
as high as I have. It turns up less often when not using X because not
loading the X stuff means that the total_gc_usage takes longer to reach
that threshold.)
2006-12-29 Nix <nix(a)esperi.org.uk>
* gc.c (recompute_need_to_garbage_collect): Avoid numeric
overflow in percentage calculation.
Index: 21.5/src/gc.c
===================================================================
--- 21.5.orig/src/gc.c 2006-12-29 18:21:43.000000000 +0000
+++ 21.5/src/gc.c 2006-12-29 22:11:22.000000000 +0000
＠＠ -314,12 +314,12 ＠＠
(consing_since_gc > gc_cons_threshold
&&
#if 0 /* #### implement this better */
- (100 * consing_since_gc) / total_data_usage () >=
- gc_cons_percentage
+ ((double)consing_since_gc) / total_data_usage()) >=
+ ((double)gc_cons_percentage / 100)
#else
(!total_gc_usage_set ||
- (100 * consing_since_gc) / total_gc_usage >=
- gc_cons_percentage)
+ ((double)consing_since_gc / total_gc_usage) >=
+ ((double)gc_cons_percentage / 100))
#endif
);
recompute_funcall_allocation_flag ();
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches