From 73ce3c19c435db51ec818ec62a75e0956b31899f Mon Sep 17 00:00:00 2001 From: Alex Kost Date: Thu, 22 Oct 2015 10:08:42 +0300 Subject: emacs: Add API for 'guix-entry'. * emacs/guix-info.el: Use new entry procedures. * emacs/guix-list.el: Likewise. * emacs/guix-base.el: Likewise. (guix-get-entry-by-id): Move and rename to ... * emacs/guix-entry.el (guix-entry-by-id): ...this. New file. (guix-entry-value, guix-entry-id, guix-entries-by-ids) (guix-replace-entry): New procedures. * emacs.am (ELFILES): Add new file. --- emacs/guix-base.el | 25 ++++++++++--------------- 1 file changed, 10 insertions(+), 15 deletions(-) (limited to 'emacs/guix-base.el') diff --git a/emacs/guix-base.el b/emacs/guix-base.el index d9c70aae9e..7055a0984e 100644 --- a/emacs/guix-base.el +++ b/emacs/guix-base.el @@ -30,6 +30,7 @@ (require 'cl-lib) (require 'guix-profiles) (require 'guix-backend) +(require 'guix-entry) (require 'guix-guile) (require 'guix-utils) (require 'guix-history) @@ -103,15 +104,15 @@ Each element of the list has a form: (defun guix-get-full-name (entry &optional output) "Return name specification of the package ENTRY and OUTPUT." - (guix-get-name-spec (guix-assq-value entry 'name) - (guix-assq-value entry 'version) + (guix-get-name-spec (guix-entry-value entry 'name) + (guix-entry-value entry 'version) output)) (defun guix-entry-to-specification (entry) "Return name specification by the package or output ENTRY." - (guix-get-name-spec (guix-assq-value entry 'name) - (guix-assq-value entry 'version) - (guix-assq-value entry 'output))) + (guix-get-name-spec (guix-entry-value entry 'name) + (guix-entry-value entry 'version) + (guix-entry-value entry 'output))) (defun guix-entries-to-specifications (entries) "Return name specifications by the package or output ENTRIES." @@ -121,14 +122,8 @@ Each element of the list has a form: (defun guix-get-installed-outputs (entry) "Return list of installed outputs for the package ENTRY." (mapcar (lambda (installed-entry) - (guix-assq-value installed-entry 'output)) - (guix-assq-value entry 'installed))) - -(defun guix-get-entry-by-id (id entries) - "Return entry from ENTRIES by entry ID." - (cl-find-if (lambda (entry) - (equal id (guix-assq-value entry 'id))) - entries)) + (guix-entry-value installed-entry 'output)) + (guix-entry-value entry 'installed))) (defun guix-get-package-id-and-output-by-output-id (oid) "Return list (PACKAGE-ID OUTPUT) by output id OID." @@ -940,9 +935,9 @@ ENTRIES is a list of package entries to get info about packages." (lambda (spec) (let* ((id (car spec)) (outputs (cdr spec)) - (entry (guix-get-entry-by-id id entries))) + (entry (guix-entry-by-id id entries))) (when entry - (let ((location (guix-assq-value entry 'location))) + (let ((location (guix-entry-value entry 'location))) (concat (guix-get-full-name entry) (when outputs (concat ":" -- cgit v1.2.3 From ceea647c72cac582126688c71e19e4c9f9137a63 Mon Sep 17 00:00:00 2001 From: Alex Kost Date: Tue, 17 Nov 2015 22:19:14 +0300 Subject: emacs: Simplify defining parameter titles. * emacs/guix-utils.el (guix-symbol-title): New procedure. * emacs/guix-base.el (guix-get-param-title): Use it. (guix-param-titles): Remove most titles as they are automatically defined by 'guix-symbol-title'. --- emacs/guix-base.el | 46 +++++----------------------------------------- emacs/guix-utils.el | 9 +++++++++ 2 files changed, 14 insertions(+), 41 deletions(-) (limited to 'emacs/guix-base.el') diff --git a/emacs/guix-base.el b/emacs/guix-base.el index 7055a0984e..43dec3dca3 100644 --- a/emacs/guix-base.el +++ b/emacs/guix-base.el @@ -41,48 +41,14 @@ (defvar guix-param-titles '((package - (id . "ID") - (name . "Name") - (version . "Version") - (source . "Source") - (license . "License") - (synopsis . "Synopsis") - (description . "Description") - (home-url . "Home page") - (outputs . "Outputs") - (inputs . "Inputs") - (native-inputs . "Native inputs") - (propagated-inputs . "Propagated inputs") - (location . "Location") - (installed . "Installed")) + (home-url . "Home page")) (installed - (path . "Installed path") - (dependencies . "Dependencies") - (output . "Output")) + (path . "Installed path")) (output - (id . "ID") - (name . "Name") - (version . "Version") - (source . "Source") - (license . "License") - (synopsis . "Synopsis") - (description . "Description") (home-url . "Home page") - (output . "Output") - (inputs . "Inputs") - (native-inputs . "Native inputs") - (propagated-inputs . "Propagated inputs") - (location . "Location") - (installed . "Installed") - (path . "Installed path") - (dependencies . "Dependencies")) + (path . "Installed path")) (generation - (id . "ID") - (number . "Number") - (prev-number . "Previous number") - (current . "Current") - (path . "Path") - (time . "Time"))) + (prev-number . "Previous number"))) "List for defining titles of entry parameters. Titles are used for displaying information about entries. Each element of the list has a form: @@ -93,9 +59,7 @@ Each element of the list has a form: "Return title of an ENTRY-TYPE entry parameter PARAM." (or (guix-assq-value guix-param-titles entry-type param) - (prog1 (symbol-name param) - (message "Couldn't find title for '%S %S'." - entry-type param)))) + (guix-symbol-title param))) (defun guix-get-name-spec (name version &optional output) "Return Guix package specification by its NAME, VERSION and OUTPUT." diff --git a/emacs/guix-utils.el b/emacs/guix-utils.el index 5a0cad4f2a..e24b58fb17 100644 --- a/emacs/guix-utils.el +++ b/emacs/guix-utils.el @@ -165,6 +165,15 @@ This function is similar to `shell-quote-argument', but less strict." (replace-regexp-in-string (rx (not (any alnum "-=,./\n"))) "\\\\\\&" argument)))) +(defun guix-symbol-title (symbol) + "Return SYMBOL's name, a string. +This is like `symbol-name', but fancier." + (if (eq symbol 'id) + "ID" + (let ((str (replace-regexp-in-string "-" " " (symbol-name symbol)))) + (concat (capitalize (substring str 0 1)) + (substring str 1))))) + (defun guix-command-symbol (&optional args) "Return symbol by concatenating 'guix' and ARGS (strings)." (intern (guix-concat-strings (cons "guix" args) "-"))) -- cgit v1.2.3 From 0b9cd3206ab9ba4f8fd55139d42cdf5265c4b0e1 Mon Sep 17 00:00:00 2001 From: Alex Kost Date: Wed, 18 Nov 2015 11:36:27 +0300 Subject: emacs: Rename internal procedures. * emacs/guix-list.el (guix-list-get-param-title): Rename to... (guix-list-param-title): ... this. (guix-list-get-column-format): Rename to... (guix-list-format): ... this. (guix-list-get-displayed-params): Rename to... (guix-list-displayed-params): ... this. (guix-list-get-sort-key): Rename to... (guix-list-tabulated-sort-key): ... this. (guix-list-make-tabulated-vector): Rename to... (guix-list-tabulated-vector): ... this. (guix-list-get-list-format): Rename to... (guix-list-tabulated-format): ... this. (guix-list-get-tabulated-entries): Rename to... (guix-list-tabulated-entries): ... this. (guix-list-get-tabulated-entry): Rename to... (guix-list-tabulated-entry): ... this. * emacs/guix-info.el (guix-info-get-displayed-params): Rename to... (guix-info-displayed-params): ... this. * emacs/guix-base.el (guix-get-params-for-receiving): Adjust accordingly. (guix-get-name-spec): Rename to... (guix-package-name-specification): ... this. (guix-get-full-name): Merge this and... (guix-entry-to-specification): ... this into... (guix-package-entry->name-specification): ... this. (guix-get-installed-outputs): Rename to... (guix-package-installed-outputs): ... this. (guix-get-package-id-and-output-by-output-id): Rename to... (guix-package-id-and-output-by-output-id): ... this. --- emacs/guix-base.el | 35 +++++++++++++-------------- emacs/guix-info.el | 14 +++++------ emacs/guix-list.el | 69 ++++++++++++++++++++++++++---------------------------- 3 files changed, 56 insertions(+), 62 deletions(-) (limited to 'emacs/guix-base.el') diff --git a/emacs/guix-base.el b/emacs/guix-base.el index 43dec3dca3..91b52db188 100644 --- a/emacs/guix-base.el +++ b/emacs/guix-base.el @@ -61,35 +61,31 @@ Each element of the list has a form: entry-type param) (guix-symbol-title param))) -(defun guix-get-name-spec (name version &optional output) +(defun guix-package-name-specification (name version &optional output) "Return Guix package specification by its NAME, VERSION and OUTPUT." (concat name "-" version (when output (concat ":" output)))) -(defun guix-get-full-name (entry &optional output) +(defun guix-package-entry->name-specification (entry &optional output) "Return name specification of the package ENTRY and OUTPUT." - (guix-get-name-spec (guix-entry-value entry 'name) - (guix-entry-value entry 'version) - output)) + (guix-package-name-specification + (guix-entry-value entry 'name) + (guix-entry-value entry 'version) + (or output (guix-entry-value entry 'output)))) -(defun guix-entry-to-specification (entry) - "Return name specification by the package or output ENTRY." - (guix-get-name-spec (guix-entry-value entry 'name) - (guix-entry-value entry 'version) - (guix-entry-value entry 'output))) - -(defun guix-entries-to-specifications (entries) +(defun guix-package-entries->name-specifications (entries) "Return name specifications by the package or output ENTRIES." - (cl-remove-duplicates (mapcar #'guix-entry-to-specification entries) + (cl-remove-duplicates (mapcar #'guix-package-entry->name-specification + entries) :test #'string=)) -(defun guix-get-installed-outputs (entry) +(defun guix-package-installed-outputs (entry) "Return list of installed outputs for the package ENTRY." (mapcar (lambda (installed-entry) (guix-entry-value installed-entry 'output)) (guix-entry-value entry 'installed))) -(defun guix-get-package-id-and-output-by-output-id (oid) +(defun guix-package-id-and-output-by-output-id (oid) "Return list (PACKAGE-ID OUTPUT) by output id OID." (cl-multiple-value-bind (pid-str output) (split-string oid ":") @@ -567,7 +563,7 @@ If NO-DISPLAY is non-nil, do not switch to the buffer." (required (symbol-value required-var))) (unless (equal required 'all) (cl-union required - (funcall (guix-get-symbol "get-displayed-params" + (funcall (guix-get-symbol "displayed-params" buffer-type) entry-type))))) @@ -596,8 +592,9 @@ See `revert-buffer' for the meaning of NOCONFIRM." (eq guix-entry-type 'output))) (progn (setq search-type 'name - search-vals (guix-entries-to-specifications - guix-entries)) + search-vals + (guix-package-entries->name-specifications + guix-entries)) (guix-get-entries guix-profile guix-entry-type search-type search-vals params)) @@ -902,7 +899,7 @@ ENTRIES is a list of package entries to get info about packages." (entry (guix-entry-by-id id entries))) (when entry (let ((location (guix-entry-value entry 'location))) - (concat (guix-get-full-name entry) + (concat (guix-package-entry->name-specification entry) (when outputs (concat ":" (guix-concat-strings outputs ","))) diff --git a/emacs/guix-info.el b/emacs/guix-info.el index 8cb4e94185..05a8143202 100644 --- a/emacs/guix-info.el +++ b/emacs/guix-info.el @@ -187,13 +187,13 @@ Each element of the list should have a form: The order of displayed parameters is the same as in this list.") -(defun guix-info-get-insert-methods (entry-type param) +(defun guix-info-insert-methods (entry-type param) "Return list of insert methods for parameter PARAM of ENTRY-TYPE. See `guix-info-insert-methods' for details." (guix-assq-value guix-info-insert-methods entry-type param)) -(defun guix-info-get-displayed-params (entry-type) +(defun guix-info-displayed-params (entry-type) "Return parameters of ENTRY-TYPE that should be displayed." (guix-assq-value guix-info-displayed-params entry-type)) @@ -224,7 +224,7 @@ number of `guix-info-indent' spaces." guix-info-indent) (mapc (lambda (param) (guix-info-insert-param param entry entry-type)) - (guix-info-get-displayed-params entry-type)))) + (guix-info-displayed-params entry-type)))) (defun guix-info-insert-entry (entry entry-type &optional indent-level) "Insert ENTRY of ENTRY-TYPE into the current info buffer. @@ -245,7 +245,7 @@ ENTRY-TYPE is a type of ENTRY." (let ((val (guix-entry-value entry param))) (unless (and guix-info-ignore-empty-vals (null val)) (let* ((title (guix-get-param-title entry-type param)) - (insert-methods (guix-info-get-insert-methods entry-type param)) + (insert-methods (guix-info-insert-methods entry-type param)) (val-method (car insert-methods)) (title-method (cadr insert-methods))) (guix-info-method-funcall title title-method @@ -525,7 +525,7 @@ Show package name, version, and `guix-package-info-heading-params'." (unless (or (memq param '(name version)) (memq param guix-package-info-heading-params)) (guix-info-insert-param param entry 'package))) - (guix-info-get-displayed-params 'package))) + (guix-info-displayed-params 'package))) (defun guix-package-info-insert-description (desc &optional _) "Insert description DESC at point." @@ -601,7 +601,7 @@ If nil, insert installed info in a default way.") (and (guix-entry-value entry 'non-unique) (guix-entry-value entry 'installed) (guix-package-info-insert-non-unique-text - (guix-get-full-name entry))) + (guix-package-entry->name-specification entry))) (insert "\n") (mapc (lambda (output) (guix-package-info-insert-output output entry)) @@ -653,7 +653,7 @@ current OUTPUT is installed (if there is such output in TYPE is one of the following symbols: `install', `delete', `upgrade'. ENTRY is an alist with package info." (let ((type-str (capitalize (symbol-name type))) - (full-name (guix-get-full-name entry output))) + (full-name (guix-package-entry->name-specification entry output))) (guix-info-insert-action-button type-str (lambda (btn) diff --git a/emacs/guix-list.el b/emacs/guix-list.el index d6045d45cc..5e4df38c0e 100644 --- a/emacs/guix-list.el +++ b/emacs/guix-list.el @@ -117,27 +117,19 @@ function is called with 2 arguments: the first one is the value of the parameter; the second argument is an entry info (alist of parameters and their values).") -(defun guix-list-get-param-title (entry-type param) - "Return title of an ENTRY-TYPE entry parameter PARAM." +(defun guix-list-param-title (entry-type param) + "Return column title of an ENTRY-TYPE parameter PARAM." (or (guix-assq-value guix-list-column-titles entry-type param) (guix-get-param-title entry-type param))) -(defun guix-list-get-column-format (entry-type) +(defun guix-list-format (entry-type) "Return column format for ENTRY-TYPE." (guix-assq-value guix-list-column-format entry-type)) -(defun guix-list-get-displayed-params (entry-type) - "Return list of parameters of ENTRY-TYPE that should be displayed." - (mapcar #'car - (guix-list-get-column-format entry-type))) - -(defun guix-list-get-sort-key (entry-type param &optional invert) - "Return suitable sort key for `tabulated-list-sort-key'. -Define column title by ENTRY-TYPE and PARAM. If INVERT is -non-nil, invert the sort." - (when (memq param (guix-list-get-displayed-params entry-type)) - (cons (guix-list-get-param-title entry-type param) invert))) +(defun guix-list-displayed-params (entry-type) + "Return a list of ENTRY-TYPE parameters that should be displayed." + (mapcar #'car (guix-list-format entry-type))) (defun guix-list-sort-numerically (column a b) "Compare COLUMN of tabulated entries A and B numerically. @@ -169,7 +161,14 @@ See `guix-list-define-numerical-sorter' for details." (guix-list-define-numerical-sorters 9) -(defun guix-list-make-tabulated-vector (entry-type fun) +(defun guix-list-tabulated-sort-key (entry-type param &optional invert) + "Return suitable sort key for `tabulated-list-sort-key'. +Define column title by ENTRY-TYPE and PARAM. If INVERT is +non-nil, invert the sort." + (when (memq param (guix-list-displayed-params entry-type)) + (cons (guix-list-param-title entry-type param) invert))) + +(defun guix-list-tabulated-vector (entry-type fun) "Call FUN on each column specification for ENTRY-TYPE. FUN is called with 2 argument: parameter name and column @@ -179,36 +178,34 @@ Return a vector made of values of FUN calls." (apply #'vector (mapcar (lambda (col-spec) (funcall fun (car col-spec) (cdr col-spec))) - (guix-list-get-column-format entry-type)))) + (guix-list-format entry-type)))) -(defun guix-list-get-list-format (entry-type) +(defun guix-list-tabulated-format (entry-type) "Return ENTRY-TYPE list specification for `tabulated-list-format'." - (guix-list-make-tabulated-vector + (guix-list-tabulated-vector entry-type (lambda (param spec) - (cons (guix-list-get-param-title entry-type param) + (cons (guix-list-param-title entry-type param) 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'." (setq tabulated-list-entries - (guix-list-get-tabulated-entries entries entry-type)) + (guix-list-tabulated-entries entries entry-type)) (tabulated-list-print)) -(defun guix-list-get-tabulated-entries (entries entry-type) - "Return list of values of ENTRY-TYPE for `tabulated-list-entries'. -Values are taken from ENTRIES which should have the form of -`guix-entries'." +(defun guix-list-tabulated-entries (entries entry-type) + "Return a list of ENTRY-TYPE values for `tabulated-list-entries'." (mapcar (lambda (entry) (list (guix-entry-id entry) - (guix-list-get-tabulated-entry entry entry-type))) + (guix-list-tabulated-entry entry entry-type))) entries)) -(defun guix-list-get-tabulated-entry (entry entry-type) +(defun guix-list-tabulated-entry (entry entry-type) "Return array of values for `tabulated-list-entries'. -Parameters are taken from ENTRY of ENTRY-TYPE." - (guix-list-make-tabulated-vector +Parameters are taken from ENTRY-TYPE ENTRY." + (guix-list-tabulated-vector entry-type (lambda (param _) (let ((val (guix-entry-value entry param)) @@ -472,10 +469,10 @@ This macro defines the following functions: ,(concat "Initial settings for `" mode-str "'.") ,(when sort-key `(setq tabulated-list-sort-key - (guix-list-get-sort-key + (guix-list-tabulated-sort-key ',entry-type ',sort-key ,invert-sort))) (setq tabulated-list-format - (guix-list-get-list-format ',entry-type)) + (guix-list-tabulated-format ',entry-type)) (setq-local guix-list-mark-alist (append guix-list-mark-alist ,marks-var)) (tabulated-list-init-header))))) @@ -595,7 +592,7 @@ be separated with \",\")." (guix-package-list-marking-check) (let* ((entry (guix-list-current-entry)) (all (guix-entry-value entry 'outputs)) - (installed (guix-get-installed-outputs entry)) + (installed (guix-package-installed-outputs entry)) (available (cl-set-difference all installed :test #'string=))) (or available (user-error "This package is already installed")) @@ -611,7 +608,7 @@ be separated with \",\")." (interactive "P") (guix-package-list-marking-check) (let* ((entry (guix-list-current-entry)) - (installed (guix-get-installed-outputs entry))) + (installed (guix-package-installed-outputs entry))) (or installed (user-error "This package is not installed")) (guix-package-list-mark-outputs @@ -626,7 +623,7 @@ be separated with \",\")." (interactive "P") (guix-package-list-marking-check) (let* ((entry (guix-list-current-entry)) - (installed (guix-get-installed-outputs entry))) + (installed (guix-package-installed-outputs entry))) (or installed (user-error "This package is not installed")) (when (or (guix-entry-value entry 'obsolete) @@ -662,7 +659,7 @@ accept an entry as argument." (lambda (entry) (apply #'guix-list--mark 'upgrade nil - (guix-get-installed-outputs entry))))) + (guix-package-installed-outputs entry))))) (defun guix-list-execute-package-actions (fun) "Perform actions on the marked packages. @@ -758,7 +755,7 @@ Return nil, if there are no outputs marked with ACTION-TYPE. The specification is suitable for `guix-process-output-actions'." (let ((ids (guix-list-get-marked-id-list action-type))) (and ids (cons action-type - (mapcar #'guix-get-package-id-and-output-by-output-id + (mapcar #'guix-package-id-and-output-by-output-id ids))))) (defun guix-output-list-describe (&optional arg) @@ -773,7 +770,7 @@ Also see `guix-package-info-type'." (unless arg '(general))) (list (guix-list-current-id)))) (pids (mapcar (lambda (oid) - (car (guix-get-package-id-and-output-by-output-id + (car (guix-package-id-and-output-by-output-id oid))) oids))) (guix-list-describe-maybe 'package (cl-remove-duplicates pids))))) -- cgit v1.2.3 From 4ba476f94992247cd54541ac09b0a516660f20e5 Mon Sep 17 00:00:00 2001 From: Alex Kost Date: Wed, 18 Nov 2015 22:28:13 +0300 Subject: emacs: Add 'guix-keyword-args-let'. * emacs/guix-utils.el (guix-keyword-args-let): New macro. (guix-utils-font-lock-keywords): Add it. * emacs/guix-base.el (guix-define-buffer-type): Use it. * emacs/guix-list.el (guix-list-define-entry-type): Use it. * emacs/guix-read.el (guix-define-readers): Use it. --- emacs/guix-base.el | 106 ++++++++++++++++++++++++---------------------------- emacs/guix-list.el | 70 +++++++++++++++------------------- emacs/guix-read.el | 28 ++++---------- emacs/guix-utils.el | 52 +++++++++++++++++++++++++- 4 files changed, 139 insertions(+), 117 deletions(-) (limited to 'emacs/guix-base.el') diff --git a/emacs/guix-base.el b/emacs/guix-base.el index 91b52db188..f55e1c67e0 100644 --- a/emacs/guix-base.el +++ b/emacs/guix-base.el @@ -382,63 +382,55 @@ following keywords are available: (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"))) - (buf-name-val (format "*Guix %s %s*" Entry-type-str Buf-type-str)) - (revert-val nil) - (history-val 20) - (params-val '(id))) - - ;; Process the keyword args. - (while (keywordp (car args)) - (pcase (pop args) - (`:required (setq params-val (pop args))) - (`:history-size (setq history-val (pop args))) - (`:revert (setq revert-val (pop args))) - (`:buffer-name (setq buf-name-val (pop args))) - (_ (pop args)))) - - `(progn - (defgroup ,group nil - ,(concat Buf-type-str " buffer with " entry-str ".") - :prefix ,(concat prefix "-") - :group ',(intern (concat "guix-" buf-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 ".") - :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.") - :type 'integer - :group ',group) - - (defcustom ,revert-var ,revert-val - ,(concat "If non-nil, do not ask to confirm for reverting the " buf-str ".") - :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) - ,(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) - (and (fboundp ',mode-init-fun) (,mode-init-fun)))))) + (params-var (intern (concat prefix "-required-params")))) + (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))) + `(progn + (defgroup ,group nil + ,(concat Buf-type-str " buffer with " entry-str ".") + :prefix ,(concat prefix "-") + :group ',(intern (concat "guix-" buf-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 ".") + :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.") + :type 'integer + :group ',group) + + (defcustom ,revert-var ,revert-val + ,(concat "If non-nil, do not ask to confirm for reverting the " buf-str ".") + :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) + ,(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) + (and (fboundp ',mode-init-fun) (,mode-init-fun))))))) (put 'guix-define-buffer-type 'lisp-indent-function 'defun) diff --git a/emacs/guix-list.el b/emacs/guix-list.el index f0e20193c0..3e846a3377 100644 --- a/emacs/guix-list.el +++ b/emacs/guix-list.el @@ -416,45 +416,37 @@ This macro defines the following functions: (prefix (concat "guix-" entry-type-str "-list")) (mode-str (concat prefix "-mode")) (init-fun (intern (concat prefix "-mode-initialize"))) - (marks-var (intern (concat prefix "-mark-alist"))) - (marks-val nil) - (sort-key nil) - (invert-sort nil)) - - ;; Process the keyword args. - (while (keywordp (car args)) - (pcase (pop args) - (`:sort-key (setq sort-key (pop args))) - (`:invert-sort (setq invert-sort (pop args))) - (`:marks (setq marks-val (pop args))) - (_ (pop args)))) - - `(progn - (defvar ,marks-var ',marks-val - ,(concat "Alist of additional marks for `" mode-str "'.\n" - "Marks from this list are added to `guix-list-mark-alist'.")) - - ,@(mapcar (lambda (mark-spec) - (let* ((mark-name (car mark-spec)) - (mark-name-str (symbol-name mark-name))) - `(defun ,(intern (concat prefix "-mark-" mark-name-str "-simple")) () - ,(concat "Put '" mark-name-str "' mark and move to the next line.\n" - "Also add the current entry to `guix-list-marked'.") - (interactive) - (guix-list--mark ',mark-name t)))) - marks-val) - - (defun ,init-fun () - ,(concat "Initial settings for `" mode-str "'.") - ,(when sort-key - `(setq tabulated-list-sort-key - (guix-list-tabulated-sort-key - ',entry-type ',sort-key ,invert-sort))) - (setq tabulated-list-format - (guix-list-tabulated-format ',entry-type)) - (setq-local guix-list-mark-alist - (append guix-list-mark-alist ,marks-var)) - (tabulated-list-init-header))))) + (marks-var (intern (concat prefix "-mark-alist")))) + (guix-keyword-args-let args + ((sort-key :sort-key) + (invert-sort :invert-sort) + (marks-val :marks)) + `(progn + (defvar ,marks-var ',marks-val + ,(concat "Alist of additional marks for `" mode-str "'.\n" + "Marks from this list are added to `guix-list-mark-alist'.")) + + ,@(mapcar (lambda (mark-spec) + (let* ((mark-name (car mark-spec)) + (mark-name-str (symbol-name mark-name))) + `(defun ,(intern (concat prefix "-mark-" mark-name-str "-simple")) () + ,(concat "Put '" mark-name-str "' mark and move to the next line.\n" + "Also add the current entry to `guix-list-marked'.") + (interactive) + (guix-list--mark ',mark-name t)))) + marks-val) + + (defun ,init-fun () + ,(concat "Initial settings for `" mode-str "'.") + ,(when sort-key + `(setq tabulated-list-sort-key + (guix-list-tabulated-sort-key + ',entry-type ',sort-key ,invert-sort))) + (setq tabulated-list-format + (guix-list-tabulated-format ',entry-type)) + (setq-local guix-list-mark-alist + (append guix-list-mark-alist ,marks-var)) + (tabulated-list-init-header)))))) (put 'guix-list-define-entry-type 'lisp-indent-function 'defun) diff --git a/emacs/guix-read.el b/emacs/guix-read.el index e60af9c2f7..82eccbd678 100644 --- a/emacs/guix-read.el +++ b/emacs/guix-read.el @@ -66,26 +66,14 @@ keywords are available: `-string' function returning a string of multiple values separated the specified separator will be defined." - (let (completions-var - completions-getter - single-reader - single-prompt - multiple-reader - multiple-prompt - multiple-separator) - - ;; Process the keyword args. - (while (keywordp (car args)) - (pcase (pop args) - (`:completions-var (setq completions-var (pop args))) - (`:completions-getter (setq completions-getter (pop args))) - (`:single-reader (setq single-reader (pop args))) - (`:single-prompt (setq single-prompt (pop args))) - (`:multiple-reader (setq multiple-reader (pop args))) - (`:multiple-prompt (setq multiple-prompt (pop args))) - (`:multiple-separator (setq multiple-separator (pop args))) - (_ (pop args)))) - + (guix-keyword-args-let args + ((completions-var :completions-var) + (completions-getter :completions-getter) + (single-reader :single-reader) + (single-prompt :single-prompt) + (multiple-reader :multiple-reader) + (multiple-prompt :multiple-prompt) + (multiple-separator :multiple-separator)) (let ((completions (cond ((and completions-var completions-getter) `(or ,completions-var diff --git a/emacs/guix-utils.el b/emacs/guix-utils.el index e24b58fb17..3748350b87 100644 --- a/emacs/guix-utils.el +++ b/emacs/guix-utils.el @@ -257,6 +257,55 @@ modifier call." (guix-modify (funcall (car modifiers) object) (cdr modifiers)))) +(defmacro guix-keyword-args-let (args varlist &rest body) + "Parse ARGS, bind variables from VARLIST and eval BODY. + +Find keyword values in ARGS, bind them to variables according to +VARLIST, then evaluate BODY. + +ARGS is a keyword/value property list. + +Each element of VARLIST has a form: + + (SYMBOL KEYWORD [DEFAULT-VALUE]) + +SYMBOL is a varible name. KEYWORD is a symbol that will be +searched in ARGS for an according value. If the value of KEYWORD +does not exist, bind SYMBOL to DEFAULT-VALUE or nil. + +The rest arguments (that present in ARGS but not in VARLIST) will +be bound to `%foreign-args' variable. + +Example: + + (guix-keyword-args-let '(:two 8 :great ! :guix is) + ((one :one 1) + (two :two 2) + (foo :smth)) + (list one two foo %foreign-args)) + + => (1 8 nil (:guix is :great !))" + (declare (indent 2)) + (let ((args-var (make-symbol "args"))) + `(let (,@(mapcar (lambda (spec) + (pcase-let ((`(,name ,_ ,val) spec)) + (list name val))) + varlist) + (,args-var ,args) + %foreign-args) + (while ,args-var + (pcase ,args-var + (`(,key ,val . ,rest-args) + (cl-case key + ,@(mapcar (lambda (spec) + (pcase-let ((`(,name ,key ,_) spec)) + `(,key (setq ,name val)))) + varlist) + (t (setq %foreign-args + (cl-list* key val %foreign-args)))) + (setq ,args-var rest-args)))) + ,@body))) + ;;; Alist accessors @@ -326,7 +375,8 @@ See `defun' for the meaning of arguments." (defvar guix-utils-font-lock-keywords (eval-when-compile - `((,(rx "(" (group "guix-with-indent") + `((,(rx "(" (group (or "guix-keyword-args-let" + "guix-with-indent")) symbol-end) . 1) (,(rx "(" -- cgit v1.2.3 From 7735c503b5b8dfe7d8963207f4f2cf0b7dfd3894 Mon Sep 17 00:00:00 2001 From: Alex Kost Date: Fri, 20 Nov 2015 12:38:31 +0300 Subject: emacs: Factorize macros for defining interfaces. Make a root 'guix-buffer-define-interface' macro. It should generate a common code for any type of interface. Inherit 'guix-info-define-interface' and 'guix-list-define-interface' from it. They should provide a general 'info'/'list' interface for any data. Finally, make 'guix-ui-define-interface' for the common code for interfaces to Guix packages and generations, and inherit 'guix-ui-info-define-interface' and 'guix-ui-list-define-interface' from it. * emacs/guix-base.el (guix-define-buffer-type): Rename to... (guix-buffer-define-interface): ... this. Rename internal variables ('buf-' -> 'buffer-'). Move ':required' keyword to 'guix-ui-define-interface'. * emacs/guix-info.el (guix-info-define-interface): New macro. (guix-info-font-lock-keywords): New variable. * emacs/guix-list.el (guix-list-define-entry-type): Rename to... (guix-list-define-interface): ... this. (guix-list-font-lock-keywords): New variable. (guix-list-describe-ids): Move and rename to... * emacs/guix-ui.el: New file. (guix-ui-list-describe): ... this. (guix-ui-define-interface, guix-ui-info-define-interface) (guix-ui-list-define-interface): New macros. (guix-ui-font-lock-keywords): New variable. * emacs.am (ELFILES): Add "emacs/guix-ui.el" --- emacs.am | 1 + emacs/guix-base.el | 122 ++++++++++++++++++++++++----------------------------- emacs/guix-info.el | 30 +++++++++++-- emacs/guix-list.el | 47 +++++++++++---------- emacs/guix-ui.el | 109 +++++++++++++++++++++++++++++++++++++++++++++++ 5 files changed, 216 insertions(+), 93 deletions(-) create mode 100644 emacs/guix-ui.el (limited to 'emacs/guix-base.el') diff --git a/emacs.am b/emacs.am index a205b0a359..ad7de78657 100644 --- a/emacs.am +++ b/emacs.am @@ -40,6 +40,7 @@ ELFILES = \ emacs/guix-prettify.el \ emacs/guix-profiles.el \ emacs/guix-read.el \ + emacs/guix-ui.el \ emacs/guix-utils.el \ emacs/guix.el diff --git a/emacs/guix-base.el b/emacs/guix-base.el index f55e1c67e0..67b83cfbe3 100644 --- a/emacs/guix-base.el +++ b/emacs/guix-base.el @@ -23,7 +23,7 @@ ;; package. ;; List and info buffers have many common patterns that are defined -;; using `guix-define-buffer-type' macro from this file. +;; using `guix-buffer-define-interface' macro from this file. ;;; Code: @@ -337,103 +337,93 @@ VAL is a value of this parameter.") (concat (symbol-name entry-type) "-")) (symbol-name buffer-type) "-" postfix))) -(defmacro guix-define-buffer-type (buf-type entry-type &rest args) - "Define common for BUF-TYPE buffers for displaying ENTRY-TYPE entries. - -In the text below TYPE means ENTRY-TYPE-BUF-TYPE. - -This macro defines `guix-TYPE-mode', a custom group and several -user variables. +(defmacro guix-buffer-define-interface (buffer-type entry-type &rest args) + "Define BUFFER-TYPE interface for displaying ENTRY-TYPE entries. +Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ... +In the following description TYPE means ENTRY-TYPE-BUFFER-TYPE. The following stuff should be defined outside this macro: - - `guix-BUF-TYPE-mode' - parent mode for the defined mode. + - `guix-BUFFER-TYPE-mode' - parent mode of the generated mode. - `guix-TYPE-mode-initialize' (optional) - function for additional mode settings; it is called without arguments. -Remaining argument (ARGS) should have a form [KEYWORD VALUE] ... The -following keywords are available: +Optional keywords: - - `:buffer-name' - default value for the defined + - `:buffer-name' - default value of the generated `guix-TYPE-buffer-name' variable. - - `:required' - default value for the defined - `guix-TYPE-required-params' variable. - - - `:history-size' - default value for the defined + - `:history-size' - default value of the generated `guix-TYPE-history-size' variable. - - `:revert' - default value for the defined - `guix-TYPE-revert-no-confirm' variable." - (let* ((entry-type-str (symbol-name entry-type)) - (buf-type-str (symbol-name buf-type)) - (Entry-type-str (capitalize entry-type-str)) - (Buf-type-str (capitalize buf-type-str)) - (entry-str (concat entry-type-str " entries")) - (buf-str (concat buf-type-str " buffer")) - (prefix (concat "guix-" entry-type-str "-" buf-type-str)) - (group (intern prefix)) - (faces-group (intern (concat prefix "-faces"))) - (mode-map-str (concat prefix "-mode-map")) - (parent-mode (intern (concat "guix-" buf-type-str "-mode"))) - (mode (intern (concat prefix "-mode"))) - (mode-init-fun (intern (concat prefix "-mode-initialize"))) - (buf-name-var (intern (concat prefix "-buffer-name"))) - (revert-var (intern (concat prefix "-revert-no-confirm"))) - (history-var (intern (concat prefix "-history-size"))) - (params-var (intern (concat prefix "-required-params")))) + - `:revert-confirm?' - default value of the generated + `guix-TYPE-revert-confirm' variable." + (declare (indent 2)) + (let* ((entry-type-str (symbol-name entry-type)) + (buffer-type-str (symbol-name buffer-type)) + (Entry-type-str (capitalize entry-type-str)) + (Buffer-type-str (capitalize buffer-type-str)) + (entry-str (concat entry-type-str " entries")) + (buffer-str (concat buffer-type-str " buffer")) + (prefix (concat "guix-" entry-type-str "-" + buffer-type-str)) + (group (intern prefix)) + (faces-group (intern (concat prefix "-faces"))) + (mode-map-str (concat prefix "-mode-map")) + (parent-mode (intern (concat "guix-" buffer-type-str "-mode"))) + (mode (intern (concat prefix "-mode"))) + (mode-init-fun (intern (concat prefix "-mode-initialize"))) + (buffer-name-var (intern (concat prefix "-buffer-name"))) + (history-size-var (intern (concat prefix "-history-size"))) + (revert-confirm-var (intern (concat prefix "-revert-confirm")))) (guix-keyword-args-let args - ((params-val :required '(id)) - (history-val :history-size 20) - (revert-val :revert) - (buf-name-val :buffer-name - (format "*Guix %s %s*" Entry-type-str Buf-type-str))) + ((buffer-name-val :buffer-name + (format "*Guix %s %s*" + Entry-type-str Buffer-type-str)) + (history-size-val :history-size 20) + (revert-confirm-val :revert-confirm? t)) `(progn (defgroup ,group nil - ,(concat Buf-type-str " buffer with " entry-str ".") + ,(format "Display '%s' entries in '%s' buffer." + entry-type-str buffer-type-str) :prefix ,(concat prefix "-") - :group ',(intern (concat "guix-" buf-type-str))) + :group ',(intern (concat "guix-" buffer-type-str))) (defgroup ,faces-group nil - ,(concat "Faces for " buf-type-str " buffer with " entry-str ".") - :group ',(intern (concat "guix-" buf-type-str "-faces"))) - - (defcustom ,buf-name-var ,buf-name-val - ,(concat "Default name of the " buf-str " for displaying " entry-str ".") + ,(format "Faces for displaying '%s' entries in '%s' buffer." + entry-type-str buffer-type-str) + :group ',(intern (concat "guix-" buffer-type-str "-faces"))) + + (defcustom ,buffer-name-var ,buffer-name-val + ,(format "\ +Default name of '%s' buffer for displaying '%s' entries." + buffer-type-str entry-type-str) :type 'string :group ',group) - (defcustom ,history-var ,history-val - ,(concat "Maximum number of items saved in the history of the " buf-str ".\n" - "If 0, the history is disabled.") + (defcustom ,history-size-var ,history-size-val + ,(format "\ +Maximum number of items saved in history of `%S' buffer. +If 0, the history is disabled." + buffer-name-var) :type 'integer :group ',group) - (defcustom ,revert-var ,revert-val - ,(concat "If non-nil, do not ask to confirm for reverting the " buf-str ".") + (defcustom ,revert-confirm-var ,revert-confirm-val + ,(format "\ +If non-nil, ask to confirm for reverting `%S' buffer." + buffer-name-var) :type 'boolean :group ',group) - (defvar ,params-var ',params-val - ,(concat "List of required " entry-type-str " parameters.\n\n" - "Displayed parameters and parameters from this list are received\n" - "for each " entry-type-str ".\n\n" - "May be a special value `all', in which case all supported\n" - "parameters are received (this may be very slow for a big number\n" - "of entries).\n\n" - "Do not remove `id' from this list as it is required for\n" - "identifying an entry.")) - - (define-derived-mode ,mode ,parent-mode ,(concat "Guix-" Buf-type-str) + (define-derived-mode ,mode ,parent-mode ,(concat "Guix-" Buffer-type-str) ,(concat "Major mode for displaying information about " entry-str ".\n\n" "\\{" mode-map-str "}") (setq-local revert-buffer-function 'guix-revert-buffer) - (setq-local guix-history-size ,history-var) + (setq-local guix-history-size ,history-size-var) (and (fboundp ',mode-init-fun) (,mode-init-fun))))))) -(put 'guix-define-buffer-type 'lisp-indent-function 'defun) - ;;; Getting and displaying info about packages and generations diff --git a/emacs/guix-info.el b/emacs/guix-info.el index 9c46810f60..d31e0377ff 100644 --- a/emacs/guix-info.el +++ b/emacs/guix-info.el @@ -28,6 +28,7 @@ (require 'guix-base) (require 'guix-entry) (require 'guix-utils) +(require 'guix-ui) (defgroup guix-info nil "General settings for info buffers." @@ -455,6 +456,8 @@ See `insert-text-button' for the meaning of PROPERTIES." properties)) +;;; Major mode and interface definer + (defvar guix-info-mode-map (let ((map (make-sparse-keymap))) (set-keymap-parent @@ -466,11 +469,21 @@ See `insert-text-button' for the meaning of PROPERTIES." (define-derived-mode guix-info-mode special-mode "Guix-Info" "Parent mode for displaying information in info buffers.") +(defmacro guix-info-define-interface (entry-type &rest args) + "Define 'info' interface for displaying ENTRY-TYPE entries. +Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ... + +The rest keyword arguments are passed to +`guix-buffer-define-interface' macro." + (declare (indent 1)) + `(guix-buffer-define-interface info ,entry-type + ,@args)) + ;;; Displaying packages -(guix-define-buffer-type info package - :required (id name version installed non-unique)) +(guix-ui-info-define-interface package + :required '(id name version installed non-unique)) (defface guix-package-info-heading '((t :inherit guix-info-heading)) @@ -758,7 +771,7 @@ This function is used to hide a \"Download\" button if needed." (guix-ui-info-define-interface output :buffer-name "*Guix Package Info*" - :required (id package-id installed non-unique)) + :required '(id package-id installed non-unique)) (defun guix-output-info-insert-version (version entry) "Insert output VERSION and obsolete text if needed at point." @@ -786,7 +799,7 @@ This function is used to hide a \"Download\" button if needed." ;;; Displaying generations -(guix-define-buffer-type info generation) +(guix-ui-info-define-interface generation) (defface guix-generation-info-number '((t :inherit font-lock-keyword-face)) @@ -837,6 +850,15 @@ This function is used to hide a \"Download\" button if needed." "Switch to this generation (make it the current one)" 'number (guix-entry-value entry 'number)))) + +(defvar guix-info-font-lock-keywords + (eval-when-compile + `((,(rx "(" (group "guix-info-define-interface") + symbol-end) + . 1)))) + +(font-lock-add-keywords 'emacs-lisp-mode guix-info-font-lock-keywords) + (provide 'guix-info) ;;; guix-info.el ends here diff --git a/emacs/guix-list.el b/emacs/guix-list.el index e1fc199639..8943e8f589 100644 --- a/emacs/guix-list.el +++ b/emacs/guix-list.el @@ -30,6 +30,7 @@ (require 'guix-base) (require 'guix-entry) (require 'guix-utils) +(require 'guix-ui) (defgroup guix-list nil "General settings for list buffers." @@ -73,17 +74,12 @@ With prefix argument, describe entries marked with any mark." count))) (guix-list-describe-entries entry-type ids)))) -(defun guix-list-describe-ids (ids) - "Describe entries with IDS (list of identifiers)." - (apply #'guix-get-show-entries - guix-profile 'info guix-entry-type 'id ids)) - ;;; Wrappers for 'list' variables (defvar guix-list-data nil "Alist with 'list' data. -This alist is filled by `guix-list-define-entry-type' macro.") +This alist is filled by `guix-list-define-interface' macro.") (defun guix-list-value (entry-type symbol) "Return SYMBOL's value for ENTRY-TYPE from `guix-list-data'." @@ -416,8 +412,8 @@ Same as `tabulated-list-sort', but also restore marks after sorting." (setq-local guix-list-marks (guix-list-marks entry-type)) (tabulated-list-init-header)) -(defmacro guix-list-define-entry-type (entry-type &rest args) - "Define common stuff for displaying ENTRY-TYPE entries in list buffers. +(defmacro guix-list-define-interface (entry-type &rest args) + "Define 'list' interface for displaying ENTRY-TYPE entries. Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ... Required keywords: @@ -435,7 +431,10 @@ Optional keywords: - `:marks' - default value of the generated `guix-ENTRY-TYPE-list-marks' variable. -" + +The rest keyword arguments are passed to +`guix-buffer-define-interface' macro." + (declare (indent 1)) (let* ((entry-type-str (symbol-name entry-type)) (prefix (concat "guix-" entry-type-str "-list")) (group (intern prefix)) @@ -518,17 +517,15 @@ See also `guix-list-describe'." (format . ,format-var) (sort-key . ,sort-key-var) (marks . ,marks-var)) - 'guix-list-data ',entry-type))))) + 'guix-list-data ',entry-type) -(put 'guix-list-define-entry-type 'lisp-indent-function 'defun) + (guix-buffer-define-interface list ,entry-type + ,@%foreign-args))))) ;;; Displaying packages -(guix-define-buffer-type list package) - -(guix-list-define-entry-type package - :describe-function 'guix-list-describe-ids +(guix-ui-list-define-interface package :format '((name guix-package-list-get-name 20 t) (version nil 10 nil) (outputs nil 13 t) @@ -717,17 +714,15 @@ The specification is suitable for `guix-process-package-actions'." ;;; Displaying outputs -(guix-define-buffer-type list output +(guix-ui-list-define-interface output :buffer-name "*Guix Package List*" - :required (package-id)) - -(guix-list-define-entry-type output :describe-function 'guix-output-list-describe :format '((name guix-package-list-get-name 20 t) (version nil 10 nil) (output nil 9 t) (installed nil 12 t) (synopsis guix-list-get-one-line 30 nil)) + :required '(package-id) :sort-key '(name) :marks '((install . ?I) (upgrade . ?U) @@ -816,10 +811,7 @@ See `guix-package-info-type'." ;;; Displaying generations -(guix-define-buffer-type list generation) - -(guix-list-define-entry-type generation - :describe-function 'guix-list-describe-ids +(guix-ui-list-define-interface generation :format '((number nil 5 guix-list-sort-numerically-0 :right-align t) (current guix-generation-list-get-current 10 t) (time guix-list-get-time 20 t) @@ -954,6 +946,15 @@ With ARG, mark all generations for deletion." (user-error "No generations marked for deletion")) (guix-delete-generations guix-profile marked (current-buffer)))) + +(defvar guix-list-font-lock-keywords + (eval-when-compile + `((,(rx "(" (group "guix-list-define-interface") + symbol-end) + . 1)))) + +(font-lock-add-keywords 'emacs-lisp-mode guix-list-font-lock-keywords) + (provide 'guix-list) ;;; guix-list.el ends here diff --git a/emacs/guix-ui.el b/emacs/guix-ui.el new file mode 100644 index 0000000000..4f4688250b --- /dev/null +++ b/emacs/guix-ui.el @@ -0,0 +1,109 @@ +;;; guix-ui.el --- Common code for Guix package management interface -*- lexical-binding: t -*- + +;; Copyright © 2014, 2015 Alex Kost + +;; 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 . + +;;; 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 -- cgit v1.2.3 From 9193fb7c1dedcf2233287baa819a9c9ded8242a8 Mon Sep 17 00:00:00 2001 From: Alex Kost Date: Fri, 20 Nov 2015 21:25:10 +0300 Subject: emacs: info: Split 'guix-info-format' variable. * emacs/guix-info.el: Generate 'guix-ENTRY-TYPE-info-format' variables for 'package', 'installed-output', 'output' and 'generation' entry types. (guix-info-format): Remove. (guix-info-data): New variable. (guix-info-value): New procedure. (guix-info-define-interface): Add ':format' keyword. * emacs/guix-base.el (guix-buffer-define-interface): Add ':reduced?' keyword. * doc/emacs.texi (Emacs Appearance): Adjust accordingly. --- doc/emacs.texi | 2 +- emacs/guix-base.el | 55 +++++++++-------- emacs/guix-info.el | 174 +++++++++++++++++++++++++++++++---------------------- 3 files changed, 133 insertions(+), 98 deletions(-) (limited to 'emacs/guix-base.el') diff --git a/doc/emacs.texi b/doc/emacs.texi index 7f5a9bb023..fb6da31cdb 100644 --- a/doc/emacs.texi +++ b/doc/emacs.texi @@ -484,7 +484,7 @@ the following variables (@dfn{ENTRY-TYPE} means @code{package}, Specify the columns, their names, what and how is displayed in ``list'' buffers. -@item guix-info-format +@item guix-ENTRY-TYPE-info-format @itemx guix-info-ignore-empty-values @itemx guix-info-param-title-format @itemx guix-info-multiline-prefix diff --git a/emacs/guix-base.el b/emacs/guix-base.el index 67b83cfbe3..6fa03064b8 100644 --- a/emacs/guix-base.el +++ b/emacs/guix-base.el @@ -358,7 +358,9 @@ Optional keywords: `guix-TYPE-history-size' variable. - `:revert-confirm?' - default value of the generated - `guix-TYPE-revert-confirm' variable." + `guix-TYPE-revert-confirm' variable. + + - `:reduced?' - if non-nil, generate only group and faces group." (declare (indent 2)) (let* ((entry-type-str (symbol-name entry-type)) (buffer-type-str (symbol-name buffer-type)) @@ -382,7 +384,8 @@ Optional keywords: (format "*Guix %s %s*" Entry-type-str Buffer-type-str)) (history-size-val :history-size 20) - (revert-confirm-val :revert-confirm? t)) + (revert-confirm-val :revert-confirm? t) + (reduced? :reduced?)) `(progn (defgroup ,group nil ,(format "Display '%s' entries in '%s' buffer." @@ -395,34 +398,38 @@ Optional keywords: entry-type-str buffer-type-str) :group ',(intern (concat "guix-" buffer-type-str "-faces"))) - (defcustom ,buffer-name-var ,buffer-name-val - ,(format "\ + ,(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) + buffer-type-str entry-type-str) + :type 'string + :group ',group) - (defcustom ,history-size-var ,history-size-val - ,(format "\ + (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) + buffer-name-var) + :type 'integer + :group ',group) - (defcustom ,revert-confirm-var ,revert-confirm-val - ,(format "\ + (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) - - (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-size-var) - (and (fboundp ',mode-init-fun) (,mode-init-fun))))))) + buffer-name-var) + :type 'boolean + :group ',group) + + (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-size-var) + (and (fboundp ',mode-init-fun) (,mode-init-fun))))))))) ;;; Getting and displaying info about packages and generations diff --git a/emacs/guix-info.el b/emacs/guix-info.el index d31e0377ff..bf43b40e9e 100644 --- a/emacs/guix-info.el +++ b/emacs/guix-info.el @@ -114,76 +114,16 @@ This string is used by `guix-info-insert-value-format'.") (defvar guix-info-delimiter "\n\f\n" "String used to separate entries.") -(defvar guix-info-format - '((package - guix-package-info-insert-heading - ignore - (synopsis ignore (simple guix-package-info-synopsis)) - ignore - (description ignore (simple guix-package-info-description)) - ignore - (outputs simple guix-package-info-insert-outputs) - (source simple guix-package-info-insert-source) - (location format (format guix-package-location)) - (home-url format (format guix-url)) - (license format (format guix-package-info-license)) - (inputs format (format guix-package-input)) - (native-inputs format (format guix-package-native-input)) - (propagated-inputs format (format guix-package-propagated-input))) - (installed - (path simple (indent guix-file)) - (dependencies simple (indent guix-file))) - (output - (name format (format guix-package-info-name)) - (version format guix-output-info-insert-version) - (output format guix-output-info-insert-output) - (synopsis simple (indent guix-package-info-synopsis)) - (source simple guix-package-info-insert-source) - (path simple (indent guix-file)) - (dependencies simple (indent guix-file)) - (location format (format guix-package-location)) - (home-url format (format guix-url)) - (license format (format guix-package-info-license)) - (inputs format (format guix-package-input)) - (native-inputs format (format guix-package-native-input)) - (propagated-inputs format (format guix-package-propagated-input)) - (description simple (indent guix-package-info-description))) - (generation - (number format guix-generation-info-insert-number) - (prev-number format (format)) - (current format guix-generation-info-insert-current) - (path simple (indent guix-file)) - (time format (time)))) - "Methods for inserting parameter values. -Each element of the list should have a form: - - (ENTRY-TYPE . (METHOD ...)) - -Each METHOD should be either a function or should have the -following form: - - (PARAM INSERT-TITLE INSERT-VALUE) - -If METHOD is a function, it is called with an entry as argument. - -PARAM is a name of entry parameter. - -INSERT-TITLE may be either a symbol or a list. If it is a -symbol, it should be a function or an alias from -`guix-info-title-aliases', in which case it is called with title -as argument. If it is a list, it should have a -form (FUN-OR-ALIAS [ARGS ...]), in which case FUN-OR-ALIAS is -called with title and ARGS as arguments. + +;;; Wrappers for 'info' variables -INSERT-VALUE may be either a symbol or a list. If it is a -symbol, it should be a function or an alias from -`guix-info-value-aliases', in which case it is called with value -and entry as arguments. If it is a list, it should have a -form (FUN-OR-ALIAS [ARGS ...]), in which case FUN-OR-ALIAS is -called with value and ARGS as arguments. +(defvar guix-info-data nil + "Alist with 'info' data. +This alist is filled by `guix-info-define-interface' macro.") -Parameters are inserted in the same order as defined by this list. -After calling each METHOD, a new line is inserted.") +(defun guix-info-value (entry-type symbol) + "Return SYMBOL's value for ENTRY-TYPE from `guix-info-data'." + (symbol-value (guix-assq-value guix-info-data entry-type symbol))) (defun guix-info-param-title (entry-type param) "Return a title of an ENTRY-TYPE parameter PARAM." @@ -191,7 +131,7 @@ After calling each METHOD, a new line is inserted.") (defun guix-info-format (entry-type) "Return 'info' format for ENTRY-TYPE." - (guix-assq-value guix-info-format entry-type)) + (guix-info-value entry-type 'format)) (defun guix-info-displayed-params (entry-type) "Return a list of ENTRY-TYPE parameters that should be displayed." @@ -473,18 +413,86 @@ See `insert-text-button' for the meaning of PROPERTIES." "Define 'info' interface for displaying ENTRY-TYPE entries. Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ... +Required keywords: + + - `:format' - default value of the generated + `guix-ENTRY-TYPE-info-format' variable. + The rest keyword arguments are passed to `guix-buffer-define-interface' macro." (declare (indent 1)) - `(guix-buffer-define-interface info ,entry-type - ,@args)) + (let* ((entry-type-str (symbol-name entry-type)) + (prefix (concat "guix-" entry-type-str "-info")) + (group (intern prefix)) + (format-var (intern (concat prefix "-format")))) + (guix-keyword-args-let args + ((format-val :format)) + `(progn + (defcustom ,format-var ,format-val + ,(format "\ +List of methods for inserting '%s' entry. +Each METHOD should be either a function or should have the +following form: + + (PARAM INSERT-TITLE INSERT-VALUE) + +If METHOD is a function, it is called with an entry as argument. + +PARAM is a name of '%s' entry parameter. + +INSERT-TITLE may be either a symbol or a list. If it is a +symbol, it should be a function or an alias from +`guix-info-title-aliases', in which case it is called with title +as argument. If it is a list, it should have a +form (FUN-OR-ALIAS [ARGS ...]), in which case FUN-OR-ALIAS is +called with title and ARGS as arguments. + +INSERT-VALUE may be either a symbol or a list. If it is a +symbol, it should be a function or an alias from +`guix-info-value-aliases', in which case it is called with value +and entry as arguments. If it is a list, it should have a +form (FUN-OR-ALIAS [ARGS ...]), in which case FUN-OR-ALIAS is +called with value and ARGS as arguments. + +Parameters are inserted in the same order as defined by this list. +After calling each METHOD, a new line is inserted." + entry-type-str entry-type-str) + :type 'sexp + :group ',group) + + (guix-alist-put! + '((format . ,format-var)) + 'guix-info-data ',entry-type) + + (guix-buffer-define-interface info ,entry-type + ,@%foreign-args))))) ;;; Displaying packages (guix-ui-info-define-interface package + :format '(guix-package-info-insert-heading + ignore + (synopsis ignore (simple guix-package-info-synopsis)) + ignore + (description ignore (simple guix-package-info-description)) + ignore + (outputs simple guix-package-info-insert-outputs) + (source simple guix-package-info-insert-source) + (location format (format guix-package-location)) + (home-url format (format guix-url)) + (license format (format guix-package-info-license)) + (inputs format (format guix-package-input)) + (native-inputs format (format guix-package-native-input)) + (propagated-inputs format + (format guix-package-propagated-input))) :required '(id name version installed non-unique)) +(guix-info-define-interface installed-output + :format '((path simple (indent guix-file)) + (dependencies simple (indent guix-file))) + :reduced? t) + (defface guix-package-info-heading '((t :inherit guix-info-heading)) "Face for package name and version headings." @@ -641,7 +649,7 @@ current OUTPUT is installed (if there is such output in (guix-package-info-insert-action-button 'upgrade entry output)) (insert "\n") (when installed-entry - (guix-info-insert-entry installed-entry 'installed 2)))) + (guix-info-insert-entry installed-entry 'installed-output 2)))) (defun guix-package-info-insert-action-button (type entry output) "Insert button to process an action on a package OUTPUT at point. @@ -771,6 +779,21 @@ This function is used to hide a \"Download\" button if needed." (guix-ui-info-define-interface output :buffer-name "*Guix Package Info*" + :format '((name format (format guix-package-info-name)) + (version format guix-output-info-insert-version) + (output format guix-output-info-insert-output) + (synopsis simple (indent guix-package-info-synopsis)) + (source simple guix-package-info-insert-source) + (path simple (indent guix-file)) + (dependencies simple (indent guix-file)) + (location format (format guix-package-location)) + (home-url format (format guix-url)) + (license format (format guix-package-info-license)) + (inputs format (format guix-package-input)) + (native-inputs format (format guix-package-native-input)) + (propagated-inputs format + (format guix-package-propagated-input)) + (description simple (indent guix-package-info-description))) :required '(id package-id installed non-unique)) (defun guix-output-info-insert-version (version entry) @@ -799,7 +822,12 @@ This function is used to hide a \"Download\" button if needed." ;;; Displaying generations -(guix-ui-info-define-interface generation) +(guix-ui-info-define-interface generation + :format '((number format guix-generation-info-insert-number) + (prev-number format (format)) + (current format guix-generation-info-insert-current) + (path simple (indent guix-file)) + (time format (time)))) (defface guix-generation-info-number '((t :inherit font-lock-keyword-face)) -- cgit v1.2.3 From 574f6727b061e2b58b23cb9b75a75d03822f5d08 Mon Sep 17 00:00:00 2001 From: Alex Kost Date: Sat, 21 Nov 2015 11:35:43 +0300 Subject: emacs: Split 'guix-param-titles' variable. Generate 'guix-ENTRY-TYPE-BUFFER-TYPE-titles' variables for each ENTRY-TYPE and BUFFER-TYPE instead. * emacs/guix-base.el (guix-param-titles): Remove. (guix-buffer-data): New variable. (guix-buffer-value, guix-buffer-param-title): New procedures. (guix-buffer-define-interface): Add ':titles' keyword. * emacs/guix-info.el (guix-info-param-title): Adjust accordingly. * emacs/guix-list.el (guix-list-param-title): Likewise. (guix-list-column-titles): Remove. * doc/emacs.texi (Emacs Appearance): Adjust accordingly. --- doc/emacs.texi | 3 ++- emacs/guix-base.el | 61 +++++++++++++++++++++++++++++++++--------------------- emacs/guix-info.el | 9 ++++++-- emacs/guix-list.el | 12 ++--------- 4 files changed, 48 insertions(+), 37 deletions(-) (limited to 'emacs/guix-base.el') diff --git a/doc/emacs.texi b/doc/emacs.texi index fb6da31cdb..5828bb74d5 100644 --- a/doc/emacs.texi +++ b/doc/emacs.texi @@ -480,11 +480,12 @@ the following variables (@dfn{ENTRY-TYPE} means @code{package}, @table @code @item guix-ENTRY-TYPE-list-format -@itemx guix-list-column-titles +@itemx guix-ENTRY-TYPE-list-titles Specify the columns, their names, what and how is displayed in ``list'' buffers. @item guix-ENTRY-TYPE-info-format +@itemx guix-ENTRY-TYPE-info-titles @itemx guix-info-ignore-empty-values @itemx guix-info-param-title-format @itemx guix-info-multiline-prefix diff --git a/emacs/guix-base.el b/emacs/guix-base.el index 6fa03064b8..f75624c6c9 100644 --- a/emacs/guix-base.el +++ b/emacs/guix-base.el @@ -39,28 +39,6 @@ ;;; Parameters of the entries -(defvar guix-param-titles - '((package - (home-url . "Home page")) - (installed - (path . "Installed path")) - (output - (home-url . "Home page") - (path . "Installed path")) - (generation - (prev-number . "Previous number"))) - "List for defining titles of entry parameters. -Titles are used for displaying information about entries. -Each element of the list has a form: - - (ENTRY-TYPE . ((PARAM . TITLE) ...))") - -(defun guix-get-param-title (entry-type param) - "Return title of an ENTRY-TYPE entry parameter PARAM." - (or (guix-assq-value guix-param-titles - entry-type param) - (guix-symbol-title param))) - (defun guix-package-name-specification (name version &optional output) "Return Guix package specification by its NAME, VERSION and OUTPUT." (concat name "-" version @@ -278,6 +256,25 @@ See `guix-update-after-operation' for details." ;;; 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))) + (defvar guix-root-map (let ((map (make-sparse-keymap))) (define-key map (kbd "l") 'guix-history-back) @@ -354,13 +351,17 @@ Optional keywords: - `:buffer-name' - default value of the generated `guix-TYPE-buffer-name' 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. - - `:reduced?' - if non-nil, generate only group and faces group." + - `: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)) @@ -377,12 +378,14 @@ Optional keywords: (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 (format "*Guix %s %s*" Entry-type-str Buffer-type-str)) + (titles-val :titles) (history-size-val :history-size 20) (revert-confirm-val :revert-confirm? t) (reduced? :reduced?)) @@ -398,6 +401,12 @@ Optional keywords: 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 @@ -429,7 +438,11 @@ If non-nil, ask to confirm for reverting `%S' buffer." "\\{" mode-map-str "}") (setq-local revert-buffer-function 'guix-revert-buffer) (setq-local guix-history-size ,history-size-var) - (and (fboundp ',mode-init-fun) (,mode-init-fun))))))))) + (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 diff --git a/emacs/guix-info.el b/emacs/guix-info.el index bf43b40e9e..3cad6624f3 100644 --- a/emacs/guix-info.el +++ b/emacs/guix-info.el @@ -127,7 +127,7 @@ This alist is filled by `guix-info-define-interface' macro.") (defun guix-info-param-title (entry-type param) "Return a title of an ENTRY-TYPE parameter PARAM." - (guix-get-param-title entry-type param)) + (guix-buffer-param-title 'info entry-type param)) (defun guix-info-format (entry-type) "Return 'info' format for ENTRY-TYPE." @@ -486,11 +486,13 @@ After calling each METHOD, a new line is inserted." (native-inputs format (format guix-package-native-input)) (propagated-inputs format (format guix-package-propagated-input))) + :titles '((home-url . "Home page")) :required '(id name version installed non-unique)) (guix-info-define-interface installed-output :format '((path simple (indent guix-file)) (dependencies simple (indent guix-file))) + :titles '((path . "Store directory")) :reduced? t) (defface guix-package-info-heading @@ -794,6 +796,7 @@ This function is used to hide a \"Download\" button if needed." (propagated-inputs format (format guix-package-propagated-input)) (description simple (indent guix-package-info-description))) + :titles guix-package-info-titles :required '(id package-id installed non-unique)) (defun guix-output-info-insert-version (version entry) @@ -827,7 +830,9 @@ This function is used to hide a \"Download\" button if needed." (prev-number format (format)) (current format guix-generation-info-insert-current) (path simple (indent guix-file)) - (time format (time)))) + (time format (time))) + :titles '((path . "File name") + (prev-number . "Previous number"))) (defface guix-generation-info-number '((t :inherit font-lock-keyword-face)) diff --git a/emacs/guix-list.el b/emacs/guix-list.el index 8943e8f589..9aed7dcb82 100644 --- a/emacs/guix-list.el +++ b/emacs/guix-list.el @@ -52,13 +52,6 @@ "Face used for time stamps." :group 'guix-list-faces) -(defvar guix-list-column-titles - '((generation - (number . "N."))) - "Column titles for list buffers. -Has the same structure as `guix-param-titles', but titles from -this list have a priority.") - (defun guix-list-describe (&optional mark-names) "Describe entries marked with a general mark. 'Describe' means display entries in 'info' buffer. @@ -87,9 +80,7 @@ This alist is filled by `guix-list-define-interface' macro.") (defun guix-list-param-title (entry-type param) "Return column title of an ENTRY-TYPE parameter PARAM." - (or (guix-assq-value guix-list-column-titles - entry-type param) - (guix-get-param-title entry-type param))) + (guix-buffer-param-title 'list entry-type param)) (defun guix-list-format (entry-type) "Return column format for ENTRY-TYPE." @@ -816,6 +807,7 @@ See `guix-package-info-type'." (current guix-generation-list-get-current 10 t) (time guix-list-get-time 20 t) (path guix-list-get-file-path 30 t)) + :titles '((number . "N.")) :sort-key '(number . t) :marks '((delete . ?D))) -- cgit v1.2.3 From c8e2666a8a6f0c96f389f8775f1d8dbad38153c1 Mon Sep 17 00:00:00 2001 From: Alex Kost Date: Sat, 21 Nov 2015 12:07:17 +0300 Subject: emacs: Add wrappers for 'history-size' and 'revert-confirm'. * emacs/guix-base.el (guix-buffer-history-size): New procedure. (guix-buffer-define-interface): Use it in the mode definition. (guix-buffer-revert-confirm?): New procedure. (guix-revert-buffer): Use it. --- emacs/guix-base.el | 22 ++++++++++++++++++---- 1 file changed, 18 insertions(+), 4 deletions(-) (limited to 'emacs/guix-base.el') diff --git a/emacs/guix-base.el b/emacs/guix-base.el index f75624c6c9..3aaa2665c0 100644 --- a/emacs/guix-base.el +++ b/emacs/guix-base.el @@ -275,6 +275,14 @@ This alist is filled by `guix-buffer-define-interface' macro.") 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)) + (defvar guix-root-map (let ((map (make-sparse-keymap))) (define-key map (kbd "l") 'guix-history-back) @@ -431,13 +439,20 @@ If non-nil, ask to confirm for reverting `%S' buffer." :type 'boolean :group ',group) + (guix-alist-put! + '((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-revert-buffer) - (setq-local guix-history-size ,history-size-var) + (setq-local guix-history-size + (guix-buffer-history-size + ',buffer-type ',entry-type)) (and (fboundp ',mode-init-fun) (,mode-init-fun))))) (guix-alist-put! @@ -574,9 +589,8 @@ If NO-DISPLAY is non-nil, do not switch to the buffer." The function is suitable for `revert-buffer-function'. See `revert-buffer' for the meaning of NOCONFIRM." (when (or noconfirm - (symbol-value - (guix-get-symbol "revert-no-confirm" - guix-buffer-type guix-entry-type)) + (guix-buffer-revert-confirm? guix-buffer-type + guix-entry-type) (y-or-n-p "Update current information? ")) (let* ((search-type guix-search-type) (search-vals guix-search-vals) -- cgit v1.2.3 From e40b3c33f4750dcbe83012eb4e5b8e786f9f71b1 Mon Sep 17 00:00:00 2001 From: Alex Kost Date: Sat, 21 Nov 2015 12:25:19 +0300 Subject: emacs: Split 'guix-root-map' keymap. * emacs/guix-base.el: (guix-root-map): Split into... (guix-buffer-map): ... this and... * emacs/guix-ui.el (guix-ui-map): ... this. (guix-ui-define-interface): Generate 'guix-ENTRY-TYPE-BUFFER-TYPE-mode-map' keymaps inheriting them from 'guix-ui-map' and 'guix-BUFFER-TYPE-mode-map'. * emacs/guix-info.el (guix-info-mode-map): Use 'guix-buffer-map'. * emacs/guix-list.el (guix-list-mode-map): Likewise. * doc/emacs.texi (Emacs Keymaps): Document new keymaps. --- doc/emacs.texi | 8 ++++++-- emacs/guix-base.el | 6 ++---- emacs/guix-info.el | 4 ++-- emacs/guix-list.el | 2 +- emacs/guix-ui.el | 18 ++++++++++++++++++ 5 files changed, 29 insertions(+), 9 deletions(-) (limited to 'emacs/guix-base.el') diff --git a/doc/emacs.texi b/doc/emacs.texi index 5828bb74d5..15abedb6a1 100644 --- a/doc/emacs.texi +++ b/doc/emacs.texi @@ -439,8 +439,12 @@ If you want to change default key bindings, use the following keymaps (@pxref{Init Rebinding,,, emacs, The GNU Emacs Manual}): @table @code -@item guix-root-map -Parent keymap with general keys for all guix modes. +@item guix-buffer-map +Parent keymap with general keys for any buffer type. + +@item guix-ui-map +Parent keymap with general keys for buffers used for Guix package +management (for packages, outputs and generations). @item guix-list-mode-map Parent keymap with general keys for ``list'' buffers. diff --git a/emacs/guix-base.el b/emacs/guix-base.el index 3aaa2665c0..73c94042ba 100644 --- a/emacs/guix-base.el +++ b/emacs/guix-base.el @@ -283,16 +283,14 @@ This alist is filled by `guix-buffer-define-interface' macro.") "Return 'revert-confirm' value for BUFFER-TYPE/ENTRY-TYPE." (guix-buffer-value buffer-type entry-type 'revert-confirm)) -(defvar guix-root-map +(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-redisplay-buffer) - (define-key map (kbd "M") 'guix-apply-manifest) - (define-key map (kbd "C-c C-z") 'guix-switch-to-repl) map) - "Parent keymap for all guix modes.") + "Parent keymap for Guix buffer modes.") (defvar-local guix-profile nil "Profile used for the current buffer.") diff --git a/emacs/guix-info.el b/emacs/guix-info.el index 3cad6624f3..6e50d34c4d 100644 --- a/emacs/guix-info.el +++ b/emacs/guix-info.el @@ -401,10 +401,10 @@ See `insert-text-button' for the meaning of PROPERTIES." (defvar guix-info-mode-map (let ((map (make-sparse-keymap))) (set-keymap-parent - map (make-composed-keymap (list guix-root-map button-buffer-map) + map (make-composed-keymap (list guix-buffer-map button-buffer-map) special-mode-map)) map) - "Parent keymap for info buffers.") + "Keymap for `guix-info-mode' buffers.") (define-derived-mode guix-info-mode special-mode "Guix-Info" "Parent mode for displaying information in info buffers.") diff --git a/emacs/guix-list.el b/emacs/guix-list.el index 9aed7dcb82..8a9c10f2da 100644 --- a/emacs/guix-list.el +++ b/emacs/guix-list.el @@ -380,7 +380,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 (make-composed-keymap guix-root-map + map (make-composed-keymap guix-buffer-map tabulated-list-mode-map)) (define-key map (kbd "RET") 'guix-list-describe) (define-key map (kbd "i") 'guix-list-describe) diff --git a/emacs/guix-ui.el b/emacs/guix-ui.el index 4f4688250b..25b110c815 100644 --- a/emacs/guix-ui.el +++ b/emacs/guix-ui.el @@ -27,6 +27,13 @@ (require 'cl-lib) (require 'guix-utils) +(defvar guix-ui-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "M") 'guix-apply-manifest) + (define-key map (kbd "C-c C-z") 'guix-switch-to-repl) + map) + "Parent keymap for Guix package/generation buffers.") + (defun guix-ui-list-describe (ids) "Describe 'ui' entries with IDS (list of identifiers)." (apply #'guix-get-show-entries @@ -52,12 +59,23 @@ The rest keyword arguments are passed to (buffer-type-str (symbol-name buffer-type)) (prefix (concat "guix-" entry-type-str "-" buffer-type-str)) + (mode-str (concat prefix "-mode")) + (mode-map (intern (concat mode-str "-map"))) + (parent-map (intern (format "guix-%s-mode-map" + 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 ,mode-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent + map (make-composed-keymap ,parent-map guix-ui-map)) + map) + ,(format "Keymap for `%s' buffers." mode-str)) + (defvar ,required-var ,required-val ,(format "\ List of the required '%s' parameters for '%s' buffer. -- cgit v1.2.3 From 819518d15a4ca6ef4ce0844d89e990ffd46ee3a0 Mon Sep 17 00:00:00 2001 From: Alex Kost Date: Sun, 22 Nov 2015 13:21:18 +0300 Subject: emacs: Generalize buffer redisplaying. * emacs/guix-base.el (guix-buffer-after-redisplay-hook): New variable. (guix-redisplay-buffer): Use it. Remove all arguments and the code for moving point to the next button. Rename to... (guix-buffer-redisplay): ... this. (guix-buffer-redisplay-goto-button): New procedure. * emacs/guix-info.el (guix-package-info-show-source): Use it. Adjust accordingly. (guix-package-info-redisplay-after-download): Likewise. --- emacs/guix-base.el | 64 ++++++++++++++++++++++++++---------------------------- emacs/guix-info.el | 15 ++++++++----- 2 files changed, 40 insertions(+), 39 deletions(-) (limited to 'emacs/guix-base.el') diff --git a/emacs/guix-base.el b/emacs/guix-base.el index 73c94042ba..7592988fec 100644 --- a/emacs/guix-base.el +++ b/emacs/guix-base.el @@ -288,7 +288,7 @@ This alist is filled by `guix-buffer-define-interface' macro.") (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-redisplay-buffer) + (define-key map (kbd "R") 'guix-buffer-redisplay) map) "Parent keymap for Guix buffer modes.") @@ -616,41 +616,39 @@ See `revert-buffer' for the meaning of NOCONFIRM." (guix-set-buffer guix-profile entries guix-buffer-type guix-entry-type search-type search-vals t t)))) -(cl-defun guix-redisplay-buffer (&key buffer profile entries buffer-type - entry-type search-type search-vals) - "Redisplay a Guix BUFFER. -Restore the point and window positions after redisplaying if possible. +(defvar guix-buffer-after-redisplay-hook nil + "Hook run by `guix-buffer-redisplay'. +This hook is called before seting up a window position.") -This function will not update the information, use -\"\\[revert-buffer]\" if you want the full update. +(defun guix-buffer-redisplay () + "Redisplay the current Guix buffer. +Restore the point and window positions after redisplaying. -If BUFFER is nil, use the current buffer. For the meaning of the -rest arguments, see `guix-set-buffer'." +This function does not update the buffer data, use +'\\[revert-buffer]' if you want the full update." (interactive) - (or buffer (setq buffer (current-buffer))) - (with-current-buffer buffer - (or (derived-mode-p 'guix-info-mode 'guix-list-mode) - (error "%S is not a Guix buffer" buffer)) - (let* ((point (point)) - (was-at-button (button-at point)) - ;; For simplicity, ignore an unlikely case when multiple - ;; windows display the same BUFFER. - (window (car (get-buffer-window-list buffer nil t))) - (window-start (and window (window-start window)))) - (guix-set-buffer (or profile guix-profile) - (or entries guix-entries) - (or buffer-type guix-buffer-type) - (or entry-type guix-entry-type) - (or search-type guix-search-type) - (or search-vals guix-search-vals) - t t) - (goto-char point) - (and was-at-button - (not (button-at (point))) - (forward-button 1)) - (when window - (set-window-point window (point)) - (set-window-start window window-start))))) + (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 diff --git a/emacs/guix-info.el b/emacs/guix-info.el index 6e50d34c4d..b52bd73322 100644 --- a/emacs/guix-info.el +++ b/emacs/guix-info.el @@ -714,14 +714,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* ((entry (guix-entry-by-id entry-id guix-entries)) - (file (guix-package-source-path package-id))) + (let* ((entries guix-entries) + (entry (guix-entry-by-id entry-id guix-entries)) + (file (guix-package-source-path package-id))) (or file - (error "Couldn't define file path of the package source")) + (error "Couldn't define file name of the package source")) (let* ((new-entry (cons (cons 'source-file file) entry)) - (entries (guix-replace-entry entry-id new-entry guix-entries))) - (guix-redisplay-buffer :entries entries) + (new-entries (guix-replace-entry entry-id new-entry entries))) + (setq guix-entries new-entries) + (guix-buffer-redisplay-goto-button) (if (file-exists-p file) (if guix-package-info-auto-find-source (guix-find-file file) @@ -770,7 +772,8 @@ SOURCE is a list of URLs." "Redisplay an 'info' buffer after downloading the package source. This function is used to hide a \"Download\" button if needed." (when (buffer-live-p guix-package-info-download-buffer) - (guix-redisplay-buffer :buffer guix-package-info-download-buffer) + (with-current-buffer guix-package-info-download-buffer + (guix-buffer-redisplay-goto-button)) (setq guix-package-info-download-buffer nil))) (add-hook 'guix-after-source-download-hook -- cgit v1.2.3 From 87fe9ecae5bc3ae0681a47e0ec6e6929d910664b Mon Sep 17 00:00:00 2001 From: Alex Kost Date: Sun, 22 Nov 2015 14:37:45 +0300 Subject: emacs: Generalize buffer reverting. This is a partial revert of commit d2b299a91f3be283df1264afe62770ab2783ace9. * emacs/guix-base.el (guix-revert-buffer): Make it more general by removing the code specific to a particular search (a search for packages/outputs by ID). Rename to... (guix-buffer-revert): ... this. --- emacs/guix-base.el | 30 ++++++------------------------ 1 file changed, 6 insertions(+), 24 deletions(-) (limited to 'emacs/guix-base.el') diff --git a/emacs/guix-base.el b/emacs/guix-base.el index 7592988fec..9b90942d09 100644 --- a/emacs/guix-base.el +++ b/emacs/guix-base.el @@ -235,7 +235,7 @@ If MODES is nil, return list of all Guix 'list' and 'info' buffers." (defun guix-update-buffer (buffer) "Update information in a 'list' or 'info' BUFFER." (with-current-buffer buffer - (guix-revert-buffer nil t))) + (guix-buffer-revert nil t))) (defun guix-update-buffers-maybe-after-operation () "Update buffers after Guix operation if needed. @@ -447,7 +447,7 @@ If non-nil, ask to confirm for reverting `%S' buffer." ,(concat "Major mode for displaying information about " entry-str ".\n\n" "\\{" mode-map-str "}") - (setq-local revert-buffer-function 'guix-revert-buffer) + (setq-local revert-buffer-function 'guix-buffer-revert) (setq-local guix-history-size (guix-buffer-history-size ',buffer-type ',entry-type)) @@ -582,7 +582,7 @@ If NO-DISPLAY is non-nil, do not switch to the buffer." buffer-type) entry-type))))) -(defun guix-revert-buffer (_ignore-auto noconfirm) +(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." @@ -590,31 +590,13 @@ See `revert-buffer' for the meaning of NOCONFIRM." (guix-buffer-revert-confirm? guix-buffer-type guix-entry-type) (y-or-n-p "Update current information? ")) - (let* ((search-type guix-search-type) - (search-vals guix-search-vals) - (params (guix-get-params-for-receiving guix-buffer-type + (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)) - ;; If a REPL was restarted, package/output IDs are not actual - ;; anymore, because 'object-address'-es died with the REPL, so if a - ;; search by ID didn't give results, search again by name. - (entries (if (and (null entries) - (eq guix-search-type 'id) - (or (eq guix-entry-type 'package) - (eq guix-entry-type 'output))) - (progn - (setq search-type 'name - search-vals - (guix-package-entries->name-specifications - guix-entries)) - (guix-get-entries - guix-profile guix-entry-type - search-type search-vals params)) - entries))) + guix-search-type guix-search-vals params))) (guix-set-buffer guix-profile entries guix-buffer-type guix-entry-type - search-type search-vals t t)))) + guix-search-type guix-search-vals t t)))) (defvar guix-buffer-after-redisplay-hook nil "Hook run by `guix-buffer-redisplay'. -- cgit v1.2.3 From 8bff0c796e0eea5dd26e5327238cf6def5b55027 Mon Sep 17 00:00:00 2001 From: Alex Kost Date: Mon, 23 Nov 2015 16:41:58 +0300 Subject: emacs: Generalize buffer naming. * emacs/guix-base.el (guix-buffer-name): New procedure. (guix-buffer-define-interface): Make ':buffer-name' a required keyword. (guix-update-after-operation, guix-buffer-name-function) (guix-buffer-name-simple, guix-buffer-name-default, guix-buffer-name) (guix-buffer-p, guix-buffers, guix-update-buffer) (guix-update-buffers-maybe-after-operation): Adjust, move and rename to... * emacs/guix-ui.el (guix-ui-update-after-operation) (guix-ui-buffer-name-function, guix-ui-buffer-name-simple) (guix-ui-buffer-name-default, guix-ui-buffer-name) (guix-ui-buffer?, guix-ui-buffers, guix-ui-update-buffer) (guix-ui-update-buffers-after-operation): ... this. (guix-ui-define-interface): Generate 'guix-ENTRY-TYPE-BUFFER-TYPE-buffer-name' procedure and pass it as ':buffer-name' argument. (guix-ui): New custom group. * emacs/guix-info.el: Specify ':buffer-name' for the defined interfaces. * emacs/guix-list.el: Likewise. * doc/emacs.texi (Emacs Appearance): Adjust accordingly. --- doc/emacs.texi | 5 +- emacs/guix-base.el | 139 +++++++++-------------------------------------------- emacs/guix-info.el | 2 + emacs/guix-list.el | 2 + emacs/guix-ui.el | 120 ++++++++++++++++++++++++++++++++++++++++++++- 5 files changed, 147 insertions(+), 121 deletions(-) (limited to 'emacs/guix-base.el') diff --git a/doc/emacs.texi b/doc/emacs.texi index 15abedb6a1..ff866947c0 100644 --- a/doc/emacs.texi +++ b/doc/emacs.texi @@ -414,7 +414,7 @@ changed with the following variables: By default, the name of a profile is also displayed in a ``list'' or ``info'' buffer name. To change this behavior, use -@code{guix-buffer-name-function} variable. +@code{guix-ui-buffer-name-function} variable. For example, if you want to display all types of results in a single buffer (in such case you will probably use a history (@kbd{l}/@kbd{r}) @@ -428,8 +428,7 @@ extensively), you may do it like this: guix-generation-list-buffer-name name guix-package-info-buffer-name name guix-output-info-buffer-name name - guix-generation-info-buffer-name name - guix-buffer-name-function #'guix-buffer-name-simple)) + guix-generation-info-buffer-name name)) @end example @node Emacs Keymaps diff --git a/emacs/guix-base.el b/emacs/guix-base.el index 9b90942d09..21be02d26d 100644 --- a/emacs/guix-base.el +++ b/emacs/guix-base.el @@ -33,6 +33,7 @@ (require 'guix-entry) (require 'guix-guile) (require 'guix-utils) +(require 'guix-ui) (require 'guix-history) (require 'guix-messages) @@ -142,73 +143,7 @@ For the meaning of location, see `guix-find-location'." #'string<)) -;;; Buffers and auto updating. - -(defcustom guix-update-after-operation 'current - "Define what information to update after executing an operation. - -After successful executing an operation in the Guix REPL (for -example after installing a package), information in Guix buffers -will or will not be automatically updated depending on a value of -this variable. - -If nil, update nothing (do not revert any buffer). -If `current', update the buffer from which an operation was performed. -If `all', update all Guix buffers (not recommended)." - :type '(choice (const :tag "Do nothing" nil) - (const :tag "Update operation buffer" current) - (const :tag "Update all Guix buffers" all)) - :group 'guix) - -(defcustom guix-buffer-name-function #'guix-buffer-name-default - "Function used to define name of a buffer for displaying information. -The function is called with 4 arguments: PROFILE, BUFFER-TYPE, -ENTRY-TYPE, SEARCH-TYPE. See `guix-get-entries' for the meaning -of the arguments." - :type '(choice (function-item guix-buffer-name-default) - (function-item guix-buffer-name-simple) - (function :tag "Other function")) - :group 'guix) - -(defun guix-buffer-name-simple (_profile buffer-type entry-type - &optional _search-type) - "Return name of a buffer used for displaying information. -The name is defined by `guix-ENTRY-TYPE-BUFFER-TYPE-buffer-name' -variable." - (symbol-value - (guix-get-symbol "buffer-name" buffer-type entry-type))) - -(defun guix-buffer-name-default (profile buffer-type entry-type - &optional _search-type) - "Return name of a buffer used for displaying information. -The name is almost the same as the one defined by -`guix-buffer-name-simple' except the PROFILE name is added to it." - (let ((simple-name (guix-buffer-name-simple - profile buffer-type entry-type)) - (profile-name (file-name-base (directory-file-name profile))) - (re (rx string-start - (group (? "*")) - (group (*? any)) - (group (? "*")) - string-end))) - (or (string-match re simple-name) - (error "Unexpected error in defining guix buffer name")) - (let ((first* (match-string 1 simple-name)) - (name-body (match-string 2 simple-name)) - (last* (match-string 3 simple-name))) - ;; Handle the case when buffer name is wrapped by '*'. - (if (and (string= "*" first*) - (string= "*" last*)) - (concat "*" name-body ": " profile-name "*") - (concat simple-name ": " profile-name))))) - -(defun guix-buffer-name (profile buffer-type entry-type search-type) - "Return name of a buffer used for displaying information. -See `guix-buffer-name-function' for details." - (let ((fun (if (functionp guix-buffer-name-function) - guix-buffer-name-function - #'guix-buffer-name-default))) - (funcall fun profile buffer-type entry-type search-type))) +;;; Buffers (defun guix-switch-to-buffer (buffer) "Switch to a 'list' or 'info' BUFFER." @@ -216,43 +151,6 @@ See `guix-buffer-name-function' for details." '((display-buffer-reuse-window display-buffer-same-window)))) -(defun guix-buffer-p (&optional buffer modes) - "Return non-nil if BUFFER mode is derived from any of the MODES. -If BUFFER is nil, check current buffer. -If MODES is nil, use `guix-list-mode' and `guix-info-mode'." - (with-current-buffer (or buffer (current-buffer)) - (apply #'derived-mode-p - (or modes - '(guix-list-mode guix-info-mode))))) - -(defun guix-buffers (&optional modes) - "Return list of all buffers with major modes derived from MODES. -If MODES is nil, return list of all Guix 'list' and 'info' buffers." - (cl-remove-if-not (lambda (buf) - (guix-buffer-p buf modes)) - (buffer-list))) - -(defun guix-update-buffer (buffer) - "Update information in a 'list' or 'info' BUFFER." - (with-current-buffer buffer - (guix-buffer-revert nil t))) - -(defun guix-update-buffers-maybe-after-operation () - "Update buffers after Guix operation if needed. -See `guix-update-after-operation' for details." - (let ((to-update - (and guix-operation-buffer - (cl-case guix-update-after-operation - (current (and (buffer-live-p guix-operation-buffer) - (guix-buffer-p guix-operation-buffer) - (list guix-operation-buffer))) - (all (guix-buffers)))))) - (setq guix-operation-buffer nil) - (mapc #'guix-update-buffer to-update))) - -(add-hook 'guix-after-repl-operation-hook - 'guix-update-buffers-maybe-after-operation) - ;;; Common definitions for buffer types @@ -275,6 +173,14 @@ This alist is filled by `guix-buffer-define-interface' macro.") param)) (guix-symbol-title param))) +(defun guix-buffer-name (buffer-type entry-type profile) + "Return name of BUFFER-TYPE buffer for displaying ENTRY-TYPE entries." + (let ((str-or-fun (guix-buffer-value buffer-type entry-type + 'buffer-name))) + (if (stringp str-or-fun) + str-or-fun + (funcall str-or-fun profile)))) + (defun guix-buffer-history-size (buffer-type entry-type) "Return history size for BUFFER-TYPE/ENTRY-TYPE." (guix-buffer-value buffer-type entry-type 'history-size)) @@ -352,11 +258,13 @@ The following stuff should be defined outside this macro: - `guix-TYPE-mode-initialize' (optional) - function for additional mode settings; it is called without arguments. -Optional keywords: +Required keywords: - `:buffer-name' - default value of the generated `guix-TYPE-buffer-name' variable. +Optional keywords: + - `:titles' - default value of the generated `guix-TYPE-titles' variable. @@ -374,7 +282,6 @@ Optional keywords: (Entry-type-str (capitalize entry-type-str)) (Buffer-type-str (capitalize buffer-type-str)) (entry-str (concat entry-type-str " entries")) - (buffer-str (concat buffer-type-str " buffer")) (prefix (concat "guix-" entry-type-str "-" buffer-type-str)) (group (intern prefix)) @@ -388,9 +295,7 @@ Optional keywords: (history-size-var (intern (concat prefix "-history-size"))) (revert-confirm-var (intern (concat prefix "-revert-confirm")))) (guix-keyword-args-let args - ((buffer-name-val :buffer-name - (format "*Guix %s %s*" - Entry-type-str Buffer-type-str)) + ((buffer-name-val :buffer-name) (titles-val :titles) (history-size-val :history-size 20) (revert-confirm-val :revert-confirm? t) @@ -438,7 +343,8 @@ If non-nil, ask to confirm for reverting `%S' buffer." :group ',group) (guix-alist-put! - '((history-size . ,history-size-var) + '((buffer-name . ,buffer-name-var) + (history-size . ,history-size-var) (revert-confirm . ,revert-confirm-var)) 'guix-buffer-data ',buffer-type ',entry-type) @@ -531,8 +437,7 @@ If NO-DISPLAY is non-nil, do not switch to the buffer." (equal guix-profile profile)) (current-buffer) (get-buffer-create - (guix-buffer-name profile buffer-type - entry-type search-type))))) + (guix-buffer-name buffer-type entry-type profile))))) (with-current-buffer buf (guix-show-entries entries buffer-type entry-type) (guix-set-vars profile entries buffer-type entry-type @@ -1124,12 +1029,12 @@ The function is called with a single argument - a command line string." (defun guix-update-buffers-maybe-after-pull () "Update buffers depending on `guix-update-after-pull'." (when guix-update-after-pull - (mapc #'guix-update-buffer + (mapc #'guix-ui-update-buffer ;; No need to update "generation" buffers. - (guix-buffers '(guix-package-list-mode - guix-package-info-mode - guix-output-list-mode - guix-output-info-mode))) + (guix-ui-buffers '(guix-package-list-mode + guix-package-info-mode + guix-output-list-mode + guix-output-info-mode))) (message "Guix buffers have been updated."))) ;;;###autoload diff --git a/emacs/guix-info.el b/emacs/guix-info.el index 80443f2e40..d71d8f52a3 100644 --- a/emacs/guix-info.el +++ b/emacs/guix-info.el @@ -471,6 +471,7 @@ After calling each METHOD, a new line is inserted." ;;; Displaying packages (guix-ui-info-define-interface package + :buffer-name "*Guix Package Info*" :format '(guix-package-info-insert-heading ignore (synopsis ignore (simple guix-package-info-synopsis)) @@ -830,6 +831,7 @@ This function is used to hide a \"Download\" button if needed." ;;; Displaying generations (guix-ui-info-define-interface generation + :buffer-name "*Guix Generation Info*" :format '((number format guix-generation-info-insert-number) (prev-number format (format)) (current format guix-generation-info-insert-current) diff --git a/emacs/guix-list.el b/emacs/guix-list.el index 8a9c10f2da..42bc0c87f5 100644 --- a/emacs/guix-list.el +++ b/emacs/guix-list.el @@ -517,6 +517,7 @@ See also `guix-list-describe'." ;;; Displaying packages (guix-ui-list-define-interface package + :buffer-name "*Guix Package List*" :format '((name guix-package-list-get-name 20 t) (version nil 10 nil) (outputs nil 13 t) @@ -803,6 +804,7 @@ See `guix-package-info-type'." ;;; Displaying generations (guix-ui-list-define-interface generation + :buffer-name "*Guix Generation List*" :format '((number nil 5 guix-list-sort-numerically-0 :right-align t) (current guix-generation-list-get-current 10 t) (time guix-list-get-time 20 t) diff --git a/emacs/guix-ui.el b/emacs/guix-ui.el index 25b110c815..a92439baf1 100644 --- a/emacs/guix-ui.el +++ b/emacs/guix-ui.el @@ -25,8 +25,15 @@ ;;; Code: (require 'cl-lib) +(require 'guix-backend) (require 'guix-utils) +(defgroup guix-ui nil + "Settings for Guix package management. +This group includes settings for displaying packages, outputs and +generations in 'list' and 'info' buffers." + :group 'guix) + (defvar guix-ui-map (let ((map (make-sparse-keymap))) (define-key map (kbd "M") 'guix-apply-manifest) @@ -39,6 +46,101 @@ (apply #'guix-get-show-entries guix-profile 'info guix-entry-type 'id ids)) + +;;; Buffers and auto updating + +(defcustom guix-ui-update-after-operation 'current + "Define what kind of data to update after executing an operation. + +After successful executing an operation in the Guix REPL (for +example after installing a package), the data in Guix buffers +will or will not be automatically updated depending on a value of +this variable. + +If nil, update nothing (do not revert any buffer). +If `current', update the buffer from which an operation was performed. +If `all', update all Guix buffers (not recommended)." + :type '(choice (const :tag "Do nothing" nil) + (const :tag "Update operation buffer" current) + (const :tag "Update all Guix buffers" all)) + :group 'guix-ui) + +(defcustom guix-ui-buffer-name-function + #'guix-ui-buffer-name-default + "Function used to define a name of a Guix buffer. +The function is called with 2 arguments: BASE-NAME and PROFILE." + :type '(choice (function-item guix-ui-buffer-name-default) + (function-item guix-ui-buffer-name-simple) + (function :tag "Other function")) + :group 'guix-ui) + +(defun guix-ui-buffer-name-simple (base-name &rest _) + "Return BASE-NAME." + base-name) + +;; TODO separate '*...*' logic from the real profile appending. Also add +;; another function to return '*Guix ...: /full/path/to/profile*' name. +(defun guix-ui-buffer-name-default (base-name profile) + "Return buffer name by appending BASE-NAME and PROFILE's base file name." + (let ((profile-name (file-name-base (directory-file-name profile))) + (re (rx string-start + (group (? "*")) + (group (*? any)) + (group (? "*")) + string-end))) + (or (string-match re base-name) + (error "Unexpected error in defining guix buffer name")) + (let ((first* (match-string 1 base-name)) + (name-body (match-string 2 base-name)) + (last* (match-string 3 base-name))) + ;; Handle the case when buffer name is wrapped by '*'. + (if (and (string= "*" first*) + (string= "*" last*)) + (concat "*" name-body ": " profile-name "*") + (concat base-name ": " profile-name))))) + +(defun guix-ui-buffer-name (base-name profile) + "Return Guix buffer name based on BASE-NAME and profile. +See `guix-ui-buffer-name-function' for details." + (funcall guix-ui-buffer-name-function + base-name profile)) + +(defun guix-ui-buffer? (&optional buffer modes) + "Return non-nil if BUFFER mode is derived from any of the MODES. +If BUFFER is nil, check current buffer. +If MODES is nil, use `guix-list-mode' and `guix-info-mode'." + (with-current-buffer (or buffer (current-buffer)) + (apply #'derived-mode-p + (or modes '(guix-list-mode guix-info-mode))))) + +(defun guix-ui-buffers (&optional modes) + "Return a list of all buffers with major modes derived from MODES. +If MODES is nil, return list of all Guix 'list' and 'info' buffers." + (cl-remove-if-not (lambda (buf) + (guix-ui-buffer? buf modes)) + (buffer-list))) + +(defun guix-ui-update-buffer (buffer) + "Update data in a 'list' or 'info' BUFFER." + (with-current-buffer buffer + (guix-buffer-revert nil t))) + +(defun guix-ui-update-buffers-after-operation () + "Update buffers after Guix operation if needed. +See `guix-ui-update-after-operation' for details." + (let ((to-update + (and guix-operation-buffer + (cl-case guix-ui-update-after-operation + (current (and (buffer-live-p guix-operation-buffer) + (guix-ui-buffer? guix-operation-buffer) + (list guix-operation-buffer))) + (all (guix-ui-buffers)))))) + (setq guix-operation-buffer nil) + (mapc #'guix-ui-update-buffer to-update))) + +(add-hook 'guix-after-repl-operation-hook + 'guix-ui-update-buffers-after-operation) + ;;; Interface definers @@ -47,6 +149,12 @@ Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ... In the following description TYPE means ENTRY-TYPE-BUFFER-TYPE. +Required keywords: + + - `:buffer-name' - base part of a buffer name. It is used in a + generated `guix-TYPE-buffer-name' function; see + `guix-ui-buffer-name' for details. + Optional keywords: - `:required' - default value of the generated @@ -64,10 +172,12 @@ The rest keyword arguments are passed to (parent-map (intern (format "guix-%s-mode-map" buffer-type-str))) (required-var (intern (concat prefix "-required-params"))) + (buffer-name-fun (intern (concat prefix "-buffer-name"))) (definer (intern (format "guix-%s-define-interface" buffer-type-str)))) (guix-keyword-args-let args - ((required-val :required ''(id))) + ((buffer-name-val :buffer-name) + (required-val :required ''(id))) `(progn (defvar ,mode-map (let ((map (make-sparse-keymap))) @@ -82,7 +192,15 @@ List of the required '%s' parameters for '%s' buffer. These parameters are received along with the displayed parameters." entry-type-str buffer-type-str)) + (defun ,buffer-name-fun (profile &rest _) + ,(format "\ +Return a name of '%s' buffer for displaying '%s' entries. +See `guix-ui-buffer-name' for details." + buffer-type-str entry-type-str) + (guix-ui-buffer-name ,buffer-name-val profile)) + (,definer ,entry-type + :buffer-name ',buffer-name-fun ,@%foreign-args))))) (defmacro guix-ui-info-define-interface (entry-type &rest args) -- cgit v1.2.3 From 6c40b7b703424f757ff2e1fbb7503a525f9acfd8 Mon Sep 17 00:00:00 2001 From: Alex Kost Date: Wed, 2 Dec 2015 15:24:07 +0300 Subject: emacs: Generalize buffer interface. Extract the code for defining buffer interface from "guix-base.el", generalize it and move to "guix-buffer.el". * emacs.am (ELFILES): Add "emacs/guix-buffer.el". * emacs/guix-base.el (guix-profile, guix-entries, guix-buffer-type) (guix-entry-type, guix-search-type, guix-search-vals, guix-set-vars) (guix-get-symbol, guix-show-entries, guix-get-show-entries) (guix-set-buffer, guix-history-call, guix-make-history-item) (guix-get-params-for-receiving): Remove. (guix-switch-to-buffer): Rename to 'guix-buffer-display' and move to "guix-buffer.el". (guix-get-entries): Rename to 'guix-ui-get-entries' and move to "guix-ui.el". (guix-buffer-data, guix-buffer-value, guix-buffer-param-title) (guix-buffer-name, guix-buffer-history-size) (guix-buffer-revert-confirm?, guix-buffer-map, guix-buffer-revert) (guix-buffer-after-redisplay-hook, guix-buffer-redisplay) (guix-buffer-redisplay-goto-button): Move to... * emacs/guix-buffer.el: ... here. New file. (guix-buffer-item): New variable. (guix-buffer-with-item, guix-buffer-with-current-item) (guix-buffer-define-current-item-accessor) (guix-buffer-define-current-item-accessors) (guix-buffer-define-current-args-accessor) (guix-buffer-define-current-args-accessors): New macros. (guix-buffer-get-entries, guix-buffer-mode-enable) (guix-buffer-mode-initialize, guix-buffer-insert-entries) (guix-buffer-show-entries-default, guix-buffer-show-entries) (guix-buffer-message, guix-buffer-history-item, guix-buffer-set) (guix-buffer-display-entries-current) (guix-buffer-get-display-entries-current) (guix-buffer-display-entries, guix-buffer-get-display-entries): New procedures. * emacs/guix-info.el: Adjust for the procedures renaming. (guix-info-define-interface): Add ':show-entries-function' keyword. * emacs/guix-list.el: Likewise. * emacs/guix-ui.el (guix-ui-define-interface): Generate 'guix-ENTRY-TYPE-BUFFER-TYPE-get-entries' procedure based on 'guix-ui-get-entries'. * emacs/guix.el (guix-get-show-packages, guix-get-show-generations): Adjust for the procedures renaming. --- emacs.am | 1 + emacs/guix-base.el | 396 +---------------------------------- emacs/guix-buffer.el | 566 +++++++++++++++++++++++++++++++++++++++++++++++++++ emacs/guix-info.el | 58 ++++-- emacs/guix-list.el | 103 ++++++---- emacs/guix-ui.el | 80 +++++++- emacs/guix.el | 45 ++-- 7 files changed, 780 insertions(+), 469 deletions(-) create mode 100644 emacs/guix-buffer.el (limited to 'emacs/guix-base.el') diff --git a/emacs.am b/emacs.am index ad7de78657..7848b1c415 100644 --- a/emacs.am +++ b/emacs.am @@ -22,6 +22,7 @@ ELFILES = \ emacs/guix-backend.el \ emacs/guix-base.el \ emacs/guix-build-log.el \ + emacs/guix-buffer.el \ emacs/guix-command.el \ emacs/guix-devel.el \ emacs/guix-emacs.el \ 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 @@ -142,227 +137,6 @@ For the meaning of location, see `guix-find-location'." 'package-names-lists))) #'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 @@ -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 + +;; 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 . + +;;; 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) -- cgit v1.2.3 From b1990426fdec1b0047a115116ac686c6dd4d4884 Mon Sep 17 00:00:00 2001 From: Alex Kost Date: Wed, 9 Dec 2015 14:12:00 +0300 Subject: emacs: Reorganize 'readers' code. * emacs/guix-base.el (guix-graph-type-names, guix-refresh-updater-names) (guix-lint-checker-names, guix-package-names): Move to... * emacs/guix-read.el: ... here. (guix-read-file-name, guix-define-reader, guix-define-readers): Move to... * emacs/guix-utils.el: ... here. --- emacs/guix-base.el | 29 -------------- emacs/guix-read.el | 111 ++++++++++++++++------------------------------------ emacs/guix-utils.el | 83 ++++++++++++++++++++++++++++++++++++++- 3 files changed, 116 insertions(+), 107 deletions(-) (limited to 'emacs/guix-base.el') diff --git a/emacs/guix-base.el b/emacs/guix-base.el index 4bd88992c4..ab8acdfb31 100644 --- a/emacs/guix-base.el +++ b/emacs/guix-base.el @@ -108,35 +108,6 @@ For the meaning of location, see `guix-find-location'." (guix-eval-read (guix-make-guile-expression 'package-location-string id-or-name))) - -;;; Receivable lists of packages, lint checkers, etc. - -(guix-memoized-defun guix-graph-type-names () - "Return a list of names of available graph node types." - (guix-eval-read (guix-make-guile-expression 'graph-type-names))) - -(guix-memoized-defun guix-refresh-updater-names () - "Return a list of names of available refresh updater types." - (guix-eval-read (guix-make-guile-expression 'refresh-updater-names))) - -(guix-memoized-defun guix-lint-checker-names () - "Return a list of names of available lint checkers." - (guix-eval-read (guix-make-guile-expression 'lint-checker-names))) - -(guix-memoized-defun guix-package-names () - "Return a list of names of available packages." - (sort - ;; Work around : - ;; list of strings is parsed much slower than list of lists, - ;; so we use 'package-names-lists' instead of 'package-names'. - - ;; (guix-eval-read (guix-make-guile-expression 'package-names)) - - (mapcar #'car - (guix-eval-read (guix-make-guile-expression - 'package-names-lists))) - #'string<)) - ;;; Getting and displaying info about packages and generations diff --git a/emacs/guix-read.el b/emacs/guix-read.el index 82eccbd678..3bc7b16587 100644 --- a/emacs/guix-read.el +++ b/emacs/guix-read.el @@ -26,83 +26,40 @@ (require 'guix-help-vars) (require 'guix-utils) -(require 'guix-base) - -(defun guix-read-file-name (prompt &optional dir default-filename - mustmatch initial predicate) - "Read file name. -This function is similar to `read-file-name' except it also -expands the file name." - (expand-file-name (read-file-name prompt dir default-filename - mustmatch initial predicate))) - -(defmacro guix-define-reader (name read-fun completions prompt) - "Define NAME function to read from minibuffer. -READ-FUN may be `completing-read', `completing-read-multiple' or -another function with the same arguments." - `(defun ,name (&optional prompt initial-contents) - (,read-fun ,(if prompt - `(or prompt ,prompt) - 'prompt) - ,completions nil nil initial-contents))) - -(defmacro guix-define-readers (&rest args) - "Define reader functions. - -ARGS should have a form [KEYWORD VALUE] ... The following -keywords are available: - - - `completions-var' - variable used to get completions. - - - `completions-getter' - function used to get completions. - - - `single-reader', `single-prompt' - name of a function to read - a single value, and a prompt for it. - - - `multiple-reader', `multiple-prompt' - name of a function to - read multiple values, and a prompt for it. - - - `multiple-separator' - if specified, another - `-string' function returning a string - of multiple values separated the specified separator will be - defined." - (guix-keyword-args-let args - ((completions-var :completions-var) - (completions-getter :completions-getter) - (single-reader :single-reader) - (single-prompt :single-prompt) - (multiple-reader :multiple-reader) - (multiple-prompt :multiple-prompt) - (multiple-separator :multiple-separator)) - (let ((completions - (cond ((and completions-var completions-getter) - `(or ,completions-var - (setq ,completions-var - (funcall ',completions-getter)))) - (completions-var - completions-var) - (completions-getter - `(funcall ',completions-getter))))) - `(progn - ,(when (and completions-var - (not (boundp completions-var))) - `(defvar ,completions-var nil)) - - ,(when single-reader - `(guix-define-reader ,single-reader completing-read - ,completions ,single-prompt)) - - ,(when multiple-reader - `(guix-define-reader ,multiple-reader completing-read-multiple - ,completions ,multiple-prompt)) - - ,(when (and multiple-reader multiple-separator) - (let ((name (intern (concat (symbol-name multiple-reader) - "-string")))) - `(defun ,name (&optional prompt initial-contents) - (guix-concat-strings - (,multiple-reader prompt initial-contents) - ,multiple-separator)))))))) +(require 'guix-backend) +(require 'guix-guile) + + +;;; Receivable lists of packages, lint checkers, etc. + +(guix-memoized-defun guix-graph-type-names () + "Return a list of names of available graph node types." + (guix-eval-read (guix-make-guile-expression 'graph-type-names))) + +(guix-memoized-defun guix-refresh-updater-names () + "Return a list of names of available refresh updater types." + (guix-eval-read (guix-make-guile-expression 'refresh-updater-names))) + +(guix-memoized-defun guix-lint-checker-names () + "Return a list of names of available lint checkers." + (guix-eval-read (guix-make-guile-expression 'lint-checker-names))) + +(guix-memoized-defun guix-package-names () + "Return a list of names of available packages." + (sort + ;; Work around : + ;; list of strings is parsed much slower than list of lists, + ;; so we use 'package-names-lists' instead of 'package-names'. + + ;; (guix-eval-read (guix-make-guile-expression 'package-names)) + + (mapcar #'car + (guix-eval-read (guix-make-guile-expression + 'package-names-lists))) + #'string<)) + + +;;; Readers (guix-define-readers :completions-var guix-help-system-types diff --git a/emacs/guix-utils.el b/emacs/guix-utils.el index 3c75417a08..4f5c69ca4d 100644 --- a/emacs/guix-utils.el +++ b/emacs/guix-utils.el @@ -232,6 +232,14 @@ Return time value." (require 'org) (org-read-date nil t nil prompt)) +(defun guix-read-file-name (prompt &optional dir default-filename + mustmatch initial predicate) + "Read file name. +This function is similar to `read-file-name' except it also +expands the file name." + (expand-file-name (read-file-name prompt dir default-filename + mustmatch initial predicate))) + (defcustom guix-find-file-function #'find-file "Function used to find a file. The function is called by `guix-find-file' with a file name as a @@ -396,6 +404,77 @@ See `guix-alist-put' for details." "Same as `diff', but use `guix-diff-switches' as default." (diff old new (or switches guix-diff-switches) no-async)) + +;;; Completing readers definers + +(defmacro guix-define-reader (name read-fun completions prompt) + "Define NAME function to read from minibuffer. +READ-FUN may be `completing-read', `completing-read-multiple' or +another function with the same arguments." + `(defun ,name (&optional prompt initial-contents) + (,read-fun ,(if prompt + `(or prompt ,prompt) + 'prompt) + ,completions nil nil initial-contents))) + +(defmacro guix-define-readers (&rest args) + "Define reader functions. + +ARGS should have a form [KEYWORD VALUE] ... The following +keywords are available: + + - `completions-var' - variable used to get completions. + + - `completions-getter' - function used to get completions. + + - `single-reader', `single-prompt' - name of a function to read + a single value, and a prompt for it. + + - `multiple-reader', `multiple-prompt' - name of a function to + read multiple values, and a prompt for it. + + - `multiple-separator' - if specified, another + `-string' function returning a string + of multiple values separated the specified separator will be + defined." + (guix-keyword-args-let args + ((completions-var :completions-var) + (completions-getter :completions-getter) + (single-reader :single-reader) + (single-prompt :single-prompt) + (multiple-reader :multiple-reader) + (multiple-prompt :multiple-prompt) + (multiple-separator :multiple-separator)) + (let ((completions + (cond ((and completions-var completions-getter) + `(or ,completions-var + (setq ,completions-var + (funcall ',completions-getter)))) + (completions-var + completions-var) + (completions-getter + `(funcall ',completions-getter))))) + `(progn + ,(when (and completions-var + (not (boundp completions-var))) + `(defvar ,completions-var nil)) + + ,(when single-reader + `(guix-define-reader ,single-reader completing-read + ,completions ,single-prompt)) + + ,(when multiple-reader + `(guix-define-reader ,multiple-reader completing-read-multiple + ,completions ,multiple-prompt)) + + ,(when (and multiple-reader multiple-separator) + (let ((name (intern (concat (symbol-name multiple-reader) + "-string")))) + `(defun ,name (&optional prompt initial-contents) + (guix-concat-strings + (,multiple-reader prompt initial-contents) + ,multiple-separator)))))))) + ;;; Memoizing @@ -436,7 +515,9 @@ See `defun' for the meaning of arguments." (defvar guix-utils-font-lock-keywords (eval-when-compile - `((,(rx "(" (group (or "guix-keyword-args-let" + `((,(rx "(" (group (or "guix-define-reader" + "guix-define-readers" + "guix-keyword-args-let" "guix-with-indent")) symbol-end) . 1) -- cgit v1.2.3 From c80ce104bed39157347078020cbc45c65ff9b893 Mon Sep 17 00:00:00 2001 From: Alex Kost Date: Wed, 9 Dec 2015 14:44:34 +0300 Subject: emacs: Reorganize package/generation UI code. Move the code for packages/generations interface from "guix-info.el", "guix-list.el", "guix-base.el" and "guix.el" to "guix-ui-package.el" and "guix-ui-generation.el". * emacs/guix-base.el (guix-package-entry->name-specification) (guix-package-entries->name-specifications) (guix-package-id-and-output-by-output-id) (guix-package-installed-outputs, guix-process-package-actions) (guix-package-list-type, guix-package-info-type) (guix-continue-package-operation-p, guix-get-package-strings) (guix-insert-package-strings): Move to "guix-ui-package.el". (guix-generation-packages-buffer-name-function, guix-output-name-width) (guix-generation-packages-update-buffer, guix-generation-packages) (guix-generation-packages-buffer-name-default) (guix-generation-packages-buffer-name-long) (guix-generation-packages-buffer-name, guix-generation-packages-buffer) (guix-generation-insert-packages, guix-generation-insert-package) (guix-profile-generation-manifest-file, guix-delete-generations) (guix-profile-generation-packages-buffer, guix-switch-to-generation): Move to "guix-ui-generation.el". * emacs/guix-info.el (guix-package-location, guix-package-name) (guix-package-source, guix-package-info-source) (guix-package-info-heading, guix-package-info-license) (guix-package-info-name, guix-package-info-name-button) (guix-package-info-version, guix-package-info-location) (guix-package-info-synopsis, guix-package-info-description) (guix-package-info-obsolete, guix-package-info-installed-outputs) (guix-package-info-uninstalled-outputs) (guix-package-info-insert-heading) (guix-package-info-define-insert-inputs) (guix-package-info-obsolete-string) (guix-package-info-insert-obsolete-text) (guix-package-info-insert-non-unique-text) (guix-package-info-insert-outputs, guix-package-info-insert-output) (guix-package-info-insert-action-button) (guix-package-info-auto-find-source) (guix-package-info-auto-download-source) (guix-package-info-download-buffer, guix-package-info-show-source) (guix-package-info-download-source, guix-package-info-insert-source) (guix-package-info-redisplay-after-download) (guix-output-info-insert-version, guix-output-info-insert-output): Move to "guix-ui-package.el". (guix-generation-info-number, guix-generation-info-current) (guix-generation-not-current, guix-generation-info-insert-number) (guix-generation-info-insert-current): Move to "guix-ui-generation.el". * emacs/guix-list.el (guix-package-list-generation-marking-enabled) (guix-package-list-installed, guix-package-list-obsolete) (guix-package-list-get-name, guix-package-list-get-installed-outputs) (guix-package-list-marking-check, guix-package-list-mark-outputs) (guix-package-list-mark-install, guix-package-list-mark-delete) (guix-package-list-mark-upgrade, guix-package-list-mark-upgrades) (guix-list-mark-package-upgrades, guix-list-execute-package-actions) (guix-package-list-execute, guix-package-list-make-action) (guix-package-list-edit, guix-output-list-mark-install) (guix-output-list-mark-delete, guix-output-list-mark-upgrade) (guix-output-list-mark-upgrades, guix-output-list-make-action) (guix-output-list-describe, guix-output-list-edit): Move to "guix-ui-package.el". (guix-generation-list-get-current, guix-generation-list-switch) (guix-generation-list-generations-to-compare) (guix-generation-list-compare, guix-generation-list-show-packages) (guix-generation-list-show-added-packages) (guix-generation-list-show-removed-packages) (guix-generation-list-diff, guix-generation-list-diff-manifests) (guix-generation-list-ediff, guix-generation-list-ediff-manifests) (guix-generation-list-diff-packages) (guix-generation-list-ediff-packages) (guix-generation-list-mark-delete, guix-generation-list-execute): Move to "guix-ui-generation.el". * emacs/guix.el: Remove. (guix, guix-faces, guix-edit): Move to "guix-base.el". (guix-list-single-package, guix-search-params, guix-search-history) (guix-get-show-packages, guix-search-by-name, guix-search-by-regexp) (guix-installed-packages, guix-obsolete-packages) (guix-all-available-packages, guix-newest-available-packages): Move to "guix-ui-package.el". (guix-get-show-generations, guix-generations, guix-last-generations) (guix-generations-by-time): Move to "guix-ui-generation.el". * emacs.am (ELFILES): Remove "guix.el". Add "guix-ui-package.el" and "guix-ui-generation.el". * doc/emacs.texi (Emacs Appearance): Adjust accordingly. --- doc/emacs.texi | 2 +- emacs.am | 5 +- emacs/guix-base.el | 293 +------------- emacs/guix-info.el | 455 +-------------------- emacs/guix-list.el | 449 +-------------------- emacs/guix-ui-generation.el | 439 ++++++++++++++++++++ emacs/guix-ui-package.el | 958 ++++++++++++++++++++++++++++++++++++++++++++ emacs/guix.el | 210 ---------- 8 files changed, 1428 insertions(+), 1383 deletions(-) create mode 100644 emacs/guix-ui-generation.el create mode 100644 emacs/guix-ui-package.el delete mode 100644 emacs/guix.el (limited to 'emacs/guix-base.el') diff --git a/doc/emacs.texi b/doc/emacs.texi index ff866947c0..6b989a976d 100644 --- a/doc/emacs.texi +++ b/doc/emacs.texi @@ -160,7 +160,7 @@ Display package(s) with the specified name. @item M-x guix-search-by-regexp Search for packages by a specified regexp. By default ``name'', ``synopsis'' and ``description'' of the packages will be searched. This -can be changed by modifying @code{guix-search-params} variable. +can be changed by modifying @code{guix-package-search-params} variable. @end table diff --git a/emacs.am b/emacs.am index 7848b1c415..bfd9494b0a 100644 --- a/emacs.am +++ b/emacs.am @@ -42,8 +42,9 @@ ELFILES = \ emacs/guix-profiles.el \ emacs/guix-read.el \ emacs/guix-ui.el \ - emacs/guix-utils.el \ - emacs/guix.el + emacs/guix-ui-package.el \ + emacs/guix-ui-generation.el \ + emacs/guix-utils.el if HAVE_EMACS diff --git a/emacs/guix-base.el b/emacs/guix-base.el index ab8acdfb31..dae658ebfa 100644 --- a/emacs/guix-base.el +++ b/emacs/guix-base.el @@ -25,50 +25,29 @@ ;;; Code: (require 'cl-lib) -(require 'guix-profiles) (require 'guix-backend) -(require 'guix-entry) (require 'guix-guile) +(require 'guix-read) (require 'guix-utils) (require 'guix-ui) - -;;; Parameters of the entries +(defgroup guix nil + "Settings for Guix package manager and friends." + :prefix "guix-" + :group 'external) + +(defgroup guix-faces nil + "Guix faces." + :group 'guix + :group 'faces) (defun guix-package-name-specification (name version &optional output) "Return Guix package specification by its NAME, VERSION and OUTPUT." (concat name "-" version (when output (concat ":" output)))) -(defun guix-package-entry->name-specification (entry &optional output) - "Return name specification of the package ENTRY and OUTPUT." - (guix-package-name-specification - (guix-entry-value entry 'name) - (guix-entry-value entry 'version) - (or output (guix-entry-value entry 'output)))) - -(defun guix-package-entries->name-specifications (entries) - "Return name specifications by the package or output ENTRIES." - (cl-remove-duplicates (mapcar #'guix-package-entry->name-specification - entries) - :test #'string=)) - -(defun guix-package-installed-outputs (entry) - "Return list of installed outputs for the package ENTRY." - (mapcar (lambda (installed-entry) - (guix-entry-value installed-entry 'output)) - (guix-entry-value entry 'installed))) - -(defun guix-package-id-and-output-by-output-id (oid) - "Return list (PACKAGE-ID OUTPUT) by output id OID." - (cl-multiple-value-bind (pid-str output) - (split-string oid ":") - (let ((pid (string-to-number pid-str))) - (list (if (= 0 pid) pid-str pid) - output)))) - -;;; Location of the packages +;;; Location of packages, profiles and manifests (defvar guix-directory nil "Default Guix directory. @@ -108,56 +87,6 @@ For the meaning of location, see `guix-find-location'." (guix-eval-read (guix-make-guile-expression 'package-location-string id-or-name))) - -;;; Getting and displaying info about packages and generations - -(defcustom guix-package-list-type 'output - "Define how to display packages in a list buffer. -May be a symbol `package' or `output' (if `output', display each -output on a separate line; if `package', display each package on -a separate line)." - :type '(choice (const :tag "List of packages" package) - (const :tag "List of outputs" output)) - :group 'guix) - -(defcustom guix-package-info-type 'package - "Define how to display packages in an info buffer. -May be a symbol `package' or `output' (if `output', display each -output separately; if `package', display outputs inside a package -information)." - :type '(choice (const :tag "Display packages" package) - (const :tag "Display outputs" output)) - :group 'guix) - - -;;; Generations - -(defcustom guix-generation-packages-buffer-name-function - #'guix-generation-packages-buffer-name-default - "Function used to define name of a buffer with generation packages. -This function is called with 2 arguments: PROFILE (string) and -GENERATION (number)." - :type '(choice (function-item guix-generation-packages-buffer-name-default) - (function-item guix-generation-packages-buffer-name-long) - (function :tag "Other function")) - :group 'guix) - -(defcustom guix-generation-packages-update-buffer t - "If non-nil, always update list of packages during comparing generations. -If nil, generation packages are received only once. So when you -compare generation 1 and generation 2, the packages for both -generations will be received. Then if you compare generation 1 -and generation 3, only the packages for generation 3 will be -received. Thus if you use comparing of different generations a -lot, you may set this variable to nil to improve the -performance." - :type 'boolean - :group 'guix) - -(defvar guix-output-name-width 30 - "Width of an output name \"column\". -This variable is used in auxiliary buffers for comparing generations.") - (defun guix-generation-file (profile generation) "Return the file name of a PROFILE's GENERATION." (format "%s-%s-link" profile generation)) @@ -171,75 +100,14 @@ this generation." (guix-generation-file profile generation) profile))) -(defun guix-generation-packages (profile generation) - "Return a list of sorted packages installed in PROFILE's GENERATION. -Each element of the list is a list of the package specification and its path." - (let ((names+paths (guix-eval-read - (guix-make-guile-expression - 'generation-package-specifications+paths - profile generation)))) - (sort names+paths - (lambda (a b) - (string< (car a) (car b)))))) - -(defun guix-generation-packages-buffer-name-default (profile generation) - "Return name of a buffer for displaying GENERATION's package outputs. -Use base name of PROFILE path." - (let ((profile-name (file-name-base (directory-file-name profile)))) - (format "*Guix %s: generation %s*" - profile-name generation))) - -(defun guix-generation-packages-buffer-name-long (profile generation) - "Return name of a buffer for displaying GENERATION's package outputs. -Use the full PROFILE path." - (format "*Guix generation %s (%s)*" - generation profile)) - -(defun guix-generation-packages-buffer-name (profile generation) - "Return name of a buffer for displaying GENERATION's package outputs." - (let ((fun (if (functionp guix-generation-packages-buffer-name-function) - guix-generation-packages-buffer-name-function - #'guix-generation-packages-buffer-name-default))) - (funcall fun profile generation))) - -(defun guix-generation-insert-package (name path) - "Insert package output NAME and PATH at point." - (insert name) - (indent-to guix-output-name-width 2) - (insert path "\n")) - -(defun guix-generation-insert-packages (buffer profile generation) - "Insert package outputs installed in PROFILE's GENERATION in BUFFER." - (with-current-buffer buffer - (setq buffer-read-only nil - indent-tabs-mode nil) - (erase-buffer) - (mapc (lambda (name+path) - (guix-generation-insert-package - (car name+path) (cadr name+path))) - (guix-generation-packages profile generation)))) - -(defun guix-generation-packages-buffer (profile generation) - "Return buffer with package outputs installed in PROFILE's GENERATION. -Create the buffer if needed." - (let ((buf-name (guix-generation-packages-buffer-name - profile generation))) - (or (and (null guix-generation-packages-update-buffer) - (get-buffer buf-name)) - (let ((buf (get-buffer-create buf-name))) - (guix-generation-insert-packages buf profile generation) - buf)))) - -(defun guix-profile-generation-manifest-file (generation) - "Return the file name of a GENERATION's manifest. -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 the current profile." - (guix-generation-packages-buffer (guix-ui-current-profile) - generation)) +;;;###autoload +(defun guix-edit (id-or-name) + "Edit (go to location of) package with ID-OR-NAME." + (interactive (list (guix-read-package-name))) + (let ((loc (guix-package-location id-or-name))) + (if loc + (guix-find-location loc) + (message "Couldn't find package location.")))) ;;; Actions on packages and generations @@ -313,101 +181,6 @@ VARIABLE is a name of an option variable.") guix-operation-option-true-string guix-operation-option-false-string)) -(defun guix-process-package-actions (profile actions - &optional operation-buffer) - "Process package ACTIONS on PROFILE. -Each action is a list of the form: - - (ACTION-TYPE PACKAGE-SPEC ...) - -ACTION-TYPE is one of the following symbols: `install', -`upgrade', `remove'/`delete'. -PACKAGE-SPEC should have the following form: (ID [OUTPUT] ...)." - (let (install upgrade remove) - (mapc (lambda (action) - (let ((action-type (car action)) - (specs (cdr action))) - (cl-case action-type - (install (setq install (append install specs))) - (upgrade (setq upgrade (append upgrade specs))) - ((remove delete) (setq remove (append remove specs)))))) - actions) - (when (guix-continue-package-operation-p - profile - :install install :upgrade upgrade :remove remove) - (guix-eval-in-repl - (guix-make-guile-expression - 'process-package-actions profile - :install install :upgrade upgrade :remove remove - :use-substitutes? (or guix-use-substitutes 'f) - :dry-run? (or guix-dry-run 'f)) - (and (not guix-dry-run) operation-buffer))))) - -(cl-defun guix-continue-package-operation-p (profile - &key install upgrade remove) - "Return non-nil if a package operation should be continued. -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-ui-get-entries - profile 'package 'id - (append (mapcar #'car install) - (mapcar #'car upgrade) - (mapcar #'car remove)) - '(id name version location))) - (install-strings (guix-get-package-strings install entries)) - (upgrade-strings (guix-get-package-strings upgrade entries)) - (remove-strings (guix-get-package-strings remove entries))) - (if (or install-strings upgrade-strings remove-strings) - (let ((buf (get-buffer-create guix-temp-buffer-name))) - (with-current-buffer buf - (setq-local cursor-type nil) - (setq buffer-read-only nil) - (erase-buffer) - (insert "Profile: " profile "\n\n") - (guix-insert-package-strings install-strings "install") - (guix-insert-package-strings upgrade-strings "upgrade") - (guix-insert-package-strings remove-strings "remove") - (let ((win (temp-buffer-window-show - buf - '((display-buffer-reuse-window - display-buffer-at-bottom) - (window-height . fit-window-to-buffer))))) - (prog1 (guix-operation-prompt) - (quit-window nil win))))) - (message "Nothing to be done. If the REPL was restarted, information is not up-to-date.") - nil)))) - -(defun guix-get-package-strings (specs entries) - "Return short package descriptions for performing package actions. -See `guix-process-package-actions' for the meaning of SPECS. -ENTRIES is a list of package entries to get info about packages." - (delq nil - (mapcar - (lambda (spec) - (let* ((id (car spec)) - (outputs (cdr spec)) - (entry (guix-entry-by-id id entries))) - (when entry - (let ((location (guix-entry-value entry 'location))) - (concat (guix-package-entry->name-specification entry) - (when outputs - (concat ":" - (guix-concat-strings outputs ","))) - (when location - (concat "\t(" location ")"))))))) - specs))) - -(defun guix-insert-package-strings (strings action) - "Insert information STRINGS at point for performing package ACTION." - (when strings - (insert "Package(s) to " (propertize action 'face 'bold) ":\n") - (mapc (lambda (str) - (insert " " str "\n")) - strings) - (insert "\n"))) - (defun guix-operation-prompt (&optional prompt) "Prompt a user for continuing the current operation. Return non-nil, if the operation should be continued; nil otherwise. @@ -462,34 +235,6 @@ Ask a user with PROMPT for continuing an operation." guix-operation-option-separator))) (force-mode-line-update)) -(defun guix-delete-generations (profile generations - &optional operation-buffer) - "Delete GENERATIONS from PROFILE. -Each element from GENERATIONS is a generation number." - (when (or (not guix-operation-confirm) - (y-or-n-p - (let ((count (length generations))) - (if (> count 1) - (format "Delete %d generations from profile '%s'? " - count profile) - (format "Delete generation %d from profile '%s'? " - (car generations) profile))))) - (guix-eval-in-repl - (guix-make-guile-expression - 'delete-generations* profile generations) - operation-buffer))) - -(defun guix-switch-to-generation (profile generation - &optional operation-buffer) - "Switch PROFILE to GENERATION." - (when (or (not guix-operation-confirm) - (y-or-n-p (format "Switch profile '%s' to generation %d? " - profile generation))) - (guix-eval-in-repl - (guix-make-guile-expression - 'switch-to-generation* profile generation) - operation-buffer))) - (defun guix-package-source-path (package-id) "Return a store file path to a source of a package PACKAGE-ID." (message "Calculating the source derivation ...") diff --git a/emacs/guix-info.el b/emacs/guix-info.el index 9c63892d06..5219ac5507 100644 --- a/emacs/guix-info.el +++ b/emacs/guix-info.el @@ -1,4 +1,4 @@ -;;; guix-info.el --- Info buffers for displaying entries -*- lexical-binding: t -*- +;;; guix-info.el --- 'Info' buffer interface for displaying data -*- lexical-binding: t -*- ;; Copyright © 2014, 2015 Alex Kost ;; Copyright © 2015 Ludovic Courtès @@ -20,15 +20,14 @@ ;;; Commentary: -;; This file provides a help-like buffer for displaying information -;; about Guix packages and generations. +;; This file provides 'info' (help-like) buffer interface for displaying +;; an arbitrary data. ;;; Code: -(require 'guix-base) +(require 'guix-buffer) (require 'guix-entry) (require 'guix-utils) -(require 'guix-ui) (defgroup guix-info nil "General settings for info buffers." @@ -358,24 +357,6 @@ BUTTON-OR-FACE is a button type)." 'action (lambda (btn) (browse-url (button-label btn)))) -(define-button-type 'guix-package-location - :supertype 'guix - 'face 'guix-package-info-location - 'help-echo "Find location of this package" - 'action (lambda (btn) - (guix-find-location (button-label btn)))) - -(define-button-type 'guix-package-name - :supertype 'guix - 'face 'guix-package-info-name-button - 'help-echo "Describe this package" - 'action (lambda (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. If POS is nil, use the current point position." @@ -495,434 +476,6 @@ Print '%s' ENTRIES in the current 'info' buffer." :mode-init-function 'guix-info-mode-initialize ,@%foreign-args)))))))) - -;;; Displaying packages - -(guix-ui-info-define-interface package - :buffer-name "*Guix Package Info*" - :format '(guix-package-info-insert-heading - ignore - (synopsis ignore (simple guix-package-info-synopsis)) - ignore - (description ignore (simple guix-package-info-description)) - ignore - (outputs simple guix-package-info-insert-outputs) - (source simple guix-package-info-insert-source) - (location format (format guix-package-location)) - (home-url format (format guix-url)) - (license format (format guix-package-info-license)) - (inputs format (format guix-package-input)) - (native-inputs format (format guix-package-native-input)) - (propagated-inputs format - (format guix-package-propagated-input))) - :titles '((home-url . "Home page")) - :required '(id name version installed non-unique)) - -(guix-info-define-interface installed-output - :format '((path simple (indent guix-file)) - (dependencies simple (indent guix-file))) - :titles '((path . "Store directory")) - :reduced? t) - -(defface guix-package-info-heading - '((t :inherit guix-info-heading)) - "Face for package name and version headings." - :group 'guix-package-info-faces) - -(defface guix-package-info-name - '((t :inherit font-lock-keyword-face)) - "Face used for a name of a package." - :group 'guix-package-info-faces) - -(defface guix-package-info-name-button - '((t :inherit button)) - "Face used for a full name that can be used to describe a package." - :group 'guix-package-info-faces) - -(defface guix-package-info-version - '((t :inherit font-lock-builtin-face)) - "Face used for a version of a package." - :group 'guix-package-info-faces) - -(defface guix-package-info-synopsis - '((((type tty pc) (class color)) :weight bold) - (t :height 1.1 :weight bold :inherit variable-pitch)) - "Face used for a synopsis of a package." - :group 'guix-package-info-faces) - -(defface guix-package-info-description - '((t)) - "Face used for a description of a package." - :group 'guix-package-info-faces) - -(defface guix-package-info-license - '((t :inherit font-lock-string-face)) - "Face used for a license of a package." - :group 'guix-package-info-faces) - -(defface guix-package-info-location - '((t :inherit link)) - "Face used for a location of a package." - :group 'guix-package-info-faces) - -(defface guix-package-info-installed-outputs - '((default :weight bold) - (((class color) (min-colors 88) (background light)) - :foreground "ForestGreen") - (((class color) (min-colors 88) (background dark)) - :foreground "PaleGreen") - (((class color) (min-colors 8)) - :foreground "green") - (t :underline t)) - "Face used for installed outputs of a package." - :group 'guix-package-info-faces) - -(defface guix-package-info-uninstalled-outputs - '((t :weight bold)) - "Face used for uninstalled outputs of a package." - :group 'guix-package-info-faces) - -(defface guix-package-info-obsolete - '((t :inherit error)) - "Face used if a package is obsolete." - :group 'guix-package-info-faces) - -(defun guix-package-info-insert-heading (entry) - "Insert package ENTRY heading (name specification) at point." - (guix-insert-button - (guix-package-entry->name-specification entry) - 'guix-package-name - 'face 'guix-package-info-heading)) - -(defmacro guix-package-info-define-insert-inputs (&optional type) - "Define a face and a function for inserting package inputs. -TYPE is a type of inputs. -Function name is `guix-package-info-insert-TYPE-inputs'. -Face name is `guix-package-info-TYPE-inputs'." - (let* ((type-str (symbol-name type)) - (type-name (and type (concat type-str "-"))) - (type-desc (and type (concat type-str " "))) - (face (intern (concat "guix-package-info-" type-name "inputs"))) - (btn (intern (concat "guix-package-" type-name "input")))) - `(progn - (defface ,face - '((t :inherit guix-package-info-name-button)) - ,(concat "Face used for " type-desc "inputs of a package.") - :group 'guix-package-info-faces) - - (define-button-type ',btn - :supertype 'guix-package-name - 'face ',face)))) - -(guix-package-info-define-insert-inputs) -(guix-package-info-define-insert-inputs native) -(guix-package-info-define-insert-inputs propagated) - - -;;; Inserting outputs and installed parameters - -(defvar guix-package-info-output-format "%-10s" - "String used to format output names of the packages. -It should be a '%s'-sequence. After inserting an output name -formatted with this string, an action button is inserted.") - -(defvar guix-package-info-obsolete-string "(This package is obsolete)" - "String used if a package is obsolete.") - -(defun guix-package-info-insert-outputs (outputs entry) - "Insert OUTPUTS from package ENTRY at point." - (and (guix-entry-value entry 'obsolete) - (guix-package-info-insert-obsolete-text)) - (and (guix-entry-value entry 'non-unique) - (guix-entry-value entry 'installed) - (guix-package-info-insert-non-unique-text - (guix-package-entry->name-specification entry))) - (insert "\n") - (mapc (lambda (output) - (guix-package-info-insert-output output entry)) - outputs)) - -(defun guix-package-info-insert-obsolete-text () - "Insert a message about obsolete package at point." - (guix-info-insert-indent) - (guix-format-insert guix-package-info-obsolete-string - 'guix-package-info-obsolete)) - -(defun guix-package-info-insert-non-unique-text (full-name) - "Insert a message about non-unique package with FULL-NAME at point." - (insert "\n") - (guix-info-insert-indent) - (insert "Installed outputs are displayed for a non-unique ") - (guix-insert-button full-name 'guix-package-name) - (insert " package.")) - -(defun guix-package-info-insert-output (output entry) - "Insert OUTPUT at point. -Make some fancy text with buttons and additional stuff if the -current OUTPUT is installed (if there is such output in -`installed' parameter of a package ENTRY)." - (let* ((installed (guix-entry-value entry 'installed)) - (obsolete (guix-entry-value entry 'obsolete)) - (installed-entry (cl-find-if - (lambda (entry) - (string= (guix-entry-value entry 'output) - output)) - installed)) - (action-type (if installed-entry 'delete 'install))) - (guix-info-insert-indent) - (guix-format-insert output - (if installed-entry - 'guix-package-info-installed-outputs - 'guix-package-info-uninstalled-outputs) - guix-package-info-output-format) - (guix-package-info-insert-action-button action-type entry output) - (when obsolete - (guix-info-insert-indent) - (guix-package-info-insert-action-button 'upgrade entry output)) - (insert "\n") - (when installed-entry - (guix-info-insert-entry installed-entry 'installed-output 2)))) - -(defun guix-package-info-insert-action-button (type entry output) - "Insert button to process an action on a package OUTPUT at point. -TYPE is one of the following symbols: `install', `delete', `upgrade'. -ENTRY is an alist with package info." - (let ((type-str (capitalize (symbol-name type))) - (full-name (guix-package-entry->name-specification entry output))) - (guix-info-insert-action-button - type-str - (lambda (btn) - (guix-process-package-actions - (guix-ui-current-profile) - `((,(button-get btn 'action-type) (,(button-get btn 'id) - ,(button-get btn 'output)))) - (current-buffer))) - (concat type-str " '" full-name "'") - 'action-type type - 'id (or (guix-entry-value entry 'package-id) - (guix-entry-id entry)) - 'output output))) - - -;;; Inserting a source - -(defface guix-package-info-source - '((t :inherit link :underline nil)) - "Face used for a source URL of a package." - :group 'guix-package-info-faces) - -(defcustom guix-package-info-auto-find-source nil - "If non-nil, find a source file after pressing a \"Show\" button. -If nil, just display the source file path without finding." - :type 'boolean - :group 'guix-package-info) - -(defcustom guix-package-info-auto-download-source t - "If nil, do not automatically download a source file if it doesn't exist. -After pressing a \"Show\" button, a derivation of the package -source is calculated and a store file path is displayed. If this -variable is non-nil and the source file does not exist in the -store, it will be automatically downloaded (with a possible -prompt depending on `guix-operation-confirm' variable)." - :type 'boolean - :group 'guix-package-info) - -(defvar guix-package-info-download-buffer nil - "Buffer from which a current download operation was performed.") - -(define-button-type 'guix-package-source - :supertype 'guix - 'face 'guix-package-info-source - 'help-echo "" - 'action (lambda (_) - ;; As a source may not be a real URL (e.g., "mirror://..."), - ;; no action is bound to a source button. - (message "Yes, this is the source URL. What did you expect?"))) - -(defun guix-package-info-show-source (entry-id package-id) - "Show file name of a package source in the current info buffer. -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-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))) - (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 - (guix-find-file file) - (message "The source store path is displayed.")) - (if guix-package-info-auto-download-source - (guix-package-info-download-source package-id) - (message "The source does not exist in the store.")))))) - -(defun guix-package-info-download-source (package-id) - "Download a source of the package PACKAGE-ID." - (setq guix-package-info-download-buffer (current-buffer)) - (guix-package-source-build-derivation - package-id - "The source does not exist in the store. Download it?")) - -(defun guix-package-info-insert-source (source entry) - "Insert SOURCE from package ENTRY at point. -SOURCE is a list of URLs." - (if (null source) - (guix-format-insert nil) - (let* ((source-file (guix-entry-value entry 'source-file)) - (entry-id (guix-entry-id entry)) - (package-id (or (guix-entry-value entry 'package-id) - entry-id))) - (if (null source-file) - (guix-info-insert-action-button - "Show" - (lambda (btn) - (guix-package-info-show-source (button-get btn 'entry-id) - (button-get btn 'package-id))) - "Show the source store directory of the current package" - 'entry-id entry-id - 'package-id package-id) - (unless (file-exists-p source-file) - (guix-info-insert-action-button - "Download" - (lambda (btn) - (guix-package-info-download-source - (button-get btn 'package-id))) - "Download the source into the store" - 'package-id package-id)) - (guix-info-insert-value-indent source-file 'guix-file)) - (guix-info-insert-value-indent source 'guix-package-source)))) - -(defun guix-package-info-redisplay-after-download () - "Redisplay an 'info' buffer after downloading the package source. -This function is used to hide a \"Download\" button if needed." - (when (buffer-live-p guix-package-info-download-buffer) - (with-current-buffer guix-package-info-download-buffer - (guix-buffer-redisplay-goto-button)) - (setq guix-package-info-download-buffer nil))) - -(add-hook 'guix-after-source-download-hook - 'guix-package-info-redisplay-after-download) - - -;;; Displaying outputs - -(guix-ui-info-define-interface output - :buffer-name "*Guix Package Info*" - :format '((name format (format guix-package-info-name)) - (version format guix-output-info-insert-version) - (output format guix-output-info-insert-output) - (synopsis simple (indent guix-package-info-synopsis)) - (source simple guix-package-info-insert-source) - (path simple (indent guix-file)) - (dependencies simple (indent guix-file)) - (location format (format guix-package-location)) - (home-url format (format guix-url)) - (license format (format guix-package-info-license)) - (inputs format (format guix-package-input)) - (native-inputs format (format guix-package-native-input)) - (propagated-inputs format - (format guix-package-propagated-input)) - (description simple (indent guix-package-info-description))) - :titles guix-package-info-titles - :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." - (guix-info-insert-value-format version - 'guix-package-info-version) - (and (guix-entry-value entry 'obsolete) - (guix-package-info-insert-obsolete-text))) - -(defun guix-output-info-insert-output (output entry) - "Insert OUTPUT and action buttons at point." - (let* ((installed (guix-entry-value entry 'installed)) - (obsolete (guix-entry-value entry 'obsolete)) - (action-type (if installed 'delete 'install))) - (guix-info-insert-value-format - output - (if installed - 'guix-package-info-installed-outputs - 'guix-package-info-uninstalled-outputs)) - (guix-info-insert-indent) - (guix-package-info-insert-action-button action-type entry output) - (when obsolete - (guix-info-insert-indent) - (guix-package-info-insert-action-button 'upgrade entry output)))) - - -;;; Displaying generations - -(guix-ui-info-define-interface generation - :buffer-name "*Guix Generation Info*" - :format '((number format guix-generation-info-insert-number) - (prev-number format (format)) - (current format guix-generation-info-insert-current) - (path simple (indent guix-file)) - (time format (time))) - :titles '((path . "File name") - (prev-number . "Previous number"))) - -(defface guix-generation-info-number - '((t :inherit font-lock-keyword-face)) - "Face used for a number of a generation." - :group 'guix-generation-info-faces) - -(defface guix-generation-info-current - '((t :inherit guix-package-info-installed-outputs)) - "Face used if a generation is the current one." - :group 'guix-generation-info-faces) - -(defface guix-generation-info-not-current - '((t nil)) - "Face used if a generation is not the current one." - :group 'guix-generation-info-faces) - -(defun guix-generation-info-insert-number (number &optional _) - "Insert generation NUMBER and action buttons." - (guix-info-insert-value-format number 'guix-generation-info-number) - (guix-info-insert-indent) - (guix-info-insert-action-button - "Packages" - (lambda (btn) - (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-ui-current-profile) - (list (button-get btn 'number)) - (current-buffer))) - "Delete this generation" - 'number number)) - -(defun guix-generation-info-insert-current (val entry) - "Insert boolean value VAL showing whether this generation is current." - (if val - (guix-info-insert-value-format "Yes" 'guix-generation-info-current) - (guix-info-insert-value-format "No" 'guix-generation-info-not-current) - (guix-info-insert-indent) - (guix-info-insert-action-button - "Switch" - (lambda (btn) - (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)))) - (defvar guix-info-font-lock-keywords (eval-when-compile diff --git a/emacs/guix-list.el b/emacs/guix-list.el index f5c50389ed..719642ad07 100644 --- a/emacs/guix-list.el +++ b/emacs/guix-list.el @@ -1,4 +1,4 @@ -;;; guix-list.el --- List buffers for displaying entries -*- lexical-binding: t -*- +;;; guix-list.el --- 'List' buffer interface for displaying data -*- lexical-binding: t -*- ;; Copyright © 2014, 2015 Alex Kost @@ -19,18 +19,17 @@ ;;; Commentary: -;; This file provides a list-like buffer for displaying information -;; about Guix packages and generations. +;; This file provides 'list' buffer interface for displaying an arbitrary +;; data. ;;; Code: (require 'cl-lib) (require 'tabulated-list) +(require 'guix-buffer) (require 'guix-info) -(require 'guix-base) (require 'guix-entry) (require 'guix-utils) -(require 'guix-ui) (defgroup guix-list nil "General settings for list buffers." @@ -533,446 +532,6 @@ Set up the current 'list' buffer for displaying '%s' entries." :mode-init-function ',mode-init-fun ,@%foreign-args)))))))) - -;;; Displaying packages - -(guix-ui-list-define-interface package - :buffer-name "*Guix Package List*" - :format '((name guix-package-list-get-name 20 t) - (version nil 10 nil) - (outputs nil 13 t) - (installed guix-package-list-get-installed-outputs 13 t) - (synopsis guix-list-get-one-line 30 nil)) - :sort-key '(name) - :marks '((install . ?I) - (upgrade . ?U) - (delete . ?D))) - -(defface guix-package-list-installed - '((t :inherit guix-package-info-installed-outputs)) - "Face used if there are installed outputs for the current package." - :group 'guix-package-list-faces) - -(defface guix-package-list-obsolete - '((t :inherit guix-package-info-obsolete)) - "Face used if a package is obsolete." - :group 'guix-package-list-faces) - -(defcustom guix-package-list-generation-marking-enabled nil - "If non-nil, allow putting marks in a list with 'generation packages'. - -By default this is disabled, because it may be confusing. For -example a package is installed in some generation, so a user can -mark it for deletion in the list of packages from this -generation, but the package may not be installed in the latest -generation, so actually it cannot be deleted. - -If you managed to understand the explanation above or if you -really know what you do or if you just don't care, you can set -this variable to t. It should not do much harm anyway (most -likely)." - :type 'boolean - :group 'guix-package-list) - -(let ((map guix-package-list-mode-map)) - (define-key map (kbd "e") 'guix-package-list-edit) - (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) - (define-key map (kbd "U") 'guix-package-list-mark-upgrade) - (define-key map (kbd "^") 'guix-package-list-mark-upgrades)) - -(defun guix-package-list-get-name (name entry) - "Return NAME of the package ENTRY. -Colorize it with `guix-package-list-installed' or -`guix-package-list-obsolete' if needed." - (guix-get-string name - (cond ((guix-entry-value entry 'obsolete) - 'guix-package-list-obsolete) - ((guix-entry-value entry 'installed) - 'guix-package-list-installed)))) - -(defun guix-package-list-get-installed-outputs (installed &optional _) - "Return string with outputs from INSTALLED entries." - (guix-get-string - (mapcar (lambda (entry) - (guix-entry-value entry 'output)) - installed))) - -(defun guix-package-list-marking-check () - "Signal an error if marking is disabled for the current buffer." - (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-ui-current-search-type) 'generation)) - (error "Action marks are disabled for lists of 'generation packages'"))) - -(defun guix-package-list-mark-outputs (mark default - &optional prompt available) - "Mark the current package with MARK and move to the next line. -If PROMPT is non-nil, use it to ask a user for outputs from -AVAILABLE list, otherwise mark all DEFAULT outputs." - (let ((outputs (if prompt - (guix-completing-read-multiple - prompt available nil t) - default))) - (apply #'guix-list--mark mark t outputs))) - -(defun guix-package-list-mark-install (&optional arg) - "Mark the current package for installation and move to the next line. -With ARG, prompt for the outputs to install (several outputs may -be separated with \",\")." - (interactive "P") - (guix-package-list-marking-check) - (let* ((entry (guix-list-current-entry)) - (all (guix-entry-value entry 'outputs)) - (installed (guix-package-installed-outputs entry)) - (available (cl-set-difference all installed :test #'string=))) - (or available - (user-error "This package is already installed")) - (guix-package-list-mark-outputs - 'install '("out") - (and arg "Output(s) to install: ") - available))) - -(defun guix-package-list-mark-delete (&optional arg) - "Mark the current package for deletion and move to the next line. -With ARG, prompt for the outputs to delete (several outputs may -be separated with \",\")." - (interactive "P") - (guix-package-list-marking-check) - (let* ((entry (guix-list-current-entry)) - (installed (guix-package-installed-outputs entry))) - (or installed - (user-error "This package is not installed")) - (guix-package-list-mark-outputs - 'delete installed - (and arg "Output(s) to delete: ") - installed))) - -(defun guix-package-list-mark-upgrade (&optional arg) - "Mark the current package for upgrading and move to the next line. -With ARG, prompt for the outputs to upgrade (several outputs may -be separated with \",\")." - (interactive "P") - (guix-package-list-marking-check) - (let* ((entry (guix-list-current-entry)) - (installed (guix-package-installed-outputs entry))) - (or installed - (user-error "This package is not installed")) - (when (or (guix-entry-value entry 'obsolete) - (y-or-n-p "This package is not obsolete. Try to upgrade it anyway? ")) - (guix-package-list-mark-outputs - 'upgrade installed - (and arg "Output(s) to upgrade: ") - installed)))) - -(defun guix-list-mark-package-upgrades (fun) - "Mark all obsolete packages for upgrading. -Use FUN to perform marking of the current line. FUN should -accept an entry as argument." - (guix-package-list-marking-check) - (let ((obsolete (cl-remove-if-not - (lambda (entry) - (guix-entry-value entry 'obsolete)) - (guix-buffer-current-entries)))) - (guix-list-for-each-line - (lambda () - (let* ((id (guix-list-current-id)) - (entry (cl-find-if - (lambda (entry) - (equal id (guix-entry-id entry))) - obsolete))) - (when entry - (funcall fun entry))))))) - -(defun guix-package-list-mark-upgrades () - "Mark all obsolete packages for upgrading." - (interactive) - (guix-list-mark-package-upgrades - (lambda (entry) - (apply #'guix-list--mark - 'upgrade nil - (guix-package-installed-outputs entry))))) - -(defun guix-list-execute-package-actions (fun) - "Perform actions on the marked packages. -Use FUN to define actions suitable for `guix-process-package-actions'. -FUN should accept action-type as argument." - (let ((actions (delq nil - (mapcar fun '(install delete upgrade))))) - (if actions - (guix-process-package-actions (guix-ui-current-profile) - actions (current-buffer)) - (user-error "No operations specified")))) - -(defun guix-package-list-execute () - "Perform actions on the marked packages." - (interactive) - (guix-list-execute-package-actions #'guix-package-list-make-action)) - -(defun guix-package-list-make-action (action-type) - "Return action specification for the packages marked with ACTION-TYPE. -Return nil, if there are no packages marked with ACTION-TYPE. -The specification is suitable for `guix-process-package-actions'." - (let ((specs (guix-list-get-marked-args action-type))) - (and specs (cons action-type specs)))) - -(defun guix-package-list-edit () - "Go to the location of the current package." - (interactive) - (guix-edit (guix-list-current-id))) - - -;;; Displaying outputs - -(guix-ui-list-define-interface output - :buffer-name "*Guix Package List*" - :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 '(id package-id) - :sort-key '(name) - :marks '((install . ?I) - (upgrade . ?U) - (delete . ?D))) - -(let ((map guix-output-list-mode-map)) - (define-key map (kbd "e") 'guix-output-list-edit) - (define-key map (kbd "x") 'guix-output-list-execute) - (define-key map (kbd "i") 'guix-output-list-mark-install) - (define-key map (kbd "d") 'guix-output-list-mark-delete) - (define-key map (kbd "U") 'guix-output-list-mark-upgrade) - (define-key map (kbd "^") 'guix-output-list-mark-upgrades)) - -(defun guix-output-list-mark-install () - "Mark the current output for installation and move to the next line." - (interactive) - (guix-package-list-marking-check) - (let* ((entry (guix-list-current-entry)) - (installed (guix-entry-value entry 'installed))) - (if installed - (user-error "This output is already installed") - (guix-list--mark 'install t)))) - -(defun guix-output-list-mark-delete () - "Mark the current output for deletion and move to the next line." - (interactive) - (guix-package-list-marking-check) - (let* ((entry (guix-list-current-entry)) - (installed (guix-entry-value entry 'installed))) - (if installed - (guix-list--mark 'delete t) - (user-error "This output is not installed")))) - -(defun guix-output-list-mark-upgrade () - "Mark the current output for deletion and move to the next line." - (interactive) - (guix-package-list-marking-check) - (let* ((entry (guix-list-current-entry)) - (installed (guix-entry-value entry 'installed))) - (or installed - (user-error "This output is not installed")) - (when (or (guix-entry-value entry 'obsolete) - (y-or-n-p "This output is not obsolete. Try to upgrade it anyway? ")) - (guix-list--mark 'upgrade t)))) - -(defun guix-output-list-mark-upgrades () - "Mark all obsolete package outputs for upgrading." - (interactive) - (guix-list-mark-package-upgrades - (lambda (_) (guix-list--mark 'upgrade)))) - -(defun guix-output-list-execute () - "Perform actions on the marked outputs." - (interactive) - (guix-list-execute-package-actions #'guix-output-list-make-action)) - -(defun guix-output-list-make-action (action-type) - "Return action specification for the outputs marked with ACTION-TYPE. -Return nil, if there are no outputs marked with ACTION-TYPE. -The specification is suitable for `guix-process-output-actions'." - (let ((ids (guix-list-get-marked-id-list action-type))) - (and ids (cons action-type - (mapcar #'guix-package-id-and-output-by-output-id - ids))))) - -(defun guix-output-list-describe (ids) - "Describe outputs with IDS (list of output identifiers). -See `guix-package-info-type'." - (if (eq guix-package-info-type 'output) - (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))) - (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." - (interactive) - (guix-edit (guix-entry-value (guix-list-current-entry) - 'package-id))) - - -;;; Displaying generations - -(guix-ui-list-define-interface generation - :buffer-name "*Guix Generation List*" - :format '((number nil 5 guix-list-sort-numerically-0 :right-align t) - (current guix-generation-list-get-current 10 t) - (time guix-list-get-time 20 t) - (path guix-list-get-file-path 30 t)) - :titles '((number . "N.")) - :sort-key '(number . t) - :marks '((delete . ?D))) - -(let ((map guix-generation-list-mode-map)) - (define-key map (kbd "RET") 'guix-generation-list-show-packages) - (define-key map (kbd "+") 'guix-generation-list-show-added-packages) - (define-key map (kbd "-") 'guix-generation-list-show-removed-packages) - (define-key map (kbd "=") 'guix-generation-list-diff) - (define-key map (kbd "D") 'guix-generation-list-diff) - (define-key map (kbd "e") 'guix-generation-list-ediff) - (define-key map (kbd "x") 'guix-generation-list-execute) - (define-key map (kbd "s") 'guix-generation-list-switch) - (define-key map (kbd "d") 'guix-generation-list-mark-delete)) - -(defun guix-generation-list-get-current (val &optional _) - "Return string from VAL showing whether this generation is current. -VAL is a boolean value." - (if val "(current)" "")) - -(defun guix-generation-list-switch () - "Switch current profile to the generation at point." - (interactive) - (let* ((entry (guix-list-current-entry)) - (current (guix-entry-value entry 'current)) - (number (guix-entry-value entry 'number))) - (if current - (user-error "This generation is already the current one") - (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-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." - (let ((numbers (guix-list-get-marked-id-list 'general))) - (if (/= (length numbers) 2) - (user-error "2 generations should be marked for comparing") - (sort numbers #'<)))) - -(defun guix-generation-list-show-added-packages () - "List package outputs added to the latest marked generation. -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) - (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. -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) - (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." - (cl-multiple-value-bind (gen1 gen2) - (guix-generation-list-generations-to-compare) - (funcall diff-fun - (funcall gen-fun gen1) - (funcall gen-fun gen2)))) - -(defun guix-generation-list-ediff-manifests () - "Run Ediff on manifests of the 2 marked generations." - (interactive) - (guix-generation-list-compare - #'ediff-files - #'guix-profile-generation-manifest-file)) - -(defun guix-generation-list-diff-manifests () - "Run Diff on manifests of the 2 marked generations." - (interactive) - (guix-generation-list-compare - #'guix-diff - #'guix-profile-generation-manifest-file)) - -(defun guix-generation-list-ediff-packages () - "Run Ediff on package outputs installed in the 2 marked generations." - (interactive) - (guix-generation-list-compare - #'ediff-buffers - #'guix-profile-generation-packages-buffer)) - -(defun guix-generation-list-diff-packages () - "Run Diff on package outputs installed in the 2 marked generations." - (interactive) - (guix-generation-list-compare - #'guix-diff - #'guix-profile-generation-packages-buffer)) - -(defun guix-generation-list-ediff (arg) - "Run Ediff on package outputs installed in the 2 marked generations. -With ARG, run Ediff on manifests of the marked generations." - (interactive "P") - (if arg - (guix-generation-list-ediff-manifests) - (guix-generation-list-ediff-packages))) - -(defun guix-generation-list-diff (arg) - "Run Diff on package outputs installed in the 2 marked generations. -With ARG, run Diff on manifests of the marked generations." - (interactive "P") - (if arg - (guix-generation-list-diff-manifests) - (guix-generation-list-diff-packages))) - -(defun guix-generation-list-mark-delete (&optional arg) - "Mark the current generation for deletion and move to the next line. -With ARG, mark all generations for deletion." - (interactive "P") - (if arg - (guix-list-mark-all 'delete) - (guix-list--mark 'delete t))) - -(defun guix-generation-list-execute () - "Delete marked generations." - (interactive) - (let ((marked (guix-list-get-marked-id-list 'delete))) - (or marked - (user-error "No generations marked for deletion")) - (guix-delete-generations (guix-ui-current-profile) - marked (current-buffer)))) - (defvar guix-list-font-lock-keywords (eval-when-compile diff --git a/emacs/guix-ui-generation.el b/emacs/guix-ui-generation.el new file mode 100644 index 0000000000..7d6762a444 --- /dev/null +++ b/emacs/guix-ui-generation.el @@ -0,0 +1,439 @@ +;;; guix-ui-generation.el --- Interface for displaying generations -*- lexical-binding: t -*- + +;; Copyright © 2014, 2015 Alex Kost + +;; 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 . + +;;; Commentary: + +;; This file provides an interface for displaying profile generations in +;; 'list' and 'info' buffers, and commands for working with them. + +;;; Code: + +(require 'cl-lib) +(require 'guix-buffer) +(require 'guix-list) +(require 'guix-info) +(require 'guix-ui) +(require 'guix-ui-package) +(require 'guix-base) +(require 'guix-backend) +(require 'guix-guile) +(require 'guix-entry) +(require 'guix-utils) + +(defgroup guix-generation nil + "Interface for displaying generations." + :group 'guix-ui) + +(defun guix-generation-get-display (profile search-type &rest search-values) + "Search for generations and show results. + +If PROFILE is nil, use `guix-current-profile'. + +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))) + +(defun guix-delete-generations (profile generations + &optional operation-buffer) + "Delete GENERATIONS from PROFILE. +Each element from GENERATIONS is a generation number." + (when (or (not guix-operation-confirm) + (y-or-n-p + (let ((count (length generations))) + (if (> count 1) + (format "Delete %d generations from profile '%s'? " + count profile) + (format "Delete generation %d from profile '%s'? " + (car generations) profile))))) + (guix-eval-in-repl + (guix-make-guile-expression + 'delete-generations* profile generations) + operation-buffer))) + +(defun guix-switch-to-generation (profile generation + &optional operation-buffer) + "Switch PROFILE to GENERATION." + (when (or (not guix-operation-confirm) + (y-or-n-p (format "Switch profile '%s' to generation %d? " + profile generation))) + (guix-eval-in-repl + (guix-make-guile-expression + 'switch-to-generation* profile generation) + operation-buffer))) + + +;;; Generation 'info' + +(guix-ui-info-define-interface generation + :buffer-name "*Guix Generation Info*" + :format '((number format guix-generation-info-insert-number) + (prev-number format (format)) + (current format guix-generation-info-insert-current) + (path simple (indent guix-file)) + (time format (time))) + :titles '((path . "File name") + (prev-number . "Previous number"))) + +(defface guix-generation-info-number + '((t :inherit font-lock-keyword-face)) + "Face used for a number of a generation." + :group 'guix-generation-info-faces) + +(defface guix-generation-info-current + '((t :inherit guix-package-info-installed-outputs)) + "Face used if a generation is the current one." + :group 'guix-generation-info-faces) + +(defface guix-generation-info-not-current + '((t nil)) + "Face used if a generation is not the current one." + :group 'guix-generation-info-faces) + +(defun guix-generation-info-insert-number (number &optional _) + "Insert generation NUMBER and action buttons." + (guix-info-insert-value-format number 'guix-generation-info-number) + (guix-info-insert-indent) + (guix-info-insert-action-button + "Packages" + (lambda (btn) + (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-ui-current-profile) + (list (button-get btn 'number)) + (current-buffer))) + "Delete this generation" + 'number number)) + +(defun guix-generation-info-insert-current (val entry) + "Insert boolean value VAL showing whether this generation is current." + (if val + (guix-info-insert-value-format "Yes" 'guix-generation-info-current) + (guix-info-insert-value-format "No" 'guix-generation-info-not-current) + (guix-info-insert-indent) + (guix-info-insert-action-button + "Switch" + (lambda (btn) + (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)))) + + +;;; Generation 'list' + +(guix-ui-list-define-interface generation + :buffer-name "*Guix Generation List*" + :format '((number nil 5 guix-list-sort-numerically-0 :right-align t) + (current guix-generation-list-get-current 10 t) + (time guix-list-get-time 20 t) + (path guix-list-get-file-path 30 t)) + :titles '((number . "N.")) + :sort-key '(number . t) + :marks '((delete . ?D))) + +(let ((map guix-generation-list-mode-map)) + (define-key map (kbd "RET") 'guix-generation-list-show-packages) + (define-key map (kbd "+") 'guix-generation-list-show-added-packages) + (define-key map (kbd "-") 'guix-generation-list-show-removed-packages) + (define-key map (kbd "=") 'guix-generation-list-diff) + (define-key map (kbd "D") 'guix-generation-list-diff) + (define-key map (kbd "e") 'guix-generation-list-ediff) + (define-key map (kbd "x") 'guix-generation-list-execute) + (define-key map (kbd "s") 'guix-generation-list-switch) + (define-key map (kbd "c") 'guix-generation-list-switch) + (define-key map (kbd "d") 'guix-generation-list-mark-delete)) + +(defun guix-generation-list-get-current (val &optional _) + "Return string from VAL showing whether this generation is current. +VAL is a boolean value." + (if val "(current)" "")) + +(defun guix-generation-list-switch () + "Switch current profile to the generation at point." + (interactive) + (let* ((entry (guix-list-current-entry)) + (current (guix-entry-value entry 'current)) + (number (guix-entry-value entry 'number))) + (if current + (user-error "This generation is already the current one") + (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-package-get-display + (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." + (let ((numbers (guix-list-get-marked-id-list 'general))) + (if (/= (length numbers) 2) + (user-error "2 generations should be marked for comparing") + (sort numbers #'<)))) + +(defun guix-generation-list-show-added-packages () + "List package outputs added to the latest marked generation. +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) + (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. +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) + (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." + (cl-multiple-value-bind (gen1 gen2) + (guix-generation-list-generations-to-compare) + (funcall diff-fun + (funcall gen-fun gen1) + (funcall gen-fun gen2)))) + +(defun guix-generation-list-ediff-manifests () + "Run Ediff on manifests of the 2 marked generations." + (interactive) + (guix-generation-list-compare + #'ediff-files + #'guix-profile-generation-manifest-file)) + +(defun guix-generation-list-diff-manifests () + "Run Diff on manifests of the 2 marked generations." + (interactive) + (guix-generation-list-compare + #'guix-diff + #'guix-profile-generation-manifest-file)) + +(defun guix-generation-list-ediff-packages () + "Run Ediff on package outputs installed in the 2 marked generations." + (interactive) + (guix-generation-list-compare + #'ediff-buffers + #'guix-profile-generation-packages-buffer)) + +(defun guix-generation-list-diff-packages () + "Run Diff on package outputs installed in the 2 marked generations." + (interactive) + (guix-generation-list-compare + #'guix-diff + #'guix-profile-generation-packages-buffer)) + +(defun guix-generation-list-ediff (arg) + "Run Ediff on package outputs installed in the 2 marked generations. +With ARG, run Ediff on manifests of the marked generations." + (interactive "P") + (if arg + (guix-generation-list-ediff-manifests) + (guix-generation-list-ediff-packages))) + +(defun guix-generation-list-diff (arg) + "Run Diff on package outputs installed in the 2 marked generations. +With ARG, run Diff on manifests of the marked generations." + (interactive "P") + (if arg + (guix-generation-list-diff-manifests) + (guix-generation-list-diff-packages))) + +(defun guix-generation-list-mark-delete (&optional arg) + "Mark the current generation for deletion and move to the next line. +With ARG, mark all generations for deletion." + (interactive "P") + (if arg + (guix-list-mark-all 'delete) + (guix-list--mark 'delete t))) + +(defun guix-generation-list-execute () + "Delete marked generations." + (interactive) + (let ((marked (guix-list-get-marked-id-list 'delete))) + (or marked + (user-error "No generations marked for deletion")) + (guix-delete-generations (guix-ui-current-profile) + marked (current-buffer)))) + + +;;; Inserting packages to compare generations + +(defcustom guix-generation-packages-buffer-name-function + #'guix-generation-packages-buffer-name-default + "Function used to define name of a buffer with generation packages. +This function is called with 2 arguments: PROFILE (string) and +GENERATION (number)." + :type '(choice (function-item guix-generation-packages-buffer-name-default) + (function-item guix-generation-packages-buffer-name-long) + (function :tag "Other function")) + :group 'guix-generation) + +(defcustom guix-generation-packages-update-buffer t + "If non-nil, always update list of packages during comparing generations. +If nil, generation packages are received only once. So when you +compare generation 1 and generation 2, the packages for both +generations will be received. Then if you compare generation 1 +and generation 3, only the packages for generation 3 will be +received. Thus if you use comparing of different generations a +lot, you may set this variable to nil to improve the +performance." + :type 'boolean + :group 'guix-generation) + +(defvar guix-generation-output-name-width 30 + "Width of an output name \"column\". +This variable is used in auxiliary buffers for comparing generations.") + +(defun guix-generation-packages (profile generation) + "Return a list of sorted packages installed in PROFILE's GENERATION. +Each element of the list is a list of the package specification +and its store path." + (let ((names+paths (guix-eval-read + (guix-make-guile-expression + 'generation-package-specifications+paths + profile generation)))) + (sort names+paths + (lambda (a b) + (string< (car a) (car b)))))) + +(defun guix-generation-packages-buffer-name-default (profile generation) + "Return name of a buffer for displaying GENERATION's package outputs. +Use base name of PROFILE file name." + (let ((profile-name (file-name-base (directory-file-name profile)))) + (format "*Guix %s: generation %s*" + profile-name generation))) + +(defun guix-generation-packages-buffer-name-long (profile generation) + "Return name of a buffer for displaying GENERATION's package outputs. +Use the full PROFILE file name." + (format "*Guix generation %s (%s)*" + generation profile)) + +(defun guix-generation-packages-buffer-name (profile generation) + "Return name of a buffer for displaying GENERATION's package outputs." + (funcall guix-generation-packages-buffer-name-function + profile generation)) + +(defun guix-generation-insert-package (name path) + "Insert package output NAME and store PATH at point." + (insert name) + (indent-to guix-generation-output-name-width 2) + (insert path "\n")) + +(defun guix-generation-insert-packages (buffer profile generation) + "Insert package outputs installed in PROFILE's GENERATION in BUFFER." + (with-current-buffer buffer + (setq buffer-read-only nil + indent-tabs-mode nil) + (erase-buffer) + (mapc (lambda (name+path) + (guix-generation-insert-package + (car name+path) (cadr name+path))) + (guix-generation-packages profile generation)))) + +(defun guix-generation-packages-buffer (profile generation) + "Return buffer with package outputs installed in PROFILE's GENERATION. +Create the buffer if needed." + (let ((buf-name (guix-generation-packages-buffer-name + profile generation))) + (or (and (null guix-generation-packages-update-buffer) + (get-buffer buf-name)) + (let ((buf (get-buffer-create buf-name))) + (guix-generation-insert-packages buf profile generation) + buf)))) + +(defun guix-profile-generation-manifest-file (generation) + "Return the file name of a GENERATION's manifest. +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 the current profile." + (guix-generation-packages-buffer (guix-ui-current-profile) + generation)) + + +;;; Interactive commands + +;;;###autoload +(defun guix-generations (&optional profile) + "Display information about all generations. +If PROFILE is nil, use `guix-current-profile'. +Interactively with prefix, prompt for PROFILE." + (interactive + (list (and current-prefix-arg + (guix-profile-prompt)))) + (guix-generation-get-display profile 'all)) + +;;;###autoload +(defun guix-last-generations (number &optional profile) + "Display information about last NUMBER generations. +If PROFILE is nil, use `guix-current-profile'. +Interactively with prefix, prompt for PROFILE." + (interactive + (list (read-number "The number of last generations: ") + (and current-prefix-arg + (guix-profile-prompt)))) + (guix-generation-get-display profile 'last number)) + +;;;###autoload +(defun guix-generations-by-time (from to &optional profile) + "Display information about generations created between FROM and TO. +FROM and TO should be time values. +If PROFILE is nil, use `guix-current-profile'. +Interactively with prefix, prompt for PROFILE." + (interactive + (list (guix-read-date "Find generations (from): ") + (guix-read-date "Find generations (to): ") + (and current-prefix-arg + (guix-profile-prompt)))) + (guix-generation-get-display profile 'time + (float-time from) + (float-time to))) + +(provide 'guix-ui-generation) + +;;; guix-ui-generation.el ends here diff --git a/emacs/guix-ui-package.el b/emacs/guix-ui-package.el new file mode 100644 index 0000000000..299822aae9 --- /dev/null +++ b/emacs/guix-ui-package.el @@ -0,0 +1,958 @@ +;;; guix-ui-package.el --- Interface for displaying packages -*- lexical-binding: t -*- + +;; Copyright © 2014, 2015 Alex Kost + +;; 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 . + +;;; Commentary: + +;; This file provides an interface for displaying packages and outputs +;; in 'list' and 'info' buffers, and commands for working with them. + +;;; Code: + +(require 'cl-lib) +(require 'guix-buffer) +(require 'guix-list) +(require 'guix-info) +(require 'guix-ui) +(require 'guix-base) +(require 'guix-backend) +(require 'guix-guile) +(require 'guix-entry) +(require 'guix-utils) + +(defgroup guix-package nil + "Interface for displaying packages and outputs." + :group 'guix-ui) + +(defcustom guix-package-list-type 'output + "Define how to display packages in 'list' buffer. +Should be a symbol `package' or `output' (if `output', display each +output on a separate line; if `package', display each package on +a separate line)." + :type '(choice (const :tag "List of packages" package) + (const :tag "List of outputs" output)) + :group 'guix-package) + +(defcustom guix-package-info-type 'package + "Define how to display packages in 'info' buffer. +Should be a symbol `package' or `output' (if `output', display +each output separately; if `package', display outputs inside +package data)." + :type '(choice (const :tag "Display packages" package) + (const :tag "Display outputs" output)) + :group 'guix-package) + +(defcustom guix-package-list-single nil + "If non-nil, list a package even if it is the only matching result. +If nil, show a single package in the info buffer." + :type 'boolean + :group 'guix) + +(defun guix-package-get-display (profile search-type &rest search-values) + "Search for packages/outputs and show results. + +If PROFILE is nil, use `guix-current-profile'. + +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-package-list-single' is nil." + (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-package-list-single + (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-package-entry->name-specification (entry &optional output) + "Return name specification of the package ENTRY and OUTPUT." + (guix-package-name-specification + (guix-entry-value entry 'name) + (guix-entry-value entry 'version) + (or output (guix-entry-value entry 'output)))) + +(defun guix-package-entries->name-specifications (entries) + "Return name specifications by the package or output ENTRIES." + (cl-remove-duplicates (mapcar #'guix-package-entry->name-specification + entries) + :test #'string=)) + +(defun guix-package-installed-outputs (entry) + "Return a list of installed outputs for the package ENTRY." + (mapcar (lambda (installed-entry) + (guix-entry-value installed-entry 'output)) + (guix-entry-value entry 'installed))) + +(defun guix-package-id-and-output-by-output-id (output-id) + "Return a list (PACKAGE-ID OUTPUT) by OUTPUT-ID." + (cl-multiple-value-bind (package-id-str output) + (split-string output-id ":") + (let ((package-id (string-to-number package-id-str))) + (list (if (= 0 package-id) package-id-str package-id) + output)))) + + +;;; Processing package actions + +(defun guix-process-package-actions (profile actions + &optional operation-buffer) + "Process package ACTIONS on PROFILE. +Each action is a list of the form: + + (ACTION-TYPE PACKAGE-SPEC ...) + +ACTION-TYPE is one of the following symbols: `install', +`upgrade', `remove'/`delete'. +PACKAGE-SPEC should have the following form: (ID [OUTPUT] ...)." + (let (install upgrade remove) + (mapc (lambda (action) + (let ((action-type (car action)) + (specs (cdr action))) + (cl-case action-type + (install (setq install (append install specs))) + (upgrade (setq upgrade (append upgrade specs))) + ((remove delete) (setq remove (append remove specs)))))) + actions) + (when (guix-continue-package-operation-p + profile + :install install :upgrade upgrade :remove remove) + (guix-eval-in-repl + (guix-make-guile-expression + 'process-package-actions profile + :install install :upgrade upgrade :remove remove + :use-substitutes? (or guix-use-substitutes 'f) + :dry-run? (or guix-dry-run 'f)) + (and (not guix-dry-run) operation-buffer))))) + +(cl-defun guix-continue-package-operation-p (profile + &key install upgrade remove) + "Return non-nil if a package operation should be continued. +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-ui-get-entries + profile 'package 'id + (append (mapcar #'car install) + (mapcar #'car upgrade) + (mapcar #'car remove)) + '(id name version location))) + (install-strings (guix-get-package-strings install entries)) + (upgrade-strings (guix-get-package-strings upgrade entries)) + (remove-strings (guix-get-package-strings remove entries))) + (if (or install-strings upgrade-strings remove-strings) + (let ((buf (get-buffer-create guix-temp-buffer-name))) + (with-current-buffer buf + (setq-local cursor-type nil) + (setq buffer-read-only nil) + (erase-buffer) + (insert "Profile: " profile "\n\n") + (guix-insert-package-strings install-strings "install") + (guix-insert-package-strings upgrade-strings "upgrade") + (guix-insert-package-strings remove-strings "remove") + (let ((win (temp-buffer-window-show + buf + '((display-buffer-reuse-window + display-buffer-at-bottom) + (window-height . fit-window-to-buffer))))) + (prog1 (guix-operation-prompt) + (quit-window nil win))))) + (message "Nothing to be done. +If Guix REPL was restarted, the data is not up-to-date.") + nil)))) + +(defun guix-get-package-strings (specs entries) + "Return short package descriptions for performing package actions. +See `guix-process-package-actions' for the meaning of SPECS. +ENTRIES is a list of package entries to get info about packages." + (delq nil + (mapcar + (lambda (spec) + (let* ((id (car spec)) + (outputs (cdr spec)) + (entry (guix-entry-by-id id entries))) + (when entry + (let ((location (guix-entry-value entry 'location))) + (concat (guix-package-entry->name-specification entry) + (when outputs + (concat ":" + (guix-concat-strings outputs ","))) + (when location + (concat "\t(" location ")"))))))) + specs))) + +(defun guix-insert-package-strings (strings action) + "Insert information STRINGS at point for performing package ACTION." + (when strings + (insert "Package(s) to " (propertize action 'face 'bold) ":\n") + (mapc (lambda (str) + (insert " " str "\n")) + strings) + (insert "\n"))) + + +;;; Package 'info' + +(guix-ui-info-define-interface package + :buffer-name "*Guix Package Info*" + :format '(guix-package-info-insert-heading + ignore + (synopsis ignore (simple guix-package-info-synopsis)) + ignore + (description ignore (simple guix-package-info-description)) + ignore + (outputs simple guix-package-info-insert-outputs) + (source simple guix-package-info-insert-source) + (location format (format guix-package-location)) + (home-url format (format guix-url)) + (license format (format guix-package-info-license)) + (inputs format (format guix-package-input)) + (native-inputs format (format guix-package-native-input)) + (propagated-inputs format + (format guix-package-propagated-input))) + :titles '((home-url . "Home page")) + :required '(id name version installed non-unique)) + +(guix-info-define-interface installed-output + :format '((path simple (indent guix-file)) + (dependencies simple (indent guix-file))) + :titles '((path . "Store directory")) + :reduced? t) + +(defface guix-package-info-heading + '((t :inherit guix-info-heading)) + "Face for package name and version headings." + :group 'guix-package-info-faces) + +(defface guix-package-info-name + '((t :inherit font-lock-keyword-face)) + "Face used for a name of a package." + :group 'guix-package-info-faces) + +(defface guix-package-info-name-button + '((t :inherit button)) + "Face used for a full name that can be used to describe a package." + :group 'guix-package-info-faces) + +(defface guix-package-info-version + '((t :inherit font-lock-builtin-face)) + "Face used for a version of a package." + :group 'guix-package-info-faces) + +(defface guix-package-info-synopsis + '((((type tty pc) (class color)) :weight bold) + (t :height 1.1 :weight bold :inherit variable-pitch)) + "Face used for a synopsis of a package." + :group 'guix-package-info-faces) + +(defface guix-package-info-description + '((t)) + "Face used for a description of a package." + :group 'guix-package-info-faces) + +(defface guix-package-info-license + '((t :inherit font-lock-string-face)) + "Face used for a license of a package." + :group 'guix-package-info-faces) + +(defface guix-package-info-location + '((t :inherit link)) + "Face used for a location of a package." + :group 'guix-package-info-faces) + +(defface guix-package-info-source + '((t :inherit link :underline nil)) + "Face used for a source URL of a package." + :group 'guix-package-info-faces) + +(defface guix-package-info-installed-outputs + '((default :weight bold) + (((class color) (min-colors 88) (background light)) + :foreground "ForestGreen") + (((class color) (min-colors 88) (background dark)) + :foreground "PaleGreen") + (((class color) (min-colors 8)) + :foreground "green") + (t :underline t)) + "Face used for installed outputs of a package." + :group 'guix-package-info-faces) + +(defface guix-package-info-uninstalled-outputs + '((t :weight bold)) + "Face used for uninstalled outputs of a package." + :group 'guix-package-info-faces) + +(defface guix-package-info-obsolete + '((t :inherit error)) + "Face used if a package is obsolete." + :group 'guix-package-info-faces) + +(defcustom guix-package-info-auto-find-source nil + "If non-nil, find a source file after pressing a \"Show\" button. +If nil, just display the source file path without finding." + :type 'boolean + :group 'guix-package-info) + +(defcustom guix-package-info-auto-download-source t + "If nil, do not automatically download a source file if it doesn't exist. +After pressing a \"Show\" button, a derivation of the package +source is calculated and a store file path is displayed. If this +variable is non-nil and the source file does not exist in the +store, it will be automatically downloaded (with a possible +prompt depending on `guix-operation-confirm' variable)." + :type 'boolean + :group 'guix-package-info) + +(defvar guix-package-info-download-buffer nil + "Buffer from which a current download operation was performed.") + +(defvar guix-package-info-output-format "%-10s" + "String used to format output names of the packages. +It should be a '%s'-sequence. After inserting an output name +formatted with this string, an action button is inserted.") + +(defvar guix-package-info-obsolete-string "(This package is obsolete)" + "String used if a package is obsolete.") + +(define-button-type 'guix-package-location + :supertype 'guix + 'face 'guix-package-info-location + 'help-echo "Find location of this package" + 'action (lambda (btn) + (guix-find-location (button-label btn)))) + +(define-button-type 'guix-package-name + :supertype 'guix + 'face 'guix-package-info-name-button + 'help-echo "Describe this package" + 'action (lambda (btn) + (guix-buffer-get-display-entries-current + 'info guix-package-info-type + (list (guix-ui-current-profile) + 'name (button-label btn)) + 'add))) + +(define-button-type 'guix-package-source + :supertype 'guix + 'face 'guix-package-info-source + 'help-echo "" + 'action (lambda (_) + ;; As a source may not be a real URL (e.g., "mirror://..."), + ;; no action is bound to a source button. + (message "Yes, this is the source URL. What did you expect?"))) + +(defun guix-package-info-insert-heading (entry) + "Insert package ENTRY heading (name specification) at point." + (guix-insert-button + (guix-package-entry->name-specification entry) + 'guix-package-name + 'face 'guix-package-info-heading)) + +(defmacro guix-package-info-define-insert-inputs (&optional type) + "Define a face and a function for inserting package inputs. +TYPE is a type of inputs. +Function name is `guix-package-info-insert-TYPE-inputs'. +Face name is `guix-package-info-TYPE-inputs'." + (let* ((type-str (symbol-name type)) + (type-name (and type (concat type-str "-"))) + (type-desc (and type (concat type-str " "))) + (face (intern (concat "guix-package-info-" type-name "inputs"))) + (btn (intern (concat "guix-package-" type-name "input")))) + `(progn + (defface ,face + '((t :inherit guix-package-info-name-button)) + ,(concat "Face used for " type-desc "inputs of a package.") + :group 'guix-package-info-faces) + + (define-button-type ',btn + :supertype 'guix-package-name + 'face ',face)))) + +(guix-package-info-define-insert-inputs) +(guix-package-info-define-insert-inputs native) +(guix-package-info-define-insert-inputs propagated) + +(defun guix-package-info-insert-outputs (outputs entry) + "Insert OUTPUTS from package ENTRY at point." + (and (guix-entry-value entry 'obsolete) + (guix-package-info-insert-obsolete-text)) + (and (guix-entry-value entry 'non-unique) + (guix-entry-value entry 'installed) + (guix-package-info-insert-non-unique-text + (guix-package-entry->name-specification entry))) + (insert "\n") + (dolist (output outputs) + (guix-package-info-insert-output output entry))) + +(defun guix-package-info-insert-obsolete-text () + "Insert a message about obsolete package at point." + (guix-info-insert-indent) + (guix-format-insert guix-package-info-obsolete-string + 'guix-package-info-obsolete)) + +(defun guix-package-info-insert-non-unique-text (full-name) + "Insert a message about non-unique package with FULL-NAME at point." + (insert "\n") + (guix-info-insert-indent) + (insert "Installed outputs are displayed for a non-unique ") + (guix-insert-button full-name 'guix-package-name) + (insert " package.")) + +(defun guix-package-info-insert-output (output entry) + "Insert OUTPUT at point. +Make some fancy text with buttons and additional stuff if the +current OUTPUT is installed (if there is such output in +`installed' parameter of a package ENTRY)." + (let* ((installed (guix-entry-value entry 'installed)) + (obsolete (guix-entry-value entry 'obsolete)) + (installed-entry (cl-find-if + (lambda (entry) + (string= (guix-entry-value entry 'output) + output)) + installed)) + (action-type (if installed-entry 'delete 'install))) + (guix-info-insert-indent) + (guix-format-insert output + (if installed-entry + 'guix-package-info-installed-outputs + 'guix-package-info-uninstalled-outputs) + guix-package-info-output-format) + (guix-package-info-insert-action-button action-type entry output) + (when obsolete + (guix-info-insert-indent) + (guix-package-info-insert-action-button 'upgrade entry output)) + (insert "\n") + (when installed-entry + (guix-info-insert-entry installed-entry 'installed-output 2)))) + +(defun guix-package-info-insert-action-button (type entry output) + "Insert button to process an action on a package OUTPUT at point. +TYPE is one of the following symbols: `install', `delete', `upgrade'. +ENTRY is an alist with package info." + (let ((type-str (capitalize (symbol-name type))) + (full-name (guix-package-entry->name-specification entry output))) + (guix-info-insert-action-button + type-str + (lambda (btn) + (guix-process-package-actions + (guix-ui-current-profile) + `((,(button-get btn 'action-type) (,(button-get btn 'id) + ,(button-get btn 'output)))) + (current-buffer))) + (concat type-str " '" full-name "'") + 'action-type type + 'id (or (guix-entry-value entry 'package-id) + (guix-entry-id entry)) + 'output output))) + +(defun guix-package-info-show-source (entry-id package-id) + "Show file name of a package source in the current info buffer. +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-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))) + (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 + (guix-find-file file) + (message "The source store path is displayed.")) + (if guix-package-info-auto-download-source + (guix-package-info-download-source package-id) + (message "The source does not exist in the store.")))))) + +(defun guix-package-info-download-source (package-id) + "Download a source of the package PACKAGE-ID." + (setq guix-package-info-download-buffer (current-buffer)) + (guix-package-source-build-derivation + package-id + "The source does not exist in the store. Download it?")) + +(defun guix-package-info-insert-source (source entry) + "Insert SOURCE from package ENTRY at point. +SOURCE is a list of URLs." + (if (null source) + (guix-format-insert nil) + (let* ((source-file (guix-entry-value entry 'source-file)) + (entry-id (guix-entry-id entry)) + (package-id (or (guix-entry-value entry 'package-id) + entry-id))) + (if (null source-file) + (guix-info-insert-action-button + "Show" + (lambda (btn) + (guix-package-info-show-source (button-get btn 'entry-id) + (button-get btn 'package-id))) + "Show the source store directory of the current package" + 'entry-id entry-id + 'package-id package-id) + (unless (file-exists-p source-file) + (guix-info-insert-action-button + "Download" + (lambda (btn) + (guix-package-info-download-source + (button-get btn 'package-id))) + "Download the source into the store" + 'package-id package-id)) + (guix-info-insert-value-indent source-file 'guix-file)) + (guix-info-insert-value-indent source 'guix-package-source)))) + +(defun guix-package-info-redisplay-after-download () + "Redisplay an 'info' buffer after downloading the package source. +This function is used to hide a \"Download\" button if needed." + (when (buffer-live-p guix-package-info-download-buffer) + (with-current-buffer guix-package-info-download-buffer + (guix-buffer-redisplay-goto-button)) + (setq guix-package-info-download-buffer nil))) + +(add-hook 'guix-after-source-download-hook + 'guix-package-info-redisplay-after-download) + + +;;; Package 'list' + +(guix-ui-list-define-interface package + :buffer-name "*Guix Package List*" + :format '((name guix-package-list-get-name 20 t) + (version nil 10 nil) + (outputs nil 13 t) + (installed guix-package-list-get-installed-outputs 13 t) + (synopsis guix-list-get-one-line 30 nil)) + :sort-key '(name) + :marks '((install . ?I) + (upgrade . ?U) + (delete . ?D))) + +(let ((map guix-package-list-mode-map)) + (define-key map (kbd "e") 'guix-package-list-edit) + (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) + (define-key map (kbd "U") 'guix-package-list-mark-upgrade) + (define-key map (kbd "^") 'guix-package-list-mark-upgrades)) + +(defface guix-package-list-installed + '((t :inherit guix-package-info-installed-outputs)) + "Face used if there are installed outputs for the current package." + :group 'guix-package-list-faces) + +(defface guix-package-list-obsolete + '((t :inherit guix-package-info-obsolete)) + "Face used if a package is obsolete." + :group 'guix-package-list-faces) + +(defcustom guix-package-list-generation-marking-enabled nil + "If non-nil, allow putting marks in a list with 'generation packages'. + +By default this is disabled, because it may be confusing. For +example, a package is installed in some generation, so a user can +mark it for deletion in the list of packages from this +generation, but the package may not be installed in the latest +generation, so actually it cannot be deleted. + +If you managed to understand the explanation above or if you +really know what you do or if you just don't care, you can set +this variable to t. It should not do much harm anyway (most +likely)." + :type 'boolean + :group 'guix-package-list) + +(defun guix-package-list-get-name (name entry) + "Return NAME of the package ENTRY. +Colorize it with `guix-package-list-installed' or +`guix-package-list-obsolete' if needed." + (guix-get-string name + (cond ((guix-entry-value entry 'obsolete) + 'guix-package-list-obsolete) + ((guix-entry-value entry 'installed) + 'guix-package-list-installed)))) + +(defun guix-package-list-get-installed-outputs (installed &optional _) + "Return string with outputs from INSTALLED entries." + (guix-get-string + (mapcar (lambda (entry) + (guix-entry-value entry 'output)) + installed))) + +(defun guix-package-list-marking-check () + "Signal an error if marking is disabled for the current buffer." + (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-ui-current-search-type) 'generation)) + (error "Action marks are disabled for lists of 'generation packages'"))) + +(defun guix-package-list-mark-outputs (mark default + &optional prompt available) + "Mark the current package with MARK and move to the next line. +If PROMPT is non-nil, use it to ask a user for outputs from +AVAILABLE list, otherwise mark all DEFAULT outputs." + (let ((outputs (if prompt + (guix-completing-read-multiple + prompt available nil t) + default))) + (apply #'guix-list--mark mark t outputs))) + +(defun guix-package-list-mark-install (&optional arg) + "Mark the current package for installation and move to the next line. +With ARG, prompt for the outputs to install (several outputs may +be separated with \",\")." + (interactive "P") + (guix-package-list-marking-check) + (let* ((entry (guix-list-current-entry)) + (all (guix-entry-value entry 'outputs)) + (installed (guix-package-installed-outputs entry)) + (available (cl-set-difference all installed :test #'string=))) + (or available + (user-error "This package is already installed")) + (guix-package-list-mark-outputs + 'install '("out") + (and arg "Output(s) to install: ") + available))) + +(defun guix-package-list-mark-delete (&optional arg) + "Mark the current package for deletion and move to the next line. +With ARG, prompt for the outputs to delete (several outputs may +be separated with \",\")." + (interactive "P") + (guix-package-list-marking-check) + (let* ((entry (guix-list-current-entry)) + (installed (guix-package-installed-outputs entry))) + (or installed + (user-error "This package is not installed")) + (guix-package-list-mark-outputs + 'delete installed + (and arg "Output(s) to delete: ") + installed))) + +(defun guix-package-list-mark-upgrade (&optional arg) + "Mark the current package for upgrading and move to the next line. +With ARG, prompt for the outputs to upgrade (several outputs may +be separated with \",\")." + (interactive "P") + (guix-package-list-marking-check) + (let* ((entry (guix-list-current-entry)) + (installed (guix-package-installed-outputs entry))) + (or installed + (user-error "This package is not installed")) + (when (or (guix-entry-value entry 'obsolete) + (y-or-n-p "This package is not obsolete. Try to upgrade it anyway? ")) + (guix-package-list-mark-outputs + 'upgrade installed + (and arg "Output(s) to upgrade: ") + installed)))) + +(defun guix-package-mark-upgrades (fun) + "Mark all obsolete packages for upgrading. +Use FUN to perform marking of the current line. FUN should +take an entry as argument." + (guix-package-list-marking-check) + (let ((obsolete (cl-remove-if-not + (lambda (entry) + (guix-entry-value entry 'obsolete)) + (guix-buffer-current-entries)))) + (guix-list-for-each-line + (lambda () + (let* ((id (guix-list-current-id)) + (entry (cl-find-if + (lambda (entry) + (equal id (guix-entry-id entry))) + obsolete))) + (when entry + (funcall fun entry))))))) + +(defun guix-package-list-mark-upgrades () + "Mark all obsolete packages for upgrading." + (interactive) + (guix-package-mark-upgrades + (lambda (entry) + (apply #'guix-list--mark + 'upgrade nil + (guix-package-installed-outputs entry))))) + +(defun guix-package-execute-actions (fun) + "Perform actions on the marked packages. +Use FUN to define actions suitable for `guix-process-package-actions'. +FUN should take action-type as argument." + (let ((actions (delq nil + (mapcar fun '(install delete upgrade))))) + (if actions + (guix-process-package-actions (guix-ui-current-profile) + actions (current-buffer)) + (user-error "No operations specified")))) + +(defun guix-package-list-execute () + "Perform actions on the marked packages." + (interactive) + (guix-package-execute-actions #'guix-package-list-make-action)) + +(defun guix-package-list-make-action (action-type) + "Return action specification for the packages marked with ACTION-TYPE. +Return nil, if there are no packages marked with ACTION-TYPE. +The specification is suitable for `guix-process-package-actions'." + (let ((specs (guix-list-get-marked-args action-type))) + (and specs (cons action-type specs)))) + +(defun guix-package-list-edit () + "Go to the location of the current package." + (interactive) + (guix-edit (guix-list-current-id))) + + +;;; Output 'info' + +(guix-ui-info-define-interface output + :buffer-name "*Guix Package Info*" + :format '((name format (format guix-package-info-name)) + (version format guix-output-info-insert-version) + (output format guix-output-info-insert-output) + (synopsis simple (indent guix-package-info-synopsis)) + (source simple guix-package-info-insert-source) + (path simple (indent guix-file)) + (dependencies simple (indent guix-file)) + (location format (format guix-package-location)) + (home-url format (format guix-url)) + (license format (format guix-package-info-license)) + (inputs format (format guix-package-input)) + (native-inputs format (format guix-package-native-input)) + (propagated-inputs format + (format guix-package-propagated-input)) + (description simple (indent guix-package-info-description))) + :titles guix-package-info-titles + :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." + (guix-info-insert-value-format version + 'guix-package-info-version) + (and (guix-entry-value entry 'obsolete) + (guix-package-info-insert-obsolete-text))) + +(defun guix-output-info-insert-output (output entry) + "Insert OUTPUT and action buttons at point." + (let* ((installed (guix-entry-value entry 'installed)) + (obsolete (guix-entry-value entry 'obsolete)) + (action-type (if installed 'delete 'install))) + (guix-info-insert-value-format + output + (if installed + 'guix-package-info-installed-outputs + 'guix-package-info-uninstalled-outputs)) + (guix-info-insert-indent) + (guix-package-info-insert-action-button action-type entry output) + (when obsolete + (guix-info-insert-indent) + (guix-package-info-insert-action-button 'upgrade entry output)))) + + +;;; Output 'list' + +(guix-ui-list-define-interface output + :buffer-name "*Guix Package List*" + :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 '(id package-id) + :sort-key '(name) + :marks '((install . ?I) + (upgrade . ?U) + (delete . ?D))) + +(let ((map guix-output-list-mode-map)) + (define-key map (kbd "e") 'guix-output-list-edit) + (define-key map (kbd "x") 'guix-output-list-execute) + (define-key map (kbd "i") 'guix-output-list-mark-install) + (define-key map (kbd "d") 'guix-output-list-mark-delete) + (define-key map (kbd "U") 'guix-output-list-mark-upgrade) + (define-key map (kbd "^") 'guix-output-list-mark-upgrades)) + +(defun guix-output-list-mark-install () + "Mark the current output for installation and move to the next line." + (interactive) + (guix-package-list-marking-check) + (let* ((entry (guix-list-current-entry)) + (installed (guix-entry-value entry 'installed))) + (if installed + (user-error "This output is already installed") + (guix-list--mark 'install t)))) + +(defun guix-output-list-mark-delete () + "Mark the current output for deletion and move to the next line." + (interactive) + (guix-package-list-marking-check) + (let* ((entry (guix-list-current-entry)) + (installed (guix-entry-value entry 'installed))) + (if installed + (guix-list--mark 'delete t) + (user-error "This output is not installed")))) + +(defun guix-output-list-mark-upgrade () + "Mark the current output for upgrading and move to the next line." + (interactive) + (guix-package-list-marking-check) + (let* ((entry (guix-list-current-entry)) + (installed (guix-entry-value entry 'installed))) + (or installed + (user-error "This output is not installed")) + (when (or (guix-entry-value entry 'obsolete) + (y-or-n-p "This output is not obsolete. Try to upgrade it anyway? ")) + (guix-list--mark 'upgrade t)))) + +(defun guix-output-list-mark-upgrades () + "Mark all obsolete package outputs for upgrading." + (interactive) + (guix-package-mark-upgrades + (lambda (_) (guix-list--mark 'upgrade)))) + +(defun guix-output-list-execute () + "Perform actions on the marked outputs." + (interactive) + (guix-package-execute-actions #'guix-output-list-make-action)) + +(defun guix-output-list-make-action (action-type) + "Return action specification for the outputs marked with ACTION-TYPE. +Return nil, if there are no outputs marked with ACTION-TYPE. +The specification is suitable for `guix-process-output-actions'." + (let ((ids (guix-list-get-marked-id-list action-type))) + (and ids (cons action-type + (mapcar #'guix-package-id-and-output-by-output-id + ids))))) + +(defun guix-output-list-describe (ids) + "Describe outputs with IDS (list of output identifiers). +See `guix-package-info-type'." + (if (eq guix-package-info-type 'output) + (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))) + (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." + (interactive) + (guix-edit (guix-entry-value (guix-list-current-entry) + 'package-id))) + + +;;; Interactive commands + +(defvar guix-package-search-params '(name synopsis description) + "Default list of package parameters for searching by regexp.") + +(defvar guix-package-search-history nil + "A history of minibuffer prompts.") + +;;;###autoload +(defun guix-search-by-name (name &optional profile) + "Search for Guix packages by NAME. +NAME is a string with name specification. It may optionally contain +a version number. Examples: \"guile\", \"guile-2.0.11\". + +If PROFILE is nil, use `guix-current-profile'. +Interactively with prefix, prompt for PROFILE." + (interactive + (list (read-string "Package name: " nil 'guix-package-search-history) + (and current-prefix-arg + (guix-profile-prompt)))) + (guix-package-get-display profile 'name name)) + +;;;###autoload +(defun guix-search-by-regexp (regexp &optional params profile) + "Search for Guix packages by REGEXP. +PARAMS are package parameters that should be searched. +If PARAMS are not specified, use `guix-package-search-params'. + +If PROFILE is nil, use `guix-current-profile'. +Interactively with prefix, prompt for PROFILE." + (interactive + (list (read-regexp "Regexp: " nil 'guix-package-search-history) + nil + (and current-prefix-arg + (guix-profile-prompt)))) + (guix-package-get-display profile 'regexp regexp + (or params guix-package-search-params))) + +;;;###autoload +(defun guix-installed-packages (&optional profile) + "Display information about installed Guix packages. +If PROFILE is nil, use `guix-current-profile'. +Interactively with prefix, prompt for PROFILE." + (interactive + (list (and current-prefix-arg + (guix-profile-prompt)))) + (guix-package-get-display profile 'installed)) + +;;;###autoload +(defun guix-obsolete-packages (&optional profile) + "Display information about obsolete Guix packages. +If PROFILE is nil, use `guix-current-profile'. +Interactively with prefix, prompt for PROFILE." + (interactive + (list (and current-prefix-arg + (guix-profile-prompt)))) + (guix-package-get-display profile 'obsolete)) + +;;;###autoload +(defun guix-all-available-packages (&optional profile) + "Display information about all available Guix packages. +If PROFILE is nil, use `guix-current-profile'. +Interactively with prefix, prompt for PROFILE." + (interactive + (list (and current-prefix-arg + (guix-profile-prompt)))) + (guix-package-get-display profile 'all-available)) + +;;;###autoload +(defun guix-newest-available-packages (&optional profile) + "Display information about the newest available Guix packages. +If PROFILE is nil, use `guix-current-profile'. +Interactively with prefix, prompt for PROFILE." + (interactive + (list (and current-prefix-arg + (guix-profile-prompt)))) + (guix-package-get-display profile 'newest-available)) + +(provide 'guix-ui-package) + +;;; guix-ui-package.el ends here diff --git a/emacs/guix.el b/emacs/guix.el deleted file mode 100644 index 12dd4a2553..0000000000 --- a/emacs/guix.el +++ /dev/null @@ -1,210 +0,0 @@ -;;; guix.el --- Interface for GNU Guix package manager - -;; Copyright © 2014, 2015 Alex Kost - -;; Package-Requires: ((geiser "0.3")) -;; Keywords: tools - -;; 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 . - -;;; Commentary: - -;; This package provides an interface for searching, listing and getting -;; information about Guix packages and generations; and for -;; installing/upgrading/removing packages. - -;;; Code: - -(require 'guix-base) -(require 'guix-list) -(require 'guix-info) -(require 'guix-utils) -(require 'guix-read) - -(defgroup guix nil - "Interface for Guix package manager." - :prefix "guix-" - :group 'external) - -(defgroup guix-faces nil - "Guix faces." - :group 'guix - :group 'faces) - -(defcustom guix-list-single-package nil - "If non-nil, list a package even if it is the only matching result. -If nil, show a single package in the info buffer." - :type 'boolean - :group 'guix) - -(defvar guix-search-params '(name synopsis description) - "Default list of package parameters for searching by regexp.") - -(defvar guix-search-history nil - "A history of minibuffer prompts.") - -(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-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." - (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 - (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-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) - "Search for Guix packages by NAME. -NAME is a string with name specification. It may optionally contain -a version number. Examples: \"guile\", \"guile-2.0.11\". - -If PROFILE is nil, use `guix-current-profile'. -Interactively with prefix, prompt for PROFILE." - (interactive - (list (read-string "Package name: " nil 'guix-search-history) - (and current-prefix-arg - (guix-profile-prompt)))) - (guix-get-show-packages profile 'name name)) - -;;;###autoload -(defun guix-search-by-regexp (regexp &optional params profile) - "Search for Guix packages by REGEXP. -PARAMS are package parameters that should be searched. -If PARAMS are not specified, use `guix-search-params'. - -If PROFILE is nil, use `guix-current-profile'. -Interactively with prefix, prompt for PROFILE." - (interactive - (list (read-regexp "Regexp: " nil 'guix-search-history) - nil - (and current-prefix-arg - (guix-profile-prompt)))) - (guix-get-show-packages profile 'regexp regexp - (or params guix-search-params))) - -;;;###autoload -(defun guix-installed-packages (&optional profile) - "Display information about installed Guix packages. -If PROFILE is nil, use `guix-current-profile'. -Interactively with prefix, prompt for PROFILE." - (interactive - (list (and current-prefix-arg - (guix-profile-prompt)))) - (guix-get-show-packages profile 'installed)) - -;;;###autoload -(defun guix-obsolete-packages (&optional profile) - "Display information about obsolete Guix packages. -If PROFILE is nil, use `guix-current-profile'. -Interactively with prefix, prompt for PROFILE." - (interactive - (list (and current-prefix-arg - (guix-profile-prompt)))) - (guix-get-show-packages profile 'obsolete)) - -;;;###autoload -(defun guix-all-available-packages (&optional profile) - "Display information about all available Guix packages. -If PROFILE is nil, use `guix-current-profile'. -Interactively with prefix, prompt for PROFILE." - (interactive - (list (and current-prefix-arg - (guix-profile-prompt)))) - (guix-get-show-packages profile 'all-available)) - -;;;###autoload -(defun guix-newest-available-packages (&optional profile) - "Display information about the newest available Guix packages. -If PROFILE is nil, use `guix-current-profile'. -Interactively with prefix, prompt for PROFILE." - (interactive - (list (and current-prefix-arg - (guix-profile-prompt)))) - (guix-get-show-packages profile 'newest-available)) - -;;;###autoload -(defun guix-generations (&optional profile) - "Display information about all generations. -If PROFILE is nil, use `guix-current-profile'. -Interactively with prefix, prompt for PROFILE." - (interactive - (list (and current-prefix-arg - (guix-profile-prompt)))) - (guix-get-show-generations profile 'all)) - -;;;###autoload -(defun guix-last-generations (number &optional profile) - "Display information about last NUMBER generations. -If PROFILE is nil, use `guix-current-profile'. -Interactively with prefix, prompt for PROFILE." - (interactive - (list (read-number "The number of last generations: ") - (and current-prefix-arg - (guix-profile-prompt)))) - (guix-get-show-generations profile 'last number)) - -;;;###autoload -(defun guix-generations-by-time (from to &optional profile) - "Display information about generations created between FROM and TO. -FROM and TO should be time values. -If PROFILE is nil, use `guix-current-profile'. -Interactively with prefix, prompt for PROFILE." - (interactive - (list (guix-read-date "Find generations (from): ") - (guix-read-date "Find generations (to): ") - (and current-prefix-arg - (guix-profile-prompt)))) - (guix-get-show-generations profile 'time - (float-time from) - (float-time to))) - -;;;###autoload -(defun guix-edit (id-or-name) - "Edit (go to location of) package with ID-OR-NAME." - (interactive (list (guix-read-package-name))) - (let ((loc (guix-package-location id-or-name))) - (if loc - (guix-find-location loc) - (message "Couldn't find package location.")))) - -(provide 'guix) - -;;; guix.el ends here -- cgit v1.2.3