-;;; guix-base.el --- Common definitions
+;;; guix-base.el --- Common definitions -*- lexical-binding: t -*-
;; Copyright © 2014 Alex Kost <alezost@gmail.com>
;;; Code:
(require 'cl-lib)
+(require 'guix-profiles)
(require 'guix-backend)
(require 'guix-utils)
-
-\f
-;;; Profiles
-
-(defvar guix-user-profile
- (expand-file-name "~/.guix-profile")
- "User profile.")
-
-(defvar guix-default-profile
- (concat (or (getenv "NIX_STATE_DIR") "/var/guix")
- "/profiles/per-user/"
- (getenv "USER")
- "/guix-profile")
- "Default Guix profile.")
-
-(defvar guix-current-profile guix-default-profile
- "Current profile.")
-
-(defun guix-set-current-profile (path)
- "Set `guix-current-profile' to PATH.
-Interactively, prompt for PATH. With prefix, use
-`guix-default-profile'."
- (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)))
+(require 'guix-history)
+(require 'guix-messages)
\f
;;; Parameters of the entries
(id . "ID")
(name . "Name")
(version . "Version")
+ (source . "Source")
(license . "License")
(synopsis . "Synopsis")
(description . "Description")
(path . "Installed path")
(dependencies . "Dependencies")
(output . "Output"))
+ (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"))
(generation
(id . "ID")
(number . "Number")
(prev-number . "Previous number")
+ (current . "Current")
(path . "Path")
(time . "Time")))
"List for defining titles of entry parameters.
(guix-get-key-val entry 'version)
output))
+(defun guix-entry-to-specification (entry)
+ "Return name specification by the package or output ENTRY."
+ (guix-get-name-spec (guix-get-key-val entry 'name)
+ (guix-get-key-val entry 'version)
+ (guix-get-key-val entry 'output)))
+
+(defun guix-entries-to-specifications (entries)
+ "Return name specifications by the package or output ENTRIES."
+ (cl-remove-duplicates (mapcar #'guix-entry-to-specification entries)
+ :test #'string=))
+
(defun guix-get-installed-outputs (entry)
"Return list of installed outputs for the package ENTRY."
(mapcar (lambda (installed-entry)
(equal id (guix-get-key-val entry 'id)))
entries))
+(defun guix-get-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))))
+
\f
;;; Location of the packages
(recenter 1))))
\f
+;;; 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)))
+
+(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))))
+
+(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-revert-buffer 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)
+
+\f
;;; 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
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)
"Values of the current search.")
(put 'guix-search-vals 'permanent-local t)
-(defsubst guix-set-vars (entries search-type search-vals)
- (setq guix-entries entries
- guix-search-type search-type
- guix-search-vals search-vals))
+(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-define-buffer-type (buf-type entry-type &rest args)
- "Define common stuff for BUF-TYPE buffers for displaying entries.
-
-ENTRY-TYPE is a type of displayed entries (see
-`guix-get-entries').
+ "Define common for BUF-TYPE buffers for displaying ENTRY-TYPE entries.
In the text below TYPE means ENTRY-TYPE-BUF-TYPE.
-This macro defines `guix-TYPE-mode', a custom group, several user
-variables and the following functions:
-
- - `guix-TYPE-get-params-for-receiving'
- - `guix-TYPE-revert'
- - `guix-TYPE-redisplay'
- - `guix-TYPE-make-history-item'
- - `guix-TYPE-set'
- - `guix-TYPE-show'
- - `guix-TYPE-get-show'
+This macro defines `guix-TYPE-mode', a custom group and several
+user variables.
The following stuff should be defined outside this macro:
- `guix-BUF-TYPE-mode' - parent mode for the defined mode.
- - `guix-BUF-TYPE-insert-entries' - function for inserting
- entries in the current buffer; it is called with 2 arguments:
- entries of the form of `guix-entries' and ENTRY-TYPE.
-
- - `guix-BUF-TYPE-get-displayed-params' - function returning a
- list of parameters displayed in the current buffer; it is
- called with ENTRY-TYPE as argument.
-
- `guix-TYPE-mode-initialize' (optional) - function for
additional mode settings; it is called without arguments.
Remaining argument (ARGS) should have a form [KEYWORD VALUE] ... The
following keywords are available:
+ - `:buffer-name' - default value for the defined
+ `guix-TYPE-buffer-name' variable.
+
- `:required' - default value for the defined
`guix-TYPE-required-params' variable.
(mode-init-fun (intern (concat prefix "-mode-initialize")))
(buf-name-var (intern (concat prefix "-buffer-name")))
(revert-var (intern (concat prefix "-revert-no-confirm")))
- (revert-fun (intern (concat prefix "-revert")))
- (redisplay-fun (intern (concat prefix "-redisplay")))
(history-var (intern (concat prefix "-history-size")))
- (history-fun (intern (concat prefix "-make-history-item")))
(params-var (intern (concat prefix "-required-params")))
- (params-fun (intern (concat prefix "-get-params-for-receiving")))
- (set-fun (intern (concat prefix "-set")))
- (show-fun (intern (concat prefix "-show")))
- (get-show-fun (intern (concat prefix "-get-show")))
+ (buf-name-val (format "*Guix %s %s*" Entry-type-str Buf-type-str))
(revert-val nil)
(history-val 20)
(params-val '(id)))
(`: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
:prefix ,(concat prefix "-")
:group ',(intern (concat "guix-" buf-type-str)))
- (defcustom ,buf-name-var ,(format "*Guix %s %s*"
- Entry-type-str Buf-type-str)
+ (defcustom ,buf-name-var ,buf-name-val
,(concat "Default name of the " buf-str " for displaying " entry-str ".")
:type 'string
:group ',group)
(define-derived-mode ,mode ,parent-mode ,(concat "Guix-" Buf-type-str)
,(concat "Major mode for displaying information about " entry-str ".\n\n"
"\\{" mode-map-str "}")
- (setq-local revert-buffer-function ',revert-fun)
+ (setq-local revert-buffer-function 'guix-revert-buffer)
(setq-local guix-history-size ,history-var)
(and (fboundp ',mode-init-fun) (,mode-init-fun)))
(define-key map (kbd "l") 'guix-history-back)
(define-key map (kbd "r") 'guix-history-forward)
(define-key map (kbd "g") 'revert-buffer)
- (define-key map (kbd "R") ',redisplay-fun)
- (define-key map (kbd "C-c C-z") 'guix-switch-to-repl))
-
- (defun ,params-fun ()
- ,(concat "Return " entry-type-str " parameters that should be received.")
- (unless (equal ,params-var 'all)
- (cl-union ,params-var
- (,(intern (concat "guix-" buf-type-str "-get-displayed-params"))
- ',entry-type))))
-
- (defun ,revert-fun (_ignore-auto noconfirm)
- "Update information in the current buffer.
-The function is suitable for `revert-buffer-function'.
-See `revert-buffer' for the meaning of NOCONFIRM."
- (when (or ,revert-var
- noconfirm
- (y-or-n-p "Update current information? "))
- (let ((entries (guix-get-entries ',entry-type guix-search-type
- guix-search-vals (,params-fun))))
- (,set-fun entries guix-search-type guix-search-vals t))))
-
- (defun ,redisplay-fun ()
- "Redisplay current information.
-This function will not update the information, use
-\"\\[revert-buffer]\" if you want the full update."
- (interactive)
- (,show-fun guix-entries)
- (guix-result-message guix-entries ',entry-type
- guix-search-type guix-search-vals))
-
- (defun ,history-fun ()
- "Make and return a history item for the current buffer."
- (list (lambda (entries search-type search-vals)
- (,show-fun entries)
- (guix-set-vars entries search-type search-vals)
- (guix-result-message entries ',entry-type
- search-type search-vals))
- guix-entries guix-search-type guix-search-vals))
-
- (defun ,set-fun (entries search-type search-vals &optional history-replace)
- ,(concat "Set up the " buf-str " for displaying " entry-str ".\n\n"
- "Display ENTRIES, set variables and make history item.\n\n"
- "ENTRIES should have a form of `guix-entries'.\n\n"
- "See `guix-get-entries' for the meaning of SEARCH-TYPE and\n"
- "SEARCH-VALS.\n\n"
- "If HISTORY-REPLACE is non-nil, replace current history item,\n"
- "otherwise add the new one.")
- (when entries
- (let ((buf (if (eq major-mode ',mode)
- (current-buffer)
- (get-buffer-create ,buf-name-var))))
- (with-current-buffer buf
- (,show-fun entries)
- (guix-set-vars entries search-type search-vals)
- (funcall (if history-replace
- #'guix-history-replace
- #'guix-history-add)
- (,history-fun)))
- (pop-to-buffer buf
- '((display-buffer-reuse-window
- display-buffer-same-window)))))
- (guix-result-message entries ',entry-type
- search-type search-vals))
-
- (defun ,show-fun (entries)
- ,(concat "Display " entry-type-str " ENTRIES in the current " buf-str ".")
- (let ((inhibit-read-only t))
- (erase-buffer)
- (,mode)
- (,(intern (concat "guix-" buf-type-str "-insert-entries"))
- entries ',entry-type)
- (goto-char (point-min))))
-
- (defun ,get-show-fun (search-type &rest search-vals)
- ,(concat "Search for " entry-str " and show results in the " buf-str ".\n"
- "See `guix-get-entries' for the meaning of SEARCH-TYPE and\n"
- "SEARCH-VALS.")
- (let ((entries (guix-get-entries ',entry-type search-type
- search-vals (,params-fun))))
- (,set-fun entries search-type search-vals))))))
+ (define-key map (kbd "R") 'guix-redisplay-buffer)
+ (define-key map (kbd "C-c C-z") 'guix-switch-to-repl)))))
(put 'guix-define-buffer-type 'lisp-indent-function 'defun)
\f
-;;; Messages
-
-(defvar guix-messages
- '((package
- (id
- (0 "Packages not found.")
- (1 "")
- (many "%d packages." count))
- (name
- (0 "The package '%s' not found." val)
- (1 "A single package with name '%s'." val)
- (many "%d packages with '%s' name." count val))
- (regexp
- (0 "No packages matching '%s'." val)
- (1 "A single package matching '%s'." val)
- (many "%d packages matching '%s'." count val))
- (all-available
- (0 "No packages are available for some reason.")
- (1 "A single available package (that's strange).")
- (many "%d available packages." count))
- (newest-available
- (0 "No packages are available for some reason.")
- (1 "A single newest available package (that's strange).")
- (many "%d newest available packages." count))
- (installed
- (0 "No installed packages.")
- (1 "A single installed package.")
- (many "%d installed packages." count))
- (obsolete
- (0 "No obsolete packages.")
- (1 "A single obsolete package.")
- (many "%d obsolete packages." count))
- (generation
- (0 "No packages installed in generation %d." val)
- (1 "A single package installed in generation %d." val)
- (many "%d packages installed in generation %d." count val)))
- (generation
- (id
- (0 "Generations not found.")
- (1 "")
- (many "%d generations." count))
- (last
- (0 "No available generations.")
- (1 "The last generation.")
- (many "%d last generations." count))
- (all
- (0 "No available generations.")
- (1 "A single available generation.")
- (many "%d available generations." count)))))
-
-(defun guix-result-message (entries entry-type search-type search-vals)
- "Display an appropriate message after displaying ENTRIES."
- (let* ((val (car search-vals))
- (count (length entries))
- (count-key (if (> count 1) 'many count))
- (msg-spec (guix-get-key-val guix-messages
- entry-type search-type count-key))
- (format (car msg-spec))
- (args (cdr msg-spec)))
- (mapc (lambda (subst)
- (setq args (cl-substitute (car subst) (cdr subst) args)))
- (list (cons count 'count)
- (cons val 'val)))
- (apply #'message format args)))
+;;; 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)
-\f
-;;; Getting info about packages and generations
+(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)
-(defun guix-get-entries (entry-type search-type search-vals &optional params)
+(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' or
-`generation'.
+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': `id', `name', `regexp',
+- 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'.
+- 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
- 'get-entries
- guix-current-profile params
- entry-type search-type search-vals)))
+ '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 profile buffer-type
+ entry-type search-type)))))
+ (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 "get-displayed-params"
+ buffer-type)
+ entry-type)))))
+
+(defun guix-revert-buffer (_ignore-auto noconfirm)
+ "Update information in the current buffer.
+The function is suitable for `revert-buffer-function'.
+See `revert-buffer' for the meaning of NOCONFIRM."
+ (when (or noconfirm
+ (symbol-value
+ (guix-get-symbol "revert-no-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
+ 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-entries-to-specifications
+ guix-entries))
+ (guix-get-entries
+ guix-profile guix-entry-type
+ search-type search-vals params))
+ entries)))
+ (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.
+
+This function will not update the information, use
+\"\\[revert-buffer]\" if you want the full update.
+
+If BUFFER is nil, use the current buffer. For the meaning of the
+rest arguments, see `guix-set-buffer'."
+ (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)))))
+
+\f
+;;; 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))
+
+(defun guix-manifest-file (profile &optional generation)
+ "Return the file name of a PROFILE's manifest.
+If GENERATION number is specified, return manifest file name for
+this generation."
+ (expand-file-name "manifest"
+ (if 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 `guix-profile' profile."
+ (guix-manifest-file guix-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))
\f
;;; Actions on packages and generations
+(defface guix-operation-option-key
+ '((t :inherit font-lock-warning-face))
+ "Face used for the keys of operation options."
+ :group 'guix)
+
(defcustom guix-operation-confirm t
"If nil, do not prompt to confirm an operation."
:type 'boolean
(defvar guix-temp-buffer-name " *Guix temp*"
"Name of a buffer used for displaying info before executing operation.")
-(defun guix-process-package-actions (&rest actions)
- "Process package ACTIONS.
+(defvar guix-operation-option-true-string "yes"
+ "String displayed in the mode-line when operation option is t.")
+
+(defvar guix-operation-option-false-string "no "
+ "String displayed in the mode-line when operation option is nil.")
+
+(defvar guix-operation-option-separator " | "
+ "String used in the mode-line to separate operation options.")
+
+(defvar guix-operation-options
+ '((?s "substitutes" guix-use-substitutes)
+ (?d "dry-run" guix-dry-run))
+ "List of available operation options.
+Each element of the list has a form:
+
+ (KEY NAME VARIABLE)
+
+KEY is a character that may be pressed during confirmation to
+toggle the option.
+NAME is a string displayed in the mode-line.
+VARIABLE is a name of an option variable.")
+
+(defun guix-operation-option-by-key (key)
+ "Return operation option by KEY (character)."
+ (assq key guix-operation-options))
+
+(defun guix-operation-option-key (option)
+ "Return key (character) of the operation OPTION."
+ (car option))
+
+(defun guix-operation-option-name (option)
+ "Return name of the operation OPTION."
+ (nth 1 option))
+
+(defun guix-operation-option-variable (option)
+ "Return name of the variable of the operation OPTION."
+ (nth 2 option))
+
+(defun guix-operation-option-value (option)
+ "Return boolean value of the operation OPTION."
+ (symbol-value (guix-operation-option-variable option)))
+
+(defun guix-operation-option-string-value (option)
+ "Convert boolean value of the operation OPTION to string and return it."
+ (if (guix-operation-option-value option)
+ 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 ...)
((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))))))
+ :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
- (list (append (mapcar #'car install)
- (mapcar #'car upgrade)
- (mapcar #'car remove)))
+ 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))
(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")
'((display-buffer-reuse-window
display-buffer-at-bottom)
(window-height . fit-window-to-buffer)))))
- (prog1 (y-or-n-p "Continue operation? ")
+ (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-insert-package-strings (strings action)
"Insert information STRINGS at point for performing package ACTION."
(when strings
- (insert "Package(s) to " (guix-get-string action 'bold) ":\n")
+ (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.
+Ask a user with PROMPT for continuing an operation."
+ (let* ((option-keys (mapcar #'guix-operation-option-key
+ guix-operation-options))
+ (keys (append '(?y ?n) option-keys))
+ (prompt (concat (propertize (or prompt "Continue operation?")
+ 'face 'minibuffer-prompt)
+ " ("
+ (mapconcat
+ (lambda (key)
+ (propertize (string key)
+ 'face 'guix-operation-option-key))
+ keys
+ ", ")
+ ") ")))
+ (let ((mode-line mode-line-format))
+ (prog1 (guix-operation-prompt-1 prompt keys)
+ (setq mode-line-format mode-line)
+ ;; Clear the minibuffer after prompting.
+ (message "")))))
+
+(defun guix-operation-prompt-1 (prompt keys)
+ "This function is internal for `guix-operation-prompt'."
+ (guix-operation-set-mode-line)
+ (let ((key (read-char-choice prompt (cons ?\C-g keys) t)))
+ (cl-case key
+ (?y t)
+ ((?n ?\C-g) nil)
+ (t (let* ((option (guix-operation-option-by-key key))
+ (var (guix-operation-option-variable option)))
+ (set var (not (symbol-value var)))
+ (guix-operation-prompt-1 prompt keys))))))
+
+(defun guix-operation-set-mode-line ()
+ "Display operation options in the mode-line of the current buffer."
+ (setq mode-line-format
+ (concat (propertize " Options: "
+ 'face 'mode-line-buffer-id)
+ (mapconcat
+ (lambda (option)
+ (let ((key (guix-operation-option-key option))
+ (name (guix-operation-option-name option))
+ (val (guix-operation-option-string-value option)))
+ (concat name
+ " ("
+ (propertize (string key)
+ 'face 'guix-operation-option-key)
+ "): " val)))
+ guix-operation-options
+ 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 ...")
+ (guix-eval-read
+ (guix-make-guile-expression
+ 'package-source-path package-id)))
+
+(defvar guix-after-source-download-hook nil
+ "Hook run after successful performing a 'source-download' operation.")
+
+(defun guix-package-source-build-derivation (package-id &optional prompt)
+ "Build source derivation of a package PACKAGE-ID.
+Ask a user with PROMPT for continuing an operation."
+ (when (or (not guix-operation-confirm)
+ (guix-operation-prompt (or prompt
+ "Build the source derivation?")))
+ (guix-eval-in-repl
+ (guix-make-guile-expression
+ 'package-source-build-derivation
+ package-id
+ :use-substitutes? (or guix-use-substitutes 'f)
+ :dry-run? (or guix-dry-run 'f))
+ nil 'source-download)))
+
+\f
+;;; Pull
+
+(defcustom guix-update-after-pull t
+ "If non-nil, update Guix buffers after performing \\[guix-pull]."
+ :type 'boolean
+ :group 'guix)
+
+(defvar guix-after-pull-hook
+ '(guix-restart-repl-after-pull guix-update-buffers-maybe-after-pull)
+ "Hook run after successful performing `guix-pull' operation.")
+
+(defun guix-restart-repl-after-pull ()
+ "Restart Guix REPL after `guix-pull' operation."
+ (guix-repl-exit)
+ (guix-start-process-maybe
+ "Restarting Guix REPL after pull operation ..."))
+
+(defun guix-update-buffers-maybe-after-pull ()
+ "Update buffers depending on `guix-update-after-pull'."
+ (when guix-update-after-pull
+ (mapc #'guix-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)))
+ (message "Guix buffers have been updated.")))
+
+;;;###autoload
+(defun guix-pull (&optional verbose)
+ "Run Guix pull operation.
+If VERBOSE is non-nil (with prefix argument), produce verbose output."
+ (interactive)
+ (let ((args (and verbose '("--verbose"))))
+ (guix-eval-in-repl
+ (apply #'guix-make-guile-expression 'guix-pull args)
+ nil 'pull)))
+
(provide 'guix-base)
;;; guix-base.el ends here
HCoop / jackhill / guix / guix.git / blobdiff