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.

4 files changed, 145 insertions, 118 deletions

diff --git a/emacs/guix-base.el b/emacs/guix-base.el
index 9b90942d09..21be02d26d 100644
--- a/emacs/guix-base.el
+++ b/emacs/guix-base.el
@@ -33,6 +33,7 @@
 (require 'guix-entry)
 (require 'guix-guile)
 (require 'guix-utils)
+(require 'guix-ui)
 (require 'guix-history)
 (require 'guix-messages)
 
@@ -142,73 +143,7 @@ For the meaning of location, see `guix-find-location'."
    #'string<))
 
 
-;;; Buffers and auto updating.
-
-(defcustom guix-update-after-operation 'current
-  "Define what information to update after executing an operation.
-
-After successful executing an operation in the Guix REPL (for
-example after installing a package), information 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)
-
-(defcustom guix-buffer-name-function #'guix-buffer-name-default
-  "Function used to define name of a buffer for displaying information.
-The function is called with 4 arguments: PROFILE, BUFFER-TYPE,
-ENTRY-TYPE, SEARCH-TYPE.  See `guix-get-entries' for the meaning
-of the arguments."
-  :type '(choice (function-item guix-buffer-name-default)
-                 (function-item guix-buffer-name-simple)
-                 (function :tag "Other function"))
-  :group 'guix)
-
-(defun guix-buffer-name-simple (_profile buffer-type entry-type
-                                &optional _search-type)
-  "Return name of a buffer used for displaying information.
-The name is defined by `guix-ENTRY-TYPE-BUFFER-TYPE-buffer-name'
-variable."
-  (symbol-value
-   (guix-get-symbol "buffer-name" buffer-type entry-type)))
-
-(defun guix-buffer-name-default (profile buffer-type entry-type
-                                 &optional _search-type)
-  "Return name of a buffer used for displaying information.
-The name is almost the same as the one defined by
-`guix-buffer-name-simple' except the PROFILE name is added to it."
-  (let ((simple-name (guix-buffer-name-simple
-                      profile buffer-type entry-type))
-        (profile-name (file-name-base (directory-file-name profile)))
-        (re (rx string-start
-                (group (? "*"))
-                (group (*? any))
-                (group (? "*"))
-                string-end)))
-    (or (string-match re simple-name)
-        (error "Unexpected error in defining guix buffer name"))
-    (let ((first*    (match-string 1 simple-name))
-          (name-body (match-string 2 simple-name))
-          (last*     (match-string 3 simple-name)))
-      ;; Handle the case when buffer name is wrapped by '*'.
-      (if (and (string= "*" first*)
-               (string= "*" last*))
-          (concat "*" name-body ": " profile-name "*")
-        (concat simple-name ": " profile-name)))))
-
-(defun guix-buffer-name (profile buffer-type entry-type search-type)
-  "Return name of a buffer used for displaying information.
-See `guix-buffer-name-function' for details."
-  (let ((fun (if (functionp guix-buffer-name-function)
-                 guix-buffer-name-function
-               #'guix-buffer-name-default)))
-    (funcall fun profile buffer-type entry-type search-type)))
+;;; Buffers
 
 (defun guix-switch-to-buffer (buffer)
   "Switch to a 'list' or 'info' BUFFER."
@@ -216,43 +151,6 @@ See `guix-buffer-name-function' for details."
                  '((display-buffer-reuse-window
                     display-buffer-same-window))))
 
-(defun guix-buffer-p (&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-buffers (&optional modes)
-  "Return 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-buffer-p buf modes))
-                    (buffer-list)))
-
-(defun guix-update-buffer (buffer)
-  "Update information in a 'list' or 'info' BUFFER."
-  (with-current-buffer buffer
-    (guix-buffer-revert nil t)))
-
-(defun guix-update-buffers-maybe-after-operation ()
-  "Update buffers after Guix operation if needed.
-See `guix-update-after-operation' for details."
-  (let ((to-update
-         (and guix-operation-buffer
-              (cl-case guix-update-after-operation
-                (current (and (buffer-live-p guix-operation-buffer)
-                              (guix-buffer-p guix-operation-buffer)
-                              (list guix-operation-buffer)))
-                (all     (guix-buffers))))))
-    (setq guix-operation-buffer nil)
-    (mapc #'guix-update-buffer to-update)))
-
-(add-hook 'guix-after-repl-operation-hook
-          'guix-update-buffers-maybe-after-operation)
-
 
 ;;; Common definitions for buffer types
 
@@ -275,6 +173,14 @@ This alist is filled by `guix-buffer-define-interface' macro.")
                          param))
       (guix-symbol-title param)))
 
+(defun guix-buffer-name (buffer-type entry-type profile)
+  "Return name of BUFFER-TYPE buffer for displaying ENTRY-TYPE entries."
+  (let ((str-or-fun (guix-buffer-value buffer-type entry-type
+                                       'buffer-name)))
+    (if (stringp str-or-fun)
+        str-or-fun
+      (funcall str-or-fun profile))))
+
 (defun guix-buffer-history-size (buffer-type entry-type)
   "Return history size for BUFFER-TYPE/ENTRY-TYPE."
   (guix-buffer-value buffer-type entry-type 'history-size))
@@ -352,11 +258,13 @@ The following stuff should be defined outside this macro:
   - `guix-TYPE-mode-initialize' (optional) - function for
   additional mode settings; it is called without arguments.
 
-Optional keywords:
+Required keywords:
 
   - `:buffer-name' - default value of the generated
     `guix-TYPE-buffer-name' variable.
 
+Optional keywords:
+
   - `:titles' - default value of the generated
     `guix-TYPE-titles' variable.
 
@@ -374,7 +282,6 @@ Optional keywords:
          (Entry-type-str     (capitalize entry-type-str))
          (Buffer-type-str    (capitalize buffer-type-str))
          (entry-str          (concat entry-type-str " entries"))
-         (buffer-str         (concat buffer-type-str " buffer"))
          (prefix             (concat "guix-" entry-type-str "-"
                                      buffer-type-str))
          (group              (intern prefix))
@@ -388,9 +295,7 @@ Optional keywords:
          (history-size-var   (intern (concat prefix "-history-size")))
          (revert-confirm-var (intern (concat prefix "-revert-confirm"))))
     (guix-keyword-args-let args
-        ((buffer-name-val    :buffer-name
-                             (format "*Guix %s %s*"
-                                     Entry-type-str Buffer-type-str))
+        ((buffer-name-val    :buffer-name)
          (titles-val         :titles)
          (history-size-val   :history-size 20)
          (revert-confirm-val :revert-confirm? t)
@@ -438,7 +343,8 @@ If non-nil, ask to confirm for reverting `%S' buffer."
                  :group ',group)
 
                (guix-alist-put!
-                '((history-size   . ,history-size-var)
+                '((buffer-name    . ,buffer-name-var)
+                  (history-size   . ,history-size-var)
                   (revert-confirm . ,revert-confirm-var))
                 'guix-buffer-data ',buffer-type ',entry-type)
 
@@ -531,8 +437,7 @@ If NO-DISPLAY is non-nil, do not switch to the buffer."
                         (equal guix-profile profile))
                    (current-buffer)
                  (get-buffer-create
-                  (guix-buffer-name profile buffer-type
-                                    entry-type search-type)))))
+                  (guix-buffer-name buffer-type entry-type profile)))))
       (with-current-buffer buf
         (guix-show-entries entries buffer-type entry-type)
         (guix-set-vars profile entries buffer-type entry-type
@@ -1124,12 +1029,12 @@ The function is called with a single argument - a command line string."
 (defun guix-update-buffers-maybe-after-pull ()
   "Update buffers depending on `guix-update-after-pull'."
   (when guix-update-after-pull
-    (mapc #'guix-update-buffer
+    (mapc #'guix-ui-update-buffer
           ;; No need to update "generation" buffers.
-          (guix-buffers '(guix-package-list-mode
-                          guix-package-info-mode
-                          guix-output-list-mode
-                          guix-output-info-mode)))
+          (guix-ui-buffers '(guix-package-list-mode
+                             guix-package-info-mode
+                             guix-output-list-mode
+                             guix-output-info-mode)))
     (message "Guix buffers have been updated.")))
 
 ;;;###autoload
diff --git a/emacs/guix-info.el b/emacs/guix-info.el
index 80443f2e40..d71d8f52a3 100644
--- a/emacs/guix-info.el
+++ b/emacs/guix-info.el
@@ -471,6 +471,7 @@ After calling each METHOD, a new line is inserted."
 ;;; Displaying packages
 
 (guix-ui-info-define-interface package
+  :buffer-name "*Guix Package Info*"
   :format '(guix-package-info-insert-heading
             ignore
             (synopsis ignore (simple guix-package-info-synopsis))
@@ -830,6 +831,7 @@ This function is used to hide a \"Download\" button if needed."
 ;;; Displaying generations
 
 (guix-ui-info-define-interface generation
+  :buffer-name "*Guix Generation Info*"
   :format '((number format guix-generation-info-insert-number)
             (prev-number format (format))
             (current format guix-generation-info-insert-current)
diff --git a/emacs/guix-list.el b/emacs/guix-list.el
index 8a9c10f2da..42bc0c87f5 100644
--- a/emacs/guix-list.el
+++ b/emacs/guix-list.el
@@ -517,6 +517,7 @@ See also `guix-list-describe'."
 ;;; Displaying packages
 
 (guix-ui-list-define-interface package
+  :buffer-name "*Guix Package List*"
   :format '((name guix-package-list-get-name 20 t)
             (version nil 10 nil)
             (outputs nil 13 t)
@@ -803,6 +804,7 @@ See `guix-package-info-type'."
 ;;; Displaying generations
 
 (guix-ui-list-define-interface generation
+  :buffer-name "*Guix Generation List*"
   :format '((number nil 5 guix-list-sort-numerically-0 :right-align t)
             (current guix-generation-list-get-current 10 t)
             (time guix-list-get-time 20 t)
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)