| 1 | ;;; guix-messages.el --- Minibuffer messages |
| 2 | |
| 3 | ;; Copyright © 2014, 2015 Alex Kost <alezost@gmail.com> |
| 4 | |
| 5 | ;; This file is part of GNU Guix. |
| 6 | |
| 7 | ;; GNU Guix is free software; you can redistribute it and/or modify |
| 8 | ;; it under the terms of the GNU General Public License as published by |
| 9 | ;; the Free Software Foundation, either version 3 of the License, or |
| 10 | ;; (at your option) any later version. |
| 11 | |
| 12 | ;; GNU Guix is distributed in the hope that it will be useful, |
| 13 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 14 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 15 | ;; GNU General Public License for more details. |
| 16 | |
| 17 | ;; You should have received a copy of the GNU General Public License |
| 18 | ;; along with this program. If not, see <http://www.gnu.org/licenses/>. |
| 19 | |
| 20 | ;;; Commentary: |
| 21 | |
| 22 | ;; This file provides `guix-result-message' function used to show a |
| 23 | ;; minibuffer message after displaying packages/generations in a |
| 24 | ;; list/info buffer. |
| 25 | |
| 26 | ;;; Code: |
| 27 | |
| 28 | (require 'cl-lib) |
| 29 | (require 'guix-utils) |
| 30 | |
| 31 | (defvar guix-messages |
| 32 | `((package |
| 33 | (id |
| 34 | ,(lambda (_ entries ids) |
| 35 | (guix-message-packages-by-id entries 'package ids))) |
| 36 | (name |
| 37 | ,(lambda (_ entries names) |
| 38 | (guix-message-packages-by-name entries 'package names))) |
| 39 | (license |
| 40 | ,(lambda (_ entries licenses) |
| 41 | (apply #'guix-message-packages-by-license |
| 42 | entries 'package licenses))) |
| 43 | (location |
| 44 | ,(lambda (_ entries locations) |
| 45 | (apply #'guix-message-packages-by-location |
| 46 | entries 'package locations))) |
| 47 | (from-file |
| 48 | (0 "No package in file '%s'." val) |
| 49 | (1 "Package from file '%s'." val)) |
| 50 | (regexp |
| 51 | (0 "No packages matching '%s'." val) |
| 52 | (1 "A single package matching '%s'." val) |
| 53 | (many "%d packages matching '%s'." count val)) |
| 54 | (all-available |
| 55 | (0 "No packages are available for some reason.") |
| 56 | (1 "A single available package (that's strange).") |
| 57 | (many "%d available packages." count)) |
| 58 | (newest-available |
| 59 | (0 "No packages are available for some reason.") |
| 60 | (1 "A single newest available package (that's strange).") |
| 61 | (many "%d newest available packages." count)) |
| 62 | (installed |
| 63 | (0 "No packages installed in profile '%s'." profile) |
| 64 | (1 "A single package installed in profile '%s'." profile) |
| 65 | (many "%d packages installed in profile '%s'." count profile)) |
| 66 | (obsolete |
| 67 | (0 "No obsolete packages in profile '%s'." profile) |
| 68 | (1 "A single obsolete package in profile '%s'." profile) |
| 69 | (many "%d obsolete packages in profile '%s'." count profile))) |
| 70 | |
| 71 | (output |
| 72 | (id |
| 73 | ,(lambda (_ entries ids) |
| 74 | (guix-message-packages-by-id entries 'output ids))) |
| 75 | (name |
| 76 | ,(lambda (_ entries names) |
| 77 | (guix-message-packages-by-name entries 'output names))) |
| 78 | (license |
| 79 | ,(lambda (_ entries licenses) |
| 80 | (apply #'guix-message-packages-by-license |
| 81 | entries 'output licenses))) |
| 82 | (location |
| 83 | ,(lambda (_ entries locations) |
| 84 | (apply #'guix-message-packages-by-location |
| 85 | entries 'output locations))) |
| 86 | (from-file |
| 87 | (0 "No package in file '%s'." val) |
| 88 | (1 "Package from file '%s'." val) |
| 89 | (many "Package outputs from file '%s'." val)) |
| 90 | (regexp |
| 91 | (0 "No package outputs matching '%s'." val) |
| 92 | (1 "A single package output matching '%s'." val) |
| 93 | (many "%d package outputs matching '%s'." count val)) |
| 94 | (all-available |
| 95 | (0 "No package outputs are available for some reason.") |
| 96 | (1 "A single available package output (that's strange).") |
| 97 | (many "%d available package outputs." count)) |
| 98 | (newest-available |
| 99 | (0 "No package outputs are available for some reason.") |
| 100 | (1 "A single newest available package output (that's strange).") |
| 101 | (many "%d newest available package outputs." count)) |
| 102 | (installed |
| 103 | (0 "No package outputs installed in profile '%s'." profile) |
| 104 | (1 "A single package output installed in profile '%s'." profile) |
| 105 | (many "%d package outputs installed in profile '%s'." count profile)) |
| 106 | (obsolete |
| 107 | (0 "No obsolete package outputs in profile '%s'." profile) |
| 108 | (1 "A single obsolete package output in profile '%s'." profile) |
| 109 | (many "%d obsolete package outputs in profile '%s'." count profile)) |
| 110 | (profile-diff |
| 111 | guix-message-outputs-by-diff)) |
| 112 | |
| 113 | (generation |
| 114 | (id |
| 115 | (0 "Generations not found.") |
| 116 | (1 "") |
| 117 | (many "%d generations." count)) |
| 118 | (last |
| 119 | (0 "No generations in profile '%s'." profile) |
| 120 | (1 "The last generation of profile '%s'." profile) |
| 121 | (many "%d last generations of profile '%s'." count profile)) |
| 122 | (all |
| 123 | (0 "No generations in profile '%s'." profile) |
| 124 | (1 "A single generation available in profile '%s'." profile) |
| 125 | (many "%d generations available in profile '%s'." count profile)) |
| 126 | (time |
| 127 | guix-message-generations-by-time)))) |
| 128 | |
| 129 | (defun guix-message-string-name (name) |
| 130 | "Return a quoted name string." |
| 131 | (concat "'" name "'")) |
| 132 | |
| 133 | (defun guix-message-string-entry-type (entry-type &optional plural) |
| 134 | "Return a string denoting an ENTRY-TYPE." |
| 135 | (cl-ecase entry-type |
| 136 | (package |
| 137 | (if plural "packages" "package")) |
| 138 | (output |
| 139 | (if plural "package outputs" "package output")) |
| 140 | (generation |
| 141 | (if plural "generations" "generation")))) |
| 142 | |
| 143 | (defun guix-message-string-entries (count entry-type) |
| 144 | "Return a string denoting the COUNT of ENTRY-TYPE entries." |
| 145 | (cl-case count |
| 146 | (0 (concat "No " |
| 147 | (guix-message-string-entry-type |
| 148 | entry-type 'plural))) |
| 149 | (1 (concat "A single " |
| 150 | (guix-message-string-entry-type |
| 151 | entry-type))) |
| 152 | (t (format "%d %s" |
| 153 | count |
| 154 | (guix-message-string-entry-type |
| 155 | entry-type 'plural))))) |
| 156 | |
| 157 | (defun guix-message-packages-by-id (entries entry-type ids) |
| 158 | "Display a message for packages or outputs searched by IDS." |
| 159 | (let* ((count (length entries)) |
| 160 | (str-beg (guix-message-string-entries count entry-type)) |
| 161 | (str-end (if (> count 1) |
| 162 | (concat "with the following IDs: " |
| 163 | (mapconcat #'guix-get-string ids ", ")) |
| 164 | (concat "with ID " (guix-get-string (car ids)))))) |
| 165 | (if (zerop count) |
| 166 | (message "%s %s. |
| 167 | Most likely, Guix REPL was restarted, so IDs are not actual |
| 168 | anymore, because they live only during the REPL process. |
| 169 | Try \"M-x guix-search-by-name\"." |
| 170 | str-beg str-end) |
| 171 | (message "%s %s." str-beg str-end)))) |
| 172 | |
| 173 | (defun guix-message-packages-by-name (entries entry-type names) |
| 174 | "Display a message for packages or outputs searched by NAMES." |
| 175 | (let* ((count (length entries)) |
| 176 | (str-beg (guix-message-string-entries count entry-type)) |
| 177 | (str-end (if (cdr names) |
| 178 | (concat "matching the following names: " |
| 179 | (mapconcat #'guix-message-string-name |
| 180 | names ", ")) |
| 181 | (concat "with name " |
| 182 | (guix-message-string-name (car names)))))) |
| 183 | (message "%s %s." str-beg str-end))) |
| 184 | |
| 185 | (defun guix-message-packages-by-license (entries entry-type license) |
| 186 | "Display a message for packages or outputs searched by LICENSE." |
| 187 | (let* ((count (length entries)) |
| 188 | (str-beg (guix-message-string-entries count entry-type)) |
| 189 | (str-end (format "with license '%s'" license))) |
| 190 | (message "%s %s." str-beg str-end))) |
| 191 | |
| 192 | (defun guix-message-packages-by-location (entries entry-type location) |
| 193 | "Display a message for packages or outputs searched by LOCATION." |
| 194 | (let* ((count (length entries)) |
| 195 | (str-beg (guix-message-string-entries count entry-type)) |
| 196 | (str-end (format "placed in '%s'" location))) |
| 197 | (message "%s %s." str-beg str-end))) |
| 198 | |
| 199 | (defun guix-message-generations-by-time (profile entries times) |
| 200 | "Display a message for generations searched by TIMES." |
| 201 | (let* ((count (length entries)) |
| 202 | (str-beg (guix-message-string-entries count 'generation)) |
| 203 | (time-beg (guix-get-time-string (car times))) |
| 204 | (time-end (guix-get-time-string (cadr times)))) |
| 205 | (message (concat "%s of profile '%s'\n" |
| 206 | "matching time period '%s' - '%s'.") |
| 207 | str-beg profile time-beg time-end))) |
| 208 | |
| 209 | (defun guix-message-outputs-by-diff (_ entries profiles) |
| 210 | "Display a message for outputs searched by PROFILES difference." |
| 211 | (let* ((count (length entries)) |
| 212 | (str-beg (guix-message-string-entries count 'output)) |
| 213 | (profile1 (car profiles)) |
| 214 | (profile2 (cadr profiles))) |
| 215 | (cl-multiple-value-bind (new old str-action) |
| 216 | (if (string-lessp profile2 profile1) |
| 217 | (list profile1 profile2 "added to") |
| 218 | (list profile2 profile1 "removed from")) |
| 219 | (message "%s %s profile '%s' comparing with profile '%s'." |
| 220 | str-beg str-action new old)))) |
| 221 | |
| 222 | (defun guix-result-message (profile entries entry-type |
| 223 | search-type search-vals) |
| 224 | "Display an appropriate message after displaying ENTRIES." |
| 225 | (let* ((type-spec (guix-assq-value guix-messages |
| 226 | (if (eq entry-type 'system-generation) |
| 227 | 'generation |
| 228 | entry-type) |
| 229 | search-type)) |
| 230 | (fun-or-count-spec (car type-spec))) |
| 231 | (if (functionp fun-or-count-spec) |
| 232 | (funcall fun-or-count-spec profile entries search-vals) |
| 233 | (let* ((count (length entries)) |
| 234 | (count-key (if (> count 1) 'many count)) |
| 235 | (msg-spec (guix-assq-value type-spec count-key)) |
| 236 | (msg (car msg-spec)) |
| 237 | (args (cdr msg-spec))) |
| 238 | (mapc (lambda (subst) |
| 239 | (setq args (cl-substitute (cdr subst) (car subst) args))) |
| 240 | `((count . ,count) |
| 241 | (val . ,(car search-vals)) |
| 242 | (profile . ,profile))) |
| 243 | (apply #'message msg args))))) |
| 244 | |
| 245 | (provide 'guix-messages) |
| 246 | |
| 247 | ;;; guix-messages.el ends here |