Mercurial > hg > xemacs-beta
annotate lisp/window.el @ 4910:6bc1f3f6cf0d
Make canoncase visible to Lisp; use it with chars in internal_equalp.
src/ChangeLog addition:
2010-02-01 Aidan Kehoe <kehoea@parhasard.net>
* fns.c (internal_equalp):
Use bytecode_arithcompare, which takes two args, instead of
passing a stack pointer to Feqlsign.
Use CANONCASE(), not DOWNCASE(), for case-insensitive character
comparison.
Correct a comment here.
* casefiddle.c (casify_object): New operation in this function,
CASE_CANONICALIZE.
(Fcanoncase): New function, used for case-insensitive comparison.
* lisp.h:
Make Fcanoncase, bytecode_arithcompare visible here.
* bytecode.c (bytecode_arithcompare):
Make this visible to other files.
lisp/ChangeLog addition:
2010-02-01 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (equalp):
Remove special treatment for an #'equalp with a single character
constant argument, it was incorrect (it used #'downcase instead of
#'canoncase).
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Mon, 01 Feb 2010 17:57:04 +0000 |
| parents | bd28481bb0e1 |
| children | f00192e1cd49 308d34e9f07d |
| 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 | |
| 11 ;; XEmacs is free software; you can redistribute it and/or modify it | |
| 12 ;; under the terms of the GNU General Public License as published by | |
| 13 ;; the Free Software Foundation; either version 2, or (at your option) | |
| 14 ;; any later version. | |
| 15 | |
| 16 ;; XEmacs is distributed in the hope that it will be useful, but | |
| 17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
| 19 ;; General Public License for more details. | |
| 20 | |
| 21 ;; You should have received a copy of the GNU General Public License | |
| 22 ;; along with XEmacs; see the file COPYING. If not, write to the | |
| 23 ;; Free Software Foundation, 59 Temple Place - Suite 330, | |
| 24 ;; Boston, MA 02111-1307, USA. | |
| 25 | |
| 26 ;;; Synched up with: Emacs/Mule zeta. | |
| 27 | |
| 28 ;;; Commentary: | |
| 29 | |
| 30 ;; This file is dumped with XEmacs. | |
| 31 | |
| 32 ;;; Code: | |
| 33 | |
| 34 ;;;; Window tree functions. | |
| 35 | |
|
4506
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
36 ;; 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
|
37 (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
|
38 "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
|
39 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
|
40 minibuffer even if it is active. |
| 428 | 41 |
|
4506
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
42 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
|
43 |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
44 WHICH-FRAMES nil or omitted means count only WINDOW's frame, |
| 428 | 45 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
|
46 \(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
|
47 WHICH-DEVICES argument.) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
48 WHICH-FRAMES = `visible' means include windows on all visible frames |
| 444 | 49 WHICH-FRAMES = 0 means include windows on all visible and iconified frames. |
| 50 WHICH-FRAMES = t means include windows on all frames including invisible frames. | |
| 51 If WHICH-FRAMES is any other value, count only the selected frame. | |
| 428 | 52 |
| 444 | 53 The optional third argument WHICH-DEVICES further clarifies on which |
| 54 devices to search for frames as specified by WHICH-FRAMES. This value | |
| 55 is only meaningful if WHICH-FRAMES is non-nil. | |
| 56 If nil or omitted, search all devices on the selected console. | |
| 57 If a device, only search that device. | |
| 58 If a console, search all devices on that console. | |
| 59 If a device type, search all devices of that type. | |
| 60 If `window-system', search all devices on window-system consoles. | |
| 61 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
|
62 (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
|
63 (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
|
64 (minibuffer-window (window-frame base-window)))) |
| 428 | 65 (setq base-window (next-window base-window))) |
| 66 (eq base-window | |
| 444 | 67 (next-window base-window (if nomini 'arg) which-frames which-devices)))) |
| 428 | 68 |
|
4506
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
69 (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
|
70 "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
|
71 |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
72 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
|
73 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
|
74 (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
|
75 |
| 444 | 76 (defun walk-windows (function &optional minibuf which-frames which-devices) |
| 77 "Cycle through all visible windows, calling FUNCTION for each one. | |
| 78 FUNCTION is called with a window as argument. | |
| 428 | 79 |
| 80 Optional second arg MINIBUF t means count the minibuffer window even | |
| 81 if not active. MINIBUF nil or omitted means count the minibuffer iff | |
| 82 it is active. MINIBUF neither t nor nil means not to count the | |
| 83 minibuffer even if it is active. | |
| 84 | |
| 85 Several frames may share a single minibuffer; if the minibuffer | |
| 86 counts, all windows on all frames that share that minibuffer count | |
| 87 too. Therefore, when a separate minibuffer frame is active, | |
| 88 `walk-windows' includes the windows in the frame from which you | |
| 89 entered the minibuffer, as well as the minibuffer window. But if the | |
| 444 | 90 minibuffer does not count, only the selected window counts. |
| 428 | 91 |
| 444 | 92 By default, only the windows in the selected frame are included. |
| 93 The optional argument WHICH-FRAMES changes this behavior: | |
| 94 WHICH-FRAMES nil or omitted means cycle within the frames as specified above. | |
| 95 WHICH-FRAMES = `visible' means include windows on all visible frames. | |
| 96 WHICH-FRAMES = 0 means include windows on all visible and iconified frames. | |
| 97 WHICH-FRAMES = t means include windows on all frames including invisible frames. | |
| 428 | 98 Anything else means restrict to WINDOW's frame. |
| 99 | |
| 444 | 100 The optional fourth argument WHICH-DEVICES further clarifies on which |
| 101 devices to search for frames as specified by WHICH-FRAMES. This value | |
| 102 is only meaningful if WHICH-FRAMES is non-nil. | |
| 103 If nil or omitted, search all devices on the selected console. | |
| 104 If a device, only search that device. | |
| 105 If a console, search all devices on that console. | |
| 106 If a device type, search all devices of that type. | |
| 107 If `window-system', search all devices on window-system consoles. | |
| 108 Any other non-nil value means search all devices." | |
| 428 | 109 ;; If we start from the minibuffer window, don't fail to come back to it. |
| 1279 | 110 (let ((arg (cond |
| 111 ((framep which-frames) which-frames) | |
| 112 ((devicep which-devices) which-devices) | |
| 113 (t nil)))) | |
| 114 (if (window-minibuffer-p (selected-window arg)) | |
| 115 (setq minibuf t)) | |
| 116 ;; Note that, like next-window & previous-window, this behaves a little | |
| 117 ;; strangely if the selected window is on an invisible frame: it hits | |
| 118 ;; some of the windows on that frame, and all windows on visible frames. | |
| 119 (let* ((walk-windows-start (selected-window arg)) | |
| 120 (walk-windows-current walk-windows-start)) | |
| 121 (while (progn | |
| 122 (setq walk-windows-current | |
| 123 (next-window walk-windows-current minibuf which-frames | |
| 124 which-devices)) | |
| 125 (funcall function walk-windows-current) | |
| 126 (not (eq walk-windows-current walk-windows-start))))))) | |
| 428 | 127 ;; The old XEmacs definition of the above clause. It's more correct in |
| 128 ;; that it will never hit a window that's already been hit even if you | |
| 129 ;; do something odd like `delete-other-windows', but has the problem | |
| 130 ;; that it conses. (This may be called repeatedly, from lazy-lock | |
| 131 ;; for example.) | |
| 132 ; (let* ((walk-windows-history nil) | |
| 133 ; (walk-windows-current (selected-window))) | |
| 134 ; (while (progn | |
| 135 ; (setq walk-windows-current | |
| 444 | 136 ; (next-window walk-windows-current minibuf which-frames |
| 137 ; which-devices)) | |
| 428 | 138 ; (not (memq walk-windows-current walk-windows-history))) |
| 139 ; (setq walk-windows-history (cons walk-windows-current | |
| 140 ; walk-windows-history)) | |
| 444 | 141 ; (funcall function walk-windows-current)))) |
| 428 | 142 |
| 800 | 143 (defun get-window-with-predicate (predicate &optional minibuf |
| 144 all-frames default) | |
| 145 "Return a window satisfying PREDICATE. | |
| 146 | |
| 147 This function cycles through all visible windows using `walk-windows', | |
| 148 calling PREDICATE on each one. PREDICATE is called with a window as | |
| 149 argument. The first window for which PREDICATE returns a non-nil | |
| 150 value is returned. If no window satisfies PREDICATE, DEFAULT is | |
| 151 returned. | |
| 152 | |
| 153 Optional second arg MINIBUF t means count the minibuffer window even | |
| 154 if not active. MINIBUF nil or omitted means count the minibuffer iff | |
| 155 it is active. MINIBUF neither t nor nil means not to count the | |
| 156 minibuffer even if it is active. | |
| 157 | |
| 158 Several frames may share a single minibuffer; if the minibuffer | |
| 159 counts, all windows on all frames that share that minibuffer count | |
| 160 too. Therefore, if you are using a separate minibuffer frame | |
| 161 and the minibuffer is active and MINIBUF says it counts, | |
| 162 `walk-windows' includes the windows in the frame from which you | |
| 163 entered the minibuffer, as well as the minibuffer window. | |
| 164 | |
| 165 ALL-FRAMES is the optional third argument. | |
| 166 ALL-FRAMES nil or omitted means cycle within the frames as specified above. | |
| 167 ALL-FRAMES = `visible' means include windows on all visible frames. | |
| 168 ALL-FRAMES = 0 means include windows on all visible and iconified frames. | |
| 169 ALL-FRAMES = t means include windows on all frames including invisible frames. | |
| 170 If ALL-FRAMES is a frame, it means include windows on that frame. | |
| 171 Anything else means restrict to the selected frame." | |
| 172 (catch 'found | |
| 173 (walk-windows #'(lambda (window) | |
| 174 (when (funcall predicate window) | |
| 175 (throw 'found window))) | |
| 176 minibuf all-frames) | |
| 177 default)) | |
| 178 | |
| 179 (defalias 'some-window 'get-window-with-predicate) | |
| 180 | |
| 428 | 181 (defun minibuffer-window-active-p (window) |
| 182 "Return t if WINDOW (a minibuffer window) is now active." | |
| 183 (eq window (active-minibuffer-window))) | |
| 184 | |
| 185 (defmacro save-selected-window (&rest body) | |
| 460 | 186 "Execute BODY, then select the window that was selected before BODY. |
| 187 The value returned is the value of the last form in BODY." | |
| 188 (let ((old-window (gensym "ssw"))) | |
| 189 `(let ((,old-window (selected-window))) | |
| 442 | 190 (unwind-protect |
| 191 (progn ,@body) | |
| 460 | 192 (when (window-live-p ,old-window) |
| 193 (select-window ,old-window)))))) | |
| 442 | 194 |
| 195 (defmacro with-selected-window (window &rest body) | |
| 196 "Execute forms in BODY with WINDOW as the selected window. | |
| 197 The value returned is the value of the last form in BODY." | |
| 198 `(save-selected-window | |
| 199 (select-window ,window) | |
| 200 ,@body)) | |
| 428 | 201 |
| 1133 | 202 (defmacro save-window-excursion (&rest body) |
| 203 "Execute body, preserving window sizes and contents. | |
| 204 Restores which buffer appears in which window, where display starts, | |
| 205 as well as the current buffer. | |
| 206 Does not restore the value of point in current buffer." | |
| 207 (let ((window-config (gensym 'window-config))) | |
| 208 `(let ((,window-config (current-window-configuration))) | |
| 209 (unwind-protect | |
| 210 (progn ,@body) | |
| 211 (set-window-configuration ,window-config))))) | |
| 212 | |
| 428 | 213 (defun count-windows (&optional minibuf) |
| 214 "Return the number of visible windows. | |
| 800 | 215 This counts the windows in the selected frame and (if the minibuffer is |
| 216 to be counted) its minibuffer frame (if that's not the same frame). | |
| 217 The optional arg MINIBUF non-nil means count the minibuffer | |
| 428 | 218 even if it is inactive." |
| 219 (let ((count 0)) | |
| 220 (walk-windows (function (lambda (w) | |
| 221 (setq count (+ count 1)))) | |
| 222 minibuf) | |
| 223 count)) | |
| 224 | |
| 800 | 225 (defun window-safely-shrinkable-p (&optional window) |
| 226 "Non-nil if the WINDOW can be shrunk without shrinking other windows. | |
| 227 If WINDOW is nil or omitted, it defaults to the currently selected window." | |
| 228 (save-selected-window | |
| 229 (when window (select-window window)) | |
| 230 (or (and (not (eq window (frame-first-window))) | |
| 231 (= (car (window-pixel-edges)) | |
| 232 (car (window-pixel-edges (previous-window))))) | |
| 233 (= (car (window-pixel-edges)) | |
| 234 (car (window-pixel-edges (next-window))))))) | |
| 235 | |
| 428 | 236 (defun balance-windows () |
| 237 "Make all visible windows the same height (approximately)." | |
| 238 (interactive) | |
| 239 (let ((count -1) levels newsizes size) | |
| 240 ;FSFmacs | |
| 241 ;;; Don't count the lines that are above the uppermost windows. | |
| 242 ;;; (These are the menu bar lines, if any.) | |
| 243 ;(mbl (nth 1 (window-edges (frame-first-window (selected-frame)))))) | |
| 244 ;; Find all the different vpos's at which windows start, | |
| 245 ;; then count them. But ignore levels that differ by only 1. | |
| 246 (save-window-excursion | |
| 247 (let (tops (prev-top -2)) | |
| 248 (walk-windows (function (lambda (w) | |
| 249 (setq tops (cons (nth 1 (window-pixel-edges w)) | |
| 250 tops)))) | |
| 251 'nomini) | |
| 252 (setq tops (sort tops '<)) | |
| 253 (while tops | |
| 254 (if (> (car tops) (1+ prev-top)) | |
| 255 (setq prev-top (car tops) | |
| 256 count (1+ count))) | |
| 257 (setq levels (cons (cons (car tops) count) levels)) | |
| 258 (setq tops (cdr tops))) | |
| 259 (setq count (1+ count)))) | |
| 260 ;; Subdivide the frame into that many vertical levels. | |
| 261 ;FSFmacs (setq size (/ (- (frame-height) mbl) count)) | |
| 262 (setq size (/ (window-pixel-height (frame-root-window)) count)) | |
| 263 (walk-windows (function | |
| 264 (lambda (w) | |
| 265 (select-window w) | |
| 266 (let ((newtop (cdr (assq (nth 1 (window-pixel-edges)) | |
| 267 levels))) | |
| 268 (newbot (or (cdr (assq | |
| 269 (+ (window-pixel-height) | |
| 270 (nth 1 (window-pixel-edges))) | |
| 271 levels)) | |
| 272 count))) | |
| 273 (setq newsizes | |
| 274 (cons (cons w (* size (- newbot newtop))) | |
| 275 newsizes))))) | |
| 276 'nomini) | |
| 277 (walk-windows (function (lambda (w) | |
| 278 (select-window w) | |
| 279 (let ((newsize (cdr (assq w newsizes)))) | |
| 280 (enlarge-window | |
| 281 (/ (- newsize (window-pixel-height)) | |
| 282 (face-height 'default)))))) | |
| 283 'nomini))) | |
| 284 | |
| 285 ;;; I think this should be the default; I think people will prefer it--rms. | |
| 286 (defcustom split-window-keep-point t | |
| 287 "*If non-nil, split windows keeps the original point in both children. | |
| 288 This is often more convenient for editing. | |
| 289 If nil, adjust point in each of the two windows to minimize redisplay. | |
| 290 This is convenient on slow terminals, but point can move strangely." | |
| 291 :type 'boolean | |
| 292 :group 'windows) | |
| 293 | |
| 294 (defun split-window-vertically (&optional arg) | |
| 295 "Split current window into two windows, one above the other. | |
| 296 The uppermost window gets ARG lines and the other gets the rest. | |
| 297 Negative arg means select the size of the lowermost window instead. | |
| 298 With no argument, split equally or close to it. | |
| 299 Both windows display the same buffer now current. | |
| 300 | |
| 730 | 301 If the variable `split-window-keep-point' is non-nil, both new windows |
| 428 | 302 will get the same value of point as the current window. This is often |
| 303 more convenient for editing. | |
| 304 | |
| 444 | 305 Otherwise, we choose window starts so as to minimize the amount of |
| 428 | 306 redisplay; this is convenient on slow terminals. The new selected |
| 307 window is the one that the current value of point appears in. The | |
| 308 value of point can change if the text around point is hidden by the | |
| 309 new mode line. | |
| 310 | |
| 311 Programs should probably use split-window instead of this." | |
| 312 (interactive "P") | |
| 313 (let ((old-w (selected-window)) | |
| 314 (old-point (point)) | |
| 315 (size (and arg (prefix-numeric-value arg))) | |
| 316 (window-full-p nil) | |
| 317 new-w bottom moved) | |
| 318 (and size (< size 0) (setq size (+ (window-height) size))) | |
| 319 (setq new-w (split-window nil size)) | |
| 320 (or split-window-keep-point | |
| 321 (progn | |
| 322 (save-excursion | |
| 323 (set-buffer (window-buffer)) | |
| 324 (goto-char (window-start)) | |
| 325 (setq moved (vertical-motion (window-height))) | |
| 326 (set-window-start new-w (point)) | |
| 327 (if (> (point) (window-point new-w)) | |
| 328 (set-window-point new-w (point))) | |
| 329 (and (= moved (window-height)) | |
| 330 (progn | |
| 331 (setq window-full-p t) | |
| 332 (vertical-motion -1))) | |
| 333 (setq bottom (point))) | |
| 334 (and window-full-p | |
| 335 (<= bottom (point)) | |
| 336 (set-window-point old-w (1- bottom))) | |
| 337 (and window-full-p | |
| 338 (<= (window-start new-w) old-point) | |
| 339 (progn | |
| 340 (set-window-point new-w old-point) | |
| 341 (select-window new-w))))) | |
| 342 new-w)) | |
| 343 | |
| 344 (defun split-window-horizontally (&optional arg) | |
| 345 "Split current window into two windows side by side. | |
| 346 This window becomes the leftmost of the two, and gets ARG columns. | |
| 347 Negative arg means select the size of the rightmost window instead. | |
| 348 No arg means split equally." | |
| 349 (interactive "P") | |
| 350 (let ((size (and arg (prefix-numeric-value arg)))) | |
| 351 (and size (< size 0) | |
| 352 (setq size (+ (window-width) size))) | |
| 353 (split-window nil size t))) | |
| 354 | |
| 355 (defun enlarge-window-horizontally (arg) | |
| 356 "Make current window ARG columns wider." | |
| 357 (interactive "p") | |
| 358 (enlarge-window arg t)) | |
| 359 | |
| 360 (defun shrink-window-horizontally (arg) | |
| 361 "Make current window ARG columns narrower." | |
| 362 (interactive "p") | |
| 363 (shrink-window arg t)) | |
| 364 | |
|
4506
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
365 (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
|
366 "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
|
367 (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
|
368 (max 1 |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
369 (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
|
370 ;; 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
|
371 ;; 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
|
372 (eobp) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
373 window)))) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
374 ;; 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
|
375 (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
|
376 window buffer) |
| 800 | 377 "Return the number of screen lines in the region. |
| 378 The number of screen lines may be different from the number of actual lines, | |
| 379 due to line breaking, display table, etc. | |
| 380 | |
| 381 Optional arguments BEG and END default to `point-min' and `point-max' | |
| 382 respectively. | |
| 383 | |
| 384 If region ends with a newline, ignore it unless optional third argument | |
| 385 COUNT-FINAL-NEWLINE is non-nil. | |
| 386 | |
| 387 The optional fourth argument WINDOW specifies the window used for obtaining | |
| 388 parameters such as width, horizontal scrolling, and so on. The default is | |
| 389 to use the selected window's parameters. | |
| 390 | |
|
4506
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
391 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
|
392 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
|
393 this behaviour and that of GNU Emacs." |
| 800 | 394 (unless beg |
|
4506
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
395 (setq beg (point-min buffer))) |
| 800 | 396 (unless end |
|
4506
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
397 (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
|
398 (unless buffer |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
399 (setq buffer (current-buffer))) |
| 800 | 400 (if (= beg end) |
| 401 0 | |
| 402 (save-excursion | |
| 403 (save-restriction | |
|
4506
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
404 (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
|
405 (unwind-protect |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
406 (progn |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
407 (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
|
408 (set-buffer buffer) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
409 (widen) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
410 (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
|
411 (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
|
412 (= ?\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
|
413 (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
|
414 (max beg end))) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
415 (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
|
416 (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
|
417 (set-window-buffer window old-window-buffer))))))) |
| 800 | 418 |
|
4506
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
419 (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
|
420 "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
|
421 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
|
422 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
|
423 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
|
424 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
|
425 height the window is allowed to be, defaulting to `window-min-height'. |
| 800 | 426 |
|
4506
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
427 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
|
428 header-line." |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
429 (interactive) |
| 800 | 430 |
|
4506
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
431 (when (null window) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
432 (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
|
433 (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
|
434 (setq max-height (frame-height (window-frame window)))) |
| 800 | 435 |
|
4506
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
436 (let* ((buf |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
437 ;; 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
|
438 (window-buffer 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 |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
440 ;; 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
|
441 (window-height window)) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
442 (desired-height |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
443 ;; 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
|
444 ;; (`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
|
445 ;; 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
|
446 ;; 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
|
447 (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
|
448 (+ (count-screen-lines) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
449 ;; 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
|
450 ;; 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
|
451 ;; for cursor. |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
452 (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
|
453 1 0) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
454 ;; 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
|
455 (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
|
456 mode-line-format) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
457 1 0) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
458 ;; 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
|
459 ;; 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
|
460 ;; (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
|
461 (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
|
462 (delta |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
463 ;; 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
|
464 ;; 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
|
465 (- (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
|
466 (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
|
467 window-height))) |
| 800 | 468 |
|
4506
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
469 ;; 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
|
470 ;; 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
|
471 (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
|
472 (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
|
473 (set-window-point window (1- (window-point window)))) |
| 800 | 474 |
|
4506
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
475 ;; 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
|
476 ;; 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
|
477 (unless (zerop delta) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
478 (enlarge-window delta nil window)) |
| 800 | 479 |
|
4506
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
480 ;; 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
|
481 ;; enlarge the window. |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
482 (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
|
483 (save-excursion |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
484 (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
|
485 (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
|
486 ;; 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
|
487 (backward-char 1)) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
488 (when truncate-lines |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
489 ;; 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
|
490 ;; 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
|
491 ;; 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
|
492 ;; 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
|
493 ;; 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
|
494 (forward-line 0)) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
495 (point)))) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
496 ;; 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
|
497 ;; 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
|
498 (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
|
499 ; (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
|
500 (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
|
501 (= 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
|
502 (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
|
503 (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
|
504 (setq desired-height (1+ desired-height)))))) |
| 800 | 505 |
| 428 | 506 (defun shrink-window-if-larger-than-buffer (&optional window) |
| 507 "Shrink the WINDOW to be as small as possible to display its contents. | |
| 508 Do not shrink to less than `window-min-height' lines. | |
| 509 Do nothing if the buffer contains more lines than the present window height, | |
| 510 or if some of the window's contents are scrolled out of view, | |
| 511 or if the window is not the full width of the frame, | |
| 512 or if the window is the only window of its frame." | |
| 513 (interactive) | |
| 514 (or window (setq window (selected-window))) | |
| 515 (save-excursion | |
| 516 (set-buffer (window-buffer window)) | |
| 1127 | 517 (let ((test-pos |
| 428 | 518 (- (point-max) |
| 519 ;; If buffer ends with a newline, ignore it when counting | |
| 520 ;; height unless point is after it. | |
| 521 (if (and (not (eobp)) | |
| 522 (eq ?\n (char-after (1- (point-max))))) | |
| 523 1 0))) | |
| 442 | 524 (mini (frame-property (window-frame window) 'minibuffer))) |
| 428 | 525 (if (and (< 1 (let ((frame (selected-frame))) |
| 526 (select-frame (window-frame window)) | |
| 527 (unwind-protect | |
| 528 (count-windows) | |
| 529 (select-frame frame)))) | |
| 530 ;; check to make sure that the window is the full width | |
| 531 ;; of the frame | |
| 440 | 532 (window-leftmost-p window) |
| 533 (window-rightmost-p window) | |
| 428 | 534 ;; The whole buffer must be visible. |
| 535 (pos-visible-in-window-p (point-min) window) | |
| 536 ;; The frame must not be minibuffer-only. | |
| 537 (not (eq mini 'only))) | |
| 538 (progn | |
| 1127 | 539 (goto-char (point-min)) |
| 540 (while (and (pos-visible-in-window-p test-pos window) | |
| 541 (> (window-height window) window-min-height)) | |
| 542 (shrink-window 1 nil window)) | |
| 543 (if (not (pos-visible-in-window-p test-pos window)) | |
| 544 (enlarge-window 1 nil window))))))) | |
| 428 | 545 |
| 546 (defun kill-buffer-and-window () | |
| 547 "Kill the current buffer and delete the selected window." | |
| 548 (interactive) | |
| 549 (if (yes-or-no-p (format "Kill buffer `%s'? " (buffer-name))) | |
| 550 (let ((buffer (current-buffer))) | |
| 551 (delete-window (selected-window)) | |
| 552 (kill-buffer buffer)) | |
| 553 (error "Aborted"))) | |
| 554 | |
| 730 | 555 (defun quit-window (&optional kill window) |
| 556 "Quit the current buffer. Bury it, and maybe delete the selected frame. | |
| 557 \(The frame is deleted if it is contains a dedicated window for the buffer.) | |
| 558 With a prefix argument, kill the buffer instead. | |
| 559 | |
| 560 Noninteractively, if KILL is non-nil, then kill the current buffer, | |
| 561 otherwise bury it. | |
| 428 | 562 |
| 730 | 563 If WINDOW is non-nil, it specifies a window; we delete that window, |
| 564 and the buffer that is killed or buried is the one in that window." | |
| 565 (interactive "P") | |
| 566 (let ((buffer (window-buffer window)) | |
| 567 (frame (window-frame (or window (selected-window)))) | |
| 568 (window-solitary | |
| 569 (save-selected-window | |
| 570 (if window | |
| 571 (select-window window)) | |
| 572 (one-window-p t))) | |
| 573 window-handled) | |
| 444 | 574 |
| 730 | 575 (save-selected-window |
| 576 (if window | |
| 577 (select-window window)) | |
| 578 (or (window-minibuffer-p) | |
| 579 (window-dedicated-p (selected-window)) | |
| 580 (switch-to-buffer (other-buffer)))) | |
| 581 | |
| 582 ;; Get rid of the frame, if it has just one dedicated window | |
| 583 ;; and other visible frames exist. | |
| 584 (and (or (window-minibuffer-p) (window-dedicated-p window)) | |
| 585 (delq frame (visible-frame-list)) | |
| 586 window-solitary | |
| 587 (if (and (eq default-minibuffer-frame frame) | |
| 588 (= 1 (length (minibuffer-frame-list)))) | |
| 589 (setq window nil) | |
| 590 (delete-frame frame) | |
| 591 (setq window-handled t))) | |
| 592 | |
| 593 ;; Deal with the buffer. | |
| 594 (if kill | |
| 595 (kill-buffer buffer) | |
| 596 (bury-buffer buffer)) | |
| 597 | |
| 598 ;; Maybe get rid of the window. | |
| 599 (and window (not window-handled) (not window-solitary) | |
| 600 (delete-window window)))) | |
| 428 | 601 |
| 602 ;;; window.el ends here |