emacs: Improve minibuffer messages.

* emacs/guix-base.el (guix-messages, guix-result-message): Move to
  'guix-messages.el'.
  (guix-set-buffer, guix-history-call, guix-redisplay-buffer): Adjust for
  the modified 'guix-result-message'.
* emacs/guix-messages.el: New file.
  (guix-redisplay-buffer): Add 'profile' argument.
  (guix-message-string-name, guix-message-string-entry-type,
  guix-message-string-entries, guix-message-packages-by-name,
  guix-message-generations-by-time): New procedures.

2 files changed, 199 insertions, 106 deletions

diff --git a/emacs/guix-base.el b/emacs/guix-base.el
index 9583d49262..eb88f37140 100644
--- a/emacs/guix-base.el
+++ b/emacs/guix-base.el
@@ -30,6 +30,8 @@
 (require 'cl-lib)
 (require 'guix-backend)
 (require 'guix-utils)
+(require 'guix-history)
+(require 'guix-messages)
 
 
 ;;; Profiles
@@ -565,7 +567,8 @@ If NO-DISPLAY is non-nil, do not switch to the buffer."
                  (guix-make-history-item)))
       (or no-display
           (guix-switch-to-buffer buf))))
-  (guix-result-message entries entry-type search-type search-vals))
+  (guix-result-message profile entries entry-type
+                       search-type search-vals))
 
 (defun guix-show-entries (entries buffer-type entry-type)
   "Display ENTRY-TYPE ENTRIES in the current BUFFER-TYPE buffer."
@@ -583,7 +586,8 @@ If NO-DISPLAY is non-nil, do not switch to the buffer."
   (guix-show-entries entries buffer-type entry-type)
   (guix-set-vars profile entries buffer-type entry-type
                  search-type search-vals)
-  (guix-result-message entries entry-type search-type search-vals))
+  (guix-result-message profile entries entry-type
+                       search-type search-vals))
 
 (defun guix-make-history-item ()
   "Make and return a history item for the current buffer."
@@ -642,113 +646,10 @@ This function will not update the information, use
 \"\\[revert-buffer]\" if you want the full update."
   (interactive)
   (guix-show-entries guix-entries guix-buffer-type guix-entry-type)
-  (guix-result-message guix-entries guix-entry-type
+  (guix-result-message guix-profile guix-entries guix-entry-type
                        guix-search-type guix-search-vals))
 
 
-;;; Messages
-
-(defvar guix-messages
-  '((package
-     (id
-      (0 "Packages not found.")
-      (1 "")
-      (many "%d packages." count))
-     (name
-      (0 "The package '%s' not found." val)
-      (1 "A single package with name '%s'." val)
-      (many "%d packages with '%s' name." count val))
-     (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 installed packages.")
-      (1 "A single package installed.")
-      (many "%d packages installed." count))
-     (obsolete
-      (0 "No obsolete packages.")
-      (1 "A single obsolete package.")
-      (many "%d obsolete packages." count))
-     (generation
-      (0 "No packages installed in generation %d." val)
-      (1 "A single package installed in generation %d." val)
-      (many "%d packages installed in generation %d." count val)))
-    (output
-     (id
-      (0 "Package outputs not found.")
-      (1 "")
-      (many "%d package outputs." count))
-     (name
-      (0 "The package output '%s' not found." val)
-      (1 "A single package output with name '%s'." val)
-      (many "%d package outputs with '%s' name." count val))
-     (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 installed package outputs.")
-      (1 "A single package output installed.")
-      (many "%d package outputs installed." count))
-     (obsolete
-      (0 "No obsolete package outputs.")
-      (1 "A single obsolete package output.")
-      (many "%d obsolete package outputs." count))
-     (generation
-      (0 "No package outputs installed in generation %d." val)
-      (1 "A single package output installed in generation %d." val)
-      (many "%d package outputs installed in generation %d." count val)))
-    (generation
-     (id
-      (0 "Generations not found.")
-      (1 "")
-      (many "%d generations." count))
-     (last
-      (0 "No available generations.")
-      (1 "The last generation.")
-      (many "%d last generations." count))
-     (all
-      (0 "No available generations.")
-      (1 "A single available generation.")
-      (many "%d available generations." count))
-     (time
-      (0 "Generations not found.")
-      (1 "A single generation matching time period.")
-      (many "%d generations matching time period." count)))))
-
-(defun guix-result-message (entries entry-type search-type search-vals)
-  "Display an appropriate message after displaying ENTRIES."
-  (let* ((val (car search-vals))
-         (count (length entries))
-         (count-key (if (> count 1) 'many count))
-         (msg-spec (guix-get-key-val guix-messages
-                                     entry-type search-type count-key))
-         (format (car msg-spec))
-         (args (cdr msg-spec)))
-    (mapc (lambda (subst)
-            (setq args (cl-substitute (car subst) (cdr subst) args)))
-          (list (cons count 'count)
-                (cons val 'val)))
-    (apply #'message format args)))
-
-
 ;;; Actions on packages and generations
 
 (defface guix-operation-option-key
diff --git a/emacs/guix-messages.el b/emacs/guix-messages.el
new file mode 100644
index 0000000000..7a0b493ac7
--- /dev/null
+++ b/emacs/guix-messages.el
@@ -0,0 +1,192 @@
+;;; 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
+     (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-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