[elpa] externals/popper a85a343c99 027/102: Merge branch 'popup-groups'

[ELPA Syncer]

branch: externals/popper
commit a85a343c991f1e53a84cc13bf422b22411a43a5f
Merge: 238dae1e46 2341669327
Author: Karthik Chikmagalur <karthikchikmagalur@gmail.com>
Commit: Karthik Chikmagalur <karthikchikmagalur@gmail.com>

    Merge branch 'popup-groups'
---
 README.org |  21 +++--
 popper.el  | 269 ++++++++++++++++++++++++++++++++++++++++++++++---------------
 2 files changed, 217 insertions(+), 73 deletions(-)

diff --git a/README.org b/README.org
index 9b179a8d4c..a12b019f60 100644
--- a/README.org
+++ b/README.org
@@ -2,6 +2,8 @@
 
 A minor-mode to help with the Emacs window flood. Designate any buffer to 
"popup" status, and it will stay out of your way. Disimss or summon it easily 
with one key. Useful for many things, including toggling display of REPLs, 
documentation, compilation or shell output, etc.
 
+There is a [[https://www.youtube.com/watch?v=E-xUNlZi3rI][detailed demo of 
Popper here]].
+
 popper can place your popups for you, but it works best in conjunction
 with some system to handle window creation and placement, like =shackle.el=.
 This plugin summons windows defined by the user as "popups" by simply calling
@@ -33,18 +35,20 @@ You can also promote a popup to a normal window.
 * Usage
 To designate popups in your init file, see the customization section.
 
-There are three commands of note, you can bind them as convenient:
+There are two primary commands, you can bind them as convenient:
 
 - =popper-toggle-latest=: Show/hide the latest popup. Does more with prefix 
args.
 - =popper-cycle=: Cycle through your popups in sequence. With a prefix arg, 
cycle backwards.
-- =popper-toggle-type=: Turn a regular window into a popup or a popup into a 
regular window.
-  
+
+Additionally, you can turn a regular window into a popup (or vice-versa) with 
=popper-toggle-type=, and kill an open popup buffer with 
=popper-kill-latest-popup=.
+
 * Setup 
-=popper= is not part of any package archive, so you will need to ensure it's 
on the Emacs =load-path= somewhere.
+=popper= is available in MELPA, so you can install it with =M-x 
package-install RET popper RET= after adding MELPA to your package archives 
list.
+
 ** With =use-package=
 #+BEGIN_SRC emacs-lisp
   (use-package popper
-    :load-path "/path/to/popper/"                                   
+    :ensure t
     :bind (("C-`"   . popper-toggle-latest)
            ("M-`"   . popper-cycle)
            ("C-M-`" . popper-toggle-type))
@@ -58,7 +62,7 @@ There are three commands of note, you can bind them as 
convenient:
 #+END_SRC
 See [[*Customization][Customization]] for details on specifying buffer types 
as popups.
 
-** General
+** Without =use-package=
 #+BEGIN_SRC emacs-lisp
   (require 'popper)
   (setq popper-reference-buffers
@@ -93,6 +97,11 @@ To get started, customize this variable:
 
   There are other customization options, check the =popper= group.
 
+** Grouping popups by context
+Popper can group popups by "context", so that the popups available for display 
are limited to those that are relevant to the context in which 
=popper-toggle-latest= or =popper-cycle= is called. For example, when cycling 
popups from a project buffer, you may only want to see the popups (REPLs, help 
buffers and compilation output, say) that were spawned from buffers in that 
project. This is intended to approximate DWIM behavior, so that the most 
relevant popup in any context is never more  [...]
+
+Built in contexts include projects as defined in Emacs' built in =project.el= 
and =projectile=, as well as the default directory of a buffer. To set this, 
customize =popper-group-function=. You can also provide a custom function that 
takes no arguments, is executed in the context of a popup buffer and returns a 
string or symbol that represents the group/context it belongs to.
+
 **  Managing window placement
 In keeping with the principle of least surprise, all popups are shown in the 
same location: At the bottom of the frame. However this means you can't have 
more than one popup open at a time. You may also want more control over where 
individual popups appear. For example, you may want an IDE-like set-up, with 
all help windows open on the right, REPLs on top and compilation windows at the 
bottom. This is best done by customizing Emacs' =display-buffer-alist=. Since 
this is a [[https://www.g [...]
 
diff --git a/popper.el b/popper.el
index 605f012d8c..2c4c8eb4dc 100644
--- a/popper.el
+++ b/popper.el
@@ -3,7 +3,7 @@
 ;; Copyright (C) 2021  Karthik Chikmagalur
 
 ;; Author: Karthik Chikmagalur <karthik.chikmagalur@gmail.com>
-;; Version: 0.20
+;; Version: 0.30
 ;; Package-Requires: ((emacs "26.1"))
 ;; Keywords: convenience
 ;; URL: https://github.com/karthink/popper
@@ -38,6 +38,7 @@
 ;; popper-toggle-latest : Toggle latest popup
 ;; popper-cycle         : Cycle through all popups, or close all open popups
 ;; popper-toggle-type   : Turn a regular window into a popup or vice-versa
+;; popper-kill-latest-popup : Kill latest open popup
 ;;
 ;; CUSTOMIZATION:
 ;;
@@ -46,14 +47,23 @@
 ;; as popups.
 ;;
 ;; `popper-mode-line': String or sexp to show in the mode-line of
-;; popper. Setting this to NIL removes the mode-line entirely from
+;; popper. Setting this to nil removes the mode-line entirely from
 ;; popper.
+;;
+;; `popper-group-function': Function that returns the context a popup should be
+;; shown in. The context is a string or symbol used to group together a set of
+;; buffers and their associated popups, such as the project root. See
+;; documentation for available options.
 
 ;;; Code:
 
 (require 'cl-lib)
 (require 'subr-x)
 
+(declare-function project-root "project")
+(declare-function project-current "project")
+(declare-function projectile-project-root "projectile")
+
 (defvar popper-mode)
 
 (defgroup popper nil
@@ -81,7 +91,7 @@ Output*, and all help and compilation buffers."
 (defcustom popper-mode-line '(:eval (propertize " POP" 'face 
'mode-line-emphasis))
   "String or sexp to show in the mode-line of popper.
 
- Can be a quoted list or function. Setting this to NIL removes
+ Can be a quoted list or function. Setting this to nil removes
 the mode-line entirely from popper."
   :group 'popper
   :type '(choice (const :tag "Off" nil)
@@ -116,6 +126,30 @@ Display Action Alists\") for details on the alist."
   :group 'popper
   :type 'function)
 
+(defcustom popper-group-function nil
+  "Function that returns a popup context.
+
+When set to nil popups are not grouped by context.
+
+This function is called with no arguments and should return a
+string or symbol identifying a popup buffer's group. This
+identifier is used to associate popups with regular buffers (such
+as by project, directory, or `major-mode') so that popup-cycling
+from a regular buffer is restricted to its associated group.
+
+Built-in choices include
+
+`popper-group-by-directory': Return project root or default directory.
+`popper-group-by-project': Return project root using project.el.
+`popper-group-by-projectile': Return project root using projectile."
+  :group 'popper
+  :type '(choice
+          (const :tag "Don't group popups" nil)
+          (const :tag "Group by project (project.el)" popper-group-by-project)
+          (const :tag "Group by project (projectile)" 
popper-group-by-projectile)
+          (const :tag "Group by directory" popper-group-by-directory)
+          (function :tag "Custom function")))
+
 (defvar popper-reference-names nil
   "List of buffer names whose windows are treated as popups.")
 
@@ -126,7 +160,10 @@ Display Action Alists\") for details on the alist."
   "Alist of currently live (window . buffer)s that are treated as popups.")
 
 (defvar popper-buried-popup-alist nil
-  "Alist of currently buried (window . buffer)s that are treated as popups.")
+  "Alist of currently buried (window . buffer)s that are treated as popups.
+
+If `popper-group-function' is non-nil, these are
+grouped by the predicate `popper-group-function'.")
 
 (defvar-local popper-popup-status nil
   "Identifies a buffer as a popup by its buffer-local value.
@@ -167,6 +204,33 @@ This is intended to be used in `display-buffer-alist'."
       ('t (with-current-buffer buffer
             (memq popper-popup-status '(popup user-popup)))))))
 
+(defun popper-group-by-directory ()
+  "Return an identifier (default directory) to group popups.
+
+The project root is used if found by project, with the default
+directory as a fall back."
+  (or (and (fboundp 'project-root)
+           (project-root (project-current)))
+      (expand-file-name default-directory)))
+
+(defun popper-group-by-project ()
+  "Return an identifier (project root) to group popups."
+  (unless (fboundp 'project-root)
+    (user-error "Cannot find project directory to group popups.
+  Please install `project' or customize
+  `popper-group-function'"))
+  (project-root (project-current)))
+
+(defun popper-group-by-projectile ()
+  "Return an identifier to group popups.
+
+This returns the project root found using the projectile package."
+  (unless (fboundp 'projectile-project-root)
+    (user-error "Cannot find project directory to group popups.
+  Please install `projectile' or customize
+  `popper-group-function'"))
+  (projectile-project-root))
+
 (defun popper-find-popups (test-buffer-list)
   "Return an alist corresponding to popups in TEST-BUFFER-LIST.
 
@@ -198,11 +262,29 @@ Each element of the alist is a cons cell of the form 
(window . buffer)."
                                             open-popups
                                             :key #'cdr))))
          (setq popper-open-popup-alist (nreverse open-popups))
-         (setq popper-buried-popup-alist
-               (append closed-popups
-                       (cl-set-difference popper-buried-popup-alist
-                                          closed-popups
-                                          :key #'cdr))))
+         (if popper-group-function
+             (cl-loop for (win . buf) in closed-popups do
+                      (let ((identifier-popups
+                             (cdr (assoc
+                                   (with-current-buffer buf
+                                     (funcall popper-group-function))
+                                   popper-buried-popup-alist
+                                  'equal))))
+                        (setf
+                         (alist-get
+                          (with-current-buffer buf
+                            (funcall popper-group-function))
+                          popper-buried-popup-alist
+                          nil nil 'equal)
+                         (append (list (cons win buf))
+                                 (cl-remove (cons win buf)
+                                            identifier-popups
+                                            :key 'cdr)))))
+           (setf (alist-get nil popper-buried-popup-alist)
+                 (append closed-popups
+                         (cl-set-difference (cdr (assoc nil 
popper-buried-popup-alist))
+                                            closed-popups
+                                            :key #'cdr)))))
   ;; Mode line update
   (cl-loop for (_ . buf) in popper-open-popup-alist do
              (with-current-buffer buf
@@ -212,42 +294,66 @@ Each element of the alist is a cons cell of the form 
(window . buffer)."
   "Update the list of currently buried popups.
 
  Meant to be run when starting command `popper-mode'."
-  (setq popper-buried-popup-alist
-        (popper-find-popups
-            (cl-set-difference (buffer-list)
-                               (mapcar #'window-buffer
-                                       (window-list))))))
+  (let ((buried-popups (popper-find-popups
+                        (cl-set-difference
+                         (buffer-list)
+                         (mapcar #'window-buffer
+                                 (window-list))))))
+    (if popper-group-function
+        (cl-loop for (win . buf) in buried-popups do
+                 (push (cons win buf)
+                       (alist-get
+                        (with-current-buffer buf
+                          (funcall popper-group-function))
+                        popper-buried-popup-alist
+                        nil nil 'equal)))
+      (setq popper-buried-popup-alist
+            (list (cons nil buried-popups))))))
 
 (defun popper-close-latest ()
   "Close the last opened popup."
+  (unless popper-mode (user-error "Popper-mode not active!"))
   (if (null popper-open-popup-alist)
-      (message (if popper-mode
-                   "No open popups!"
-                 "popper-mode not active!"))
+      (message "No open popups!")
     (cl-destructuring-bind ((win . buf) . rest) popper-open-popup-alist
       (when (and (window-valid-p win) (window-parent win))
         ;;only close window when window has a parent:
-        (unless (seq-some
-                 (lambda (item) (eq buf (cdr item)))
-                 popper-buried-popup-alist)
-          ;; buffer doesn't already exist in the buried popup list
-          (push (cons nil buf) popper-buried-popup-alist)
-          (pop popper-open-popup-alist))
+        (let ((group (when popper-group-function
+                       (with-current-buffer buf
+                         (funcall popper-group-function)))))
+          (unless (cl-member buf
+                             (cdr (assoc group popper-buried-popup-alist))
+                             :key 'cdr)
+            ;; buffer doesn't already exist in the buried popup list
+            (push (cons nil buf) (alist-get group
+                                            popper-buried-popup-alist
+                                            nil nil 'equal))))
+        (pop popper-open-popup-alist)
         (with-selected-window win
           (bury-buffer buf)
           (delete-window win))))))
 
-(defun popper-open-latest ()
-  "Open the last closed popup."
-  (if (null popper-buried-popup-alist)
-      (message (if popper-mode
-                   "No buried popups!"
-                 "popper-mode not active!"))
-    (let* ((new-popup (pop popper-buried-popup-alist))
-           (buf (cdr new-popup)))
-      (if (buffer-live-p buf)
-          (display-buffer buf)
-        (popper-open-latest)))))
+(defun popper-open-latest (&optional group)
+  "Open the last closed popup.
+
+Optional argument GROUP is called with no arguments to select
+a popup buffer to open."
+  (unless popper-mode (user-error "Popper-mode not active!"))
+  (let* ((identifier (when popper-group-function group))
+        (no-popup-msg (format "No buried popups for group %s"
+                                 (if (symbolp identifier)
+                                     (symbol-name identifier)
+                                   identifier))))
+    (if (null (alist-get identifier popper-buried-popup-alist
+                         nil 'remove 'equal))
+        (message (if identifier no-popup-msg "No buried popups"))
+      (if-let* ((new-popup (pop (alist-get identifier popper-buried-popup-alist
+                                           nil 'remove 'equal)))
+                (buf (cdr new-popup)))
+          (if (buffer-live-p buf)
+              (progn (display-buffer buf))
+            (popper-open-latest))
+        (message no-popup-msg)))))
 
 (defun popper-modified-mode-line ()
   "Return modified mode-line string."
@@ -258,8 +364,18 @@ Each element of the alist is a cons cell of the form 
(window . buffer)."
               (cons popper-mode-line (nthcdr popper-mode-line-position
                                              (default-value 
'mode-line-format)))))))
 
+(defun popper-restore-mode-lines (win-buf-alist)
+  "Restore the default value of `mode-line-format'.
+
+This applies to popup-buffers in the list WIN-BUF-ALIST."
+  (dolist (buf (mapcar 'cdr win-buf-alist))
+    (when (buffer-live-p buf)
+      (with-current-buffer buf
+        (setq mode-line-format (default-value 'mode-line-format))
+        (force-mode-line-update)))))
+
 (defun popper-bury-all ()
-  "Bury all open popper."
+  "Bury all open popups."
   (while popper-open-popup-alist
     (popper-close-latest)))
 
@@ -268,8 +384,10 @@ Each element of the alist is a cons cell of the form 
(window . buffer)."
 
 Note that buffers that are displayed in the same 'position' on
 the screen by `display-buffer' will not all be displayed."
-  (while popper-buried-popup-alist
-    (popper-open-latest)))
+  (let ((group (when popper-group-function
+                 (funcall popper-group-function))))
+    (while popper-buried-popup-alist
+      (popper-open-latest group))))
 
 (defun popper-toggle-latest (&optional arg)
   "Toggle visibility of the last opened popup window.
@@ -283,39 +401,45 @@ With a double prefix ARG \\[universal-argument]
 one buffer can be show in one 'slot', so it will display as many
 windows as it can."
   (interactive "p")
-  (if popper-open-popup-alist
-      (pcase arg
-        (4 (popper-open-latest))
-        (16 (popper-bury-all))
-        (_ (popper-close-latest)))
-    (if (equal arg 16)
-        (popper-open-all)
-      (popper-open-latest))))
-
-(defun popper-cycle (&optional _arg)
+  (let ((group (when popper-group-function
+                 (funcall popper-group-function))))
+    (if popper-open-popup-alist
+        (pcase arg
+          (4 (popper-open-latest group))
+          (16 (popper-bury-all))
+          (_ (popper-close-latest)))
+      (if (equal arg 16)
+          (popper-open-all)
+        (popper-open-latest group)))))
+
+(defun popper-cycle (&optional default-group)
   "Cycle visibility of popup windows one at a time.
 
-TODO: With a prefix argument ARG, cycle in the opposite
-direction."
-  (interactive "p")
-  (if (null popper-open-popup-alist)
-      (popper-open-latest)
-    (if (null popper-buried-popup-alist)
-        (popper-bury-all) ; starting new cycle, so bury everything first.
-      ;; cycle through buffers
-      (popper-close-latest)
-      (let ((bufs popper-buried-popup-alist))
-        (setq popper-buried-popup-alist
-              (append (cdr bufs) (cons (car bufs) nil))))
-      (popper-open-latest))))
+With a prefix argument DEFAULT-GROUP, cycle through popups
+belonging to the default group."
+  (interactive "P")
+  (let* ((group (when (and popper-group-function
+                           (not default-group))
+                  (funcall popper-group-function))))
+    (if (null popper-open-popup-alist)
+        (popper-open-latest group)
+      (if (null (alist-get group popper-buried-popup-alist nil nil 'equal))
+          (popper-bury-all) ; starting new cycle, so bury everything first.
+        ;; cycle through buffers
+        (popper-close-latest)
+        (let ((bufs (cdr (assoc group popper-buried-popup-alist))))
+          (setf (alist-get group popper-buried-popup-alist nil nil 'equal)
+                (append (cdr bufs) (cons (car bufs) nil))))
+        (popper-open-latest group)))))
 
 (defun popper-raise-popup (&optional buffer)
   "Raise a popup to regular status.
 If BUFFER is not specified,raise the current buffer."
-  (when-let* ((buf (get-buffer (or buffer (current-buffer))))
-              (popup-status (buffer-local-value 'popper-popup-status buf)))
+  (when-let ((buf (get-buffer (or buffer (current-buffer)))))
     (with-current-buffer buf
-      (setq popper-popup-status (and (popper-popup-p buf) 'raised))
+      (if (popper-popup-p buf)
+          (setq popper-popup-status 'raised)
+        (setq popper-popup-status nil))
       (setq mode-line-format (default-value 'mode-line-format)))
     (delete-window (get-buffer-window buf))
     (pop-to-buffer buf)))
@@ -327,8 +451,8 @@ If BUFFER is not specified act on the current buffer 
instead."
   (let ((buf (get-buffer (or buffer (current-buffer)))))
     (with-current-buffer buf
       (setq popper-popup-status (if (popper-popup-p buf)
-                                           'popup
-                                         'user-popup))
+                                    'popup
+                                  'user-popup))
       (delete-window (get-buffer-window buf t))
       (pop-to-buffer buf))
     (popper-update-popups)))
@@ -344,6 +468,14 @@ If BUFFER is not specified act on the current buffer 
instead."
       ((or 'popup 'user-popup) (popper-raise-popup buf))
       (_ (popper-lower-to-popup buf)))))
 
+(defun popper-kill-latest-popup ()
+  "Kill the latest popup-buffer and delete its window."
+  (interactive)
+  (cl-destructuring-bind ((win . buf) . rest) popper-open-popup-alist
+    (pop popper-open-popup-alist)
+    (delete-window win)
+    (kill-buffer buf)))
+
 ;;;###autoload
 (define-minor-mode popper-mode
   "Toggle Popper mode. When enabled, treat certain buffer
@@ -351,7 +483,7 @@ windows as popups, a class of window that can be summoned or
 dismissed with a command. See the customization options for
 details on how to designate buffer types as popups."
   :global t
-  :version "0.20"
+  :version "0.30"
   :lighter ""
   :group 'popper
   :keymap (let ((map (make-sparse-keymap))) map)
@@ -369,9 +501,12 @@ details on how to designate buffer types as popups."
                      `(popper-display-control-p
                        (,popper-display-function))))
     ;; Turning the mode OFF
+    (remove-hook 'window-configuration-change-hook #'popper-update-popups)
+    (cl-loop for (_ . win-buf-alist) in popper-buried-popup-alist do
+             (popper-restore-mode-lines win-buf-alist))
+    (popper-restore-mode-lines popper-open-popup-alist)
     (setq popper-buried-popup-alist nil
           popper-open-popup-alist nil)
-    (remove-hook 'window-configuration-change-hook #'popper-update-popups)
     (setq display-buffer-alist
           (cl-remove 'popper-display-control-p
                      display-buffer-alist