~ruther/guix-local

67cedc4ba69ec90b2d9d94646b861ba6821f342d — Alex Kost 10 years ago 5672866
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.
6 files changed, 156 insertions(+), 2 deletions(-)

M NEWS
M doc/emacs.texi
M emacs.am
M emacs/guix-main.scm
M emacs/guix-messages.el
A emacs/guix-ui-system-generation.el
M NEWS => NEWS +1 -0
@@ 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";

M doc/emacs.texi => doc/emacs.texi +8 -0
@@ 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:


M emacs.am => emacs.am +1 -0
@@ 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

M emacs/guix-main.scm => emacs/guix-main.scm +37 -1
@@ 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))))



M emacs/guix-messages.el => emacs/guix-messages.el +4 -1
@@ 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)

A emacs/guix-ui-system-generation.el => emacs/guix-ui-system-generation.el +105 -0
@@ 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