forked from emacsorphanage/popwin
-
Notifications
You must be signed in to change notification settings - Fork 0
/
popwin.el
1116 lines (979 loc) · 43.3 KB
/
popwin.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
;;; popwin.el --- Popup Window Manager.
;; Copyright (C) 2011-2015 Tomohiro Matsuyama
;; Author: Tomohiro Matsuyama <[email protected]>
;; Keywords: convenience
;; 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-lib))
(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)
"Not documented (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-OR-NAME be displayed in the \
selected window. NORECORD is the same as `switch-to-buffer' NORECORD."
(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' (WINDOW) with saving the current buffer.
NORECORD is the same as `switch-to-buffer' NORECORD."
(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 ()
"Not documented."
(if (buffer-live-p popwin:dummy-buffer)
popwin:dummy-buffer
(setq popwin:dummy-buffer (get-buffer-create " *popwin-dummy*"))))
(defun popwin:kill-dummy-buffer ()
"Not documented."
(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)
"Not documented (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."
:type 'symbol
: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 ()
"Not documented."
(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 ()
"Not documented."
(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 ()
"Not documented."
(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 (BUFFER) (IGNORE)."
(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'. BUFFER,
OTHER-WINDOW amd NORECORD are the same arguments."
(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'."
:type 'list
: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)))