;;; Code:
(require 'cl-lib)
+(require 'guix-profiles)
(require 'guix-backend)
(require 'guix-utils)
(require 'guix-history)
(require 'guix-messages)
\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-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
-`guix-default-profile'."
- (interactive
- (list (if current-prefix-arg
- guix-default-profile
- (guix-profile-prompt))))
- (setq guix-current-profile path)
- (message "Current profile has been set to '%s'."
- guix-current-profile))
-
-\f
;;; Parameters of the entries
(defvar guix-param-titles
(id . "ID")
(name . "Name")
(version . "Version")
+ (source . "Source")
(license . "License")
(synopsis . "Synopsis")
(description . "Description")
(id . "ID")
(name . "Name")
(version . "Version")
+ (source . "Source")
(license . "License")
(synopsis . "Synopsis")
(description . "Description")
(guix-set-buffer guix-profile entries guix-buffer-type guix-entry-type
search-type search-vals t t))))
-(defun guix-redisplay-buffer ()
- "Redisplay current information.
+(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."
+\"\\[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)
- (guix-show-entries guix-entries guix-buffer-type guix-entry-type)
- (guix-result-message guix-profile guix-entries guix-entry-type
- guix-search-type guix-search-vals))
+ (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
strings)
(insert "\n")))
-(defun guix-operation-prompt ()
- "Prompt a user for continuing the current package operation.
-Return non-nil, if the operation should be continued; nil otherwise."
+(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 "Continue operation?"
+ (prompt (concat (propertize (or prompt "Continue operation?")
'face 'minibuffer-prompt)
" ("
(mapconcat
keys
", ")
") ")))
- (prog1 (guix-operation-prompt-1 prompt keys)
- ;; Clear the minibuffer after prompting.
- (message ""))))
+ (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'."
'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
HCoop / jackhill / guix / guix.git / blobdiff