* RE: fit-frame.el
2008-01-16 2:42 fit-frame.el Richard Stallman
@ 2008-02-11 17:02 ` Drew Adams
2008-02-11 21:10 ` fit-frame.el Richard Stallman
0 siblings, 1 reply; 3+ messages in thread
From: Drew Adams @ 2008-02-11 17:02 UTC (permalink / raw)
To: rms, emacs-devel
[-- Attachment #1: Type: text/plain, Size: 1906 bytes --]
Resending file for your review.
----
> From: Richard Stallman Sent: Tuesday, January 15, 2008 6:42 PM
> Would people please read the file fit-frame.el
> that was sent by Drew Adams on Dec 30, and comment on it?
----
> From: Drew Adams Sent: Sunday, December 30, 2007 7:02 PM
> Attached is library `fit-frame.el', for possible inclusion in Emacs.
>
> Command `fit-frame' fits a frame to its buffer(s). See the
> doc string, in particular, for the use of a prefix arg. A
> common use is to fit a one-window frame to its buffer.
>
> Users can set minimum and maximum width and height limits.
> Within those limits, the width of a one-window frame that has
> been fit accommodates all of the buffer lines without
> wrapping, and the height accommodates all of the buffer lines.
>
> Please give it a try. Let me know, especially, how well it
> works on different platforms and with different kinds of
> buffers. I've tried to take into account the menu-bar,
> minibuffer, and tool-bar, and I've tried to compensate for
> long header lines in some buffers, such as Dired.
>
> Wrt the last point: header lines can be wrapped in some modes
> - see option `fit-frame-skip-header-lines-alist'. In these
> cases, a header line is ignored, in order not to let its
> exceptional length skew the width measurement. Example: Dired
> with `dired-details' hiding details - the frame is only as
> wide as the longest file-name length, not the directory name
> in the header line.
>
> Note too that if a buffer contains faces larger than the
> default for the frame, or characters that are extra-wide,
> then fitting is not perfect. For example, TAB characters in
> Info menus can in some cases cause a menu line to wrap, and
> likewise for the slightly larger characters of raised buttons
> in Customize. This is because the computed size is based only
> on the frame's default character size.
[-- Attachment #2: fit-frame-2007-12-30.el --]
[-- Type: application/octet-stream, Size: 21921 bytes --]
;;; fit-frame.el --- Resize a frame. In particular, fit a frame to its buffers.
;;
;; Filename: fit-frame.el
;; Description: Resize a frame. In particular, fit a frame to its buffers.
;; Author: Drew Adams
;; Maintainer: Drew Adams
;; Copyright (C) 2000-2007, Drew Adams, all rights reserved.
;; Created: Thu Dec 7 09:32:12 2000
;; Version: 22.0
;; Last-Updated: Sun Dec 30 18:43:49 2007 (-28800 Pacific Standard Time)
;; By: dradams
;; Update #: 1159
;; Keywords: convenience, frame, window
;; Compatibility: GNU Emacs 22.x
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
;;
;; Resize a frame. In particular, fit a frame to its buffers.
;;
;; Commands and user options (variables) are provided here to resize
;; (shrink-wrap) a frame to fit its displayed buffers, its selected
;; buffer, or the `fill-column' width.
;;
;; The command to fit a frame is `fit-frame'. The main user options
;; for this command are `fit-frame-inhibit-fitting-flag' and
;; `fit-frame-max-*[-percent]'. You can use a prefix argument to
;; control the behavior of command `fit-frame'.
;;
;; Put this in your initialization file (`~/.emacs'):
;;
;; (require 'fit-frame)
;; (add-hook 'after-make-frame-functions 'fit-frame)
;;
;; The second line here causes newly created frames to be fitted to
;; their buffer.
;;
;; Command `fit-frame' does *not* take the following into account,
;; when determining the proper frame size:
;;
;; - font sizes, other than the default frame font
;; - characters, such as TAB, that have special widths
;;
;; Suggested key bindings:
;;
;; (global-set-key [(control ?x) (control ?_)] 'fit-frame)
;; (global-set-key [vertical-line down-mouse-1]
;; 'fit-frame-or-mouse-drag-vertical-line)
;;
;; Customize the menu-bar. Uncomment this to try it out.
;;
;; (defvar menu-bar-frames-menu (make-sparse-keymap "Frames"))
;; (define-key global-map [menu-bar frames]
;; (cons "Frames" menu-bar-frames-menu)))
;; (define-key menu-bar-frames-menu [fit-frame]
;; '("Fit This Frame" . fit-frame))
;;
;; TO DO:
;;
;; Emacs needs a command similar to `fit-frame' for windows, that is,
;; a command that will fit the existing windows of a frame to their
;; buffers, as well as possible. That could be then be used in
;; combination with `fit-frame'.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
;; Floor, Boston, MA 02110-1301, USA.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
\f
;;; User options ---------------------------------------------------
;;;###autoload
(defgroup fit-frame nil
"Resize a frame to fit its buffers."
:group 'frames :group 'convenience)
;;;###autoload
(defcustom fit-frame-inhibit-fitting-flag nil
"*Non-nil means command `fit-frame' does nothing.
You can bind this to non-`nil' to temporarily inhibit frame fitting:
(let ((fit-frame-inhibit-fitting-flag t))...)"
:type 'boolean :group 'fit-frame)
;;;###autoload
(defcustom fit-frame-min-width 20
"*Minimum width, in characters, that `fit-frame' gives to a frame.
The actual minimum is at least the greater of this and `window-min-width'."
:type 'integer :group 'fit-frame)
;;;###autoload
(defcustom fit-frame-max-width nil
"*Maximum width, in characters, that `fit-frame' gives to a frame.
If nil, then the function `fit-frame-max-width' is used instead."
:type '(choice (const :tag "Use `fit-frame-max-width-percent' instead" nil)
integer)
:group 'fit-frame)
;;;###autoload
(defcustom fit-frame-max-width-percent 94
"*Maximum percent of display width that `fit-frame' gives to a frame'.
See function `fit-frame-max-width'.
Not used unless `fit-frame-max-width' is nil."
:type 'integer :group 'fit-frame)
;;;###autoload
(defcustom fit-frame-min-height window-min-height
"*Minimum height, in lines, that `fit-frame' gives to a frame.
The actual minimum is at least the greater of this and `window-min-height'."
:type 'integer :group 'fit-frame)
;;;###autoload
(defcustom fit-frame-max-height nil
"*Maximum height, in lines, that `fit-frame' gives to a frame.
If nil, then the function `fit-frame-max-height' is used instead."
:type '(choice (const :tag "Use `fit-frame-max-height-percent' instead" nil)
integer)
:group 'fit-frame)
;;;###autoload
(defcustom fit-frame-max-height-percent 82
"*Maximum percent of display height that `fit-frame' gives to a frame.
See function `fit-frame-max-height'.
Not used unless `fit-frame-max-height' is nil."
:type 'integer :group 'fit-frame)
;;;###autoload
(defcustom fit-frame-empty-width (or (cdr (assq 'width default-frame-alist)) 80)
"*Width, in characters, that `fit-frame' gives to an empty frame."
:type 'integer :group 'fit-frame)
;;;###autoload
(defcustom fit-frame-empty-height (or (cdr (assq 'height default-frame-alist)) 35)
"*Height, in lines, that `fit-frame' gives to an empty frame."
:type 'integer :group 'fit-frame)
;;;###autoload
(defcustom fit-frame-empty-special-display-width 80
"*Width, in chars, that `fit-frame' gives to an empty special-display frame.
If this is nil, it is ignored."
:type 'integer :group 'fit-frame)
;;;###autoload
(defcustom fit-frame-empty-special-display-height 9
"*Height, in lines, that `fit-frame' gives to an empty special-display frame.
If this is nil, it is ignored."
:type 'integer :group 'fit-frame)
;;;###autoload
(defcustom fit-frame-fill-column-margin 7
"*Difference between `fill-column' and frame width after fitting a frame.
Used when `fit-frame' fits a frame, if the prefix arg is negative.
Depending on the average word length of the language used in the
selected window, you might want different values for this. For this
reason, writers of some modes might want to make this buffer-local."
:type 'integer :group 'fit-frame)
;;;###autoload
(defcustom fit-frame-skip-header-lines-alist
'((Info-mode . 1) (dired-mode . 2) (compilation-mode . 2))
"*Alist of major-modes and header lines to ignore.
When `fit-frame' calculates the width of the current buffer, it can
first skip some lines at the buffer beginning, ignoring their
widths. For example, Info, Dired, and compilation buffers sometimes
have a long header line at the top. You can use this alist to tell
`fit-frame' to ignore the width of these header lines.
Each item in the alist is of form (MODE . LINES).
MODE is a major-mode name.
LINES is the number of lines to skip at the beginning of the buffer."
:type '(repeat (cons :format "%v" (symbol :tag "Major Mode")
(integer :tag "Header Lines to Ignore")))
:group 'fit-frame)
\f
;;; Commands ---------------------------------------------------
;;;###autoload
(defun fit-frame (&optional frame width height all-windows-p)
"Resize FRAME to fit its buffer(s).
Does nothing if `fit-frame-inhibit-fitting-flag' is non-nil.
FRAME defaults to the current (i.e. selected) frame.
If non-nil, WIDTH and HEIGHT specify the frame width and height. To
define them interactively, use a non-negative prefix arg (e.g. `C-9').
To set the width to `fill-column' + `fit-frame-fill-column-margin',
use a negative prefix arg (e.g. `M--').
To fit the frame to all of its displayed buffers, use no prefix arg.
To fit it to just the current buffer, use a plain prefix arg (`C-u').
Fitting a non-empty buffer means resizing the frame to the smallest
size such that the following are both true:
* The width is at least `fit-frame-min-width' and `window-min-width'.
The width is at most `fit-frame-max-width(-percent)' and the
longest line length.
* The height is at least `fit-frame-min-height' and
`window-min-height'. The height is at most
`fit-frame-max-height(-percent)' and the number of lines.
You can thus use those user variables to control the maximum and
minimum frame sizes. The `*-percent' options let you specify the
maximum as a percentage of your display size.
See also option `fit-frame-skip-header-lines-alist'.
The following user options control how an empty frame is fit.
An empty frame is a one-window frame displaying an empty buffer.
* `fit-frame-empty-width', `fit-frame-empty-height' (normal buffer)
* `fit-frame-empty-special-display-width',
`fit-frame-empty-special-display-height' (special-display buffer)"
(interactive
(let ((option (prefix-numeric-value current-prefix-arg)))
(list nil
;; Plain `C-u' means WIDTH, HEIGHT, and ALL-WINDOWS-P are all nil.
;; Non-negative prefix arg means prompt user for WIDTH and HEIGHT.
;; Negative prefix arg means use
;; `fill-column' + `fit-frame-fill-column-margin'
;; for WIDTH, and use current frame height for HEIGHT.
(and current-prefix-arg (atom current-prefix-arg)
(if (natnump option)
(floor (if (fboundp 'read-number)
(read-number "New width: ")
(string-to-number (read-string "New width: "))))
(+ fill-column fit-frame-fill-column-margin)))
(and current-prefix-arg (atom current-prefix-arg)
(if (natnump option)
(floor (if (fboundp 'read-number)
(read-number "New height: ")
(string-to-number (read-string "New height: "))))
(frame-height)))
(atom current-prefix-arg))))
(setq frame (or frame (selected-frame)))
(unless fit-frame-inhibit-fitting-flag
(let (extra-lines computed-max-frame-size empty-buf-p specbuf-p)
(save-window-excursion
(select-frame frame)
(setq empty-buf-p (and (= (point-min) (point-max))
(one-window-p (selected-window)))
specbuf-p (and empty-buf-p
(special-display-p (buffer-name (window-buffer))))))
;; `extra-lines' for minimum frame height. `set-frame-size' includes the
;; tool-bar and the minibuffer. For Emacs without a toolkit, the one-line
;; menu-bar is also included - add 1 line for that. Add 1 line for the
;; minibuffer, unless it is standalone. Perhaps we should also take into
;; account a possible horizontal scroll bar, but we don't do that.
(let* ((fparams (frame-parameters frame)))
(setq extra-lines (+ 2 ; Minimum is 1 for empty + 1 extra.
(or (cdr (assq 'tool-bar-lines fparams)) 0))) ; Tool bar.
(when (and (cdr (assq 'minibuffer fparams)) ; Frame has a minibuffer, but
(save-window-excursion (select-frame frame) ; it's not standalone.
(not (one-window-p nil 'selected-frame))))
(setq extra-lines (1+ extra-lines))))
(when (and (not (eq system-type 'windows-nt)) (not (featurep 'x-toolkit)))
(setq extra-lines (1+ extra-lines)))
(unless (or empty-buf-p (and width height))
(setq computed-max-frame-size (fit-frame-max-frame-size frame all-windows-p)))
(set-frame-size
;; Frame
frame
;; Columns
(or width
(and empty-buf-p (if specbuf-p
fit-frame-empty-special-display-width
fit-frame-empty-width))
(max fit-frame-min-width window-min-width
(min (or fit-frame-max-width (fit-frame-max-width frame))
(1+ (car computed-max-frame-size)))))
;; Rows
(or height
(and empty-buf-p (if specbuf-p
fit-frame-empty-special-display-height
fit-frame-empty-height))
(max fit-frame-min-height window-min-height
(min (or fit-frame-max-height (fit-frame-max-height frame))
(+ (cdr computed-max-frame-size) extra-lines))))))))
;;;###autoload
(defun fit-frame-or-mouse-drag-vertical-line (start-event)
"If only window in frame, `fit-frame'; else `mouse-drag-vertical-line'."
(interactive "e")
(if (one-window-p t) (fit-frame) (mouse-drag-vertical-line start-event)))
\f
;;; Non-Interactive Functions -------------------------------------------
(defun fit-frame-max-width (&optional frame)
"Returns the max width, in chars, for `fit-frame' to use for a new frame.
If option `fit-frame-max-width' is non-nil, then this is not used.
The value is relative to your display size and FRAME's character
size, and depends on the value of `fit-frame-max-width-percent':
(/ (* fit-frame-max-width-percent (x-display-pixel-width))
(* 100 (frame-char-width FRAME)))"
(setq frame (or frame (selected-frame)))
(/ (* fit-frame-max-width-percent
(if (fboundp 'winmgr-display-available-pixel-bounds) ; For MacIntosh.
(nth 2 (winmgr-display-available-pixel-bounds))
(x-display-pixel-width)))
(* 100 (frame-char-width frame))))
(defun fit-frame-max-height (&optional frame)
"Returns the max height, in lines, for `fit-frame' to use for a new frame.
If option `fit-frame-max-height' is non-nil, then this is not used.
The value is relative to your display size and FRAME's character
size, and depends on the value of `fit-frame-max-height-percent':
(/ (* fit-frame-max-height-percent (x-display-pixel-height))
(* 100 (frame-char-height FRAME)))"
(setq frame (or frame (selected-frame)))
(/ (* fit-frame-max-height-percent
(if (fboundp 'winmgr-display-available-pixel-bounds) ; For MacIntosh.
(nth 3 (winmgr-display-available-pixel-bounds))
(x-display-pixel-height)))
(* 100 (frame-char-height frame)
;; When fitting a thumbnail frame, we don't want the height to use the
;; whole display height. So, we apply a fudge factor:
;; `fit-frame-thumbnail-factor'. We could also use it in
;; `fit-frame-max-width', in addition to `fit-frame-max-height',
;; but we don't need to.
(fit-frame-thumbnail-factor frame))))
(defun fit-frame-max-frame-size (frame all-windows-p)
"Return maximum size of frame FRAME as a cons: (MAX-WIDTH . MAX-HEIGHT).
If ALL-WINDOWS-P is non-nil, then consider all buffers shown in FRAME.
Otherwise, consider only the selected buffer."
(save-window-excursion
(select-frame frame)
(if (not all-windows-p)
(fit-frame-max-window-size (selected-window))
(let* ((wins ())
(marked-wins ()) ; Windows whose size was already considered.
(max-width 0)
(max-height 0))
(walk-windows (lambda (w) (push w wins)) 'no-mini 'this-frame)
(setq wins (sort wins (lambda (w1 w2) ; Top to bottom, left to right.
(let ((edges1 (window-edges w1))
(edges2 (window-edges w2)))
(or (< (cadr edges1) (cadr edges2)) ; top
(and (= (cadr edges1) (cadr edges2))
(<= (car edges1) (car edges2)))))))) ; left
;; Iterate over all windows in frame.
;; For each, check all windows in the same row, and all in the same column.
;; When checking those in the same row:
;; 1. Increase MAX-HEIGHT to the max buffer height of the row windows.
;; 2. Increase MAX-WIDTH to the sum of the buffer widths of the row windows.
;; When checking those in the same column:
;; 1. Increase MAX-WIDTH to the max buffer width of the column windows.
;; 2. Increase MAX-HEIGHT to the sum of the buffer heights of the col windows.
;; After examining a window in the frame, exclude it from further examination
;; by adding it to MARKED-WINS.
(dolist (win wins)
(unless (memq win marked-wins)
(let* ((win-edges (window-edges win))
(win-top (cadr win-edges))
(win-left (car win-edges)))
;; Add widths of buffers in the same row. Max the heights of the buffers.
(dolist (row-win (fit-frame-same-row-windows wins win marked-wins))
;; Add ROW-WIN to exclusion list for subsequent iterations.
(setq marked-wins (cons row-win marked-wins))
(let* ((win-size (fit-frame-max-window-size row-win))
(max-win-width (car win-size))
(max-win-height (cdr win-size)))
(unless (> (cadr (window-edges row-win)) win-top) ; Use only first.
(setq max-width (+ max-width max-win-width)))
(setq max-height (max max-height max-win-height))))
;; Add heights of buffers in the same column. Max the buffer widths.
(dolist (col-win (fit-frame-same-column-windows wins win marked-wins))
;; Add COL-WIN to exclusion list for subsequent iterations.
(setq marked-wins (cons col-win marked-wins))
(let* ((win-size (fit-frame-max-window-size col-win))
(max-win-width (car win-size))
(max-win-height (cdr win-size)))
(unless (> (car (window-edges col-win)) win-left) ; Use only first.
(setq max-height (+ max-height max-win-height)))
(setq max-width (max max-width max-win-width)))))))
(cons max-width max-height)))))
(defun fit-frame-same-row-windows (wins window exclude)
"Returns the windows in WINS that are in the same row as window WINDOW.
This the list of windows in WINS whose top edge is above the bottom
edge of WINDOW.
Windows that are in list EXCLUDE are excluded from the result."
(let ((ref-bottom (cadddr (window-edges window)))
(row-wins ()))
(dolist (win wins)
(when (and (not (memq win exclude)) (< (cadr (window-edges win)) ref-bottom))
(push win row-wins)))
row-wins))
(defun fit-frame-same-column-windows (wins window exclude)
"Returns the windows in WINS that are in the same column as window WINDOW.
This the list of windows in WINS whose left edge is to the left of the
right edge of WINDOW.
Windows that are in list EXCLUDE are excluded from the result."
(let ((ref-right (caddr (window-edges window)))
(col-wins ()))
(dolist (win wins)
(when (and (not (memq win exclude)) (< (car (window-edges win)) ref-right))
(push win col-wins)))
col-wins))
(defun fit-frame-max-window-size (window)
"Maximum size that would be needed to display the buffer in WINDOW.
Returned as a cons: (MAX-WIDTH . MAX-HEIGHT), where:
MAX-WIDTH is the maximum width, in characters.
MAX-HEIGHT is the maximum height, in lines."
(select-window window)
(let ((hdr-lines (cdr (assq major-mode fit-frame-skip-header-lines-alist)))
(hdr-widths ())
(max-win-width 0)
(max-win-height 0))
(save-excursion
(set-buffer (window-buffer))
(goto-char (point-min))
;; Don't count header lines for width calculation.
(while (and hdr-lines (> hdr-lines 0))
(end-of-line)
(setq hdr-widths (cons (current-column) hdr-widths)
hdr-lines (1- hdr-lines))
(forward-line)
(setq max-win-height (1+ max-win-height)))
;; Calculate maximum line width and number of lines.
(while (not (eobp))
(end-of-line)
(setq max-win-width (max (current-column) max-win-width))
(forward-line 1)
(setq max-win-height (1+ max-win-height))))
;; Add height for any wrap-around header lines.
(while hdr-widths
(when (> (car hdr-widths) max-win-width)
(if (zerop max-win-width)
(setq max-win-height (1+ max-win-height))
(let ((nb-wraps (/ (car hdr-widths) max-win-width))
(remainder (% (car hdr-widths) max-win-width)))
(unless (zerop remainder) (setq nb-wraps (1+ nb-wraps)))
(setq max-win-height (+ max-win-height nb-wraps)))))
(setq hdr-widths (cdr hdr-widths)))
(cons max-win-width max-win-height)))
(defun fit-frame-thumbnail-factor (frame)
"Shrink factor for thumbnail frames. See `thumb-frm.el'.
FRAME is the frame to apply factor to."
(let ((char-height (frame-char-height frame)))
(if (and (fboundp 'thumbnail-frame-p) ; Defined in `thumb-frm.el'
(thumbnail-frame-p frame))
;; Need integer result for `set-frame-size'. 1+ because of integer round-off.
(1+ (/ (+ char-height frame-thumbnail-font-difference) char-height))
1)))
;;;;;;;;;;
(provide 'fit-frame)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; fit-frame.el ends here
^ permalink raw reply [flat|nested] 3+ messages in thread