diff options
Diffstat (limited to 'emacs/guix-ui.el')
| -rw-r--r-- | emacs/guix-ui.el | 333 |
1 files changed, 333 insertions, 0 deletions
diff --git a/emacs/guix-ui.el b/emacs/guix-ui.el new file mode 100644 index 0000000000..7fef7c355c --- /dev/null +++ b/emacs/guix-ui.el @@ -0,0 +1,333 @@ +;;; guix-ui.el --- Common code for Guix package management interface -*- lexical-binding: t -*- + +;; Copyright © 2014, 2015 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 some general code for 'list'/'info' interfaces for +;; packages and generations. + +;;; Code: + +(require 'cl-lib) +(require 'guix-backend) +(require 'guix-buffer) +(require 'guix-guile) +(require 'guix-utils) +(require 'guix-messages) + +(guix-define-groups ui + :group-doc "\ +Settings for 'ui' (Guix package management) buffers. +This group includes settings for displaying packages, outputs and +generations in 'list' and 'info' buffers.") + +(defvar guix-ui-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "M") 'guix-apply-manifest) + (define-key map (kbd "C-c C-z") 'guix-switch-to-repl) + map) + "Parent keymap for Guix package/generation buffers.") + +(guix-buffer-define-current-args-accessors + "guix-ui-current" "profile" "search-type" "search-values") + +(defun guix-ui-read-profile () + "Return `guix-current-profile' or prompt for it. +This function is intended for using in `interactive' forms." + (if current-prefix-arg + (guix-profile-prompt) + guix-current-profile)) + +(defun guix-ui-get-entries (profile entry-type search-type search-values + &optional params) + "Receive ENTRY-TYPE entries for PROFILE. +Call an appropriate scheme procedure and return a list of entries. + +ENTRY-TYPE should be one of the following symbols: `package', +`output' or `generation'. + +SEARCH-TYPE may be one of the following symbols: + +- If ENTRY-TYPE is `package' or `output': `id', `name', `regexp', + `all-available', `newest-available', `installed', `obsolete', + `generation'. + +- If ENTRY-TYPE is `generation': `id', `last', `all', `time'. + +PARAMS is a list of parameters for receiving. If nil, get data +with all available parameters." + (guix-eval-read + (guix-make-guile-expression + 'entries + profile params entry-type search-type search-values))) + +(defun guix-ui-list-describe (ids) + "Describe 'ui' entries with IDS (list of identifiers)." + (guix-buffer-get-display-entries + 'info (guix-buffer-current-entry-type) + (cl-list* (guix-ui-current-profile) 'id ids) + 'add)) + + +;;; Buffers and auto updating + +(defcustom guix-ui-update-after-operation 'current + "Define what kind of data to update after executing an operation. + +After successful executing an operation in the Guix REPL (for +example after installing a package), the data in Guix buffers +will or will not be automatically updated depending on a value of +this variable. + +If nil, update nothing (do not revert any buffer). +If `current', update the buffer from which an operation was performed. +If `all', update all Guix buffers (not recommended)." + :type '(choice (const :tag "Do nothing" nil) + (const :tag "Update operation buffer" current) + (const :tag "Update all Guix buffers" all)) + :group 'guix-ui) + +(defcustom guix-ui-buffer-name-function + #'guix-ui-buffer-name-default + "Function used to define a name of a Guix buffer. +The function is called with 2 arguments: BASE-NAME and PROFILE." + :type '(choice (function-item guix-ui-buffer-name-default) + (function-item guix-ui-buffer-name-simple) + (function :tag "Other function")) + :group 'guix-ui) + +(defun guix-ui-buffer-name-simple (base-name &rest _) + "Return BASE-NAME." + base-name) + +;; TODO separate '*...*' logic from the real profile appending. Also add +;; another function to return '*Guix ...: /full/path/to/profile*' name. +(defun guix-ui-buffer-name-default (base-name profile) + "Return buffer name by appending BASE-NAME and PROFILE's base file name." + (let ((profile-name (file-name-base (directory-file-name profile))) + (re (rx string-start + (group (? "*")) + (group (*? any)) + (group (? "*")) + string-end))) + (or (string-match re base-name) + (error "Unexpected error in defining guix buffer name")) + (let ((first* (match-string 1 base-name)) + (name-body (match-string 2 base-name)) + (last* (match-string 3 base-name))) + ;; Handle the case when buffer name is wrapped by '*'. + (if (and (string= "*" first*) + (string= "*" last*)) + (concat "*" name-body ": " profile-name "*") + (concat base-name ": " profile-name))))) + +(defun guix-ui-buffer-name (base-name profile) + "Return Guix buffer name based on BASE-NAME and profile. +See `guix-ui-buffer-name-function' for details." + (funcall guix-ui-buffer-name-function + base-name profile)) + +(defun guix-ui-buffer? (&optional buffer modes) + "Return non-nil if BUFFER mode is derived from any of the MODES. +If BUFFER is nil, check current buffer. +If MODES is nil, use `guix-list-mode' and `guix-info-mode'." + (with-current-buffer (or buffer (current-buffer)) + (apply #'derived-mode-p + (or modes '(guix-list-mode guix-info-mode))))) + +(defun guix-ui-buffers (&optional modes) + "Return a list of all buffers with major modes derived from MODES. +If MODES is nil, return list of all Guix 'list' and 'info' buffers." + (cl-remove-if-not (lambda (buf) + (guix-ui-buffer? buf modes)) + (buffer-list))) + +(defun guix-ui-update-buffer (buffer) + "Update data in a 'list' or 'info' BUFFER." + (with-current-buffer buffer + (guix-buffer-revert nil t))) + +(defun guix-ui-update-buffers-after-operation () + "Update buffers after Guix operation if needed. +See `guix-ui-update-after-operation' for details." + (let ((to-update + (and guix-operation-buffer + (cl-case guix-ui-update-after-operation + (current (and (buffer-live-p guix-operation-buffer) + (guix-ui-buffer? guix-operation-buffer) + (list guix-operation-buffer))) + (all (guix-ui-buffers)))))) + (setq guix-operation-buffer nil) + (mapc #'guix-ui-update-buffer to-update))) + +(add-hook 'guix-after-repl-operation-hook + 'guix-ui-update-buffers-after-operation) + + +;;; Interface definers + +(defmacro guix-ui-define-entry-type (entry-type &rest args) + "Define general code for ENTRY-TYPE. +Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ... + +The rest keyword arguments are passed to +`guix-define-entry-type' macro." + (declare (indent 1)) + `(guix-define-entry-type ,entry-type + :parent-group guix-ui + :parent-faces-group guix-ui-faces + ,@args)) + +(defmacro guix-ui-define-interface (buffer-type entry-type &rest args) + "Define BUFFER-TYPE interface for displaying ENTRY-TYPE entries. +Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ... +In the following description TYPE means ENTRY-TYPE-BUFFER-TYPE. + +Required keywords: + + - `:buffer-name' - base part of a buffer name. It is used in a + generated `guix-TYPE-buffer-name' function; see + `guix-ui-buffer-name' for details. + +Optional keywords: + + - `:required' - default value of the generated + `guix-TYPE-required-params' variable. + +The rest keyword arguments are passed to +`guix-BUFFER-TYPE-define-interface' macro. + +Along with the mentioned definitions, this macro also defines: + + - `guix-TYPE-mode-map' - keymap based on `guix-ui-map' and + `guix-BUFFER-TYPE-mode-map'. + + - `guix-TYPE-get-entries' - a wrapper around `guix-ui-get-entries'. + + - `guix-TYPE-message' - a wrapper around `guix-result-message'." + (declare (indent 2)) + (let* ((entry-type-str (symbol-name entry-type)) + (buffer-type-str (symbol-name buffer-type)) + (prefix (concat "guix-" entry-type-str "-" + buffer-type-str)) + (mode-str (concat prefix "-mode")) + (mode-map (intern (concat mode-str "-map"))) + (parent-map (intern (format "guix-%s-mode-map" + buffer-type-str))) + (required-var (intern (concat prefix "-required-params"))) + (buffer-name-fun (intern (concat prefix "-buffer-name"))) + (get-fun (intern (concat prefix "-get-entries"))) + (message-fun (intern (concat prefix "-message"))) + (displayed-fun (intern (format "guix-%s-displayed-params" + buffer-type-str))) + (definer (intern (format "guix-%s-define-interface" + buffer-type-str)))) + (guix-keyword-args-let args + ((buffer-name-val :buffer-name) + (required-val :required ''(id))) + `(progn + (defvar ,mode-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent + map (make-composed-keymap ,parent-map guix-ui-map)) + map) + ,(format "Keymap for `%s' buffers." mode-str)) + + (defvar ,required-var ,required-val + ,(format "\ +List of the required '%s' parameters. +These parameters are received by `%S' +along with the displayed parameters. + +Do not remove `id' from this list as it is required for +identifying an entry." + entry-type-str get-fun)) + + (defun ,buffer-name-fun (profile &rest _) + ,(format "\ +Return a name of '%s' buffer for displaying '%s' entries. +See `guix-ui-buffer-name' for details." + buffer-type-str entry-type-str) + (guix-ui-buffer-name ,buffer-name-val profile)) + + (defun ,get-fun (profile search-type &rest search-values) + ,(format "\ +Receive '%s' entries for displaying them in '%s' buffer. +See `guix-ui-get-entries' for details." + entry-type-str buffer-type-str) + (guix-ui-get-entries + profile ',entry-type search-type search-values + (cl-union ,required-var + (,displayed-fun ',entry-type)))) + + (defun ,message-fun (entries profile search-type + &rest search-values) + ,(format "\ +Display a message after showing '%s' entries." + entry-type-str) + (guix-result-message + profile entries ',entry-type search-type search-values)) + + (,definer ,entry-type + :get-entries-function ',get-fun + :message-function ',message-fun + :buffer-name ',buffer-name-fun + ,@%foreign-args))))) + +(defmacro guix-ui-info-define-interface (entry-type &rest args) + "Define 'info' interface for displaying ENTRY-TYPE entries. +See `guix-ui-define-interface'." + (declare (indent 1)) + `(guix-ui-define-interface info ,entry-type + ,@args)) + +(defmacro guix-ui-list-define-interface (entry-type &rest args) + "Define 'list' interface for displaying ENTRY-TYPE entries. +Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ... + +Optional keywords: + + - `:describe-function' - default value of the generated + `guix-ENTRY-TYPE-list-describe-function' variable (if not + specified, use `guix-ui-list-describe'). + +The rest keyword arguments are passed to +`guix-ui-define-interface' macro." + (declare (indent 1)) + (guix-keyword-args-let args + ((describe-val :describe-function)) + `(guix-ui-define-interface list ,entry-type + :describe-function ,(or describe-val ''guix-ui-list-describe) + ,@args))) + + +(defvar guix-ui-font-lock-keywords + (eval-when-compile + `((,(rx "(" (group (or "guix-ui-define-entry-type" + "guix-ui-define-interface" + "guix-ui-info-define-interface" + "guix-ui-list-define-interface")) + symbol-end) + . 1)))) + +(font-lock-add-keywords 'emacs-lisp-mode guix-ui-font-lock-keywords) + +(provide 'guix-ui) + +;;; guix-ui.el ends here |