diff options
Diffstat (limited to 'emacs')
| -rw-r--r-- | emacs/guix-main.scm | 38 | ||||
| -rw-r--r-- | emacs/guix-messages.el | 5 | ||||
| -rw-r--r-- | emacs/guix-ui-system-generation.el | 105 |
3 files changed, 146 insertions, 2 deletions
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 <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 |