Mercurial > hg > xemacs-beta
annotate lisp/window.el @ 5560:58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
src/ChangeLog addition:
2011-09-04 Aidan Kehoe <kehoea@parhasard.net>
* alloc.c:
* alloc.c (ALLOC_FROB_BLOCK_LISP_OBJECT_1):
* alloc.c (ALLOC_FROB_BLOCK_LISP_OBJECT):
* alloc.c (cons_print_preprocess):
* alloc.c (vector_print_preprocess):
* alloc.c (vector_nsubst_structures_descend):
* alloc.c (Fmake_symbol):
* alloc.c (UNMARK_symbol):
* alloc.c (sweep_symbols):
* alloc.c (reinit_alloc_objects_early):
* alloc.c (reinit_alloc_early):
* bytecode.c:
* bytecode.c (compiled_function_print_preprocess):
* bytecode.c (compiled_function_nsubst_structures_descend):
* bytecode.c (set_compiled_function_arglist):
* bytecode.c (set_compiled_function_interactive):
* bytecode.c (bytecode_objects_create):
* chartab.c:
* chartab.c (print_preprocess_mapper):
* chartab.c (nsubst_structures_mapper):
* chartab.c (char_table_nsubst_structures_descend):
* chartab.c (chartab_objects_create):
* elhash.c:
* elhash.c (nsubst_structures_map_hash_table):
* elhash.c (hash_table_nsubst_structures_descend):
* elhash.c (print_preprocess_mapper):
* elhash.c (hash_table_print_preprocess):
* elhash.c (inchash_eq):
* elhash.c (hash_table_objects_create):
* elhash.c (syms_of_elhash):
* elhash.h:
* emacs.c (main_1):
* fns.c:
* fns.c (check_eq_nokey):
* fns.c (Fnsubst):
* fns.c (syms_of_fns):
* lisp.h:
* lisp.h (struct Lisp_Symbol):
* lisp.h (IN_OBARRAY):
* lisp.h (struct):
* lisp.h (PRINT_PREPROCESS):
* lread.c (read1):
* lrecord.h:
* lrecord.h (struct lrecord_implementation):
* lrecord.h (DEFINE_DUMPABLE_MODULE_LISP_OBJECT):
* print.c:
* print.c (PRINT_CIRCLE_LIMIT):
* print.c (print_continuous_numbering_changed):
* print.c (print_prepare):
* print.c (print_finish):
* print.c (Fprin1_to_string):
* print.c (print_cons):
* print.c (print_preprocess_inchash_eq):
* print.c (print_preprocess):
* print.c (print_sort_get_numbers):
* print.c (print_sort_compare_ordinals):
* print.c (print_gensym_or_circle):
* print.c (nsubst_structures_descend):
* print.c (nsubst_structures):
* print.c (print_internal):
* print.c (print_symbol):
* print.c (vars_of_print):
* rangetab.c:
* rangetab.c (range_table_print_preprocess):
* rangetab.c (range_table_nsubst_structures_descend):
* rangetab.c (rangetab_objects_create):
* rangetab.c (syms_of_rangetab):
* symbols.c:
* symbols.c (symbol_print_preprocess):
* symbols.c (Fintern):
* symbols.c (Funintern):
* symbols.c (reinit_symbol_objects_early):
* symbols.c (init_symbols_once_early):
* symsinit.h:
Implement print-circle, printing circular structures in a readable
fashion, and treating them appropriately on read. This is by means
of two new object methods, print_preprocess (detecting
circularities), and nsubst_structures_descend (replacing
placeholders with the read objects).
Expose the substitution to Lisp via #'nsubst and its new
:descend-structures keyword.
Store information as to whether symbols are interned in obarray or
not in their header, making checking for keywords and uninterned
symbols (and thus printing) cheaper.
Default print_gensym to t, as Common Lisp does, and as a
more-than-decade old comment suggests.
lisp/ChangeLog addition:
2011-09-04 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el (byte-compile-output-file-form):
* bytecomp.el (byte-compile-output-docform):
Bind print-circle, print-continuous-numbering in these functions,
now those variables are available.
* lisp.el (forward-sexp):
* lisp.el (backward-sexp):
Recognise leading #N= as being part of an expression.
tests/ChangeLog addition:
2011-09-04 Aidan Kehoe <kehoea@parhasard.net>
* automated/lisp-reader-tests.el:
* automated/lisp-tests.el (literal-with-uninterned):
* automated/symbol-tests.el (foo):
Test print-circle, for printing (mutually-)recursive and circular
structures.
Bind print-continuous-numbering where appropriate.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Sun, 04 Sep 2011 19:51:35 +0100 |
| parents | ac37a5f7e5be |
| children | cc6f0266bc36 |
| rev | line source |
|---|---|
| 428 | 1 ;;; window.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:
4506
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:
4506
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:
4506
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:
4506
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:
4506
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:
4506
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:
4506
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:
4506
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:
4506
diff
changeset
|
22 ;; along with XEmacs. If not, see <http://www.gnu.org/licenses/>. |
| 428 | 23 |
| 24 ;;; Synched up with: Emacs/Mule zeta. | |
| 25 | |
| 26 ;;; Commentary: | |
| 27 | |
| 28 ;; This file is dumped with XEmacs. | |
| 29 | |
| 30 ;;; Code: | |
| 31 | |
| 32 ;;;; Window tree functions. | |
| 33 | |
|
4506
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
34 ;; XEmacs addition, to expose WINDOW. |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
35 (defun only-window-p (&optional window nomini which-frames which-devices) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
36 "Return non-nil if WINDOW is the only window in some context, |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
37 normally its frame. Optional arg NOMINI non-nil means don't count the |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
38 minibuffer even if it is active. |
| 428 | 39 |
|
4506
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
40 The optional argument WHICH-FRAMES changes the frames that are considered: |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
41 |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
42 WHICH-FRAMES nil or omitted means count only WINDOW's frame, |
| 428 | 43 plus the minibuffer it uses (which may be on another frame). |
|
4506
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
44 \(But, for all values of WHICH-FRAMES, see the documentation for the |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
45 WHICH-DEVICES argument.) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
46 WHICH-FRAMES = `visible' means include windows on all visible frames |
| 444 | 47 WHICH-FRAMES = 0 means include windows on all visible and iconified frames. |
| 48 WHICH-FRAMES = t means include windows on all frames including invisible frames. | |
| 49 If WHICH-FRAMES is any other value, count only the selected frame. | |
| 428 | 50 |
| 444 | 51 The optional third argument WHICH-DEVICES further clarifies on which |
| 52 devices to search for frames as specified by WHICH-FRAMES. This value | |
| 53 is only meaningful if WHICH-FRAMES is non-nil. | |
| 54 If nil or omitted, search all devices on the selected console. | |
| 55 If a device, only search that device. | |
| 56 If a console, search all devices on that console. | |
| 57 If a device type, search all devices of that type. | |
| 58 If `window-system', search all devices on window-system consoles. | |
| 59 Any other non-nil value means search all devices." | |
|
4506
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
60 (let ((base-window (or window (selected-window)))) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
61 (if (and nomini (eq base-window |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
62 (minibuffer-window (window-frame base-window)))) |
| 428 | 63 (setq base-window (next-window base-window))) |
| 64 (eq base-window | |
| 444 | 65 (next-window base-window (if nomini 'arg) which-frames which-devices)))) |
| 428 | 66 |
|
4506
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
67 (defun one-window-p (&optional nomini which-frames which-devices) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
68 "Return the result of calling `only-window-p' on the selected window. |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
69 |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
70 See that function's documentation for the meaning of the NOMINI, |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
71 WHICH-FRAMES and WHICH-DEVICES arguments." |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
72 (only-window-p (selected-window) nomini which-frames which-devices)) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
73 |
| 444 | 74 (defun walk-windows (function &optional minibuf which-frames which-devices) |
| 75 "Cycle through all visible windows, calling FUNCTION for each one. | |
| 76 FUNCTION is called with a window as argument. | |
| 428 | 77 |
| 78 Optional second arg MINIBUF t means count the minibuffer window even | |
| 79 if not active. MINIBUF nil or omitted means count the minibuffer iff | |
| 80 it is active. MINIBUF neither t nor nil means not to count the | |
| 81 minibuffer even if it is active. | |
| 82 | |
| 83 Several frames may share a single minibuffer; if the minibuffer | |
| 84 counts, all windows on all frames that share that minibuffer count | |
| 85 too. Therefore, when a separate minibuffer frame is active, | |
| 86 `walk-windows' includes the windows in the frame from which you | |
| 87 entered the minibuffer, as well as the minibuffer window. But if the | |
| 444 | 88 minibuffer does not count, only the selected window counts. |
| 428 | 89 |
| 444 | 90 By default, only the windows in the selected frame are included. |
| 91 The optional argument WHICH-FRAMES changes this behavior: | |
| 92 WHICH-FRAMES nil or omitted means cycle within the frames as specified above. | |
| 93 WHICH-FRAMES = `visible' means include windows on all visible frames. | |
| 94 WHICH-FRAMES = 0 means include windows on all visible and iconified frames. | |
| 95 WHICH-FRAMES = t means include windows on all frames including invisible frames. | |
| 428 | 96 Anything else means restrict to WINDOW's frame. |
| 97 | |
| 444 | 98 The optional fourth argument WHICH-DEVICES further clarifies on which |
| 99 devices to search for frames as specified by WHICH-FRAMES. This value | |
| 100 is only meaningful if WHICH-FRAMES is non-nil. | |
| 101 If nil or omitted, search all devices on the selected console. | |
| 102 If a device, only search that device. | |
| 103 If a console, search all devices on that console. | |
| 104 If a device type, search all devices of that type. | |
| 105 If `window-system', search all devices on window-system consoles. | |
| 106 Any other non-nil value means search all devices." | |
| 428 | 107 ;; If we start from the minibuffer window, don't fail to come back to it. |
| 1279 | 108 (let ((arg (cond |
| 109 ((framep which-frames) which-frames) | |
| 110 ((devicep which-devices) which-devices) | |
| 111 (t nil)))) | |
| 112 (if (window-minibuffer-p (selected-window arg)) | |
| 113 (setq minibuf t)) | |
| 114 ;; Note that, like next-window & previous-window, this behaves a little | |
| 115 ;; strangely if the selected window is on an invisible frame: it hits | |
| 116 ;; some of the windows on that frame, and all windows on visible frames. | |
| 117 (let* ((walk-windows-start (selected-window arg)) | |
| 118 (walk-windows-current walk-windows-start)) | |
| 119 (while (progn | |
| 120 (setq walk-windows-current | |
| 121 (next-window walk-windows-current minibuf which-frames | |
| 122 which-devices)) | |
| 123 (funcall function walk-windows-current) | |
| 124 (not (eq walk-windows-current walk-windows-start))))))) | |
| 428 | 125 ;; The old XEmacs definition of the above clause. It's more correct in |
| 126 ;; that it will never hit a window that's already been hit even if you | |
| 127 ;; do something odd like `delete-other-windows', but has the problem | |
| 128 ;; that it conses. (This may be called repeatedly, from lazy-lock | |
| 129 ;; for example.) | |
| 130 ; (let* ((walk-windows-history nil) | |
| 131 ; (walk-windows-current (selected-window))) | |
| 132 ; (while (progn | |
| 133 ; (setq walk-windows-current | |
| 444 | 134 ; (next-window walk-windows-current minibuf which-frames |
| 135 ; which-devices)) | |
| 428 | 136 ; (not (memq walk-windows-current walk-windows-history))) |
| 137 ; (setq walk-windows-history (cons walk-windows-current | |
| 138 ; walk-windows-history)) | |
| 444 | 139 ; (funcall function walk-windows-current)))) |
| 428 | 140 |
| 800 | 141 (defun get-window-with-predicate (predicate &optional minibuf |
| 142 all-frames default) | |
| 143 "Return a window satisfying PREDICATE. | |
| 144 | |
| 145 This function cycles through all visible windows using `walk-windows', | |
| 146 calling PREDICATE on each one. PREDICATE is called with a window as | |
| 147 argument. The first window for which PREDICATE returns a non-nil | |
| 148 value is returned. If no window satisfies PREDICATE, DEFAULT is | |
| 149 returned. | |
| 150 | |
| 151 Optional second arg MINIBUF t means count the minibuffer window even | |
| 152 if not active. MINIBUF nil or omitted means count the minibuffer iff | |
| 153 it is active. MINIBUF neither t nor nil means not to count the | |
| 154 minibuffer even if it is active. | |
| 155 | |
| 156 Several frames may share a single minibuffer; if the minibuffer | |
| 157 counts, all windows on all frames that share that minibuffer count | |
| 158 too. Therefore, if you are using a separate minibuffer frame | |
| 159 and the minibuffer is active and MINIBUF says it counts, | |
| 160 `walk-windows' includes the windows in the frame from which you | |
| 161 entered the minibuffer, as well as the minibuffer window. | |
| 162 | |
| 163 ALL-FRAMES is the optional third argument. | |
| 164 ALL-FRAMES nil or omitted means cycle within the frames as specified above. | |
| 165 ALL-FRAMES = `visible' means include windows on all visible frames. | |
| 166 ALL-FRAMES = 0 means include windows on all visible and iconified frames. | |
| 167 ALL-FRAMES = t means include windows on all frames including invisible frames. | |
| 168 If ALL-FRAMES is a frame, it means include windows on that frame. | |
| 169 Anything else means restrict to the selected frame." | |
| 170 (catch 'found | |
| 171 (walk-windows #'(lambda (window) | |
| 172 (when (funcall predicate window) | |
| 173 (throw 'found window))) | |
| 174 minibuf all-frames) | |
| 175 default)) | |
| 176 | |
| 177 (defalias 'some-window 'get-window-with-predicate) | |
| 178 | |
| 428 | 179 (defun minibuffer-window-active-p (window) |
| 180 "Return t if WINDOW (a minibuffer window) is now active." | |
| 181 (eq window (active-minibuffer-window))) | |
| 182 | |
| 183 (defmacro save-selected-window (&rest body) | |
| 460 | 184 "Execute BODY, then select the window that was selected before BODY. |
| 185 The value returned is the value of the last form in BODY." | |
| 186 (let ((old-window (gensym "ssw"))) | |
| 187 `(let ((,old-window (selected-window))) | |
| 442 | 188 (unwind-protect |
| 189 (progn ,@body) | |
| 460 | 190 (when (window-live-p ,old-window) |
| 191 (select-window ,old-window)))))) | |
| 442 | 192 |
| 193 (defmacro with-selected-window (window &rest body) | |
| 194 "Execute forms in BODY with WINDOW as the selected window. | |
| 195 The value returned is the value of the last form in BODY." | |
| 196 `(save-selected-window | |
| 197 (select-window ,window) | |
| 198 ,@body)) | |
| 428 | 199 |
| 1133 | 200 (defmacro save-window-excursion (&rest body) |
| 201 "Execute body, preserving window sizes and contents. | |
| 202 Restores which buffer appears in which window, where display starts, | |
| 203 as well as the current buffer. | |
| 204 Does not restore the value of point in current buffer." | |
| 205 (let ((window-config (gensym 'window-config))) | |
| 206 `(let ((,window-config (current-window-configuration))) | |
| 207 (unwind-protect | |
| 208 (progn ,@body) | |
| 209 (set-window-configuration ,window-config))))) | |
| 210 | |
| 428 | 211 (defun count-windows (&optional minibuf) |
| 212 "Return the number of visible windows. | |
| 800 | 213 This counts the windows in the selected frame and (if the minibuffer is |
| 214 to be counted) its minibuffer frame (if that's not the same frame). | |
| 215 The optional arg MINIBUF non-nil means count the minibuffer | |
| 428 | 216 even if it is inactive." |
| 217 (let ((count 0)) | |
| 218 (walk-windows (function (lambda (w) | |
| 219 (setq count (+ count 1)))) | |
| 220 minibuf) | |
| 221 count)) | |
| 222 | |
| 800 | 223 (defun window-safely-shrinkable-p (&optional window) |
| 224 "Non-nil if the WINDOW can be shrunk without shrinking other windows. | |
| 225 If WINDOW is nil or omitted, it defaults to the currently selected window." | |
| 226 (save-selected-window | |
| 227 (when window (select-window window)) | |
| 228 (or (and (not (eq window (frame-first-window))) | |
| 229 (= (car (window-pixel-edges)) | |
| 230 (car (window-pixel-edges (previous-window))))) | |
| 231 (= (car (window-pixel-edges)) | |
| 232 (car (window-pixel-edges (next-window))))))) | |
| 233 | |
| 428 | 234 (defun balance-windows () |
| 235 "Make all visible windows the same height (approximately)." | |
| 236 (interactive) | |
| 237 (let ((count -1) levels newsizes size) | |
| 238 ;FSFmacs | |
| 239 ;;; Don't count the lines that are above the uppermost windows. | |
| 240 ;;; (These are the menu bar lines, if any.) | |
| 241 ;(mbl (nth 1 (window-edges (frame-first-window (selected-frame)))))) | |
| 242 ;; Find all the different vpos's at which windows start, | |
| 243 ;; then count them. But ignore levels that differ by only 1. | |
| 244 (save-window-excursion | |
| 245 (let (tops (prev-top -2)) | |
| 246 (walk-windows (function (lambda (w) | |
| 247 (setq tops (cons (nth 1 (window-pixel-edges w)) | |
| 248 tops)))) | |
| 249 'nomini) | |
| 250 (setq tops (sort tops '<)) | |
| 251 (while tops | |
| 252 (if (> (car tops) (1+ prev-top)) | |
| 253 (setq prev-top (car tops) | |
| 254 count (1+ count))) | |
| 255 (setq levels (cons (cons (car tops) count) levels)) | |
| 256 (setq tops (cdr tops))) | |
| 257 (setq count (1+ count)))) | |
| 258 ;; Subdivide the frame into that many vertical levels. | |
| 259 ;FSFmacs (setq size (/ (- (frame-height) mbl) count)) | |
| 260 (setq size (/ (window-pixel-height (frame-root-window)) count)) | |
| 261 (walk-windows (function | |
| 262 (lambda (w) | |
| 263 (select-window w) | |
| 264 (let ((newtop (cdr (assq (nth 1 (window-pixel-edges)) | |
| 265 levels))) | |
| 266 (newbot (or (cdr (assq | |
| 267 (+ (window-pixel-height) | |
| 268 (nth 1 (window-pixel-edges))) | |
| 269 levels)) | |
| 270 count))) | |
| 271 (setq newsizes | |
| 272 (cons (cons w (* size (- newbot newtop))) | |
| 273 newsizes))))) | |
| 274 'nomini) | |
| 275 (walk-windows (function (lambda (w) | |
| 276 (select-window w) | |
| 277 (let ((newsize (cdr (assq w newsizes)))) | |
| 278 (enlarge-window | |
| 279 (/ (- newsize (window-pixel-height)) | |
| 280 (face-height 'default)))))) | |
| 281 'nomini))) | |
| 282 | |
| 283 ;;; I think this should be the default; I think people will prefer it--rms. | |
| 284 (defcustom split-window-keep-point t | |
| 285 "*If non-nil, split windows keeps the original point in both children. | |
| 286 This is often more convenient for editing. | |
| 287 If nil, adjust point in each of the two windows to minimize redisplay. | |
| 288 This is convenient on slow terminals, but point can move strangely." | |
| 289 :type 'boolean | |
| 290 :group 'windows) | |
| 291 | |
| 292 (defun split-window-vertically (&optional arg) | |
| 293 "Split current window into two windows, one above the other. | |
| 294 The uppermost window gets ARG lines and the other gets the rest. | |
| 295 Negative arg means select the size of the lowermost window instead. | |
| 296 With no argument, split equally or close to it. | |
| 297 Both windows display the same buffer now current. | |
| 298 | |
| 730 | 299 If the variable `split-window-keep-point' is non-nil, both new windows |
| 428 | 300 will get the same value of point as the current window. This is often |
| 301 more convenient for editing. | |
| 302 | |
| 444 | 303 Otherwise, we choose window starts so as to minimize the amount of |
| 428 | 304 redisplay; this is convenient on slow terminals. The new selected |
| 305 window is the one that the current value of point appears in. The | |
| 306 value of point can change if the text around point is hidden by the | |
| 307 new mode line. | |
| 308 | |
| 309 Programs should probably use split-window instead of this." | |
| 310 (interactive "P") | |
| 311 (let ((old-w (selected-window)) | |
| 312 (old-point (point)) | |
| 313 (size (and arg (prefix-numeric-value arg))) | |
| 314 (window-full-p nil) | |
| 315 new-w bottom moved) | |
| 316 (and size (< size 0) (setq size (+ (window-height) size))) | |
| 317 (setq new-w (split-window nil size)) | |
| 318 (or split-window-keep-point | |
| 319 (progn | |
| 320 (save-excursion | |
| 321 (set-buffer (window-buffer)) | |
| 322 (goto-char (window-start)) | |
| 323 (setq moved (vertical-motion (window-height))) | |
| 324 (set-window-start new-w (point)) | |
| 325 (if (> (point) (window-point new-w)) | |
| 326 (set-window-point new-w (point))) | |
| 327 (and (= moved (window-height)) | |
| 328 (progn | |
| 329 (setq window-full-p t) | |
| 330 (vertical-motion -1))) | |
| 331 (setq bottom (point))) | |
| 332 (and window-full-p | |
| 333 (<= bottom (point)) | |
| 334 (set-window-point old-w (1- bottom))) | |
| 335 (and window-full-p | |
| 336 (<= (window-start new-w) old-point) | |
| 337 (progn | |
| 338 (set-window-point new-w old-point) | |
| 339 (select-window new-w))))) | |
| 340 new-w)) | |
| 341 | |
| 342 (defun split-window-horizontally (&optional arg) | |
| 343 "Split current window into two windows side by side. | |
| 344 This window becomes the leftmost of the two, and gets ARG columns. | |
| 345 Negative arg means select the size of the rightmost window instead. | |
| 346 No arg means split equally." | |
| 347 (interactive "P") | |
| 348 (let ((size (and arg (prefix-numeric-value arg)))) | |
| 349 (and size (< size 0) | |
| 350 (setq size (+ (window-width) size))) | |
| 351 (split-window nil size t))) | |
| 352 | |
| 353 (defun enlarge-window-horizontally (arg) | |
| 354 "Make current window ARG columns wider." | |
| 355 (interactive "p") | |
| 356 (enlarge-window arg t)) | |
| 357 | |
| 358 (defun shrink-window-horizontally (arg) | |
| 359 "Make current window ARG columns narrower." | |
| 360 (interactive "p") | |
| 361 (shrink-window arg t)) | |
| 362 | |
|
4506
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
363 (defun window-buffer-height (window) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
364 "Return the height (in screen lines) of the buffer that WINDOW is displaying." |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
365 (with-current-buffer (window-buffer window) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
366 (max 1 |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
367 (count-screen-lines (point-min) (point-max) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
368 ;; If buffer ends with a newline, ignore it when |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
369 ;; counting height unless point is after it. |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
370 (eobp) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
371 window)))) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
372 ;; XEmacs change; accept BUFFER. |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
373 (defun count-screen-lines (&optional beg end count-final-newline |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
374 window buffer) |
| 800 | 375 "Return the number of screen lines in the region. |
| 376 The number of screen lines may be different from the number of actual lines, | |
| 377 due to line breaking, display table, etc. | |
| 378 | |
| 379 Optional arguments BEG and END default to `point-min' and `point-max' | |
| 380 respectively. | |
| 381 | |
| 382 If region ends with a newline, ignore it unless optional third argument | |
| 383 COUNT-FINAL-NEWLINE is non-nil. | |
| 384 | |
| 385 The optional fourth argument WINDOW specifies the window used for obtaining | |
| 386 parameters such as width, horizontal scrolling, and so on. The default is | |
| 387 to use the selected window's parameters. | |
| 388 | |
|
4506
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
389 Optional argument BUFFER is the buffer to check, and defaults to the current |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
390 buffer. See `vertical-motion' for some caveats on the differences between |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
391 this behaviour and that of GNU Emacs." |
| 800 | 392 (unless beg |
|
4506
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
393 (setq beg (point-min buffer))) |
| 800 | 394 (unless end |
|
4506
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
395 (setq end (point-max buffer))) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
396 (unless buffer |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
397 (setq buffer (current-buffer))) |
| 800 | 398 (if (= beg end) |
| 399 0 | |
| 400 (save-excursion | |
| 401 (save-restriction | |
|
4506
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
402 (let ((old-window-buffer (window-buffer window))) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
403 (unwind-protect |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
404 (progn |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
405 (set-window-buffer window buffer) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
406 (set-buffer buffer) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
407 (widen) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
408 (narrow-to-region (min beg end) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
409 (if (and (not count-final-newline) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
410 (= ?\n (char-before (max beg end)))) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
411 (1- (max beg end)) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
412 (max beg end))) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
413 (goto-char (point-min)) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
414 (1+ (vertical-motion (buffer-size) window))) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
415 (set-window-buffer window old-window-buffer))))))) |
| 800 | 416 |
|
4506
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
417 (defun fit-window-to-buffer (&optional window max-height min-height) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
418 "Make WINDOW the right height to display its contents exactly. |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
419 If WINDOW is omitted or nil, it defaults to the selected window. |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
420 If the optional argument MAX-HEIGHT is supplied, it is the maximum height |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
421 the window is allowed to be, defaulting to the frame height. |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
422 If the optional argument MIN-HEIGHT is supplied, it is the minimum |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
423 height the window is allowed to be, defaulting to `window-min-height'. |
| 800 | 424 |
|
4506
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
425 The heights in MAX-HEIGHT and MIN-HEIGHT include the mode-line and/or |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
426 header-line." |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
427 (interactive) |
| 800 | 428 |
|
4506
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
429 (when (null window) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
430 (setq window (selected-window))) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
431 (when (null max-height) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
432 (setq max-height (frame-height (window-frame window)))) |
| 800 | 433 |
|
4506
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
434 (let* ((buf |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
435 ;; Buffer that is displayed in WINDOW |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
436 (window-buffer window)) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
437 (window-height |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
438 ;; The current height of WINDOW |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
439 (window-height window)) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
440 (desired-height |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
441 ;; The height necessary to show the buffer displayed by WINDOW |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
442 ;; (`count-screen-lines' always works on the current buffer). |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
443 ;; XEmacs; it does in GNU, we provide a BUFFER argument, but we're |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
444 ;; not changing the implementation. |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
445 (with-current-buffer buf |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
446 (+ (count-screen-lines) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
447 ;; If the buffer is empty, (count-screen-lines) is |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
448 ;; zero. But, even in that case, we need one text line |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
449 ;; for cursor. |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
450 (if (= (point-min) (point-max)) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
451 1 0) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
452 ;; For non-minibuffers, count the mode-line, if any |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
453 (if (and (not (window-minibuffer-p window)) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
454 mode-line-format) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
455 1 0) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
456 ;; Count the header-line, if any |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
457 ;; XEmacs change; we don't have header-line-format. |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
458 ;; (if header-line-format 1 0)))) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
459 (if (specifier-instance top-gutter) 1 0)))) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
460 (delta |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
461 ;; Calculate how much the window height has to change to show |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
462 ;; desired-height lines, constrained by MIN-HEIGHT and MAX-HEIGHT. |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
463 (- (max (min desired-height max-height) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
464 (or min-height window-min-height)) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
465 window-height))) |
| 800 | 466 |
|
4506
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
467 ;; Don't try to redisplay with the cursor at the end |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
468 ;; on its own line--that would force a scroll and spoil things. |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
469 (when (with-current-buffer buf |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
470 (and (eobp) (bolp) (not (bobp)))) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
471 (set-window-point window (1- (window-point window)))) |
| 800 | 472 |
|
4506
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
473 ;; Adjust WINDOW to the nominally correct size (which may actually |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
474 ;; be slightly off because of variable height text, etc). |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
475 (unless (zerop delta) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
476 (enlarge-window delta nil window)) |
| 800 | 477 |
|
4506
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
478 ;; Check if the last line is surely fully visible. If not, |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
479 ;; enlarge the window. |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
480 (let ((end (with-current-buffer buf |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
481 (save-excursion |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
482 (goto-char (point-max)) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
483 (when (and (bolp) (not (bobp))) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
484 ;; Don't include final newline |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
485 (backward-char 1)) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
486 (when truncate-lines |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
487 ;; If line-wrapping is turned off, test the |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
488 ;; beginning of the last line for visibility |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
489 ;; instead of the end, as the end of the line |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
490 ;; could be invisible by virtue of extending past |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
491 ;; the edge of the window. |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
492 (forward-line 0)) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
493 (point)))) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
494 ;; XEmacs change; bind window-pixel-vscroll-increment, we don't |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
495 ;; have #'set-window-vscroll. |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
496 (window-pixel-scroll-increment 0)) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
497 ; (set-window-vscroll window 0) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
498 (while (and (< desired-height max-height) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
499 (= desired-height (window-height window)) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
500 (not (pos-visible-in-window-p end window))) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
501 (enlarge-window 1 nil window) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
502 (setq desired-height (1+ desired-height)))))) |
| 800 | 503 |
| 428 | 504 (defun shrink-window-if-larger-than-buffer (&optional window) |
| 505 "Shrink the WINDOW to be as small as possible to display its contents. | |
| 506 Do not shrink to less than `window-min-height' lines. | |
| 507 Do nothing if the buffer contains more lines than the present window height, | |
| 508 or if some of the window's contents are scrolled out of view, | |
| 509 or if the window is not the full width of the frame, | |
| 510 or if the window is the only window of its frame." | |
| 511 (interactive) | |
| 512 (or window (setq window (selected-window))) | |
| 513 (save-excursion | |
| 514 (set-buffer (window-buffer window)) | |
| 1127 | 515 (let ((test-pos |
| 428 | 516 (- (point-max) |
| 517 ;; If buffer ends with a newline, ignore it when counting | |
| 518 ;; height unless point is after it. | |
| 519 (if (and (not (eobp)) | |
| 520 (eq ?\n (char-after (1- (point-max))))) | |
| 521 1 0))) | |
| 442 | 522 (mini (frame-property (window-frame window) 'minibuffer))) |
| 428 | 523 (if (and (< 1 (let ((frame (selected-frame))) |
| 524 (select-frame (window-frame window)) | |
| 525 (unwind-protect | |
| 526 (count-windows) | |
| 527 (select-frame frame)))) | |
| 528 ;; check to make sure that the window is the full width | |
| 529 ;; of the frame | |
| 440 | 530 (window-leftmost-p window) |
| 531 (window-rightmost-p window) | |
| 428 | 532 ;; The whole buffer must be visible. |
| 533 (pos-visible-in-window-p (point-min) window) | |
| 534 ;; The frame must not be minibuffer-only. | |
| 535 (not (eq mini 'only))) | |
| 536 (progn | |
| 1127 | 537 (goto-char (point-min)) |
| 538 (while (and (pos-visible-in-window-p test-pos window) | |
| 539 (> (window-height window) window-min-height)) | |
| 540 (shrink-window 1 nil window)) | |
| 541 (if (not (pos-visible-in-window-p test-pos window)) | |
| 542 (enlarge-window 1 nil window))))))) | |
| 428 | 543 |
| 544 (defun kill-buffer-and-window () | |
| 545 "Kill the current buffer and delete the selected window." | |
| 546 (interactive) | |
| 547 (if (yes-or-no-p (format "Kill buffer `%s'? " (buffer-name))) | |
| 548 (let ((buffer (current-buffer))) | |
| 549 (delete-window (selected-window)) | |
| 550 (kill-buffer buffer)) | |
| 551 (error "Aborted"))) | |
| 552 | |
| 730 | 553 (defun quit-window (&optional kill window) |
| 554 "Quit the current buffer. Bury it, and maybe delete the selected frame. | |
| 555 \(The frame is deleted if it is contains a dedicated window for the buffer.) | |
| 556 With a prefix argument, kill the buffer instead. | |
| 557 | |
| 558 Noninteractively, if KILL is non-nil, then kill the current buffer, | |
| 559 otherwise bury it. | |
| 428 | 560 |
| 730 | 561 If WINDOW is non-nil, it specifies a window; we delete that window, |
| 562 and the buffer that is killed or buried is the one in that window." | |
| 563 (interactive "P") | |
| 564 (let ((buffer (window-buffer window)) | |
| 565 (frame (window-frame (or window (selected-window)))) | |
| 566 (window-solitary | |
| 567 (save-selected-window | |
| 568 (if window | |
| 569 (select-window window)) | |
| 570 (one-window-p t))) | |
| 571 window-handled) | |
| 444 | 572 |
| 730 | 573 (save-selected-window |
| 574 (if window | |
| 575 (select-window window)) | |
| 576 (or (window-minibuffer-p) | |
| 577 (window-dedicated-p (selected-window)) | |
| 578 (switch-to-buffer (other-buffer)))) | |
| 579 | |
| 580 ;; Get rid of the frame, if it has just one dedicated window | |
| 581 ;; and other visible frames exist. | |
| 582 (and (or (window-minibuffer-p) (window-dedicated-p window)) | |
| 583 (delq frame (visible-frame-list)) | |
| 584 window-solitary | |
| 585 (if (and (eq default-minibuffer-frame frame) | |
|
5366
f00192e1cd49
Examining the result of #'length: `eql', not `=', it's better style & cheaper
Aidan Kehoe <kehoea@parhasard.net>
parents:
4506
diff
changeset
|
586 (eql 1 (length (minibuffer-frame-list)))) |
| 730 | 587 (setq window nil) |
| 588 (delete-frame frame) | |
| 589 (setq window-handled t))) | |
| 590 | |
| 591 ;; Deal with the buffer. | |
| 592 (if kill | |
| 593 (kill-buffer buffer) | |
| 594 (bury-buffer buffer)) | |
| 595 | |
| 596 ;; Maybe get rid of the window. | |
| 597 (and window (not window-handled) (not window-solitary) | |
| 598 (delete-window window)))) | |
| 428 | 599 |
| 600 ;;; window.el ends here |