Mercurial > hg > xemacs-beta
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