~ruther/guix-local

dfeb023927799b45616b435d27001b0fbd533c2b — Alex Kost 11 years ago 8689901
emacs: Use general functions instead of generated ones.

* emacs/guix-base.el: Add and use general functions instead of
  specialized functions generated by 'guix-define-buffer-type' macro.
  (guix-buffer-type, guix-entry-type): New variables.
  (guix-set-vars): Add new variables.
  (guix-get-show-entries, guix-show-entries, guix-set-buffer)
  (guix-history-call, guix-make-history-item)
  (guix-get-params-for-receiving, guix-revert-buffer)
  (guix-redisplay-buffer): New functions.
  (guix-define-buffer-type): Do not generate specialized functions.
* emacs/guix-info.el (guix-package-info-insert-full-names): Use
  'guix-get-show-entries'.
  (guix-generation-info-insert-number): Likewise.
* emacs/guix-list.el (guix-list-describe): New function.
  (guix-list-define-entry-type): Do not generate specialized one.
  (guix-generation-list-show-packages): Use 'guix-get-show-entries'.
* emacs/guix.el (guix-show-generations-function): Remove.
  (guix-get-show-packages): Use new functions.
  (guix-get-show-generations): Likewise.
4 files changed, 198 insertions(+), 183 deletions(-)

M emacs/guix-base.el
M emacs/guix-info.el
M emacs/guix-list.el
M emacs/guix.el
M emacs/guix-base.el => emacs/guix-base.el +154 -138
@@ 1,4 1,4 @@
;;; guix-base.el --- Common definitions
;;; guix-base.el --- Common definitions   -*- lexical-binding: t -*-

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



@@ 179,6 179,14 @@ PARAM is a name of the entry parameter.
VAL is a value of this parameter.")
(put 'guix-entries 'permanent-local t)

(defvar-local guix-buffer-type nil
  "Type of the current buffer.")
(put 'guix-buffer-type 'permanent-local t)

(defvar-local guix-entry-type nil
  "Type of the current entry.")
(put 'guix-entry-type 'permanent-local t)

(defvar-local guix-search-type nil
  "Type of the current search.")
(put 'guix-search-type 'permanent-local t)


@@ 187,42 195,32 @@ VAL is a value of this parameter.")
  "Values of the current search.")
(put 'guix-search-vals 'permanent-local t)

(defsubst guix-set-vars (entries search-type search-vals)
  (setq guix-entries entries
(defsubst guix-set-vars (entries buffer-type entry-type
                         search-type search-vals)
  (setq guix-entries     entries
        guix-buffer-type buffer-type
        guix-entry-type  entry-type
        guix-search-type search-type
        guix-search-vals search-vals))

(defmacro guix-define-buffer-type (buf-type entry-type &rest args)
  "Define common stuff for BUF-TYPE buffers for displaying entries.
(defun guix-get-symbol (postfix buffer-type &optional entry-type)
  (intern (concat "guix-"
                  (when entry-type
                    (concat (symbol-name entry-type) "-"))
                  (symbol-name buffer-type) "-" postfix)))

ENTRY-TYPE is a type of displayed entries (see
`guix-get-entries').
(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, several user
variables and the following functions:

  - `guix-TYPE-get-params-for-receiving'
  - `guix-TYPE-revert'
  - `guix-TYPE-redisplay'
  - `guix-TYPE-make-history-item'
  - `guix-TYPE-set'
  - `guix-TYPE-show'
  - `guix-TYPE-get-show'
This macro defines `guix-TYPE-mode', a custom group and several
user variables.

The following stuff should be defined outside this macro:

  - `guix-BUF-TYPE-mode' - parent mode for the defined mode.

  - `guix-BUF-TYPE-insert-entries' - function for inserting
  entries in the current buffer; it is called with 2 arguments:
  entries of the form of `guix-entries' and ENTRY-TYPE.

  - `guix-BUF-TYPE-get-displayed-params' - function returning a
  list of parameters displayed in the current buffer; it is
  called with ENTRY-TYPE as argument.

  - `guix-TYPE-mode-initialize' (optional) - function for
  additional mode settings; it is called without arguments.



@@ 252,15 250,8 @@ following keywords are available:
         (mode-init-fun  (intern (concat prefix "-mode-initialize")))
         (buf-name-var   (intern (concat prefix "-buffer-name")))
         (revert-var     (intern (concat prefix "-revert-no-confirm")))
         (revert-fun     (intern (concat prefix "-revert")))
         (redisplay-fun  (intern (concat prefix "-redisplay")))
         (history-var    (intern (concat prefix "-history-size")))
         (history-fun    (intern (concat prefix "-make-history-item")))
         (params-var     (intern (concat prefix "-required-params")))
         (params-fun     (intern (concat prefix "-get-params-for-receiving")))
         (set-fun        (intern (concat prefix "-set")))
         (show-fun       (intern (concat prefix "-show")))
         (get-show-fun   (intern (concat prefix "-get-show")))
         (revert-val     nil)
         (history-val    20)
         (params-val     '(id)))


@@ 309,7 300,7 @@ following keywords are available:
       (define-derived-mode ,mode ,parent-mode ,(concat "Guix-" Buf-type-str)
         ,(concat "Major mode for displaying information about " entry-str ".\n\n"
                  "\\{" mode-map-str "}")
         (setq-local revert-buffer-function ',revert-fun)
         (setq-local revert-buffer-function 'guix-revert-buffer)
         (setq-local guix-history-size ,history-var)
         (and (fboundp ',mode-init-fun) (,mode-init-fun)))



@@ 317,88 308,140 @@ following keywords are available:
         (define-key map (kbd "l") 'guix-history-back)
         (define-key map (kbd "r") 'guix-history-forward)
         (define-key map (kbd "g") 'revert-buffer)
         (define-key map (kbd "R") ',redisplay-fun)
         (define-key map (kbd "C-c C-z") 'guix-switch-to-repl))

       (defun ,params-fun ()
         ,(concat "Return " entry-type-str " parameters that should be received.")
         (unless (equal ,params-var 'all)
           (cl-union ,params-var
                     (,(intern (concat "guix-" buf-type-str "-get-displayed-params"))
                      ',entry-type))))

       (defun ,revert-fun (_ignore-auto noconfirm)
         "Update information in the current buffer.
         (define-key map (kbd "R") 'guix-redisplay-buffer)
         (define-key map (kbd "C-c C-z") 'guix-switch-to-repl)))))

(put 'guix-define-buffer-type 'lisp-indent-function 'defun)


;;; Getting info about packages and generations

(defun guix-get-entries (entry-type search-type search-vals
                         &optional params)
  "Search for entries of ENTRY-TYPE.

Call an appropriate scheme function and return a list of the
form of `guix-entries'.

ENTRY-TYPE should be one of the following symbols: `package' or
`generation'.

SEARCH-TYPE may be one of the following symbols:

- If ENTRY-TYPE is `package' or `output': `id', `name', `regexp',
  `all-available', `newest-available', `installed', `obsolete',
  `generation'.

- If ENTRY-TYPE is `generation': `id', `last', `all'.

PARAMS is a list of parameters for receiving.  If nil, get
information with all available parameters."
  (guix-eval-read (guix-make-guile-expression
                   'get-entries
                   guix-current-profile params
                   entry-type search-type search-vals)))

(defun guix-get-show-entries (buffer-type entry-type search-type
                                          &rest search-vals)
  "Search for ENTRY-TYPE entries and show results in BUFFER-TYPE buffer.
See `guix-get-entries' for the meaning of SEARCH-TYPE and SEARCH-VALS."
  (let ((entries (guix-get-entries entry-type search-type search-vals
                                   (guix-get-params-for-receiving
                                    buffer-type entry-type))))
    (guix-set-buffer entries buffer-type entry-type
                     search-type search-vals)))

(defun guix-set-buffer (entries buffer-type entry-type search-type
                        search-vals &optional history-replace)
  "Set up BUFFER-TYPE buffer for displaying ENTRY-TYPE ENTRIES.

Display ENTRIES, set variables and make history item.
ENTRIES should have a form of `guix-entries'.

See `guix-get-entries' for the meaning of SEARCH-TYPE and SEARCH-VALS.

If HISTORY-REPLACE is non-nil, replace current history item,
otherwise add the new one."
  (when entries
    (let ((buf (if (eq major-mode (guix-get-symbol
                                   "mode" buffer-type entry-type))
                   (current-buffer)
                 (get-buffer-create
                  (symbol-value
                   (guix-get-symbol "buffer-name"
                                    buffer-type entry-type))))))
      (with-current-buffer buf
        (guix-show-entries entries buffer-type entry-type)
        (guix-set-vars entries buffer-type entry-type
                       search-type search-vals)
        (funcall (if history-replace
                     #'guix-history-replace
                   #'guix-history-add)
                 (guix-make-history-item)))
      (pop-to-buffer buf
                     '((display-buffer-reuse-window
                        display-buffer-same-window)))))
  (guix-result-message entries entry-type search-type search-vals))

(defun guix-show-entries (entries buffer-type entry-type)
  "Display ENTRY-TYPE ENTRIES in the current BUFFER-TYPE buffer."
  (let ((inhibit-read-only t))
    (erase-buffer)
    (funcall (symbol-function (guix-get-symbol
                               "mode" buffer-type entry-type)))
    (funcall (guix-get-symbol "insert-entries" buffer-type)
             entries entry-type)
    (goto-char (point-min))))

(defun guix-history-call (entries buffer-type entry-type
                          search-type search-vals)
  "Function called for moving by history."
  (guix-show-entries entries buffer-type entry-type)
  (guix-set-vars entries buffer-type entry-type
                 search-type search-vals)
  (guix-result-message entries entry-type search-type search-vals))

(defun guix-make-history-item ()
  "Make and return a history item for the current buffer."
  (list #'guix-history-call
        guix-entries guix-buffer-type guix-entry-type
        guix-search-type guix-search-vals))

(defun guix-get-params-for-receiving (buffer-type entry-type)
  "Return parameters that should be received for BUFFER-TYPE, ENTRY-TYPE."
  (let* ((required-var (guix-get-symbol "required-params"
                                        buffer-type entry-type))
         (required (symbol-value required-var)))
    (unless (equal required 'all)
      (cl-union required
                (funcall (guix-get-symbol "get-displayed-params"
                                          buffer-type)
                         entry-type)))))

(defun guix-revert-buffer (_ignore-auto noconfirm)
  "Update information in the current buffer.
The function is suitable for `revert-buffer-function'.
See `revert-buffer' for the meaning of NOCONFIRM."
         (when (or ,revert-var
                   noconfirm
                   (y-or-n-p "Update current information? "))
           (let ((entries (guix-get-entries ',entry-type guix-search-type
                                            guix-search-vals (,params-fun))))
             (,set-fun entries guix-search-type guix-search-vals t))))

       (defun ,redisplay-fun ()
         "Redisplay current information.
  (when (or noconfirm
            (symbol-value
             (guix-get-symbol "revert-no-confirm"
                              guix-buffer-type guix-entry-type))
            (y-or-n-p "Update current information? "))
    (let ((entries (guix-get-entries
                    guix-entry-type guix-search-type guix-search-vals
                    (guix-get-params-for-receiving guix-buffer-type
                                                   guix-entry-type))))
      (guix-set-buffer entries guix-buffer-type guix-entry-type
                       guix-search-type guix-search-vals t))))

(defun guix-redisplay-buffer ()
  "Redisplay current information.
This function will not update the information, use
\"\\[revert-buffer]\" if you want the full update."
         (interactive)
         (,show-fun guix-entries)
         (guix-result-message guix-entries ',entry-type
                              guix-search-type guix-search-vals))

       (defun ,history-fun ()
         "Make and return a history item for the current buffer."
         (list (lambda (entries search-type search-vals)
                 (,show-fun entries)
                 (guix-set-vars entries search-type search-vals)
                 (guix-result-message entries ',entry-type
                                      search-type search-vals))
               guix-entries guix-search-type guix-search-vals))

       (defun ,set-fun (entries search-type search-vals &optional history-replace)
         ,(concat "Set up the " buf-str " for displaying " entry-str ".\n\n"
                  "Display ENTRIES, set variables and make history item.\n\n"
                  "ENTRIES should have a form of `guix-entries'.\n\n"
                  "See `guix-get-entries' for the meaning of SEARCH-TYPE and\n"
                  "SEARCH-VALS.\n\n"
                  "If HISTORY-REPLACE is non-nil, replace current history item,\n"
                  "otherwise add the new one.")
         (when entries
           (let ((buf (if (eq major-mode ',mode)
                          (current-buffer)
                        (get-buffer-create ,buf-name-var))))
             (with-current-buffer buf
               (,show-fun entries)
               (guix-set-vars entries search-type search-vals)
               (funcall (if history-replace
                            #'guix-history-replace
                          #'guix-history-add)
                        (,history-fun)))
             (pop-to-buffer buf
                            '((display-buffer-reuse-window
                               display-buffer-same-window)))))
         (guix-result-message entries ',entry-type
                              search-type search-vals))

       (defun ,show-fun (entries)
         ,(concat "Display " entry-type-str " ENTRIES in the current " buf-str ".")
         (let ((inhibit-read-only t))
           (erase-buffer)
           (,mode)
           (,(intern (concat "guix-" buf-type-str "-insert-entries"))
            entries ',entry-type)
           (goto-char (point-min))))

       (defun ,get-show-fun (search-type &rest search-vals)
         ,(concat "Search for " entry-str " and show results in the " buf-str ".\n"
                  "See `guix-get-entries' for the meaning of SEARCH-TYPE and\n"
                  "SEARCH-VALS.")
         (let ((entries (guix-get-entries ',entry-type search-type
                                          search-vals (,params-fun))))
           (,set-fun entries search-type search-vals))))))

(put 'guix-define-buffer-type 'lisp-indent-function 'defun)
  (interactive)
  (guix-show-entries guix-entries guix-buffer-type guix-entry-type)
  (guix-result-message guix-entries guix-entry-type
                       guix-search-type guix-search-vals))


;;; Messages


@@ 467,33 510,6 @@ This function will not update the information, use
    (apply #'message format args)))


;;; Getting info about packages and generations

(defun guix-get-entries (entry-type search-type search-vals &optional params)
  "Search for entries of ENTRY-TYPE.

Call an appropriate scheme function and return a list of the
form of `guix-entries'.

ENTRY-TYPE should be one of the following symbols: `package' or
`generation'.

SEARCH-TYPE may be one of the following symbols:

- If ENTRY-TYPE is `package': `id', `name', `regexp',
  `all-available', `newest-available', `installed', `obsolete',
  `generation'.

- If ENTRY-TYPE is `generation': `id', `last', `all'.

PARAMS is a list of parameters for receiving.  If nil, get
information with all available parameters."
  (guix-eval-read (guix-make-guile-expression
                   'get-entries
                   guix-current-profile params
                   entry-type search-type search-vals)))


;;; Actions on packages and generations

(defcustom guix-operation-confirm t

M emacs/guix-info.el => emacs/guix-info.el +4 -5
@@ 427,7 427,8 @@ Propertize package button with FACE."
  (guix-insert-button
   name face
   (lambda (btn)
     (guix-package-info-get-show 'name (button-label btn)))
     (guix-get-show-entries 'info 'package 'name
                            (button-label btn)))
   "Describe this package"))




@@ 532,8 533,6 @@ ENTRY is an alist with package info."
  "Face used for a number of a generation."
  :group 'guix-generation-info)

(declare-function guix-package-list-get-show "guix-list" t t)

(defun guix-generation-info-insert-number (number &optional _)
  "Insert generation NUMBER and action buttons."
  (guix-info-insert-val-default number 'guix-generation-info-number)


@@ 541,8 540,8 @@ ENTRY is an alist with package info."
  (guix-info-insert-action-button
   "Packages"
   (lambda (btn)
     (guix-package-list-get-show 'generation
                                 (button-get btn 'number)))
     (guix-get-show-entries 'list 'package 'generation
                            (button-get btn 'number)))
   "Show installed packages for this generation"
   'number number)
  (guix-info-insert-indent)

M emacs/guix-list.el => emacs/guix-list.el +19 -23
@@ 343,6 343,7 @@ Same as `tabulated-list-sort', but also restore marks after sorting."
(defvar guix-list-mode-map
  (let ((map (make-sparse-keymap)))
    (set-keymap-parent map tabulated-list-mode-map)
    (define-key map (kbd "RET") 'guix-list-describe)
    (define-key map (kbd "m")   'guix-list-mark)
    (define-key map (kbd "*")   'guix-list-mark)
    (define-key map (kbd "M")   'guix-list-mark-all)


@@ 371,16 372,12 @@ following keywords are available:

This macro defines the following functions:

  - `guix-ENTRY-TYPE-describe' - display marked entries in info buffer.

  - `guix-ENTRY-TYPE-mark-MARK-NAME' functions for each mark
    specified in `:marks' argument."
  (let* ((entry-type-str (symbol-name entry-type))
         (entry-str      (concat entry-type-str " entries"))
         (prefix         (concat "guix-" entry-type-str "-list"))
         (mode-str       (concat prefix "-mode"))
         (init-fun       (intern (concat prefix "-mode-initialize")))
         (describe-fun   (intern (concat prefix "-describe")))
         (marks-var      (intern (concat prefix "-mark-alist")))
         (marks-val      nil)
         (sort-key       nil)


@@ 409,22 406,6 @@ This macro defines the following functions:
                        (guix-list-mark ',mark-name t))))
                 marks-val)

       (defun ,describe-fun (&optional arg)
         ,(concat "Describe " entry-str " marked with a general mark.\n"
                  "If no entry is marked, describe the current " entry-type-str ".\n"
                  "With prefix (if ARG is non-nil), describe the " entry-str "\n"
                  "marked with any mark.")
         (interactive "P")
         (let* ((ids (or (apply #'guix-list-get-marked-id-list
                                (unless arg '(general)))
                         (list (guix-list-current-id))))
                (count (length ids)))
           (when (or (<= count guix-list-describe-warning-count)
                     (y-or-n-p (format "Do you really want to describe %d entries? "
                                       count)))
             (,(intern (concat "guix-" entry-type-str "-info-get-show"))
              'id ids))))

       (defun ,init-fun ()
         ,(concat "Initial settings for `" mode-str "'.")
         ,(when sort-key


@@ 439,6 420,21 @@ This macro defines the following functions:

(put 'guix-list-define-entry-type 'lisp-indent-function 'defun)

(defun guix-list-describe (&optional arg)
  "Describe entries marked with a general mark.
If no entries are marked, describe the current entry.
With prefix (if ARG is non-nil), describe entries marked with any mark."
  (interactive "P")
  (let* ((ids (or (apply #'guix-list-get-marked-id-list
                         (unless arg '(general)))
                  (list (guix-list-current-id))))
         (count (length ids)))
    (when (or (<= count guix-list-describe-warning-count)
              (y-or-n-p (format "Do you really want to describe %d entries? "
                                count)))
      (apply #'guix-get-show-entries
             'info guix-entry-type 'id ids))))


;;; Displaying packages



@@ 477,7 473,6 @@ likely)."
  :group 'guix-package-list)

(let ((map guix-package-list-mode-map))
  (define-key map (kbd "RET") 'guix-package-list-describe)
  (define-key map (kbd "x")   'guix-package-list-execute)
  (define-key map (kbd "i")   'guix-package-list-mark-install)
  (define-key map (kbd "d")   'guix-package-list-mark-delete)


@@ 617,13 612,14 @@ The specification is suitable for `guix-process-package-actions'."

(let ((map guix-generation-list-mode-map))
  (define-key map (kbd "RET") 'guix-generation-list-show-packages)
  (define-key map (kbd "i")   'guix-generation-list-describe)
  (define-key map (kbd "i")   'guix-list-describe)
  (define-key map (kbd "d")   'guix-generation-list-mark-delete-simple))

(defun guix-generation-list-show-packages ()
  "List installed packages for the generation at point."
  (interactive)
  (guix-package-list-get-show 'generation (guix-list-current-id)))
  (guix-get-show-entries 'list 'package 'generation
                         (guix-list-current-id)))

(provide 'guix-list)


M emacs/guix.el => emacs/guix.el +21 -17
@@ 28,6 28,7 @@

;;; Code:

(require 'guix-base)
(require 'guix-list)
(require 'guix-info)



@@ 42,12 43,6 @@ If nil, show a single package in the info buffer."
  :type 'boolean
  :group 'guix)

(defcustom guix-show-generations-function 'guix-generation-list-get-show
  "Default function used to display generations."
  :type '(choice (function-item guix-generation-list-get-show)
                 (function-item guix-generation-info-get-show))
  :group 'guix)

(defvar guix-search-params '(name synopsis description)
  "Default list of package parameters for searching by regexp.")



@@ 62,22 57,31 @@ SEARCH-VALS.

Results are displayed in the list buffer, unless a single package
is found and `guix-list-single-package' is nil."
  (let* ((list-params (guix-package-list-get-params-for-receiving))
         (packages (guix-get-entries 'package search-type
                                     search-vals list-params)))
  (let* ((list-params (guix-get-params-for-receiving
                       'list 'package))
         (packages (guix-get-entries 'package
                                     search-type search-vals
                                     list-params)))
    (if (or guix-list-single-package
            (cdr packages))
        (guix-package-list-set packages search-type search-vals)
      (let ((info-params (guix-package-info-get-params-for-receiving)))
        (unless (equal list-params info-params)
          ;; If we don't have required info, we should receive it again
          (setq packages (guix-get-entries 'package search-type
                                           search-vals info-params))))
      (guix-package-info-set packages search-type search-vals))))
        (guix-set-buffer packages 'list 'package
                         search-type search-vals)
      (let* ((info-params (guix-get-params-for-receiving
                           'info 'package))
             (packages (if (equal list-params info-params)
                           packages
                         ;; If we don't have required info, we should
                         ;; receive it again
                         (guix-get-entries 'package
                                           search-type search-vals
                                           info-params))))
        (guix-set-buffer packages 'info 'package
                         search-type search-vals)))))

(defun guix-get-show-generations (search-type &rest search-vals)
  "Search for generations and show results."
  (apply guix-show-generations-function search-type search-vals))
  (apply #'guix-get-show-entries
         'list 'generation search-type search-vals))

;;;###autoload
(defun guix-search-by-name (name)