PATCH: make ilisp-bury-output handle multiple sinks

   If you have two output frames displayed at the same time
(e.g. compiler warnings and multiline arglist output), ilisp-bury-output
will only get the first one.  The attached patch fixes this by replacing
ilisp-*last-ilisp-output-sink* with ilisp-*output-sink-history*, which
stores a list of output sinks, and thereby keeps track of everything.
And "C-u C-z 1" now buries them all.

   But this may not be the best way to deal with proliferating popup
windows, so I'll wait a few days for comments before committing this.
(And I'll add a comment to the ilisp-last-active-output-sink preamble.)

					-- Bob Rogers
					   http://rgrjr.dyndns.org/

------------------------------------------------------------------------
Index: ilisp-out.el
===================================================================
RCS file: /cvsroot/ilisp/ILISP/ilisp-out.el,v
retrieving revision 1.11
diff -u -r1.11 ilisp-out.el
--- ilisp-out.el	2 Jun 2002 22:50:28 -0000	1.11
+++ ilisp-out.el	7 Sep 2002 17:37:34 -0000
@@ -52,13 +52,6 @@
 The function gets a single argument, a string.")
 
 
-(defvar ilisp-*last-ilisp-output-sink* nil
-  "Last buffer displayed.
-This is needed for 'ilisp-scroll-output', and 'ilisp-bury-output'") 
-
-
-
-
 ;;; ilisp-output-sink --
 ;;; Datastructure for a output sink that points to its 
 ;;; output-{buffers|frames|windows}
@@ -167,6 +160,26 @@
   "An association table between 'commands and 'output sinks.
 It is used to determine where the output of a 'command' should go.")
 
+;;; Output sink history.
+(defvar ilisp-*output-sink-history* nil
+  "List of output sinks (i.e. buffers) that may currently be in use,
+most recent first [internal state variable].  This grows when
+ilisp-output-buffer pushes a new sink onto it, and the topmost sink is
+used by 'ilisp-scroll-output' and 'ilisp-bury-output' (which pops it).
+Use the 'ilisp-last-active-output-sink' function to return the most
+recent sink that is still active, where 'active' means 'currently
+displayed on the screen'.")
+
+(defun ilisp-last-active-output-sink ()
+  (let ((result (car ilisp-*output-sink-history*)))
+    (while (and result
+		(let ((buffer (ilisp-output-sink-buffer result)))
+		  (or (null buffer)
+		      (null (get-buffer-window buffer t)))))
+      ;; not active; pop it, and try the next.
+      (setq ilisp-*output-sink-history* (cdr ilisp-*output-sink-history*))
+      (setq result (car ilisp-*output-sink-history*)))
+    result))
 
 ;;; Accessor functions for
 ;;; 'ilisp-*command-to-ilisp-output-sink-table*'.
@@ -205,8 +218,12 @@
 	(modeline (ilisp-output-sink-modeline ilisp-output-sink))
 	(set-modeline-p (ilisp-output-sink-set-modeline-p ilisp-output-sink))
 	)
-    (setq ilisp-*last-ilisp-output-sink* ilisp-output-sink)
-    ;; save ilisp-output-sink for scrolling and burying
+    ;; save ilisp-output-sink for scrolling and burying.  first, try to clean up
+    ;; old output sinks.
+    (ilisp-last-active-output-sink)
+    (or (eq ilisp-output-sink (car ilisp-*output-sink-history*))
+	(setq ilisp-*output-sink-history*
+	      (cons ilisp-output-sink ilisp-*output-sink-history*)))
     (unless (and (boundp modeline) (symbol-value modeline))
       (when set-modeline-p
 	(setf (symbol-value modeline)
@@ -229,25 +246,37 @@
 ;;; 19991220 Marco Antoniotti
 ;;; Changed the function to take care of the output frame.
 
-(defun* ilisp-bury-output (&optional (pilisp-output-sink nil))
-  "Delete the typeout window, with sink's buffer, if any"
-  (interactive)
-  (let* ((ilisp-output-sink (or pilisp-output-sink
-				ilisp-*last-ilisp-output-sink*))
-         (buffer (ilisp-output-buffer ilisp-output-sink))
-         (window (and buffer (get-buffer-window buffer t)))
-         (frame (ilisp-output-sink-frame ilisp-output-sink)))
-    (when buffer 
-      (with-current-buffer buffer
-        (erase-buffer))
-      (bury-buffer buffer))
+(defun ilisp-bury-output-internal (ilisp-output-sink)
+  ;; given an active output sink, make it go away.
+  (let* ((buffer (ilisp-output-sink-buffer ilisp-output-sink))
+	 (window (and buffer (get-buffer-window buffer t)))
+	 (frame (ilisp-output-sink-frame ilisp-output-sink)))
+    (if (eq ilisp-output-sink (car ilisp-*output-sink-history*))
+	(setq ilisp-*output-sink-history*
+	      (cdr ilisp-*output-sink-history*)))
+    (with-current-buffer buffer
+      (erase-buffer))
+    (bury-buffer buffer)
     (if frame
-      (when (not (eql this-command
-                      'ilisp-arglist-message-lisp-space))
-        (ilisp-delete-message-frame ilisp-output-sink))
-      (when window
-        (ilisp-delete-window window)))))
-
+	(unless (eql this-command 'ilisp-arglist-message-lisp-space)
+	  (ilisp-delete-message-frame ilisp-output-sink))
+	(when window
+	  (ilisp-delete-window window)))))
+
+(defun ilisp-bury-output (&optional bury-all-p)
+  "Delete the topmost typeout window, with sink's buffer, if any.
+If given a numeric argument, deletes all typeout windows."
+  (interactive "P")
+  (let ((ilisp-output-sink (ilisp-last-active-output-sink))
+	(buried-one-p nil))
+    (while (and ilisp-*output-sink-history*
+		(or bury-all-p
+		    (not buried-one-p)))
+      (ilisp-bury-output-internal ilisp-output-sink)
+      (setq buried-one-p t)
+      (setq ilisp-output-sink (ilisp-last-active-output-sink)))
+    (if (not buried-one-p)
+	(message "No more output to bury."))))
 
 (defun ilisp-delete-window (window)
   "Delete a window with minimal redisplay."
@@ -265,25 +294,23 @@
 	  (set-window-start lower-window (point)))
 	(select-window old-window)))))
 
-
 (defun ilisp-scroll-output (&optional lines)
   "Scroll the typeout-window, if any."
   (interactive "P")
-  (let* ((ilisp-output-sink ilisp-*last-ilisp-output-sink*)
-         (buffer (ilisp-output-buffer ilisp-output-sink))
-         (window (and buffer (get-buffer-window buffer t)))
+  (let* ((ilisp-output-sink (or (ilisp-last-active-output-sink)
+				(error "No output to scroll.")))
+	 (buffer (ilisp-output-buffer ilisp-output-sink))
+	 (window (and buffer (get-buffer-window buffer t)))
 	 (old-window (selected-window)))
-    (when window
-      (unwind-protect
-	  (progn
-	    (select-window window)
-	    (set-buffer buffer)
-	    ;; 19990806 Martin Atzmueller
-	    ;; (scroll-up lines)
-	    (let ((scroll-in-place nil))
-	      (scroll-up lines)))
-	(select-window old-window)))))
-
+    (unwind-protect
+	 (progn
+	   (select-window window)
+	   (set-buffer buffer)	;; [maybe redundant?]
+	   ;; 19990806 Martin Atzmueller
+	   ;; (scroll-up lines)
+	   (let ((scroll-in-place nil))
+	     (scroll-up lines)))
+      (select-window old-window))))
 
 (defun ilisp-grow-output (&optional n)
   "Grow the typeout window by ARG (default 1) lines."
@@ -775,7 +802,7 @@
   ;; First clear any existing typeout so as to not confuse the user.
   (or (eq (selected-window)
           (get-buffer-window (ilisp-output-sink-buffer ilisp-output-sink) t))
-      (ilisp-bury-output ilisp-output-sink))
+      (ilisp-bury-output-internal ilisp-output-sink))
   
   ;; v5.7: Patch suggested by [email protected] (Larry Hunter)
   ;; If output contains '%', 'message' loses.
@@ -841,7 +868,8 @@
          (frame  (when window (window-frame window))))
     (cond ((not window)
            (when ilisp-output-sink
-             (ilisp-bury-output ilisp-output-sink)) ; is this neccessary?
+	     ;; is this necessary?
+             (ilisp-bury-output-internal ilisp-output-sink))
            (pop-to-buffer buffer))
           (set-input-focus-p
            (if (fboundp 'select-frame-set-input-focus)


-------------------------------------------------------
This sf.net email is sponsored by: OSDN - Tired of that same old
cell phone?  Get a new here for FREE!
https://www.inphonic.com/r.asp?r=sourceforge1&refcode1=vs3390