Mercurial > hg > xemacs-beta
annotate lisp/window-xemacs.el @ 5652:cc6f0266bc36
Avoid #'delq in core Lisp, for the sake of style, a very slightly smaller binary
lisp/ChangeLog addition:
2012-05-01 Aidan Kehoe <kehoea@parhasard.net>
Avoid #'delq in core code, for the sake of style and a (very
slightly) smaller binary.
* behavior.el (disable-behavior):
* behavior.el (compute-behavior-group-children):
* buff-menu.el (buffers-tab-items):
* byte-optimize.el (byte-optimize-delay-constants-math):
* byte-optimize.el (byte-optimize-logmumble):
* byte-optimize.el (byte-decompile-bytecode-1):
* byte-optimize.el (byte-optimize-lapcode):
* bytecomp.el:
* bytecomp.el (byte-compile-arglist-warn):
* bytecomp.el (byte-compile-warn-about-unresolved-functions):
* bytecomp.el (byte-compile-lambda):
* bytecomp.el (byte-compile-out-toplevel):
* bytecomp.el (byte-compile-insert):
* bytecomp.el (byte-compile-defalias-warn):
* cl-macs.el (cl-upcase-arg):
* cl-macs.el (cl-transform-lambda):
* cl-macs.el (cl-do-proclaim):
* cl-macs.el (defstruct):
* cl-macs.el (cl-make-type-test):
* cl-macs.el (define-compiler-macro):
* cl-macs.el (delete-duplicates):
* cus-edit.el (widget-face-value-delete):
* cus-edit.el (face-history):
* easymenu.el (easy-menu-remove):
* files.el (files-fetch-hook-value):
* files.el (file-expand-wildcards):
* font-lock.el (font-lock-update-removed-keyword-alist):
* font-lock.el (font-lock-remove-keywords):
* frame.el (frame-initialize):
* frame.el (frame-notice-user-settings):
* frame.el (set-frame-font):
* frame.el (delete-other-frames):
* frame.el (get-frame-for-buffer-noselect):
* gnuserv.el (gnuserv-kill-buffer-function):
* gnuserv.el (gnuserv-check-device):
* gnuserv.el (gnuserv-kill-client):
* gnuserv.el (gnuserv-buffer-done-1):
* gtk-font-menu.el (gtk-reset-device-font-menus):
* gutter-items.el (buffers-tab-items):
* gutter.el (set-gutter-element-visible-p):
* info.el (Info-find-file-node):
* info.el (Info-history-add):
* info.el (Info-build-annotation-completions):
* info.el (Info-index):
* info.el (Info-reannotate-node):
* itimer.el (delete-itimer):
* itimer.el (start-itimer):
* lib-complete.el (lib-complete:cache-completions):
* loadhist.el (unload-feature):
* menubar-items.el (build-buffers-menu-internal):
* menubar.el (delete-menu-item):
* menubar.el (relabel-menu-item):
* msw-font-menu.el (mswindows-reset-device-font-menus):
* mule/make-coding-system.el (fixed-width-generate-helper):
* next-error.el (next-error-find-buffer):
* obsolete.el:
* obsolete.el (find-non-ascii-charset-string):
* obsolete.el (find-non-ascii-charset-region):
* occur.el (multi-occur-by-filename-regexp):
* occur.el (occur-1):
* packages.el (packages-package-hierarchy-directory-names):
* packages.el (package-get-key-1):
* process.el (setenv):
* simple.el (undo):
* simple.el (handle-pre-motion-command-current-command-is-motion):
* sound.el (load-sound-file):
* wid-edit.el (widget-field-value-delete):
* wid-edit.el (widget-checklist-match-inline):
* wid-edit.el (widget-checklist-match-find):
* wid-edit.el (widget-editable-list-delete-at):
* wid-edit.el (widget-editable-list-entry-create):
* window.el (quit-window):
* x-font-menu.el (x-reset-device-font-menus-core):
1. Replace (delq nil (mapcar ....)) with analogous (mapcan ...)
forms; this is in non-dumped files, it was done previously in
dumped files.
2. Replace (delq FOO (copy-sequence BAR)) with (remove* FOO BAR),
where #'eq and #'eql are equivalent
3. Replace (delq FOO BAR) with (delete* FOO BAR), where FOO is not
a non-fixnum number. Saves a little space in the dumped file
(since the compiler macro adds :test #'eq to the delete* call if
it's not clear that FOO is not a non-fixnum number).
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Tue, 01 May 2012 16:17:42 +0100 |
| parents | 5d3bb1100832 |
| children | c6b1500299a7 |
| rev | line source |
|---|---|
| 428 | 1 ;;; window-xemacs.el --- XEmacs window commands aside from those written in C. |
| 2 | |
| 3 ;; Copyright (C) 1985, 1989, 1993-94, 1997 Free Software Foundation, Inc. | |
| 4 ;; Copyright (C) 1995, 1996 Ben Wing. | |
| 5 | |
| 6 ;; Maintainer: XEmacs Development Team | |
| 7 ;; Keywords: frames, extensions, dumped | |
| 8 | |
| 9 ;; This file is part of XEmacs. | |
| 10 | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4674
diff
changeset
|
11 ;; XEmacs is free software: you can redistribute it and/or modify it |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4674
diff
changeset
|
12 ;; under the terms of the GNU General Public License as published by the |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4674
diff
changeset
|
13 ;; Free Software Foundation, either version 3 of the License, or (at your |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4674
diff
changeset
|
14 ;; option) any later version. |
| 428 | 15 |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4674
diff
changeset
|
16 ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4674
diff
changeset
|
17 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4674
diff
changeset
|
18 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4674
diff
changeset
|
19 ;; for more details. |
| 428 | 20 |
| 21 ;; You should have received a copy of the GNU General Public License | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4674
diff
changeset
|
22 ;; along with XEmacs. If not, see <http://www.gnu.org/licenses/>. |
| 428 | 23 |
| 24 ;;; Synched up with: Not synched. | |
| 25 | |
| 26 ;;; Commentary: | |
| 27 | |
| 28 ;; This file is dumped with XEmacs. | |
| 29 | |
| 30 ;; slb - 5/29/97 | |
| 31 ;; Split apart from window.el in order to keep that file better in synch | |
| 32 ;; with Emacs. | |
| 33 | |
| 34 ;;; Code: | |
| 35 | |
| 36 (defgroup windows nil | |
| 37 "Windows within a frame." | |
| 38 :group 'environment) | |
| 39 | |
| 40 (defun recenter (&optional n window) | |
| 41 "Center point in WINDOW and redisplay frame. With N, put point on line N. | |
| 42 The desired position of point is always relative to the window. | |
| 43 Just C-u as prefix means put point in the center of the window. | |
| 44 No N (i.e., it is nil) erases the entire frame and then | |
| 45 redraws with point in the center of the window. | |
| 46 If WINDOW is nil, the selected window is used." | |
| 47 (interactive "_P") | |
| 48 (center-to-window-line (if (consp n) nil n) window) | |
| 49 (when (null n) | |
| 50 (redraw-frame (window-frame window) t))) | |
| 51 | |
| 444 | 52 (defun backward-other-window (count &optional which-frames which-devices) |
| 53 "Select the COUNT'th different window on this frame, going backwards. | |
| 54 This is just like calling `other-window' with COUNT negated." | |
| 428 | 55 (interactive "p") |
| 444 | 56 (other-window (- count) which-frames which-devices)) |
| 428 | 57 |
| 58 (defalias 'windows-of-buffer 'get-buffer-window-list) | |
| 59 | |
| 60 (defun buffer-in-multiple-windows-p (&optional buffer) | |
| 61 "Return t if BUFFER is in multiple windows. | |
| 62 If BUFFER is not specified, the current buffer will be used." | |
| 63 (setq buffer (or buffer | |
| 64 (get-buffer buffer) | |
| 65 (get-file-buffer buffer) | |
| 66 (current-buffer))) | |
| 67 (> (length (windows-of-buffer buffer)) 1)) | |
| 68 | |
| 69 (defun window-list (&optional frame minibuf window) | |
| 70 "Return a list of windows on FRAME, beginning with WINDOW. | |
| 71 FRAME and WINDOW default to the selected ones. | |
| 72 Optional second arg MINIBUF t means count the minibuffer window | |
| 73 even if not active. If MINIBUF is neither t nor nil it means | |
| 74 not to count the minibuffer even if it is active." | |
| 1261 | 75 (setq frame (or frame (selected-frame)) |
| 76 window (or window (selected-window frame))) | |
| 428 | 77 (if (not (eq (window-frame window) frame)) |
| 78 (error "Window must be on frame.")) | |
| 79 (let ((current-frame (selected-frame)) | |
| 80 list) | |
| 81 (unwind-protect | |
| 82 (save-window-excursion | |
| 83 (select-frame frame) | |
| 84 (walk-windows | |
| 85 (function (lambda (cur-window) | |
| 86 (if (not (eq window cur-window)) | |
| 87 (setq list (cons cur-window list))))) | |
| 88 minibuf) | |
| 89 (setq list (cons window list))) | |
| 90 (select-frame current-frame)))) | |
| 91 | |
| 92 ;; We used to have set-window-dedicated-p as an obsolete version | |
| 93 ;; of set-window-buffer-dedicated, but it really makes more sense | |
| 94 ;; this way. | |
| 95 | |
| 96 (make-obsolete 'set-window-buffer-dedicated 'set-window-dedicated-p) | |
| 97 (defun set-window-buffer-dedicated (window buffer) | |
| 98 "Make WINDOW display BUFFER and be dedicated to that buffer. | |
| 99 Then Emacs will not automatically change which buffer appears in WINDOW. | |
| 100 If BUFFER is nil, make WINDOW not be dedicated (but don't change which | |
| 101 buffer appears in it currently)." | |
| 102 (if (bufferp buffer) | |
| 103 (set-window-buffer window (get-buffer-create buffer))) | |
| 104 (set-window-dedicated-p window (not (null buffer)))) | |
| 1149 | 105 |
| 106 ;; Window configurations | |
| 428 | 107 |
| 3646 | 108 (defcustom window-configuration-includes-position nil |
| 109 "*Whether restoring window configurations will restore positions too. | |
| 110 If nil, only the size of windows will be restored. | |
| 111 | |
| 112 Note that setting this value to t may have counterintuitive consequences, | |
| 113 if a window manager employing virtual desktops is in use." | |
| 114 :type 'boolean | |
| 115 :group 'windows) | |
| 116 | |
| 1149 | 117 (defstruct saved-window |
| 118 currentp minibufferp minibuffer-scrollp | |
| 119 buffer mark-marker | |
| 120 start-marker | |
| 121 point-marker | |
| 122 pixel-left pixel-top pixel-right pixel-bottom | |
| 123 hscroll modeline-hscroll | |
| 124 dedicatedp | |
|
4445
1d41b9bcf74f
Add `set-window-configuration/mapping' and `save-window-excursion/mapping'.
Mike Sperber <sperber@deinprogramm.de>
parents:
4444
diff
changeset
|
125 first-hchild first-vchild next-child |
|
1d41b9bcf74f
Add `set-window-configuration/mapping' and `save-window-excursion/mapping'.
Mike Sperber <sperber@deinprogramm.de>
parents:
4444
diff
changeset
|
126 window) |
| 1149 | 127 |
| 128 (defstruct window-configuration | |
| 129 frame | |
| 2872 | 130 frame-top frame-left |
| 1149 | 131 frame-pixel-width frame-pixel-height |
| 132 current-buffer | |
| 133 minibuffer-pixel-height | |
| 134 min-width min-height | |
| 135 saved-root-window) | |
| 136 | |
|
4444
715c3ced8fa8
Use `real-split-window', `real-delete-window' in window-config code.
Mike Sperber <sperber@deinprogramm.de>
parents:
4438
diff
changeset
|
137 ; make sure we don't get affected by harmful advice |
|
715c3ced8fa8
Use `real-split-window', `real-delete-window' in window-config code.
Mike Sperber <sperber@deinprogramm.de>
parents:
4438
diff
changeset
|
138 (fset 'real-split-window (symbol-function 'split-window)) |
|
715c3ced8fa8
Use `real-split-window', `real-delete-window' in window-config code.
Mike Sperber <sperber@deinprogramm.de>
parents:
4438
diff
changeset
|
139 (fset 'real-delete-window (symbol-function 'delete-window)) |
|
715c3ced8fa8
Use `real-split-window', `real-delete-window' in window-config code.
Mike Sperber <sperber@deinprogramm.de>
parents:
4438
diff
changeset
|
140 |
| 1149 | 141 (defun window-configuration-equal (conf-1 conf-2) |
| 142 "Returns a boolean indicating whether the two given configurations | |
| 3646 | 143 are identical. |
| 144 | |
| 145 Window configurations containing windows with different window | |
| 146 positions are not identical iff `window-configuration-includes-position' | |
| 147 is t." | |
| 1149 | 148 (or (eq conf-1 conf-2) |
| 149 (and (eq (window-configuration-frame conf-1) | |
| 150 (window-configuration-frame conf-2)) | |
| 151 (= (window-configuration-frame-pixel-width conf-1) | |
| 152 (window-configuration-frame-pixel-width conf-2)) | |
| 153 (= (window-configuration-frame-pixel-height conf-1) | |
| 154 (window-configuration-frame-pixel-height conf-2)) | |
| 3646 | 155 (if window-configuration-includes-position |
| 156 (and (equal (window-configuration-frame-top conf-1) | |
| 157 (window-configuration-frame-top conf-2)) | |
| 158 (equal (window-configuration-frame-left conf-1) | |
| 159 (window-configuration-frame-left conf-2))) | |
| 160 t) | |
| 1149 | 161 (eq (window-configuration-current-buffer conf-1) |
| 162 (window-configuration-current-buffer conf-2)) | |
| 163 (saved-window-equal (window-configuration-saved-root-window conf-1) | |
| 164 (window-configuration-saved-root-window conf-2))))) | |
| 165 | |
| 166 (defun saved-window-equal (saved-1 saved-2) | |
| 167 "Returns a boolean indicating whether the two given saved windows | |
| 168 are identical." | |
| 169 (or (eq saved-1 saved-2) | |
| 170 (and (eq (saved-window-currentp saved-1) | |
| 171 (saved-window-currentp saved-2)) | |
| 172 (eq (saved-window-minibuffer-scrollp saved-1) | |
| 173 (saved-window-minibuffer-scrollp saved-2)) | |
| 174 (eq (saved-window-buffer saved-1) | |
| 175 (saved-window-buffer saved-2)) | |
| 176 (equal (saved-window-mark-marker saved-1) | |
| 177 (saved-window-mark-marker saved-2)) | |
| 178 (or (and (saved-window-currentp saved-1) | |
| 179 (saved-window-currentp saved-2)) | |
| 180 (equal (saved-window-start-marker saved-1) | |
| 181 (saved-window-start-marker saved-2))) | |
| 182 (or (and (saved-window-currentp saved-1) | |
| 183 (saved-window-currentp saved-2)) | |
| 184 (equal (saved-window-point-marker saved-1) | |
| 185 (saved-window-point-marker saved-2))) | |
| 186 (= (saved-window-pixel-left saved-1) | |
| 187 (saved-window-pixel-left saved-2)) | |
| 188 (= (saved-window-pixel-top saved-1) | |
| 189 (saved-window-pixel-top saved-2)) | |
| 190 (= (saved-window-pixel-right saved-1) | |
| 191 (saved-window-pixel-right saved-2)) | |
| 192 (= (saved-window-pixel-bottom saved-1) | |
| 193 (saved-window-pixel-bottom saved-2)) | |
| 194 (= (saved-window-hscroll saved-1) | |
| 195 (saved-window-hscroll saved-2)) | |
| 1387 | 196 (equal (saved-window-modeline-hscroll saved-1) |
| 197 (saved-window-modeline-hscroll saved-2)) | |
| 1149 | 198 (eq (saved-window-dedicatedp saved-1) |
| 199 (saved-window-dedicatedp saved-2)) | |
| 200 (maybe-saved-window-equal (saved-window-first-hchild saved-1) | |
| 201 (saved-window-first-hchild saved-2)) | |
| 202 (maybe-saved-window-equal (saved-window-first-vchild saved-1) | |
| 203 (saved-window-first-vchild saved-2)) | |
| 204 (maybe-saved-window-equal (saved-window-next-child saved-1) | |
| 205 (saved-window-next-child saved-2))))) | |
| 206 | |
| 207 (defun maybe-saved-window-equal (maybe-saved-1 maybe-saved-2) | |
| 208 "Returns a boolean indicating whether the two given saved windows | |
| 209 or NILs are identical." | |
| 210 (cond | |
| 211 ((and (not maybe-saved-1) (not maybe-saved-2)) t) | |
| 212 ((not maybe-saved-1) (not maybe-saved-2)) | |
| 213 ((not maybe-saved-2) (not maybe-saved-1)) | |
| 214 (t (saved-window-equal maybe-saved-1 maybe-saved-2)))) | |
| 215 | |
| 216 (defun current-window-configuration (&optional frame) | |
| 217 "Return an object representing the current window configuration of FRAME. | |
| 218 If FRAME is nil or omitted, use the selected frame. | |
| 219 This describes the number of windows, their sizes and current buffers, | |
| 220 and for each window on FRAME the displayed buffer, where display | |
| 221 starts, and the positions of point and mark. | |
| 222 An exception is made for point in the current buffer: | |
| 223 its value is -not- saved." | |
| 224 (let ((frame (or frame (selected-frame)))) | |
| 225 ;; The original C code used complicated but still incomplete logic | |
| 226 ;; to decide if and how to restore the size of the minibuffer. It | |
| 227 ;; goes something like this: | |
| 228 ; (let ((real-font-height | |
| 229 ; (font-height (face-font 'default) frame)) | |
| 230 ; (minibuffer-height | |
| 231 ; (if (and (minibuffer-window frame) | |
| 232 ; (not (frame-minibuffer-only-p frame))) | |
| 233 ; (window-pixel-height (minibuffer-window frame)) | |
| 234 ; 0))) | |
| 235 ; ...) | |
| 236 | |
| 237 (make-window-configuration | |
| 238 :frame frame | |
| 2885 | 239 :frame-top (frame-property frame 'top) |
| 240 :frame-left (frame-property frame 'left) | |
| 1149 | 241 :frame-pixel-width (frame-pixel-width frame) |
| 242 :frame-pixel-height (frame-pixel-height frame) | |
| 243 :current-buffer (current-buffer) | |
| 244 :min-width window-min-width :min-height window-min-height | |
| 245 :minibuffer-pixel-height (window-pixel-height (minibuffer-window frame)) | |
| 246 ;; this tries to do what the old code did: | |
| 247 ; :minibuffer-height (if (zerop (% minibuffer-height real-font-height)) | |
| 248 ; (- (/ minibuffer-height real-font-height)) ; lines | |
| 249 ; minibuffer-height) ; pixels | |
| 250 :saved-root-window (root-window->saved-window (frame-root-window frame))))) | |
| 251 | |
| 252 (defun root-window->saved-window (window) | |
| 253 "Converts a root window into a tree of saved-window structures." | |
| 254 (let ((buffer (window-buffer window)) | |
| 255 (edges (window-pixel-edges window))) | |
| 256 (let ((left (nth 0 edges)) | |
| 257 (top (nth 1 edges)) | |
| 258 (right (nth 2 edges)) | |
| 259 (bottom (nth 3 edges))) | |
| 260 (let ((saved-window | |
| 261 (make-saved-window | |
|
4445
1d41b9bcf74f
Add `set-window-configuration/mapping' and `save-window-excursion/mapping'.
Mike Sperber <sperber@deinprogramm.de>
parents:
4444
diff
changeset
|
262 :window window |
| 1149 | 263 :currentp (eq window (selected-window (window-frame window))) |
| 264 :minibufferp (eq window (minibuffer-window (window-frame window))) | |
| 265 :minibuffer-scrollp (eq window minibuffer-scroll-window) | |
| 266 :buffer buffer | |
| 267 :pixel-left left :pixel-top top :pixel-right right :pixel-bottom bottom | |
| 268 :hscroll (window-hscroll window) | |
| 269 :modeline-hscroll (modeline-hscroll window) | |
| 270 :dedicatedp (window-dedicated-p window) | |
| 271 :first-hchild (if (window-first-hchild window) | |
| 272 (root-window->saved-window (window-first-hchild window)) | |
| 273 nil) | |
| 274 :first-vchild (if (window-first-vchild window) | |
| 275 (root-window->saved-window (window-first-vchild window)) | |
| 276 nil) | |
| 277 :next-child (if (window-next-child window) | |
| 278 (root-window->saved-window (window-next-child window)) | |
| 279 nil)))) | |
| 280 (if buffer | |
| 281 (progn | |
| 282 (let ((marker (make-marker))) | |
| 283 (set-marker marker (window-start window) buffer) | |
| 284 (setf (saved-window-start-marker saved-window) marker)) | |
| 4136 | 285 (if (not (eq buffer (current-buffer))) |
| 286 (let ((marker (make-marker))) | |
| 287 (set-marker marker (window-point window) buffer) | |
| 288 (setf (saved-window-point-marker saved-window) marker))) | |
| 1149 | 289 (setf (saved-window-mark-marker saved-window) |
| 290 (copy-marker (mark-marker t buffer))))) | |
| 291 saved-window)))) | |
| 292 | |
|
4445
1d41b9bcf74f
Add `set-window-configuration/mapping' and `save-window-excursion/mapping'.
Mike Sperber <sperber@deinprogramm.de>
parents:
4444
diff
changeset
|
293 (defmacro save-window-excursion/mapping (&rest body) |
|
1d41b9bcf74f
Add `set-window-configuration/mapping' and `save-window-excursion/mapping'.
Mike Sperber <sperber@deinprogramm.de>
parents:
4444
diff
changeset
|
294 "Execute body, preserving window sizes and contents. |
|
1d41b9bcf74f
Add `set-window-configuration/mapping' and `save-window-excursion/mapping'.
Mike Sperber <sperber@deinprogramm.de>
parents:
4444
diff
changeset
|
295 Restores which buffer appears in which window, where display starts, |
|
1d41b9bcf74f
Add `set-window-configuration/mapping' and `save-window-excursion/mapping'.
Mike Sperber <sperber@deinprogramm.de>
parents:
4444
diff
changeset
|
296 as well as the current buffer. |
|
1d41b9bcf74f
Add `set-window-configuration/mapping' and `save-window-excursion/mapping'.
Mike Sperber <sperber@deinprogramm.de>
parents:
4444
diff
changeset
|
297 Return alist mapping old windows to new windows. |
|
1d41b9bcf74f
Add `set-window-configuration/mapping' and `save-window-excursion/mapping'.
Mike Sperber <sperber@deinprogramm.de>
parents:
4444
diff
changeset
|
298 This alist maps the originally captured windows to the windows that correspond |
|
1d41b9bcf74f
Add `set-window-configuration/mapping' and `save-window-excursion/mapping'.
Mike Sperber <sperber@deinprogramm.de>
parents:
4444
diff
changeset
|
299 to them in the restored configuration. It does not include entries for |
|
1d41b9bcf74f
Add `set-window-configuration/mapping' and `save-window-excursion/mapping'.
Mike Sperber <sperber@deinprogramm.de>
parents:
4444
diff
changeset
|
300 windows that have not changed identity. |
|
1d41b9bcf74f
Add `set-window-configuration/mapping' and `save-window-excursion/mapping'.
Mike Sperber <sperber@deinprogramm.de>
parents:
4444
diff
changeset
|
301 Does not restore the value of point in current buffer." |
|
1d41b9bcf74f
Add `set-window-configuration/mapping' and `save-window-excursion/mapping'.
Mike Sperber <sperber@deinprogramm.de>
parents:
4444
diff
changeset
|
302 (let ((window-config (gensym 'window-config)) |
|
1d41b9bcf74f
Add `set-window-configuration/mapping' and `save-window-excursion/mapping'.
Mike Sperber <sperber@deinprogramm.de>
parents:
4444
diff
changeset
|
303 (mapping (gensym 'mapping))) |
|
1d41b9bcf74f
Add `set-window-configuration/mapping' and `save-window-excursion/mapping'.
Mike Sperber <sperber@deinprogramm.de>
parents:
4444
diff
changeset
|
304 `(let ((,window-config (current-window-configuration)) |
|
1d41b9bcf74f
Add `set-window-configuration/mapping' and `save-window-excursion/mapping'.
Mike Sperber <sperber@deinprogramm.de>
parents:
4444
diff
changeset
|
305 (,mapping)) |
|
1d41b9bcf74f
Add `set-window-configuration/mapping' and `save-window-excursion/mapping'.
Mike Sperber <sperber@deinprogramm.de>
parents:
4444
diff
changeset
|
306 (unwind-protect |
|
1d41b9bcf74f
Add `set-window-configuration/mapping' and `save-window-excursion/mapping'.
Mike Sperber <sperber@deinprogramm.de>
parents:
4444
diff
changeset
|
307 (progn ,@body) |
|
1d41b9bcf74f
Add `set-window-configuration/mapping' and `save-window-excursion/mapping'.
Mike Sperber <sperber@deinprogramm.de>
parents:
4444
diff
changeset
|
308 (setq ,mapping (set-window-configuration/mapping ,window-config))) |
|
1d41b9bcf74f
Add `set-window-configuration/mapping' and `save-window-excursion/mapping'.
Mike Sperber <sperber@deinprogramm.de>
parents:
4444
diff
changeset
|
309 ,mapping))) |
|
1d41b9bcf74f
Add `set-window-configuration/mapping' and `save-window-excursion/mapping'.
Mike Sperber <sperber@deinprogramm.de>
parents:
4444
diff
changeset
|
310 |
|
4674
e95ddfd6a409
In `set-window-configuration', don't restore frame size unconditionally.
Mike Sperber <sperber@deinprogramm.de>
parents:
4673
diff
changeset
|
311 (defun set-window-configuration (configuration &optional set-frame-size-p) |
|
4445
1d41b9bcf74f
Add `set-window-configuration/mapping' and `save-window-excursion/mapping'.
Mike Sperber <sperber@deinprogramm.de>
parents:
4444
diff
changeset
|
312 "Set the configuration of windows and buffers as specified by CONFIGURATION. |
|
1d41b9bcf74f
Add `set-window-configuration/mapping' and `save-window-excursion/mapping'.
Mike Sperber <sperber@deinprogramm.de>
parents:
4444
diff
changeset
|
313 CONFIGURATION must be a value previously returned |
|
1d41b9bcf74f
Add `set-window-configuration/mapping' and `save-window-excursion/mapping'.
Mike Sperber <sperber@deinprogramm.de>
parents:
4444
diff
changeset
|
314 by `current-window-configuration'. |
|
4674
e95ddfd6a409
In `set-window-configuration', don't restore frame size unconditionally.
Mike Sperber <sperber@deinprogramm.de>
parents:
4673
diff
changeset
|
315 If SET-FRAME-SIZE-P is true, the frame size is also restored. |
|
e95ddfd6a409
In `set-window-configuration', don't restore frame size unconditionally.
Mike Sperber <sperber@deinprogramm.de>
parents:
4673
diff
changeset
|
316 " |
|
e95ddfd6a409
In `set-window-configuration', don't restore frame size unconditionally.
Mike Sperber <sperber@deinprogramm.de>
parents:
4673
diff
changeset
|
317 (set-window-configuration/mapping configuration set-frame-size-p) |
|
e95ddfd6a409
In `set-window-configuration', don't restore frame size unconditionally.
Mike Sperber <sperber@deinprogramm.de>
parents:
4673
diff
changeset
|
318 nil) ; make sure nobody relies on mapping return value |
|
e95ddfd6a409
In `set-window-configuration', don't restore frame size unconditionally.
Mike Sperber <sperber@deinprogramm.de>
parents:
4673
diff
changeset
|
319 |
|
e95ddfd6a409
In `set-window-configuration', don't restore frame size unconditionally.
Mike Sperber <sperber@deinprogramm.de>
parents:
4673
diff
changeset
|
320 (defun set-window-configuration/mapping (configuration &optional set-frame-size-p) |
|
e95ddfd6a409
In `set-window-configuration', don't restore frame size unconditionally.
Mike Sperber <sperber@deinprogramm.de>
parents:
4673
diff
changeset
|
321 "Set the configuration of windows and buffers as specified by CONFIGURATION. |
|
e95ddfd6a409
In `set-window-configuration', don't restore frame size unconditionally.
Mike Sperber <sperber@deinprogramm.de>
parents:
4673
diff
changeset
|
322 CONFIGURATION must be a value previously returned |
|
e95ddfd6a409
In `set-window-configuration', don't restore frame size unconditionally.
Mike Sperber <sperber@deinprogramm.de>
parents:
4673
diff
changeset
|
323 by `current-window-configuration'. |
|
e95ddfd6a409
In `set-window-configuration', don't restore frame size unconditionally.
Mike Sperber <sperber@deinprogramm.de>
parents:
4673
diff
changeset
|
324 If SET-FRAME-SIZE-P is true, the frame size is also restored. |
|
4445
1d41b9bcf74f
Add `set-window-configuration/mapping' and `save-window-excursion/mapping'.
Mike Sperber <sperber@deinprogramm.de>
parents:
4444
diff
changeset
|
325 Return alist mapping old windows to new windows. |
|
1d41b9bcf74f
Add `set-window-configuration/mapping' and `save-window-excursion/mapping'.
Mike Sperber <sperber@deinprogramm.de>
parents:
4444
diff
changeset
|
326 This alist maps the originally captured windows to the windows that correspond |
|
1d41b9bcf74f
Add `set-window-configuration/mapping' and `save-window-excursion/mapping'.
Mike Sperber <sperber@deinprogramm.de>
parents:
4444
diff
changeset
|
327 to them in the restored configuration. It does not include entries for |
|
1d41b9bcf74f
Add `set-window-configuration/mapping' and `save-window-excursion/mapping'.
Mike Sperber <sperber@deinprogramm.de>
parents:
4444
diff
changeset
|
328 windows that have not changed identity." |
| 1149 | 329 (let ((frame (window-configuration-frame configuration))) |
| 330 (if (and (frame-live-p frame) | |
| 331 (not (window-configuration-equal configuration | |
| 332 (current-window-configuration)))) | |
|
4674
e95ddfd6a409
In `set-window-configuration', don't restore frame size unconditionally.
Mike Sperber <sperber@deinprogramm.de>
parents:
4673
diff
changeset
|
333 (really-set-window-configuration frame configuration set-frame-size-p)))) |
| 1149 | 334 |
|
4674
e95ddfd6a409
In `set-window-configuration', don't restore frame size unconditionally.
Mike Sperber <sperber@deinprogramm.de>
parents:
4673
diff
changeset
|
335 (defun really-set-window-configuration (frame configuration set-frame-size-p) |
|
4445
1d41b9bcf74f
Add `set-window-configuration/mapping' and `save-window-excursion/mapping'.
Mike Sperber <sperber@deinprogramm.de>
parents:
4444
diff
changeset
|
336 "Set the window configuration CONFIGURATION on live frame FRAME. |
|
4674
e95ddfd6a409
In `set-window-configuration', don't restore frame size unconditionally.
Mike Sperber <sperber@deinprogramm.de>
parents:
4673
diff
changeset
|
337 If SET-FRAME-SIZE-P is true, the frame size is also restored. |
|
4445
1d41b9bcf74f
Add `set-window-configuration/mapping' and `save-window-excursion/mapping'.
Mike Sperber <sperber@deinprogramm.de>
parents:
4444
diff
changeset
|
338 Return alist mapping old windows to new windows." |
| 1149 | 339 ;; avoid potential temporary problems |
| 340 (setq window-min-width 0) | |
| 341 (setq window-min-height 0) | |
| 342 (setq minibuffer-scroll-window nil) | |
| 343 | |
| 344 (frame-reduce-to-one-window frame) | |
|
4674
e95ddfd6a409
In `set-window-configuration', don't restore frame size unconditionally.
Mike Sperber <sperber@deinprogramm.de>
parents:
4673
diff
changeset
|
345 (if set-frame-size-p |
|
e95ddfd6a409
In `set-window-configuration', don't restore frame size unconditionally.
Mike Sperber <sperber@deinprogramm.de>
parents:
4673
diff
changeset
|
346 (set-window-configuration-frame-size configuration)) |
| 2888 | 347 |
|
4673
11d71be1c232
Add `set-window-pixel-{width,height} convenience functions.
Mike Sperber <sperber@deinprogramm.de>
parents:
4445
diff
changeset
|
348 ;; avoid setting these if they're already up-to-date |
|
11d71be1c232
Add `set-window-pixel-{width,height} convenience functions.
Mike Sperber <sperber@deinprogramm.de>
parents:
4445
diff
changeset
|
349 ;; This also avoids potential inaccuracies in these settings --Mike |
| 3646 | 350 (when window-configuration-includes-position |
| 351 (let ((left (window-configuration-frame-left configuration)) | |
|
4673
11d71be1c232
Add `set-window-pixel-{width,height} convenience functions.
Mike Sperber <sperber@deinprogramm.de>
parents:
4445
diff
changeset
|
352 (top (window-configuration-frame-top configuration))) |
| 3646 | 353 (if (not (equal left (frame-property frame 'left))) |
|
4673
11d71be1c232
Add `set-window-pixel-{width,height} convenience functions.
Mike Sperber <sperber@deinprogramm.de>
parents:
4445
diff
changeset
|
354 (set-frame-property frame 'left left)) |
| 3646 | 355 (if (not (equal top (frame-property frame 'top))) |
|
4673
11d71be1c232
Add `set-window-pixel-{width,height} convenience functions.
Mike Sperber <sperber@deinprogramm.de>
parents:
4445
diff
changeset
|
356 (set-frame-property frame 'top top)))) |
| 1149 | 357 |
| 358 ;; these may have changed because of the delete | |
|
4673
11d71be1c232
Add `set-window-pixel-{width,height} convenience functions.
Mike Sperber <sperber@deinprogramm.de>
parents:
4445
diff
changeset
|
359 (set-window-pixel-height (minibuffer-window frame) |
|
11d71be1c232
Add `set-window-pixel-{width,height} convenience functions.
Mike Sperber <sperber@deinprogramm.de>
parents:
4445
diff
changeset
|
360 (window-configuration-minibuffer-pixel-height configuration)) |
| 1149 | 361 |
|
4673
11d71be1c232
Add `set-window-pixel-{width,height} convenience functions.
Mike Sperber <sperber@deinprogramm.de>
parents:
4445
diff
changeset
|
362 ;; avoid that `set-window-point' will set the buffer's point for |
|
11d71be1c232
Add `set-window-pixel-{width,height} convenience functions.
Mike Sperber <sperber@deinprogramm.de>
parents:
4445
diff
changeset
|
363 ;; the selected window |
|
11d71be1c232
Add `set-window-pixel-{width,height} convenience functions.
Mike Sperber <sperber@deinprogramm.de>
parents:
4445
diff
changeset
|
364 (select-window (minibuffer-window frame)) |
| 1149 | 365 |
|
4673
11d71be1c232
Add `set-window-pixel-{width,height} convenience functions.
Mike Sperber <sperber@deinprogramm.de>
parents:
4445
diff
changeset
|
366 (let ((window-configuration-current-window nil) |
|
11d71be1c232
Add `set-window-pixel-{width,height} convenience functions.
Mike Sperber <sperber@deinprogramm.de>
parents:
4445
diff
changeset
|
367 (mapping (list nil))) ; poor man's box |
|
4445
1d41b9bcf74f
Add `set-window-configuration/mapping' and `save-window-excursion/mapping'.
Mike Sperber <sperber@deinprogramm.de>
parents:
4444
diff
changeset
|
368 |
|
4673
11d71be1c232
Add `set-window-pixel-{width,height} convenience functions.
Mike Sperber <sperber@deinprogramm.de>
parents:
4445
diff
changeset
|
369 (declare (special window-configuration-current-window)) |
|
11d71be1c232
Add `set-window-pixel-{width,height} convenience functions.
Mike Sperber <sperber@deinprogramm.de>
parents:
4445
diff
changeset
|
370 (restore-saved-window configuration |
|
11d71be1c232
Add `set-window-pixel-{width,height} convenience functions.
Mike Sperber <sperber@deinprogramm.de>
parents:
4445
diff
changeset
|
371 (frame-root-window frame) |
|
11d71be1c232
Add `set-window-pixel-{width,height} convenience functions.
Mike Sperber <sperber@deinprogramm.de>
parents:
4445
diff
changeset
|
372 (window-configuration-saved-root-window configuration) |
|
11d71be1c232
Add `set-window-pixel-{width,height} convenience functions.
Mike Sperber <sperber@deinprogramm.de>
parents:
4445
diff
changeset
|
373 'vertical |
|
11d71be1c232
Add `set-window-pixel-{width,height} convenience functions.
Mike Sperber <sperber@deinprogramm.de>
parents:
4445
diff
changeset
|
374 mapping) |
|
11d71be1c232
Add `set-window-pixel-{width,height} convenience functions.
Mike Sperber <sperber@deinprogramm.de>
parents:
4445
diff
changeset
|
375 (if window-configuration-current-window |
|
11d71be1c232
Add `set-window-pixel-{width,height} convenience functions.
Mike Sperber <sperber@deinprogramm.de>
parents:
4445
diff
changeset
|
376 (select-window window-configuration-current-window)) |
|
4445
1d41b9bcf74f
Add `set-window-configuration/mapping' and `save-window-excursion/mapping'.
Mike Sperber <sperber@deinprogramm.de>
parents:
4444
diff
changeset
|
377 |
|
4673
11d71be1c232
Add `set-window-pixel-{width,height} convenience functions.
Mike Sperber <sperber@deinprogramm.de>
parents:
4445
diff
changeset
|
378 (setq window-min-width (window-configuration-min-width configuration)) |
|
11d71be1c232
Add `set-window-pixel-{width,height} convenience functions.
Mike Sperber <sperber@deinprogramm.de>
parents:
4445
diff
changeset
|
379 (setq window-min-height (window-configuration-min-height configuration)) |
|
4445
1d41b9bcf74f
Add `set-window-configuration/mapping' and `save-window-excursion/mapping'.
Mike Sperber <sperber@deinprogramm.de>
parents:
4444
diff
changeset
|
380 |
|
4673
11d71be1c232
Add `set-window-pixel-{width,height} convenience functions.
Mike Sperber <sperber@deinprogramm.de>
parents:
4445
diff
changeset
|
381 (let ((buffer (window-configuration-current-buffer configuration))) |
|
11d71be1c232
Add `set-window-pixel-{width,height} convenience functions.
Mike Sperber <sperber@deinprogramm.de>
parents:
4445
diff
changeset
|
382 (if (buffer-live-p buffer) |
|
11d71be1c232
Add `set-window-pixel-{width,height} convenience functions.
Mike Sperber <sperber@deinprogramm.de>
parents:
4445
diff
changeset
|
383 (set-buffer buffer) |
|
11d71be1c232
Add `set-window-pixel-{width,height} convenience functions.
Mike Sperber <sperber@deinprogramm.de>
parents:
4445
diff
changeset
|
384 (set-buffer (car (buffer-list))))) |
|
4674
e95ddfd6a409
In `set-window-configuration', don't restore frame size unconditionally.
Mike Sperber <sperber@deinprogramm.de>
parents:
4673
diff
changeset
|
385 ; this resets the window configuration so that the frame is filled |
|
e95ddfd6a409
In `set-window-configuration', don't restore frame size unconditionally.
Mike Sperber <sperber@deinprogramm.de>
parents:
4673
diff
changeset
|
386 (if (not set-frame-size-p) |
|
e95ddfd6a409
In `set-window-configuration', don't restore frame size unconditionally.
Mike Sperber <sperber@deinprogramm.de>
parents:
4673
diff
changeset
|
387 (set-frame-pixel-size frame (frame-pixel-width frame) (frame-pixel-height frame))) |
|
4673
11d71be1c232
Add `set-window-pixel-{width,height} convenience functions.
Mike Sperber <sperber@deinprogramm.de>
parents:
4445
diff
changeset
|
388 (car mapping))) |
| 1149 | 389 |
| 390 (defun set-window-configuration-frame-size (configuration) | |
| 391 "Restore the frame size of a window configuration." | |
| 392 (set-frame-pixel-size | |
| 393 (window-configuration-frame configuration) | |
| 394 (window-configuration-frame-pixel-width configuration) | |
| 395 (window-configuration-frame-pixel-height configuration))) | |
| 396 | |
| 397 (defun frame-reduce-to-one-window (frame) | |
| 398 "Delete all windows except the minibuffer and one other in FRAME." | |
| 399 (let* ((root-window (frame-root-window frame)) | |
| 400 (combination-start (or (window-first-hchild root-window) | |
| 401 (window-first-vchild root-window)))) | |
| 402 (if combination-start | |
| 403 (window-reduce-to-one combination-start)))) | |
| 404 | |
| 1230 | 405 ;; Note that simply using `delete-other-windows' causes obscure |
| 406 ;; breakage. --Mike | |
| 407 | |
| 1149 | 408 (defun window-reduce-to-one (window) |
| 409 "Make sure only one subwindow of WINDOW is left." | |
| 1230 | 410 (let ((window (window-next-child window))) |
| 411 (while window | |
| 412 (if (window-live-p window) | |
| 413 (let ((next (window-next-child window))) | |
|
4444
715c3ced8fa8
Use `real-split-window', `real-delete-window' in window-config code.
Mike Sperber <sperber@deinprogramm.de>
parents:
4438
diff
changeset
|
414 (real-delete-window window) |
| 1230 | 415 (setq window next))))) |
| 416 (cond | |
| 417 ((window-first-hchild window) | |
| 418 (window-reduce-to-one (window-first-hchild window))) | |
| 419 ((window-first-vchild window) | |
| 420 (window-reduce-to-one (window-first-vchild window))))) | |
| 1149 | 421 |
|
4445
1d41b9bcf74f
Add `set-window-configuration/mapping' and `save-window-excursion/mapping'.
Mike Sperber <sperber@deinprogramm.de>
parents:
4444
diff
changeset
|
422 (defun restore-saved-window (configuration window saved-window direction mapping) |
|
1d41b9bcf74f
Add `set-window-configuration/mapping' and `save-window-excursion/mapping'.
Mike Sperber <sperber@deinprogramm.de>
parents:
4444
diff
changeset
|
423 "Within CONFIGURATION, restore WINDOW to the state of SAVED-WINDOW. |
|
1d41b9bcf74f
Add `set-window-configuration/mapping' and `save-window-excursion/mapping'.
Mike Sperber <sperber@deinprogramm.de>
parents:
4444
diff
changeset
|
424 MAPPING is a one-element list whose element is an old-window-to-new-window |
|
1d41b9bcf74f
Add `set-window-configuration/mapping' and `save-window-excursion/mapping'.
Mike Sperber <sperber@deinprogramm.de>
parents:
4444
diff
changeset
|
425 mapping, which this function will extend." |
|
1d41b9bcf74f
Add `set-window-configuration/mapping' and `save-window-excursion/mapping'.
Mike Sperber <sperber@deinprogramm.de>
parents:
4444
diff
changeset
|
426 (if (not (eq (saved-window-window saved-window) window)) |
|
1d41b9bcf74f
Add `set-window-configuration/mapping' and `save-window-excursion/mapping'.
Mike Sperber <sperber@deinprogramm.de>
parents:
4444
diff
changeset
|
427 (rplaca mapping |
|
1d41b9bcf74f
Add `set-window-configuration/mapping' and `save-window-excursion/mapping'.
Mike Sperber <sperber@deinprogramm.de>
parents:
4444
diff
changeset
|
428 (cons (cons (saved-window-window saved-window) window) |
|
1d41b9bcf74f
Add `set-window-configuration/mapping' and `save-window-excursion/mapping'.
Mike Sperber <sperber@deinprogramm.de>
parents:
4444
diff
changeset
|
429 (car mapping)))) |
|
4438
2785829fe37c
Fix window-configuration problem.
Mike Sperber <sperber@deinprogramm.de>
parents:
4136
diff
changeset
|
430 (cond |
|
2785829fe37c
Fix window-configuration problem.
Mike Sperber <sperber@deinprogramm.de>
parents:
4136
diff
changeset
|
431 ((and (saved-window-next-child saved-window) |
|
2785829fe37c
Fix window-configuration problem.
Mike Sperber <sperber@deinprogramm.de>
parents:
4136
diff
changeset
|
432 (not (saved-window-minibufferp (saved-window-next-child saved-window)))) |
|
2785829fe37c
Fix window-configuration problem.
Mike Sperber <sperber@deinprogramm.de>
parents:
4136
diff
changeset
|
433 (cond ((eq direction 'vertical) |
|
4444
715c3ced8fa8
Use `real-split-window', `real-delete-window' in window-config code.
Mike Sperber <sperber@deinprogramm.de>
parents:
4438
diff
changeset
|
434 (real-split-window window nil nil)) |
|
4438
2785829fe37c
Fix window-configuration problem.
Mike Sperber <sperber@deinprogramm.de>
parents:
4136
diff
changeset
|
435 ((eq direction 'horizontal) |
|
4444
715c3ced8fa8
Use `real-split-window', `real-delete-window' in window-config code.
Mike Sperber <sperber@deinprogramm.de>
parents:
4438
diff
changeset
|
436 (real-split-window window nil t))) |
|
4438
2785829fe37c
Fix window-configuration problem.
Mike Sperber <sperber@deinprogramm.de>
parents:
4136
diff
changeset
|
437 (if (not (saved-window-minibufferp saved-window)) |
|
2785829fe37c
Fix window-configuration problem.
Mike Sperber <sperber@deinprogramm.de>
parents:
4136
diff
changeset
|
438 (restore-saved-window-parameters configuration window saved-window)) |
|
2785829fe37c
Fix window-configuration problem.
Mike Sperber <sperber@deinprogramm.de>
parents:
4136
diff
changeset
|
439 (restore-saved-window configuration |
|
2785829fe37c
Fix window-configuration problem.
Mike Sperber <sperber@deinprogramm.de>
parents:
4136
diff
changeset
|
440 (window-next-child window) |
|
2785829fe37c
Fix window-configuration problem.
Mike Sperber <sperber@deinprogramm.de>
parents:
4136
diff
changeset
|
441 (saved-window-next-child saved-window) |
|
4445
1d41b9bcf74f
Add `set-window-configuration/mapping' and `save-window-excursion/mapping'.
Mike Sperber <sperber@deinprogramm.de>
parents:
4444
diff
changeset
|
442 direction |
|
1d41b9bcf74f
Add `set-window-configuration/mapping' and `save-window-excursion/mapping'.
Mike Sperber <sperber@deinprogramm.de>
parents:
4444
diff
changeset
|
443 mapping)) |
|
4438
2785829fe37c
Fix window-configuration problem.
Mike Sperber <sperber@deinprogramm.de>
parents:
4136
diff
changeset
|
444 ((not (saved-window-minibufferp saved-window)) |
|
2785829fe37c
Fix window-configuration problem.
Mike Sperber <sperber@deinprogramm.de>
parents:
4136
diff
changeset
|
445 (restore-saved-window-parameters configuration window saved-window))) |
| 1149 | 446 |
| 1576 | 447 (if (saved-window-first-hchild saved-window) |
| 448 (restore-saved-window configuration | |
| 449 window | |
| 450 (saved-window-first-hchild saved-window) | |
|
4445
1d41b9bcf74f
Add `set-window-configuration/mapping' and `save-window-excursion/mapping'.
Mike Sperber <sperber@deinprogramm.de>
parents:
4444
diff
changeset
|
451 'horizontal |
|
1d41b9bcf74f
Add `set-window-configuration/mapping' and `save-window-excursion/mapping'.
Mike Sperber <sperber@deinprogramm.de>
parents:
4444
diff
changeset
|
452 mapping)) |
| 1576 | 453 (if (saved-window-first-vchild saved-window) |
| 454 (restore-saved-window configuration | |
| 455 window | |
| 456 (saved-window-first-vchild saved-window) | |
|
4445
1d41b9bcf74f
Add `set-window-configuration/mapping' and `save-window-excursion/mapping'.
Mike Sperber <sperber@deinprogramm.de>
parents:
4444
diff
changeset
|
457 'vertical |
|
1d41b9bcf74f
Add `set-window-configuration/mapping' and `save-window-excursion/mapping'.
Mike Sperber <sperber@deinprogramm.de>
parents:
4444
diff
changeset
|
458 mapping))) |
| 1149 | 459 |
| 460 (defun restore-saved-window-parameters (configuration window saved-window) | |
| 461 "Restore the window parameters stored in SAVED-WINDOW on WINDOW." | |
| 1261 | 462 (declare (special window-configuration-current-window)) |
| 1149 | 463 (let ((buffer (saved-window-buffer saved-window))) |
| 464 (if (and buffer (buffer-live-p buffer)) | |
| 465 (progn | |
| 466 (set-window-buffer window | |
| 467 (saved-window-buffer saved-window)) | |
| 468 (set-window-start window | |
| 1161 | 469 (marker-position (saved-window-start-marker saved-window)) |
| 470 t) | |
| 4136 | 471 (if (markerp (saved-window-point-marker saved-window)) |
| 472 (set-window-point window | |
| 473 (marker-position (saved-window-point-marker saved-window)))) | |
| 1149 | 474 (set-marker (mark-marker t buffer) |
| 475 (marker-position (saved-window-mark-marker saved-window)) | |
| 476 buffer) | |
| 477 (if (not (eq buffer (window-configuration-current-buffer configuration))) | |
| 478 (goto-char (window-point window) buffer))))) | |
| 479 | |
| 480 (if (and (not (saved-window-first-hchild saved-window)) | |
| 481 (not (saved-window-first-vchild saved-window))) | |
| 482 ;; only set size for non-container windows | |
| 483 (progn | |
| 484 ;; If this is the root window, it may be the only window. | |
| 485 ;; Because of mismatches between actual and reported frame | |
| 486 ;; size, it may not let us actually set the size of the root | |
| 487 ;; window to what we want. --Mike | |
| 488 (if (not (eq window (frame-root-window (window-frame window)))) | |
| 489 (progn | |
|
4673
11d71be1c232
Add `set-window-pixel-{width,height} convenience functions.
Mike Sperber <sperber@deinprogramm.de>
parents:
4445
diff
changeset
|
490 (set-window-pixel-width window |
|
11d71be1c232
Add `set-window-pixel-{width,height} convenience functions.
Mike Sperber <sperber@deinprogramm.de>
parents:
4445
diff
changeset
|
491 (saved-window-pixel-width saved-window)) |
|
11d71be1c232
Add `set-window-pixel-{width,height} convenience functions.
Mike Sperber <sperber@deinprogramm.de>
parents:
4445
diff
changeset
|
492 (set-window-pixel-height window |
|
11d71be1c232
Add `set-window-pixel-{width,height} convenience functions.
Mike Sperber <sperber@deinprogramm.de>
parents:
4445
diff
changeset
|
493 (saved-window-pixel-height saved-window)))) |
| 1149 | 494 (set-window-hscroll window (saved-window-hscroll saved-window)) |
| 495 (set-modeline-hscroll window | |
| 496 (saved-window-modeline-hscroll saved-window)) | |
| 497 (set-window-dedicated-p window (saved-window-dedicatedp saved-window)))) | |
| 498 | |
| 499 (if (saved-window-currentp saved-window) | |
| 500 (setq window-configuration-current-window window)) | |
| 501 (if (saved-window-minibuffer-scrollp saved-window) | |
| 502 (setq minibuffer-scroll-window window))) | |
| 503 | |
| 504 (defun saved-window-pixel-width (saved-window) | |
| 505 "Compute the pixel width of SAVED-WINDOW." | |
| 506 (- (saved-window-pixel-right saved-window) | |
| 507 (saved-window-pixel-left saved-window))) | |
| 508 | |
| 509 (defun saved-window-pixel-height (saved-window) | |
| 510 "Compute the pixel height of SAVED-WINDOW." | |
| 511 (- (saved-window-pixel-bottom saved-window) | |
| 512 (saved-window-pixel-top saved-window))) | |
|
4673
11d71be1c232
Add `set-window-pixel-{width,height} convenience functions.
Mike Sperber <sperber@deinprogramm.de>
parents:
4445
diff
changeset
|
513 |
|
11d71be1c232
Add `set-window-pixel-{width,height} convenience functions.
Mike Sperber <sperber@deinprogramm.de>
parents:
4445
diff
changeset
|
514 (defun set-window-pixel-width (window width) |
|
11d71be1c232
Add `set-window-pixel-{width,height} convenience functions.
Mike Sperber <sperber@deinprogramm.de>
parents:
4445
diff
changeset
|
515 "Set the pixel width of WINDOW." |
|
11d71be1c232
Add `set-window-pixel-{width,height} convenience functions.
Mike Sperber <sperber@deinprogramm.de>
parents:
4445
diff
changeset
|
516 (enlarge-window-pixels (- width (window-pixel-width window)) t window)) |
|
11d71be1c232
Add `set-window-pixel-{width,height} convenience functions.
Mike Sperber <sperber@deinprogramm.de>
parents:
4445
diff
changeset
|
517 |
|
11d71be1c232
Add `set-window-pixel-{width,height} convenience functions.
Mike Sperber <sperber@deinprogramm.de>
parents:
4445
diff
changeset
|
518 (defun set-window-pixel-height (window height) |
|
11d71be1c232
Add `set-window-pixel-{width,height} convenience functions.
Mike Sperber <sperber@deinprogramm.de>
parents:
4445
diff
changeset
|
519 "Set the pixel height of WINDOW." |
|
11d71be1c232
Add `set-window-pixel-{width,height} convenience functions.
Mike Sperber <sperber@deinprogramm.de>
parents:
4445
diff
changeset
|
520 (enlarge-window-pixels (- height (window-pixel-height window)) nil window)) |
|
11d71be1c232
Add `set-window-pixel-{width,height} convenience functions.
Mike Sperber <sperber@deinprogramm.de>
parents:
4445
diff
changeset
|
521 |
| 428 | 522 |
| 523 ;; The window-config stack is stored as a list in frame property | |
| 524 ;; 'window-config-stack, with the most recent element at the front. | |
| 525 ;; When you pop off an element, the popped off element gets put at the | |
| 526 ;; front of frame property 'window-config-unpop-stack, so you can | |
| 527 ;; retrieve it using unpop-window-configuration. | |
| 528 | |
| 529 (defcustom window-config-stack-max 16 | |
| 530 "*Maximum size of window configuration stack. | |
| 531 Start discarding off end if it gets this big." | |
| 532 :type 'integer | |
| 533 :group 'windows) | |
| 534 | |
| 535 (defun window-config-stack (&optional frame) | |
| 536 (or frame (setq frame (selected-frame))) | |
| 537 (let ((stack (frame-property frame 'window-config-stack))) | |
| 538 (if stack | |
| 539 (set-undoable-stack-max stack window-config-stack-max) | |
| 540 (progn | |
| 541 (setq stack (make-undoable-stack window-config-stack-max)) | |
| 542 (set-frame-property frame 'window-config-stack stack))) | |
| 543 stack)) | |
| 544 | |
| 545 (defun push-window-configuration (&optional config) | |
| 546 "Push the current window configuration onto the window-config stack. | |
| 547 If CONFIG is specified, push it instead of the current window configuration. | |
| 548 Each frame has its own window-config stack." | |
| 549 (interactive) | |
| 550 (let ((wc (or config (current-window-configuration))) | |
| 551 (stack (window-config-stack))) | |
|
5366
f00192e1cd49
Examining the result of #'length: `eql', not `=', it's better style & cheaper
Aidan Kehoe <kehoea@parhasard.net>
parents:
4674
diff
changeset
|
552 (if (or (eql 0 (undoable-stack-a-length stack)) |
| 428 | 553 (not (equal (undoable-stack-a-top stack) wc))) |
| 554 (undoable-stack-push stack wc)))) | |
| 555 | |
| 556 (defun pop-window-configuration () | |
| 557 "Pop the top window configuration off the window-config stack and set it. | |
| 558 Before setting the new window configuration, the current window configuration | |
| 559 is pushed onto the \"unpop\" stack. | |
| 560 `unpop-window-configuration' undoes what this function does. | |
| 561 Each frame has its own window-config and \"unpop\" stack." | |
| 562 (interactive) | |
| 563 (let ((stack (window-config-stack)) | |
| 564 (wc (current-window-configuration)) | |
| 565 popped) | |
| 566 (condition-case nil | |
| 567 (progn | |
| 568 (setq popped (undoable-stack-pop stack)) | |
| 569 (while (equal popped wc) | |
| 570 (setq popped (undoable-stack-pop stack))) | |
| 571 (undoable-stack-push stack wc) | |
| 572 (undoable-stack-undo stack) | |
| 573 (set-window-configuration popped) | |
| 574 popped) | |
| 575 (trunc-stack-bottom | |
| 576 (error "Bottom of window config stack"))))) | |
| 577 | |
| 578 (defun unpop-window-configuration () | |
| 579 "Undo the effect of the most recent `pop-window-configuration'. | |
| 580 This does exactly the inverse of what `pop-window-configuration' does: | |
| 581 i.e. it pops a window configuration off of the \"unpop\" stack and | |
| 582 pushes the current window configuration onto the window-config stack. | |
| 583 Each frame has its own window-config and \"unpop\" stack." | |
| 584 (interactive) | |
| 585 (let ((stack (window-config-stack)) | |
| 586 (wc (current-window-configuration)) | |
| 587 popped) | |
| 588 (condition-case nil | |
| 589 (progn | |
| 590 (setq popped | |
| 591 (progn | |
| 592 (undoable-stack-redo stack) | |
| 593 (undoable-stack-pop stack))) | |
| 594 (while (equal popped wc) | |
| 595 (setq popped | |
| 596 (progn | |
| 597 (undoable-stack-redo stack) | |
| 598 (undoable-stack-pop stack)))) | |
| 599 (undoable-stack-push stack wc) | |
| 600 (set-window-configuration popped) | |
| 601 popped) | |
| 602 (trunc-stack-bottom | |
| 603 (error "Top of window config stack"))))) | |
| 604 | |
| 605 | |
| 606 ;;;;;;;;;;;;; display-buffer, moved here from C. Hallelujah. | |
| 607 | |
| 442 | 608 (make-variable-buffer-local '__buffer-dedicated-frame) |
| 609 | |
| 610 (defun buffer-dedicated-frame (&optional buffer) | |
| 611 "Return the frame dedicated to this BUFFER, or nil if there is none. | |
| 612 No argument or nil as argument means use current buffer as BUFFER." | |
| 613 (let ((buffer (decode-buffer buffer))) | |
| 614 (let ((frame (symbol-value-in-buffer '__buffer-dedicated-frame buffer))) | |
| 615 ;; XEmacs addition: if the frame is dead, silently make it go away. | |
| 616 (when (and (framep frame) (not (frame-live-p frame))) | |
| 617 (with-current-buffer buffer | |
| 618 (setq __buffer-dedicated-frame nil)) | |
| 619 (setq frame nil)) | |
| 620 frame))) | |
| 621 | |
| 622 (defun set-buffer-dedicated-frame (buffer frame) | |
| 623 "For this BUFFER, set the FRAME dedicated to it. | |
| 624 FRAME must be a frame or nil." | |
| 625 (let ((buffer (decode-buffer buffer))) | |
| 626 (and frame | |
| 627 (check-argument-type #'frame-live-p frame)) | |
| 628 (with-current-buffer buffer | |
| 629 (setq __buffer-dedicated-frame frame)))) | |
| 630 | |
| 428 | 631 (defvar display-buffer-function nil |
| 632 "If non-nil, function to call to handle `display-buffer'. | |
| 903 | 633 It will receive four args: the same as those to `display-buffer'.") |
| 428 | 634 |
| 635 (defvar pre-display-buffer-function nil | |
| 636 "If non-nil, function that will be called from `display-buffer' | |
| 903 | 637 as the first action. It will receive four args: the same as those |
| 428 | 638 to `display-buffer'. |
| 639 This function may be used to select an appropriate frame for the buffer, | |
| 640 for example. See also the variable `display-buffer-function', which may | |
| 641 be used to completely replace the `display-buffer' function. | |
| 642 If the return value of this function is non-nil, it should be a frame, | |
| 643 and that frame will be used to display the buffer.") | |
| 644 | |
| 645 (defcustom pop-up-frames nil | |
| 646 "*Non-nil means `display-buffer' should make a separate frame." | |
| 647 :type 'boolean | |
| 648 :group 'frames) | |
| 649 | |
| 650 (defvar pop-up-frame-function nil | |
| 651 "Function to call to handle automatic new frame creation. | |
| 652 It is called with no arguments and should return a newly created frame. | |
| 653 | |
| 654 A typical value might be `(lambda () (new-frame pop-up-frame-alist))' | |
| 655 where `pop-up-frame-alist' would hold the default frame parameters.") | |
| 656 | |
| 657 (defcustom special-display-buffer-names nil | |
| 658 "*List of buffer names that should have their own special frames. | |
| 659 Displaying a buffer whose name is in this list makes a special frame for it | |
| 660 using `special-display-function'. | |
| 661 | |
| 662 An element of the list can be a cons cell instead of just a string. | |
| 663 Then the car should be a buffer name, and the cdr specifies frame | |
| 664 parameters for creating the frame for that buffer. | |
| 665 More precisely, the cdr is passed as the second argument to | |
| 666 the function found in `special-display-function', when making that frame. | |
| 667 See also `special-display-regexps'." | |
| 668 :type '(repeat (choice :value "" | |
| 669 (string :tag "Name") | |
| 670 (cons :menu-tag "Properties" | |
| 671 :value ("" . nil) | |
| 672 (string :tag "Name") | |
| 673 (repeat :tag "Properties" | |
| 674 (group :inline t | |
| 675 (symbol :tag "Property") | |
| 676 (sexp :tag "Value")))))) | |
| 677 :group 'frames) | |
| 678 | |
| 679 (defcustom special-display-regexps nil | |
| 680 "*List of regexps saying which buffers should have their own special frames. | |
| 681 If a buffer name matches one of these regexps, it gets its own frame. | |
| 682 Displaying a buffer whose name is in this list makes a special frame for it | |
| 683 using `special-display-function'. | |
| 684 | |
| 685 An element of the list can be a cons cell instead of just a string. | |
| 686 Then the car should be the regexp, and the cdr specifies frame | |
| 687 parameters for creating the frame for buffers that match. | |
| 688 More precisely, the cdr is passed as the second argument to | |
| 689 the function found in `special-display-function', when making that frame. | |
| 690 See also `special-display-buffer-names'." | |
| 691 :type '(repeat (choice :value "" | |
| 692 regexp | |
| 693 (cons :menu-tag "Properties" | |
| 694 :value ("" . nil) | |
| 695 regexp | |
| 696 (repeat :tag "Properties" | |
| 697 (group :inline t | |
| 698 (symbol :tag "Property") | |
| 699 (sexp :tag "Value")))))) | |
| 700 :group 'frames) | |
| 701 | |
| 702 (defvar special-display-function nil | |
| 703 "Function to call to make a new frame for a special buffer. | |
| 704 It is called with two arguments, the buffer and optional buffer specific | |
| 705 data, and should return a window displaying that buffer. | |
| 706 The default value makes a separate frame for the buffer, | |
| 707 using `special-display-frame-alist' to specify the frame parameters. | |
| 708 | |
| 709 A buffer is special if its is listed in `special-display-buffer-names' | |
| 710 or matches a regexp in `special-display-regexps'.") | |
| 711 | |
| 712 (defcustom same-window-buffer-names nil | |
| 713 "*List of buffer names that should appear in the selected window. | |
| 714 Displaying one of these buffers using `display-buffer' or `pop-to-buffer' | |
| 715 switches to it in the selected window, rather than making it appear | |
| 716 in some other window. | |
| 717 | |
| 718 An element of the list can be a cons cell instead of just a string. | |
| 719 Then the car must be a string, which specifies the buffer name. | |
| 720 This is for compatibility with `special-display-buffer-names'; | |
| 721 the cdr of the cons cell is ignored. | |
| 722 | |
| 723 See also `same-window-regexps'." | |
| 724 :type '(repeat (string :tag "Name")) | |
| 725 :group 'windows) | |
| 726 | |
| 727 (defcustom same-window-regexps nil | |
| 728 "*List of regexps saying which buffers should appear in the selected window. | |
| 729 If a buffer name matches one of these regexps, then displaying it | |
| 730 using `display-buffer' or `pop-to-buffer' switches to it | |
| 731 in the selected window, rather than making it appear in some other window. | |
| 732 | |
| 733 An element of the list can be a cons cell instead of just a string. | |
| 734 Then the car must be a string, which specifies the buffer name. | |
| 735 This is for compatibility with `special-display-buffer-names'; | |
| 736 the cdr of the cons cell is ignored. | |
| 737 | |
| 738 See also `same-window-buffer-names'." | |
| 739 :type '(repeat regexp) | |
| 740 :group 'windows) | |
| 741 | |
| 742 (defcustom pop-up-windows t | |
| 743 "*Non-nil means display-buffer should make new windows." | |
| 744 :type 'boolean | |
| 745 :group 'windows) | |
| 746 | |
| 747 (defcustom split-height-threshold 500 | |
| 748 "*display-buffer would prefer to split the largest window if this large. | |
| 749 If there is only one window, it is split regardless of this value." | |
| 750 :type 'integer | |
| 751 :group 'windows) | |
| 752 | |
| 753 (defcustom split-width-threshold 500 | |
| 754 "*display-buffer would prefer to split the largest window if this large. | |
| 755 If there is only one window, it is split regardless of this value." | |
| 756 :type 'integer | |
| 757 :group 'windows) | |
| 758 | |
| 759 ;; Can you believe that all of this crap was formerly in C? | |
| 760 ;; Praise Jesus that it's not there any more. | |
| 761 | |
| 903 | 762 (defun display-buffer (buffer &optional not-this-window-p override-frame |
|
5645
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
763 shrink-to-fit) |
| 428 | 764 "Make BUFFER appear in some window on the current frame, but don't select it. |
| 765 BUFFER can be a buffer or a buffer name. | |
| 766 If BUFFER is shown already in some window in the current frame, | |
| 767 just uses that one, unless the window is the selected window and | |
| 768 NOT-THIS-WINDOW-P is non-nil (interactively, with prefix arg). | |
| 769 | |
| 770 If BUFFER has a dedicated frame, display on that frame instead of | |
| 771 the current frame, unless OVERRIDE-FRAME is non-nil. | |
| 772 | |
| 773 If OVERRIDE-FRAME is non-nil, display on that frame instead of | |
| 774 the current frame (or the dedicated frame). | |
| 775 | |
| 903 | 776 If SHRINK-TO-FIT is non-nil and splitting the window is appropriate, give |
| 777 the new buffer less than half the space if it is small enough to fit. | |
| 778 | |
| 428 | 779 If `pop-up-windows' is non-nil, always use the |
| 780 current frame and create a new window regardless of whether the | |
| 781 buffer has a dedicated frame, and regardless of whether | |
| 782 OVERRIDE-FRAME was specified. | |
| 783 | |
| 784 If `pop-up-frames' is non-nil, make a new frame if no window shows BUFFER. | |
| 785 | |
| 2590 | 786 If the buffer name is a member of the `same-window-buffer-names' list, |
| 787 or matches one of the `same-window-regexps' expressions, display the | |
| 788 buffer in the currently selected window. | |
| 789 | |
| 428 | 790 Returns the window displaying BUFFER." |
| 791 (interactive "BDisplay buffer:\nP") | |
| 792 | |
|
5645
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
793 (let ((wconfig (current-window-configuration))) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
794 (prog1 |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
795 ;; We just simulate a `return' in C. This function is way |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
796 ;; ugly and does `returns' all over the place and there's |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
797 ;; no sense in trying to rewrite it to be more Lispy. |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
798 (block nil |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
799 (labels |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
800 ((display-buffer-1 (window) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
801 ;; Deiconify the frame containing the window WINDOW, then |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
802 ;; return WINDOW. |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
803 (if (frame-iconified-p (window-frame window)) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
804 (make-frame-visible (window-frame window))) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
805 window)) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
806 (let (window old-frame target-frame explicit-frame shrink-it) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
807 (setq old-frame (or (last-nonminibuf-frame) (selected-frame))) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
808 (setq buffer (get-buffer buffer)) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
809 (check-argument-type 'bufferp buffer) |
| 428 | 810 |
|
5645
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
811 (setq explicit-frame |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
812 (if pre-display-buffer-function |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
813 (funcall pre-display-buffer-function buffer |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
814 not-this-window-p |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
815 override-frame |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
816 shrink-to-fit))) |
| 428 | 817 |
|
5645
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
818 ;; Give the user the ability to completely reimplement |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
819 ;; this function via the `display-buffer-function'. |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
820 (if display-buffer-function |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
821 (return (funcall display-buffer-function buffer |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
822 not-this-window-p |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
823 override-frame |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
824 shrink-to-fit))) |
| 428 | 825 |
|
5645
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
826 ;; If the buffer has a dedicated frame, that takes |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
827 ;; precedence over the current frame, and over what the |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
828 ;; pre-display-buffer-function did. |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
829 (let ((dedi (buffer-dedicated-frame buffer))) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
830 (if (frame-live-p dedi) (setq explicit-frame dedi))) |
| 428 | 831 |
|
5645
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
832 ;; if override-frame is supplied, that takes precedence over |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
833 ;; everything. This is gonna look bad if the |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
834 ;; pre-display-buffer-function raised some other frame already. |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
835 (if override-frame |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
836 (progn |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
837 (check-argument-type 'frame-live-p override-frame) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
838 (setq explicit-frame override-frame))) |
| 428 | 839 |
|
5645
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
840 (setq target-frame |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
841 (or explicit-frame |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
842 (last-nonminibuf-frame) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
843 (selected-frame))) |
| 428 | 844 |
|
5645
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
845 ;; If we have switched frames, then set not-this-window-p to |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
846 ;; false. Switching frames means that selected-window is no |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
847 ;; longer the same as it was on entry -- it's the |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
848 ;; selected-window of target_frame instead of old_frame, so |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
849 ;; it's a fine candidate for display. |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
850 (if (not (eq old-frame target-frame)) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
851 (setq not-this-window-p nil)) |
| 428 | 852 |
|
5645
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
853 ;; if it's in the selected window, and that's ok, then we're |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
854 ;; done. |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
855 (if (and (not not-this-window-p) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
856 (eq buffer (window-buffer (selected-window)))) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
857 (return (display-buffer-1 (selected-window)))) |
| 428 | 858 |
|
5645
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
859 ;; See if the user has specified this buffer should |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
860 ;; appear in the selected window. |
| 428 | 861 |
|
5645
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
862 (if not-this-window-p |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
863 nil |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
864 (if (or (member (buffer-name buffer) same-window-buffer-names) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
865 (assoc (buffer-name buffer) same-window-buffer-names)) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
866 (progn |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
867 (switch-to-buffer buffer) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
868 (return (display-buffer-1 (selected-window))))) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
869 |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
870 (let ((tem same-window-regexps)) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
871 (while tem |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
872 (let ((car (car tem))) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
873 (if (or |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
874 (and (stringp car) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
875 (string-match car (buffer-name buffer))) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
876 (and (consp car) (stringp (car car)) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
877 (string-match (car car) (buffer-name buffer)))) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
878 (progn |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
879 (switch-to-buffer buffer) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
880 (return (display-buffer-1 (selected-window)))))) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
881 (setq tem (cdr tem))))) |
| 428 | 882 |
|
5645
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
883 ;; If pop-up-frames, look for a window showing BUFFER |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
884 ;; on any visible or iconified frame. Otherwise search |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
885 ;; only the current frame. |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
886 (if (and (not explicit-frame) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
887 (or pop-up-frames (not (last-nonminibuf-frame)))) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
888 (setq target-frame 0)) |
| 428 | 889 |
|
5645
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
890 ;; Otherwise, find some window that it's already in, |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
891 ;; and return that, unless that window is the selected |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
892 ;; window and that isn't ok. What a contorted mess! |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
893 (setq window (or (if (not explicit-frame) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
894 ;; search the selected frame |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
895 ;; first if the user didn't |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
896 ;; specify an explicit frame. |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
897 (get-buffer-window buffer nil)) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
898 (get-buffer-window buffer target-frame))) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
899 (if (and window |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
900 (or (not not-this-window-p) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
901 (not (eq window (selected-window))))) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
902 (return (display-buffer-1 window))) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
903 ;; Certain buffer names get special handling. |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
904 (if special-display-function |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
905 (progn |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
906 (if (member (buffer-name buffer) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
907 special-display-buffer-names) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
908 (return (funcall special-display-function buffer))) |
| 428 | 909 |
|
5645
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
910 (let ((tem (assoc (buffer-name buffer) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
911 special-display-buffer-names))) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
912 (if tem |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
913 (return (funcall special-display-function |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
914 buffer (cdr tem))))) |
| 428 | 915 |
|
5645
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
916 (let ((tem special-display-regexps)) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
917 (while tem |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
918 (let ((car (car tem))) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
919 (if (and (stringp car) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
920 (string-match car (buffer-name buffer))) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
921 (return |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
922 (funcall special-display-function buffer))) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
923 (if (and (consp car) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
924 (stringp (car car)) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
925 (string-match (car car) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
926 (buffer-name buffer))) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
927 (return (funcall special-display-function buffer |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
928 (cdr car))))) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
929 (setq tem (cdr tem)))))) |
| 428 | 930 |
|
5645
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
931 ;; If there are no frames open that have more than a minibuffer, |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
932 ;; we need to create a new frame. |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
933 (if (or pop-up-frames |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
934 (null (last-nonminibuf-frame))) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
935 (progn |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
936 (setq window (frame-selected-window |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
937 (funcall pop-up-frame-function))) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
938 (set-window-buffer window buffer) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
939 (return (display-buffer-1 window)))) |
| 428 | 940 |
|
5645
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
941 ;; Otherwise, make it be in some window, splitting if |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
942 ;; appropriate/possible. Do not split a window if we |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
943 ;; are displaying the buffer in a different frame than |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
944 ;; that which was current when we were called. (It is |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
945 ;; already in a different window by virtue of being in |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
946 ;; another frame.) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
947 (if (or (and pop-up-windows (eq target-frame old-frame)) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
948 (eq 'only (frame-property (selected-frame) 'minibuffer)) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
949 ;; If the current frame is a special display frame, |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
950 ;; don't try to reuse its windows. |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
951 (window-dedicated-p |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
952 (frame-root-window (selected-frame)))) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
953 (progn |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
954 (if (eq 'only (frame-property (selected-frame) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
955 'minibuffer)) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
956 (setq target-frame (last-nonminibuf-frame))) |
| 428 | 957 |
|
5645
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
958 ;; Don't try to create a window if would get an error with |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
959 ;; height. |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
960 (if (< split-height-threshold (* 2 window-min-height)) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
961 (setq split-height-threshold (* 2 window-min-height))) |
| 428 | 962 |
|
5645
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
963 ;; Same with width. |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
964 (if (< split-width-threshold (* 2 window-min-width)) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
965 (setq split-width-threshold (* 2 window-min-width))) |
| 428 | 966 |
|
5645
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
967 ;; If the frame we would try to split cannot be split, |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
968 ;; try other frames. |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
969 (if (frame-property (if (null target-frame) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
970 (selected-frame) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
971 (last-nonminibuf-frame)) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
972 'unsplittable) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
973 (setq window |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
974 ;; Try visible frames first. |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
975 (or (get-largest-window 'visible) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
976 ;; If that didn't work, try iconified frames. |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
977 (get-largest-window 0) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
978 (get-largest-window t))) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
979 (setq window (get-largest-window target-frame))) |
| 428 | 980 |
|
5645
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
981 ;; If we got a tall enough full-width window that |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
982 ;; can be split, split it. |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
983 (if (and window |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
984 (not (frame-property (window-frame window) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
985 'unsplittable)) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
986 (>= (window-height window) split-height-threshold) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
987 (or (>= (window-width window) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
988 split-width-threshold) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
989 (and (window-leftmost-p window) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
990 (window-rightmost-p window)))) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
991 (setq window (split-window window)) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
992 (let (upper other) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
993 (setq window (get-lru-window target-frame)) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
994 ;; If the LRU window is selected, and big enough, |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
995 ;; and can be split, split it. |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
996 (if (and window |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
997 (not (frame-property (window-frame window) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
998 'unsplittable)) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
999 (or (eq window (selected-window)) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1000 (not (window-parent window))) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1001 (>= (window-height window) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1002 (* 2 window-min-height))) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1003 (setq window (split-window window))) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1004 ;; If get-lru-window returned nil, try other |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1005 ;; approaches. Try visible frames first. |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1006 (or window |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1007 (setq window (or (get-largest-window 'visible) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1008 ;; If that didn't work, try |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1009 ;; iconified frames. |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1010 (get-largest-window 0) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1011 ;; Try invisible frames. |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1012 (get-largest-window t) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1013 ;; As a last resort, make |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1014 ;; a new frame. |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1015 (frame-selected-window |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1016 (funcall |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1017 pop-up-frame-function))))) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1018 ;; If window appears above or below another, |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1019 ;; even out their heights. |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1020 (if (window-previous-child window) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1021 (setq other (window-previous-child window) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1022 upper other)) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1023 (if (window-next-child window) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1024 (setq other (window-next-child window) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1025 upper window)) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1026 ;; Check that OTHER and WINDOW are vertically arrayed. |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1027 (if (and other |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1028 (not (= (nth 1 (window-pixel-edges other)) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1029 (nth 1 (window-pixel-edges window)))) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1030 (> (window-pixel-height other) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1031 (window-pixel-height window))) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1032 (enlarge-window (- (/ (+ (window-height other) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1033 (window-height window)) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1034 2) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1035 (window-height upper)) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1036 nil upper)) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1037 ;; Klaus Berndl <klaus.berndl@sdm.de>: Only in |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1038 ;; this situation we shrink-to-fit but we can do |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1039 ;; this first after we have displayed buffer in |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1040 ;; window (s.b. (set-window-buffer window buffer)) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1041 (setq shrink-it shrink-to-fit)))) |
| 428 | 1042 |
|
5645
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1043 (setq window (get-lru-window target-frame))) |
| 428 | 1044 |
|
5645
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1045 ;; Bring the window's previous buffer to the top of the |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1046 ;; MRU chain. |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1047 (if (window-buffer window) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1048 (save-excursion |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1049 (save-selected-window |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1050 (select-window window) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1051 (record-buffer (window-buffer window))))) |
| 428 | 1052 |
|
5645
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1053 (set-window-buffer window buffer) |
| 1669 | 1054 |
|
5645
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1055 ;; Now window's previous buffer has been brought to the |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1056 ;; top of the MRU chain and window displays buffer - |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1057 ;; now we can shrink-to-fit if necessary |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1058 (if shrink-it |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1059 (shrink-window-if-larger-than-buffer window)) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1060 (display-buffer-1 window)))) ;; End of prog1's 1th form. |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1061 (or (equal wconfig (current-window-configuration)) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5473
diff
changeset
|
1062 (push-window-configuration wconfig))))) |
| 428 | 1063 |
| 1064 ;;; window-xemacs.el ends here |