diff options
Diffstat (limited to 'emacs')
| -rw-r--r-- | emacs/guix-base.el | 25 | ||||
| -rw-r--r-- | emacs/guix-main.scm | 77 | ||||
| -rw-r--r-- | emacs/guix-messages.el | 42 | ||||
| -rw-r--r-- | emacs/guix-profiles.el | 7 | ||||
| -rw-r--r-- | emacs/guix-ui-generation.el | 62 | ||||
| -rw-r--r-- | emacs/guix-ui-package.el | 24 | ||||
| -rw-r--r-- | emacs/guix-ui-system-generation.el | 105 |
7 files changed, 258 insertions, 84 deletions
diff --git a/emacs/guix-base.el b/emacs/guix-base.el index dae658ebfa..d720a87833 100644 --- a/emacs/guix-base.el +++ b/emacs/guix-base.el @@ -1,6 +1,6 @@ ;;; guix-base.el --- Common definitions -*- lexical-binding: t -*- -;; Copyright © 2014, 2015 Alex Kost <alezost@gmail.com> +;; Copyright © 2014, 2015, 2016 Alex Kost <alezost@gmail.com> ;; This file is part of GNU Guix. @@ -91,14 +91,25 @@ For the meaning of location, see `guix-find-location'." "Return the file name of a PROFILE's GENERATION." (format "%s-%s-link" profile generation)) -(defun guix-manifest-file (profile &optional generation) +(defun guix-packages-profile (profile &optional generation system?) + "Return a directory where packages are installed for the +PROFILE's GENERATION. + +If SYSTEM? is non-nil, then PROFILE is considered to be a system +profile. Unlike usual profiles, for a system profile, packages +are placed in 'profile' subdirectory." + (let ((profile (if generation + (guix-generation-file profile generation) + profile))) + (if system? + (expand-file-name "profile" profile) + profile))) + +(defun guix-manifest-file (profile &optional generation system?) "Return the file name of a PROFILE's manifest. -If GENERATION number is specified, return manifest file name for -this generation." +See `guix-packages-profile'." (expand-file-name "manifest" - (if generation - (guix-generation-file profile generation) - profile))) + (guix-packages-profile profile generation system?))) ;;;###autoload (defun guix-edit (id-or-name) diff --git a/emacs/guix-main.scm b/emacs/guix-main.scm index 8c38e7cae3..236c882e3c 100644 --- a/emacs/guix-main.scm +++ b/emacs/guix-main.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014, 2015 Alex Kost <alezost@gmail.com> +;;; Copyright © 2014, 2015, 2016 Alex Kost <alezost@gmail.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -61,7 +61,8 @@ (guix scripts lint) (guix scripts package) (guix scripts pull) - (gnu packages)) + (gnu packages) + (gnu system)) (define-syntax-rule (first-or-false lst) (and (not (null? lst)) @@ -137,28 +138,26 @@ return two values: name and version. For example, for SPEC (define (manifest-entries->package-specifications entries) (map manifest-entry->package-specification entries)) -(define (generation-package-specifications profile number) - "Return a list of package specifications for generation NUMBER." - (let ((manifest (profile-manifest - (generation-file-name profile number)))) +(define (profile-package-specifications profile) + "Return a list of package specifications for PROFILE." + (let ((manifest (profile-manifest profile))) (manifest-entries->package-specifications (manifest-entries manifest)))) -(define (generation-package-specifications+paths profile number) - "Return a list of package specifications and paths for generation NUMBER. +(define (profile->specifications+paths profile) + "Return a list of package specifications and paths for PROFILE. Each element of the list is a list of the package specification and its path." - (let ((manifest (profile-manifest - (generation-file-name profile number)))) + (let ((manifest (profile-manifest profile))) (map (lambda (entry) (list (manifest-entry->package-specification entry) (manifest-entry-item entry))) (manifest-entries manifest)))) -(define (generation-difference profile number1 number2) - "Return a list of package specifications for outputs installed in generation -NUMBER1 and not installed in generation NUMBER2." - (let ((specs1 (generation-package-specifications profile number1)) - (specs2 (generation-package-specifications profile number2))) +(define (profile-difference profile1 profile2) + "Return a list of package specifications for outputs installed in PROFILE1 +and not installed in PROFILE2." + (let ((specs1 (profile-package-specifications profile1)) + (specs2 (profile-package-specifications profile2))) (lset-difference string=? specs1 specs2))) (define (manifest-entries->hash-table entries) @@ -670,7 +669,6 @@ ENTRIES is a list of installed manifest entries." (id . ,(apply-to-rest ids->package-patterns)) (name . ,(apply-to-rest specifications->package-patterns)) (installed . ,manifest-package-proc) - (generation . ,manifest-package-proc) (obsolete . ,(apply-to-first obsolete-package-patterns)) (regexp . ,regexp-proc) (all-available . ,all-proc) @@ -679,7 +677,6 @@ ENTRIES is a list of installed manifest entries." (id . ,(apply-to-rest ids->output-patterns)) (name . ,(apply-to-rest specifications->output-patterns)) (installed . ,manifest-output-proc) - (generation . ,manifest-output-proc) (obsolete . ,(apply-to-first obsolete-output-patterns)) (regexp . ,regexp-proc) (all-available . ,all-proc) @@ -694,16 +691,13 @@ ENTRIES is a list of installed manifest entries." search-type search-vals) "Return information about packages or package outputs. See 'entry-sexps' for details." - (let* ((profile (if (eq? search-type 'generation) - (generation-file-name profile (car search-vals)) - profile)) - (manifest (profile-manifest profile)) + (let* ((manifest (profile-manifest profile)) (patterns (if (and (eq? entry-type 'output) - (eq? search-type 'generation-diff)) + (eq? search-type 'profile-diff)) (match search-vals - ((g1 g2) + ((p1 p2) (map specification->output-pattern - (generation-difference profile g1 g2))) + (profile-difference p1 p2))) (_ '())) (apply (patterns-maker entry-type search-type) manifest search-vals))) @@ -765,6 +759,38 @@ See 'entry-sexps' for details." params))) (map ->sexp generations))) +(define system-generation-boot-parameters + (memoize + (lambda (profile generation) + "Return boot parameters for PROFILE's system GENERATION." + (let* ((gen-file (generation-file-name profile generation)) + (param-file (string-append gen-file "/parameters"))) + (call-with-input-file param-file read-boot-parameters))))) + +(define (system-generation-param-alist profile) + "Return an alist of system generation parameters and procedures for +PROFILE." + (append (generation-param-alist profile) + `((label . ,(lambda (gen) + (boot-parameters-label + (system-generation-boot-parameters + profile gen)))) + (root-device . ,(lambda (gen) + (boot-parameters-root-device + (system-generation-boot-parameters + profile gen)))) + (kernel . ,(lambda (gen) + (boot-parameters-kernel + (system-generation-boot-parameters + profile gen))))))) + +(define (system-generation-sexps profile params search-type search-vals) + "Return an alist with information about system generations." + (let ((generations (find-generations profile search-type search-vals)) + (->sexp (object-transformer (system-generation-param-alist profile) + params))) + (map ->sexp generations))) + ;;; Getting package/output/generation entries (alists). @@ -809,6 +835,9 @@ parameter/value pairs." ((generation) (generation-sexps profile params search-type search-vals)) + ((system-generation) + (system-generation-sexps profile params + search-type search-vals)) (else (entry-type-error entry-type)))) diff --git a/emacs/guix-messages.el b/emacs/guix-messages.el index eb2a76e216..c4f15dcac2 100644 --- a/emacs/guix-messages.el +++ b/emacs/guix-messages.el @@ -55,14 +55,7 @@ (obsolete (0 "No obsolete packages in profile '%s'." profile) (1 "A single obsolete package in profile '%s'." profile) - (many "%d obsolete packages in profile '%s'." count profile)) - (generation - (0 "No packages installed in generation %d of profile '%s'." - val profile) - (1 "A single package installed in generation %d of profile '%s'." - val profile) - (many "%d packages installed in generation %d of profile '%s'." - count val profile))) + (many "%d obsolete packages in profile '%s'." count profile))) (output (id @@ -91,14 +84,7 @@ (0 "No obsolete package outputs in profile '%s'." profile) (1 "A single obsolete package output in profile '%s'." profile) (many "%d obsolete package outputs in profile '%s'." count profile)) - (generation - (0 "No package outputs installed in generation %d of profile '%s'." - val profile) - (1 "A single package output installed in generation %d of profile '%s'." - val profile) - (many "%d package outputs installed in generation %d of profile '%s'." - count val profile)) - (generation-diff + (profile-diff guix-message-outputs-by-diff)) (generation @@ -183,25 +169,27 @@ Try \"M-x guix-search-by-name\"." "matching time period '%s' - '%s'.") str-beg profile time-beg time-end))) -(defun guix-message-outputs-by-diff (profile entries generations) - "Display a message for outputs searched by GENERATIONS difference." +(defun guix-message-outputs-by-diff (_ entries profiles) + "Display a message for outputs searched by PROFILES difference." (let* ((count (length entries)) (str-beg (guix-message-string-entries count 'output)) - (gen1 (car generations)) - (gen2 (cadr generations))) + (profile1 (car profiles)) + (profile2 (cadr profiles))) (cl-multiple-value-bind (new old str-action) - (if (> gen1 gen2) - (list gen1 gen2 "added to") - (list gen2 gen1 "removed from")) - (message (concat "%s %s generation %d comparing with " - "generation %d of profile '%s'.") - str-beg str-action new old profile)))) + (if (string-lessp profile2 profile1) + (list profile1 profile2 "added to") + (list profile2 profile1 "removed from")) + (message "%s %s profile '%s' comparing with profile '%s'." + str-beg str-action new old)))) (defun guix-result-message (profile entries entry-type search-type search-vals) "Display an appropriate message after displaying ENTRIES." (let* ((type-spec (guix-assq-value guix-messages - entry-type search-type)) + (if (eq entry-type 'system-generation) + 'generation + entry-type) + search-type)) (fun-or-count-spec (car type-spec))) (if (functionp fun-or-count-spec) (funcall fun-or-count-spec profile entries search-vals) diff --git a/emacs/guix-profiles.el b/emacs/guix-profiles.el index 2c1936864f..43ad1d42eb 100644 --- a/emacs/guix-profiles.el +++ b/emacs/guix-profiles.el @@ -1,6 +1,7 @@ ;;; guix-profiles.el --- Guix profiles -;; Copyright © 2014 Alex Kost <alezost@gmail.com> +;; Copyright © 2014, 2015, 2016 Alex Kost <alezost@gmail.com> +;; Copyright © 2015 Mathieu Lirzin <mthl@openmailbox.org> ;; This file is part of GNU Guix. @@ -25,6 +26,10 @@ (expand-file-name "~/.guix-profile") "User profile.") +(defvar guix-system-profile + (concat guix-config-state-directory "/profiles/system") + "System profile.") + (defvar guix-default-profile (concat guix-config-state-directory "/profiles/per-user/" diff --git a/emacs/guix-ui-generation.el b/emacs/guix-ui-generation.el index aa71645b4e..4047850f23 100644 --- a/emacs/guix-ui-generation.el +++ b/emacs/guix-ui-generation.el @@ -1,6 +1,6 @@ ;;; guix-ui-generation.el --- Interface for displaying generations -*- lexical-binding: t -*- -;; Copyright © 2014, 2015 Alex Kost <alezost@gmail.com> +;; Copyright © 2014, 2015, 2016 Alex Kost <alezost@gmail.com> ;; This file is part of GNU Guix. @@ -78,6 +78,18 @@ Each element from GENERATIONS is a generation number." 'switch-to-generation* profile generation) operation-buffer))) +(defun guix-system-generation? () + "Return non-nil, if current generation is a system one." + (eq (guix-buffer-current-entry-type) + 'system-generation)) + +(defun guix-generation-current-packages-profile (&optional generation) + "Return a directory where packages are installed for the +current profile's GENERATION." + (guix-packages-profile (guix-ui-current-profile) + generation + (guix-system-generation?))) + ;;; Generation 'info' @@ -115,8 +127,9 @@ Each element from GENERATIONS is a generation number." (lambda (btn) (guix-buffer-get-display-entries 'list guix-package-list-type - (list (guix-ui-current-profile) - 'generation (button-get btn 'number)) + (list (guix-generation-current-packages-profile + (button-get btn 'number)) + 'installed) 'add)) "Show installed packages for this generation" 'number number) @@ -190,8 +203,8 @@ VAL is a boolean value." "List installed packages for the generation at point." (interactive) (guix-package-get-display - (guix-ui-current-profile) - 'generation (guix-list-current-id))) + (guix-generation-current-packages-profile (guix-list-current-id)) + 'installed)) (defun guix-generation-list-generations-to-compare () "Return a sorted list of 2 marked generations for comparing." @@ -200,6 +213,11 @@ VAL is a boolean value." (user-error "2 generations should be marked for comparing") (sort numbers #'<)))) +(defun guix-generation-list-profiles-to-compare () + "Return a sorted list of 2 marked generation profiles for comparing." + (mapcar #'guix-generation-current-packages-profile + (guix-generation-list-generations-to-compare))) + (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 @@ -209,8 +227,8 @@ installed in the other one." (guix-buffer-get-display-entries 'list 'output (cl-list* (guix-ui-current-profile) - 'generation-diff - (reverse (guix-generation-list-generations-to-compare))) + 'profile-diff + (reverse (guix-generation-list-profiles-to-compare))) 'add)) (defun guix-generation-list-show-removed-packages () @@ -222,8 +240,8 @@ installed in the other one." (guix-buffer-get-display-entries 'list 'output (cl-list* (guix-ui-current-profile) - 'generation-diff - (guix-generation-list-generations-to-compare)) + 'profile-diff + (guix-generation-list-profiles-to-compare)) 'add)) (defun guix-generation-list-compare (diff-fun gen-fun) @@ -324,14 +342,13 @@ performance." "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. +(defun guix-generation-packages (profile) + "Return a list of sorted packages installed in PROFILE. 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)))) + 'profile->specifications+paths profile)))) (sort names+paths (lambda (a b) (string< (car a) (car b)))))) @@ -360,8 +377,8 @@ Use the full PROFILE file 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." +(defun guix-generation-insert-packages (buffer profile) + "Insert package outputs installed in PROFILE in BUFFER." (with-current-buffer buffer (setq buffer-read-only nil indent-tabs-mode nil) @@ -369,9 +386,9 @@ Use the full PROFILE file name." (mapc (lambda (name+path) (guix-generation-insert-package (car name+path) (cadr name+path))) - (guix-generation-packages profile generation)))) + (guix-generation-packages profile)))) -(defun guix-generation-packages-buffer (profile generation) +(defun guix-generation-packages-buffer (profile generation &optional system?) "Return buffer with package outputs installed in PROFILE's GENERATION. Create the buffer if needed." (let ((buf-name (guix-generation-packages-buffer-name @@ -379,19 +396,24 @@ Create the buffer if needed." (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) + (guix-generation-insert-packages + buf + (guix-packages-profile profile generation system?)) 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)) + (guix-manifest-file (guix-ui-current-profile) + generation + (guix-system-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)) + generation + (guix-system-generation?))) ;;; Interactive commands diff --git a/emacs/guix-ui-package.el b/emacs/guix-ui-package.el index 12bfaeef68..29514527ce 100644 --- a/emacs/guix-ui-package.el +++ b/emacs/guix-ui-package.el @@ -349,6 +349,10 @@ formatted with this string, an action button is inserted.") 'name (button-label btn)) 'add))) +(define-button-type 'guix-package-heading + :supertype 'guix-package-name + 'face 'guix-package-info-heading) + (define-button-type 'guix-package-source :supertype 'guix 'face 'guix-package-info-source @@ -362,8 +366,7 @@ formatted with this string, an action button is inserted.") "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)) + 'guix-package-heading)) (defun guix-package-info-insert-systems (systems entry) "Insert supported package SYSTEMS at point." @@ -909,15 +912,15 @@ See `guix-package-info-type'." "A history of minibuffer prompts.") ;;;###autoload -(defun guix-search-by-name (name &optional profile) - "Search for Guix packages by NAME. +(defun guix-packages-by-name (name &optional profile) + "Display Guix packages with 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) + (list (guix-read-package-name) (guix-ui-read-profile))) (guix-package-get-display profile 'name name)) @@ -936,6 +939,17 @@ Interactively with prefix, prompt for PROFILE." (or params guix-package-search-params))) ;;;###autoload +(defun guix-search-by-name (regexp &optional profile) + "Search for Guix packages matching REGEXP in a package name. +If PROFILE is nil, use `guix-current-profile'. +Interactively with prefix, prompt for PROFILE." + (interactive + (list (read-string "Package name by regexp: " + nil 'guix-package-search-history) + (guix-ui-read-profile))) + (guix-search-by-regexp regexp '(name) profile)) + +;;;###autoload (defun guix-installed-packages (&optional profile) "Display information about installed Guix packages. If PROFILE is nil, use `guix-current-profile'. diff --git a/emacs/guix-ui-system-generation.el b/emacs/guix-ui-system-generation.el new file mode 100644 index 0000000000..d79f3bceef --- /dev/null +++ b/emacs/guix-ui-system-generation.el @@ -0,0 +1,105 @@ +;;; guix-ui-system-generation.el --- Interface for displaying system generations -*- lexical-binding: t -*- + +;; Copyright © 2016 Alex Kost <alezost@gmail.com> + +;; 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 <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This file provides an interface for displaying system generations +;; in 'list' and 'info' buffers, and commands for working with them. + +;;; Code: + +(require 'cl-lib) +(require 'guix-list) +(require 'guix-ui) +(require 'guix-ui-generation) +(require 'guix-profiles) + +(guix-ui-define-entry-type system-generation) + +(defun guix-system-generation-get-display (search-type &rest search-values) + "Search for system generations and show results. +See `guix-ui-get-entries' for the meaning of SEARCH-TYPE and +SEARCH-VALUES." + (apply #'guix-list-get-display-entries + 'system-generation + guix-system-profile + search-type search-values)) + + +;;; System generation 'info' + +(guix-ui-info-define-interface system-generation + :buffer-name "*Guix Generation Info*" + :format '((number format guix-generation-info-insert-number) + (label format (format)) + (prev-number format (format)) + (current format guix-generation-info-insert-current) + (path format (format guix-file)) + (time format (time)) + (root-device format (format)) + (kernel format (format guix-file))) + :titles guix-generation-info-titles) + + +;;; System generation 'list' + +;; FIXME It is better to make `guix-generation-list-shared-map' with +;; common keys for both usual and system generations. +(defvar guix-system-generation-list-mode-map + (copy-keymap guix-generation-list-mode-map) + "Keymap for `guix-system-generation-list-mode' buffers.") + +(guix-ui-list-define-interface system-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) + (label nil 40 t) + (time guix-list-get-time 20 t) + (path guix-list-get-file-path 30 t)) + :titles guix-generation-list-titles + :sort-key '(number . t) + :marks '((delete . ?D))) + + +;;; Interactive commands + +;;;###autoload +(defun guix-system-generations () + "Display information about system generations." + (interactive) + (guix-system-generation-get-display 'all)) + +;;;###autoload +(defun guix-last-system-generations (number) + "Display information about last NUMBER of system generations." + (interactive "nThe number of last generations: ") + (guix-system-generation-get-display 'last number)) + +;;;###autoload +(defun guix-system-generations-by-time (from to) + "Display information about system generations created between FROM and TO." + (interactive + (list (guix-read-date "Find generations (from): ") + (guix-read-date "Find generations (to): "))) + (guix-system-generation-get-display + 'time (float-time from) (float-time to))) + +(provide 'guix-ui-system-generation) + +;;; guix-ui-system-generation.el ends here |