Mercurial > hg > xemacs-beta

comparison lisp/window.el @ 4506:bd28481bb0e1

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions. lisp/ChangeLog addition: 2008-08-31 Aidan Kehoe <kehoea@parhasard.net> * window.el (only-window-p): New. Check if WINDOW is the only window in some context, normally its frame. (one-window-p): Implemented this in terms of #'only-window-p, calling it on the selected window. (window-buffer-height): Uncomment this, make it work. (count-screen-lines): Support a BUFFER argument. (fit-window-to-buffer): Uncomment this, correct its implementation to work with XEmacs. * help.el (temp-buffer-resize-mode): New. Name taken from GNU, implementation our own. * (resize-temp-buffer-window): New. GNU-compatible alias for #'shrink-window-if-larger-than-buffer. * dumped-lisp.el (preloaded-file-list): Move easy-mmode before help, now that the latter uses #'define-minor-mode. * frame.el: Point to #'temp-buffer-resize-mode in a comment. Some of this code is from GNU; help.el CVS version 1.327 of 2007-03-21, window.el CVS version 1.122, of 2007-06-24. Both these are GPLV2 or later.
author Aidan Kehoe <kehoea@parhasard.net>
date Sun, 31 Aug 2008 12:26:46 +0200
parents cd0abfdb9e9d
children f00192e1cd49 308d34e9f07d
comparison
equal deleted inserted replaced
4504:b82fdf7305ee 4506:bd28481bb0e1
31 31
32 ;;; Code: 32 ;;; Code:
33 33
34 ;;;; Window tree functions. 34 ;;;; Window tree functions.
35 35
36 (defun one-window-p (&optional nomini which-frames which-devices) 36 ;; XEmacs addition, to expose WINDOW.
37 "Return non-nil if the selected window is the only window (in its frame). 37 (defun only-window-p (&optional window nomini which-frames which-devices)
38 Optional arg NOMINI non-nil means don't count the minibuffer 38 "Return non-nil if WINDOW is the only window in some context,
39 even if it is active. 39 normally its frame. Optional arg NOMINI non-nil means don't count the
40 40 minibuffer even if it is active.
41 By default, only the windows in the selected frame are considered. 41
42 The optional argument WHICH-FRAMES changes this behavior: 42 The optional argument WHICH-FRAMES changes the frames that are considered:
43 WHICH-FRAMES nil or omitted means count only the selected frame, 43
44 WHICH-FRAMES nil or omitted means count only WINDOW's frame,
44 plus the minibuffer it uses (which may be on another frame). 45 plus the minibuffer it uses (which may be on another frame).
45 WHICH-FRAMES = `visible' means include windows on all visible frames. 46 \(But, for all values of WHICH-FRAMES, see the documentation for the
47 WHICH-DEVICES argument.)
48 WHICH-FRAMES = `visible' means include windows on all visible frames
46 WHICH-FRAMES = 0 means include windows on all visible and iconified frames. 49 WHICH-FRAMES = 0 means include windows on all visible and iconified frames.
47 WHICH-FRAMES = t means include windows on all frames including invisible frames. 50 WHICH-FRAMES = t means include windows on all frames including invisible frames.
48 If WHICH-FRAMES is any other value, count only the selected frame. 51 If WHICH-FRAMES is any other value, count only the selected frame.
49 52
50 The optional third argument WHICH-DEVICES further clarifies on which 53 The optional third argument WHICH-DEVICES further clarifies on which
54 If a device, only search that device. 57 If a device, only search that device.
55 If a console, search all devices on that console. 58 If a console, search all devices on that console.
56 If a device type, search all devices of that type. 59 If a device type, search all devices of that type.
57 If `window-system', search all devices on window-system consoles. 60 If `window-system', search all devices on window-system consoles.
58 Any other non-nil value means search all devices." 61 Any other non-nil value means search all devices."
59 (let ((base-window (selected-window))) 62 (let ((base-window (or window (selected-window))))
60 (if (and nomini (eq base-window (minibuffer-window))) 63 (if (and nomini (eq base-window
64 (minibuffer-window (window-frame base-window))))
61 (setq base-window (next-window base-window))) 65 (setq base-window (next-window base-window)))
62 (eq base-window 66 (eq base-window
63 (next-window base-window (if nomini 'arg) which-frames which-devices)))) 67 (next-window base-window (if nomini 'arg) which-frames which-devices))))
68
69 (defun one-window-p (&optional nomini which-frames which-devices)
70 "Return the result of calling `only-window-p' on the selected window.
71
72 See that function's documentation for the meaning of the NOMINI,
73 WHICH-FRAMES and WHICH-DEVICES arguments."
74 (only-window-p (selected-window) nomini which-frames which-devices))
64 75
65 (defun walk-windows (function &optional minibuf which-frames which-devices) 76 (defun walk-windows (function &optional minibuf which-frames which-devices)
66 "Cycle through all visible windows, calling FUNCTION for each one. 77 "Cycle through all visible windows, calling FUNCTION for each one.
67 FUNCTION is called with a window as argument. 78 FUNCTION is called with a window as argument.
68 79
349 (defun shrink-window-horizontally (arg) 360 (defun shrink-window-horizontally (arg)
350 "Make current window ARG columns narrower." 361 "Make current window ARG columns narrower."
351 (interactive "p") 362 (interactive "p")
352 (shrink-window arg t)) 363 (shrink-window arg t))
353 364
354 ; (defun window-buffer-height (window) 365 (defun window-buffer-height (window)
355 ; "Return the height (in screen lines) of the buffer that WINDOW is displaying." 366 "Return the height (in screen lines) of the buffer that WINDOW is displaying."
356 ; (save-excursion 367 (with-current-buffer (window-buffer window)
357 ; (set-buffer (window-buffer window)) 368 (max 1
358 ; (goto-char (point-min)) 369 (count-screen-lines (point-min) (point-max)
359 ; (let ((ignore-final-newline 370 ;; If buffer ends with a newline, ignore it when
360 ; ;; If buffer ends with a newline, ignore it when counting height 371 ;; counting height unless point is after it.
361 ; ;; unless point is after it. 372 (eobp)
362 ; (and (not (eobp)) (eq ?\n (char-after (1- (point-max))))))) 373 window))))
363 ; (+ 1 (nth 2 (compute-motion (point-min) 374 ;; XEmacs change; accept BUFFER.
364 ; '(0 . 0) 375 (defun count-screen-lines (&optional beg end count-final-newline
365 ; (- (point-max) (if ignore-final-newline 1 0)) 376 window buffer)
366 ; (cons 0 100000000)
367 ; (window-width window)
368 ; nil
369 ; window))))))
370
371 (defun count-screen-lines (&optional beg end count-final-newline window)
372 "Return the number of screen lines in the region. 377 "Return the number of screen lines in the region.
373 The number of screen lines may be different from the number of actual lines, 378 The number of screen lines may be different from the number of actual lines,
374 due to line breaking, display table, etc. 379 due to line breaking, display table, etc.
375 380
376 Optional arguments BEG and END default to `point-min' and `point-max' 381 Optional arguments BEG and END default to `point-min' and `point-max'
381 386
382 The optional fourth argument WINDOW specifies the window used for obtaining 387 The optional fourth argument WINDOW specifies the window used for obtaining
383 parameters such as width, horizontal scrolling, and so on. The default is 388 parameters such as width, horizontal scrolling, and so on. The default is
384 to use the selected window's parameters. 389 to use the selected window's parameters.
385 390
386 Like `vertical-motion', `count-screen-lines' always uses the current buffer, 391 Optional argument BUFFER is the buffer to check, and defaults to the current
387 regardless of which buffer is displayed in WINDOW. This makes possible to use 392 buffer. See `vertical-motion' for some caveats on the differences between
388 `count-screen-lines' in any buffer, whether or not it is currently displayed 393 this behaviour and that of GNU Emacs."
389 in some window."
390 (unless beg 394 (unless beg
391 (setq beg (point-min))) 395 (setq beg (point-min buffer)))
392 (unless end 396 (unless end
393 (setq end (point-max))) 397 (setq end (point-max buffer)))
398 (unless buffer
399 (setq buffer (current-buffer)))
394 (if (= beg end) 400 (if (= beg end)
395 0 401 0
396 (save-excursion 402 (save-excursion
397 (save-restriction 403 (save-restriction
398 (widen) 404 (let ((old-window-buffer (window-buffer window)))
399 (narrow-to-region (min beg end) 405 (unwind-protect
400 (if (and (not count-final-newline) 406 (progn
401 (= ?\n (char-before (max beg end)))) 407 (set-window-buffer window buffer)
402 (1- (max beg end)) 408 (set-buffer buffer)
403 (max beg end))) 409 (widen)
404 (goto-char (point-min)) 410 (narrow-to-region (min beg end)
405 (1+ (vertical-motion (buffer-size) window)))))) 411 (if (and (not count-final-newline)
406 412 (= ?\n (char-before (max beg end))))
407 ; (defun fit-window-to-buffer (&optional window max-height min-height) 413 (1- (max beg end))
408 ; "Make WINDOW the right size to display its contents exactly. 414 (max beg end)))
409 ; If WINDOW is omitted or nil, it defaults to the selected window. 415 (goto-char (point-min))
410 ; If the optional argument MAX-HEIGHT is supplied, it is the maximum height 416 (1+ (vertical-motion (buffer-size) window)))
411 ; the window is allowed to be, defaulting to the frame height. 417 (set-window-buffer window old-window-buffer)))))))
412 ; If the optional argument MIN-HEIGHT is supplied, it is the minimum 418
413 ; height the window is allowed to be, defaulting to `window-min-height'. 419 (defun fit-window-to-buffer (&optional window max-height min-height)
414 420 "Make WINDOW the right height to display its contents exactly.
415 ; The heights in MAX-HEIGHT and MIN-HEIGHT include the mode-line and/or 421 If WINDOW is omitted or nil, it defaults to the selected window.
416 ; header-line." 422 If the optional argument MAX-HEIGHT is supplied, it is the maximum height
417 ; (interactive) 423 the window is allowed to be, defaulting to the frame height.
418 424 If the optional argument MIN-HEIGHT is supplied, it is the minimum
419 ; (when (null window) 425 height the window is allowed to be, defaulting to `window-min-height'.
420 ; (setq window (selected-window))) 426
421 ; (when (null max-height) 427 The heights in MAX-HEIGHT and MIN-HEIGHT include the mode-line and/or
422 ; (setq max-height (frame-height (window-frame window)))) 428 header-line."
423 429 (interactive)
424 ; (let* ((buf 430
425 ; ;; Buffer that is displayed in WINDOW 431 (when (null window)
426 ; (window-buffer window)) 432 (setq window (selected-window)))
427 ; (window-height 433 (when (null max-height)
428 ; ;; The current height of WINDOW 434 (setq max-height (frame-height (window-frame window))))
429 ; (window-height window)) 435
430 ; (desired-height 436 (let* ((buf
431 ; ;; The height necessary to show the buffer displayed by WINDOW 437 ;; Buffer that is displayed in WINDOW
432 ; ;; (`count-screen-lines' always works on the current buffer). 438 (window-buffer window))
433 ; (with-current-buffer buf 439 (window-height
434 ; (+ (count-screen-lines) 440 ;; The current height of WINDOW
435 ; ;; If the buffer is empty, (count-screen-lines) is 441 (window-height window))
436 ; ;; zero. But, even in that case, we need one text line 442 (desired-height
437 ; ;; for cursor. 443 ;; The height necessary to show the buffer displayed by WINDOW
438 ; (if (= (point-min) (point-max)) 444 ;; (`count-screen-lines' always works on the current buffer).
439 ; 1 0) 445 ;; XEmacs; it does in GNU, we provide a BUFFER argument, but we're
440 ; ;; For non-minibuffers, count the mode-line, if any 446 ;; not changing the implementation.
441 ; (if (and (not (window-minibuffer-p window)) 447 (with-current-buffer buf
442 ; mode-line-format) 448 (+ (count-screen-lines)
443 ; 1 0) 449 ;; If the buffer is empty, (count-screen-lines) is
444 ; ;; Count the header-line, if any 450 ;; zero. But, even in that case, we need one text line
445 ; (if header-line-format 1 0)))) 451 ;; for cursor.
446 ; (delta 452 (if (= (point-min) (point-max))
447 ; ;; Calculate how much the window height has to change to show 453 1 0)
448 ; ;; desired-height lines, constrained by MIN-HEIGHT and MAX-HEIGHT. 454 ;; For non-minibuffers, count the mode-line, if any
449 ; (- (max (min desired-height max-height) 455 (if (and (not (window-minibuffer-p window))
450 ; (or min-height window-min-height)) 456 mode-line-format)
451 ; window-height)) 457 1 0)
452 ; ;; We do our own height checking, so avoid any restrictions due to 458 ;; Count the header-line, if any
453 ; ;; window-min-height. 459 ;; XEmacs change; we don't have header-line-format.
454 ; (window-min-height 1)) 460 ;; (if header-line-format 1 0))))
455 461 (if (specifier-instance top-gutter) 1 0))))
456 ; ;; Don't try to redisplay with the cursor at the end 462 (delta
457 ; ;; on its own line--that would force a scroll and spoil things. 463 ;; Calculate how much the window height has to change to show
458 ; (when (with-current-buffer buf 464 ;; desired-height lines, constrained by MIN-HEIGHT and MAX-HEIGHT.
459 ; (and (eobp) (bolp) (not (bobp)))) 465 (- (max (min desired-height max-height)
460 ; (set-window-point window (1- (window-point window)))) 466 (or min-height window-min-height))
461 467 window-height)))
462 ; (save-selected-window 468
463 ; (select-window window) 469 ;; Don't try to redisplay with the cursor at the end
464 470 ;; on its own line--that would force a scroll and spoil things.
465 ; ;; Adjust WINDOW to the nominally correct size (which may actually 471 (when (with-current-buffer buf
466 ; ;; be slightly off because of variable height text, etc). 472 (and (eobp) (bolp) (not (bobp))))
467 ; (unless (zerop delta) 473 (set-window-point window (1- (window-point window))))
468 ; (enlarge-window delta)) 474
469 475 ;; Adjust WINDOW to the nominally correct size (which may actually
470 ; ;; Check if the last line is surely fully visible. If not, 476 ;; be slightly off because of variable height text, etc).
471 ; ;; enlarge the window. 477 (unless (zerop delta)
472 ; (let ((end (with-current-buffer buf 478 (enlarge-window delta nil window))
473 ; (save-excursion 479
474 ; (goto-char (point-max)) 480 ;; Check if the last line is surely fully visible. If not,
475 ; (when (and (bolp) (not (bobp))) 481 ;; enlarge the window.
476 ; ;; Don't include final newline 482 (let ((end (with-current-buffer buf
477 ; (backward-char 1)) 483 (save-excursion
478 ; (when truncate-lines 484 (goto-char (point-max))
479 ; ;; If line-wrapping is turned off, test the 485 (when (and (bolp) (not (bobp)))
480 ; ;; beginning of the last line for visibility 486 ;; Don't include final newline
481 ; ;; instead of the end, as the end of the line 487 (backward-char 1))
482 ; ;; could be invisible by virtue of extending past 488 (when truncate-lines
483 ; ;; the edge of the window. 489 ;; If line-wrapping is turned off, test the
484 ; (forward-line 0)) 490 ;; beginning of the last line for visibility
485 ; (point))))) 491 ;; instead of the end, as the end of the line
486 ; (set-window-vscroll window 0) 492 ;; could be invisible by virtue of extending past
487 ; (while (and (< desired-height max-height) 493 ;; the edge of the window.
488 ; (= desired-height (window-height window)) 494 (forward-line 0))
489 ; (not (pos-visible-in-window-p end window))) 495 (point))))
490 ; (enlarge-window 1) 496 ;; XEmacs change; bind window-pixel-vscroll-increment, we don't
491 ; (setq desired-height (1+ desired-height))))))) 497 ;; have #'set-window-vscroll.
498 (window-pixel-scroll-increment 0))
499 ; (set-window-vscroll window 0)
500 (while (and (< desired-height max-height)
501 (= desired-height (window-height window))
502 (not (pos-visible-in-window-p end window)))
503 (enlarge-window 1 nil window)
504 (setq desired-height (1+ desired-height))))))
492 505
493 (defun shrink-window-if-larger-than-buffer (&optional window) 506 (defun shrink-window-if-larger-than-buffer (&optional window)
494 "Shrink the WINDOW to be as small as possible to display its contents. 507 "Shrink the WINDOW to be as small as possible to display its contents.
495 Do not shrink to less than `window-min-height' lines. 508 Do not shrink to less than `window-min-height' lines.
496 Do nothing if the buffer contains more lines than the present window height, 509 Do nothing if the buffer contains more lines than the present window height,