[elpa] master e03ceb9 30/68: ace-window.el: remove aw-generic macro

[Oleh Krehel]

branch: master
commit e03ceb9c7ed4db45c1d9e48490554761c7971f3c
Author: Oleh Krehel <address@hidden>
Commit: Oleh Krehel <address@hidden>

    ace-window.el: remove aw-generic macro
    
    * ace-window.el (aw--current-op): New var.
      (aw--callback): New command, replaces "...-wrapper" from `aw-generic'.
      (aw--doit): New function, replaces the other part of `aw-generic'.
      (ace-select-window): Update.
      (ace-delete-window): Update.
      (ace-swap-window): Update.
      (aw-switch-to-window): Now expects only an aj-data structure.
      (aw-delete-window): Now expects only an aj-data structure. Will
      `delete-frame' when there's only one window if frame.
      (aw-swap-window): Now expects only an aj-data structure.
---
 ace-window.el |  351 ++++++++++++++++++++++++++++-----------------------------
 1 files changed, 170 insertions(+), 181 deletions(-)

diff --git a/ace-window.el b/ace-window.el
index 3d0c38f..2cc0f84 100644
--- a/ace-window.el
+++ b/ace-window.el
@@ -89,7 +89,6 @@ Use M-0 `ace-window' to toggle this value."
        (member (buffer-name (window-buffer window))
                aw-ignored-buffers)))
 
-;;;###autoload
 (defun aw-list-visual-area ()
   "Forward to `ace-jump-list-visual-area', removing invisible frames."
   (cl-remove-if
@@ -101,153 +100,150 @@ Use M-0 `ace-window' to toggle this value."
            (aw-ignored-p (aj-visual-area-window x)))))
    (ace-jump-list-visual-area)))
 
-;; ——— Macros 
——————————————————————————————————————————————————————————————————
-;;;###autoload
-(defmacro aw-generic (mode-line handler)
-  "Create a window-manipulating function.
-MODE-LINE is a string to display while a window is being selected.
-HANDLER is a function that takes a window argument."
-  (let ((wrapper (intern (format "%S-wrapper" handler))))
-    `(progn
-       (defun ,wrapper (&optional w)
-         (interactive)
-         (if w
-             (,handler w)
-           (let* ((index (let ((ret (cl-position (aref (this-command-keys) 0)
-                                                 aw-keys)))
-                           (if ret ret (length aw-keys))))
-                  (node (nth index (cdr ace-jump-search-tree))))
-             (cond
-               ;; we do not find key in search tree. This can happen, for
-               ;; example, when there is only three selections in screen
-               ;; (totally five move-keys), but user press the forth move key
-               ((null node)
-                (message "No such position candidate.")
-                (ace-jump-done))
-               ;; this is a branch node, which means there need further
-               ;; selection
-               ((eq (car node) 'branch)
-                (let ((old-tree ace-jump-search-tree))
-                  ;; we use sub tree in next move, create a new root node
-                  ;; whose child is the sub tree nodes
-                  (setq ace-jump-search-tree (cons 'branch (cdr node)))
-                  (ace-jump-update-overlay-in-search-tree ace-jump-search-tree
-                                                          aw-keys)
-                  ;; this is important, we need remove the subtree first before
-                  ;; do delete, we set the child nodes to nil
-                  (setf (cdr node) nil)
-                  (ace-jump-delete-overlay-in-search-tree old-tree)))
-               ;; if the node is leaf node, this is the final one
-               ((eq (car node) 'leaf)
-                ;; need to save aj data, as `ace-jump-done' will clean it
-                (let ((aj-data (overlay-get (cdr node) 'aj-data)))
-                  (ace-jump-done)
-                  (ace-jump-push-mark)
-                  (run-hooks 'ace-jump-mode-before-jump-hook)
-                  (,handler aj-data))
-                (run-hooks 'ace-jump-mode-end-hook))
-               (t
-                (ace-jump-done)
-                (error "[AceJump] Internal error: tree node type is 
invalid"))))))
-       (lambda ()
-         (interactive)
-         (let* ((ace-jump-mode-scope aw-scope)
-                (next-window-scope
-                 (cl-case aw-scope
-                   ('global 'visible)
-                   ('frame 'frame)))
-                (visual-area-list
-                 (sort (aw-list-visual-area)
-                       'aw-visual-area<)))
-           (unless (<= (length visual-area-list) 2)
-             (setq visual-area-list
-                   (cl-remove-if (lambda (va)
-                                   (let ((b (aj-visual-area-buffer va)))
-                                     (with-current-buffer b
-                                       (and buffer-read-only
-                                            (= 0 (buffer-size b))))))
-                                 visual-area-list)))
-           (cl-case (length visual-area-list)
-             (0)
-             (1
-              (if (aw-ignored-p (selected-window))
-                  (other-window 1)
-                ;; don't get stuck in an empty read-only buffer
-                (select-window (aj-visual-area-window (car 
visual-area-list)))))
-             (2
-              (if (aw-ignored-p (selected-window))
-                  (other-window 1)
-                (let ((sw (selected-window))
-                      (w (next-window nil nil next-window-scope)))
-                  (while (aw-ignored-p w)
-                    (select-window w)
-                    (setq w (next-window nil nil next-window-scope)))
-                  (select-window sw)
-                  (,handler w))))
-             (t
-              (let ((candidate-list
-                     (mapcar (lambda (va)
-                               (let ((b (aj-visual-area-buffer va)))
-                                 ;; ace-jump-mode can't jump if the buffer is 
empty
-                                 (when (= 0 (buffer-size b))
-                                   (with-current-buffer b
-                                     (insert " "))))
-                               (make-aj-position
-                                :offset
-                                (aw-offset (aj-visual-area-window va))
-                                :visual-area va))
-                             visual-area-list)))
-                ;; create background for each visual area
-                (if ace-jump-mode-gray-background
-                    (setq ace-jump-background-overlay-list
-                          (loop for va in visual-area-list
-                             collect (let* ((w (aj-visual-area-window va))
-                                            (b (aj-visual-area-buffer va))
-                                            (ol (make-overlay (window-start w)
-                                                              (window-end w)
-                                                              b)))
-                                       (overlay-put ol 'face 
'ace-jump-face-background)
-                                       ol))))
-                ;; construct search tree and populate overlay into tree
-                (setq ace-jump-search-tree
-                      (ace-jump-tree-breadth-first-construct
-                       (length candidate-list)
-                       (length aw-keys)))
-                (ace-jump-populate-overlay-to-search-tree
-                 ace-jump-search-tree candidate-list)
-                (ace-jump-update-overlay-in-search-tree
-                 ace-jump-search-tree aw-keys)
-                (setq ace-jump-mode ,mode-line)
-                (force-mode-line-update)
-                ;; override the local key map
-                (setq overriding-local-map
-                      (let ((map (make-keymap)))
-                        (dolist (key-code aw-keys)
-                          (define-key map (make-string 1 key-code) ',wrapper))
-                        (define-key map [t] 'ace-jump-done)
-                        map))
-                (add-hook 'mouse-leave-buffer-hook 'ace-jump-done)
-                (add-hook 'kbd-macro-termination-hook 'ace-jump-done)))))))))
+(defvar aw--current-op nil
+  "A function of one argument to call.")
+
+(defun aw--callback ()
+  "Call `aw--current-op' for the window selected by ace-jump."
+  (interactive)
+  (let* ((ret (cl-position (aref (this-command-keys) 0)
+                           aw-keys))
+         (index (or ret (length aw-keys)))
+         (node (nth index (cdr ace-jump-search-tree))))
+    (cond ((null node)
+           (message "No such position candidate.")
+           (ace-jump-done))
+
+          ((eq (car node) 'branch)
+           (let ((old-tree ace-jump-search-tree))
+             (setq ace-jump-search-tree (cons 'branch (cdr node)))
+             (ace-jump-update-overlay-in-search-tree
+              ace-jump-search-tree aw-keys)
+             (setf (cdr node) nil)
+             (ace-jump-delete-overlay-in-search-tree old-tree)))
+
+          ((eq (car node) 'leaf)
+           (let ((aj-data (overlay-get (cdr node) 'aj-data)))
+             (ace-jump-done)
+             (ace-jump-push-mark)
+             (run-hooks 'ace-jump-mode-before-jump-hook)
+             (funcall aw--current-op aj-data))
+           (run-hooks 'ace-jump-mode-end-hook))
+
+          (t
+           (ace-jump-done)
+           (error "[AceJump] Internal error: tree node type is invalid")))))
+
+(defun aw--doit (mode-line)
+  "Select a window and eventually call `aw--current-op' for it.
+Set mode line to MODE-LINE during the selection process."
+  (let* ((ace-jump-mode-scope aw-scope)
+         (next-window-scope
+          (cl-case aw-scope
+            ('global 'visible)
+            ('frame 'frame)))
+         (visual-area-list
+          (sort (aw-list-visual-area)
+                'aw-visual-area<))
+         (visual-area-list
+          (if (<= (length visual-area-list) 2)
+              visual-area-list
+            (cl-remove-if
+             (lambda (va)
+               (let ((b (aj-visual-area-buffer va)))
+                 (with-current-buffer b
+                   (and buffer-read-only
+                        (= 0 (buffer-size b))))))
+             visual-area-list))))
+    (cl-case (length visual-area-list)
+      (0)
+      (1
+       (if (aw-ignored-p (selected-window))
+           (other-window 1)
+         ;; don't get stuck in an empty read-only buffer
+         (select-window (aj-visual-area-window (car visual-area-list)))))
+      (2
+       (if (aw-ignored-p (selected-window))
+           (other-window 1)
+         (let ((sw (selected-window))
+               (w (next-window nil nil next-window-scope)))
+           (while (aw-ignored-p w)
+             (select-window w)
+             (setq w (next-window nil nil next-window-scope)))
+           (select-window sw)
+           (funcall aw--current-op
+                    (make-aj-position
+                     :offset 0
+                     :visual-area (make-aj-visual-area
+                                   :buffer (window-buffer w)
+                                   :window w
+                                   :frame (window-frame w)))))))
+      (t
+       (let ((candidate-list
+              (mapcar (lambda (va)
+                        (let ((b (aj-visual-area-buffer va)))
+                          ;; ace-jump-mode can't jump if the buffer is empty
+                          (when (= 0 (buffer-size b))
+                            (with-current-buffer b
+                              (insert " "))))
+                        (make-aj-position
+                         :offset
+                         (aw-offset (aj-visual-area-window va))
+                         :visual-area va))
+                      visual-area-list)))
+         ;; create background for each visual area
+         (if ace-jump-mode-gray-background
+             (setq ace-jump-background-overlay-list
+                   (loop for va in visual-area-list
+                      collect (let* ((w (aj-visual-area-window va))
+                                     (b (aj-visual-area-buffer va))
+                                     (ol (make-overlay (window-start w)
+                                                       (window-end w)
+                                                       b)))
+                                (overlay-put ol 'face 
'ace-jump-face-background)
+                                ol))))
+         ;; construct search tree and populate overlay into tree
+         (setq ace-jump-search-tree
+               (ace-jump-tree-breadth-first-construct
+                (length candidate-list)
+                (length aw-keys)))
+         (ace-jump-populate-overlay-to-search-tree
+          ace-jump-search-tree candidate-list)
+         (ace-jump-update-overlay-in-search-tree
+          ace-jump-search-tree aw-keys)
+         (setq ace-jump-mode mode-line)
+         (force-mode-line-update)
+         ;; override the local key map
+         (setq overriding-local-map
+               (let ((map (make-keymap)))
+                 (dolist (key-code aw-keys)
+                   (define-key map (make-string 1 key-code) 'aw--callback))
+                 (define-key map [t] 'ace-jump-done)
+                 map))
+         (add-hook 'mouse-leave-buffer-hook 'ace-jump-done)
+         (add-hook 'kbd-macro-termination-hook 'ace-jump-done))))))
 
 ;; ——— Interactive 
—————————————————————————————————————————————————————————————
 ;;;###autoload
-(defun ace-select-window () (interactive) "Ace select window.")
-;;;###autoload
-(defun ace-delete-window () (interactive) "Ace delete window.")
-;;;###autoload
-(defun ace-swap-window () (interactive) "Ace swap window.")
+(defun ace-select-window ()
+  "Ace select window."
+  (interactive)
+  (setq aw--current-op 'aw-switch-to-window)
+  (aw--doit " Ace - Window"))
 
-(defalias 'ace-select-window
-    (aw-generic " Ace - Window" aw-switch-to-window)
-  "Ace select window.")
-
-(defalias 'ace-delete-window
-    (aw-generic " Ace - Delete Window" aw-delete-window)
-  "Ace delete window.")
+;;;###autoload
+(defun ace-delete-window ()
+  "Ace delete window."
+  (interactive)
+  (setq aw--current-op 'aw-delete-window)
+  (aw--doit " Ace - Delete Window"))
 
-(defalias 'ace-swap-window
-    (aw-generic " Ace - Swap Window" aw-swap-window)
-  "Ace swap window.")
+;;;###autoload
+(defun ace-swap-window ()
+  "Ace swap window."
+  (interactive)
+  (setq aw--current-op 'aw-swap-window)
+  (aw--doit " Ace - Swap Window"))
 
 ;;;###autoload
 (defun ace-window (arg)
@@ -290,35 +286,32 @@ Windows are numbered top down, left to right."
           ((< (cadr e1) (cadr e2))
            t))))
 
-(defun aw-switch-to-window (position)
-  "Switch to window of `aj-position' structure POSITION."
-  (let (frame window)
-    (if (windowp position)
-        (setq frame (window-frame position)
-              window position)
-      (setq frame (aj-position-frame position)
-            window (aj-position-window position)))
-    (if (and (frame-live-p frame)
-             (not (eq frame (selected-frame))))
-        (select-frame-set-input-focus frame))
-    (if (and (window-live-p window)
-             (not (eq window (selected-window))))
-        (select-window window))))
-
-(defun aw-delete-window (position)
-  "Delete window of `aj-position' structure POSITION."
-  (if (windowp position)
-      (delete-window position)
-    (let ((frame (aj-position-frame position))
-          (window (aj-position-window position)))
-      (if (and (frame-live-p frame)
+(defun aw-switch-to-window (aj-data)
+  "Switch to the window of `aj-position' structure AJ-DATA."
+  (let ((frame (aj-position-frame aj-data))
+        (window (aj-position-window aj-data)))
+    (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 "aw-delete-window: %S" aj-data))))
+
+(defun aw-delete-window (aj-data)
+  "Delete window of `aj-position' structure AJ-DATA."
+  (let ((frame (aj-position-frame aj-data))
+        (window (aj-position-window aj-data)))
+    (when (and (frame-live-p frame)
                (not (eq frame (selected-frame))))
-          (select-frame-set-input-focus (window-frame window)))
+      (select-frame-set-input-focus (window-frame window)))
+    (if (= 1 (length (window-list)))
+        (delete-frame frame)
       (if (window-live-p window)
-          (delete-window window)))))
+          (delete-window window)
+        (error "aw-delete-window: %S" aj-data)))))
 
-(defun aw-swap-window (position)
-  "Swap buffers of current window and that of `aj-position' structure 
POSITION."
+(defun aw-swap-window (aj-data)
+  "Swap buffers of current window and that of `aj-position' structure AJ-DATA."
   (cl-labels ((swap-windows (window1 window2)
                 "Swap the buffers of WINDOW1 and WINDOW2."
                 (let ((buffer1 (window-buffer window1))
@@ -326,20 +319,16 @@ Windows are numbered top down, left to right."
                   (set-window-buffer window1 buffer2)
                   (set-window-buffer window2 buffer1)
                   (select-window window2))))
-    (if (windowp position)
-        (swap-windows
-         (get-buffer-window (current-buffer))
-         position)
-      (let ((frame (aj-position-frame position))
-            (window (aj-position-window position)))
-        (if (and (frame-live-p frame)
+    (let ((frame (aj-position-frame aj-data))
+          (window (aj-position-window aj-data)))
+      (when (and (frame-live-p frame)
                  (not (eq frame (selected-frame))))
-            (select-frame-set-input-focus (window-frame window)))
-        (if (and (window-live-p window)
+        (select-frame-set-input-focus (window-frame window)))
+      (when (and (window-live-p window)
                  (not (eq window (selected-window))))
-            (swap-windows
-             (get-buffer-window (current-buffer))
-             window))))))
+        (swap-windows
+         (get-buffer-window (current-buffer))
+         window)))))
 
 (defun aw-offset (window)
   "Return point in WINDOW that's closest to top left corner.