.emacs.d.git - Gitblit

Chizi123

2018-11-17 5cb5f70b1872a757e93ea333b0e2dca50c6c8957

commit \| author \| age
5cb5f7	1	;;; popwin.el --- Popup Window Manager.
C	2
	3	;; Copyright (C) 2011-2015 Tomohiro Matsuyama
	4
	5	;; Author: Tomohiro Matsuyama <m2ym.pub@gmail.com>
	6	;; Keywords: convenience
	7	;; Package-Version: 20150315.1300
	8	;; Version: 1.0.0
	9
	10	;; This program is free software; you can redistribute it and/or modify
	11	;; it under the terms of the GNU General Public License as published by
	12	;; the Free Software Foundation, either version 3 of the License, or
	13	;; (at your option) any later version.
	14
	15	;; This program is distributed in the hope that it will be useful,
	16	;; but WITHOUT ANY WARRANTY; without even the implied warranty of
	17	;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	18	;; GNU General Public License for more details.
	19
	20	;; You should have received a copy of the GNU General Public License
	21	;; along with this program. If not, see <http://www.gnu.org/licenses/>.
	22
	23	;;; Commentary:
	24
	25	;; Popwin makes you free from the hell of annoying buffers such like
	26	;; Help, Completions, compilation, and etc.
	27	;;
	28	;; To use popwin, just add the following code into your .emacs:
	29	;;
	30	;; (require 'popwin)
	31	;; (popwin-mode 1)
	32	;;
	33	;; Then try to show some buffer, for example Help or
	34	;; Completeions. Unlike standard behavior, their buffers may be
	35	;; shown in a popup window at the bottom of the frame. And you can
	36	;; close the popup window seamlessly by typing C-g or selecting other
	37	;; windows.
	38	;;
	39	;; `popwin:display-buffer' displays special buffers in a popup window
	40	;; and displays normal buffers as unsual. Special buffers are
	41	;; specified in `popwin:special-display-config', which tells popwin
	42	;; how to display such buffers. See docstring of
	43	;; `popwin:special-display-config' for more information.
	44	;;
	45	;; The default width/height/position of popup window can be changed by
	46	;; setting `popwin:popup-window-width', `popwin:popup-window-height',
	47	;; and `popwin:popup-window-position'. You can also change the
	48	;; behavior for a specific buffer. See docstring of
	49	;; `popwin:special-display-config'.
	50	;;
	51	;; If you want to use some useful commands such like
	52	;; `popwin:popup-buffer' and `popwin:find-file' easily. you may bind
	53	;; `popwin:keymap' to `C-z', for example, like:
	54	;;
	55	;; (global-set-key (kbd "C-z") popwin:keymap)
	56	;;
	57	;; See also `popwin:keymap' documentation.
	58	;;
	59	;; Enjoy!
	60
	61	;;; Code:
	62
	63	(eval-when-compile (require 'cl))
	64
	65	(defconst popwin:version "1.0.0")
	66
	67
	68
	69	;;; Utility
	70
	71	(defun popwin:listify (object)
	72	"Return a singleton list of OBJECT if OBJECT is an atom,
	73	otherwise OBJECT itself."
	74	(if (atom object) (list object) object))
	75
	76	(defun popwin:subsitute-in-tree (map tree)
	77	(if (consp tree)
	78	(cons (popwin:subsitute-in-tree map (car tree))
	79	(popwin:subsitute-in-tree map (cdr tree)))
	80	(or (cdr (assq tree map)) tree)))
	81
	82	(defun popwin:get-buffer (buffer-or-name &optional if-not-found)
	83	"Return a buffer named BUFFER-OR-NAME or BUFFER-OR-NAME itself
	84	if BUFFER-OR-NAME is a buffer. If BUFFER-OR-NAME is a string and
	85	such a buffer named BUFFER-OR-NAME not found, a new buffer will
	86	be returned when IF-NOT-FOUND is :create, or an error reported
	87	when IF-NOT-FOUND is :error. The default of value of IF-NOT-FOUND
	88	is :error."
	89	(ecase (or if-not-found :error)
	90	(:create
	91	(get-buffer-create buffer-or-name))
	92	(:error
	93	(or (get-buffer buffer-or-name)
	94	(error "No buffer named %s" buffer-or-name)))))
	95
	96	(defun popwin:switch-to-buffer (buffer-or-name &optional norecord)
	97	"Call `switch-to-buffer' forcing BUFFER-OF-NAME be displayed in
	98	the selected window."
	99	(with-no-warnings
	100	(if (>= emacs-major-version 24)
	101	(switch-to-buffer buffer-or-name norecord t)
	102	(switch-to-buffer buffer-or-name norecord))))
	103
	104	(defun popwin:select-window (window &optional norecord)
	105	"Call `select-window' with saving the current buffer."
	106	(save-current-buffer
	107	(select-window window norecord)))
	108
	109	(defun popwin:buried-buffer-p (buffer)
	110	"Return t if BUFFER might be thought of as a buried buffer."
	111	(eq (car (last (buffer-list))) buffer))
	112
	113	(defun popwin:window-point (window)
	114	"Return window-point of WINDOW. If WINDOW is currently
	115	selected, then return buffer-point instead."
	116	(if (eq (selected-window) window)
	117	(with-current-buffer (window-buffer window)
	118	(point))
	119	(window-point window)))
	120
	121	(defun popwin:window-deletable-p (window)
	122	"Return t if WINDOW is deletable, meaning that WINDOW is alive
	123	and not a minibuffer's window, plus there is two or more windows."
	124	(and (window-live-p window)
	125	(not (window-minibuffer-p window))
	126	(not (one-window-p))))
	127
	128	(defmacro popwin:save-selected-window (&rest body)
	129	"Evaluate BODY saving the selected window."
	130	`(with-selected-window (selected-window) ,@body))
	131
	132	(defun popwin:minibuffer-window-selected-p ()
	133	"Return t if minibuffer window is selected."
	134	(minibuffer-window-active-p (selected-window)))
	135
	136	(defun popwin:last-selected-window ()
	137	"Return currently selected window or lastly selected window if
	138	minibuffer window is selected."
	139	(if (popwin:minibuffer-window-selected-p)
	140	(minibuffer-selected-window)
	141	(selected-window)))
	142
	143
	144
	145	;;; Common
	146
	147	(defvar popwin:debug nil)
	148
	149	(defvar popwin:dummy-buffer nil)
	150
	151	(defun popwin:dummy-buffer ()
	152	(if (buffer-live-p popwin:dummy-buffer)
	153	popwin:dummy-buffer
	154	(setq popwin:dummy-buffer (get-buffer-create " popwin-dummy"))))
	155
	156	(defun popwin:kill-dummy-buffer ()
	157	(when (buffer-live-p popwin:dummy-buffer)
	158	(kill-buffer popwin:dummy-buffer))
	159	(setq popwin:dummy-buffer nil))
	160
	161	(defun popwin:window-trailing-edge-adjustable-p (window)
	162	"Return t if a trailing edge of WINDOW is adjustable."
	163	(let ((next-window (next-window window)))
	164	(and (not (eq next-window (frame-first-window)))
	165	(not (eq (window-buffer next-window)
	166	(popwin:dummy-buffer))))))
	167
	168	(defun* popwin:adjust-window-edges (window
	169	edges
	170	&optional
	171	(hfactor 1)
	172	(vfactor 1))
	173	"Adjust edges of WINDOW to EDGES accoring to horizontal factor
	174	HFACTOR, and vertical factor VFACTOR."
	175	(when (popwin:window-trailing-edge-adjustable-p window)
	176	(destructuring-bind ((left top right bottom)
	177	(cur-left cur-top cur-right cur-bottom))
	178	(list edges (window-edges window))
	179	(let ((hdelta (floor (- (* (- right left) hfactor) (- cur-right cur-left))))
	180	(vdelta (floor (- (* (- bottom top) vfactor) (- cur-bottom cur-top)))))
	181	(ignore-errors
	182	(adjust-window-trailing-edge window hdelta t))
	183	(ignore-errors
	184	(adjust-window-trailing-edge window vdelta nil))))))
	185
	186	(defun popwin:window-config-tree-1 (node)
	187	(if (windowp node)
	188	(list 'window
	189	node
	190	(window-buffer node)
	191	(popwin:window-point node)
	192	(window-start node)
	193	(window-edges node)
	194	(eq (selected-window) node)
	195	(window-dedicated-p node))
	196	(destructuring-bind (dir edges . windows) node
	197	(append (list dir edges)
	198	(loop for window in windows
	199	unless (and (windowp window)
	200	(window-parameter window 'window-side))
	201	collect (popwin:window-config-tree-1 window))))))
	202
	203	(defun popwin:window-config-tree ()
	204	"Return `window-tree' with replacing window values in the tree
	205	with persistent representations."
	206	(destructuring-bind (root mini)
	207	(window-tree)
	208	(list (popwin:window-config-tree-1 root) mini)))
	209
	210	(defun popwin:replicate-window-config (window node hfactor vfactor)
	211	"Replicate NODE of window configuration on WINDOW with
	212	horizontal factor HFACTOR, and vertical factor VFACTOR. The
	213	return value is a association list of mapping from old-window to
	214	new-window."
	215	(if (eq (car node) 'window)
	216	(destructuring-bind (old-win buffer point start edges selected dedicated)
	217	(cdr node)
	218	(set-window-dedicated-p window nil)
	219	(popwin:adjust-window-edges window edges hfactor vfactor)
	220	(with-selected-window window
	221	(popwin:switch-to-buffer buffer t))
	222	(when selected
	223	(popwin:select-window window))
	224	(set-window-point window point)
	225	(set-window-start window start t)
	226	(when dedicated
	227	(set-window-dedicated-p window t))
	228	`((,old-win . ,window)))
	229	(destructuring-bind (dir edges . windows) node
	230	(loop while windows
	231	for sub-node = (pop windows)
	232	for win = window then next-win
	233	for next-win = (and windows (split-window win nil (not dir)))
	234	append (popwin:replicate-window-config win sub-node hfactor vfactor)))))
	235
	236	(defun popwin:restore-window-outline (node outline)
	237	"Restore window outline accoding to the structures of NODE
	238	which is a node of `window-tree' and OUTLINE which is a node of
	239	`popwin:window-config-tree'."
	240	(cond
	241	((and (windowp node)
	242	(eq (car outline) 'window))
	243	;; same window
	244	(destructuring-bind (old-win buffer point start edges selected dedicated)
	245	(cdr outline)
	246	(popwin:adjust-window-edges node edges)
	247	(when (and (eq (window-buffer node) buffer)
	248	(eq (popwin:window-point node) point))
	249	(set-window-start node start))))
	250	((or (windowp node)
	251	(not (eq (car node) (car outline))))
	252	;; different structure
	253	;; nothing to do
	254	)
	255	(t
	256	(let ((child-nodes (cddr node))
	257	(child-outlines (cddr outline)))
	258	(when (eq (length child-nodes) (length child-outlines))
	259	;; same structure
	260	(loop for child-node in child-nodes
	261	for child-outline in child-outlines
	262	do (popwin:restore-window-outline child-node child-outline)))))))
	263
	264	(defun popwin:position-horizontal-p (position)
	265	"Return t if POSITION is hozirontal."
	266	(and (memq position '(left :left right :right)) t))
	267
	268	(defun popwin:position-vertical-p (position)
	269	"Return t if POSITION is vertical."
	270	(and (memq position '(top :top bottom :bottom)) t))
	271
	272	(defun popwin:create-popup-window-1 (window size position)
	273	"Create a new window with SIZE at POSITION of WINDOW. The
	274	return value is a list of a master window and the popup window."
	275	(let ((width (window-width window))
	276	(height (window-height window)))
	277	(ecase position
	278	((left :left)
	279	(list (split-window window size t)
	280	window))
	281	((top :top)
	282	(list (split-window window size nil)
	283	window))
	284	((right :right)
	285	(list window
	286	(split-window window (- width size) t)))
	287	((bottom :bottom)
	288	(list window
	289	(split-window window (- height size) nil))))))
	290
	291	(defun* popwin:create-popup-window (&optional (size 15) (position 'bottom) (adjust t))
	292	"Create a popup window with SIZE on the frame. If SIZE
	293	is integer, the size of the popup window will be SIZE. If SIZE is
	294	float, the size of popup window will be a multiplier of SIZE and
	295	frame-size. can be an integer and a float. If ADJUST is t, all of
	296	windows will be adjusted to fit the frame. POSITION must be one
	297	of (left top right bottom). The return value is a pair of a
	298	master window and the popup window. To close the popup window
	299	properly, get `current-window-configuration' before calling this
	300	function, and call `set-window-configuration' with the
	301	window-configuration."
	302	(let* ((root (car (popwin:window-config-tree)))
	303	(root-win (popwin:last-selected-window))
	304	(hfactor 1)
	305	(vfactor 1))
	306	(popwin:save-selected-window
	307	(delete-other-windows root-win))
	308	(let ((root-width (window-width root-win))
	309	(root-height (window-height root-win)))
	310	(when adjust
	311	(if (floatp size)
	312	(if (popwin:position-horizontal-p position)
	313	(setq hfactor (- 1.0 size)
	314	size (round (* root-width size)))
	315	(setq vfactor (- 1.0 size)
	316	size (round (* root-height size))))
	317	(if (popwin:position-horizontal-p position)
	318	(setq hfactor (/ (float (- root-width size)) root-width))
	319	(setq vfactor (/ (float (- root-height size)) root-height)))))
	320	(destructuring-bind (master-win popup-win)
	321	(popwin:create-popup-window-1 root-win size position)
	322	;; Mark popup-win being a popup window.
	323	(with-selected-window popup-win
	324	(popwin:switch-to-buffer (popwin:dummy-buffer) t))
	325	(let ((win-map (popwin:replicate-window-config master-win root hfactor vfactor)))
	326	(list master-win popup-win win-map))))))
	327
	328
	329
	330	;;; Common User Interface
	331
	332	(defgroup popwin nil
	333	"Popup Window Manager."
	334	:group 'convenience
	335	:prefix "popwin:")
	336
	337	(defcustom popwin:popup-window-position 'bottom
	338	"Default popup window position. This must be one of (left top right
	339	bottom)."
	340	:type 'symbol
	341	:group 'popwin)
	342
	343	(defcustom popwin:popup-window-width 30
	344	"Default popup window width. If `popwin:popup-window-position'
	345	is top or bottom, this configuration will be ignored. If this
	346	variable is float, the popup window width will be a multiplier of
	347	the value and frame-size."
	348	:type 'number
	349	:group 'popwin)
	350
	351	(defcustom popwin:popup-window-height 15
	352	"Default popup window height. If `popwin:popup-window-position'
	353	is left or right, this configuration will be ignored. If this
	354	variable is float, the popup window height will be a multiplier
	355	of the value and frame-size."
	356	:type 'number
	357	:group 'popwin)
	358
	359	(defcustom popwin:reuse-window 'current
	360	"Non-nil means `popwin:display-buffer' will not popup the
	361	visible buffer. The value is same as a second argument of
	362	`get-buffer-window', except `current' means the selected frame."
	363	:group 'popwin)
	364
	365	(defcustom popwin:adjust-other-windows t
	366	"Non-nil means all of other windows will be adjusted to fit the
	367	frame when a popup window is shown."
	368	:type 'boolean
	369	:group 'popwin)
	370
	371	(defvar popwin:context-stack nil)
	372
	373	(defvar popwin:popup-window nil
	374	"Main popup window instance.")
	375
	376	(defvar popwin:popup-buffer nil
	377	"Buffer of currently shown in the popup window.")
	378
	379	(defvar popwin:popup-last-config nil
	380	"Arguments to `popwin:popup-buffer' of last call.")
	381
	382	;; Deprecated
	383	(defvar popwin:master-window nil
	384	"Master window of a popup window.")
	385
	386	(defvar popwin:focus-window nil
	387	"Focused window which is used to check whether or not to close
	388	the popup window.")
	389
	390	(defvar popwin:selected-window nil
	391	"Last selected window when the popup window is shown.")
	392
	393	(defvar popwin:popup-window-dedicated-p nil
	394	"Non-nil means the popup window is dedicated to the original
	395	popup buffer.")
	396
	397	(defvar popwin:popup-window-stuck-p nil
	398	"Non-nil means the popup window has been stuck.")
	399
	400	(defvar popwin:window-outline nil
	401	"Original window outline which is obtained by
	402	`popwin:window-config-tree'.")
	403
	404	(defvar popwin:window-map nil
	405	"Mapping from old windows to new windows.")
	406
	407	(defvar popwin:window-config nil
	408	"An original window configuration for restoreing.")
	409
	410	(defvar popwin:close-popup-window-timer nil
	411	"Timer of closing the popup window.")
	412
	413	(defvar popwin:close-popup-window-timer-interval 0.05
	414	"Interval of `popwin:close-popup-window-timer'.")
	415
	416	(defvar popwin:before-popup-hook nil)
	417
	418	(defvar popwin:after-popup-hook nil)
	419
	420	(symbol-macrolet ((context-vars '(popwin:popup-window
	421	popwin:popup-buffer
	422	popwin:master-window
	423	popwin:focus-window
	424	popwin:selected-window
	425	popwin:popup-window-dedicated-p
	426	popwin:popup-window-stuck-p
	427	popwin:window-outline
	428	popwin:window-map)))
	429	(defun popwin:valid-context-p (context)
	430	(window-live-p (plist-get context 'popwin:popup-window)))
	431
	432	(defun popwin:current-context ()
	433	(loop for var in context-vars
	434	collect var
	435	collect (symbol-value var)))
	436
	437	(defun popwin:use-context (context)
	438	(loop for var = (pop context)
	439	for val = (pop context)
	440	while var
	441	do (set var val)))
	442
	443	(defun popwin:push-context ()
	444	(push (popwin:current-context) popwin:context-stack))
	445
	446	(defun popwin:pop-context ()
	447	(popwin:use-context (pop popwin:context-stack)))
	448
	449	(defun* popwin:find-context-for-buffer (buffer &key valid-only)
	450	(loop with stack = popwin:context-stack
	451	for context = (pop stack)
	452	while context
	453	if (and (eq buffer (plist-get context 'popwin:popup-buffer))
	454	(or (not valid-only)
	455	(popwin:valid-context-p context)))
	456	return (list context stack))))
	457
	458	(defun popwin:popup-window-live-p ()
	459	"Return t if `popwin:popup-window' is alive."
	460	(window-live-p popwin:popup-window))
	461
	462	(defun* popwin:update-window-reference (symbol
	463	&key
	464	(map popwin:window-map)
	465	safe
	466	recursive)
	467	(unless (and safe (not (boundp symbol)))
	468	(let ((value (symbol-value symbol)))
	469	(set symbol
	470	(if recursive
	471	(popwin:subsitute-in-tree map value)
	472	(or (cdr (assq value map)) value))))))
	473
	474	(defun popwin:start-close-popup-window-timer ()
	475	(or popwin:close-popup-window-timer
	476	(setq popwin:close-popup-window-timer
	477	(run-with-idle-timer popwin:close-popup-window-timer-interval
	478	popwin:close-popup-window-timer-interval
	479	'popwin:close-popup-window-timer))))
	480
	481	(defun popwin:stop-close-popup-window-timer ()
	482	(when popwin:close-popup-window-timer
	483	(cancel-timer popwin:close-popup-window-timer)
	484	(setq popwin:close-popup-window-timer nil)))
	485
	486	(defun popwin:close-popup-window-timer ()
	487	(condition-case var
	488	(popwin:close-popup-window-if-necessary)
	489	(error
	490	(message "popwin:close-popup-window-timer: error: %s" var)
	491	(when popwin:debug (backtrace)))))
	492
	493	(defun popwin:close-popup-window (&optional keep-selected)
	494	"Close the popup window and restore to the previous window
	495	configuration. If KEEP-SELECTED is non-nil, the lastly selected
	496	window will not be selected."
	497	(interactive)
	498	(when popwin:popup-window
	499	(unwind-protect
	500	(progn
	501	(when (popwin:window-deletable-p popwin:popup-window)
	502	(delete-window popwin:popup-window))
	503	(popwin:restore-window-outline (car (window-tree)) popwin:window-outline)
	504	;; Call `redisplay' here so `window-start' could be set
	505	;; prior to the point change of the master buffer.
	506	(redisplay)
	507	(when (and (not keep-selected)
	508	(window-live-p popwin:selected-window))
	509	(select-window popwin:selected-window)))
	510	(popwin:pop-context)
	511	;; Cleanup if no context left.
	512	(when (null popwin:context-stack)
	513	(popwin:kill-dummy-buffer)
	514	(popwin:stop-close-popup-window-timer)))))
	515
	516	(defun popwin:close-popup-window-if-necessary ()
	517	"Close the popup window if necessary. The all situations where
	518	the popup window will be closed are followings:
	519
	520	* `C-g' has been pressed.
	521	* The popup buffer has been killed.
	522	* The popup buffer has been buried.
	523	* The popup buffer has been changed if the popup window is
	524	dedicated to the buffer.
	525	* Another window has been selected."
	526	(when popwin:popup-window
	527	(let* ((window (selected-window))
	528	(window-point (popwin:window-point window))
	529	(window-buffer (window-buffer window))
	530	(minibuf-window-p (window-minibuffer-p window))
	531	(reading-from-minibuf
	532	(and minibuf-window-p
	533	(minibuffer-prompt)
	534	t))
	535	(quit-requested
	536	(and (eq last-command 'keyboard-quit)
	537	(eq last-command-event ?\C-g)))
	538	(other-window-selected
	539	(and (not (eq window popwin:focus-window))
	540	(not (eq window popwin:popup-window))))
	541	(orig-this-command this-command)
	542	(popup-buffer-alive
	543	(buffer-live-p popwin:popup-buffer))
	544	(popup-buffer-buried
	545	(popwin:buried-buffer-p popwin:popup-buffer))
	546	(popup-buffer-changed-despite-of-dedicated
	547	(and popwin:popup-window-dedicated-p
	548	(not popwin:popup-window-stuck-p)
	549	(or (not other-window-selected)
	550	(not reading-from-minibuf))
	551	(buffer-live-p window-buffer)
	552	(not (eq popwin:popup-buffer window-buffer))))
	553	(popup-window-alive (popwin:popup-window-live-p)))
	554	(when (or quit-requested
	555	(not popup-buffer-alive)
	556	popup-buffer-buried
	557	popup-buffer-changed-despite-of-dedicated
	558	(not popup-window-alive)
	559	(and other-window-selected
	560	(not minibuf-window-p)
	561	(not popwin:popup-window-stuck-p)))
	562	(when popwin:debug
	563	(message (concat "popwin: CLOSE:\n"
	564	" quit-requested = %s\n"
	565	" popup-buffer-alive = %s\n"
	566	" popup-buffer-buried = %s\n"
	567	" popup-buffer-changed-despite-of-dedicated = %s\n"
	568	" popup-window-alive = %s\n"
	569	" (selected-window) = %s\n"
	570	" popwin:focus-window = %s\n"
	571	" popwin:popup-window = %s\n"
	572	" other-window-selected = %s\n"
	573	" minibuf-window-p = %s\n"
	574	" popwin:popup-window-stuck-p = %s")
	575	quit-requested
	576	popup-buffer-alive
	577	popup-buffer-buried
	578	popup-buffer-changed-despite-of-dedicated
	579	popup-window-alive
	580	window
	581	popwin:focus-window
	582	popwin:popup-window
	583	other-window-selected
	584	minibuf-window-p
	585	popwin:popup-window-stuck-p))
	586	(when (and quit-requested
	587	(null orig-this-command))
	588	(setq this-command 'popwin:close-popup-window)
	589	(run-hooks 'pre-command-hook))
	590	(cond
	591	((and quit-requested
	592	(null orig-this-command)
	593	popwin:window-config)
	594	(set-window-configuration popwin:window-config)
	595	(setq popwin:window-config nil))
	596	(reading-from-minibuf
	597	(popwin:close-popup-window)
	598	(select-window (minibuffer-window)))
	599	(t
	600	(popwin:close-popup-window
	601	(and other-window-selected
	602	(and popup-buffer-alive
	603	(not popup-buffer-buried))))
	604	(when popup-buffer-changed-despite-of-dedicated
	605	(popwin:switch-to-buffer window-buffer)
	606	(goto-char window-point))))
	607	(when (and quit-requested
	608	(null orig-this-command))
	609	(run-hooks 'post-command-hook)
	610	(setq last-command 'popwin:close-popup-window))))))
	611
	612	;;;###autoload
	613	(defun* popwin:popup-buffer (buffer
	614	&key
	615	(width popwin:popup-window-width)
	616	(height popwin:popup-window-height)
	617	(position popwin:popup-window-position)
	618	noselect
	619	dedicated
	620	stick
	621	tail)
	622	"Show BUFFER in a popup window and return the popup window. If
	623	NOSELECT is non-nil, the popup window will not be selected. If
	624	STICK is non-nil, the popup window will be stuck. If TAIL is
	625	non-nil, the popup window will show the last contents. Calling
	626	`popwin:popup-buffer' during `popwin:popup-buffer' is allowed. In
	627	that case, the buffer of the popup window will be replaced with
	628	BUFFER."
	629	(interactive "BPopup buffer:\n")
	630	(setq buffer (get-buffer buffer))
	631	(popwin:push-context)
	632	(run-hooks 'popwin:before-popup-hook)
	633	(multiple-value-bind (context context-stack)
	634	(popwin:find-context-for-buffer buffer :valid-only t)
	635	(if context
	636	(progn
	637	(popwin:use-context context)
	638	(setq popwin:context-stack context-stack))
	639	(let ((win-outline (car (popwin:window-config-tree))))
	640	(destructuring-bind (master-win popup-win win-map)
	641	(let ((size (if (popwin:position-horizontal-p position) width height))
	642	(adjust popwin:adjust-other-windows))
	643	(popwin:create-popup-window size position adjust))
	644	(setq popwin:popup-window popup-win
	645	popwin:master-window master-win
	646	popwin:window-outline win-outline
	647	popwin:window-map win-map
	648	popwin:window-config nil
	649	popwin:selected-window (selected-window)))
	650	(popwin:update-window-reference 'popwin:context-stack :recursive t)
	651	(popwin:start-close-popup-window-timer))
	652	(with-selected-window popwin:popup-window
	653	(popwin:switch-to-buffer buffer)
	654	(when tail
	655	(set-window-point popwin:popup-window (point-max))
	656	(recenter -2)))
	657	(setq popwin:popup-buffer buffer
	658	popwin:popup-last-config (list buffer
	659	:width width :height height :position position
	660	:noselect noselect :dedicated dedicated
	661	:stick stick :tail tail)
	662	popwin:popup-window-dedicated-p dedicated
	663	popwin:popup-window-stuck-p stick)))
	664	(if noselect
	665	(setq popwin:focus-window popwin:selected-window)
	666	(setq popwin:focus-window popwin:popup-window)
	667	(select-window popwin:popup-window))
	668	(run-hooks 'popwin:after-popup-hook)
	669	popwin:popup-window)
	670
	671	(defun popwin:popup-last-buffer (&optional noselect)
	672	"Show the last popup buffer with the same configuration. If
	673	NOSELECT is non-nil, the popup window will not be selected."
	674	(interactive "P")
	675	(if popwin:popup-last-config
	676	(if noselect
	677	(destructuring-bind (buffer . keyargs) popwin:popup-last-config
	678	(apply 'popwin:popup-buffer buffer :noselect t keyargs))
	679	(apply 'popwin:popup-buffer popwin:popup-last-config))
	680	(error "No popup buffer ever")))
	681	(defalias 'popwin:display-last-buffer 'popwin:popup-last-buffer)
	682
	683	(defun popwin:select-popup-window ()
	684	"Select the currently shown popup window."
	685	(interactive)
	686	(if (popwin:popup-window-live-p)
	687	(select-window popwin:popup-window)
	688	(error "No popup window displayed")))
	689
	690	(defun popwin:stick-popup-window ()
	691	"Stick the currently shown popup window. The popup window can
	692	be closed by `popwin:close-popup-window'."
	693	(interactive)
	694	(if (popwin:popup-window-live-p)
	695	(progn
	696	(setq popwin:popup-window-stuck-p t)
	697	(message "Popup window stuck"))
	698	(error "No popup window displayed")))
	699
	700
	701
	702	;;; Special Display
	703
	704	(defmacro popwin:without-special-displaying (&rest body)
	705	"Evaluate BODY without special displaying."
	706	(if (boundp 'display-buffer-alist)
	707	`(with-no-warnings
	708	(let ((display-buffer-function nil)
	709	(display-buffer-alist
	710	(remove '(popwin:display-buffer-condition
	711	popwin:display-buffer-action)
	712	display-buffer-alist)))
	713	,@body))
	714	`(with-no-warnings (let ((display-buffer-function nil)) ,@body))))
	715
	716	(defcustom popwin:special-display-config
	717	'(;; Emacs
	718	("Miniedit Help" :noselect t)
	719	help-mode
	720	(completion-list-mode :noselect t)
	721	(compilation-mode :noselect t)
	722	(grep-mode :noselect t)
	723	(occur-mode :noselect t)
	724	("Pp Macroexpand Output" :noselect t)
	725	"Shell Command Output"
	726	;; VC
	727	"vc-diff"
	728	"vc-change-log"
	729	;; Undo-Tree
	730	(" undo-tree" :width 60 :position right)
	731	;; Anything
	732	("^\\anything.\\*$" :regexp t)
	733	;; SLIME
	734	"slime-apropos"
	735	"slime-macroexpansion"
	736	"slime-description"
	737	("slime-compilation" :noselect t)
	738	"slime-xref"
	739	(sldb-mode :stick t)
	740	slime-repl-mode
	741	slime-connection-list-mode)
	742	"Configuration of special displaying buffer for
	743	`popwin:display-buffer' and
	744	`popwin:special-display-popup-window'. The value is a list of
	745	CONFIG as a form of (PATTERN . KEYWORDS) where PATTERN is a
	746	pattern of specifying buffer and KEYWORDS is a list of a pair of
	747	key and value. PATTERN is in general a buffer name, a symbol
	748	specifying major-mode of buffer, or a predicate function which
	749	takes one argument: the buffer. If CONFIG is a string or a
	750	symbol, PATTERN will be CONFIG and KEYWORDS will be
	751	empty. Available keywords are following:
	752
	753	regexp: If the value is non-nil, PATTERN will be used as regexp
	754	to matching buffer.
	755
	756	width, height: Specify width or height of the popup window. If
	757	no size specified, `popwin:popup-window-width' or
	758	`popwin:popup-window-height' will be used. See also position
	759	keyword.
	760
	761	position: The value must be one of (left top right bottom). The
	762	popup window will shown at the position of the frame. If no
	763	position specified, `popwin:popup-window-position' will be
	764	used.
	765
	766	noselect: If the value is non-nil, the popup window will not be
	767	selected when it is shown.
	768
	769	dedicated: If the value is non-nil, the popup window will be
	770	dedicated to the original popup buffer. In this case, when
	771	another buffer is selected in the popup window, the popup
	772	window will be closed immedicately and the selected buffer
	773	will be shown on the previously selected window.
	774
	775	stick: If the value is non-nil, the popup window will be stuck
	776	when it is shown.
	777
	778	tail: If the value is non-nil, the popup window will show the
	779	last contents.
	780
	781	Examples: With '(\"scratch\" :height 30 :position top),
	782	scratch buffer will be shown at the top of the frame with
	783	height 30. With '(dired-mode :width 80 :position left), dired
	784	buffers will be shown at the left of the frame with width 80."
	785	:type '(repeat
	786	(cons :tag "Config"
	787	(choice :tag "Pattern"
	788	(string :tag "Buffer Name")
	789	(symbol :tag "Major Mode"))
	790	(plist :tag "Keywords"
	791	:value (:regexp nil) ; BUG? need default value
	792	:options
	793	((:regexp (boolean :tag "On/Off"))
	794	(:width (choice :tag "Width"
	795	(integer :tag "Width")
	796	(float :tag "Width (%)")))
	797	(:height (choice :tag "Height"
	798	(integer :tag "Height")
	799	(float :tag "Height (%)")))
	800	(:position (choice :tag "Position"
	801	(const :tag "Bottom" bottom)
	802	(const :tag "Top" top)
	803	(const :tag "Left" left)
	804	(const :tag "Right" right)))
	805	(:noselect (boolean :tag "On/Off"))
	806	(:dedicated (boolean :tag "On/Off"))
	807	(:stick (boolean :tag "On/Off"))
	808	(:tail (boolean :tag "On/Off"))))))
	809	:get (lambda (symbol)
	810	(mapcar (lambda (element)
	811	(if (consp element)
	812	element
	813	(list element)))
	814	(default-value symbol)))
	815	:group 'popwin)
	816
	817	(defun popwin:apply-display-buffer (function buffer &optional not-this-window)
	818	"Call FUNCTION on BUFFER without special displaying."
	819	(popwin:without-special-displaying
	820	(let ((same-window
	821	(or (same-window-p (buffer-name buffer))
	822	(and (>= emacs-major-version 24)
	823	(boundp 'action)
	824	(consp action)
	825	(eq (car action) 'display-buffer-same-window)))))
	826	;; Close the popup window here so that the popup window won't to
	827	;; be splitted.
	828	(when (and (eq (selected-window) popwin:popup-window)
	829	(not same-window))
	830	(popwin:close-popup-window)))
	831	(if (and (>= emacs-major-version 24)
	832	(boundp 'action)
	833	(boundp 'frame))
	834	;; Use variables ACTION and FRAME which are formal parameters
	835	;; of DISPLAY-BUFFER.
	836	;;
	837	;; TODO use display-buffer-alist instead of
	838	;; display-buffer-function.
	839	(funcall function buffer action frame)
	840	(funcall function buffer not-this-window))))
	841
	842	(defun popwin:original-display-buffer (buffer &optional not-this-window)
	843	"Call `display-buffer' on BUFFER without special displaying."
	844	(popwin:apply-display-buffer 'display-buffer buffer not-this-window))
	845
	846	(defun popwin:original-pop-to-buffer (buffer &optional not-this-window)
	847	"Call `pop-to-buffer' on BUFFER without special displaying."
	848	(popwin:apply-display-buffer 'pop-to-buffer buffer not-this-window))
	849
	850	(defun popwin:original-display-last-buffer ()
	851	"Call `display-buffer' for the last popup buffer without
	852	special displaying."
	853	(interactive)
	854	(if popwin:popup-last-config
	855	(popwin:original-display-buffer (car popwin:popup-last-config))
	856	(error "No popup buffer ever")))
	857
	858	(defun popwin:switch-to-last-buffer ()
	859	"Switch to the last popup buffer."
	860	(interactive)
	861	(if popwin:popup-last-config
	862	(popwin:apply-display-buffer
	863	(lambda (buffer &rest ignore) (switch-to-buffer buffer))
	864	(car popwin:popup-last-config))
	865	(error "No popup buffer ever")))
	866
	867	(defun popwin:original-pop-to-last-buffer ()
	868	"Call `pop-to-buffer' for the last popup buffer without
	869	special displaying."
	870	(interactive)
	871	(if popwin:popup-last-config
	872	(popwin:original-pop-to-buffer (car popwin:popup-last-config))
	873	(error "No popup buffer ever")))
	874
	875	(defun popwin:reuse-window-p (buffer-or-name not-this-window)
	876	"Return t if a window showing BUFFER-OR-NAME exists and should
	877	be used displaying the buffer."
	878	(and popwin:reuse-window
	879	(let ((window (get-buffer-window buffer-or-name
	880	(if (eq popwin:reuse-window 'current)
	881	nil
	882	popwin:reuse-window))))
	883	(and (not (null window))
	884	(not (eq window (if not-this-window (selected-window))))))))
	885
	886	(defun* popwin:match-config (buffer)
	887	(when (stringp buffer) (setq buffer (get-buffer buffer)))
	888	(loop with name = (buffer-name buffer)
	889	with mode = (buffer-local-value 'major-mode buffer)
	890	for config in popwin:special-display-config
	891	for (pattern . keywords) = (popwin:listify config)
	892	if (cond ((eq pattern t) t)
	893	((and (stringp pattern) (plist-get keywords :regexp))
	894	(string-match pattern name))
	895	((stringp pattern)
	896	(string= pattern name))
	897	((symbolp pattern)
	898	(eq pattern mode))
	899	((functionp pattern)
	900	(funcall pattern buffer))
	901	(t (error "Invalid pattern: %s" pattern)))
	902	return (cons pattern keywords)))
	903
	904	(defun* popwin:display-buffer-1 (buffer-or-name
	905	&key
	906	default-config-keywords
	907	(if-buffer-not-found :create)
	908	if-config-not-found)
	909	"Display BUFFER-OR-NAME, if possible, in a popup
	910	window. Otherwise call IF-CONFIG-NOT-FOUND with BUFFER-OR-NAME if
	911	the value is a function. If IF-CONFIG-NOT-FOUND is nil,
	912	`popwin:popup-buffer' will be called. IF-BUFFER-NOT-FOUND
	913	indicates what happens when there is no such buffers. If the
	914	value is :create, create a new buffer named BUFFER-OR-NAME. If
	915	the value is :error, report an error. The default value
	916	is :create. DEFAULT-CONFIG-KEYWORDS is a property list which
	917	specifies default values of the config."
	918	(let* ((buffer (popwin:get-buffer buffer-or-name if-buffer-not-found))
	919	(pattern-and-keywords (popwin:match-config buffer)))
	920	(unless pattern-and-keywords
	921	(if if-config-not-found
	922	(return-from popwin:display-buffer-1
	923	(funcall if-config-not-found buffer))
	924	(setq pattern-and-keywords '(t))))
	925	(destructuring-bind (&key regexp width height position noselect dedicated stick tail)
	926	(append (cdr pattern-and-keywords) default-config-keywords)
	927	(popwin:popup-buffer buffer
	928	:width (or width popwin:popup-window-width)
	929	:height (or height popwin:popup-window-height)
	930	:position (or position popwin:popup-window-position)
	931	:noselect (or (popwin:minibuffer-window-selected-p) noselect)
	932	:dedicated dedicated
	933	:stick stick
	934	:tail tail))))
	935
	936	;;;###autoload
	937	(defun popwin:display-buffer (buffer-or-name &optional not-this-window)
	938	"Display BUFFER-OR-NAME, if possible, in a popup window, or as
	939	usual. This function can be used as a value of
	940	`display-buffer-function'."
	941	(interactive "BDisplay buffer:\n")
	942	(if (popwin:reuse-window-p buffer-or-name not-this-window)
	943	;; Call `display-buffer' for reuse.
	944	(popwin:original-display-buffer buffer-or-name not-this-window)
	945	(popwin:display-buffer-1
	946	buffer-or-name
	947	:if-config-not-found
	948	(unless (with-no-warnings
	949	;; FIXME: emacs bug?
	950	(called-interactively-p))
	951	(lambda (buffer)
	952	(popwin:original-display-buffer buffer not-this-window))))))
	953
	954	(defun popwin:special-display-popup-window (buffer &rest ignore)
	955	"Obsolete."
	956	(popwin:display-buffer-1 buffer))
	957
	958	(defun* popwin:pop-to-buffer-1 (buffer
	959	&key
	960	default-config-keywords
	961	other-window
	962	norecord)
	963	(popwin:display-buffer-1 buffer
	964	:default-config-keywords default-config-keywords
	965	:if-config-not-found
	966	(lambda (buffer)
	967	(pop-to-buffer buffer other-window norecord))))
	968
	969	;;;###autoload
	970	(defun popwin:pop-to-buffer (buffer &optional other-window norecord)
	971	"Same as `pop-to-buffer' except that this function will use
	972	`popwin:display-buffer-1' instead of `display-buffer'."
	973	(interactive (list (read-buffer "Pop to buffer: " (other-buffer))
	974	(if current-prefix-arg t)))
	975	(popwin:pop-to-buffer-1 buffer
	976	:other-window other-window
	977	:norecord norecord))
	978
	979
	980
	981	;;; Universal Display
	982
	983	(defcustom popwin:universal-display-config '(t)
	984	"Same as `popwin:special-display-config' except that this will
	985	be used for `popwin:universal-display'."
	986	:group 'popwin)
	987
	988	;;;###autoload
	989	(defun popwin:universal-display ()
	990	"Call the following command interactively with letting
	991	`popwin:special-display-config' be
	992	`popwin:universal-display-config'. This will be useful when
	993	displaying buffers in popup windows temporarily."
	994	(interactive)
	995	(let ((command (key-binding (read-key-sequence "" t)))
	996	(popwin:special-display-config popwin:universal-display-config))
	997	(call-interactively command)))
	998
	999
	1000
	1001	;;; Extensions
	1002
	1003	;;;###autoload
	1004	(defun popwin:one-window ()
	1005	"Delete other window than the popup window. C-g restores the
	1006	original window configuration."
	1007	(interactive)
	1008	(setq popwin:window-config (current-window-configuration))
	1009	(delete-other-windows))
	1010
	1011	;;;###autoload
	1012	(defun popwin:popup-buffer-tail (&rest same-as-popwin:popup-buffer)
	1013	"Same as `popwin:popup-buffer' except that the buffer will be
	1014	`recenter'ed at the bottom."
	1015	(interactive "bPopup buffer:\n")
	1016	(destructuring-bind (buffer . keyargs) same-as-popwin:popup-buffer
	1017	(apply 'popwin:popup-buffer buffer :tail t keyargs)))
	1018
	1019	;;;###autoload
	1020	(defun popwin:find-file (filename &optional wildcards)
	1021	"Edit file FILENAME with popup window by `popwin:popup-buffer'."
	1022	(interactive
	1023	(find-file-read-args "Find file in popup window: "
	1024	(when (fboundp 'confirm-nonexistent-file-or-buffer)
	1025	(confirm-nonexistent-file-or-buffer))))
	1026	(popwin:popup-buffer (find-file-noselect filename wildcards)))
	1027
	1028	;;;###autoload
	1029	(defun popwin:find-file-tail (file &optional wildcard)
	1030	"Edit file FILENAME with popup window by
	1031	`popwin:popup-buffer-tail'."
	1032	(interactive
	1033	(find-file-read-args "Find file in popup window: "
	1034	(when (fboundp 'confirm-nonexistent-file-or-buffer)
	1035	(confirm-nonexistent-file-or-buffer))))
	1036	(popwin:popup-buffer-tail (find-file-noselect file wildcard)))
	1037
	1038	;;;###autoload
	1039	(defun popwin:messages ()
	1040	"Display Messages buffer in a popup window."
	1041	(interactive)
	1042	(popwin:popup-buffer-tail "Messages"))
	1043
	1044
	1045
	1046	;;; Minor Mode
	1047
	1048	(defun popwin:display-buffer-condition (buffer action)
	1049	(and (popwin:match-config buffer) t))
	1050
	1051	(defun popwin:display-buffer-action (buffer alist)
	1052	(let ((not-this-window (plist-get 'inhibit-same-window alist)))
	1053	(popwin:display-buffer buffer not-this-window)))
	1054
	1055	(define-minor-mode popwin-mode
	1056	""
	1057	:init-value nil
	1058	:global t
	1059	(if (boundp 'display-buffer-alist)
	1060	(let ((pair '(popwin:display-buffer-condition popwin:display-buffer-action)))
	1061	(if popwin-mode
	1062	(push pair display-buffer-alist)
	1063	(setq display-buffer-alist (delete pair display-buffer-alist))))
	1064	(with-no-warnings
	1065	(unless (or (null display-buffer-function)
	1066	(eq display-buffer-function 'popwin:display-buffer))
	1067	(warn "Overwriting display-buffer-function variable to enable/disable popwin-mode"))
	1068	(setq display-buffer-function (if popwin-mode 'popwin:display-buffer nil)))))
	1069
	1070
	1071
	1072	;;; Keymaps
	1073
	1074	(defvar popwin:keymap
	1075	(let ((map (make-sparse-keymap)))
	1076	(define-key map "b" 'popwin:popup-buffer)
	1077	(define-key map "l" 'popwin:popup-last-buffer)
	1078	(define-key map "o" 'popwin:display-buffer)
	1079	(define-key map "\C-b" 'popwin:switch-to-last-buffer)
	1080	(define-key map "\C-p" 'popwin:original-pop-to-last-buffer)
	1081	(define-key map "\C-o" 'popwin:original-display-last-buffer)
	1082	(define-key map " " 'popwin:select-popup-window)
	1083	(define-key map "s" 'popwin:stick-popup-window)
	1084	(define-key map "0" 'popwin:close-popup-window)
	1085	(define-key map "f" 'popwin:find-file)
	1086	(define-key map "\C-f" 'popwin:find-file)
	1087	(define-key map "e" 'popwin:messages)
	1088	(define-key map "\C-u" 'popwin:universal-display)
	1089	(define-key map "1" 'popwin:one-window)
	1090
	1091	map)
	1092	"Default keymap for popwin commands. Use like:
	1093	$global-set-key (kbd \"C-z\") popwin:keymap$
	1094
	1095	Keymap:
	1096
	1097	\| Key \| Command \|
	1098	\|--------+---------------------------------------\|
	1099	\| b \| popwin:popup-buffer \|
	1100	\| l \| popwin:popup-last-buffer \|
	1101	\| o \| popwin:display-buffer \|
	1102	\| C-b \| popwin:switch-to-last-buffer \|
	1103	\| C-p \| popwin:original-pop-to-last-buffer \|
	1104	\| C-o \| popwin:original-display-last-buffer \|
	1105	\| SPC \| popwin:select-popup-window \|
	1106	\| s \| popwin:stick-popup-window \|
	1107	\| 0 \| popwin:close-popup-window \|
	1108	\| f, C-f \| popwin:find-file \|
	1109	\| e \| popwin:messages \|
	1110	\| C-u \| popwin:universal-display \|
	1111	\| 1 \| popwin:one-window \|")
	1112
	1113	(provide 'popwin)
	1114	;;; popwin.el ends here