diff options
Diffstat (limited to 'emacs')
| -rw-r--r-- | emacs/guix-base.el | 179 | ||||
| -rw-r--r-- | emacs/guix-info.el | 13 | ||||
| -rw-r--r-- | emacs/guix-list.el | 14 | ||||
| -rw-r--r-- | emacs/guix.el | 141 |
4 files changed, 234 insertions, 113 deletions
diff --git a/emacs/guix-base.el b/emacs/guix-base.el index e9c1e00245..ed8b554866 100644 --- a/emacs/guix-base.el +++ b/emacs/guix-base.el @@ -48,6 +48,18 @@ (defvar guix-current-profile guix-default-profile "Current profile.") +(defun guix-profile-prompt (&optional default) + "Prompt for profile and return it. +Use DEFAULT as a start directory. If it is nil, use +`guix-current-profile'." + (let* ((path (read-file-name "Profile: " + (file-name-directory + (or default guix-current-profile)))) + (path (directory-file-name (expand-file-name path)))) + (if (string= path guix-user-profile) + guix-default-profile + path))) + (defun guix-set-current-profile (path) "Set `guix-current-profile' to PATH. Interactively, prompt for PATH. With prefix, use @@ -55,15 +67,10 @@ Interactively, prompt for PATH. With prefix, use (interactive (list (if current-prefix-arg guix-default-profile - (read-file-name "Set profile: " - (file-name-directory guix-current-profile))))) - (let ((path (directory-file-name (expand-file-name path)))) - (setq guix-current-profile - (if (string= path guix-user-profile) - guix-default-profile - path)) - (message "Current profile has been set to '%s'." - guix-current-profile))) + (guix-profile-prompt)))) + (setq guix-current-profile path) + (message "Current profile has been set to '%s'." + guix-current-profile)) ;;; Parameters of the entries @@ -209,6 +216,56 @@ If `all', update all Guix buffers (not recommended)." (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))) + (defun guix-switch-to-buffer (buffer) "Switch to a 'list' or 'info' BUFFER." (pop-to-buffer buffer @@ -246,6 +303,10 @@ See `guix-update-after-operation' for details." ;;; Common definitions for buffer types +(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 @@ -273,13 +334,16 @@ VAL is a value of this parameter.") "Values of the current search.") (put 'guix-search-vals 'permanent-local t) -(defsubst guix-set-vars (entries buffer-type entry-type +(defsubst guix-set-vars (profile entries buffer-type entry-type search-type search-vals) - (setq guix-entries entries - guix-buffer-type buffer-type - guix-entry-type entry-type - guix-search-type search-type - guix-search-vals search-vals)) + "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-" @@ -416,7 +480,7 @@ information)." (const :tag "Display outputs" output)) :group 'guix) -(defun guix-get-entries (entry-type search-type search-vals +(defun guix-get-entries (profile entry-type search-type search-vals &optional params) "Search for entries of ENTRY-TYPE. @@ -432,26 +496,25 @@ SEARCH-TYPE may be one of the following symbols: `all-available', `newest-available', `installed', `obsolete', `generation'. -- If ENTRY-TYPE is `generation': `id', `last', `all'. +- 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 - guix-current-profile params - entry-type search-type search-vals))) + profile params entry-type search-type search-vals))) -(defun guix-get-show-entries (buffer-type entry-type search-type - &rest 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 entry-type search-type 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 entries buffer-type entry-type + (guix-set-buffer profile entries buffer-type entry-type search-type search-vals))) -(defun guix-set-buffer (entries buffer-type entry-type search-type +(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. @@ -465,16 +528,16 @@ otherwise add the new one. If NO-DISPLAY is non-nil, do not switch to the buffer." (when entries - (let ((buf (if (eq major-mode (guix-get-symbol - "mode" buffer-type entry-type)) + (let ((buf (if (and (eq major-mode + (guix-get-symbol "mode" buffer-type entry-type)) + (equal guix-profile profile)) (current-buffer) (get-buffer-create - (symbol-value - (guix-get-symbol "buffer-name" - buffer-type entry-type)))))) + (guix-buffer-name profile buffer-type + entry-type search-type))))) (with-current-buffer buf (guix-show-entries entries buffer-type entry-type) - (guix-set-vars 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 @@ -494,18 +557,18 @@ If NO-DISPLAY is non-nil, do not switch to the buffer." entries entry-type) (goto-char (point-min)))) -(defun guix-history-call (entries buffer-type entry-type +(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 entries buffer-type entry-type + (guix-set-vars profile entries buffer-type entry-type search-type search-vals) (guix-result-message entries entry-type search-type search-vals)) (defun guix-make-history-item () "Make and return a history item for the current buffer." (list #'guix-history-call - guix-entries guix-buffer-type guix-entry-type + guix-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) @@ -529,10 +592,11 @@ See `revert-buffer' for the meaning of NOCONFIRM." guix-buffer-type guix-entry-type)) (y-or-n-p "Update current information? ")) (let ((entries (guix-get-entries - guix-entry-type guix-search-type guix-search-vals + guix-profile guix-entry-type + guix-search-type guix-search-vals (guix-get-params-for-receiving guix-buffer-type guix-entry-type)))) - (guix-set-buffer entries guix-buffer-type guix-entry-type + (guix-set-buffer guix-profile entries guix-buffer-type guix-entry-type guix-search-type guix-search-vals t t)))) (defun guix-redisplay-buffer () @@ -719,8 +783,9 @@ VARIABLE is a name of an option variable.") guix-operation-option-true-string guix-operation-option-false-string)) -(defun guix-process-package-actions (actions &optional operation-buffer) - "Process 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 ...) @@ -738,23 +803,25 @@ PACKAGE-SPEC should have the following form: (ID [OUTPUT] ...)." ((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 guix-current-profile + '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 (&key install upgrade remove) +(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-get-entries - 'package 'id + profile 'package 'id (append (mapcar #'car install) (mapcar #'car upgrade) (mapcar #'car remove)) @@ -768,6 +835,7 @@ See `guix-process-package-actions' for details." (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") @@ -861,29 +929,32 @@ Return non-nil, if the operation should be continued; nil otherwise." guix-operation-option-separator))) (force-mode-line-update)) -(defun guix-delete-generations (generations &optional operation-buffer) - "Delete GENERATIONS. +(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? " count) - (format "Delete generation number %d? " - (car generations)))))) + (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* guix-current-profile generations) + 'delete-generations* profile generations) operation-buffer))) -(defun guix-switch-to-generation (generation &optional operation-buffer) - "Switch `guix-current-profile' to GENERATION number." +(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 current profile to generation %d? " - generation))) + (y-or-n-p (format "Switch profile '%s' to generation %d? " + profile generation))) (guix-eval-in-repl (guix-make-guile-expression - 'switch-to-generation guix-current-profile generation) + 'switch-to-generation profile generation) operation-buffer))) (provide 'guix-base) diff --git a/emacs/guix-info.el b/emacs/guix-info.el index dcd2ce2932..551d79a293 100644 --- a/emacs/guix-info.el +++ b/emacs/guix-info.el @@ -334,8 +334,8 @@ VAL is a list, call the function on each element of this list." 'face 'guix-package-info-name-button 'help-echo "Describe this package" 'action (lambda (btn) - (guix-get-show-entries 'info guix-package-info-type 'name - (button-label btn)))) + (guix-get-show-entries guix-profile 'info guix-package-info-type + 'name (button-label btn)))) (defun guix-info-insert-action-button (label action &optional message &rest properties) @@ -558,6 +558,7 @@ ENTRY is an alist with package info." type-str (lambda (btn) (guix-process-package-actions + guix-profile `((,(button-get btn 'action-type) (,(button-get btn 'id) ,(button-get btn 'output)))) (current-buffer))) @@ -631,15 +632,15 @@ ENTRY is an alist with package info." (guix-info-insert-action-button "Packages" (lambda (btn) - (guix-get-show-entries 'list guix-package-list-type 'generation - (button-get btn 'number))) + (guix-get-show-entries guix-profile 'list guix-package-list-type + 'generation (button-get btn 'number))) "Show installed packages for this generation" 'number number) (guix-info-insert-indent) (guix-info-insert-action-button "Delete" (lambda (btn) - (guix-delete-generations (list (button-get btn 'number)) + (guix-delete-generations guix-profile (list (button-get btn 'number)) (current-buffer))) "Delete this generation" 'number number)) @@ -653,7 +654,7 @@ ENTRY is an alist with package info." (guix-info-insert-action-button "Switch" (lambda (btn) - (guix-switch-to-generation (button-get btn 'number) + (guix-switch-to-generation guix-profile (button-get btn 'number) (current-buffer))) "Switch to this generation (make it the current one)" 'number (guix-get-key-val entry 'number)))) diff --git a/emacs/guix-list.el b/emacs/guix-list.el index 4d3c21cbe7..58c03b37a9 100644 --- a/emacs/guix-list.el +++ b/emacs/guix-list.el @@ -441,7 +441,8 @@ This macro defines the following functions: (when (or (<= count guix-list-describe-warning-count) (y-or-n-p (format "Do you really want to describe %d entries? " count))) - (apply #'guix-get-show-entries 'info entry-type 'id ids)))) + (apply #'guix-get-show-entries + guix-profile 'info entry-type 'id ids)))) (defun guix-list-describe (&optional arg) "Describe entries marked with a general mark. @@ -617,7 +618,8 @@ FUN should accept action-type as argument." (let ((actions (delq nil (mapcar fun '(install delete upgrade))))) (if actions - (guix-process-package-actions actions (current-buffer)) + (guix-process-package-actions + guix-profile actions (current-buffer)) (user-error "No operations specified")))) (defun guix-package-list-execute () @@ -751,13 +753,13 @@ VAL is a boolean value." (number (guix-get-key-val entry 'number))) (if current (user-error "This generation is already the current one") - (guix-switch-to-generation number (current-buffer))))) + (guix-switch-to-generation guix-profile number (current-buffer))))) (defun guix-generation-list-show-packages () "List installed packages for the generation at point." (interactive) - (guix-get-show-entries 'list guix-package-list-type 'generation - (guix-list-current-id))) + (guix-get-show-entries guix-profile 'list guix-package-list-type + 'generation (guix-list-current-id))) (defun guix-generation-list-mark-delete (&optional arg) "Mark the current generation for deletion and move to the next line. @@ -773,7 +775,7 @@ 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 marked (current-buffer)))) + (guix-delete-generations guix-profile marked (current-buffer)))) (provide 'guix-list) diff --git a/emacs/guix.el b/emacs/guix.el index b91a88dc14..afe7285696 100644 --- a/emacs/guix.el +++ b/emacs/guix.el @@ -50,99 +50,146 @@ 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 (search-type &rest search-vals) +(defun guix-get-show-packages (profile search-type &rest search-vals) "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. Results are displayed in the list buffer, unless a single package is found and `guix-list-single-package' is nil." - (let ((packages (guix-get-entries guix-package-list-type + (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)))) (if (or guix-list-single-package (cdr packages)) - (guix-set-buffer packages 'list guix-package-list-type + (guix-set-buffer profile packages 'list guix-package-list-type search-type search-vals) - (let ((packages (guix-get-entries guix-package-info-type + (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 packages 'info guix-package-info-type + (guix-set-buffer profile packages 'info guix-package-info-type search-type search-vals))))) -(defun guix-get-show-generations (search-type &rest search-vals) - "Search for generations and show results." +(defun guix-get-show-generations (profile search-type &rest search-vals) + "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)) ;;;###autoload -(defun guix-search-by-name (name) +(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\"." +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))) - (guix-get-show-packages 'name name)) + (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 &rest params) +(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 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 (read-string "Regexp: " nil 'guix-search-history))) - (or params (setq params guix-search-params)) - (guix-get-show-packages 'regexp regexp params)) + (list (and current-prefix-arg + (guix-profile-prompt)))) + (guix-get-show-packages profile 'installed)) ;;;###autoload -(defun guix-installed-packages () - "Display information about installed Guix packages." - (interactive) - (guix-get-show-packages 'installed)) +(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-obsolete-packages () - "Display information about obsolete Guix packages." - (interactive) - (guix-get-show-packages 'obsolete)) +(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-all-available-packages () - "Display information about all available Guix packages." - (interactive) - (guix-get-show-packages 'all-available)) +(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-newest-available-packages () - "Display information about the newest available Guix packages." - (interactive) - (guix-get-show-packages 'newest-available)) +(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-generations (&optional number) +(defun guix-last-generations (number &optional profile) "Display information about last NUMBER generations. -If NUMBER is nil, display all generations. - -Generations can be displayed in a list or info buffers depending -on `guix-show-generations-function'. - -Interactively, NUMBER is defined by a numeric prefix." - (interactive "P") - (if (numberp number) - (guix-get-show-generations 'last number) - (guix-get-show-generations 'all))) +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) +(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." +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): "))) - (guix-get-show-generations 'time + (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))) |