From 54c3c284d7f319d6db7c665c612fdbeefe81ae5f Mon Sep 17 00:00:00 2001 From: Alex Kost Date: Mon, 4 Jan 2016 22:59:04 +0300 Subject: emacs: Replace 'generation-diff' search with 'profile-diff'. * emacs/guix-main.scm (generation-package-specifications): Rename to... (profile-package-specifications): ... this. Take a single 'profile' argument. (generation-difference): Rename to... (profile-difference): ... this. Take profiles as arguments. (package/output-sexps): Adjust accordingly. * emacs/guix-ui-generation.el (guix-generation-list-profiles-to-compare): New procedure. (guix-generation-list-show-added-packages) (guix-generation-list-show-removed-packages): Use it. * emacs/guix-messages.el (guix-messages): Replace 'generation-diff' with 'profile-diff'. (guix-message-outputs-by-diff): Adjust accordingly. --- emacs/guix-messages.el | 21 ++++++++++----------- 1 file changed, 10 insertions(+), 11 deletions(-) (limited to 'emacs/guix-messages.el') diff --git a/emacs/guix-messages.el b/emacs/guix-messages.el index eb2a76e216..234d3d11da 100644 --- a/emacs/guix-messages.el +++ b/emacs/guix-messages.el @@ -98,7 +98,7 @@ 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,19 +183,18 @@ 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) -- cgit v1.2.3 From 56728668485dfcba457e64748ab709eacf39b6ce Mon Sep 17 00:00:00 2001 From: Alex Kost Date: Thu, 7 Jan 2016 22:40:53 +0300 Subject: emacs: Remove 'generation' search type. Use 'installed' search type instead. * emacs/guix-main.scm (%patterns-makers): Remove 'generation'. (package/output-sexps): Adjust accordingly. * emacs/guix-ui-generation.el (guix-generation-info-insert-number): Replace 'generation' search with 'installed'. (guix-generation-list-show-packages): Likewise. * emacs/guix-messages.el (guix-messages): Remove 'generation'. --- emacs/guix-main.scm | 7 +------ emacs/guix-messages.el | 16 +--------------- emacs/guix-ui-generation.el | 9 +++++---- 3 files changed, 7 insertions(+), 25 deletions(-) (limited to 'emacs/guix-messages.el') diff --git a/emacs/guix-main.scm b/emacs/guix-main.scm index dfa9cba8e4..1199679975 100644 --- a/emacs/guix-main.scm +++ b/emacs/guix-main.scm @@ -668,7 +668,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) @@ -677,7 +676,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) @@ -692,10 +690,7 @@ 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 'profile-diff)) (match search-vals diff --git a/emacs/guix-messages.el b/emacs/guix-messages.el index 234d3d11da..9f6d833252 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,13 +84,6 @@ (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)) (profile-diff guix-message-outputs-by-diff)) diff --git a/emacs/guix-ui-generation.el b/emacs/guix-ui-generation.el index 752d8523b9..4047850f23 100644 --- a/emacs/guix-ui-generation.el +++ b/emacs/guix-ui-generation.el @@ -127,8 +127,9 @@ current profile's GENERATION." (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) @@ -202,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." -- cgit v1.2.3 From 67cedc4ba69ec90b2d9d94646b861ba6821f342d Mon Sep 17 00:00:00 2001 From: Alex Kost Date: Thu, 7 Jan 2016 23:01:26 +0300 Subject: emacs: Add interface for system generations. * emacs/guix-main.scm (system-generation-boot-parameters) (system-generation-param-alist, system-generation-sexps): New procedures. (entries): Add 'system-generation' entry type. * emacs/guix-messages.el (guix-result-message): Use the same messages for 'generation' and 'system-generation' entry types. * emacs/guix-ui-system-generation.el: New file. * emacs.am (ELFILES): Add it. * doc/emacs.texi (Emacs Commands): Document new commands. * NEWS: Mention new interface. --- NEWS | 1 + doc/emacs.texi | 8 +++ emacs.am | 1 + emacs/guix-main.scm | 38 +++++++++++++- emacs/guix-messages.el | 5 +- emacs/guix-ui-system-generation.el | 105 +++++++++++++++++++++++++++++++++++++ 6 files changed, 156 insertions(+), 2 deletions(-) create mode 100644 emacs/guix-ui-system-generation.el (limited to 'emacs/guix-messages.el') diff --git a/NEWS b/NEWS index c35c7d67b9..0084394941 100644 --- a/NEWS +++ b/NEWS @@ -14,6 +14,7 @@ Please send Guix bug reports to bug-guix@gnu.org. ** Package management +*** Emacs interface for system generations *** Emacs interface for hydra.gnu.org *** Changes in Emacs interface variables In the following names, BUFFER-TYPE means "info" or "list"; diff --git a/doc/emacs.texi b/doc/emacs.texi index ea340b19fe..b2a3d473ab 100644 --- a/doc/emacs.texi +++ b/doc/emacs.texi @@ -191,6 +191,14 @@ date/time prompt,,, org, The Org Manual}). @end table +Analogously on GuixSD you can also display system generations: + +@table @kbd +@item M-x guix-system-generations +@item M-x guix-last-system-generations +@item M-x guix-system-generations-by-time +@end table + You can also invoke the @command{guix pull} command (@pxref{Invoking guix pull}) from Emacs using: diff --git a/emacs.am b/emacs.am index 85165b9368..d0d4dfb9bd 100644 --- a/emacs.am +++ b/emacs.am @@ -47,6 +47,7 @@ ELFILES = \ emacs/guix-ui.el \ emacs/guix-ui-package.el \ emacs/guix-ui-generation.el \ + emacs/guix-ui-system-generation.el \ emacs/guix-utils.el if HAVE_EMACS diff --git a/emacs/guix-main.scm b/emacs/guix-main.scm index 1199679975..236c882e3c 100644 --- a/emacs/guix-main.scm +++ b/emacs/guix-main.scm @@ -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)) @@ -758,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). @@ -802,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 9f6d833252..c4f15dcac2 100644 --- a/emacs/guix-messages.el +++ b/emacs/guix-messages.el @@ -186,7 +186,10 @@ Try \"M-x guix-search-by-name\"." 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-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 + +;; 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 . + +;;; 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 -- cgit v1.2.3