mirror of https://github.com/Chizi123/.emacs.d.git

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