[elpa] externals/popper 88ac193f9c 1/3: popper-echo: Make code more modular

[ELPA Syncer]

branch: externals/popper
commit 88ac193f9c37bbfb7936e4ed581d1ee032e36855
Author: Karthik Chikmagalur <karthikchikmagalur@gmail.com>
Commit: Karthik Chikmagalur <karthikchikmagalur@gmail.com>

    popper-echo: Make code more modular
    
    popper-echo.el (popper-echo, popper-echo--dispatch-toggle,
    popper-echo--dispatch-kill, popper-echo--dispatch-raise,
    popper-echo--popup-info, popper-echo--activate-keymap): Make
    popper-echo more modular to allow for other ways of previewing and
    acting on popups.
---
 popper-echo.el | 186 ++++++++++++++++++++++++++++-----------------------------
 1 file changed, 93 insertions(+), 93 deletions(-)

diff --git a/popper-echo.el b/popper-echo.el
index 66efb902f8..b0401d76b1 100644
--- a/popper-echo.el
+++ b/popper-echo.el
@@ -123,92 +123,9 @@ off."
   "Echo area face for popper dispatch key hints."
   :group 'popper)
 
-;; Notify in echo area:
-(defun popper-echo ()
-  "Show popup list in the echo area when cycling popups."
-  (let* ((message-log-max nil)
-         (grp-symb (when popper-group-function
-                     (funcall popper-group-function)))
-         (buried-popups (thread-last (alist-get grp-symb 
popper-buried-popup-alist nil nil 'equal)
-                                     (mapcar #'cdr)
-                                     (cl-remove-if-not #'buffer-live-p)
-                                     (mapcar #'buffer-name)
-                                     (delete-dups)))
-         (group (and grp-symb (concat "Group ("
-                                      (truncate-string-to-width (format "%S" 
grp-symb) 20 nil nil t)
-                                      "): ")))
-         (open-popup (buffer-name))
-         (dispatch-keys-extended (append (cdr popper-echo-dispatch-keys)
-                                         (make-list (max 0 (- (length 
buried-popups)
-                                                              (1- (length 
popper-echo-dispatch-keys))))
-                                                    nil)))
-         (popup-strings
-          (cl-reduce #'concat
-                     (cons
-                      (if-let ((transform popper-echo-transform-function))
-                          (funcall transform open-popup)
-                        (propertize open-popup 'face 'popper-echo-area))
-                      (cl-mapcar (lambda (key buf)
-                                   (concat
-                                    (propertize ", " 'face 
'popper-echo-area-buried)
-                                    (propertize "[" 'face 
'popper-echo-area-buried)
-                                    (and key
-                                         (concat
-                                          (propertize (if (characterp key)
-                                                          (char-to-string key)
-                                                        key)
-                                                      'face 
'popper-echo-dispatch-hint)
-                                          (propertize ":" 'face 
'popper-echo-area-buried)))
-                                    (if-let ((transform 
popper-echo-transform-function))
-                                        (funcall transform buf)
-                                      (concat
-                                       (propertize buf 'face 
'popper-echo-area-buried)))
-                                    (propertize "]" 'face 
'popper-echo-area-buried)))
-                                 dispatch-keys-extended
-                                 buried-popups)))))
-    (let* ((max-width (- (* popper-echo-lines (frame-width)) (if group (length 
group) 11)))
-           (plen (length popup-strings))
-           (space-p (> max-width plen)))
-      (message "%s"
-               (concat
-                (or group "Popups: ")
-                (substring popup-strings 0 (if space-p plen max-width))
-                (unless space-p
-                  (propertize "..." 'face 'popper-echo-area-buried)))))
-    (set-transient-map (let ((map (make-sparse-keymap))
-                             (i 0))
-                         (dolist (keybind popper-echo-dispatch-keys map)
-                           (define-key map (cond
-                                            ((characterp keybind)
-                                             (make-vector 1 keybind))
-                                            ((stringp keybind)
-                                             (kbd keybind)))
-                                       (popper-echo--dispatch-toggle i (cons 
open-popup
-                                                                             
buried-popups)))
-                           (when popper-echo-dispatch-actions
-                             (define-key map
-                                         (kbd
-                                          (concat "k " (cond
-                                                        ((characterp keybind)
-                                                         (char-to-string 
keybind))
-                                                        ((stringp keybind)
-                                                         keybind))))
-                                         (popper-echo--dispatch-kill i (cons 
open-popup
-                                                                             
buried-popups)))
-                             
-                             (define-key map
-                                         (kbd
-                                          (concat "^ " (cond
-                                                        ((characterp keybind)
-                                                         (char-to-string 
keybind))
-                                                        ((stringp keybind)
-                                                         keybind))))
-                                         (popper-echo--dispatch-raise i (cons 
open-popup
-                                                                              
buried-popups))))
-                           (setq i (1+ i)))))))
-
-
-(defun popper-echo--dispatch-toggle (i buf-list)
+;;; Utility functions
+
+(defun popper-echo--dispatch-toggle (i buf-list repeat)
   "Return a function to switch to buffer I in list BUF-LIST.
 
 This is used to create functions for switching between popups
@@ -218,10 +135,11 @@ quickly."
     (when-let ((buf (nth i buf-list)))
       (unless arg (popper-close-latest))
       (display-buffer buf)
-      (popper--update-popups))
-    (when popper-echo-dispatch-persist (popper-echo))))
+      (popper--update-popups)
+      (when popper-echo-dispatch-persist
+        (with-current-buffer buf (funcall repeat))))))
 
-(defun popper-echo--dispatch-kill (i buf-list)
+(defun popper-echo--dispatch-kill (i buf-list repeat)
   "Return a function to Kill buffer I in list BUF-LIST."
   (lambda ()
     (interactive)
@@ -232,10 +150,13 @@ quickly."
     (popper--update-popups)
     (when (and popper-echo-dispatch-persist
                popper-open-popup-alist)
-      (popper-echo))))
+      (with-current-buffer (cdar popper-open-popup-alist)
+        (funcall repeat)))))
 
-(defun popper-echo--dispatch-raise (i buf-list)
-  "Return a function to Kill buffer I in list BUF-LIST."
+(defun popper-echo--dispatch-raise (i buf-list repeat)
+  "Return a function to raise buffer I in list BUF-LIST.
+
+Raising converts if from a popup to a regular buffer."
   (lambda ()
     (interactive)
     (let* ((buf (nth i buf-list)))
@@ -243,7 +164,86 @@ quickly."
     (popper--update-popups)
     (when (and popper-echo-dispatch-persist
                popper-open-popup-alist)
-      (popper-echo))))
+      (with-current-buffer (cdar popper-open-popup-alist)
+        (funcall repeat)))))
+
+(defun popper-echo--popup-info ()
+  "Return the popper group and list of buried popup buffers."
+  (let ((grp-symb (when popper-group-function
+                    (funcall popper-group-function))))
+    (cons grp-symb
+          (thread-last (alist-get grp-symb popper-buried-popup-alist nil nil 
'equal)
+                       (mapcar #'cdr)
+                       (cl-remove-if-not #'buffer-live-p)
+                       (delete-dups)))))
+
+(defun popper-echo--activate-keymap (buffers repeat)
+  "Activate a transient keymap to switch to or manipulate BUFFERS.
+
+Each command in the keymap calls the function REPEAT afterwards."
+  (set-transient-map
+   (cl-loop with map = (make-sparse-keymap)
+            for i upto 9
+            for keybind in popper-echo-dispatch-keys
+            for rawkey = (cond ((characterp keybind) (char-to-string keybind))
+                               (t keybind))
+            do
+            (define-key map (kbd rawkey) (popper-echo--dispatch-toggle i 
buffers repeat))
+            (define-key map (kbd (concat "k " rawkey))
+                        (popper-echo--dispatch-kill i buffers repeat))
+            (define-key map (kbd (concat "^ " rawkey))
+                        (popper-echo--dispatch-raise i buffers repeat))
+            finally return map)))
+
+;;; Notify in echo area:
+(defun popper-echo ()
+  "Show popup list in the echo area when cycling popups."
+  (pcase-let*
+      ((message-log-max nil)
+       (`(,grp-symb . ,buried-popups) (popper-echo--popup-info))
+       (buried-popups (mapcar #'buffer-name buried-popups))
+       (group (and grp-symb
+                   (concat "Group (" (truncate-string-to-width (format "%S" 
grp-symb) 20 nil nil t) "): ")))
+       (open-popup (buffer-name))
+       (dispatch-keys-extended
+        (append (cdr popper-echo-dispatch-keys)
+                (make-list (max 0 (- (length buried-popups)
+                                     (1- (length popper-echo-dispatch-keys))))
+                           nil)))
+       (popup-strings
+        (apply #'concat
+               (cons
+                (if-let ((transform popper-echo-transform-function))
+                    (funcall transform open-popup)
+                  (propertize open-popup 'face 'popper-echo-area))
+                (cl-mapcar (lambda (key buf)
+                             (concat
+                              (propertize ", " 'face 'popper-echo-area-buried)
+                              (propertize "[" 'face 'popper-echo-area-buried)
+                              (and key
+                                   (concat
+                                    (propertize (if (characterp key)
+                                                    (char-to-string key)
+                                                  key)
+                                                'face 
'popper-echo-dispatch-hint)
+                                    (propertize ":" 'face 
'popper-echo-area-buried)))
+                              (if-let ((transform 
popper-echo-transform-function))
+                                  (funcall transform buf)
+                                (concat
+                                 (propertize buf 'face 
'popper-echo-area-buried)))
+                              (propertize "]" 'face 'popper-echo-area-buried)))
+                           dispatch-keys-extended
+                           buried-popups)))))
+    (let* ((max-width (- (* popper-echo-lines (frame-width)) (if group (length 
group) 11)))
+           (plen (length popup-strings))
+           (space-p (> max-width plen)))
+      (message "%s"
+               (concat
+                (or group "Popups: ")
+                (substring popup-strings 0 (if space-p plen max-width))
+                (unless space-p
+                  (propertize "..." 'face 'popper-echo-area-buried)))))
+    (popper-echo--activate-keymap (cons open-popup buried-popups) 
#'popper-echo)))
 
 ;;;###autoload
 (define-minor-mode popper-echo-mode