Download
(require 'frame-cmds)
(eval-when-compile (require 'cl))
(defvar read-file-name-completion-ignore-case)
(defvar thumfr-thumbnail-frames nil
"An alist of frames currently displayed as thumbnails.
Each entry is of the form (FRAME . FRAME-PARAMETERS), which
records the `frame-parameters' of FRAME before it was turned into a
thumbnail.")
(defvar thumfr-non-thumbnail-frames nil
"An alist of frames currently not displayed as thumbnails.
Each entry is of the form (FRAME . FRAME-PARAMETERS), which
records the `frame-parameters' of FRAME when it was a thumbnail.")
(defvar thumfr-last-sort-function nil
"Last non-nil value for `thumfr-sort-function' during this session.")
(defvar thumfr-last-row-show 0.7
"Minimum amount showing of frames in last row (or column).
Set to 1.0 to see whole frames.
A smaller value uses display real estate better.")
(defvar thumfr-next-stack-xoffset nil
"X offset for position to stack next thumbnail frame.")
(defvar thumfr-next-stack-yoffset nil
"Y offset for position to stack next thumbnail frame.")
(defvar 1on1-minibuffer-frame nil)
(defgroup Thumbnail-Frames nil
"Commands for thumbnail frames"
:prefix "thumfr-" :group 'frames :group 'convenience
:link `(url-link :tag "Send Bug Report"
,(concat "mailto:" "drew.adams" "@" "oracle" ".com?subject=\
thumb-frm.el bug: \
&body=Describe bug here, starting with `emacs -q'. \
Don't forget to mention your Emacs and library versions."))
:link '(url-link :tag "Other Libraries by Drew"
"http://www.emacswiki.org/cgi-bin/wiki/DrewsElispLibraries")
:link '(url-link :tag "Download" "http://www.emacswiki.org/cgi-bin/wiki/thumb-frm.el")
:link '(url-link :tag "Description"
"http://www.emacswiki.org/cgi-bin/wiki/FisheyeWithThumbs")
:link '(emacs-commentary-link :tag "Commentary" "thumb-frm"))
(defcustom thumfr-font-difference 8
"*Number of points for `thumfr-thumbify-frame' to decrease frame font.
This must be less than the current font size, since the new font size
cannot be less than 1 point.
If you get the error \"New font size is too small\" when you try to
thumbify a frame, then decrease `thumfr-font-difference'.
Note that the option value can be a negative integer, in which case
thumbifying actually increases the font and frame size, instead of
decreasing them."
:type 'integer :group 'Thumbnail-Frames)
(defcustom thumfr-thumbify-dont-iconify-flag t
"*Non-nil means thumbify frames instead of iconifying them."
:type 'boolean :group 'Thumbnail-Frames)
(defcustom thumfr-rename-when-thumbify-flag t
"*Non-nil means frames are renamed when thumbified.
The new name is the name of the current buffer."
:type 'boolean :group 'Thumbnail-Frames)
(defcustom thumfr-stack-display-edge 'right+down
"*Display edge to stack thumbnail frames along.
Possible values are symbols named EDGE+DIRECTION,
where EDGE is one of `left', `right', `top', and `bottom',
and DIRECTION is one of `up', `down', `to-left', and `to-right'.
For example, value `right+down' means to arrange thumbnail frames
along the right edge from top to bottom."
:type
'(choice
(const
:tag "Arrange thumbnail frames along display left, downward" left+down)
(const
:tag "Arrange thumbnail frames along display left, upward" left+up)
(const
:tag "Arrange thumbnail frames along display right, downward" right+down)
(const
:tag "Arrange thumbnail frames along display right, upward" right+up)
(const
:tag "Arrange thumbnail frames along display top, toward the right" top+to-right)
(const
:tag "Arrange thumbnail frames along display top, toward the left" top+to-left)
(const
:tag "Arrange thumbnail frames along display bottom, toward the right" bottom+to-right)
(const
:tag "Arrange thumbnail frames along display bottom, toward the left" bottom+to-left))
:group 'Thumbnail-Frames)
(defcustom thumfr-frame-parameters
'((menu-bar-lines . 0) (tool-bar-lines . 0) (scroll-bar-width . 6))
"*Frame parameters of thumbnail frames.
Use this to show or hide things like the menu bar, tool bar, tab bar,
and scroll bars for thumbnail frames."
:type '(repeat (cons symbol sexp))
:group 'Thumbnail-Frames
:set (lambda (sym defs)
(custom-set-default sym defs)
(dolist (frm thumfr-thumbnail-frames)
(setq frm (car frm))
(when (frame-live-p frm) (modify-frame-parameters frm thumfr-frame-parameters)))))
(defcustom thumfr-sort-function 'thumfr-sort-by-name
"*Function to use for sorting the stacked thumbnail frames.
If nil, then no sorting is done.
Set this to `thumfr-sort-by-name' for alphabetical order.
The function should take two frame specifications as arguments, where
a frame spec has the form of an item in list
`thumfr-thumbnail-frames'. It should return non-nil if the frame of
the first spec comes before that of the second. See, for example,
`thumfr-sort-by-name' and `thumfr-sort-by-window-id'.
Use `thumfr-toggle-sort-thumbnail-frame-stack' to turn sorting on
and off."
:type '(choice (const :tag "No sorting" nil)
(const :tag "Sort by name" thumfr-sort-by-name)
(const :tag "Sort by name" thumfr-sort-by-window-id)
(function :tag "Another function"))
:group 'Thumbnail-Frames)
(unless (boundp 'window-mgr-title-bar-pixel-width)
(defcustom window-mgr-title-bar-pixel-width 30
"*Width of frame title bar provided by window manager, in pixels."
:type 'integer :group 'Thumbnail-Frames))
(defadvice iconify-frame (around thumbify-replace-iconify activate)
"Thumbify FRAME if `thumfr-thumbify-dont-iconify-flag'
To iconify a frame in spite of this flag, use
`\\[thumfr-really-iconify-frame]'."
(if thumfr-thumbify-dont-iconify-flag
(thumfr-thumbify-frame (ad-get-arg 0))
ad-do-it))
(defadvice iconify-or-deiconify-frame
(around thumbify-replace-iconify activate)
"Thumbify frame if `thumfr-thumbify-dont-iconify-flag'
To iconify selected frame in spite of this flag, use
`\\[thumfr-really-iconify-or-deiconify-frame]'."
(if thumfr-thumbify-dont-iconify-flag
(thumfr-toggle-thumbnail-frame)
ad-do-it))
(defun thumfr-thumbify-frame-upon-event (event)
"Thumbify frame upon event EVENT.
To make the window-manager \"minimize\" button thumbify instead, bind
\[iconify-frame] to this command, as follows:
(define-key special-event-map [iconify-frame]
'thumfr-thumbify-frame-upon-event)
That will effectively replace iconification by thumbification
everywhere, except for `thumfr-really-iconify-frame' and
`thumfr-really-iconify-or-deiconify-frame'."
(interactive "e")
(select-frame (posn-window (event-start event)))
(make-frame-visible)
(thumfr-toggle-thumbnail-frame))
(defun thumfr-really-iconify-frame (&optional frame)
"Iconify FRAME, even if `thumfr-thumbify-dont-iconify-flag' is non-nil."
(interactive)
(setq frame (or frame (selected-frame)))
(let ((thumfr-thumbify-dont-iconify-flag nil))
(iconify-frame frame)
(while (not (input-pending-p)) (sit-for 0))
(discard-input)))
(defun thumfr-really-iconify-or-deiconify-frame ()
"Iconify or deiconify frame, even if `thumfr-thumbify-dont-iconify-flag'
is non-nil."
(interactive)
(let ((thumfr-thumbify-dont-iconify-flag nil))
(iconify-or-deiconify-frame)
(while (not (input-pending-p)) (sit-for 0))
(discard-input)))
(defun thumfr-thumbify-frame (&optional frame)
"Create a thumbnail version of FRAME (default: selected frame).
Variable `thumfr-frame-parameters' is used to determine
which frame parameters (such as menu-bar) to remove."
(interactive)
(setq frame (or frame (selected-frame)))
(let* ((fr+tf-params (assoc frame thumfr-non-thumbnail-frames))
(tf-params (cdr fr+tf-params))
(non-tf-params (frame-parameters frame))
(fr+non-tf-params (cons frame non-tf-params)))
(when thumfr-rename-when-thumbify-flag (rename-non-minibuffer-frame))
(unless (assoc frame thumfr-thumbnail-frames)
(add-to-list 'thumfr-thumbnail-frames fr+non-tf-params)
(setq thumfr-non-thumbnail-frames (delq fr+tf-params thumfr-non-thumbnail-frames))
(condition-case thumfr-thumbify-frame
(progn
(enlarge-font (- thumfr-font-difference) frame)
(when tf-params (modify-frame-parameters frame tf-params))
(when thumfr-next-stack-xoffset
(set-frame-position frame thumfr-next-stack-xoffset
thumfr-next-stack-yoffset)
(setq thumfr-next-stack-xoffset nil
thumfr-next-stack-yoffset nil))
(modify-frame-parameters frame thumfr-frame-parameters))
(font-too-small
(when fr+tf-params (add-to-list 'thumfr-non-thumbnail-frames fr+tf-params))
(setq thumfr-thumbnail-frames (delq fr+non-tf-params thumfr-thumbnail-frames))
(unless (> thumfr-font-difference 0)
(error (error-message-string thumfr-thumbify-frame)))
(let ((thumfr-font-difference (1- thumfr-font-difference)))
(thumfr-thumbify-frame frame)))
(error
(when fr+tf-params (add-to-list 'thumfr-non-thumbnail-frames fr+tf-params))
(setq thumfr-thumbnail-frames (delq fr+non-tf-params thumfr-thumbnail-frames))
(error (error-message-string thumfr-thumbify-frame)))))))
(defun thumfr-dethumbify-frame (&optional frame)
"Restore thumbnail FRAME to original size (default: selected frame)."
(interactive)
(setq frame (or frame (selected-frame)))
(let* ((fr+non-tf-params (assoc frame thumfr-thumbnail-frames))
(non-tf-params (cdr fr+non-tf-params))
(tf-params (frame-parameters frame))
(fr+tf-params (cons frame tf-params)))
(when fr+non-tf-params
(add-to-list 'thumfr-non-thumbnail-frames fr+tf-params)
(setq thumfr-thumbnail-frames (delq fr+non-tf-params thumfr-thumbnail-frames))
(condition-case thumfr-dethumbify-frame
(progn
(enlarge-font thumfr-font-difference frame)
(modify-frame-parameters frame non-tf-params))
(error
(when fr+non-tf-params (add-to-list 'thumfr-thumbnail-frames fr+non-tf-params))
(setq thumfr-non-thumbnail-frames (delq fr+tf-params thumfr-non-thumbnail-frames))
(error (error-message-string thumfr-dethumbify-frame))))
(select-frame-set-input-focus frame)
(thumfr-only-raise-frame frame))))
(defsubst thumfr-thumbnail-frame-p (&optional frame)
"Return non-nil if FRAME is a thumbnail."
(interactive)
(assoc (or frame (selected-frame)) thumfr-thumbnail-frames))
(or (fboundp 'thumfr-only-raise-frame)
(fset 'thumfr-only-raise-frame (symbol-function 'raise-frame)))
(defun raise-frame (&optional frame)
"Bring FRAME to the front, so it occludes any frames it overlaps.
If FRAME is invisible, make it visible.
If FRAME is a thumbnail frame (see `thumb-frm.el'), dethumbify it also.
If you don't specify a frame, the selected frame is used.
If Emacs is displaying on an ordinary terminal or other device that
does not support multiple overlapping frames, then do nothing."
(unless frame (setq frame (selected-frame)))
(thumfr-only-raise-frame frame)
(thumfr-dethumbify-frame frame))
(defun thumfr-toggle-thumbnail-frame (&optional frame)
"If FRAME is a thumbnail, restore it
FRAME defaults to the selected frame."
(interactive)
(setq frame (or frame (selected-frame)))
(if (assoc frame thumfr-thumbnail-frames)
(thumfr-dethumbify-frame frame)
(thumfr-thumbify-frame frame)))
(defalias 'thumfr-fisheye 'thumfr-thumbify-other-frames)
(defun thumfr-thumbify-other-frames (&optional frame)
"Thumbify all visible non-minibuffer frames except FRAME.
Dethumbify FRAME, if it is a thumbnail frame.
FRAME is the selected frame, by default."
(interactive)
(setq frame (or frame (selected-frame)))
(thumfr-dethumbify-frame frame)
(let ((other-frames (visible-frame-list)))
(setq other-frames (delq frame other-frames))
(setq other-frames (delq 1on1-minibuffer-frame other-frames))
(dolist (fr (thumfr-nset-difference other-frames (mapcar 'car thumfr-thumbnail-frames)))
(thumfr-thumbify-frame fr))
(thumfr-stack-thumbnail-frames))
frame)
(defun thumfr-nset-difference (list1 list2 &optional key)
"Combine LIST1 and LIST2 using a set-difference operation.
The resulting list contains all items that appear in LIST1 but not LIST2.
This is a destructive function
whenever possible.
Optional arg KEY is a function used to extract the part of each list
element to compare."
(if (or (null list1) (null list2)) list1
(apply #'thumfr-set-difference list1 list2 key)))
(defun thumfr-set-difference (list1 list2 &optional key)
"Combine LIST1 and LIST2 using a set-difference operation.
Optional arg KEY is a function used to extract the part of each list
element to compare.
The result list contains all items that appear in LIST1 but not LIST2.
This is non-destructive
avoid corrupting the original LIST1 and LIST2."
(if (or (null list1) (null list2)) list1
(let ((keyed-list2 (and key (mapcar key list2)))
(result ()))
(while list1
(unless (if key
(member (funcall key (car list1)) keyed-list2)
(member (car list1) list2))
(setq result (cons (car list1) result)))
(setq list1 (cdr list1)))
result)))
(defun thumfr-fisheye-previous-frame ()
"Call `thumfr-fisheye' on the previous frame.
Thumbify all visible non-minibuffer frames except the previous frame.
Dethumbify the previous frame (if it is a thumbnail frame)."
(interactive)
(select-frame (thumfr-thumbify-other-frames (other-frame -1)))
(message "%s" (get-frame-name)))
(defun thumfr-fisheye-next-frame ()
"Call `thumfr-fisheye' on the next frame.
Thumbify all visible non-minibuffer frames except the next frame.
Dethumbify the next frame (if it is a thumbnail frame)."
(interactive)
(select-frame (thumfr-thumbify-other-frames (other-frame 1)))
(message "%s" (get-frame-name)))
(defun thumfr-dethumbify-all-frames (&optional iconified-also-p)
"Dethumbify all visible frames
restoring them to their states before they were thumbified.
With a prefix arg, restore also iconified frames, not just thumbified
frames."
(interactive "P")
(dolist (fr (mapcar 'car (thumfr-cull-thumbnail-frames iconified-also-p)))
(thumfr-dethumbify-frame fr))
(setq thumfr-thumbnail-frames ()))
(defun thumfr-stack-thumbnail-frames ()
"Stack thumbnail frames along edge of display
according to the direction of `thumfr-stack-display-edge'."
(interactive)
(let* ((display-width (x-display-pixel-width))
(display-height (if (boundp '1on1-minibuffer-frame)
(cdr (assq 'top (frame-parameters 1on1-minibuffer-frame)))
(x-display-pixel-height)))
(xstart (if (memq thumfr-stack-display-edge
'(right+down right+up top+to-left bottom+to-left))
display-width
0))
(ystart (if (memq thumfr-stack-display-edge
'(bottom+to-right bottom+to-left left+up right+up))
display-height
0))
(xoffset xstart)
(yoffset ystart)
(thumb-frs (copy-sequence (thumfr-cull-thumbnail-frames)))
last-fr)
(when thumfr-sort-function
(setq thumb-frs (sort thumb-frs thumfr-sort-function)))
(case thumfr-stack-display-edge
(left+down
(dolist (fr (mapcar 'car thumb-frs))
(set-frame-position fr xoffset yoffset)
(let ((next-position (thumfr-next-stack-position
yoffset ystart (- display-height
window-mgr-title-bar-pixel-width
)
#'+ (+ (frame-pixel-height fr)
window-mgr-title-bar-pixel-width) #'>
xoffset xstart (- display-width (frame-pixel-width fr))
#'+ (frame-pixel-width fr) #'>)))
(setq yoffset (cdr next-position)
xoffset (car next-position)))
(thumfr-only-raise-frame fr))
(when thumb-frs
(setq thumfr-next-stack-xoffset xoffset
thumfr-next-stack-yoffset yoffset)))
(left+up
(dolist (fr (mapcar 'car thumb-frs))
(setq last-fr fr)
(set-frame-position
fr
xoffset
(max 0 (- yoffset window-mgr-title-bar-pixel-width (frame-pixel-height fr))))
(let ((next-position (thumfr-next-stack-position
yoffset ystart (truncate (* (frame-pixel-height fr)
thumfr-last-row-show))
#'- (+ (frame-pixel-height fr)
window-mgr-title-bar-pixel-width) #'<
xoffset xstart (- display-width (frame-pixel-width fr))
#'+ (frame-pixel-width fr) #'>)))
(setq yoffset (cdr next-position)
xoffset (car next-position))))
(dolist (fr (mapcar 'car (nreverse thumb-frs)))
(thumfr-only-raise-frame fr))
(when thumb-frs
(setq thumfr-next-stack-xoffset xoffset
thumfr-next-stack-yoffset (max 0 (- yoffset window-mgr-title-bar-pixel-width
(frame-pixel-height last-fr))))))
(right+down
(dolist (fr (mapcar 'car thumb-frs))
(setq last-fr fr)
(set-frame-position fr (- xoffset (frame-pixel-width fr)) yoffset)
(let ((next-position (thumfr-next-stack-position
yoffset ystart (- display-height
window-mgr-title-bar-pixel-width
)
#'+ (+ (frame-pixel-height fr)
window-mgr-title-bar-pixel-width) #'>
xoffset xstart 0
#'- (frame-pixel-width fr) #'<)))
(setq yoffset (cdr next-position)
xoffset (car next-position)))
(thumfr-only-raise-frame fr))
(when thumb-frs
(setq thumfr-next-stack-xoffset (- xoffset (frame-pixel-width last-fr))
thumfr-next-stack-yoffset yoffset)))
(right+up
(dolist (fr (mapcar 'car thumb-frs))
(setq last-fr fr)
(set-frame-position
fr
(max 0 (- xoffset (frame-pixel-width fr)))
(max 0 (- yoffset window-mgr-title-bar-pixel-width (frame-pixel-height fr))))
(let ((next-position (thumfr-next-stack-position
yoffset ystart (truncate (* (frame-pixel-height fr)
thumfr-last-row-show))
#'- (+ (frame-pixel-height fr)
window-mgr-title-bar-pixel-width) #'<
xoffset xstart 0
#'- (frame-pixel-width fr) #'<)))
(setq yoffset (cdr next-position)
xoffset (car next-position))))
(dolist (fr (mapcar 'car (nreverse thumb-frs)))
(thumfr-only-raise-frame fr))
(when thumb-frs
(setq thumfr-next-stack-xoffset (max 0 (- xoffset (frame-pixel-width last-fr)))
thumfr-next-stack-yoffset (max 0 (- yoffset window-mgr-title-bar-pixel-width
(frame-pixel-height last-fr))))))
(top+to-right
(dolist (fr (mapcar 'car thumb-frs))
(set-frame-position fr xoffset yoffset)
(let ((next-position (thumfr-next-stack-position
xoffset xstart (- display-width (frame-pixel-width fr))
#'+ (frame-pixel-width fr) #'>
yoffset ystart (- display-height
window-mgr-title-bar-pixel-width
(frame-pixel-height fr))
#'+ (+ (frame-pixel-height fr)
window-mgr-title-bar-pixel-width) #'>)))
(setq yoffset (car next-position)
xoffset (cdr next-position)))
(thumfr-only-raise-frame fr))
(when thumb-frs
(setq thumfr-next-stack-xoffset xoffset
thumfr-next-stack-yoffset yoffset)))
(top+to-left
(dolist (fr (mapcar 'car thumb-frs))
(setq last-fr fr)
(set-frame-position fr (max 0 (- xoffset (frame-pixel-width fr))) yoffset)
(let ((next-position (thumfr-next-stack-position
xoffset xstart (truncate (* (frame-pixel-width fr)
thumfr-last-row-show))
#'- (frame-pixel-width fr) #'<
yoffset ystart (- display-height
window-mgr-title-bar-pixel-width
(frame-pixel-height fr))
#'+ (+ (frame-pixel-height fr)
window-mgr-title-bar-pixel-width) #'>)))
(setq yoffset (car next-position)
xoffset (cdr next-position)))
(thumfr-only-raise-frame fr))
(when thumb-frs
(setq thumfr-next-stack-xoffset (max 0 (- xoffset (frame-pixel-width last-fr)))
thumfr-next-stack-yoffset yoffset)))
(bottom+to-right
(dolist (fr (mapcar 'car thumb-frs))
(setq last-fr fr)
(set-frame-position
fr
xoffset
(max 0 (- yoffset window-mgr-title-bar-pixel-width (frame-pixel-height fr))))
(let ((next-position (thumfr-next-stack-position
xoffset xstart (- display-width (frame-pixel-width fr))
#'+ (frame-pixel-width fr) #'>
yoffset ystart (- display-height
window-mgr-title-bar-pixel-width
(frame-pixel-height fr))
#'- (+ (frame-pixel-height fr)
window-mgr-title-bar-pixel-width) #'<)))
(setq yoffset (car next-position)
xoffset (cdr next-position))))
(dolist (fr (mapcar 'car (nreverse thumb-frs)))
(thumfr-only-raise-frame fr))
(when thumb-frs
(setq thumfr-next-stack-xoffset xoffset
thumfr-next-stack-yoffset (max 0 (- yoffset window-mgr-title-bar-pixel-width
(frame-pixel-height last-fr))))))
(bottom+to-left
(dolist (fr (mapcar 'car thumb-frs))
(setq last-fr fr)
(set-frame-position
fr
(max 0 (- xoffset (frame-pixel-width fr)))
(max 0 (- yoffset window-mgr-title-bar-pixel-width (frame-pixel-height fr))))
(let ((next-position (thumfr-next-stack-position
xoffset xstart (* (truncate (frame-pixel-width fr)
thumfr-last-row-show))
#'- (frame-pixel-width fr) #'<
yoffset ystart (- display-height
window-mgr-title-bar-pixel-width
(frame-pixel-height fr))
#'- (+ (frame-pixel-height fr)
window-mgr-title-bar-pixel-width) #'<)))
(setq yoffset (car next-position)
xoffset (cdr next-position))))
(dolist (fr (mapcar 'car (nreverse thumb-frs)))
(thumfr-only-raise-frame fr))
(when thumb-frs
(setq thumfr-next-stack-xoffset (max 0 (- xoffset (frame-pixel-width last-fr)))
thumfr-next-stack-yoffset (max 0 (- yoffset window-mgr-title-bar-pixel-width
(frame-pixel-height last-fr)))))))))
(defun thumfr-next-stack-position
(major-position major-start major-limit major-+/- major-increment major-</>
minor-position minor-start minor-limit minor-+/- minor-increment minor-</>)
"Return new position for next-stacked frame.
MAJOR* are the settings for the major direction of movement (x or y).
MINOR* are the settings for the minor direction of movement (x or y).
New position is returned as a cons: (MINOR-POSITION . MAJOR-POSITION).
*-POSITION, as input, are the positions of the current frame.
*-START are the starting positions for the first row (or column).
*-LIMIT are the maximum positions on the display.
*-+/- are functions `+' or `-', used to increment or decrement.
*-</> are functions `<' or `>', used to compare."
(setq major-position (funcall major-+/- major-position major-increment))
(when (funcall major-</> major-position major-limit)
(setq major-position major-start
minor-position (funcall minor-+/- minor-position minor-increment))
(when (funcall minor-</> minor-position minor-limit)
(setq minor-position minor-start)))
(cons minor-position major-position))
(defun thumfr-toggle-sort-thumbnail-frame-stack (force-p)
"Toggle stacking thumbnail frames between sorting and not.
Non-nil prefix FORCE-P => Sort iff FORCE-P >= 0."
(interactive "P")
(cond (thumfr-sort-function
(setq thumfr-last-sort-function thumfr-sort-function)
(when (or (null force-p) (<= (prefix-numeric-value force-p) 0))
(setq thumfr-sort-function nil)))
((or (null force-p) (> (prefix-numeric-value force-p) 0))
(if thumfr-last-sort-function
(setq thumfr-sort-function thumfr-last-sort-function)
(error "You first need to set `thumfr-sort-function'"))))
(if thumfr-sort-function
(message "Stacking of thumbnail frames is now sorted using `%s'."
thumfr-sort-function)
(message "Stacking of thumbnail frames is longer sorted.")))
(defun thumfr-iconify-thumbnail-frames ()
"Iconify all thumbnail frames."
(interactive)
(let ((thumfr-thumbify-dont-iconify-flag nil))
(mapcar (lambda (fr-spec) (iconify-frame (car fr-spec)))
(thumfr-cull-thumbnail-frames))))
(defun thumfr-deiconify-thumbnail-frames ()
"Deiconify all thumbnail frames."
(interactive)
(mapcar (lambda (fr-spec) (make-frame-visible (car fr-spec)))
(thumfr-cull-thumbnail-frames 'KEEP-ICONIFIED)))
(defun thumfr-cull-thumbnail-frames (&optional keep-iconified-p)
"Remove iconified and useless frames from `thumfr-thumbnail-frames'.
This includes dead and invisible frames.
Non-nil optional arg KEEP-ICONIFIED-P means do not remove iconified
frames."
(setq thumfr-thumbnail-frames (thumfr-delete-if-not
(lambda (fr+params)
(and (frame-live-p (car fr+params))
(frame-visible-p (car fr+params))
(or keep-iconified-p
(eq t (frame-visible-p (car fr+params))))))
thumfr-thumbnail-frames)))
(defun thumfr-delete-if-not (predicate list)
"Remove all occurrences of ITEM in LIST that do not satisfy PREDICATE.
This is a destructive function: It reuses the storage of LIST whenever
possible."
(while (and list (not (funcall predicate (car list))))
(setq list (cdr list)))
(let ((cl-p list))
(while (cdr cl-p)
(if (not (funcall predicate (cadr cl-p)))
(setcdr cl-p (cddr cl-p))
(setq cl-p (cdr cl-p)))))
list)
(defun thumfr-doremi-thumbnail-frames+ ()
"Successively cycle through frames with `thumfr-fisheye'."
(interactive)
(unless (require 'doremi-frm nil t)
(error "You need library `doremi-frm.el' to use this command"))
(let ((other-frames (visible-frame-list)))
(setq other-frames (delq 1on1-minibuffer-frame other-frames))
(doremi (lambda (fr) (thumfr-thumbify-other-frames fr) fr)
(selected-frame)
nil
nil
other-frames)))
(defun thumfr-sort-by-name (framespec1 framespec2)
"Alphabetical comparison of names of frames in argument frame specs.
FRAMESPEC1 and FRAMESPEC2 are the frame specs.
Return non-nil if name of first frame comes before that of second.
However, if the frame names name buffers visiting files, then compare
the names respecting `read-file-name-completion-ignore-case'."
(let ((fname1 (cdr (assq 'name (cdr framespec1))))
(fname2 (cdr (assq 'name (cdr framespec2)))))
(if (or (not (boundp 'read-file-name-completion-ignore-case))
(not read-file-name-completion-ignore-case))
(string-lessp fname1 fname2)
(let* ((buf1 (get-buffer fname1))
(bufname1 (and buf1 (buffer-file-name buf1)))
(file1 (and bufname1 (upcase bufname1)))
(buf2 (get-buffer fname2))
(bufname2 (and buf2 (buffer-file-name buf2)))
(file2 (and bufname2 (upcase bufname2))))
(if (and file1 file2)
(string-lessp file1 file2)
(string-lessp fname1 fname2))))))
(defun thumfr-sort-by-window-id (framespec1 framespec2)
"Comparison of `window-id' parameters in argument frame specs.
FRAMESPEC1 and FRAMESPEC2 are the frame specs.
Return non-nil if `window-id' parameter of first frame comes before
that of second. The `window-id' can be used as a substitute for time
of window creation."
(string-lessp (cdr (assq 'window-id (cdr framespec1)))
(cdr (assq 'window-id (cdr framespec2)))))
(provide 'thumb-frm)