~ruther/guix-local

7735c503b5b8dfe7d8963207f4f2cf0b7dfd3894 — Alex Kost 10 years ago 2c7ed38
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"
5 files changed, 216 insertions(+), 93 deletions(-)

M emacs.am
M emacs/guix-base.el
M emacs/guix-info.el
M emacs/guix-list.el
A emacs/guix-ui.el
M emacs.am => emacs.am +1 -0
@@ 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


M emacs/guix-base.el => emacs/guix-base.el +56 -66
@@ 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


M emacs/guix-info.el => emacs/guix-info.el +26 -4
@@ 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

M emacs/guix-list.el => emacs/guix-list.el +24 -23
@@ 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

A emacs/guix-ui.el => emacs/guix-ui.el +109 -0
@@ 0,0 1,109 @@
;;; guix-ui.el --- Common code for Guix package management interface  -*- lexical-binding: t -*-

;; Copyright © 2014, 2015 Alex Kost <alezost@gmail.com>

;; 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