aboutsummaryrefslogtreecommitdiff
path: root/emacs/guix-base.el
diff options
context:
space:
mode:
Diffstat (limited to 'emacs/guix-base.el')
-rw-r--r--emacs/guix-base.el179
1 files changed, 125 insertions, 54 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)