emacs: Generalize buffer naming.

* emacs/guix-base.el (guix-buffer-name): New procedure.
  (guix-buffer-define-interface): Make ':buffer-name' a required keyword.
  (guix-update-after-operation, guix-buffer-name-function)
  (guix-buffer-name-simple, guix-buffer-name-default, guix-buffer-name)
  (guix-buffer-p, guix-buffers, guix-update-buffer)
  (guix-update-buffers-maybe-after-operation): Adjust, move and rename to...
* emacs/guix-ui.el (guix-ui-update-after-operation)
  (guix-ui-buffer-name-function, guix-ui-buffer-name-simple)
  (guix-ui-buffer-name-default, guix-ui-buffer-name)
  (guix-ui-buffer?, guix-ui-buffers, guix-ui-update-buffer)
  (guix-ui-update-buffers-after-operation): ... this.
  (guix-ui-define-interface): Generate
  'guix-ENTRY-TYPE-BUFFER-TYPE-buffer-name' procedure and pass it as
  ':buffer-name' argument.
  (guix-ui): New custom group.
* emacs/guix-info.el: Specify ':buffer-name' for the defined interfaces.
* emacs/guix-list.el: Likewise.
* doc/emacs.texi (Emacs Appearance): Adjust accordingly.

1 files changed, 119 insertions, 1 deletions

diff --git a/emacs/guix-ui.el b/emacs/guix-ui.el
index 25b110c815..a92439baf1 100644
--- a/emacs/guix-ui.el
+++ b/emacs/guix-ui.el
@@ -25,8 +25,15 @@
 ;;; Code:
 
 (require 'cl-lib)
+(require 'guix-backend)
 (require 'guix-utils)
 
+(defgroup guix-ui nil
+  "Settings for Guix package management.
+This group includes settings for displaying packages, outputs and
+generations in 'list' and 'info' buffers."
+  :group 'guix)
+
 (defvar guix-ui-map
   (let ((map (make-sparse-keymap)))
     (define-key map (kbd "M") 'guix-apply-manifest)
@@ -40,6 +47,101 @@
          guix-profile 'info guix-entry-type 'id ids))
 
 
+;;; Buffers and auto updating
+
+(defcustom guix-ui-update-after-operation 'current
+  "Define what kind of data to update after executing an operation.
+
+After successful executing an operation in the Guix REPL (for
+example after installing a package), the data in Guix buffers
+will or will not be automatically updated depending on a value of
+this variable.
+
+If nil, update nothing (do not revert any buffer).
+If `current', update the buffer from which an operation was performed.
+If `all', update all Guix buffers (not recommended)."
+  :type '(choice (const :tag "Do nothing" nil)
+                 (const :tag "Update operation buffer" current)
+                 (const :tag "Update all Guix buffers" all))
+  :group 'guix-ui)
+
+(defcustom guix-ui-buffer-name-function
+  #'guix-ui-buffer-name-default
+  "Function used to define a name of a Guix buffer.
+The function is called with 2 arguments: BASE-NAME and PROFILE."
+  :type '(choice (function-item guix-ui-buffer-name-default)
+                 (function-item guix-ui-buffer-name-simple)
+                 (function :tag "Other function"))
+  :group 'guix-ui)
+
+(defun guix-ui-buffer-name-simple (base-name &rest _)
+  "Return BASE-NAME."
+  base-name)
+
+;; TODO separate '*...*' logic from the real profile appending.  Also add
+;; another function to return '*Guix ...: /full/path/to/profile*' name.
+(defun guix-ui-buffer-name-default (base-name profile)
+  "Return buffer name by appending BASE-NAME and PROFILE's base file name."
+  (let ((profile-name (file-name-base (directory-file-name profile)))
+        (re (rx string-start
+                (group (? "*"))
+                (group (*? any))
+                (group (? "*"))
+                string-end)))
+    (or (string-match re base-name)
+        (error "Unexpected error in defining guix buffer name"))
+    (let ((first*    (match-string 1 base-name))
+          (name-body (match-string 2 base-name))
+          (last*     (match-string 3 base-name)))
+      ;; Handle the case when buffer name is wrapped by '*'.
+      (if (and (string= "*" first*)
+               (string= "*" last*))
+          (concat "*" name-body ": " profile-name "*")
+        (concat base-name ": " profile-name)))))
+
+(defun guix-ui-buffer-name (base-name profile)
+  "Return Guix buffer name based on BASE-NAME and profile.
+See `guix-ui-buffer-name-function' for details."
+  (funcall guix-ui-buffer-name-function
+           base-name profile))
+
+(defun guix-ui-buffer? (&optional buffer modes)
+  "Return non-nil if BUFFER mode is derived from any of the MODES.
+If BUFFER is nil, check current buffer.
+If MODES is nil, use `guix-list-mode' and `guix-info-mode'."
+  (with-current-buffer (or buffer (current-buffer))
+    (apply #'derived-mode-p
+           (or modes '(guix-list-mode guix-info-mode)))))
+
+(defun guix-ui-buffers (&optional modes)
+  "Return a list of all buffers with major modes derived from MODES.
+If MODES is nil, return list of all Guix 'list' and 'info' buffers."
+  (cl-remove-if-not (lambda (buf)
+                      (guix-ui-buffer? buf modes))
+                    (buffer-list)))
+
+(defun guix-ui-update-buffer (buffer)
+  "Update data in a 'list' or 'info' BUFFER."
+  (with-current-buffer buffer
+    (guix-buffer-revert nil t)))
+
+(defun guix-ui-update-buffers-after-operation ()
+  "Update buffers after Guix operation if needed.
+See `guix-ui-update-after-operation' for details."
+  (let ((to-update
+         (and guix-operation-buffer
+              (cl-case guix-ui-update-after-operation
+                (current (and (buffer-live-p guix-operation-buffer)
+                              (guix-ui-buffer? guix-operation-buffer)
+                              (list guix-operation-buffer)))
+                (all     (guix-ui-buffers))))))
+    (setq guix-operation-buffer nil)
+    (mapc #'guix-ui-update-buffer to-update)))
+
+(add-hook 'guix-after-repl-operation-hook
+          'guix-ui-update-buffers-after-operation)
+
+
 ;;; Interface definers
 
 (defmacro guix-ui-define-interface (buffer-type entry-type &rest args)
@@ -47,6 +149,12 @@
 Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ...
 In the following description TYPE means ENTRY-TYPE-BUFFER-TYPE.
 
+Required keywords:
+
+  - `:buffer-name' - base part of a buffer name.  It is used in a
+    generated `guix-TYPE-buffer-name' function; see
+    `guix-ui-buffer-name' for details.
+
 Optional keywords:
 
   - `:required' - default value of the generated
@@ -64,10 +172,12 @@ The rest keyword arguments are passed to
          (parent-map      (intern (format "guix-%s-mode-map"
                                           buffer-type-str)))
          (required-var    (intern (concat prefix "-required-params")))
+         (buffer-name-fun (intern (concat prefix "-buffer-name")))
          (definer         (intern (format "guix-%s-define-interface"
                                           buffer-type-str))))
     (guix-keyword-args-let args
-        ((required-val    :required ''(id)))
+        ((buffer-name-val :buffer-name)
+         (required-val    :required ''(id)))
       `(progn
          (defvar ,mode-map
            (let ((map (make-sparse-keymap)))
@@ -82,7 +192,15 @@ List of the required '%s' parameters for '%s' buffer.
 These parameters are received along with the displayed parameters."
                     entry-type-str buffer-type-str))
 
+         (defun ,buffer-name-fun (profile &rest _)
+           ,(format "\
+Return a name of '%s' buffer for displaying '%s' entries.
+See `guix-ui-buffer-name' for details."
+                    buffer-type-str entry-type-str)
+           (guix-ui-buffer-name ,buffer-name-val profile))
+
          (,definer ,entry-type
+           :buffer-name ',buffer-name-fun
            ,@%foreign-args)))))
 
 (defmacro guix-ui-info-define-interface (entry-type &rest args)