diff options
Diffstat (limited to 'emacs')
| -rw-r--r-- | emacs/guix-base.el | 396 | ||||
| -rw-r--r-- | emacs/guix-buffer.el | 566 | ||||
| -rw-r--r-- | emacs/guix-info.el | 58 | ||||
| -rw-r--r-- | emacs/guix-list.el | 103 | ||||
| -rw-r--r-- | emacs/guix-ui.el | 80 | ||||
| -rw-r--r-- | emacs/guix.el | 45 |
6 files changed, 779 insertions, 469 deletions
diff --git a/emacs/guix-base.el b/emacs/guix-base.el index 21be02d26d..4bd88992c4 100644 --- a/emacs/guix-base.el +++ b/emacs/guix-base.el @@ -22,9 +22,6 @@ ;; This file provides some base and common definitions for guix.el ;; package. -;; List and info buffers have many common patterns that are defined -;; using `guix-buffer-define-interface' macro from this file. - ;;; Code: (require 'cl-lib) @@ -34,8 +31,6 @@ (require 'guix-guile) (require 'guix-utils) (require 'guix-ui) -(require 'guix-history) -(require 'guix-messages) ;;; Parameters of the entries @@ -143,227 +138,6 @@ For the meaning of location, see `guix-find-location'." #'string<)) -;;; Buffers - -(defun guix-switch-to-buffer (buffer) - "Switch to a 'list' or 'info' BUFFER." - (pop-to-buffer buffer - '((display-buffer-reuse-window - display-buffer-same-window)))) - - -;;; Common definitions for buffer types - -(defvar guix-buffer-data nil - "Alist with 'buffer' data. -This alist is filled by `guix-buffer-define-interface' macro.") - -(defun guix-buffer-value (buffer-type entry-type symbol) - "Return SYMBOL's value for BUFFER-TYPE/ENTRY-TYPE from `guix-buffer-data'." - (symbol-value - (guix-assq-value guix-buffer-data buffer-type entry-type symbol))) - -(defun guix-buffer-param-title (buffer-type entry-type param) - "Return PARAM title for BUFFER-TYPE/ENTRY-TYPE." - (or (guix-assq-value (guix-buffer-value buffer-type entry-type 'titles) - param) - ;; Fallback to a title defined in 'info' interface. - (unless (eq buffer-type 'info) - (guix-assq-value (guix-buffer-value 'info entry-type 'titles) - 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)) - -(defun guix-buffer-revert-confirm? (buffer-type entry-type) - "Return 'revert-confirm' value for BUFFER-TYPE/ENTRY-TYPE." - (guix-buffer-value buffer-type entry-type 'revert-confirm)) - -(defvar guix-buffer-map - (let ((map (make-sparse-keymap))) - (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") 'guix-buffer-redisplay) - map) - "Parent keymap for Guix buffer modes.") - -(defvar-local guix-profile nil - "Profile used for the current buffer.") -(put 'guix-profile 'permanent-local t) - -(defvar-local guix-entries nil - "List of the currently displayed entries. -Each element of the list is alist with entry info of the -following form: - - ((PARAM . VAL) ...) - -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) - -(defvar-local guix-search-vals nil - "Values of the current search.") -(put 'guix-search-vals 'permanent-local t) - -(defsubst guix-set-vars (profile entries buffer-type entry-type - search-type search-vals) - "Set local variables for the current Guix buffer." - (setq default-directory profile - guix-profile profile - guix-entries entries - guix-buffer-type buffer-type - guix-entry-type entry-type - guix-search-type search-type - guix-search-vals search-vals)) - -(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))) - -(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-BUFFER-TYPE-mode' - parent mode of the generated mode. - - - `guix-TYPE-mode-initialize' (optional) - function for - additional mode settings; it is called without arguments. - -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. - - - `:history-size' - default value of the generated - `guix-TYPE-history-size' variable. - - - `:revert-confirm?' - default value of the generated - `guix-TYPE-revert-confirm' variable. - - - `:reduced?' - if non-nil, generate only group, faces group - and titles 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")) - (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"))) - (titles-var (intern (concat prefix "-titles"))) - (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) - (titles-val :titles) - (history-size-val :history-size 20) - (revert-confirm-val :revert-confirm? t) - (reduced? :reduced?)) - `(progn - (defgroup ,group nil - ,(format "Display '%s' entries in '%s' buffer." - entry-type-str buffer-type-str) - :prefix ,(concat prefix "-") - :group ',(intern (concat "guix-" buffer-type-str))) - - (defgroup ,faces-group nil - ,(format "Faces for displaying '%s' entries in '%s' buffer." - entry-type-str buffer-type-str) - :group ',(intern (concat "guix-" buffer-type-str "-faces"))) - - (defcustom ,titles-var ,titles-val - ,(format "Alist of titles of '%s' parameters." - entry-type-str) - :type '(alist :key-type symbol :value-type string) - :group ',group) - - ,(unless reduced? - `(progn - (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-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-confirm-var ,revert-confirm-val - ,(format "\ -If non-nil, ask to confirm for reverting `%S' buffer." - buffer-name-var) - :type 'boolean - :group ',group) - - (guix-alist-put! - '((buffer-name . ,buffer-name-var) - (history-size . ,history-size-var) - (revert-confirm . ,revert-confirm-var)) - 'guix-buffer-data ',buffer-type ',entry-type) - - (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-buffer-revert) - (setq-local guix-history-size - (guix-buffer-history-size - ',buffer-type ',entry-type)) - (and (fboundp ',mode-init-fun) (,mode-init-fun))))) - - (guix-alist-put! - ',titles-var 'guix-buffer-data - ',buffer-type ',entry-type 'titles))))) - - ;;; Getting and displaying info about packages and generations (defcustom guix-package-list-type 'output @@ -384,159 +158,6 @@ information)." (const :tag "Display outputs" output)) :group 'guix) -(defun guix-get-entries (profile 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', -`output' 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', `time'. - -PARAMS is a list of parameters for receiving. If nil, get -information with all available parameters." - (guix-eval-read (guix-make-guile-expression - 'entries - profile params entry-type search-type search-vals))) - -(defun guix-get-show-entries (profile 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 profile entry-type search-type search-vals - (guix-get-params-for-receiving - buffer-type entry-type)))) - (guix-set-buffer profile entries buffer-type entry-type - search-type search-vals))) - -(defun guix-set-buffer (profile entries buffer-type entry-type search-type - search-vals &optional history-replace no-display) - "Set up BUFFER-TYPE buffer for displaying ENTRY-TYPE ENTRIES. - -Insert ENTRIES in buffer, 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. - -If NO-DISPLAY is non-nil, do not switch to the buffer." - (when entries - (let ((buf (if (and (eq major-mode - (guix-get-symbol "mode" buffer-type entry-type)) - (equal guix-profile profile)) - (current-buffer) - (get-buffer-create - (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 - search-type search-vals) - (funcall (if history-replace - #'guix-history-replace - #'guix-history-add) - (guix-make-history-item))) - (or no-display - (guix-switch-to-buffer buf)))) - (guix-result-message profile 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 (profile 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 profile entries buffer-type entry-type - search-type search-vals) - (guix-result-message profile 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-profile 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 "displayed-params" - buffer-type) - entry-type))))) - -(defun guix-buffer-revert (_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 noconfirm - (guix-buffer-revert-confirm? guix-buffer-type - guix-entry-type) - (y-or-n-p "Update current information? ")) - (let* ((params (guix-get-params-for-receiving guix-buffer-type - guix-entry-type)) - (entries (guix-get-entries - guix-profile guix-entry-type - guix-search-type guix-search-vals params))) - (guix-set-buffer guix-profile entries guix-buffer-type guix-entry-type - guix-search-type guix-search-vals t t)))) - -(defvar guix-buffer-after-redisplay-hook nil - "Hook run by `guix-buffer-redisplay'. -This hook is called before seting up a window position.") - -(defun guix-buffer-redisplay () - "Redisplay the current Guix buffer. -Restore the point and window positions after redisplaying. - -This function does not update the buffer data, use -'\\[revert-buffer]' if you want the full update." - (interactive) - (let* ((old-point (point)) - ;; For simplicity, ignore an unlikely case when multiple - ;; windows display the same buffer. - (window (car (get-buffer-window-list (current-buffer) nil t))) - (window-start (and window (window-start window)))) - (guix-set-buffer guix-profile guix-entries guix-buffer-type - guix-entry-type guix-search-type guix-search-vals - t t) - (goto-char old-point) - (run-hooks 'guix-buffer-after-redisplay-hook) - (when window - (set-window-point window (point)) - (set-window-start window window-start)))) - -(defun guix-buffer-redisplay-goto-button () - "Redisplay the current buffer and go to the next button, if needed." - (let ((guix-buffer-after-redisplay-hook - (cons (lambda () - (unless (button-at (point)) - (forward-button 1))) - guix-buffer-after-redisplay-hook))) - (guix-buffer-redisplay))) - ;;; Generations @@ -640,13 +261,14 @@ Create the buffer if needed." (defun guix-profile-generation-manifest-file (generation) "Return the file name of a GENERATION's manifest. -GENERATION is a generation number of `guix-profile' profile." - (guix-manifest-file guix-profile generation)) +GENERATION is a generation number of the current profile." + (guix-manifest-file (guix-ui-current-profile) generation)) (defun guix-profile-generation-packages-buffer (generation) "Insert GENERATION's package outputs in a buffer and return it. -GENERATION is a generation number of `guix-profile' profile." - (guix-generation-packages-buffer guix-profile generation)) +GENERATION is a generation number of the current profile." + (guix-generation-packages-buffer (guix-ui-current-profile) + generation)) ;;; Actions on packages and generations @@ -757,7 +379,7 @@ Ask a user if needed (see `guix-operation-confirm'). INSTALL, UPGRADE, REMOVE are 'package action specifications'. See `guix-process-package-actions' for details." (or (null guix-operation-confirm) - (let* ((entries (guix-get-entries + (let* ((entries (guix-ui-get-entries profile 'package 'id (append (mapcar #'car install) (mapcar #'car upgrade) @@ -930,12 +552,12 @@ See Info node `(guix) Invoking guix package' for details. Interactively, use the current profile and prompt for manifest FILE. With a prefix argument, also prompt for PROFILE." (interactive - (let* ((default-profile (or guix-profile guix-current-profile)) + (let* ((current-profile (guix-ui-current-profile)) (profile (if current-prefix-arg (guix-profile-prompt) - default-profile)) + (or current-profile guix-current-profile))) (file (read-file-name "File with manifest: ")) - (buffer (and guix-profile (current-buffer)))) + (buffer (and current-profile (current-buffer)))) (list profile file buffer))) (when (or (not guix-operation-confirm) (y-or-n-p (format "Apply manifest from '%s' to profile '%s'? " diff --git a/emacs/guix-buffer.el b/emacs/guix-buffer.el new file mode 100644 index 0000000000..5687a250aa --- /dev/null +++ b/emacs/guix-buffer.el @@ -0,0 +1,566 @@ +;;; guix-buffer.el --- Buffer interface for displaying data -*- 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 a general 'buffer' interface for displaying an +;; arbitrary data. + +;;; Code: + +(require 'cl-lib) +(require 'guix-history) +(require 'guix-utils) + +(defvar guix-buffer-map + (let ((map (make-sparse-keymap))) + (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") 'guix-buffer-redisplay) + map) + "Parent keymap for Guix buffer modes.") + + +;;; Buffer item + +(cl-defstruct (guix-buffer-item + (:constructor nil) + (:constructor guix-buffer-make-item + (entries buffer-type entry-type args)) + (:copier nil)) + entries buffer-type entry-type args) + +(defvar-local guix-buffer-item nil + "Data (structure) for the current Guix buffer. +The structure consists of the following elements: + +- `entries': list of the currently displayed entries. + + Each element of the list is an alist with an entry data of the + following form: + + ((PARAM . VAL) ...) + + PARAM is a name of the entry parameter. + VAL is a value of this parameter. + +- `entry-type': type of the currently displayed entries. + +- `buffer-type': type of the current buffer. + +- `args': search arguments used to get the current entries.") +(put 'guix-buffer-item 'permanent-local t) + +(defmacro guix-buffer-with-item (item &rest body) + "Evaluate BODY using buffer ITEM. +The following local variables are available inside BODY: +`%entries', `%buffer-type', `%entry-type', `%args'. +See `guix-buffer-item' for details." + (declare (indent 1) (debug t)) + (let ((item-var (make-symbol "item"))) + `(let ((,item-var ,item)) + (let ((%entries (guix-buffer-item-entries ,item-var)) + (%buffer-type (guix-buffer-item-buffer-type ,item-var)) + (%entry-type (guix-buffer-item-entry-type ,item-var)) + (%args (guix-buffer-item-args ,item-var))) + ,@body)))) + +(defmacro guix-buffer-with-current-item (&rest body) + "Evaluate BODY using `guix-buffer-item'. +See `guix-buffer-with-item' for details." + (declare (indent 0) (debug t)) + `(guix-buffer-with-item guix-buffer-item + ,@body)) + +(defmacro guix-buffer-define-current-item-accessor (name) + "Define `guix-buffer-current-NAME' function to access NAME +element of `guix-buffer-item' structure. +NAME should be a symbol." + (let* ((name-str (symbol-name name)) + (accessor (intern (concat "guix-buffer-item-" name-str))) + (fun-name (intern (concat "guix-buffer-current-" name-str))) + (doc (format "\ +Return '%s' of the current Guix buffer. +See `guix-buffer-item' for details." + name-str))) + `(defun ,fun-name () + ,doc + (and guix-buffer-item + (,accessor guix-buffer-item))))) + +(defmacro guix-buffer-define-current-item-accessors (&rest names) + "Define `guix-buffer-current-NAME' functions for NAMES. +See `guix-buffer-define-current-item-accessor' for details." + `(progn + ,@(mapcar (lambda (name) + `(guix-buffer-define-current-item-accessor ,name)) + names))) + +(guix-buffer-define-current-item-accessors + entries entry-type buffer-type args) + +(defmacro guix-buffer-define-current-args-accessor (n prefix name) + "Define `PREFIX-NAME' function to access Nth element of 'args' +field of `guix-buffer-item' structure. +PREFIX and NAME should be strings." + (let ((fun-name (intern (concat prefix "-" name))) + (doc (format "\ +Return '%s' of the current Guix buffer. +'%s' is the element number %d in 'args' of `guix-buffer-item'." + name name n))) + `(defun ,fun-name () + ,doc + (nth ,n (guix-buffer-current-args))))) + +(defmacro guix-buffer-define-current-args-accessors (prefix &rest names) + "Define `PREFIX-NAME' functions for NAMES. +See `guix-buffer-define-current-args-accessor' for details." + `(progn + ,@(cl-loop for name in names + for i from 0 + collect `(guix-buffer-define-current-args-accessor + ,i ,prefix ,name)))) + + +;;; Wrappers for defined variables + +(defvar guix-buffer-data nil + "Alist with 'buffer' data. +This alist is filled by `guix-buffer-define-interface' macro.") + +(defun guix-buffer-value (buffer-type entry-type symbol) + "Return SYMBOL's value for BUFFER-TYPE/ENTRY-TYPE from `guix-buffer-data'." + (symbol-value + (guix-assq-value guix-buffer-data buffer-type entry-type symbol))) + +(defun guix-buffer-get-entries (buffer-type entry-type args) + "Return ENTRY-TYPE entries. +Call an appropriate 'get-entries' function from `guix-buffer' +using ARGS as its arguments." + (apply (guix-buffer-value buffer-type entry-type 'get-entries) + args)) + +(defun guix-buffer-mode-enable (buffer-type entry-type) + "Turn on major mode to display ENTRY-TYPE ENTRIES in BUFFER-TYPE buffer." + (funcall (guix-buffer-value buffer-type entry-type 'mode))) + +(defun guix-buffer-mode-initialize (buffer-type entry-type) + "Set up the current BUFFER-TYPE buffer to display ENTRY-TYPE entries." + (let ((fun (guix-buffer-value buffer-type entry-type 'mode-init))) + (when fun + (funcall fun)))) + +(defun guix-buffer-insert-entries (entries buffer-type entry-type) + "Show ENTRY-TYPE ENTRIES in the current BUFFER-TYPE buffer." + (funcall (guix-buffer-value buffer-type entry-type 'insert-entries) + entries)) + +(defun guix-buffer-show-entries-default (entries buffer-type entry-type) + "Show ENTRY-TYPE ENTRIES in the current BUFFER-TYPE buffer." + (let ((inhibit-read-only t)) + (erase-buffer) + (guix-buffer-mode-enable buffer-type entry-type) + (guix-buffer-insert-entries entries buffer-type entry-type) + (goto-char (point-min)))) + +(defun guix-buffer-show-entries (entries buffer-type entry-type) + "Show ENTRY-TYPE ENTRIES in the current BUFFER-TYPE buffer." + (funcall (guix-buffer-value buffer-type entry-type 'show-entries) + entries)) + +(defun guix-buffer-message (entries buffer-type entry-type args) + "Display a message for BUFFER-ITEM after showing entries." + (let ((fun (guix-buffer-value buffer-type entry-type 'message))) + (when fun + (apply fun entries args)))) + +(defun guix-buffer-name (buffer-type entry-type args) + "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 + (apply str-or-fun args)))) + +(defun guix-buffer-param-title (buffer-type entry-type param) + "Return PARAM title for BUFFER-TYPE/ENTRY-TYPE." + (or (guix-assq-value (guix-buffer-value buffer-type entry-type 'titles) + param) + ;; Fallback to a title defined in 'info' interface. + (unless (eq buffer-type 'info) + (guix-assq-value (guix-buffer-value 'info entry-type 'titles) + param)) + (guix-symbol-title param))) + +(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)) + +(defun guix-buffer-revert-confirm? (buffer-type entry-type) + "Return 'revert-confirm' value for BUFFER-TYPE/ENTRY-TYPE." + (guix-buffer-value buffer-type entry-type 'revert-confirm)) + + +;;; Displaying entries + +(defun guix-buffer-display (buffer) + "Switch to a Guix BUFFER." + (pop-to-buffer buffer + '((display-buffer-reuse-window + display-buffer-same-window)))) + +(defun guix-buffer-history-item (buffer-item) + "Make and return a history item for displaying BUFFER-ITEM." + (list #'guix-buffer-set buffer-item)) + +(defun guix-buffer-set (buffer-item &optional history) + "Set up the current buffer for displaying BUFFER-ITEM. +HISTORY should be one of the following: + + `nil' - do not save BUFFER-ITEM in history, + + `add' - add it to history, + + `replace' - replace the current history item." + (guix-buffer-with-item buffer-item + (when %entries + (guix-buffer-show-entries %entries %buffer-type %entry-type) + (setq guix-buffer-item buffer-item) + (when history + (funcall (cl-ecase history + (add #'guix-history-add) + (replace #'guix-history-replace)) + (guix-buffer-history-item buffer-item)))) + (guix-buffer-message %entries %buffer-type %entry-type %args))) + +(defun guix-buffer-display-entries-current + (entries buffer-type entry-type args &optional history) + "Show ENTRIES in the current Guix buffer. +See `guix-buffer-item' for the meaning of BUFFER-TYPE, ENTRY-TYPE +and ARGS, and `guix-buffer-set' for the meaning of HISTORY." + (let ((item (guix-buffer-make-item entries buffer-type + entry-type args))) + (guix-buffer-set item history))) + +(defun guix-buffer-get-display-entries-current + (buffer-type entry-type args &optional history) + "Search for entries and show them in the current Guix buffer. +See `guix-buffer-display-entries-current' for details." + (guix-buffer-display-entries-current + (guix-buffer-get-entries buffer-type entry-type args) + buffer-type entry-type args history)) + +(defun guix-buffer-display-entries + (entries buffer-type entry-type args &optional history) + "Show ENTRIES in a BUFFER-TYPE buffer. +See `guix-buffer-display-entries-current' for details." + (let ((buffer (get-buffer-create + (guix-buffer-name buffer-type entry-type args)))) + (with-current-buffer buffer + (guix-buffer-display-entries-current + entries buffer-type entry-type args history)) + (when entries + (guix-buffer-display buffer)))) + +(defun guix-buffer-get-display-entries + (buffer-type entry-type args &optional history) + "Search for entries and show them in a BUFFER-TYPE buffer. +See `guix-buffer-display-entries-current' for details." + (guix-buffer-display-entries + (guix-buffer-get-entries buffer-type entry-type args) + buffer-type entry-type args history)) + +(defun guix-buffer-revert (_ignore-auto noconfirm) + "Update the data in the current Guix buffer. +This function is suitable for `revert-buffer-function'. +See `revert-buffer' for the meaning of NOCONFIRM." + (guix-buffer-with-current-item + (when (or noconfirm + (not (guix-buffer-revert-confirm? %buffer-type %entry-type)) + (y-or-n-p "Update the current buffer? ")) + (guix-buffer-get-display-entries-current + %buffer-type %entry-type %args 'replace)))) + +(defvar guix-buffer-after-redisplay-hook nil + "Hook run by `guix-buffer-redisplay'. +This hook is called before seting up a window position.") + +(defun guix-buffer-redisplay () + "Redisplay the current Guix buffer. +Restore the point and window positions after redisplaying. + +This function does not update the buffer data, use +'\\[revert-buffer]' if you want the full update." + (interactive) + (let* ((old-point (point)) + ;; For simplicity, ignore an unlikely case when multiple + ;; windows display the same buffer. + (window (car (get-buffer-window-list (current-buffer) nil t))) + (window-start (and window (window-start window)))) + (guix-buffer-set guix-buffer-item) + (goto-char old-point) + (run-hooks 'guix-buffer-after-redisplay-hook) + (when window + (set-window-point window (point)) + (set-window-start window window-start)))) + +(defun guix-buffer-redisplay-goto-button () + "Redisplay the current buffer and go to the next button, if needed." + (let ((guix-buffer-after-redisplay-hook + (cons (lambda () + (unless (button-at (point)) + (forward-button 1))) + guix-buffer-after-redisplay-hook))) + (guix-buffer-redisplay))) + + +;;; Interface definer + +(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. + +Required keywords: + + - `:buffer-name' - default value of the generated + `guix-TYPE-buffer-name' variable. + + - `:get-entries-function' - default value of the generated + `guix-TYPE-get-function' variable. + + - `:show-entries-function' - default value of the generated + `guix-TYPE-show-function' variable. + + Alternatively, if `:show-entries-function' is not specified, a + default `guix-TYPE-show-entries' will be generated, and the + following keyword should be specified instead: + + - `:insert-entries-function' - default value of the generated + `guix-TYPE-insert-function' variable. + +Optional keywords: + + - `:message-function' - default value of the generated + `guix-TYPE-message-function' variable. + + - `:titles' - default value of the generated + `guix-TYPE-titles' variable. + + - `:history-size' - default value of the generated + `guix-TYPE-history-size' variable. + + - `:revert-confirm?' - default value of the generated + `guix-TYPE-revert-confirm' variable. + + - `:mode-name' - name (a string appeared in the mode-line) of + the generated `guix-TYPE-mode'. + + - `:mode-init-function' - default value of the generated + `guix-TYPE-mode-initialize-function' variable. + + - `:reduced?' - if non-nil, generate only group, faces group + and titles variable (if specified); all keywords become + optional." + (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)) + (group (intern prefix)) + (faces-group (intern (concat prefix "-faces"))) + (get-entries-var (intern (concat prefix "-get-function"))) + (show-entries-var (intern (concat prefix "-show-function"))) + (show-entries-fun (intern (concat prefix "-show-entries"))) + (message-var (intern (concat prefix "-message-function"))) + (buffer-name-var (intern (concat prefix "-buffer-name"))) + (titles-var (intern (concat prefix "-titles"))) + (history-size-var (intern (concat prefix "-history-size"))) + (revert-confirm-var (intern (concat prefix "-revert-confirm")))) + (guix-keyword-args-let args + ((get-entries-val :get-entries-function) + (show-entries-val :show-entries-function) + (insert-entries-val :insert-entries-function) + (mode-name :mode-name (capitalize prefix)) + (mode-init-val :mode-init-function) + (message-val :message-function) + (buffer-name-val :buffer-name) + (titles-val :titles) + (history-size-val :history-size 20) + (revert-confirm-val :revert-confirm? t) + (reduced? :reduced?)) + `(progn + (defgroup ,group nil + ,(format "Display '%s' entries in '%s' buffer." + entry-type-str buffer-type-str) + :prefix ,(concat prefix "-") + :group ',(intern (concat "guix-" buffer-type-str))) + + (defgroup ,faces-group nil + ,(format "Faces for displaying '%s' entries in '%s' buffer." + entry-type-str buffer-type-str) + :group ',(intern (concat "guix-" buffer-type-str "-faces"))) + + (defcustom ,titles-var ,titles-val + ,(format "Alist of titles of '%s' parameters." + entry-type-str) + :type '(alist :key-type symbol :value-type string) + :group ',group) + + ,(unless reduced? + `(progn + (defvar ,get-entries-var ,get-entries-val + ,(format "\ +Function used to receive '%s' entries for '%s' buffer." + entry-type-str buffer-type-str)) + + (defvar ,show-entries-var + ,(or show-entries-val `',show-entries-fun) + ,(format "\ +Function used to show '%s' entries in '%s' buffer." + entry-type-str buffer-type-str)) + + (defvar ,message-var ,message-val + ,(format "\ +Function used to display a message after showing '%s' entries. +If nil, do not display messages." + entry-type-str)) + + (defcustom ,buffer-name-var ,buffer-name-val + ,(format "\ +Default name of '%s' buffer for displaying '%s' entries. +May be a string or a function returning a string. The function +is called with the same arguments as `%S'." + buffer-type-str entry-type-str get-entries-var) + :type '(choice string function) + :group ',group) + + (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-confirm-var ,revert-confirm-val + ,(format "\ +If non-nil, ask to confirm for reverting `%S' buffer." + buffer-name-var) + :type 'boolean + :group ',group) + + (guix-alist-put! + '((get-entries . ,get-entries-var) + (show-entries . ,show-entries-var) + (message . ,message-var) + (buffer-name . ,buffer-name-var) + (history-size . ,history-size-var) + (revert-confirm . ,revert-confirm-var)) + 'guix-buffer-data ',buffer-type ',entry-type) + + ,(unless show-entries-val + `(defun ,show-entries-fun (entries) + ,(format "\ +Show '%s' ENTRIES in the current '%s' buffer." + entry-type-str buffer-type-str) + (guix-buffer-show-entries-default + entries ',buffer-type ',entry-type))) + + ,(when (or insert-entries-val + (null show-entries-val)) + (let ((insert-entries-var + (intern (concat prefix "-insert-function")))) + `(progn + (defvar ,insert-entries-var ,insert-entries-val + ,(format "\ +Function used to print '%s' entries in '%s' buffer." + entry-type-str buffer-type-str)) + + (guix-alist-put! + ',insert-entries-var 'guix-buffer-data + ',buffer-type ',entry-type + 'insert-entries)))) + + ,(when (or mode-name + mode-init-val + (null show-entries-val)) + (let* ((mode-str (concat prefix "-mode")) + (mode-map-str (concat mode-str "-map")) + (mode (intern mode-str)) + (parent-mode (intern + (concat "guix-" buffer-type-str + "-mode"))) + (mode-var (intern + (concat mode-str "-function"))) + (mode-init-var (intern + (concat mode-str + "-initialize-function")))) + `(progn + (defvar ,mode-var ',mode + ,(format "\ +Major mode for displaying '%s' entries in '%s' buffer." + entry-type-str buffer-type-str)) + + (defvar ,mode-init-var ,mode-init-val + ,(format "\ +Function used to set up '%s' buffer for displaying '%s' entries." + buffer-type-str entry-type-str)) + + (define-derived-mode ,mode ,parent-mode ,mode-name + ,(format "\ +Major mode for displaying '%s' entries in '%s' buffer. + +\\{%s}" + entry-type-str buffer-type-str mode-map-str) + (setq-local revert-buffer-function + 'guix-buffer-revert) + (setq-local guix-history-size + (guix-buffer-history-size + ',buffer-type ',entry-type)) + (guix-buffer-mode-initialize + ',buffer-type ',entry-type)) + + (guix-alist-put! + ',mode-var 'guix-buffer-data + ',buffer-type ',entry-type 'mode) + (guix-alist-put! + ',mode-init-var 'guix-buffer-data + ',buffer-type ',entry-type + 'mode-init)))))) + + (guix-alist-put! + ',titles-var 'guix-buffer-data + ',buffer-type ',entry-type 'titles))))) + + +(defvar guix-buffer-font-lock-keywords + (eval-when-compile + `((,(rx "(" (group (or "guix-buffer-with-item" + "guix-buffer-with-current-item" + "guix-buffer-define-interface")) + symbol-end) + . 1)))) + +(font-lock-add-keywords 'emacs-lisp-mode guix-buffer-font-lock-keywords) + +(provide 'guix-buffer) + +;;; guix-buffer.el ends here diff --git a/emacs/guix-info.el b/emacs/guix-info.el index 871c4b085f..9c63892d06 100644 --- a/emacs/guix-info.el +++ b/emacs/guix-info.el @@ -202,8 +202,7 @@ LEVEL is 1 by default." (insert (guix-info-get-indent level))) (defun guix-info-insert-entries (entries entry-type) - "Display ENTRIES of ENTRY-TYPE in the current info buffer. -ENTRIES should have a form of `guix-entries'." + "Display ENTRY-TYPE ENTRIES in the current info buffer." (guix-mapinsert (lambda (entry) (guix-info-insert-entry entry entry-type)) entries @@ -371,8 +370,11 @@ BUTTON-OR-FACE is a button type)." 'face 'guix-package-info-name-button 'help-echo "Describe this package" 'action (lambda (btn) - (guix-get-show-entries guix-profile 'info guix-package-info-type - 'name (button-label btn)))) + (guix-buffer-get-display-entries-current + 'info guix-package-info-type + (list (guix-ui-current-profile) + 'name (button-label btn)) + 'add))) (defun guix-info-button-copy-label (&optional pos) "Copy a label of the button at POS into kill ring. @@ -407,7 +409,8 @@ See `insert-text-button' for the meaning of PROPERTIES." "Keymap for `guix-info-mode' buffers.") (define-derived-mode guix-info-mode special-mode "Guix-Info" - "Parent mode for displaying information in info buffers.") + "Parent mode for displaying data in 'info' form." + (setq-local revert-buffer-function 'guix-buffer-revert)) (defun guix-info-mode-initialize () "Set up the current 'info' buffer." @@ -435,7 +438,8 @@ The rest keyword arguments are passed to (group (intern prefix)) (format-var (intern (concat prefix "-format")))) (guix-keyword-args-let args - ((format-val :format)) + ((show-entries-val :show-entries-function) + (format-val :format)) `(progn (defcustom ,format-var ,format-val ,(format "\ @@ -473,9 +477,23 @@ After calling each METHOD, a new line is inserted." '((format . ,format-var)) 'guix-info-data ',entry-type) - (guix-buffer-define-interface info ,entry-type - :mode-init-function 'guix-info-mode-initialize - ,@%foreign-args))))) + ,(if show-entries-val + `(guix-buffer-define-interface info ,entry-type + :show-entries-function ,show-entries-val + ,@%foreign-args) + + (let ((insert-fun (intern (concat prefix "-insert-entries")))) + `(progn + (defun ,insert-fun (entries) + ,(format "\ +Print '%s' ENTRIES in the current 'info' buffer." + entry-type-str) + (guix-info-insert-entries entries ',entry-type)) + + (guix-buffer-define-interface info ,entry-type + :insert-entries-function ',insert-fun + :mode-init-function 'guix-info-mode-initialize + ,@%foreign-args)))))))) ;;; Displaying packages @@ -675,7 +693,7 @@ ENTRY is an alist with package info." type-str (lambda (btn) (guix-process-package-actions - guix-profile + (guix-ui-current-profile) `((,(button-get btn 'action-type) (,(button-get btn 'id) ,(button-get btn 'output)))) (current-buffer))) @@ -726,15 +744,16 @@ prompt depending on `guix-operation-confirm' variable)." Find the file if needed (see `guix-package-info-auto-find-source'). ENTRY-ID is an ID of the current entry (package or output). PACKAGE-ID is an ID of the package which source to show." - (let* ((entries guix-entries) - (entry (guix-entry-by-id entry-id guix-entries)) + (let* ((entries (guix-buffer-current-entries)) + (entry (guix-entry-by-id entry-id entries)) (file (guix-package-source-path package-id))) (or file (error "Couldn't define file name of the package source")) (let* ((new-entry (cons (cons 'source-file file) entry)) (new-entries (guix-replace-entry entry-id new-entry entries))) - (setq guix-entries new-entries) + (setf (guix-buffer-item-entries guix-buffer-item) + new-entries) (guix-buffer-redisplay-goto-button) (if (file-exists-p file) (if guix-package-info-auto-find-source @@ -872,15 +891,19 @@ This function is used to hide a \"Download\" button if needed." (guix-info-insert-action-button "Packages" (lambda (btn) - (guix-get-show-entries guix-profile 'list guix-package-list-type - 'generation (button-get btn 'number))) + (guix-buffer-get-display-entries + 'list guix-package-list-type + (list (guix-ui-current-profile) + 'generation (button-get btn 'number)) + 'add)) "Show installed packages for this generation" 'number number) (guix-info-insert-indent) (guix-info-insert-action-button "Delete" (lambda (btn) - (guix-delete-generations guix-profile (list (button-get btn 'number)) + (guix-delete-generations (guix-ui-current-profile) + (list (button-get btn 'number)) (current-buffer))) "Delete this generation" 'number number)) @@ -894,7 +917,8 @@ This function is used to hide a \"Download\" button if needed." (guix-info-insert-action-button "Switch" (lambda (btn) - (guix-switch-to-generation guix-profile (button-get btn 'number) + (guix-switch-to-generation (guix-ui-current-profile) + (button-get btn 'number) (current-buffer))) "Switch to this generation (make it the current one)" 'number (guix-entry-value entry 'number)))) diff --git a/emacs/guix-list.el b/emacs/guix-list.el index 42bc0c87f5..f5c50389ed 100644 --- a/emacs/guix-list.el +++ b/emacs/guix-list.el @@ -61,7 +61,7 @@ With prefix argument, describe entries marked with any mark." (let* ((ids (or (apply #'guix-list-get-marked-id-list mark-names) (list (guix-list-current-id)))) (count (length ids)) - (entry-type guix-entry-type)) + (entry-type (guix-buffer-current-entry-type))) (when (or (<= count (guix-list-describe-warning-count entry-type)) (y-or-n-p (format "Do you really want to describe %d entries? " count))) @@ -168,8 +168,7 @@ Return a vector made of values of FUN calls." rest-spec)))) (defun guix-list-insert-entries (entries entry-type) - "Display ENTRIES of ENTRY-TYPE in the current list buffer. -ENTRIES should have a form of `guix-entries'." + "Print ENTRY-TYPE ENTRIES in the current buffer." (setq tabulated-list-entries (guix-list-tabulated-entries entries entry-type)) (tabulated-list-print)) @@ -212,14 +211,18 @@ VAL may be nil." 'follow-link t 'help-echo "Find file")) + +;;; 'List' lines + (defun guix-list-current-id () - "Return ID of the current entry." + "Return ID of the entry at point." (or (tabulated-list-get-id) (user-error "No entry here"))) (defun guix-list-current-entry () - "Return alist of the current entry info." - (guix-entry-by-id (guix-list-current-id) guix-entries)) + "Return entry at point." + (guix-entry-by-id (guix-list-current-id) + (guix-buffer-current-entries))) (defun guix-list-for-each-line (fun &rest args) "Call FUN with ARGS for each entry line." @@ -429,8 +432,6 @@ The rest keyword arguments are passed to (let* ((entry-type-str (symbol-name entry-type)) (prefix (concat "guix-" entry-type-str "-list")) (group (intern prefix)) - (mode-str (concat prefix "-mode")) - (init-fun (intern (concat prefix "-mode-initialize"))) (describe-var (intern (concat prefix "-describe-function"))) (describe-count-var (intern (concat prefix "-describe-warning-count"))) @@ -438,7 +439,8 @@ The rest keyword arguments are passed to (sort-key-var (intern (concat prefix "-sort-key"))) (marks-var (intern (concat prefix "-marks")))) (guix-keyword-args-let args - ((describe-val :describe-function) + ((show-entries-val :show-entries-function) + (describe-val :describe-function) (describe-count-val :describe-count 10) (format-val :format) (sort-key-val :sort-key) @@ -498,10 +500,6 @@ See also `guix-list-describe'." ,(format "Function used to describe '%s' entries." entry-type-str)) - (defun ,init-fun () - ,(concat "Initial settings for `" mode-str "'.") - (guix-list-mode-initialize ',entry-type)) - (guix-alist-put! '((describe . ,describe-var) (describe-count . ,describe-count-var) @@ -510,8 +508,30 @@ See also `guix-list-describe'." (marks . ,marks-var)) 'guix-list-data ',entry-type) - (guix-buffer-define-interface list ,entry-type - ,@%foreign-args))))) + ,(if show-entries-val + `(guix-buffer-define-interface list ,entry-type + :show-entries-function ,show-entries-val + ,@%foreign-args) + + (let ((insert-fun (intern (concat prefix "-insert-entries"))) + (mode-init-fun (intern (concat prefix "-mode-initialize")))) + `(progn + (defun ,insert-fun (entries) + ,(format "\ +Print '%s' ENTRIES in the current 'list' buffer." + entry-type-str) + (guix-list-insert-entries entries ',entry-type)) + + (defun ,mode-init-fun () + ,(format "\ +Set up the current 'list' buffer for displaying '%s' entries." + entry-type-str) + (guix-list-mode-initialize ',entry-type)) + + (guix-buffer-define-interface list ,entry-type + :insert-entries-function ',insert-fun + :mode-init-function ',mode-init-fun + ,@%foreign-args)))))))) ;;; Displaying packages @@ -584,7 +604,7 @@ Colorize it with `guix-package-list-installed' or (when (and (not guix-package-list-generation-marking-enabled) (or (derived-mode-p 'guix-package-list-mode) (derived-mode-p 'guix-output-list-mode)) - (eq guix-search-type 'generation)) + (eq (guix-ui-current-search-type) 'generation)) (error "Action marks are disabled for lists of 'generation packages'"))) (defun guix-package-list-mark-outputs (mark default @@ -655,7 +675,7 @@ accept an entry as argument." (let ((obsolete (cl-remove-if-not (lambda (entry) (guix-entry-value entry 'obsolete)) - guix-entries))) + (guix-buffer-current-entries)))) (guix-list-for-each-line (lambda () (let* ((id (guix-list-current-id)) @@ -682,8 +702,8 @@ FUN should accept action-type as argument." (let ((actions (delq nil (mapcar fun '(install delete upgrade))))) (if actions - (guix-process-package-actions - guix-profile actions (current-buffer)) + (guix-process-package-actions (guix-ui-current-profile) + actions (current-buffer)) (user-error "No operations specified")))) (defun guix-package-list-execute () @@ -714,7 +734,7 @@ The specification is suitable for `guix-process-package-actions'." (output nil 9 t) (installed nil 12 t) (synopsis guix-list-get-one-line 30 nil)) - :required '(package-id) + :required '(id package-id) :sort-key '(name) :marks '((install . ?I) (upgrade . ?U) @@ -784,15 +804,19 @@ The specification is suitable for `guix-process-output-actions'." "Describe outputs with IDS (list of output identifiers). See `guix-package-info-type'." (if (eq guix-package-info-type 'output) - (apply #'guix-get-show-entries - guix-profile 'info 'output 'id ids) + (guix-buffer-get-display-entries + 'info 'output + (cl-list* (guix-ui-current-profile) 'id ids) + 'add) (let ((pids (mapcar (lambda (oid) (car (guix-package-id-and-output-by-output-id oid))) ids))) - (apply #'guix-get-show-entries - guix-profile 'info 'package 'id - (cl-remove-duplicates pids))))) + (guix-buffer-get-display-entries + 'info 'package + (cl-list* (guix-ui-current-profile) + 'id (cl-remove-duplicates pids)) + 'add)))) (defun guix-output-list-edit () "Go to the location of the current package." @@ -837,13 +861,15 @@ VAL is a boolean value." (number (guix-entry-value entry 'number))) (if current (user-error "This generation is already the current one") - (guix-switch-to-generation guix-profile number (current-buffer))))) + (guix-switch-to-generation (guix-ui-current-profile) + number (current-buffer))))) (defun guix-generation-list-show-packages () "List installed packages for the generation at point." (interactive) - (guix-get-show-entries guix-profile 'list guix-package-list-type - 'generation (guix-list-current-id))) + (guix-get-show-packages + (guix-ui-current-profile) + 'generation (guix-list-current-id))) (defun guix-generation-list-generations-to-compare () "Return a sorted list of 2 marked generations for comparing." @@ -858,9 +884,12 @@ If 2 generations are marked with \\[guix-list-mark], display outputs installed in the latest marked generation that were not installed in the other one." (interactive) - (apply #'guix-get-show-entries - guix-profile 'list 'output 'generation-diff - (reverse (guix-generation-list-generations-to-compare)))) + (guix-buffer-get-display-entries + 'list 'output + (cl-list* (guix-ui-current-profile) + 'generation-diff + (reverse (guix-generation-list-generations-to-compare))) + 'add)) (defun guix-generation-list-show-removed-packages () "List package outputs removed from the latest marked generation. @@ -868,9 +897,12 @@ If 2 generations are marked with \\[guix-list-mark], display outputs not installed in the latest marked generation that were installed in the other one." (interactive) - (apply #'guix-get-show-entries - guix-profile 'list 'output 'generation-diff - (guix-generation-list-generations-to-compare))) + (guix-buffer-get-display-entries + 'list 'output + (cl-list* (guix-ui-current-profile) + 'generation-diff + (guix-generation-list-generations-to-compare)) + 'add)) (defun guix-generation-list-compare (diff-fun gen-fun) "Run GEN-FUN on the 2 marked generations and run DIFF-FUN on the results." @@ -938,7 +970,8 @@ With ARG, mark all generations for deletion." (let ((marked (guix-list-get-marked-id-list 'delete))) (or marked (user-error "No generations marked for deletion")) - (guix-delete-generations guix-profile marked (current-buffer)))) + (guix-delete-generations (guix-ui-current-profile) + marked (current-buffer)))) (defvar guix-list-font-lock-keywords diff --git a/emacs/guix-ui.el b/emacs/guix-ui.el index a92439baf1..55c3f1b55c 100644 --- a/emacs/guix-ui.el +++ b/emacs/guix-ui.el @@ -26,7 +26,10 @@ (require 'cl-lib) (require 'guix-backend) +(require 'guix-buffer) +(require 'guix-guile) (require 'guix-utils) +(require 'guix-messages) (defgroup guix-ui nil "Settings for Guix package management. @@ -41,10 +44,38 @@ generations in 'list' and 'info' buffers." map) "Parent keymap for Guix package/generation buffers.") +(guix-buffer-define-current-args-accessors + "guix-ui-current" "profile" "search-type" "search-values") + +(defun guix-ui-get-entries (profile entry-type search-type search-values + &optional params) + "Receive ENTRY-TYPE entries for PROFILE. +Call an appropriate scheme procedure and return a list of entries. + +ENTRY-TYPE should be one of the following symbols: `package', +`output' 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', `time'. + +PARAMS is a list of parameters for receiving. If nil, get data +with all available parameters." + (guix-eval-read + (guix-make-guile-expression + 'entries + profile params entry-type search-type search-values))) + (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)) + (guix-buffer-get-display-entries + 'info (guix-buffer-current-entry-type) + (cl-list* (guix-ui-current-profile) 'id ids) + 'add)) ;;; Buffers and auto updating @@ -161,7 +192,16 @@ Optional keywords: `guix-TYPE-required-params' variable. The rest keyword arguments are passed to -`guix-BUFFER-TYPE-define-interface' macro." +`guix-BUFFER-TYPE-define-interface' macro. + +Along with the mentioned definitions, this macro also defines: + + - `guix-TYPE-mode-map' - keymap based on `guix-ui-map' and + `guix-BUFFER-TYPE-mode-map'. + + - `guix-TYPE-get-entries' - a wrapper around `guix-ui-get-entries'. + + - `guix-TYPE-message' - a wrapper around `guix-result-message'." (declare (indent 2)) (let* ((entry-type-str (symbol-name entry-type)) (buffer-type-str (symbol-name buffer-type)) @@ -173,6 +213,10 @@ The rest keyword arguments are passed to buffer-type-str))) (required-var (intern (concat prefix "-required-params"))) (buffer-name-fun (intern (concat prefix "-buffer-name"))) + (get-fun (intern (concat prefix "-get-entries"))) + (message-fun (intern (concat prefix "-message"))) + (displayed-fun (intern (format "guix-%s-displayed-params" + buffer-type-str))) (definer (intern (format "guix-%s-define-interface" buffer-type-str)))) (guix-keyword-args-let args @@ -188,9 +232,13 @@ The rest keyword arguments are passed to (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)) +List of the required '%s' parameters. +These parameters are received by `%S' +along with the displayed parameters. + +Do not remove `id' from this list as it is required for +identifying an entry." + entry-type-str get-fun)) (defun ,buffer-name-fun (profile &rest _) ,(format "\ @@ -199,7 +247,27 @@ See `guix-ui-buffer-name' for details." buffer-type-str entry-type-str) (guix-ui-buffer-name ,buffer-name-val profile)) + (defun ,get-fun (profile search-type &rest search-values) + ,(format "\ +Receive '%s' entries for displaying them in '%s' buffer. +See `guix-ui-get-entries' for details." + entry-type-str buffer-type-str) + (guix-ui-get-entries + profile ',entry-type search-type search-values + (cl-union ,required-var + (,displayed-fun ',entry-type)))) + + (defun ,message-fun (entries profile search-type + &rest search-values) + ,(format "\ +Display a message after showing '%s' entries." + entry-type-str) + (guix-result-message + profile entries ',entry-type search-type search-values)) + (,definer ,entry-type + :get-entries-function ',get-fun + :message-function ',message-fun :buffer-name ',buffer-name-fun ,@%foreign-args))))) diff --git a/emacs/guix.el b/emacs/guix.el index ac6efbb475..12dd4a2553 100644 --- a/emacs/guix.el +++ b/emacs/guix.el @@ -56,42 +56,39 @@ If nil, show a single package in the info buffer." (defvar guix-search-history nil "A history of minibuffer prompts.") -(defun guix-get-show-packages (profile search-type &rest search-vals) +(defun guix-get-show-packages (profile search-type &rest search-values) "Search for packages and show results. If PROFILE is nil, use `guix-current-profile'. -See `guix-get-entries' for the meaning of SEARCH-TYPE and -SEARCH-VALS. +See `guix-ui-get-entries' for the meaning of SEARCH-TYPE and +SEARCH-VALUES. Results are displayed in the list buffer, unless a single package is found and `guix-list-single-package' is nil." - (or profile (setq profile guix-current-profile)) - (let ((packages (guix-get-entries profile guix-package-list-type - search-type search-vals - (guix-get-params-for-receiving - 'list guix-package-list-type)))) + (let* ((args (cl-list* (or profile guix-current-profile) + search-type search-values)) + (entries (guix-buffer-get-entries + 'list guix-package-list-type args))) (if (or guix-list-single-package - (cdr packages)) - (guix-set-buffer profile packages 'list guix-package-list-type - search-type search-vals) - (let ((packages (guix-get-entries profile guix-package-info-type - search-type search-vals - (guix-get-params-for-receiving - 'info guix-package-info-type)))) - (guix-set-buffer profile packages 'info guix-package-info-type - search-type search-vals))))) - -(defun guix-get-show-generations (profile search-type &rest search-vals) + (null entries) + (cdr entries)) + (guix-buffer-display-entries + entries 'list guix-package-list-type args 'add) + (guix-buffer-get-display-entries + 'info guix-package-info-type args 'add)))) + +(defun guix-get-show-generations (profile search-type &rest search-values) "Search for generations and show results. If PROFILE is nil, use `guix-current-profile'. -See `guix-get-entries' for the meaning of SEARCH-TYPE and -SEARCH-VALS." - (apply #'guix-get-show-entries - (or profile guix-current-profile) - 'list 'generation search-type search-vals)) +See `guix-ui-get-entries' for the meaning of SEARCH-TYPE and +SEARCH-VALUES." + (let ((args (cl-list* (or profile guix-current-profile) + search-type search-values))) + (guix-buffer-get-display-entries + 'list 'generation args 'add))) ;;;###autoload (defun guix-search-by-name (name &optional profile) |