-
Notifications
You must be signed in to change notification settings - Fork 0
/
ace-window-0.10.0.tar
1177 lines (1025 loc) · 60 KB
/
ace-window-0.10.0.tar
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
ace-window-0.10.0/ 0000775 0001750 0001750 00000000000 14051364137 012321 5 ustar kimr kimr ace-window-0.10.0/ace-window-pkg.el 0000664 0001750 0001750 00000000531 14051364137 015456 0 ustar kimr kimr ;; Generated package description from ace-window.el -*- no-byte-compile: t -*-
(define-package "ace-window" "0.10.0" "Quickly switch windows." '((avy "0.5.0")) :authors '(("Oleh Krehel" . "[email protected]")) :maintainer '("Oleh Krehel" . "[email protected]") :keywords '("window" "location") :url "https://github.com/abo-abo/ace-window")
ace-window-0.10.0/ace-window.el 0000664 0001750 0001750 00000104261 14051364137 014704 0 ustar kimr kimr ;;; ace-window.el --- Quickly switch windows. -*- lexical-binding: t -*-
;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
;; Author: Oleh Krehel <[email protected]>
;; Maintainer: Oleh Krehel <[email protected]>
;; URL: https://github.com/abo-abo/ace-window
;; Version: 0.10.0
;; Package-Requires: ((avy "0.5.0"))
;; Keywords: window, location
;; This file is part of GNU Emacs.
;; This file 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, 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.
;; For a full copy of the GNU General Public License
;; see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;; The main function, `ace-window' is meant to replace `other-window'
;; by assigning each window a short, unique label. When there are only
;; two windows present, `other-window' is called (unless
;; aw-dispatch-always is set non-nil). If there are more, each
;; window will have its first label character highlighted. Once a
;; unique label is typed, ace-window will switch to that window.
;;
;; To setup this package, just add to your .emacs:
;;
;; (global-set-key (kbd "M-o") 'ace-window)
;;
;; replacing "M-o" with an appropriate shortcut.
;;
;; By default, ace-window uses numbers for window labels so the window
;; labeling is intuitively ordered. But if you prefer to type keys on
;; your home row for quicker access, use this setting:
;;
;; (setq aw-keys '(?a ?s ?d ?f ?g ?h ?j ?k ?l))
;;
;; Whenever ace-window prompts for a window selection, it grays out
;; all the window characters, highlighting window labels in red. To
;; disable this behavior, set this:
;;
;; (setq aw-background nil)
;;
;; If you want to know the selection characters ahead of time, turn on
;; `ace-window-display-mode'.
;;
;; When prefixed with one `universal-argument', instead of switching
;; to the selected window, the selected window is swapped with the
;; current one.
;;
;; When prefixed with two `universal-argument', the selected window is
;; deleted instead.
;;; Code:
(require 'avy)
(require 'ring)
(require 'subr-x)
;;* Customization
(defgroup ace-window nil
"Quickly switch current window."
:group 'convenience
:prefix "aw-")
(defcustom aw-keys '(?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)
"Keys for selecting window."
:type '(repeat character))
(defcustom aw-scope 'global
"The scope used by `ace-window'."
:type '(choice
(const :tag "visible frames" visible)
(const :tag "global" global)
(const :tag "frame" frame)))
(defcustom aw-translate-char-function #'identity
"Function to translate user input key into another key.
For example, to make SPC do the same as ?a, use
\(lambda (c) (if (= c 32) ?a c))."
:type '(choice
(const :tag "Off" #'identity)
(const :tag "Ignore Case" #'downcase)
(function :tag "Custom")))
(defcustom aw-minibuffer-flag nil
"When non-nil, also display `ace-window-mode' string in the minibuffer when ace-window is active."
:type 'boolean)
(defcustom aw-ignored-buffers '("*Calc Trail*" " *LV*")
"List of buffers and major-modes to ignore when choosing a window from the window list.
Active only when `aw-ignore-on' is non-nil."
:type '(repeat string))
(defcustom aw-ignore-on t
"When t, `ace-window' will ignore buffers and major-modes in `aw-ignored-buffers'.
Use M-0 `ace-window' to toggle this value."
:type 'boolean)
(defcustom aw-ignore-current nil
"When t, `ace-window' will ignore `selected-window'."
:type 'boolean)
(defcustom aw-background t
"When t, `ace-window' will dim out all buffers temporarily when used."
:type 'boolean)
(defcustom aw-leading-char-style 'char
"Style of the leading char overlay."
:type '(choice
(const :tag "single char" 'char)
(const :tag "full path" 'path)))
(defcustom aw-dispatch-always nil
"When non-nil, `ace-window' will issue a `read-char' even for one window.
This will make `ace-window' act different from `other-window' for
one or two windows."
:type 'boolean)
(defcustom aw-dispatch-when-more-than 2
"If the number of windows is more than this, activate ace-window-ness."
:type 'integer)
(defcustom aw-reverse-frame-list nil
"When non-nil `ace-window' will order frames for selection in
the reverse of `frame-list'"
:type 'boolean)
(defcustom aw-frame-offset '(13 . 23)
"Increase in pixel offset for new ace-window frames relative to the selected frame.
Its value is an (x-offset . y-offset) pair in pixels."
:type '(cons integer integer))
(defcustom aw-frame-size nil
"Frame size to make new ace-window frames.
Its value is a (width . height) pair in pixels or nil for the default frame size.
(0 . 0) is special and means make the frame size the same as the last selected frame size."
:type '(cons integer integer))
(defcustom aw-char-position 'top-left
"Window positions of the character overlay.
Consider changing this if the overlay tends to overlap with other things."
:type '(choice
(const :tag "top left corner only" 'top-left)
(const :tag "both left corners" 'left)))
;; Must be defined before `aw-make-frame-char' since its :set function references this.
(defvar aw-dispatch-alist
'((?x aw-delete-window "Delete Window")
(?m aw-swap-window "Swap Windows")
(?M aw-move-window "Move Window")
(?c aw-copy-window "Copy Window")
(?j aw-switch-buffer-in-window "Select Buffer")
(?n aw-flip-window)
(?u aw-switch-buffer-other-window "Switch Buffer Other Window")
(?e aw-execute-command-other-window "Execute Command Other Window")
(?F aw-split-window-fair "Split Fair Window")
(?v aw-split-window-vert "Split Vert Window")
(?b aw-split-window-horz "Split Horz Window")
(?o delete-other-windows "Delete Other Windows")
(?T aw-transpose-frame "Transpose Frame")
;; ?i ?r ?t are used by hyperbole.el
(?? aw-show-dispatch-help))
"List of actions for `aw-dispatch-default'.
Each action is a list of either:
(char function description) where function takes a single window argument
or
(char function) where function takes no argument and the description is omitted.")
(defun aw-set-make-frame-char (option value)
;; Signal an error if `aw-make-frame-char' is ever set to an invalid
;; or conflicting value.
(when value
(cond ((not (characterp value))
(user-error "`aw-make-frame-char' must be a character, not `%s'" value))
((memq value aw-keys)
(user-error "`aw-make-frame-char' is `%c'; this conflicts with the same character in `aw-keys'" value))
((assq value aw-dispatch-alist)
(user-error "`aw-make-frame-char' is `%c'; this conflicts with the same character in `aw-dispatch-alist'" value))))
(set option value))
(defcustom aw-make-frame-char ?z
"Non-existing ace window label character that triggers creation of a new single-window frame for display."
:set 'aw-set-make-frame-char
:type 'character)
(defface aw-leading-char-face
'((((class color)) (:foreground "red"))
(((background dark)) (:foreground "gray100"))
(((background light)) (:foreground "gray0"))
(t (:foreground "gray100" :underline nil)))
"Face for each window's leading char.")
(defface aw-minibuffer-leading-char-face
'((t :inherit aw-leading-char-face))
"Face for minibuffer leading char.")
(defface aw-background-face
'((t (:foreground "gray40")))
"Face for whole window background during selection.")
(defface aw-mode-line-face
'((t (:inherit mode-line-buffer-id)))
"Face used for displaying the ace window key in the mode-line.")
(defface aw-key-face
'((t :inherit font-lock-builtin-face))
"Face used by `aw-show-dispatch-help'.")
;;* Implementation
(defun aw-ignored-p (window)
"Return t if WINDOW should be ignored when choosing from the window list."
(or (and aw-ignore-on
;; Ignore major-modes and buffer-names in `aw-ignored-buffers'.
(or (memq (buffer-local-value 'major-mode (window-buffer window))
aw-ignored-buffers)
(member (buffer-name (window-buffer window)) aw-ignored-buffers)))
;; ignore child frames
(and (fboundp 'frame-parent) (frame-parent (window-frame window)))
;; Ignore selected window if `aw-ignore-current' is non-nil.
(and aw-ignore-current
(equal window (selected-window)))
;; When `ignore-window-parameters' is nil, ignore windows whose
;; `no-other-window’ or `no-delete-other-windows' parameter is non-nil.
(unless ignore-window-parameters
(cl-case this-command
(ace-select-window (window-parameter window 'no-other-window))
(ace-delete-window (window-parameter window 'no-delete-other-windows))
(ace-delete-other-windows (window-parameter
window 'no-delete-other-windows))))))
(defun aw-window-list ()
"Return the list of interesting windows."
(sort
(cl-remove-if
(lambda (w)
(let ((f (window-frame w)))
(or (not (and (frame-live-p f)
(frame-visible-p f)))
(string= "initial_terminal" (terminal-name f))
(aw-ignored-p w))))
(cl-case aw-scope
(visible
(cl-mapcan #'window-list (visible-frame-list)))
(global
(cl-mapcan #'window-list (frame-list)))
(frame
(window-list))
(t
(error "Invalid `aw-scope': %S" aw-scope))))
'aw-window<))
(defvar aw-overlays-back nil
"Hold overlays for when `aw-background' is t.")
(defvar ace-window-mode nil
"Minor mode during the selection process.")
;; register minor mode
(or (assq 'ace-window-mode minor-mode-alist)
(nconc minor-mode-alist
(list '(ace-window-mode ace-window-mode))))
(defvar aw-empty-buffers-list nil
"Store the read-only empty buffers which had to be modified.
Modify them back eventually.")
(defvar aw--windows-hscroll nil
"List of (window . hscroll-columns) items, each listing a window whose
horizontal scroll will be restored upon ace-window action completion.")
(defvar aw--windows-points nil
"List of (window . point) items. The point position had to be
moved in order to display the overlay.")
(defun aw--done ()
"Clean up mode line and overlays."
;; mode line
(aw-set-mode-line nil)
;; background
(mapc #'delete-overlay aw-overlays-back)
(setq aw-overlays-back nil)
(avy--remove-leading-chars)
(dolist (b aw-empty-buffers-list)
(with-current-buffer b
(when (string= (buffer-string) " ")
(let ((inhibit-read-only t))
(delete-region (point-min) (point-max))))))
(setq aw-empty-buffers-list nil)
(aw--restore-windows-hscroll)
(let (c)
(while (setq c (pop aw--windows-points))
(with-selected-window (car c)
(goto-char (cdr c))))))
(defun aw--restore-windows-hscroll ()
"Restore horizontal scroll of windows from `aw--windows-hscroll' list."
(let (wnd hscroll)
(mapc (lambda (wnd-and-hscroll)
(setq wnd (car wnd-and-hscroll)
hscroll (cdr wnd-and-hscroll))
(when (window-live-p wnd)
(set-window-hscroll wnd hscroll)))
aw--windows-hscroll))
(setq aw--windows-hscroll nil))
(defun aw--overlay-str (wnd pos path)
"Return the replacement text for an overlay in WND at POS,
accessible by typing PATH."
(let ((old-str (or
(ignore-errors
(with-selected-window wnd
(buffer-substring pos (1+ pos))))
"")))
(concat
(cl-case aw-leading-char-style
(char
(string (avy--key-to-char (car (last path)))))
(path
(mapconcat
(lambda (x) (string (avy--key-to-char x)))
(reverse path)
""))
(t
(error "Bad `aw-leading-char-style': %S"
aw-leading-char-style)))
(cond ((string-equal old-str "\t")
(make-string (1- tab-width) ?\ ))
((string-equal old-str "\n")
"\n")
(t
(make-string
(max 0 (1- (string-width old-str)))
?\ ))))))
(defun aw--point-visible-p ()
"Return non-nil if point is visible in the selected window.
Return nil when horizontal scrolling has moved it off screen."
(and (>= (- (current-column) (window-hscroll)) 0)
(< (- (current-column) (window-hscroll))
(window-width))))
(defun aw--lead-overlay (path leaf)
"Create an overlay using PATH at LEAF.
LEAF is (PT . WND)."
;; Properly adds overlay in visible region of most windows except for any one
;; receiving output while this function is executing, since that moves point,
;; potentially shifting the added overlay outside the window's visible region.
(let ((wnd (cdr leaf))
;; Prevent temporary movement of point from scrolling any window.
(scroll-margin 0))
(with-selected-window wnd
(when (= 0 (buffer-size))
(push (current-buffer) aw-empty-buffers-list)
(let ((inhibit-read-only t))
(insert " ")))
;; If point is not visible due to horizontal scrolling of the
;; window, this next expression temporarily scrolls the window
;; right until point is visible, so that the leading-char can be
;; seen when it is inserted. When ace-window's action finishes,
;; the horizontal scroll is restored by (aw--done).
(while (and (not (aw--point-visible-p))
(not (zerop (window-hscroll)))
(progn (push (cons (selected-window) (window-hscroll)) aw--windows-hscroll) t)
(not (zerop (scroll-right)))))
(let* ((ws (window-start))
(prev nil)
(vertical-pos (if (eq aw-char-position 'left) -1 0))
(horizontal-pos (if (zerop (window-hscroll)) 0 (1+ (window-hscroll))))
(old-pt (point))
(pt
(progn
;; If leading-char is to be displayed at the top-left, move
;; to the first visible line in the window, otherwise, move
;; to the last visible line.
(move-to-window-line vertical-pos)
(move-to-column horizontal-pos)
;; Find a nearby point that is not at the end-of-line but
;; is visible so have space for the overlay.
(setq prev (1- (point)))
(while (and (>= prev ws) (/= prev (point)) (eolp))
(setq prev (point))
(unless (bobp)
(line-move -1 t)
(move-to-column horizontal-pos)))
(recenter vertical-pos)
(point)))
(ol (make-overlay pt (1+ pt) (window-buffer wnd))))
(if (= (aw--face-rel-height) 1)
(goto-char old-pt)
(when (/= pt old-pt)
(goto-char (+ pt 1))
(push (cons wnd old-pt) aw--windows-points)))
(overlay-put ol 'display (aw--overlay-str wnd pt path))
(if (window-minibuffer-p wnd)
(overlay-put ol 'face 'aw-minibuffer-leading-char-face)
(overlay-put ol 'face 'aw-leading-char-face))
(overlay-put ol 'window wnd)
(push ol avy--overlays-lead)))))
(defun aw--make-backgrounds (wnd-list)
"Create a dim background overlay for each window on WND-LIST."
(when aw-background
(setq aw-overlays-back
(mapcar (lambda (w)
(let ((ol (make-overlay
(window-start w)
(window-end w)
(window-buffer w))))
(overlay-put ol 'face 'aw-background-face)
ol))
wnd-list))))
(defvar aw-dispatch-function 'aw-dispatch-default
"Function to call when a character not in `aw-keys' is pressed.")
(defvar aw-action nil
"Function to call at the end of `aw-select'.")
(defun aw-set-mode-line (str)
"Set mode line indicator to STR."
(setq ace-window-mode str)
(when (and aw-minibuffer-flag ace-window-mode)
(message "%s" (string-trim-left str)))
(force-mode-line-update))
(defun aw--dispatch-action (char)
"Return item from `aw-dispatch-alist' matching CHAR."
(assoc char aw-dispatch-alist))
(defun aw-make-frame ()
"Make a new Emacs frame using the values of `aw-frame-size' and `aw-frame-offset'."
(make-frame
(delq nil
(list
;; This first parameter is important because an
;; aw-dispatch-alist command may not want to leave this
;; frame with input focus. If it is given focus, the
;; command may not be able to return focus to a different
;; frame since this is done asynchronously by the window
;; manager.
'(no-focus-on-map . t)
(when aw-frame-size
(cons 'width
(if (zerop (car aw-frame-size))
(frame-width)
(car aw-frame-size))))
(when aw-frame-size
(cons 'height
(if (zerop (cdr aw-frame-size))
(frame-height)
(car aw-frame-size))))
(cons 'left (+ (car aw-frame-offset)
(car (frame-position))))
(cons 'top (+ (cdr aw-frame-offset)
(cdr (frame-position))))))))
(defun aw-use-frame (window)
"Create a new frame using the contents of WINDOW.
The new frame is set to the same size as the previous frame, offset by
`aw-frame-offset' (x . y) pixels."
(aw-switch-to-window window)
(aw-make-frame))
(defun aw-clean-up-avy-current-path ()
"Edit `avy-current-path' so only window label characters remain."
;; Remove any possible ace-window command char that may
;; precede the last specified window label, so
;; functions can use `avy-current-path' as the chosen
;; window label.
(when (and (> (length avy-current-path) 0)
(assq (aref avy-current-path 0) aw-dispatch-alist))
(setq avy-current-path (substring avy-current-path 1))))
(defun aw-dispatch-default (char)
"Perform an action depending on CHAR."
(cond ((and (fboundp 'avy-mouse-event-window)
(avy-mouse-event-window char)))
((= char (aref (kbd "C-g") 0))
(throw 'done 'exit))
((and aw-make-frame-char (= char aw-make-frame-char))
;; Make a new frame and perform any action on its window.
(let ((start-win (selected-window))
(end-win (frame-selected-window (aw-make-frame))))
(if aw-action
;; Action must be called from the start-win. The action
;; determines which window to leave selected.
(progn (select-frame-set-input-focus (window-frame start-win))
(funcall aw-action end-win))
;; Select end-win when no action
(aw-switch-to-window end-win)))
(throw 'done 'exit))
(t
(let ((action (aw--dispatch-action char)))
(if action
(cl-destructuring-bind (_key fn &optional description) action
(if (and fn description)
(prog1 (setq aw-action fn)
(aw-set-mode-line (format " Ace - %s" description)))
(if (commandp fn)
(call-interactively fn)
(funcall fn))
(throw 'done 'exit)))
(aw-clean-up-avy-current-path)
;; Prevent any char from triggering an avy dispatch command.
(let ((avy-dispatch-alist))
(avy-handler-default char)))))))
(defcustom aw-display-mode-overlay t
"When nil, don't display overlays. Rely on the mode line instead."
:type 'boolean)
(defvar ace-window-display-mode)
(defun aw-select (mode-line &optional action)
"Return a selected other window.
Amend MODE-LINE to the mode line for the duration of the selection."
(setq aw-action action)
(let ((start-window (selected-window))
(next-window-scope (cl-case aw-scope
('visible 'visible)
('global 'visible)
('frame 'frame)))
(wnd-list (aw-window-list))
window)
(setq window
(cond ((<= (length wnd-list) 1)
(when aw-dispatch-always
(setq aw-action
(unwind-protect
(catch 'done
(funcall aw-dispatch-function (read-char)))
(aw--done)))
(when (eq aw-action 'exit)
(setq aw-action nil)))
(or (car wnd-list) start-window))
((and (<= (+ (length wnd-list) (if (aw-ignored-p start-window) 1 0))
aw-dispatch-when-more-than)
(not aw-dispatch-always)
(not aw-ignore-current))
(let ((wnd (next-window nil nil next-window-scope)))
(while (and (or (not (memq wnd wnd-list))
(aw-ignored-p wnd))
(not (equal wnd start-window)))
(setq wnd (next-window wnd nil next-window-scope)))
wnd))
(t
(let ((candidate-list
(mapcar (lambda (wnd)
(cons (aw-offset wnd) wnd))
wnd-list)))
(aw--make-backgrounds wnd-list)
(aw-set-mode-line mode-line)
;; turn off helm transient map
(remove-hook 'post-command-hook 'helm--maybe-update-keymap)
(unwind-protect
(let* ((avy-handler-function aw-dispatch-function)
(avy-translate-char-function aw-translate-char-function)
(transient-mark-mode nil)
(res (avy-read (avy-tree candidate-list aw-keys)
(if (and ace-window-display-mode
(null aw-display-mode-overlay))
(lambda (_path _leaf))
#'aw--lead-overlay)
#'avy--remove-leading-chars)))
(if (eq res 'exit)
(setq aw-action nil)
(or (cdr res)
start-window)))
(aw--done))))))
(if aw-action
(funcall aw-action window)
window)))
;;* Interactive
;;;###autoload
(defun ace-select-window ()
"Ace select window."
(interactive)
(aw-select " Ace - Window"
#'aw-switch-to-window))
;;;###autoload
(defun ace-delete-window ()
"Ace delete window."
(interactive)
(aw-select " Ace - Delete Window"
#'aw-delete-window))
;;;###autoload
(defun ace-swap-window ()
"Ace swap window."
(interactive)
(aw-select " Ace - Swap Window"
#'aw-swap-window))
;;;###autoload
(defun ace-delete-other-windows ()
"Ace delete other windows."
(interactive)
(aw-select " Ace - Delete Other Windows"
#'delete-other-windows))
;;;###autoload
(defun ace-display-buffer (buffer alist)
"Make `display-buffer' and `pop-to-buffer' select using `ace-window'.
See sample config for `display-buffer-base-action' and `display-buffer-alist':
https://github.com/abo-abo/ace-window/wiki/display-buffer."
(let* ((aw-ignore-current (cdr (assq 'inhibit-same-window alist)))
(rf (cdr (assq 'reusable-frames alist)))
(aw-scope (cl-case rf
((nil) 'frame)
(visible 'visible)
((0 t) 'global))))
(unless (or (<= (length (aw-window-list)) 1)
(not aw-scope))
(window--display-buffer
buffer (aw-select "Ace - Display Buffer") 'reuse))))
(declare-function transpose-frame "ext:transpose-frame")
(defun aw-transpose-frame (w)
"Select any window on frame and `tranpose-frame'."
(transpose-frame (window-frame w)))
;;;###autoload
(defun ace-window (arg)
"Select a window.
Perform an action based on ARG described below.
By default, behaves like extended `other-window'.
See `aw-scope' which extends it to work with frames.
Prefixed with one \\[universal-argument], does a swap between the
selected window and the current window, so that the selected
buffer moves to current window (and current buffer moves to
selected window).
Prefixed with two \\[universal-argument]'s, deletes the selected
window."
(interactive "p")
(setq avy-current-path "")
(cl-case arg
(0
(let ((aw-ignore-on (not aw-ignore-on)))
(ace-select-window)))
(4 (ace-swap-window))
(16 (ace-delete-window))
(t (ace-select-window))))
;;* Utility
(unless (fboundp 'frame-position)
(defun frame-position (&optional frame)
(let ((pl (frame-parameter frame 'left))
(pt (frame-parameter frame 'top)))
(when (consp pl)
(setq pl (eval pl)))
(when (consp pt)
(setq pt (eval pt)))
(cons pl pt))))
(defun aw-window< (wnd1 wnd2)
"Return true if WND1 is less than WND2.
This is determined by their respective window coordinates.
Windows are numbered top down, left to right."
(let* ((f1 (window-frame wnd1))
(f2 (window-frame wnd2))
(e1 (window-edges wnd1))
(e2 (window-edges wnd2))
(p1 (frame-position f1))
(p2 (frame-position f2))
(nl (or (null (car p1)) (null (car p2)))))
(cond ((and (not nl) (< (car p1) (car p2)))
(not aw-reverse-frame-list))
((and (not nl) (> (car p1) (car p2)))
aw-reverse-frame-list)
((< (car e1) (car e2))
t)
((> (car e1) (car e2))
nil)
((< (cadr e1) (cadr e2))
t))))
(defvar aw--window-ring (make-ring 10)
"Hold the window switching history.")
(defun aw--push-window (window)
"Store WINDOW to `aw--window-ring'."
(when (or (zerop (ring-length aw--window-ring))
(not (equal
(ring-ref aw--window-ring 0)
window)))
(ring-insert aw--window-ring (selected-window))))
(defun aw--pop-window ()
"Return the removed top of `aw--window-ring'."
(let (res)
(condition-case nil
(while (or (not (window-live-p
(setq res (ring-remove aw--window-ring 0))))
(equal res (selected-window))))
(error
(if (= (length (aw-window-list)) 2)
(progn
(other-window 1)
(setq res (selected-window)))
(error "No previous windows stored"))))
res))
(defun aw-switch-to-window (window)
"Switch to the window WINDOW."
(let ((frame (window-frame window)))
(aw--push-window (selected-window))
(when (and (frame-live-p frame)
(not (eq frame (selected-frame))))
(select-frame-set-input-focus frame))
(if (window-live-p window)
(select-window window)
(error "Got a dead window %S" window))))
(defun aw-flip-window ()
"Switch to the window you were previously in."
(interactive)
(aw-switch-to-window (aw--pop-window)))
(defun aw-show-dispatch-help ()
"Display action shortucts in echo area."
(interactive)
(message "%s" (mapconcat
(lambda (action)
(cl-destructuring-bind (key fn &optional description) action
(format "%s: %s"
(propertize
(char-to-string key)
'face 'aw-key-face)
(or description fn))))
aw-dispatch-alist
"\n"))
;; Prevent this from replacing any help display
;; in the minibuffer.
(let (aw-minibuffer-flag)
(mapc #'delete-overlay aw-overlays-back)
(call-interactively 'ace-window)))
(defun aw-delete-window (window &optional kill-buffer)
"Delete window WINDOW.
When KILL-BUFFER is non-nil, also kill the buffer."
(let ((frame (window-frame window)))
(when (and (frame-live-p frame)
(not (eq frame (selected-frame))))
(select-frame-set-input-focus (window-frame window)))
(if (= 1 (length (window-list)))
(delete-frame frame)
(if (window-live-p window)
(let ((buffer (window-buffer window)))
(delete-window window)
(when kill-buffer
(kill-buffer buffer)))
(error "Got a dead window %S" window)))))
(defun aw-switch-buffer-in-window (window)
"Select buffer in WINDOW."
(aw-switch-to-window window)
(aw--switch-buffer))
(declare-function ivy-switch-buffer "ext:ivy")
(defun aw--switch-buffer ()
(cond ((bound-and-true-p ivy-mode)
(ivy-switch-buffer))
((bound-and-true-p ido-mode)
(ido-switch-buffer))
(t
(call-interactively 'switch-to-buffer))))
(defcustom aw-swap-invert nil
"When non-nil, the other of the two swapped windows gets the point."
:type 'boolean)
(defun aw-swap-window (window)
"Swap buffers of current window and WINDOW."
(cl-labels ((swap-windows (window1 window2)
"Swap the buffers of WINDOW1 and WINDOW2."
(let ((buffer1 (window-buffer window1))
(buffer2 (window-buffer window2)))
(set-window-buffer window1 buffer2)
(set-window-buffer window2 buffer1)
(select-window window2))))
(let ((frame (window-frame window))
(this-window (selected-window)))
(when (and (frame-live-p frame)
(not (eq frame (selected-frame))))
(select-frame-set-input-focus (window-frame window)))
(when (and (window-live-p window)
(not (eq window this-window)))
(aw--push-window this-window)
(if aw-swap-invert
(swap-windows window this-window)
(swap-windows this-window window))))))
(defun aw-move-window (window)
"Move the current buffer to WINDOW.
Switch the current window to the previous buffer."
(let ((buffer (current-buffer)))
(switch-to-buffer (other-buffer))
(aw-switch-to-window window)
(switch-to-buffer buffer)))
(defun aw-copy-window (window)
"Copy the current buffer to WINDOW."
(let ((buffer (current-buffer)))
(aw-switch-to-window window)
(switch-to-buffer buffer)))
(defun aw-split-window-vert (window)
"Split WINDOW vertically."
(select-window window)
(split-window-vertically))
(defun aw-split-window-horz (window)
"Split WINDOW horizontally."
(select-window window)
(split-window-horizontally))
(defcustom aw-fair-aspect-ratio 2
"The aspect ratio to aim for when splitting windows.
Sizes are based on the number of characters, not pixels.
Increase to prefer wider windows, or decrease for taller windows."
:type 'number)
(defun aw-split-window-fair (window)
"Split WINDOW vertically or horizontally, based on its current dimensions.
Modify `aw-fair-aspect-ratio' to tweak behavior."
(let ((w (window-body-width window))
(h (window-body-height window)))
(if (< (* h aw-fair-aspect-ratio) w)
(aw-split-window-horz window)
(aw-split-window-vert window))))
(defun aw-switch-buffer-other-window (window)
"Switch buffer in WINDOW."
(aw-switch-to-window window)
(unwind-protect
(aw--switch-buffer)
(aw-flip-window)))
(defun aw-execute-command-other-window (window)
"Execute a command in WINDOW."
(aw-switch-to-window window)
(unwind-protect
(funcall
(key-binding
(read-key-sequence
"Enter key sequence: ")))
(aw-flip-window)))
(defun aw--face-rel-height ()
(let ((h (face-attribute 'aw-leading-char-face :height)))
(cond
((eq h 'unspecified)
1)
((floatp h)
(max (floor h) 1))
((integerp h)
1)
(t
(error "unexpected: %s" h)))))
(defun aw-offset (window)
"Return point in WINDOW that's closest to top left corner.
The point is writable, i.e. it's not part of space after newline."
(let ((h (window-hscroll window))
(beg (window-start window))
(end (window-end window))
(inhibit-field-text-motion t))
(with-current-buffer (window-buffer window)
(save-excursion
(goto-char beg)
(forward-line (1-
(min
(count-lines
(point)
(point-max))
(aw--face-rel-height))))
(while (and (< (point) end)
(< (- (line-end-position)
(line-beginning-position))
h))
(forward-line))
(+ (point) h)))))
(defun aw--after-make-frame (f)
(aw-update)
(make-frame-visible f))
;;* Mode line
;;;###autoload
(define-minor-mode ace-window-display-mode
"Minor mode for showing the ace window key in the mode line."
:global t
(if ace-window-display-mode
(progn
(aw-update)
(set-default
'mode-line-format
`((ace-window-display-mode
(:eval (window-parameter (selected-window) 'ace-window-path)))
,@(assq-delete-all
'ace-window-display-mode
(default-value 'mode-line-format))))
(force-mode-line-update t)
(add-hook 'window-configuration-change-hook 'aw-update)
;; Add at the end so does not precede select-frame call.
(add-hook 'after-make-frame-functions #'aw--after-make-frame t))
(set-default
'mode-line-format
(assq-delete-all
'ace-window-display-mode
(default-value 'mode-line-format)))
(remove-hook 'window-configuration-change-hook 'aw-update)
(remove-hook 'after-make-frame-functions 'aw--after-make-frame)))
(defun aw-update ()
"Update ace-window-path window parameter for all windows.
Ensure all windows are labeled so the user can select a specific
one, even from the set of windows typically ignored when making a
window list."
(let ((aw-ignore-on)
(aw-ignore-current)
(ignore-window-parameters t))
(avy-traverse
(avy-tree (aw-window-list) aw-keys)
(lambda (path leaf)
(set-window-parameter
leaf 'ace-window-path
(propertize
(apply #'string (reverse path))
'face 'aw-mode-line-face))))))
(provide 'ace-window)
;;; ace-window.el ends here
ace-window-0.10.0/.github/ 0000775 0001750 0001750 00000000000 14050755630 013662 5 ustar kimr kimr ace-window-0.10.0/.github/FUNDING.yml 0000664 0001750 0001750 00000000044 14050755630 015475 0 ustar kimr kimr liberapay: abo-abo
patreon: abo_abo
ace-window-0.10.0/test/ 0000775 0001750 0001750 00000000000 14051364137 013300 5 ustar kimr kimr ace-window-0.10.0/test/make-compile.el 0000664 0001750 0001750 00000000153 14050755630 016165 0 ustar kimr kimr (setq files '("ace-window.el"))
(setq byte-compile--use-old-handlers nil)
(mapc #'byte-compile-file files)
ace-window-0.10.0/test/elpa.el 0000664 0001750 0001750 00000000232 14050755630 014541 0 ustar kimr kimr (setq package-user-dir
(expand-file-name (format "~/.elpa/%s/elpa" emacs-version)))
(package-initialize)
(add-to-list 'load-path default-directory)
ace-window-0.10.0/test/make-plain.el 0000664 0001750 0001750 00000000077 14050755630 015645 0 ustar kimr kimr (require 'ace-window)
(global-set-key (kbd "M-o") 'ace-window)
ace-window-0.10.0/test/make-update.el 0000664 0001750 0001750 00000001431 14050755630 016017 0 ustar kimr kimr ;;* list of the all dependencies
(defvar dev-packages '(avy))
;;* initialize package.el
(setq package-user-dir
(expand-file-name (format "~/.elpa/%s/elpa" emacs-version)))
(message "installing in %s ...\n" package-user-dir)
(package-initialize)
(setq package-archives
'(("melpa" . "https://melpa.org/packages/")
("gnu" . "http://elpa.gnu.org/packages/")))
(package-refresh-contents)
;;* install dependencies
(dolist (package dev-packages)
(unless (package-installed-p package)
(ignore-errors
(package-install package))))
;;* upgrade dependencies
(save-window-excursion
(package-list-packages t)
(condition-case nil
(progn
(package-menu-mark-upgrades)
(package-menu-execute t))
(error
(message "All packages up to date"))))
ace-window-0.10.0/README.md 0000664 0001750 0001750 00000014534 14050755630 013610 0 ustar kimr kimr # ace-window
[](https://melpa.org/#/ace-window)
[](https://stable.melpa.org/#/ace-window)
**GNU Emacs package for selecting a window to switch to**