17/38: emacs: Factorize macros for defining interfaces.

[Alex Kost]

alezost pushed a commit to branch master
in repository guix.

commit 7735c503b5b8dfe7d8963207f4f2cf0b7dfd3894
Author: Alex Kost <address@hidden>
Date:   Fri Nov 20 12:38:31 2015 +0300

    emacs: Factorize macros for defining interfaces.
    
    Make a root 'guix-buffer-define-interface' macro.  It should generate a
    common code for any type of interface.  Inherit 'guix-info-define-interface'
    and 'guix-list-define-interface' from it.  They should provide a general
    'info'/'list' interface for any data.  Finally, make
    'guix-ui-define-interface' for the common code for interfaces to Guix
    packages and generations, and inherit 'guix-ui-info-define-interface' and
    'guix-ui-list-define-interface' from it.
    
    * emacs/guix-base.el (guix-define-buffer-type): Rename to...
      (guix-buffer-define-interface): ... this.  Rename internal
      variables ('buf-' -> 'buffer-').  Move ':required' keyword to
      'guix-ui-define-interface'.
    * emacs/guix-info.el (guix-info-define-interface): New macro.
      (guix-info-font-lock-keywords): New variable.
    * emacs/guix-list.el (guix-list-define-entry-type): Rename to...
      (guix-list-define-interface): ... this.
      (guix-list-font-lock-keywords): New variable.
      (guix-list-describe-ids): Move and rename to...
    * emacs/guix-ui.el: New file.
      (guix-ui-list-describe): ... this.
      (guix-ui-define-interface, guix-ui-info-define-interface)
      (guix-ui-list-define-interface): New macros.
      (guix-ui-font-lock-keywords): New variable.
    * emacs.am (ELFILES): Add "emacs/guix-ui.el"
---
 emacs.am           |    1 +
 emacs/guix-base.el |  122 ++++++++++++++++++++++++----------------------------
 emacs/guix-info.el |   30 +++++++++++--
 emacs/guix-list.el |   47 ++++++++++----------
 emacs/guix-ui.el   |  109 ++++++++++++++++++++++++++++++++++++++++++++++
 5 files changed, 216 insertions(+), 93 deletions(-)

diff --git a/emacs.am b/emacs.am
index a205b0a..ad7de78 100644
--- a/emacs.am
+++ b/emacs.am
@@ -40,6 +40,7 @@ ELFILES =                                     \
   emacs/guix-prettify.el                       \
   emacs/guix-profiles.el                       \
   emacs/guix-read.el                           \
+  emacs/guix-ui.el                             \
   emacs/guix-utils.el                          \
   emacs/guix.el
 
diff --git a/emacs/guix-base.el b/emacs/guix-base.el
index f55e1c6..67b83cf 100644
--- a/emacs/guix-base.el
+++ b/emacs/guix-base.el
@@ -23,7 +23,7 @@
 ;; package.
 
 ;; List and info buffers have many common patterns that are defined
-;; using `guix-define-buffer-type' macro from this file.
+;; using `guix-buffer-define-interface' macro from this file.
 
 ;;; Code:
 
@@ -337,103 +337,93 @@ VAL is a value of this parameter.")
                     (concat (symbol-name entry-type) "-"))
                   (symbol-name buffer-type) "-" postfix)))
 
-(defmacro guix-define-buffer-type (buf-type entry-type &rest args)
-  "Define common for BUF-TYPE buffers for displaying ENTRY-TYPE entries.
-
-In the text below TYPE means ENTRY-TYPE-BUF-TYPE.
-
-This macro defines `guix-TYPE-mode', a custom group and several
-user variables.
+(defmacro guix-buffer-define-interface (buffer-type entry-type &rest args)
+  "Define BUFFER-TYPE interface for displaying ENTRY-TYPE entries.
+Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ...
+In the following description TYPE means ENTRY-TYPE-BUFFER-TYPE.
 
 The following stuff should be defined outside this macro:
 
-  - `guix-BUF-TYPE-mode' - parent mode for the defined mode.
+  - `guix-BUFFER-TYPE-mode' - parent mode of the generated mode.
 
   - `guix-TYPE-mode-initialize' (optional) - function for
   additional mode settings; it is called without arguments.
 
-Remaining argument (ARGS) should have a form [KEYWORD VALUE] ...  The
-following keywords are available:
+Optional keywords:
 
-  - `:buffer-name' - default value for the defined
+  - `:buffer-name' - default value of the generated
     `guix-TYPE-buffer-name' variable.
 
-  - `:required' - default value for the defined
-    `guix-TYPE-required-params' variable.
-
-  - `:history-size' - default value for the defined
+  - `:history-size' - default value of the generated
     `guix-TYPE-history-size' variable.
 
-  - `:revert' - default value for the defined
-    `guix-TYPE-revert-no-confirm' variable."
-  (let* ((entry-type-str (symbol-name entry-type))
-         (buf-type-str   (symbol-name buf-type))
-         (Entry-type-str (capitalize entry-type-str))
-         (Buf-type-str   (capitalize buf-type-str))
-         (entry-str      (concat entry-type-str " entries"))
-         (buf-str        (concat buf-type-str " buffer"))
-         (prefix         (concat "guix-" entry-type-str "-" buf-type-str))
-         (group          (intern prefix))
-         (faces-group    (intern (concat prefix "-faces")))
-         (mode-map-str   (concat prefix "-mode-map"))
-         (parent-mode    (intern (concat "guix-" buf-type-str "-mode")))
-         (mode           (intern (concat prefix "-mode")))
-         (mode-init-fun  (intern (concat prefix "-mode-initialize")))
-         (buf-name-var   (intern (concat prefix "-buffer-name")))
-         (revert-var     (intern (concat prefix "-revert-no-confirm")))
-         (history-var    (intern (concat prefix "-history-size")))
-         (params-var     (intern (concat prefix "-required-params"))))
+  - `:revert-confirm?' - default value of the generated
+    `guix-TYPE-revert-confirm' variable."
+  (declare (indent 2))
+  (let* ((entry-type-str     (symbol-name entry-type))
+         (buffer-type-str    (symbol-name buffer-type))
+         (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))
+         (faces-group        (intern (concat prefix "-faces")))
+         (mode-map-str       (concat prefix "-mode-map"))
+         (parent-mode        (intern (concat "guix-" buffer-type-str "-mode")))
+         (mode               (intern (concat prefix "-mode")))
+         (mode-init-fun      (intern (concat prefix "-mode-initialize")))
+         (buffer-name-var    (intern (concat prefix "-buffer-name")))
+         (history-size-var   (intern (concat prefix "-history-size")))
+         (revert-confirm-var (intern (concat prefix "-revert-confirm"))))
     (guix-keyword-args-let args
-        ((params-val :required '(id))
-         (history-val :history-size 20)
-         (revert-val :revert)
-         (buf-name-val :buffer-name
-                       (format "*Guix %s %s*" Entry-type-str Buf-type-str)))
+        ((buffer-name-val    :buffer-name
+                             (format "*Guix %s %s*"
+                                     Entry-type-str Buffer-type-str))
+         (history-size-val   :history-size 20)
+         (revert-confirm-val :revert-confirm? t))
       `(progn
          (defgroup ,group nil
-           ,(concat Buf-type-str " buffer with " entry-str ".")
+           ,(format "Display '%s' entries in '%s' buffer."
+                    entry-type-str buffer-type-str)
            :prefix ,(concat prefix "-")
-           :group ',(intern (concat "guix-" buf-type-str)))
+           :group ',(intern (concat "guix-" buffer-type-str)))
 
          (defgroup ,faces-group nil
-           ,(concat "Faces for " buf-type-str " buffer with " entry-str ".")
-           :group ',(intern (concat "guix-" buf-type-str "-faces")))
-
-         (defcustom ,buf-name-var ,buf-name-val
-           ,(concat "Default name of the " buf-str " for displaying " 
entry-str ".")
+           ,(format "Faces for displaying '%s' entries in '%s' buffer."
+                    entry-type-str buffer-type-str)
+           :group ',(intern (concat "guix-" buffer-type-str "-faces")))
+
+         (defcustom ,buffer-name-var ,buffer-name-val
+           ,(format "\
+Default name of '%s' buffer for displaying '%s' entries."
+                    buffer-type-str entry-type-str)
            :type 'string
            :group ',group)
 
-         (defcustom ,history-var ,history-val
-           ,(concat "Maximum number of items saved in the history of the " 
buf-str ".\n"
-                    "If 0, the history is disabled.")
+         (defcustom ,history-size-var ,history-size-val
+           ,(format "\
+Maximum number of items saved in history of `%S' buffer.
+If 0, the history is disabled."
+                    buffer-name-var)
            :type 'integer
            :group ',group)
 
-         (defcustom ,revert-var ,revert-val
-           ,(concat "If non-nil, do not ask to confirm for reverting the " 
buf-str ".")
+         (defcustom ,revert-confirm-var ,revert-confirm-val
+           ,(format "\
+If non-nil, ask to confirm for reverting `%S' buffer."
+                    buffer-name-var)
            :type 'boolean
            :group ',group)
 
-         (defvar ,params-var ',params-val
-           ,(concat "List of required " entry-type-str " parameters.\n\n"
-                    "Displayed parameters and parameters from this list are 
received\n"
-                    "for each " entry-type-str ".\n\n"
-                    "May be a special value `all', in which case all 
supported\n"
-                    "parameters are received (this may be very slow for a big 
number\n"
-                    "of entries).\n\n"
-                    "Do not remove `id' from this list as it is required for\n"
-                    "identifying an entry."))
-
-         (define-derived-mode ,mode ,parent-mode ,(concat "Guix-" Buf-type-str)
+         (define-derived-mode ,mode ,parent-mode ,(concat "Guix-" 
Buffer-type-str)
            ,(concat "Major mode for displaying information about " entry-str 
".\n\n"
                     "\\{" mode-map-str "}")
            (setq-local revert-buffer-function 'guix-revert-buffer)
-           (setq-local guix-history-size ,history-var)
+           (setq-local guix-history-size ,history-size-var)
            (and (fboundp ',mode-init-fun) (,mode-init-fun)))))))
 
-(put 'guix-define-buffer-type 'lisp-indent-function 'defun)
-
 
 ;;; Getting and displaying info about packages and generations
 
diff --git a/emacs/guix-info.el b/emacs/guix-info.el
index 9c46810..d31e037 100644
--- a/emacs/guix-info.el
+++ b/emacs/guix-info.el
@@ -28,6 +28,7 @@
 (require 'guix-base)
 (require 'guix-entry)
 (require 'guix-utils)
+(require 'guix-ui)
 
 (defgroup guix-info nil
   "General settings for info buffers."
@@ -455,6 +456,8 @@ See `insert-text-button' for the meaning of PROPERTIES."
          properties))
 
 
+;;; Major mode and interface definer
+
 (defvar guix-info-mode-map
   (let ((map (make-sparse-keymap)))
     (set-keymap-parent
@@ -466,11 +469,21 @@ See `insert-text-button' for the meaning of PROPERTIES."
 (define-derived-mode guix-info-mode special-mode "Guix-Info"
   "Parent mode for displaying information in info buffers.")
 
+(defmacro guix-info-define-interface (entry-type &rest args)
+  "Define 'info' interface for displaying ENTRY-TYPE entries.
+Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ...
+
+The rest keyword arguments are passed to
+`guix-buffer-define-interface' macro."
+  (declare (indent 1))
+  `(guix-buffer-define-interface info ,entry-type
+     ,@args))
+
 
 ;;; Displaying packages
 
-(guix-define-buffer-type info package
-  :required (id name version installed non-unique))
+(guix-ui-info-define-interface package
+  :required '(id name version installed non-unique))
 
 (defface guix-package-info-heading
   '((t :inherit guix-info-heading))
@@ -758,7 +771,7 @@ This function is used to hide a \"Download\" button if 
needed."
 
 (guix-ui-info-define-interface output
   :buffer-name "*Guix Package Info*"
-  :required (id package-id installed non-unique))
+  :required '(id package-id installed non-unique))
 
 (defun guix-output-info-insert-version (version entry)
   "Insert output VERSION and obsolete text if needed at point."
@@ -786,7 +799,7 @@ This function is used to hide a \"Download\" button if 
needed."
 
 ;;; Displaying generations
 
-(guix-define-buffer-type info generation)
+(guix-ui-info-define-interface generation)
 
 (defface guix-generation-info-number
   '((t :inherit font-lock-keyword-face))
@@ -837,6 +850,15 @@ This function is used to hide a \"Download\" button if 
needed."
      "Switch to this generation (make it the current one)"
      'number (guix-entry-value entry 'number))))
 
+
+(defvar guix-info-font-lock-keywords
+  (eval-when-compile
+    `((,(rx "(" (group "guix-info-define-interface")
+            symbol-end)
+       . 1))))
+
+(font-lock-add-keywords 'emacs-lisp-mode guix-info-font-lock-keywords)
+
 (provide 'guix-info)
 
 ;;; guix-info.el ends here
diff --git a/emacs/guix-list.el b/emacs/guix-list.el
index e1fc199..8943e8f 100644
--- a/emacs/guix-list.el
+++ b/emacs/guix-list.el
@@ -30,6 +30,7 @@
 (require 'guix-base)
 (require 'guix-entry)
 (require 'guix-utils)
+(require 'guix-ui)
 
 (defgroup guix-list nil
   "General settings for list buffers."
@@ -73,17 +74,12 @@ With prefix argument, describe entries marked with any 
mark."
                                 count)))
       (guix-list-describe-entries entry-type ids))))
 
-(defun guix-list-describe-ids (ids)
-  "Describe entries with IDS (list of identifiers)."
-  (apply #'guix-get-show-entries
-         guix-profile 'info guix-entry-type 'id ids))
-
 
 ;;; Wrappers for 'list' variables
 
 (defvar guix-list-data nil
   "Alist with 'list' data.
-This alist is filled by `guix-list-define-entry-type' macro.")
+This alist is filled by `guix-list-define-interface' macro.")
 
 (defun guix-list-value (entry-type symbol)
   "Return SYMBOL's value for ENTRY-TYPE from `guix-list-data'."
@@ -416,8 +412,8 @@ Same as `tabulated-list-sort', but also restore marks after 
sorting."
   (setq-local guix-list-marks   (guix-list-marks entry-type))
   (tabulated-list-init-header))
 
-(defmacro guix-list-define-entry-type (entry-type &rest args)
-  "Define common stuff for displaying ENTRY-TYPE entries in list buffers.
+(defmacro guix-list-define-interface (entry-type &rest args)
+  "Define 'list' interface for displaying ENTRY-TYPE entries.
 Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ...
 
 Required keywords:
@@ -435,7 +431,10 @@ Optional keywords:
 
   - `:marks' - default value of the generated
     `guix-ENTRY-TYPE-list-marks' variable.
-"
+
+The rest keyword arguments are passed to
+`guix-buffer-define-interface' macro."
+  (declare (indent 1))
   (let* ((entry-type-str     (symbol-name entry-type))
          (prefix             (concat "guix-" entry-type-str "-list"))
          (group              (intern prefix))
@@ -518,17 +517,15 @@ See also `guix-list-describe'."
             (format         . ,format-var)
             (sort-key       . ,sort-key-var)
             (marks          . ,marks-var))
-          'guix-list-data ',entry-type)))))
+          'guix-list-data ',entry-type)
 
-(put 'guix-list-define-entry-type 'lisp-indent-function 'defun)
+         (guix-buffer-define-interface list ,entry-type
+           ,@%foreign-args)))))
 
 
 ;;; Displaying packages
 
-(guix-define-buffer-type list package)
-
-(guix-list-define-entry-type package
-  :describe-function 'guix-list-describe-ids
+(guix-ui-list-define-interface package
   :format '((name guix-package-list-get-name 20 t)
             (version nil 10 nil)
             (outputs nil 13 t)
@@ -717,17 +714,15 @@ The specification is suitable for 
`guix-process-package-actions'."
 
 ;;; Displaying outputs
 
-(guix-define-buffer-type list output
+(guix-ui-list-define-interface output
   :buffer-name "*Guix Package List*"
-  :required (package-id))
-
-(guix-list-define-entry-type output
   :describe-function 'guix-output-list-describe
   :format '((name guix-package-list-get-name 20 t)
             (version nil 10 nil)
             (output nil 9 t)
             (installed nil 12 t)
             (synopsis guix-list-get-one-line 30 nil))
+  :required '(package-id)
   :sort-key '(name)
   :marks '((install . ?I)
            (upgrade . ?U)
@@ -816,10 +811,7 @@ See `guix-package-info-type'."
 
 ;;; Displaying generations
 
-(guix-define-buffer-type list generation)
-
-(guix-list-define-entry-type generation
-  :describe-function 'guix-list-describe-ids
+(guix-ui-list-define-interface generation
   :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)
@@ -954,6 +946,15 @@ With ARG, mark all generations for deletion."
         (user-error "No generations marked for deletion"))
     (guix-delete-generations guix-profile marked (current-buffer))))
 
+
+(defvar guix-list-font-lock-keywords
+  (eval-when-compile
+    `((,(rx "(" (group "guix-list-define-interface")
+            symbol-end)
+       . 1))))
+
+(font-lock-add-keywords 'emacs-lisp-mode guix-list-font-lock-keywords)
+
 (provide 'guix-list)
 
 ;;; guix-list.el ends here
diff --git a/emacs/guix-ui.el b/emacs/guix-ui.el
new file mode 100644
index 0000000..4f46882
--- /dev/null
+++ b/emacs/guix-ui.el
@@ -0,0 +1,109 @@
+;;; guix-ui.el --- Common code for Guix package management interface  -*- 
lexical-binding: t -*-
+
+;; Copyright © 2014, 2015 Alex Kost <address@hidden>
+
+;; This file is part of GNU Guix.
+
+;; GNU Guix is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Guix is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file provides some general code for 'list'/'info' interfaces for
+;; packages and generations.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'guix-utils)
+
+(defun guix-ui-list-describe (ids)
+  "Describe 'ui' entries with IDS (list of identifiers)."
+  (apply #'guix-get-show-entries
+         guix-profile 'info guix-entry-type 'id ids))
+
+
+;;; Interface definers
+
+(defmacro guix-ui-define-interface (buffer-type entry-type &rest args)
+  "Define BUFFER-TYPE interface for displaying ENTRY-TYPE entries.
+Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ...
+In the following description TYPE means ENTRY-TYPE-BUFFER-TYPE.
+
+Optional keywords:
+
+  - `:required' - default value of the generated
+    `guix-TYPE-required-params' variable.
+
+The rest keyword arguments are passed to
+`guix-BUFFER-TYPE-define-interface' macro."
+  (declare (indent 2))
+  (let* ((entry-type-str  (symbol-name entry-type))
+         (buffer-type-str (symbol-name buffer-type))
+         (prefix          (concat "guix-" entry-type-str "-"
+                                  buffer-type-str))
+         (required-var    (intern (concat prefix "-required-params")))
+         (definer         (intern (format "guix-%s-define-interface"
+                                          buffer-type-str))))
+    (guix-keyword-args-let args
+        ((required-val    :required ''(id)))
+      `(progn
+         (defvar ,required-var ,required-val
+           ,(format "\
+List of the required '%s' parameters for '%s' buffer.
+These parameters are received along with the displayed parameters."
+                    entry-type-str buffer-type-str))
+
+         (,definer ,entry-type
+           ,@%foreign-args)))))
+
+(defmacro guix-ui-info-define-interface (entry-type &rest args)
+  "Define 'info' interface for displaying ENTRY-TYPE entries.
+See `guix-ui-define-interface'."
+  (declare (indent 1))
+  `(guix-ui-define-interface info ,entry-type
+     ,@args))
+
+(defmacro guix-ui-list-define-interface (entry-type &rest args)
+  "Define 'list' interface for displaying ENTRY-TYPE entries.
+Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ...
+
+Optional keywords:
+
+  - `:describe-function' - default value of the generated
+    `guix-ENTRY-TYPE-list-describe-function' variable (if not
+    specified, use `guix-ui-list-describe').
+
+The rest keyword arguments are passed to
+`guix-ui-define-interface' macro."
+  (declare (indent 1))
+  (guix-keyword-args-let args
+      ((describe-val :describe-function))
+    `(guix-ui-define-interface list ,entry-type
+       :describe-function ,(or describe-val ''guix-ui-list-describe)
+       ,@args)))
+
+
+(defvar guix-ui-font-lock-keywords
+  (eval-when-compile
+    `((,(rx "(" (group (or "guix-ui-define-interface"
+                           "guix-ui-info-define-interface"
+                           "guix-ui-list-define-interface"))
+            symbol-end)
+       . 1))))
+
+(font-lock-add-keywords 'emacs-lisp-mode guix-ui-font-lock-keywords)
+
+(provide 'guix-ui)
+
+;;; guix-ui.el ends here