guix-play/emacs/guix-messages.el
Alex Kost d38bd08c74 emacs: Add interface for comparing generations.
Suggested by Ludovic Courtès.

* doc/emacs.texi (Emacs List buffer): Document new key bindings.
* emacs/guix-base.el (guix-generation-packages-buffer-name-function,
  guix-generation-packages-update-buffer, guix-output-name-width): New
  variables.
  (guix-generation-file, guix-manifest-file, guix-generation-packages,
  guix-generation-packages-buffer-name-default,
  guix-generation-packages-buffer-name-long,
  guix-generation-packages-buffer-name, guix-generation-packages-buffer,
  guix-generation-insert-package, guix-generation-insert-packages,
  guix-profile-generation-manifest-file,
  guix-profile-generation-packages-buffer): New procedures.
* emacs/guix-list.el: Add key bindings for comparing generations.
  (guix-generation-list-generations-to-compare,
  guix-generation-list-show-added-packages,
  guix-generation-list-show-removed-packages, guix-generation-list-compare,
  guix-generation-list-ediff-manifests, guix-generation-list-diff-manifests,
  guix-generation-list-ediff-packages, guix-generation-list-diff-packages,
  guix-generation-list-ediff, guix-generation-list-diff): New procedures.
* emacs/guix-messages.el (guix-messages): Add 'generation-diff' search type.
  (guix-message-outputs-by-diff): New procedure.
* emacs/guix-utils.el (guix-diff-switches): New variable.
  (guix-diff): New procedure.
* emacs/guix-main.scm (package/output-sexps): Handle 'generation-diff' search
  type.
  (manifest-entry->package-specification,
  manifest-entries->package-specifications, generation-package-specifications,
  generation-package-specifications+paths, generation-difference): New
  procedures.
2014-11-04 15:51:22 +03:00

209 lines
8.1 KiB
EmacsLisp

;;; guix-messages.el --- Minibuffer messages
;; Copyright © 2014 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 `guix-result-message' function used to show a
;; minibuffer message after displaying packages/generations in a
;; list/info buffer.
;;; Code:
(require 'cl-lib)
(require 'guix-utils)
(defvar guix-messages
`((package
(id
(0 "Packages not found.")
(1 "")
(many "%d packages." count))
(name
,(lambda (_ entries names)
(guix-message-packages-by-name entries 'package names)))
(regexp
(0 "No packages matching '%s'." val)
(1 "A single package matching '%s'." val)
(many "%d packages matching '%s'." count val))
(all-available
(0 "No packages are available for some reason.")
(1 "A single available package (that's strange).")
(many "%d available packages." count))
(newest-available
(0 "No packages are available for some reason.")
(1 "A single newest available package (that's strange).")
(many "%d newest available packages." count))
(installed
(0 "No packages installed in profile '%s'." profile)
(1 "A single package installed in profile '%s'." profile)
(many "%d packages installed in profile '%s'." count profile))
(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)))
(output
(id
(0 "Package outputs not found.")
(1 "")
(many "%d package outputs." count))
(name
,(lambda (_ entries names)
(guix-message-packages-by-name entries 'output names)))
(regexp
(0 "No package outputs matching '%s'." val)
(1 "A single package output matching '%s'." val)
(many "%d package outputs matching '%s'." count val))
(all-available
(0 "No package outputs are available for some reason.")
(1 "A single available package output (that's strange).")
(many "%d available package outputs." count))
(newest-available
(0 "No package outputs are available for some reason.")
(1 "A single newest available package output (that's strange).")
(many "%d newest available package outputs." count))
(installed
(0 "No package outputs installed in profile '%s'." profile)
(1 "A single package output installed in profile '%s'." profile)
(many "%d package outputs installed in profile '%s'." count profile))
(obsolete
(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
guix-message-outputs-by-diff))
(generation
(id
(0 "Generations not found.")
(1 "")
(many "%d generations." count))
(last
(0 "No generations in profile '%s'." profile)
(1 "The last generation of profile '%s'." profile)
(many "%d last generations of profile '%s'." count profile))
(all
(0 "No generations in profile '%s'." profile)
(1 "A single generation available in profile '%s'." profile)
(many "%d generations available in profile '%s'." count profile))
(time
guix-message-generations-by-time))))
(defun guix-message-string-name (name)
"Return a quoted name string."
(concat "'" name "'"))
(defun guix-message-string-entry-type (entry-type &optional plural)
"Return a string denoting an ENTRY-TYPE."
(cl-ecase entry-type
(package
(if plural "packages" "package"))
(output
(if plural "package outputs" "package output"))
(generation
(if plural "generations" "generation"))))
(defun guix-message-string-entries (count entry-type)
"Return a string denoting the COUNT of ENTRY-TYPE entries."
(cl-case count
(0 (concat "No "
(guix-message-string-entry-type
entry-type 'plural)))
(1 (concat "A single "
(guix-message-string-entry-type
entry-type)))
(t (format "%d %s"
count
(guix-message-string-entry-type
entry-type 'plural)))))
(defun guix-message-packages-by-name (entries entry-type names)
"Display a message for packages or outputs searched by NAMES."
(let* ((count (length entries))
(str-beg (guix-message-string-entries count entry-type))
(str-end (if (cdr names)
(concat "matching the following names: "
(mapconcat #'guix-message-string-name
names ", "))
(concat "with name "
(guix-message-string-name (car names))))))
(message "%s %s." str-beg str-end)))
(defun guix-message-generations-by-time (profile entries times)
"Display a message for generations searched by TIMES."
(let* ((count (length entries))
(str-beg (guix-message-string-entries count 'generation))
(time-beg (guix-get-time-string (car times)))
(time-end (guix-get-time-string (cadr times))))
(message (concat "%s of profile '%s'\n"
"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."
(let* ((count (length entries))
(str-beg (guix-message-string-entries count 'output))
(gen1 (car generations))
(gen2 (cadr generations)))
(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))))
(defun guix-result-message (profile entries entry-type
search-type search-vals)
"Display an appropriate message after displaying ENTRIES."
(let* ((type-spec (guix-get-key-val guix-messages
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)
(let* ((count (length entries))
(count-key (if (> count 1) 'many count))
(msg-spec (guix-get-key-val type-spec count-key))
(msg (car msg-spec))
(args (cdr msg-spec)))
(mapc (lambda (subst)
(setq args (cl-substitute (cdr subst) (car subst) args)))
`((count . ,count)
(val . ,(car search-vals))
(profile . ,profile)))
(apply #'message msg args)))))
(provide 'guix-messages)
;;; guix-messages.el ends here