From 8bff0c796e0eea5dd26e5327238cf6def5b55027 Mon Sep 17 00:00:00 2001 From: Alex Kost Date: Mon, 23 Nov 2015 16:41:58 +0300 Subject: emacs: Generalize buffer naming. * emacs/guix-base.el (guix-buffer-name): New procedure. (guix-buffer-define-interface): Make ':buffer-name' a required keyword. (guix-update-after-operation, guix-buffer-name-function) (guix-buffer-name-simple, guix-buffer-name-default, guix-buffer-name) (guix-buffer-p, guix-buffers, guix-update-buffer) (guix-update-buffers-maybe-after-operation): Adjust, move and rename to... * emacs/guix-ui.el (guix-ui-update-after-operation) (guix-ui-buffer-name-function, guix-ui-buffer-name-simple) (guix-ui-buffer-name-default, guix-ui-buffer-name) (guix-ui-buffer?, guix-ui-buffers, guix-ui-update-buffer) (guix-ui-update-buffers-after-operation): ... this. (guix-ui-define-interface): Generate 'guix-ENTRY-TYPE-BUFFER-TYPE-buffer-name' procedure and pass it as ':buffer-name' argument. (guix-ui): New custom group. * emacs/guix-info.el: Specify ':buffer-name' for the defined interfaces. * emacs/guix-list.el: Likewise. * doc/emacs.texi (Emacs Appearance): Adjust accordingly. --- emacs/guix-ui.el | 120 ++++++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 119 insertions(+), 1 deletion(-) (limited to 'emacs/guix-ui.el') diff --git a/emacs/guix-ui.el b/emacs/guix-ui.el index 25b110c815..a92439baf1 100644 --- a/emacs/guix-ui.el +++ b/emacs/guix-ui.el @@ -25,8 +25,15 @@ ;;; Code: (require 'cl-lib) +(require 'guix-backend) (require 'guix-utils) +(defgroup guix-ui nil + "Settings for Guix package management. +This group includes settings for displaying packages, outputs and +generations in 'list' and 'info' buffers." + :group 'guix) + (defvar guix-ui-map (let ((map (make-sparse-keymap))) (define-key map (kbd "M") 'guix-apply-manifest) @@ -39,6 +46,101 @@ (apply #'guix-get-show-entries guix-profile 'info guix-entry-type 'id ids)) + +;;; 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 @@ -47,6 +149,12 @@ 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 @@ -64,10 +172,12 @@ The rest keyword arguments are passed to (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"))) (definer (intern (format "guix-%s-define-interface" buffer-type-str)))) (guix-keyword-args-let args - ((required-val :required ''(id))) + ((buffer-name-val :buffer-name) + (required-val :required ''(id))) `(progn (defvar ,mode-map (let ((map (make-sparse-keymap))) @@ -82,7 +192,15 @@ List of the required '%s' parameters for '%s' buffer. These parameters are received along with the displayed parameters." entry-type-str buffer-type-str)) + (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)) + (,definer ,entry-type + :buffer-name ',buffer-name-fun ,@%foreign-args))))) (defmacro guix-ui-info-define-interface (entry-type &rest args) -- cgit v1.2.3