emacs/guix-ui.el

   1 ;;; guix-ui.el --- Common code for Guix package management interface  -*- lexical-binding: t -*-
   2
   3 ;; Copyright © 2014, 2015, 2016 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 some general code for 'list'/'info' interfaces for
  23 ;; packages and generations.
  24
  25 ;;; Code:
  26
  27 (require 'cl-lib)
  28 (require 'guix-backend)
  29 (require 'guix-buffer)
  30 (require 'guix-guile)
  31 (require 'guix-utils)
  32 (require 'guix-messages)
  33 (require 'guix-profiles)
  34
  35 (guix-define-groups ui
  36   :group-doc "\
  37 Settings for 'ui' (Guix package management) buffers.
  38 This group includes settings for displaying packages, outputs and
  39 generations in 'list' and 'info' buffers.")
  40
  41 (defvar guix-ui-map
  42   (let ((map (make-sparse-keymap)))
  43     (define-key map (kbd "M") 'guix-apply-manifest)
  44     (define-key map (kbd "C-c C-z") 'guix-switch-to-repl)
  45     map)
  46   "Parent keymap for Guix package/generation buffers.")
  47
  48 (guix-buffer-define-current-args-accessors
  49  "guix-ui-current" "profile" "search-type" "search-values")
  50
  51 (defun guix-ui-read-profile ()
  52   "Return `guix-current-profile' or prompt for it.
  53 This function is intended for using in `interactive' forms."
  54   (if current-prefix-arg
  55       (guix-profile-prompt)
  56     guix-current-profile))
  57
  58 (defun guix-ui-get-entries (profile entry-type search-type search-values
  59                                     &optional params)
  60   "Receive ENTRY-TYPE entries for PROFILE.
  61 Call an appropriate scheme procedure and return a list of entries.
  62
  63 ENTRY-TYPE should be one of the following symbols: `package',
  64 `output' or `generation'.
  65
  66 SEARCH-TYPE may be one of the following symbols:
  67
  68 - If ENTRY-TYPE is `package' or `output': `id', `name', `regexp',
  69   `all-available', `newest-available', `installed', `obsolete',
  70   `generation'.
  71
  72 - If ENTRY-TYPE is `generation': `id', `last', `all', `time'.
  73
  74 PARAMS is a list of parameters for receiving.  If nil, get data
  75 with all available parameters."
  76   (guix-eval-read
  77    (guix-make-guile-expression
  78     'entries
  79     profile params entry-type search-type search-values)))
  80
  81 (defun guix-ui-list-describe (ids)
  82   "Describe 'ui' entries with IDS (list of identifiers)."
  83   (guix-buffer-get-display-entries
  84    'info (guix-buffer-current-entry-type)
  85    (cl-list* (guix-ui-current-profile) 'id ids)
  86    'add))
  87
  88 \f
  89 ;;; Buffers and auto updating
  90
  91 (defcustom guix-ui-update-after-operation 'current
  92   "Define what kind of data to update after executing an operation.
  93
  94 After successful executing an operation in the Guix REPL (for
  95 example after installing a package), the data in Guix buffers
  96 will or will not be automatically updated depending on a value of
  97 this variable.
  98
  99 If nil, update nothing (do not revert any buffer).
 100 If `current', update the buffer from which an operation was performed.
 101 If `all', update all Guix buffers (not recommended)."
 102   :type '(choice (const :tag "Do nothing" nil)
 103                  (const :tag "Update operation buffer" current)
 104                  (const :tag "Update all Guix buffers" all))
 105   :group 'guix-ui)
 106
 107 (defcustom guix-ui-buffer-name-function
 108   #'guix-ui-buffer-name-full
 109   "Function used to define a name of a Guix buffer.
 110 The function is called with 2 arguments: BASE-NAME and PROFILE."
 111   :type '(choice (function-item guix-ui-buffer-name-full)
 112                  (function-item guix-ui-buffer-name-short)
 113                  (function-item guix-ui-buffer-name-simple)
 114                  (function :tag "Other function"))
 115   :group 'guix-ui)
 116
 117 (defun guix-ui-buffer-name-simple (base-name &rest _)
 118   "Return BASE-NAME."
 119   base-name)
 120
 121 (defun guix-ui-buffer-name-short (base-name profile)
 122   "Return buffer name by appending BASE-NAME and PROFILE's base file name."
 123   (guix-compose-buffer-name base-name
 124                             (file-name-base (directory-file-name profile))))
 125
 126 (defun guix-ui-buffer-name-full (base-name profile)
 127   "Return buffer name by appending BASE-NAME and PROFILE's full name."
 128   (guix-compose-buffer-name base-name profile))
 129
 130 (defun guix-ui-buffer-name (base-name profile)
 131   "Return Guix buffer name based on BASE-NAME and profile.
 132 See `guix-ui-buffer-name-function' for details."
 133   (funcall guix-ui-buffer-name-function
 134            base-name profile))
 135
 136 (defun guix-ui-buffer? (&optional buffer modes)
 137   "Return non-nil if BUFFER mode is derived from any of the MODES.
 138 If BUFFER is nil, check current buffer.
 139 If MODES is nil, use `guix-list-mode' and `guix-info-mode'."
 140   (with-current-buffer (or buffer (current-buffer))
 141     (apply #'derived-mode-p
 142            (or modes '(guix-list-mode guix-info-mode)))))
 143
 144 (defun guix-ui-buffers (&optional modes)
 145   "Return a list of all buffers with major modes derived from MODES.
 146 If MODES is nil, return list of all Guix 'list' and 'info' buffers."
 147   (cl-remove-if-not (lambda (buf)
 148                       (guix-ui-buffer? buf modes))
 149                     (buffer-list)))
 150
 151 (defun guix-ui-update-buffer (buffer)
 152   "Update data in a 'list' or 'info' BUFFER."
 153   (with-current-buffer buffer
 154     (guix-buffer-revert nil t)))
 155
 156 (defun guix-ui-update-buffers-after-operation ()
 157   "Update buffers after Guix operation if needed.
 158 See `guix-ui-update-after-operation' for details."
 159   (let ((to-update
 160          (and guix-operation-buffer
 161               (cl-case guix-ui-update-after-operation
 162                 (current (and (buffer-live-p guix-operation-buffer)
 163                               (guix-ui-buffer? guix-operation-buffer)
 164                               (list guix-operation-buffer)))
 165                 (all     (guix-ui-buffers))))))
 166     (setq guix-operation-buffer nil)
 167     (mapc #'guix-ui-update-buffer to-update)))
 168
 169 (add-hook 'guix-after-repl-operation-hook
 170           'guix-ui-update-buffers-after-operation)
 171
 172 \f
 173 ;;; Interface definers
 174
 175 (defmacro guix-ui-define-entry-type (entry-type &rest args)
 176   "Define general code for ENTRY-TYPE.
 177 Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ...
 178
 179 The rest keyword arguments are passed to
 180 `guix-define-entry-type' macro."
 181   (declare (indent 1))
 182   `(guix-define-entry-type ,entry-type
 183      :parent-group guix-ui
 184      :parent-faces-group guix-ui-faces
 185      ,@args))
 186
 187 (defmacro guix-ui-define-interface (buffer-type entry-type &rest args)
 188   "Define BUFFER-TYPE interface for displaying ENTRY-TYPE entries.
 189 Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ...
 190 In the following description TYPE means ENTRY-TYPE-BUFFER-TYPE.
 191
 192 Required keywords:
 193
 194   - `:buffer-name' - base part of a buffer name.  It is used in a
 195     generated `guix-TYPE-buffer-name' function; see
 196     `guix-ui-buffer-name' for details.
 197
 198 Optional keywords:
 199
 200   - `:required' - default value of the generated
 201     `guix-TYPE-required-params' variable.
 202
 203 The rest keyword arguments are passed to
 204 `guix-BUFFER-TYPE-define-interface' macro.
 205
 206 Along with the mentioned definitions, this macro also defines:
 207
 208   - `guix-TYPE-mode-map' - keymap based on `guix-ui-map' and
 209     `guix-BUFFER-TYPE-mode-map'.
 210
 211   - `guix-TYPE-get-entries' - a wrapper around `guix-ui-get-entries'.
 212
 213   - `guix-TYPE-message' - a wrapper around `guix-result-message'."
 214   (declare (indent 2))
 215   (let* ((entry-type-str  (symbol-name entry-type))
 216          (buffer-type-str (symbol-name buffer-type))
 217          (prefix          (concat "guix-" entry-type-str "-"
 218                                   buffer-type-str))
 219          (mode-str        (concat prefix "-mode"))
 220          (mode-map        (intern (concat mode-str "-map")))
 221          (parent-map      (intern (format "guix-%s-mode-map"
 222                                           buffer-type-str)))
 223          (required-var    (intern (concat prefix "-required-params")))
 224          (buffer-name-fun (intern (concat prefix "-buffer-name")))
 225          (get-fun         (intern (concat prefix "-get-entries")))
 226          (message-fun     (intern (concat prefix "-message")))
 227          (displayed-fun   (intern (format "guix-%s-displayed-params"
 228                                           buffer-type-str)))
 229          (definer         (intern (format "guix-%s-define-interface"
 230                                           buffer-type-str))))
 231     (guix-keyword-args-let args
 232         ((buffer-name-val :buffer-name)
 233          (required-val    :required ''(id)))
 234       `(progn
 235          (defvar ,mode-map
 236            (let ((map (make-sparse-keymap)))
 237              (set-keymap-parent
 238               map (make-composed-keymap ,parent-map guix-ui-map))
 239              map)
 240            ,(format "Keymap for `%s' buffers." mode-str))
 241
 242          (defvar ,required-var ,required-val
 243            ,(format "\
 244 List of the required '%s' parameters.
 245 These parameters are received by `%S'
 246 along with the displayed parameters.
 247
 248 Do not remove `id' from this list as it is required for
 249 identifying an entry."
 250                     entry-type-str get-fun))
 251
 252          (defun ,buffer-name-fun (profile &rest _)
 253            ,(format "\
 254 Return a name of '%s' buffer for displaying '%s' entries.
 255 See `guix-ui-buffer-name' for details."
 256                     buffer-type-str entry-type-str)
 257            (guix-ui-buffer-name ,buffer-name-val profile))
 258
 259          (defun ,get-fun (profile search-type &rest search-values)
 260            ,(format "\
 261 Receive '%s' entries for displaying them in '%s' buffer.
 262 See `guix-ui-get-entries' for details."
 263                     entry-type-str buffer-type-str)
 264            (guix-ui-get-entries
 265             profile ',entry-type search-type search-values
 266             (cl-union ,required-var
 267                       (,displayed-fun ',entry-type))))
 268
 269          (defun ,message-fun (entries profile search-type
 270                                       &rest search-values)
 271            ,(format "\
 272 Display a message after showing '%s' entries."
 273                     entry-type-str)
 274            (guix-result-message
 275             profile entries ',entry-type search-type search-values))
 276
 277          (,definer ,entry-type
 278            :get-entries-function ',get-fun
 279            :message-function ',message-fun
 280            :buffer-name ',buffer-name-fun
 281            ,@%foreign-args)))))
 282
 283 (defmacro guix-ui-info-define-interface (entry-type &rest args)
 284   "Define 'info' interface for displaying ENTRY-TYPE entries.
 285 See `guix-ui-define-interface'."
 286   (declare (indent 1))
 287   `(guix-ui-define-interface info ,entry-type
 288      ,@args))
 289
 290 (defmacro guix-ui-list-define-interface (entry-type &rest args)
 291   "Define 'list' interface for displaying ENTRY-TYPE entries.
 292 Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ...
 293
 294 Optional keywords:
 295
 296   - `:describe-function' - default value of the generated
 297     `guix-ENTRY-TYPE-list-describe-function' variable (if not
 298     specified, use `guix-ui-list-describe').
 299
 300 The rest keyword arguments are passed to
 301 `guix-ui-define-interface' macro."
 302   (declare (indent 1))
 303   (guix-keyword-args-let args
 304       ((describe-val :describe-function))
 305     `(guix-ui-define-interface list ,entry-type
 306        :describe-function ,(or describe-val ''guix-ui-list-describe)
 307        ,@args)))
 308
 309 \f
 310 (defvar guix-ui-font-lock-keywords
 311   (eval-when-compile
 312     `((,(rx "(" (group (or "guix-ui-define-entry-type"
 313                            "guix-ui-define-interface"
 314                            "guix-ui-info-define-interface"
 315                            "guix-ui-list-define-interface"))
 316             symbol-end)
 317        . 1))))
 318
 319 (font-lock-add-keywords 'emacs-lisp-mode guix-ui-font-lock-keywords)
 320
 321 (provide 'guix-ui)
 322
 323 ;;; guix-ui.el ends here