diff lisp/window-xemacs.el @ 5645:5d3bb1100832

Remove some utility functions from the global namespace, lisp/ lisp/ChangeLog addition: 2012-04-07 Aidan Kehoe <kehoea@parhasard.net> Remove some utility functions from the global namespace, it's more appropriate to have them as labels (that is, lexically-visible functions.) * behavior.el: * behavior.el (behavior-menu-filter-1): Moved to being a label. * behavior.el (behavior-menu-filter): Use the label. * cus-edit.el (custom-load-symbol-1): Moved to being a label. * cus-edit.el (custom-load-symbol): Use the label. * menubar.el (find-menu-item-1): Moved to being a label. * menubar.el (find-menu-item): Use the label. * window-xemacs.el: * window-xemacs.el (display-buffer-1): Moved to being a label. * window-xemacs.el (display-buffer): Use the label; use (block ...) instead of (catch ...), use prog1 instead of needlessly binding a variable.
author Aidan Kehoe <kehoea@parhasard.net>
date Sat, 07 Apr 2012 21:57:31 +0100
parents ac37a5f7e5be
children c6b1500299a7
line wrap: on
line diff
--- a/lisp/window-xemacs.el	Fri Mar 02 18:26:14 2012 +0000
+++ b/lisp/window-xemacs.el	Sat Apr 07 21:57:31 2012 +0100
@@ -756,18 +756,11 @@
   :type 'integer
   :group 'windows)
 
-;; Deiconify the frame containing the window WINDOW, then return WINDOW.
-
-(defun display-buffer-1 (window)
-  (if (frame-iconified-p (window-frame window))
-      (make-frame-visible (window-frame window)))
-  window)
-
 ;; Can you believe that all of this crap was formerly in C?
 ;; Praise Jesus that it's not there any more.
 
 (defun display-buffer (buffer &optional not-this-window-p override-frame
-			      shrink-to-fit)
+                       shrink-to-fit)
   "Make BUFFER appear in some window on the current frame, but don't select it.
 BUFFER can be a buffer or a buffer name.
 If BUFFER is shown already in some window in the current frame,
@@ -797,271 +790,275 @@
 Returns the window displaying BUFFER."
   (interactive "BDisplay buffer:\nP")
 
-  (let ((wconfig (current-window-configuration))
-	(result
-	 ;; We just simulate a `return' in C.  This function is way ugly
-	 ;; and does `returns' all over the place and there's no sense
-	 ;; in trying to rewrite it to be more Lispy.
-	 (catch 'done
-	   (let (window old-frame target-frame explicit-frame shrink-it)
-	     (setq old-frame (or (last-nonminibuf-frame) (selected-frame)))
-	     (setq buffer (get-buffer buffer))
-	     (check-argument-type 'bufferp buffer)
+  (let ((wconfig (current-window-configuration)))
+    (prog1
+        ;; We just simulate a `return' in C.  This function is way
+        ;; ugly and does `returns' all over the place and there's
+        ;; no sense in trying to rewrite it to be more Lispy.
+        (block nil
+          (labels
+              ((display-buffer-1 (window)
+                 ;; Deiconify the frame containing the window WINDOW, then
+                 ;; return WINDOW.
+                 (if (frame-iconified-p (window-frame window))
+                     (make-frame-visible (window-frame window)))
+                 window))
+            (let (window old-frame target-frame explicit-frame shrink-it)
+              (setq old-frame (or (last-nonminibuf-frame) (selected-frame)))
+              (setq buffer (get-buffer buffer))
+              (check-argument-type 'bufferp buffer)
 
-	     (setq explicit-frame
-		   (if pre-display-buffer-function
-		       (funcall pre-display-buffer-function buffer
-				not-this-window-p
-				override-frame
-				shrink-to-fit)))
-
-	     ;; Give the user the ability to completely reimplement
-	     ;; this function via the `display-buffer-function'.
-	     (if display-buffer-function
-		 (throw 'done
-			(funcall display-buffer-function buffer
-				 not-this-window-p
-				 override-frame
-				 shrink-to-fit)))
+              (setq explicit-frame
+                    (if pre-display-buffer-function
+                        (funcall pre-display-buffer-function buffer
+                                 not-this-window-p
+                                 override-frame
+                                 shrink-to-fit)))
 
-	     ;; If the buffer has a dedicated frame, that takes
-	     ;; precedence over the current frame, and over what the
-	     ;; pre-display-buffer-function did.
-	     (let ((dedi (buffer-dedicated-frame buffer)))
-	       (if (frame-live-p dedi) (setq explicit-frame dedi)))
+              ;; Give the user the ability to completely reimplement
+              ;; this function via the `display-buffer-function'.
+              (if display-buffer-function
+                  (return (funcall display-buffer-function buffer
+                                   not-this-window-p
+                                   override-frame
+                                   shrink-to-fit)))
 
-	     ;; if override-frame is supplied, that takes precedence over
-	     ;; everything.  This is gonna look bad if the
-	     ;; pre-display-buffer-function raised some other frame
-	     ;; already.
-	     (if override-frame
-		 (progn
-		   (check-argument-type 'frame-live-p override-frame)
-		   (setq explicit-frame override-frame)))
+              ;; If the buffer has a dedicated frame, that takes
+              ;; precedence over the current frame, and over what the
+              ;; pre-display-buffer-function did.
+              (let ((dedi (buffer-dedicated-frame buffer)))
+                (if (frame-live-p dedi) (setq explicit-frame dedi)))
 
-	     (setq target-frame
-		   (or explicit-frame
-		       (last-nonminibuf-frame)
-		       (selected-frame)))
+              ;; if override-frame is supplied, that takes precedence over
+              ;; everything.  This is gonna look bad if the
+              ;; pre-display-buffer-function raised some other frame already.
+              (if override-frame
+                  (progn
+                    (check-argument-type 'frame-live-p override-frame)
+                    (setq explicit-frame override-frame)))
 
-	     ;; If we have switched frames, then set not-this-window-p
-	     ;; to false.  Switching frames means that selected-window
-	     ;; is no longer the same as it was on entry -- it's the
-	     ;; selected-window of target_frame instead of old_frame,
-	     ;; so it's a fine candidate for display.
-	     (if (not (eq old-frame target-frame))
-		 (setq not-this-window-p nil))
+              (setq target-frame
+                    (or explicit-frame
+                        (last-nonminibuf-frame)
+                        (selected-frame)))
 
-	     ;; if it's in the selected window, and that's ok, then we're done.
-	     (if (and (not not-this-window-p)
-		      (eq buffer (window-buffer (selected-window))))
-		 (throw 'done (display-buffer-1 (selected-window))))
+              ;; If we have switched frames, then set not-this-window-p to
+              ;; false.  Switching frames means that selected-window is no
+              ;; longer the same as it was on entry -- it's the
+              ;; selected-window of target_frame instead of old_frame, so
+              ;; it's a fine candidate for display.
+              (if (not (eq old-frame target-frame))
+                  (setq not-this-window-p nil))
 
-	     ;; See if the user has specified this buffer should appear
-	     ;; in the selected window.
-
-	     (if not-this-window-p
-		 nil
+              ;; if it's in the selected window, and that's ok, then we're
+              ;; done.
+              (if (and (not not-this-window-p)
+                   (eq buffer (window-buffer (selected-window))))
+                  (return (display-buffer-1 (selected-window))))
 
-	       (if (or (member (buffer-name buffer) same-window-buffer-names)
-		       (assoc (buffer-name buffer) same-window-buffer-names))
-		   (progn
-		     (switch-to-buffer buffer)
-		     (throw 'done (display-buffer-1 (selected-window)))))
+              ;; See if the user has specified this buffer should
+              ;; appear in the selected window.
 
-	       (let ((tem same-window-regexps))
-		 (while tem
-		   (let ((car (car tem)))
-		     (if (or
-			  (and (stringp car)
-			       (string-match car (buffer-name buffer)))
-			  (and (consp car) (stringp (car car))
-			       (string-match (car car) (buffer-name buffer))))
-			 (progn
-			   (switch-to-buffer buffer)
-			   (throw 'done (display-buffer-1
-					 (selected-window))))))
-		   (setq tem (cdr tem)))))
+              (if not-this-window-p
+                  nil
+                (if (or (member (buffer-name buffer) same-window-buffer-names)
+                        (assoc (buffer-name buffer) same-window-buffer-names))
+                    (progn
+                      (switch-to-buffer buffer)
+                      (return (display-buffer-1 (selected-window)))))
+
+                (let ((tem same-window-regexps))
+                  (while tem
+                    (let ((car (car tem)))
+                      (if (or
+                           (and (stringp car)
+                                (string-match car (buffer-name buffer)))
+                           (and (consp car) (stringp (car car))
+                                (string-match (car car) (buffer-name buffer))))
+                          (progn
+                            (switch-to-buffer buffer)
+                            (return (display-buffer-1 (selected-window))))))
+                    (setq tem (cdr tem)))))
 
-	     ;; If pop-up-frames, look for a window showing BUFFER on
-	     ;; any visible or iconified frame.  Otherwise search only
-	     ;; the current frame.
-	     (if (and (not explicit-frame)
-		      (or pop-up-frames (not (last-nonminibuf-frame))))
-		 (setq target-frame 0))
+              ;; If pop-up-frames, look for a window showing BUFFER
+              ;; on any visible or iconified frame.  Otherwise search
+              ;; only the current frame.
+              (if (and (not explicit-frame)
+                   (or pop-up-frames (not (last-nonminibuf-frame))))
+                  (setq target-frame 0))
 
-	     ;; Otherwise, find some window that it's already in, and
-	     ;; return that, unless that window is the selected window
-	     ;; and that isn't ok.  What a contorted mess!
-	     (setq window (or (if (not explicit-frame)
-				  ;; search the selected frame
-				  ;; first if the user didn't
-				  ;; specify an explicit frame.
-				  (get-buffer-window buffer nil))
-			      (get-buffer-window buffer target-frame)))
-	     (if (and window
-		      (or (not not-this-window-p)
-			  (not (eq window (selected-window)))))
-		 (throw 'done (display-buffer-1 window)))
+              ;; Otherwise, find some window that it's already in,
+              ;; and return that, unless that window is the selected
+              ;; window and that isn't ok.  What a contorted mess!
+              (setq window (or (if (not explicit-frame)
+                                   ;; search the selected frame
+                                   ;; first if the user didn't
+                                   ;; specify an explicit frame.
+                                   (get-buffer-window buffer nil))
+                               (get-buffer-window buffer target-frame)))
+              (if (and window
+                   (or (not not-this-window-p)
+                       (not (eq window (selected-window)))))
+                  (return (display-buffer-1 window)))
+              ;; Certain buffer names get special handling.
+              (if special-display-function
+                  (progn
+                    (if (member (buffer-name buffer)
+                                special-display-buffer-names)
+                        (return (funcall special-display-function buffer)))
 
-	     ;; Certain buffer names get special handling.
-	     (if special-display-function
-		 (progn
-		   (if (member (buffer-name buffer)
-			       special-display-buffer-names)
-		       (throw 'done (funcall special-display-function buffer)))
-
-		   (let ((tem (assoc (buffer-name buffer)
-				     special-display-buffer-names)))
-		     (if tem
-			 (throw 'done (funcall special-display-function
-					       buffer (cdr tem)))))
+                    (let ((tem (assoc (buffer-name buffer)
+                                      special-display-buffer-names)))
+                      (if tem
+                          (return (funcall special-display-function
+                                           buffer (cdr tem)))))
 
-		   (let ((tem special-display-regexps))
-		     (while tem
-		       (let ((car (car tem)))
-			 (if (and (stringp car)
-				  (string-match car (buffer-name buffer)))
-			     (throw 'done
-				    (funcall special-display-function buffer)))
-			 (if (and (consp car)
-				  (stringp (car car))
-				  (string-match (car car)
-						(buffer-name buffer)))
-			     (throw 'done (funcall
-					   special-display-function buffer
-					   (cdr car)))))
-		       (setq tem (cdr tem))))))
+                    (let ((tem special-display-regexps))
+                      (while tem
+                        (let ((car (car tem)))
+                          (if (and (stringp car)
+                                   (string-match car (buffer-name buffer)))
+                              (return
+                               (funcall special-display-function buffer)))
+                          (if (and (consp car)
+                                   (stringp (car car))
+                                   (string-match (car car)
+                                                 (buffer-name buffer)))
+                              (return (funcall special-display-function buffer
+                                               (cdr car)))))
+                        (setq tem (cdr tem))))))
 
-	     ;; If there are no frames open that have more than a minibuffer,
-	     ;; we need to create a new frame.
-	     (if (or pop-up-frames
-		     (null (last-nonminibuf-frame)))
-		 (progn
-		   (setq window (frame-selected-window
-				 (funcall pop-up-frame-function)))
-		   (set-window-buffer window buffer)
-		   (throw 'done (display-buffer-1 window))))
+              ;; If there are no frames open that have more than a minibuffer,
+              ;; we need to create a new frame.
+              (if (or pop-up-frames
+                   (null (last-nonminibuf-frame)))
+                  (progn
+                    (setq window (frame-selected-window
+                                  (funcall pop-up-frame-function)))
+                    (set-window-buffer window buffer)
+                    (return (display-buffer-1 window))))
 
-	     ;; Otherwise, make it be in some window, splitting if
-	     ;; appropriate/possible.  Do not split a window if we are
-	     ;; displaying the buffer in a different frame than that which
-	     ;; was current when we were called.  (It is already in a
-	     ;; different window by virtue of being in another frame.)
-	     (if (or (and pop-up-windows (eq target-frame old-frame))
-		     (eq 'only (frame-property (selected-frame) 'minibuffer))
-		     ;; If the current frame is a special display frame,
-		     ;; don't try to reuse its windows.
-		     (window-dedicated-p (frame-root-window (selected-frame))))
-		 (progn
-		   (if (eq 'only (frame-property (selected-frame) 'minibuffer))
-		       (setq target-frame (last-nonminibuf-frame)))
+              ;; Otherwise, make it be in some window, splitting if
+              ;; appropriate/possible.  Do not split a window if we
+              ;; are displaying the buffer in a different frame than
+              ;; that which was current when we were called.  (It is
+              ;; already in a different window by virtue of being in
+              ;; another frame.)
+              (if (or (and pop-up-windows (eq target-frame old-frame))
+                   (eq 'only (frame-property (selected-frame) 'minibuffer))
+                   ;; If the current frame is a special display frame,
+                   ;; don't try to reuse its windows.
+                   (window-dedicated-p
+                    (frame-root-window (selected-frame))))
+                  (progn
+                    (if (eq 'only (frame-property (selected-frame)
+                                                  'minibuffer))
+                        (setq target-frame (last-nonminibuf-frame)))
 
-		   ;; Don't try to create a window if would get an error with
-		   ;; height.
-		   (if (< split-height-threshold (* 2 window-min-height))
-		       (setq split-height-threshold (* 2 window-min-height)))
+                    ;; Don't try to create a window if would get an error with
+                    ;; height.
+                    (if (< split-height-threshold (* 2 window-min-height))
+                        (setq split-height-threshold (* 2 window-min-height)))
 
-		   ;; Same with width.
-		   (if (< split-width-threshold (* 2 window-min-width))
-		       (setq split-width-threshold (* 2 window-min-width)))
+                    ;; Same with width.
+                    (if (< split-width-threshold (* 2 window-min-width))
+                        (setq split-width-threshold (* 2 window-min-width)))
 
-		   ;; If the frame we would try to split cannot be split,
-		   ;; try other frames.
-		   (if (frame-property (if (null target-frame)
-					   (selected-frame)
-					 (last-nonminibuf-frame))
-				       'unsplittable)
-		       (setq window
-			     ;; Try visible frames first.
-			     (or (get-largest-window 'visible)
-				 ;; If that didn't work, try iconified frames.
-				 (get-largest-window 0)
-				 (get-largest-window t)))
-		     (setq window (get-largest-window target-frame)))
+                    ;; If the frame we would try to split cannot be split,
+                    ;; try other frames.
+                    (if (frame-property (if (null target-frame)
+                                            (selected-frame)
+                                          (last-nonminibuf-frame))
+                                        'unsplittable)
+                        (setq window
+                              ;; Try visible frames first.
+                              (or (get-largest-window 'visible)
+                                  ;; If that didn't work, try iconified frames.
+                                  (get-largest-window 0)
+                                  (get-largest-window t)))
+                      (setq window (get-largest-window target-frame)))
 
-		   ;; If we got a tall enough full-width window that
-		   ;; can be split, split it.
-		   (if (and window
-			    (not (frame-property (window-frame window)
-						 'unsplittable))
-			    (>= (window-height window) split-height-threshold)
-			    (or (>= (window-width window)
-				    split-width-threshold)
-				(and (window-leftmost-p window)
-				     (window-rightmost-p window))))
-		       (setq window (split-window window))
-		     (let (upper other)
-		       (setq window (get-lru-window target-frame))
-		       ;; If the LRU window is selected, and big enough,
-		       ;; and can be split, split it.
-		       (if (and window
-				(not (frame-property (window-frame window)
-						     'unsplittable))
-				(or (eq window (selected-window))
-				    (not (window-parent window)))
-				(>= (window-height window)
-				    (* 2 window-min-height)))
-			   (setq window (split-window window)))
-		       ;; If get-lru-window returned nil, try other approaches.
-		       ;; Try visible frames first.
-		       (or window
-			   (setq window (or (get-largest-window 'visible)
-					    ;; If that didn't work, try
-					    ;; iconified frames.
-					    (get-largest-window 0)
-					    ;; Try invisible frames.
-					    (get-largest-window t)
-					    ;; As a last resort, make
-					    ;; a new frame.
-					    (frame-selected-window
-					     (funcall
-					      pop-up-frame-function)))))
-		       ;; If window appears above or below another,
-		       ;; even out their heights.
-		       (if (window-previous-child window)
-			   (setq other (window-previous-child window)
-				 upper other))
-		       (if (window-next-child window)
-			   (setq other (window-next-child window)
-				 upper window))
-		       ;; Check that OTHER and WINDOW are vertically arrayed.
-		       (if (and other
-				(not (= (nth 1 (window-pixel-edges other))
-					(nth 1 (window-pixel-edges window))))
-				(> (window-pixel-height other)
-				   (window-pixel-height window)))
-			   (enlarge-window (- (/ (+ (window-height other)
-						    (window-height window))
-						 2)
-					      (window-height upper))
-					   nil upper))
-                       ;; Klaus Berndl <klaus.berndl@sdm.de>: Only in
-                       ;; this situation we shrink-to-fit but we can do
-                       ;; this first after we have displayed buffer in
-                       ;; window (s.b. (set-window-buffer window buffer))
-                       (setq shrink-it shrink-to-fit))))
+                    ;; If we got a tall enough full-width window that
+                    ;; can be split, split it.
+                    (if (and window
+                             (not (frame-property (window-frame window)
+                                                  'unsplittable))
+                             (>= (window-height window) split-height-threshold)
+                             (or (>= (window-width window)
+                                     split-width-threshold)
+                                 (and (window-leftmost-p window)
+                                      (window-rightmost-p window))))
+                        (setq window (split-window window))
+                      (let (upper other)
+                        (setq window (get-lru-window target-frame))
+                        ;; If the LRU window is selected, and big enough,
+                        ;; and can be split, split it.
+                        (if (and window
+                                 (not (frame-property (window-frame window)
+                                                      'unsplittable))
+                                 (or (eq window (selected-window))
+                                     (not (window-parent window)))
+                                 (>= (window-height window)
+                                     (* 2 window-min-height)))
+                            (setq window (split-window window)))
+                        ;; If get-lru-window returned nil, try other
+                        ;; approaches.  Try visible frames first.
+                        (or window
+                            (setq window (or (get-largest-window 'visible)
+                                             ;; If that didn't work, try
+                                             ;; iconified frames.
+                                             (get-largest-window 0)
+                                             ;; Try invisible frames.
+                                             (get-largest-window t)
+                                             ;; As a last resort, make
+                                             ;; a new frame.
+                                             (frame-selected-window
+                                              (funcall
+                                               pop-up-frame-function)))))
+                        ;; If window appears above or below another,
+                        ;; even out their heights.
+                        (if (window-previous-child window)
+                            (setq other (window-previous-child window)
+                                  upper other))
+                        (if (window-next-child window)
+                            (setq other (window-next-child window)
+                                  upper window))
+                        ;; Check that OTHER and WINDOW are vertically arrayed.
+                        (if (and other
+                                 (not (= (nth 1 (window-pixel-edges other))
+                                         (nth 1 (window-pixel-edges window))))
+                                 (> (window-pixel-height other)
+                                    (window-pixel-height window)))
+                            (enlarge-window (- (/ (+ (window-height other)
+                                                     (window-height window))
+                                                  2)
+                                               (window-height upper))
+                                            nil upper))
+                        ;; Klaus Berndl <klaus.berndl@sdm.de>: Only in
+                        ;; this situation we shrink-to-fit but we can do
+                        ;; this first after we have displayed buffer in
+                        ;; window (s.b. (set-window-buffer window buffer))
+                        (setq shrink-it shrink-to-fit))))
 
-	       (setq window (get-lru-window target-frame)))
+                (setq window (get-lru-window target-frame)))
 
-	     ;; Bring the window's previous buffer to the top of the MRU chain.
-	     (if (window-buffer window)
-		 (save-excursion
-		   (save-selected-window
-		     (select-window window)
-		     (record-buffer (window-buffer window)))))
-
-	     (set-window-buffer window buffer)
+              ;; Bring the window's previous buffer to the top of the
+              ;; MRU chain.
+              (if (window-buffer window)
+                  (save-excursion
+                    (save-selected-window
+                      (select-window window)
+                      (record-buffer (window-buffer window)))))
 
-             ;; Now window's previous buffer has been brought to the top
-             ;; of the MRU chain and window displays buffer - now we can
-             ;; shrink-to-fit if necessary
-             (if shrink-it
-                 (shrink-window-if-larger-than-buffer window))
+              (set-window-buffer window buffer)
 
-	     (display-buffer-1 window)))))
-    (or (equal wconfig (current-window-configuration))
-	(push-window-configuration wconfig))
-    result))
+              ;; Now window's previous buffer has been brought to the
+              ;; top of the MRU chain and window displays buffer -
+              ;; now we can shrink-to-fit if necessary
+              (if shrink-it
+                  (shrink-window-if-larger-than-buffer window))
+              (display-buffer-1 window)))) ;; End of prog1's 1th form.
+      (or (equal wconfig (current-window-configuration))
+          (push-window-configuration wconfig)))))
 
 ;;; window-xemacs.el ends here