[elpa] master c3a9242 06/68: ace-window.el: add move and delete functionality

[Oleh Krehel]

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

    ace-window.el: add move and delete functionality
    
    * ace-window.el (aw-generic): New macro.
      (ace-window): Do different things depending on prefix arg.
      (ace-delete-window): New interactive function.
      (ace-select-window): New interactive function.
      (ace-swap-window): New interactive function.
      (aw-switch-to-window): Test if argument is window.
      (aw-delete-window): New function.
      (aw-swap-window): New function.
    
    Fixes #2.
---
 ace-window.el |  287 ++++++++++++++++++++++++++++++++++++---------------------
 1 files changed, 181 insertions(+), 106 deletions(-)

diff --git a/ace-window.el b/ace-window.el
index eb32898..77a96ad 100644
--- a/ace-window.el
+++ b/ace-window.el
@@ -4,7 +4,7 @@
 
 ;; Author: Oleh Krehel <address@hidden>
 ;; URL: https://github.com/abo-abo/ace-window
-;; Version: 0.1.0
+;; Version: 0.2.0
 ;; Package-Requires: ((ace-jump-mode "2.0"))
 ;; Keywords: cursor, window, location
 
@@ -51,6 +51,7 @@
 ;;; Code:
 (require 'ace-jump-mode)
 
+;; ——— Customization 
———————————————————————————————————————————————————————————
 (defgroup ace-window nil
   "Quickly switch current window."
   :group 'convenience
@@ -67,105 +68,140 @@
          (const :tag "global" global)
          (const :tag "frame" frame)))
 
+;; ——— Macros 
——————————————————————————————————————————————————————————————————
+(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 (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)
+              (visual-area-list
+               (sort (ace-jump-list-visual-area)
+                     'aw-visual-area<)))
+         (cl-case (length visual-area-list)
+           (0)
+           (1)
+           (2
+            (,handler (next-window)))
+           (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 (window-start (aj-visual-area-window va))
+                              :visual-area va))
+                           visual-area-list)))
+              ;; make indirect buffer for those windows that show the same 
buffer
+              (setq ace-jump-recover-visual-area-list
+                    (ace-jump-mode-make-indirect-buffer 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)))))))))
+
+;; ——— Interactive 
—————————————————————————————————————————————————————————————
+;;;###autoload
+(defalias 'ace-select-window
+    (aw-generic " Ace - Window" aw-switch-to-window)
+  "Ace select window.")
+
+;;;###autoload
+(defalias 'ace-delete-window
+    (aw-generic " Ace - Delete Window" aw-delete-window)
+  "Ace delete window.")
+
 ;;;###autoload
-(defun ace-window ()
-  "Use function `ace-jump-mode' to switch windows."
-  (interactive)
-  (let* ((ace-jump-mode-scope aw-scope)
-         (visual-area-list
-          (sort (ace-jump-list-visual-area)
-                'aw-visual-area<)))
-    (cl-case (length visual-area-list)
-      (0)
-      (1)
-      (2
-       (other-window 1))
-      (t
-       (let ((candidate-list
-              (mapcar (lambda (va)
-                        (let ((b (aj-visual-area-buffer va)))
-                          (when (= 0 (buffer-size b))
-                            (with-current-buffer b
-                              (insert " "))))
-                        (make-aj-position
-                         :offset (window-start (aj-visual-area-window va))
-                         :visual-area va))
-                      visual-area-list)))
-         ;; make indirect buffer for those windows that show the same buffer
-         (setq ace-jump-recover-visual-area-list
-               (ace-jump-mode-make-indirect-buffer 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 " Ace - Window")
-         (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-move-window))
-                 (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))))))
-
-(defun aw-move-window ()
-  "Switch window based on user input."
-  (interactive)
-  (let* ((index (let ((ret (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)
-         (aw-switch-to-window aj-data))
-       (run-hooks 'ace-jump-mode-end-hook))
-      (t
-       (ace-jump-done)
-       (error "[AceJump] Internal error: tree node type is invalid")))))
+(defalias 'ace-swap-window
+    (aw-generic " Ace - Swap Window" aw-swap-window)
+  "Ace swap window.")
 
+;;;###autoload
+(defun ace-window (arg)
+  "Ace jump to window and perform an action based on prefix ARG.
+- with no arg: select window
+- with one arg: swap window
+- with double arg: delete window"
+  (interactive "p")
+  (cl-case arg
+    (4 (ace-swap-window))
+    (16 (ace-delete-window))
+    (t (ace-select-window))))
+
+;; ——— Utility 
—————————————————————————————————————————————————————————————————
 (defun aw-visual-area< (va1 va2)
   "Return true if visual area VA1 is less than VA2.
 This is determined by their respective window coordinates.
@@ -181,14 +217,53 @@ Windows are numbered top down, left to right."
 
 (defun aw-switch-to-window (position)
   "Switch to window of `aj-position' structure POSITION."
-  (let ((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 (window-frame window)))
-    (if (and (window-live-p window)
-             (not (eq window (selected-window))))
-        (select-window window))))
+  (if (windowp position)
+      (select-window position)
+    (let ((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 (window-frame window)))
+      (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)
+               (not (eq frame (selected-frame))))
+          (select-frame-set-input-focus (window-frame window)))
+      (if (and (window-live-p window)
+               (not (eq window (selected-window))))
+          (delete-window window)))))
+
+(defun aw-swap-window (position)
+  "Swap buffers of current window and that of `aj-position' structure 
POSITION."
+  (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))))
+    (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)
+                 (not (eq frame (selected-frame))))
+            (select-frame-set-input-focus (window-frame window)))
+        (if (and (window-live-p window)
+                 (not (eq window (selected-window))))
+            (swap-windows
+             (get-buffer-window (current-buffer))
+             window))))))
 
 (provide 'ace-window)