;;; popwin.el --- Popup Window Manager.
|
|
;; Copyright (C) 2011-2015 Tomohiro Matsuyama
|
|
;; Author: Tomohiro Matsuyama <m2ym.pub@gmail.com>
|
;; Keywords: convenience
|
;; Package-Version: 20150315.1300
|
;; Version: 1.0.0
|
|
;; 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 of the License, 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. If not, see <http://www.gnu.org/licenses/>.
|
|
;;; Commentary:
|
|
;; Popwin makes you free from the hell of annoying buffers such like
|
;; *Help*, *Completions*, *compilation*, and etc.
|
;;
|
;; To use popwin, just add the following code into your .emacs:
|
;;
|
;; (require 'popwin)
|
;; (popwin-mode 1)
|
;;
|
;; Then try to show some buffer, for example *Help* or
|
;; *Completeions*. Unlike standard behavior, their buffers may be
|
;; shown in a popup window at the bottom of the frame. And you can
|
;; close the popup window seamlessly by typing C-g or selecting other
|
;; windows.
|
;;
|
;; `popwin:display-buffer' displays special buffers in a popup window
|
;; and displays normal buffers as unsual. Special buffers are
|
;; specified in `popwin:special-display-config', which tells popwin
|
;; how to display such buffers. See docstring of
|
;; `popwin:special-display-config' for more information.
|
;;
|
;; The default width/height/position of popup window can be changed by
|
;; setting `popwin:popup-window-width', `popwin:popup-window-height',
|
;; and `popwin:popup-window-position'. You can also change the
|
;; behavior for a specific buffer. See docstring of
|
;; `popwin:special-display-config'.
|
;;
|
;; If you want to use some useful commands such like
|
;; `popwin:popup-buffer' and `popwin:find-file' easily. you may bind
|
;; `popwin:keymap' to `C-z', for example, like:
|
;;
|
;; (global-set-key (kbd "C-z") popwin:keymap)
|
;;
|
;; See also `popwin:keymap' documentation.
|
;;
|
;; Enjoy!
|
|
;;; Code:
|
|
(eval-when-compile (require 'cl))
|
|
(defconst popwin:version "1.0.0")
|
|
|
|
;;; Utility
|
|
(defun popwin:listify (object)
|
"Return a singleton list of OBJECT if OBJECT is an atom,
|
otherwise OBJECT itself."
|
(if (atom object) (list object) object))
|
|
(defun popwin:subsitute-in-tree (map tree)
|
(if (consp tree)
|
(cons (popwin:subsitute-in-tree map (car tree))
|
(popwin:subsitute-in-tree map (cdr tree)))
|
(or (cdr (assq tree map)) tree)))
|
|
(defun popwin:get-buffer (buffer-or-name &optional if-not-found)
|
"Return a buffer named BUFFER-OR-NAME or BUFFER-OR-NAME itself
|
if BUFFER-OR-NAME is a buffer. If BUFFER-OR-NAME is a string and
|
such a buffer named BUFFER-OR-NAME not found, a new buffer will
|
be returned when IF-NOT-FOUND is :create, or an error reported
|
when IF-NOT-FOUND is :error. The default of value of IF-NOT-FOUND
|
is :error."
|
(ecase (or if-not-found :error)
|
(:create
|
(get-buffer-create buffer-or-name))
|
(:error
|
(or (get-buffer buffer-or-name)
|
(error "No buffer named %s" buffer-or-name)))))
|
|
(defun popwin:switch-to-buffer (buffer-or-name &optional norecord)
|
"Call `switch-to-buffer' forcing BUFFER-OF-NAME be displayed in
|
the selected window."
|
(with-no-warnings
|
(if (>= emacs-major-version 24)
|
(switch-to-buffer buffer-or-name norecord t)
|
(switch-to-buffer buffer-or-name norecord))))
|
|
(defun popwin:select-window (window &optional norecord)
|
"Call `select-window' with saving the current buffer."
|
(save-current-buffer
|
(select-window window norecord)))
|
|
(defun popwin:buried-buffer-p (buffer)
|
"Return t if BUFFER might be thought of as a buried buffer."
|
(eq (car (last (buffer-list))) buffer))
|
|
(defun popwin:window-point (window)
|
"Return window-point of WINDOW. If WINDOW is currently
|
selected, then return buffer-point instead."
|
(if (eq (selected-window) window)
|
(with-current-buffer (window-buffer window)
|
(point))
|
(window-point window)))
|
|
(defun popwin:window-deletable-p (window)
|
"Return t if WINDOW is deletable, meaning that WINDOW is alive
|
and not a minibuffer's window, plus there is two or more windows."
|
(and (window-live-p window)
|
(not (window-minibuffer-p window))
|
(not (one-window-p))))
|
|
(defmacro popwin:save-selected-window (&rest body)
|
"Evaluate BODY saving the selected window."
|
`(with-selected-window (selected-window) ,@body))
|
|
(defun popwin:minibuffer-window-selected-p ()
|
"Return t if minibuffer window is selected."
|
(minibuffer-window-active-p (selected-window)))
|
|
(defun popwin:last-selected-window ()
|
"Return currently selected window or lastly selected window if
|
minibuffer window is selected."
|
(if (popwin:minibuffer-window-selected-p)
|
(minibuffer-selected-window)
|
(selected-window)))
|
|
|
|
;;; Common
|
|
(defvar popwin:debug nil)
|
|
(defvar popwin:dummy-buffer nil)
|
|
(defun popwin:dummy-buffer ()
|
(if (buffer-live-p popwin:dummy-buffer)
|
popwin:dummy-buffer
|
(setq popwin:dummy-buffer (get-buffer-create " *popwin-dummy*"))))
|
|
(defun popwin:kill-dummy-buffer ()
|
(when (buffer-live-p popwin:dummy-buffer)
|
(kill-buffer popwin:dummy-buffer))
|
(setq popwin:dummy-buffer nil))
|
|
(defun popwin:window-trailing-edge-adjustable-p (window)
|
"Return t if a trailing edge of WINDOW is adjustable."
|
(let ((next-window (next-window window)))
|
(and (not (eq next-window (frame-first-window)))
|
(not (eq (window-buffer next-window)
|
(popwin:dummy-buffer))))))
|
|
(defun* popwin:adjust-window-edges (window
|
edges
|
&optional
|
(hfactor 1)
|
(vfactor 1))
|
"Adjust edges of WINDOW to EDGES accoring to horizontal factor
|
HFACTOR, and vertical factor VFACTOR."
|
(when (popwin:window-trailing-edge-adjustable-p window)
|
(destructuring-bind ((left top right bottom)
|
(cur-left cur-top cur-right cur-bottom))
|
(list edges (window-edges window))
|
(let ((hdelta (floor (- (* (- right left) hfactor) (- cur-right cur-left))))
|
(vdelta (floor (- (* (- bottom top) vfactor) (- cur-bottom cur-top)))))
|
(ignore-errors
|
(adjust-window-trailing-edge window hdelta t))
|
(ignore-errors
|
(adjust-window-trailing-edge window vdelta nil))))))
|
|
(defun popwin:window-config-tree-1 (node)
|
(if (windowp node)
|
(list 'window
|
node
|
(window-buffer node)
|
(popwin:window-point node)
|
(window-start node)
|
(window-edges node)
|
(eq (selected-window) node)
|
(window-dedicated-p node))
|
(destructuring-bind (dir edges . windows) node
|
(append (list dir edges)
|
(loop for window in windows
|
unless (and (windowp window)
|
(window-parameter window 'window-side))
|
collect (popwin:window-config-tree-1 window))))))
|
|
(defun popwin:window-config-tree ()
|
"Return `window-tree' with replacing window values in the tree
|
with persistent representations."
|
(destructuring-bind (root mini)
|
(window-tree)
|
(list (popwin:window-config-tree-1 root) mini)))
|
|
(defun popwin:replicate-window-config (window node hfactor vfactor)
|
"Replicate NODE of window configuration on WINDOW with
|
horizontal factor HFACTOR, and vertical factor VFACTOR. The
|
return value is a association list of mapping from old-window to
|
new-window."
|
(if (eq (car node) 'window)
|
(destructuring-bind (old-win buffer point start edges selected dedicated)
|
(cdr node)
|
(set-window-dedicated-p window nil)
|
(popwin:adjust-window-edges window edges hfactor vfactor)
|
(with-selected-window window
|
(popwin:switch-to-buffer buffer t))
|
(when selected
|
(popwin:select-window window))
|
(set-window-point window point)
|
(set-window-start window start t)
|
(when dedicated
|
(set-window-dedicated-p window t))
|
`((,old-win . ,window)))
|
(destructuring-bind (dir edges . windows) node
|
(loop while windows
|
for sub-node = (pop windows)
|
for win = window then next-win
|
for next-win = (and windows (split-window win nil (not dir)))
|
append (popwin:replicate-window-config win sub-node hfactor vfactor)))))
|
|
(defun popwin:restore-window-outline (node outline)
|
"Restore window outline accoding to the structures of NODE
|
which is a node of `window-tree' and OUTLINE which is a node of
|
`popwin:window-config-tree'."
|
(cond
|
((and (windowp node)
|
(eq (car outline) 'window))
|
;; same window
|
(destructuring-bind (old-win buffer point start edges selected dedicated)
|
(cdr outline)
|
(popwin:adjust-window-edges node edges)
|
(when (and (eq (window-buffer node) buffer)
|
(eq (popwin:window-point node) point))
|
(set-window-start node start))))
|
((or (windowp node)
|
(not (eq (car node) (car outline))))
|
;; different structure
|
;; nothing to do
|
)
|
(t
|
(let ((child-nodes (cddr node))
|
(child-outlines (cddr outline)))
|
(when (eq (length child-nodes) (length child-outlines))
|
;; same structure
|
(loop for child-node in child-nodes
|
for child-outline in child-outlines
|
do (popwin:restore-window-outline child-node child-outline)))))))
|
|
(defun popwin:position-horizontal-p (position)
|
"Return t if POSITION is hozirontal."
|
(and (memq position '(left :left right :right)) t))
|
|
(defun popwin:position-vertical-p (position)
|
"Return t if POSITION is vertical."
|
(and (memq position '(top :top bottom :bottom)) t))
|
|
(defun popwin:create-popup-window-1 (window size position)
|
"Create a new window with SIZE at POSITION of WINDOW. The
|
return value is a list of a master window and the popup window."
|
(let ((width (window-width window))
|
(height (window-height window)))
|
(ecase position
|
((left :left)
|
(list (split-window window size t)
|
window))
|
((top :top)
|
(list (split-window window size nil)
|
window))
|
((right :right)
|
(list window
|
(split-window window (- width size) t)))
|
((bottom :bottom)
|
(list window
|
(split-window window (- height size) nil))))))
|
|
(defun* popwin:create-popup-window (&optional (size 15) (position 'bottom) (adjust t))
|
"Create a popup window with SIZE on the frame. If SIZE
|
is integer, the size of the popup window will be SIZE. If SIZE is
|
float, the size of popup window will be a multiplier of SIZE and
|
frame-size. can be an integer and a float. If ADJUST is t, all of
|
windows will be adjusted to fit the frame. POSITION must be one
|
of (left top right bottom). The return value is a pair of a
|
master window and the popup window. To close the popup window
|
properly, get `current-window-configuration' before calling this
|
function, and call `set-window-configuration' with the
|
window-configuration."
|
(let* ((root (car (popwin:window-config-tree)))
|
(root-win (popwin:last-selected-window))
|
(hfactor 1)
|
(vfactor 1))
|
(popwin:save-selected-window
|
(delete-other-windows root-win))
|
(let ((root-width (window-width root-win))
|
(root-height (window-height root-win)))
|
(when adjust
|
(if (floatp size)
|
(if (popwin:position-horizontal-p position)
|
(setq hfactor (- 1.0 size)
|
size (round (* root-width size)))
|
(setq vfactor (- 1.0 size)
|
size (round (* root-height size))))
|
(if (popwin:position-horizontal-p position)
|
(setq hfactor (/ (float (- root-width size)) root-width))
|
(setq vfactor (/ (float (- root-height size)) root-height)))))
|
(destructuring-bind (master-win popup-win)
|
(popwin:create-popup-window-1 root-win size position)
|
;; Mark popup-win being a popup window.
|
(with-selected-window popup-win
|
(popwin:switch-to-buffer (popwin:dummy-buffer) t))
|
(let ((win-map (popwin:replicate-window-config master-win root hfactor vfactor)))
|
(list master-win popup-win win-map))))))
|
|
|
|
;;; Common User Interface
|
|
(defgroup popwin nil
|
"Popup Window Manager."
|
:group 'convenience
|
:prefix "popwin:")
|
|
(defcustom popwin:popup-window-position 'bottom
|
"Default popup window position. This must be one of (left top right
|
bottom)."
|
:type 'symbol
|
:group 'popwin)
|
|
(defcustom popwin:popup-window-width 30
|
"Default popup window width. If `popwin:popup-window-position'
|
is top or bottom, this configuration will be ignored. If this
|
variable is float, the popup window width will be a multiplier of
|
the value and frame-size."
|
:type 'number
|
:group 'popwin)
|
|
(defcustom popwin:popup-window-height 15
|
"Default popup window height. If `popwin:popup-window-position'
|
is left or right, this configuration will be ignored. If this
|
variable is float, the popup window height will be a multiplier
|
of the value and frame-size."
|
:type 'number
|
:group 'popwin)
|
|
(defcustom popwin:reuse-window 'current
|
"Non-nil means `popwin:display-buffer' will not popup the
|
visible buffer. The value is same as a second argument of
|
`get-buffer-window', except `current' means the selected frame."
|
:group 'popwin)
|
|
(defcustom popwin:adjust-other-windows t
|
"Non-nil means all of other windows will be adjusted to fit the
|
frame when a popup window is shown."
|
:type 'boolean
|
:group 'popwin)
|
|
(defvar popwin:context-stack nil)
|
|
(defvar popwin:popup-window nil
|
"Main popup window instance.")
|
|
(defvar popwin:popup-buffer nil
|
"Buffer of currently shown in the popup window.")
|
|
(defvar popwin:popup-last-config nil
|
"Arguments to `popwin:popup-buffer' of last call.")
|
|
;; Deprecated
|
(defvar popwin:master-window nil
|
"Master window of a popup window.")
|
|
(defvar popwin:focus-window nil
|
"Focused window which is used to check whether or not to close
|
the popup window.")
|
|
(defvar popwin:selected-window nil
|
"Last selected window when the popup window is shown.")
|
|
(defvar popwin:popup-window-dedicated-p nil
|
"Non-nil means the popup window is dedicated to the original
|
popup buffer.")
|
|
(defvar popwin:popup-window-stuck-p nil
|
"Non-nil means the popup window has been stuck.")
|
|
(defvar popwin:window-outline nil
|
"Original window outline which is obtained by
|
`popwin:window-config-tree'.")
|
|
(defvar popwin:window-map nil
|
"Mapping from old windows to new windows.")
|
|
(defvar popwin:window-config nil
|
"An original window configuration for restoreing.")
|
|
(defvar popwin:close-popup-window-timer nil
|
"Timer of closing the popup window.")
|
|
(defvar popwin:close-popup-window-timer-interval 0.05
|
"Interval of `popwin:close-popup-window-timer'.")
|
|
(defvar popwin:before-popup-hook nil)
|
|
(defvar popwin:after-popup-hook nil)
|
|
(symbol-macrolet ((context-vars '(popwin:popup-window
|
popwin:popup-buffer
|
popwin:master-window
|
popwin:focus-window
|
popwin:selected-window
|
popwin:popup-window-dedicated-p
|
popwin:popup-window-stuck-p
|
popwin:window-outline
|
popwin:window-map)))
|
(defun popwin:valid-context-p (context)
|
(window-live-p (plist-get context 'popwin:popup-window)))
|
|
(defun popwin:current-context ()
|
(loop for var in context-vars
|
collect var
|
collect (symbol-value var)))
|
|
(defun popwin:use-context (context)
|
(loop for var = (pop context)
|
for val = (pop context)
|
while var
|
do (set var val)))
|
|
(defun popwin:push-context ()
|
(push (popwin:current-context) popwin:context-stack))
|
|
(defun popwin:pop-context ()
|
(popwin:use-context (pop popwin:context-stack)))
|
|
(defun* popwin:find-context-for-buffer (buffer &key valid-only)
|
(loop with stack = popwin:context-stack
|
for context = (pop stack)
|
while context
|
if (and (eq buffer (plist-get context 'popwin:popup-buffer))
|
(or (not valid-only)
|
(popwin:valid-context-p context)))
|
return (list context stack))))
|
|
(defun popwin:popup-window-live-p ()
|
"Return t if `popwin:popup-window' is alive."
|
(window-live-p popwin:popup-window))
|
|
(defun* popwin:update-window-reference (symbol
|
&key
|
(map popwin:window-map)
|
safe
|
recursive)
|
(unless (and safe (not (boundp symbol)))
|
(let ((value (symbol-value symbol)))
|
(set symbol
|
(if recursive
|
(popwin:subsitute-in-tree map value)
|
(or (cdr (assq value map)) value))))))
|
|
(defun popwin:start-close-popup-window-timer ()
|
(or popwin:close-popup-window-timer
|
(setq popwin:close-popup-window-timer
|
(run-with-idle-timer popwin:close-popup-window-timer-interval
|
popwin:close-popup-window-timer-interval
|
'popwin:close-popup-window-timer))))
|
|
(defun popwin:stop-close-popup-window-timer ()
|
(when popwin:close-popup-window-timer
|
(cancel-timer popwin:close-popup-window-timer)
|
(setq popwin:close-popup-window-timer nil)))
|
|
(defun popwin:close-popup-window-timer ()
|
(condition-case var
|
(popwin:close-popup-window-if-necessary)
|
(error
|
(message "popwin:close-popup-window-timer: error: %s" var)
|
(when popwin:debug (backtrace)))))
|
|
(defun popwin:close-popup-window (&optional keep-selected)
|
"Close the popup window and restore to the previous window
|
configuration. If KEEP-SELECTED is non-nil, the lastly selected
|
window will not be selected."
|
(interactive)
|
(when popwin:popup-window
|
(unwind-protect
|
(progn
|
(when (popwin:window-deletable-p popwin:popup-window)
|
(delete-window popwin:popup-window))
|
(popwin:restore-window-outline (car (window-tree)) popwin:window-outline)
|
;; Call `redisplay' here so `window-start' could be set
|
;; prior to the point change of the master buffer.
|
(redisplay)
|
(when (and (not keep-selected)
|
(window-live-p popwin:selected-window))
|
(select-window popwin:selected-window)))
|
(popwin:pop-context)
|
;; Cleanup if no context left.
|
(when (null popwin:context-stack)
|
(popwin:kill-dummy-buffer)
|
(popwin:stop-close-popup-window-timer)))))
|
|
(defun popwin:close-popup-window-if-necessary ()
|
"Close the popup window if necessary. The all situations where
|
the popup window will be closed are followings:
|
|
* `C-g' has been pressed.
|
* The popup buffer has been killed.
|
* The popup buffer has been buried.
|
* The popup buffer has been changed if the popup window is
|
dedicated to the buffer.
|
* Another window has been selected."
|
(when popwin:popup-window
|
(let* ((window (selected-window))
|
(window-point (popwin:window-point window))
|
(window-buffer (window-buffer window))
|
(minibuf-window-p (window-minibuffer-p window))
|
(reading-from-minibuf
|
(and minibuf-window-p
|
(minibuffer-prompt)
|
t))
|
(quit-requested
|
(and (eq last-command 'keyboard-quit)
|
(eq last-command-event ?\C-g)))
|
(other-window-selected
|
(and (not (eq window popwin:focus-window))
|
(not (eq window popwin:popup-window))))
|
(orig-this-command this-command)
|
(popup-buffer-alive
|
(buffer-live-p popwin:popup-buffer))
|
(popup-buffer-buried
|
(popwin:buried-buffer-p popwin:popup-buffer))
|
(popup-buffer-changed-despite-of-dedicated
|
(and popwin:popup-window-dedicated-p
|
(not popwin:popup-window-stuck-p)
|
(or (not other-window-selected)
|
(not reading-from-minibuf))
|
(buffer-live-p window-buffer)
|
(not (eq popwin:popup-buffer window-buffer))))
|
(popup-window-alive (popwin:popup-window-live-p)))
|
(when (or quit-requested
|
(not popup-buffer-alive)
|
popup-buffer-buried
|
popup-buffer-changed-despite-of-dedicated
|
(not popup-window-alive)
|
(and other-window-selected
|
(not minibuf-window-p)
|
(not popwin:popup-window-stuck-p)))
|
(when popwin:debug
|
(message (concat "popwin: CLOSE:\n"
|
" quit-requested = %s\n"
|
" popup-buffer-alive = %s\n"
|
" popup-buffer-buried = %s\n"
|
" popup-buffer-changed-despite-of-dedicated = %s\n"
|
" popup-window-alive = %s\n"
|
" (selected-window) = %s\n"
|
" popwin:focus-window = %s\n"
|
" popwin:popup-window = %s\n"
|
" other-window-selected = %s\n"
|
" minibuf-window-p = %s\n"
|
" popwin:popup-window-stuck-p = %s")
|
quit-requested
|
popup-buffer-alive
|
popup-buffer-buried
|
popup-buffer-changed-despite-of-dedicated
|
popup-window-alive
|
window
|
popwin:focus-window
|
popwin:popup-window
|
other-window-selected
|
minibuf-window-p
|
popwin:popup-window-stuck-p))
|
(when (and quit-requested
|
(null orig-this-command))
|
(setq this-command 'popwin:close-popup-window)
|
(run-hooks 'pre-command-hook))
|
(cond
|
((and quit-requested
|
(null orig-this-command)
|
popwin:window-config)
|
(set-window-configuration popwin:window-config)
|
(setq popwin:window-config nil))
|
(reading-from-minibuf
|
(popwin:close-popup-window)
|
(select-window (minibuffer-window)))
|
(t
|
(popwin:close-popup-window
|
(and other-window-selected
|
(and popup-buffer-alive
|
(not popup-buffer-buried))))
|
(when popup-buffer-changed-despite-of-dedicated
|
(popwin:switch-to-buffer window-buffer)
|
(goto-char window-point))))
|
(when (and quit-requested
|
(null orig-this-command))
|
(run-hooks 'post-command-hook)
|
(setq last-command 'popwin:close-popup-window))))))
|
|
;;;###autoload
|
(defun* popwin:popup-buffer (buffer
|
&key
|
(width popwin:popup-window-width)
|
(height popwin:popup-window-height)
|
(position popwin:popup-window-position)
|
noselect
|
dedicated
|
stick
|
tail)
|
"Show BUFFER in a popup window and return the popup window. If
|
NOSELECT is non-nil, the popup window will not be selected. If
|
STICK is non-nil, the popup window will be stuck. If TAIL is
|
non-nil, the popup window will show the last contents. Calling
|
`popwin:popup-buffer' during `popwin:popup-buffer' is allowed. In
|
that case, the buffer of the popup window will be replaced with
|
BUFFER."
|
(interactive "BPopup buffer:\n")
|
(setq buffer (get-buffer buffer))
|
(popwin:push-context)
|
(run-hooks 'popwin:before-popup-hook)
|
(multiple-value-bind (context context-stack)
|
(popwin:find-context-for-buffer buffer :valid-only t)
|
(if context
|
(progn
|
(popwin:use-context context)
|
(setq popwin:context-stack context-stack))
|
(let ((win-outline (car (popwin:window-config-tree))))
|
(destructuring-bind (master-win popup-win win-map)
|
(let ((size (if (popwin:position-horizontal-p position) width height))
|
(adjust popwin:adjust-other-windows))
|
(popwin:create-popup-window size position adjust))
|
(setq popwin:popup-window popup-win
|
popwin:master-window master-win
|
popwin:window-outline win-outline
|
popwin:window-map win-map
|
popwin:window-config nil
|
popwin:selected-window (selected-window)))
|
(popwin:update-window-reference 'popwin:context-stack :recursive t)
|
(popwin:start-close-popup-window-timer))
|
(with-selected-window popwin:popup-window
|
(popwin:switch-to-buffer buffer)
|
(when tail
|
(set-window-point popwin:popup-window (point-max))
|
(recenter -2)))
|
(setq popwin:popup-buffer buffer
|
popwin:popup-last-config (list buffer
|
:width width :height height :position position
|
:noselect noselect :dedicated dedicated
|
:stick stick :tail tail)
|
popwin:popup-window-dedicated-p dedicated
|
popwin:popup-window-stuck-p stick)))
|
(if noselect
|
(setq popwin:focus-window popwin:selected-window)
|
(setq popwin:focus-window popwin:popup-window)
|
(select-window popwin:popup-window))
|
(run-hooks 'popwin:after-popup-hook)
|
popwin:popup-window)
|
|
(defun popwin:popup-last-buffer (&optional noselect)
|
"Show the last popup buffer with the same configuration. If
|
NOSELECT is non-nil, the popup window will not be selected."
|
(interactive "P")
|
(if popwin:popup-last-config
|
(if noselect
|
(destructuring-bind (buffer . keyargs) popwin:popup-last-config
|
(apply 'popwin:popup-buffer buffer :noselect t keyargs))
|
(apply 'popwin:popup-buffer popwin:popup-last-config))
|
(error "No popup buffer ever")))
|
(defalias 'popwin:display-last-buffer 'popwin:popup-last-buffer)
|
|
(defun popwin:select-popup-window ()
|
"Select the currently shown popup window."
|
(interactive)
|
(if (popwin:popup-window-live-p)
|
(select-window popwin:popup-window)
|
(error "No popup window displayed")))
|
|
(defun popwin:stick-popup-window ()
|
"Stick the currently shown popup window. The popup window can
|
be closed by `popwin:close-popup-window'."
|
(interactive)
|
(if (popwin:popup-window-live-p)
|
(progn
|
(setq popwin:popup-window-stuck-p t)
|
(message "Popup window stuck"))
|
(error "No popup window displayed")))
|
|
|
|
;;; Special Display
|
|
(defmacro popwin:without-special-displaying (&rest body)
|
"Evaluate BODY without special displaying."
|
(if (boundp 'display-buffer-alist)
|
`(with-no-warnings
|
(let ((display-buffer-function nil)
|
(display-buffer-alist
|
(remove '(popwin:display-buffer-condition
|
popwin:display-buffer-action)
|
display-buffer-alist)))
|
,@body))
|
`(with-no-warnings (let ((display-buffer-function nil)) ,@body))))
|
|
(defcustom popwin:special-display-config
|
'(;; Emacs
|
("*Miniedit Help*" :noselect t)
|
help-mode
|
(completion-list-mode :noselect t)
|
(compilation-mode :noselect t)
|
(grep-mode :noselect t)
|
(occur-mode :noselect t)
|
("*Pp Macroexpand Output*" :noselect t)
|
"*Shell Command Output*"
|
;; VC
|
"*vc-diff*"
|
"*vc-change-log*"
|
;; Undo-Tree
|
(" *undo-tree*" :width 60 :position right)
|
;; Anything
|
("^\\*anything.*\\*$" :regexp t)
|
;; SLIME
|
"*slime-apropos*"
|
"*slime-macroexpansion*"
|
"*slime-description*"
|
("*slime-compilation*" :noselect t)
|
"*slime-xref*"
|
(sldb-mode :stick t)
|
slime-repl-mode
|
slime-connection-list-mode)
|
"Configuration of special displaying buffer for
|
`popwin:display-buffer' and
|
`popwin:special-display-popup-window'. The value is a list of
|
CONFIG as a form of (PATTERN . KEYWORDS) where PATTERN is a
|
pattern of specifying buffer and KEYWORDS is a list of a pair of
|
key and value. PATTERN is in general a buffer name, a symbol
|
specifying major-mode of buffer, or a predicate function which
|
takes one argument: the buffer. If CONFIG is a string or a
|
symbol, PATTERN will be CONFIG and KEYWORDS will be
|
empty. Available keywords are following:
|
|
regexp: If the value is non-nil, PATTERN will be used as regexp
|
to matching buffer.
|
|
width, height: Specify width or height of the popup window. If
|
no size specified, `popwin:popup-window-width' or
|
`popwin:popup-window-height' will be used. See also position
|
keyword.
|
|
position: The value must be one of (left top right bottom). The
|
popup window will shown at the position of the frame. If no
|
position specified, `popwin:popup-window-position' will be
|
used.
|
|
noselect: If the value is non-nil, the popup window will not be
|
selected when it is shown.
|
|
dedicated: If the value is non-nil, the popup window will be
|
dedicated to the original popup buffer. In this case, when
|
another buffer is selected in the popup window, the popup
|
window will be closed immedicately and the selected buffer
|
will be shown on the previously selected window.
|
|
stick: If the value is non-nil, the popup window will be stuck
|
when it is shown.
|
|
tail: If the value is non-nil, the popup window will show the
|
last contents.
|
|
Examples: With '(\"*scratch*\" :height 30 :position top),
|
*scratch* buffer will be shown at the top of the frame with
|
height 30. With '(dired-mode :width 80 :position left), dired
|
buffers will be shown at the left of the frame with width 80."
|
:type '(repeat
|
(cons :tag "Config"
|
(choice :tag "Pattern"
|
(string :tag "Buffer Name")
|
(symbol :tag "Major Mode"))
|
(plist :tag "Keywords"
|
:value (:regexp nil) ; BUG? need default value
|
:options
|
((:regexp (boolean :tag "On/Off"))
|
(:width (choice :tag "Width"
|
(integer :tag "Width")
|
(float :tag "Width (%)")))
|
(:height (choice :tag "Height"
|
(integer :tag "Height")
|
(float :tag "Height (%)")))
|
(:position (choice :tag "Position"
|
(const :tag "Bottom" bottom)
|
(const :tag "Top" top)
|
(const :tag "Left" left)
|
(const :tag "Right" right)))
|
(:noselect (boolean :tag "On/Off"))
|
(:dedicated (boolean :tag "On/Off"))
|
(:stick (boolean :tag "On/Off"))
|
(:tail (boolean :tag "On/Off"))))))
|
:get (lambda (symbol)
|
(mapcar (lambda (element)
|
(if (consp element)
|
element
|
(list element)))
|
(default-value symbol)))
|
:group 'popwin)
|
|
(defun popwin:apply-display-buffer (function buffer &optional not-this-window)
|
"Call FUNCTION on BUFFER without special displaying."
|
(popwin:without-special-displaying
|
(let ((same-window
|
(or (same-window-p (buffer-name buffer))
|
(and (>= emacs-major-version 24)
|
(boundp 'action)
|
(consp action)
|
(eq (car action) 'display-buffer-same-window)))))
|
;; Close the popup window here so that the popup window won't to
|
;; be splitted.
|
(when (and (eq (selected-window) popwin:popup-window)
|
(not same-window))
|
(popwin:close-popup-window)))
|
(if (and (>= emacs-major-version 24)
|
(boundp 'action)
|
(boundp 'frame))
|
;; Use variables ACTION and FRAME which are formal parameters
|
;; of DISPLAY-BUFFER.
|
;;
|
;; TODO use display-buffer-alist instead of
|
;; display-buffer-function.
|
(funcall function buffer action frame)
|
(funcall function buffer not-this-window))))
|
|
(defun popwin:original-display-buffer (buffer &optional not-this-window)
|
"Call `display-buffer' on BUFFER without special displaying."
|
(popwin:apply-display-buffer 'display-buffer buffer not-this-window))
|
|
(defun popwin:original-pop-to-buffer (buffer &optional not-this-window)
|
"Call `pop-to-buffer' on BUFFER without special displaying."
|
(popwin:apply-display-buffer 'pop-to-buffer buffer not-this-window))
|
|
(defun popwin:original-display-last-buffer ()
|
"Call `display-buffer' for the last popup buffer without
|
special displaying."
|
(interactive)
|
(if popwin:popup-last-config
|
(popwin:original-display-buffer (car popwin:popup-last-config))
|
(error "No popup buffer ever")))
|
|
(defun popwin:switch-to-last-buffer ()
|
"Switch to the last popup buffer."
|
(interactive)
|
(if popwin:popup-last-config
|
(popwin:apply-display-buffer
|
(lambda (buffer &rest ignore) (switch-to-buffer buffer))
|
(car popwin:popup-last-config))
|
(error "No popup buffer ever")))
|
|
(defun popwin:original-pop-to-last-buffer ()
|
"Call `pop-to-buffer' for the last popup buffer without
|
special displaying."
|
(interactive)
|
(if popwin:popup-last-config
|
(popwin:original-pop-to-buffer (car popwin:popup-last-config))
|
(error "No popup buffer ever")))
|
|
(defun popwin:reuse-window-p (buffer-or-name not-this-window)
|
"Return t if a window showing BUFFER-OR-NAME exists and should
|
be used displaying the buffer."
|
(and popwin:reuse-window
|
(let ((window (get-buffer-window buffer-or-name
|
(if (eq popwin:reuse-window 'current)
|
nil
|
popwin:reuse-window))))
|
(and (not (null window))
|
(not (eq window (if not-this-window (selected-window))))))))
|
|
(defun* popwin:match-config (buffer)
|
(when (stringp buffer) (setq buffer (get-buffer buffer)))
|
(loop with name = (buffer-name buffer)
|
with mode = (buffer-local-value 'major-mode buffer)
|
for config in popwin:special-display-config
|
for (pattern . keywords) = (popwin:listify config)
|
if (cond ((eq pattern t) t)
|
((and (stringp pattern) (plist-get keywords :regexp))
|
(string-match pattern name))
|
((stringp pattern)
|
(string= pattern name))
|
((symbolp pattern)
|
(eq pattern mode))
|
((functionp pattern)
|
(funcall pattern buffer))
|
(t (error "Invalid pattern: %s" pattern)))
|
return (cons pattern keywords)))
|
|
(defun* popwin:display-buffer-1 (buffer-or-name
|
&key
|
default-config-keywords
|
(if-buffer-not-found :create)
|
if-config-not-found)
|
"Display BUFFER-OR-NAME, if possible, in a popup
|
window. Otherwise call IF-CONFIG-NOT-FOUND with BUFFER-OR-NAME if
|
the value is a function. If IF-CONFIG-NOT-FOUND is nil,
|
`popwin:popup-buffer' will be called. IF-BUFFER-NOT-FOUND
|
indicates what happens when there is no such buffers. If the
|
value is :create, create a new buffer named BUFFER-OR-NAME. If
|
the value is :error, report an error. The default value
|
is :create. DEFAULT-CONFIG-KEYWORDS is a property list which
|
specifies default values of the config."
|
(let* ((buffer (popwin:get-buffer buffer-or-name if-buffer-not-found))
|
(pattern-and-keywords (popwin:match-config buffer)))
|
(unless pattern-and-keywords
|
(if if-config-not-found
|
(return-from popwin:display-buffer-1
|
(funcall if-config-not-found buffer))
|
(setq pattern-and-keywords '(t))))
|
(destructuring-bind (&key regexp width height position noselect dedicated stick tail)
|
(append (cdr pattern-and-keywords) default-config-keywords)
|
(popwin:popup-buffer buffer
|
:width (or width popwin:popup-window-width)
|
:height (or height popwin:popup-window-height)
|
:position (or position popwin:popup-window-position)
|
:noselect (or (popwin:minibuffer-window-selected-p) noselect)
|
:dedicated dedicated
|
:stick stick
|
:tail tail))))
|
|
;;;###autoload
|
(defun popwin:display-buffer (buffer-or-name &optional not-this-window)
|
"Display BUFFER-OR-NAME, if possible, in a popup window, or as
|
usual. This function can be used as a value of
|
`display-buffer-function'."
|
(interactive "BDisplay buffer:\n")
|
(if (popwin:reuse-window-p buffer-or-name not-this-window)
|
;; Call `display-buffer' for reuse.
|
(popwin:original-display-buffer buffer-or-name not-this-window)
|
(popwin:display-buffer-1
|
buffer-or-name
|
:if-config-not-found
|
(unless (with-no-warnings
|
;; FIXME: emacs bug?
|
(called-interactively-p))
|
(lambda (buffer)
|
(popwin:original-display-buffer buffer not-this-window))))))
|
|
(defun popwin:special-display-popup-window (buffer &rest ignore)
|
"Obsolete."
|
(popwin:display-buffer-1 buffer))
|
|
(defun* popwin:pop-to-buffer-1 (buffer
|
&key
|
default-config-keywords
|
other-window
|
norecord)
|
(popwin:display-buffer-1 buffer
|
:default-config-keywords default-config-keywords
|
:if-config-not-found
|
(lambda (buffer)
|
(pop-to-buffer buffer other-window norecord))))
|
|
;;;###autoload
|
(defun popwin:pop-to-buffer (buffer &optional other-window norecord)
|
"Same as `pop-to-buffer' except that this function will use
|
`popwin:display-buffer-1' instead of `display-buffer'."
|
(interactive (list (read-buffer "Pop to buffer: " (other-buffer))
|
(if current-prefix-arg t)))
|
(popwin:pop-to-buffer-1 buffer
|
:other-window other-window
|
:norecord norecord))
|
|
|
|
;;; Universal Display
|
|
(defcustom popwin:universal-display-config '(t)
|
"Same as `popwin:special-display-config' except that this will
|
be used for `popwin:universal-display'."
|
:group 'popwin)
|
|
;;;###autoload
|
(defun popwin:universal-display ()
|
"Call the following command interactively with letting
|
`popwin:special-display-config' be
|
`popwin:universal-display-config'. This will be useful when
|
displaying buffers in popup windows temporarily."
|
(interactive)
|
(let ((command (key-binding (read-key-sequence "" t)))
|
(popwin:special-display-config popwin:universal-display-config))
|
(call-interactively command)))
|
|
|
|
;;; Extensions
|
|
;;;###autoload
|
(defun popwin:one-window ()
|
"Delete other window than the popup window. C-g restores the
|
original window configuration."
|
(interactive)
|
(setq popwin:window-config (current-window-configuration))
|
(delete-other-windows))
|
|
;;;###autoload
|
(defun popwin:popup-buffer-tail (&rest same-as-popwin:popup-buffer)
|
"Same as `popwin:popup-buffer' except that the buffer will be
|
`recenter'ed at the bottom."
|
(interactive "bPopup buffer:\n")
|
(destructuring-bind (buffer . keyargs) same-as-popwin:popup-buffer
|
(apply 'popwin:popup-buffer buffer :tail t keyargs)))
|
|
;;;###autoload
|
(defun popwin:find-file (filename &optional wildcards)
|
"Edit file FILENAME with popup window by `popwin:popup-buffer'."
|
(interactive
|
(find-file-read-args "Find file in popup window: "
|
(when (fboundp 'confirm-nonexistent-file-or-buffer)
|
(confirm-nonexistent-file-or-buffer))))
|
(popwin:popup-buffer (find-file-noselect filename wildcards)))
|
|
;;;###autoload
|
(defun popwin:find-file-tail (file &optional wildcard)
|
"Edit file FILENAME with popup window by
|
`popwin:popup-buffer-tail'."
|
(interactive
|
(find-file-read-args "Find file in popup window: "
|
(when (fboundp 'confirm-nonexistent-file-or-buffer)
|
(confirm-nonexistent-file-or-buffer))))
|
(popwin:popup-buffer-tail (find-file-noselect file wildcard)))
|
|
;;;###autoload
|
(defun popwin:messages ()
|
"Display *Messages* buffer in a popup window."
|
(interactive)
|
(popwin:popup-buffer-tail "*Messages*"))
|
|
|
|
;;; Minor Mode
|
|
(defun popwin:display-buffer-condition (buffer action)
|
(and (popwin:match-config buffer) t))
|
|
(defun popwin:display-buffer-action (buffer alist)
|
(let ((not-this-window (plist-get 'inhibit-same-window alist)))
|
(popwin:display-buffer buffer not-this-window)))
|
|
(define-minor-mode popwin-mode
|
""
|
:init-value nil
|
:global t
|
(if (boundp 'display-buffer-alist)
|
(let ((pair '(popwin:display-buffer-condition popwin:display-buffer-action)))
|
(if popwin-mode
|
(push pair display-buffer-alist)
|
(setq display-buffer-alist (delete pair display-buffer-alist))))
|
(with-no-warnings
|
(unless (or (null display-buffer-function)
|
(eq display-buffer-function 'popwin:display-buffer))
|
(warn "Overwriting display-buffer-function variable to enable/disable popwin-mode"))
|
(setq display-buffer-function (if popwin-mode 'popwin:display-buffer nil)))))
|
|
|
|
;;; Keymaps
|
|
(defvar popwin:keymap
|
(let ((map (make-sparse-keymap)))
|
(define-key map "b" 'popwin:popup-buffer)
|
(define-key map "l" 'popwin:popup-last-buffer)
|
(define-key map "o" 'popwin:display-buffer)
|
(define-key map "\C-b" 'popwin:switch-to-last-buffer)
|
(define-key map "\C-p" 'popwin:original-pop-to-last-buffer)
|
(define-key map "\C-o" 'popwin:original-display-last-buffer)
|
(define-key map " " 'popwin:select-popup-window)
|
(define-key map "s" 'popwin:stick-popup-window)
|
(define-key map "0" 'popwin:close-popup-window)
|
(define-key map "f" 'popwin:find-file)
|
(define-key map "\C-f" 'popwin:find-file)
|
(define-key map "e" 'popwin:messages)
|
(define-key map "\C-u" 'popwin:universal-display)
|
(define-key map "1" 'popwin:one-window)
|
|
map)
|
"Default keymap for popwin commands. Use like:
|
\(global-set-key (kbd \"C-z\") popwin:keymap\)
|
|
Keymap:
|
|
| Key | Command |
|
|--------+---------------------------------------|
|
| b | popwin:popup-buffer |
|
| l | popwin:popup-last-buffer |
|
| o | popwin:display-buffer |
|
| C-b | popwin:switch-to-last-buffer |
|
| C-p | popwin:original-pop-to-last-buffer |
|
| C-o | popwin:original-display-last-buffer |
|
| SPC | popwin:select-popup-window |
|
| s | popwin:stick-popup-window |
|
| 0 | popwin:close-popup-window |
|
| f, C-f | popwin:find-file |
|
| e | popwin:messages |
|
| C-u | popwin:universal-display |
|
| 1 | popwin:one-window |")
|
|
(provide 'popwin)
|
;;; popwin.el ends here
|
