diff options
Diffstat (limited to 'emacs/guix-base.el')
| -rw-r--r-- | emacs/guix-base.el | 396 |
1 files changed, 9 insertions, 387 deletions
diff --git a/emacs/guix-base.el b/emacs/guix-base.el index 21be02d26d..4bd88992c4 100644 --- a/emacs/guix-base.el +++ b/emacs/guix-base.el @@ -22,9 +22,6 @@ ;; This file provides some base and common definitions for guix.el ;; package. -;; List and info buffers have many common patterns that are defined -;; using `guix-buffer-define-interface' macro from this file. - ;;; Code: (require 'cl-lib) @@ -34,8 +31,6 @@ (require 'guix-guile) (require 'guix-utils) (require 'guix-ui) -(require 'guix-history) -(require 'guix-messages) ;;; Parameters of the entries @@ -143,227 +138,6 @@ For the meaning of location, see `guix-find-location'." #'string<)) -;;; Buffers - -(defun guix-switch-to-buffer (buffer) - "Switch to a 'list' or 'info' BUFFER." - (pop-to-buffer buffer - '((display-buffer-reuse-window - display-buffer-same-window)))) - - -;;; Common definitions for buffer types - -(defvar guix-buffer-data nil - "Alist with 'buffer' data. -This alist is filled by `guix-buffer-define-interface' macro.") - -(defun guix-buffer-value (buffer-type entry-type symbol) - "Return SYMBOL's value for BUFFER-TYPE/ENTRY-TYPE from `guix-buffer-data'." - (symbol-value - (guix-assq-value guix-buffer-data buffer-type entry-type symbol))) - -(defun guix-buffer-param-title (buffer-type entry-type param) - "Return PARAM title for BUFFER-TYPE/ENTRY-TYPE." - (or (guix-assq-value (guix-buffer-value buffer-type entry-type 'titles) - param) - ;; Fallback to a title defined in 'info' interface. - (unless (eq buffer-type 'info) - (guix-assq-value (guix-buffer-value 'info entry-type 'titles) - param)) - (guix-symbol-title param))) - -(defun guix-buffer-name (buffer-type entry-type profile) - "Return name of BUFFER-TYPE buffer for displaying ENTRY-TYPE entries." - (let ((str-or-fun (guix-buffer-value buffer-type entry-type - 'buffer-name))) - (if (stringp str-or-fun) - str-or-fun - (funcall str-or-fun profile)))) - -(defun guix-buffer-history-size (buffer-type entry-type) - "Return history size for BUFFER-TYPE/ENTRY-TYPE." - (guix-buffer-value buffer-type entry-type 'history-size)) - -(defun guix-buffer-revert-confirm? (buffer-type entry-type) - "Return 'revert-confirm' value for BUFFER-TYPE/ENTRY-TYPE." - (guix-buffer-value buffer-type entry-type 'revert-confirm)) - -(defvar guix-buffer-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "l") 'guix-history-back) - (define-key map (kbd "r") 'guix-history-forward) - (define-key map (kbd "g") 'revert-buffer) - (define-key map (kbd "R") 'guix-buffer-redisplay) - map) - "Parent keymap for Guix buffer modes.") - -(defvar-local guix-profile nil - "Profile used for the current buffer.") -(put 'guix-profile 'permanent-local t) - -(defvar-local guix-entries nil - "List of the currently displayed entries. -Each element of the list is alist with entry info of the -following form: - - ((PARAM . VAL) ...) - -PARAM is a name of the entry parameter. -VAL is a value of this parameter.") -(put 'guix-entries 'permanent-local t) - -(defvar-local guix-buffer-type nil - "Type of the current buffer.") -(put 'guix-buffer-type 'permanent-local t) - -(defvar-local guix-entry-type nil - "Type of the current entry.") -(put 'guix-entry-type 'permanent-local t) - -(defvar-local guix-search-type nil - "Type of the current search.") -(put 'guix-search-type 'permanent-local t) - -(defvar-local guix-search-vals nil - "Values of the current search.") -(put 'guix-search-vals 'permanent-local t) - -(defsubst guix-set-vars (profile entries buffer-type entry-type - search-type search-vals) - "Set local variables for the current Guix buffer." - (setq default-directory profile - guix-profile profile - guix-entries entries - guix-buffer-type buffer-type - guix-entry-type entry-type - guix-search-type search-type - guix-search-vals search-vals)) - -(defun guix-get-symbol (postfix buffer-type &optional entry-type) - (intern (concat "guix-" - (when entry-type - (concat (symbol-name entry-type) "-")) - (symbol-name buffer-type) "-" postfix))) - -(defmacro guix-buffer-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. - -The following stuff should be defined outside this macro: - - - `guix-BUFFER-TYPE-mode' - parent mode of the generated mode. - - - `guix-TYPE-mode-initialize' (optional) - function for - additional mode settings; it is called without arguments. - -Required keywords: - - - `:buffer-name' - default value of the generated - `guix-TYPE-buffer-name' variable. - -Optional keywords: - - - `:titles' - default value of the generated - `guix-TYPE-titles' variable. - - - `:history-size' - default value of the generated - `guix-TYPE-history-size' variable. - - - `:revert-confirm?' - default value of the generated - `guix-TYPE-revert-confirm' variable. - - - `:reduced?' - if non-nil, generate only group, faces group - and titles variable." - (declare (indent 2)) - (let* ((entry-type-str (symbol-name entry-type)) - (buffer-type-str (symbol-name buffer-type)) - (Entry-type-str (capitalize entry-type-str)) - (Buffer-type-str (capitalize buffer-type-str)) - (entry-str (concat entry-type-str " entries")) - (prefix (concat "guix-" entry-type-str "-" - buffer-type-str)) - (group (intern prefix)) - (faces-group (intern (concat prefix "-faces"))) - (mode-map-str (concat prefix "-mode-map")) - (parent-mode (intern (concat "guix-" buffer-type-str "-mode"))) - (mode (intern (concat prefix "-mode"))) - (mode-init-fun (intern (concat prefix "-mode-initialize"))) - (buffer-name-var (intern (concat prefix "-buffer-name"))) - (titles-var (intern (concat prefix "-titles"))) - (history-size-var (intern (concat prefix "-history-size"))) - (revert-confirm-var (intern (concat prefix "-revert-confirm")))) - (guix-keyword-args-let args - ((buffer-name-val :buffer-name) - (titles-val :titles) - (history-size-val :history-size 20) - (revert-confirm-val :revert-confirm? t) - (reduced? :reduced?)) - `(progn - (defgroup ,group nil - ,(format "Display '%s' entries in '%s' buffer." - entry-type-str buffer-type-str) - :prefix ,(concat prefix "-") - :group ',(intern (concat "guix-" buffer-type-str))) - - (defgroup ,faces-group nil - ,(format "Faces for displaying '%s' entries in '%s' buffer." - entry-type-str buffer-type-str) - :group ',(intern (concat "guix-" buffer-type-str "-faces"))) - - (defcustom ,titles-var ,titles-val - ,(format "Alist of titles of '%s' parameters." - entry-type-str) - :type '(alist :key-type symbol :value-type string) - :group ',group) - - ,(unless reduced? - `(progn - (defcustom ,buffer-name-var ,buffer-name-val - ,(format "\ -Default name of '%s' buffer for displaying '%s' entries." - buffer-type-str entry-type-str) - :type 'string - :group ',group) - - (defcustom ,history-size-var ,history-size-val - ,(format "\ -Maximum number of items saved in history of `%S' buffer. -If 0, the history is disabled." - buffer-name-var) - :type 'integer - :group ',group) - - (defcustom ,revert-confirm-var ,revert-confirm-val - ,(format "\ -If non-nil, ask to confirm for reverting `%S' buffer." - buffer-name-var) - :type 'boolean - :group ',group) - - (guix-alist-put! - '((buffer-name . ,buffer-name-var) - (history-size . ,history-size-var) - (revert-confirm . ,revert-confirm-var)) - 'guix-buffer-data ',buffer-type ',entry-type) - - (define-derived-mode ,mode ,parent-mode - ,(concat "Guix-" Buffer-type-str) - ,(concat "Major mode for displaying information about " - entry-str ".\n\n" - "\\{" mode-map-str "}") - (setq-local revert-buffer-function 'guix-buffer-revert) - (setq-local guix-history-size - (guix-buffer-history-size - ',buffer-type ',entry-type)) - (and (fboundp ',mode-init-fun) (,mode-init-fun))))) - - (guix-alist-put! - ',titles-var 'guix-buffer-data - ',buffer-type ',entry-type 'titles))))) - - ;;; Getting and displaying info about packages and generations (defcustom guix-package-list-type 'output @@ -384,159 +158,6 @@ information)." (const :tag "Display outputs" output)) :group 'guix) -(defun guix-get-entries (profile entry-type search-type search-vals - &optional params) - "Search for entries of ENTRY-TYPE. - -Call an appropriate scheme function and return a list of the -form of `guix-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 -information with all available parameters." - (guix-eval-read (guix-make-guile-expression - 'entries - profile params entry-type search-type search-vals))) - -(defun guix-get-show-entries (profile buffer-type entry-type search-type - &rest search-vals) - "Search for ENTRY-TYPE entries and show results in BUFFER-TYPE buffer. -See `guix-get-entries' for the meaning of SEARCH-TYPE and SEARCH-VALS." - (let ((entries (guix-get-entries profile entry-type search-type search-vals - (guix-get-params-for-receiving - buffer-type entry-type)))) - (guix-set-buffer profile entries buffer-type entry-type - search-type search-vals))) - -(defun guix-set-buffer (profile entries buffer-type entry-type search-type - search-vals &optional history-replace no-display) - "Set up BUFFER-TYPE buffer for displaying ENTRY-TYPE ENTRIES. - -Insert ENTRIES in buffer, set variables and make history item. -ENTRIES should have a form of `guix-entries'. - -See `guix-get-entries' for the meaning of SEARCH-TYPE and SEARCH-VALS. - -If HISTORY-REPLACE is non-nil, replace current history item, -otherwise add the new one. - -If NO-DISPLAY is non-nil, do not switch to the buffer." - (when entries - (let ((buf (if (and (eq major-mode - (guix-get-symbol "mode" buffer-type entry-type)) - (equal guix-profile profile)) - (current-buffer) - (get-buffer-create - (guix-buffer-name buffer-type entry-type profile))))) - (with-current-buffer buf - (guix-show-entries entries buffer-type entry-type) - (guix-set-vars profile entries buffer-type entry-type - search-type search-vals) - (funcall (if history-replace - #'guix-history-replace - #'guix-history-add) - (guix-make-history-item))) - (or no-display - (guix-switch-to-buffer buf)))) - (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." - (let ((inhibit-read-only t)) - (erase-buffer) - (funcall (symbol-function (guix-get-symbol - "mode" buffer-type entry-type))) - (funcall (guix-get-symbol "insert-entries" buffer-type) - entries entry-type) - (goto-char (point-min)))) - -(defun guix-history-call (profile entries buffer-type entry-type - search-type search-vals) - "Function called for moving by history." - (guix-show-entries entries buffer-type entry-type) - (guix-set-vars profile entries buffer-type 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." - (list #'guix-history-call - guix-profile guix-entries guix-buffer-type guix-entry-type - guix-search-type guix-search-vals)) - -(defun guix-get-params-for-receiving (buffer-type entry-type) - "Return parameters that should be received for BUFFER-TYPE, ENTRY-TYPE." - (let* ((required-var (guix-get-symbol "required-params" - buffer-type entry-type)) - (required (symbol-value required-var))) - (unless (equal required 'all) - (cl-union required - (funcall (guix-get-symbol "displayed-params" - buffer-type) - entry-type))))) - -(defun guix-buffer-revert (_ignore-auto noconfirm) - "Update information in the current buffer. -The function is suitable for `revert-buffer-function'. -See `revert-buffer' for the meaning of NOCONFIRM." - (when (or noconfirm - (guix-buffer-revert-confirm? guix-buffer-type - guix-entry-type) - (y-or-n-p "Update current information? ")) - (let* ((params (guix-get-params-for-receiving guix-buffer-type - guix-entry-type)) - (entries (guix-get-entries - guix-profile guix-entry-type - guix-search-type guix-search-vals params))) - (guix-set-buffer guix-profile entries guix-buffer-type guix-entry-type - guix-search-type guix-search-vals t t)))) - -(defvar guix-buffer-after-redisplay-hook nil - "Hook run by `guix-buffer-redisplay'. -This hook is called before seting up a window position.") - -(defun guix-buffer-redisplay () - "Redisplay the current Guix buffer. -Restore the point and window positions after redisplaying. - -This function does not update the buffer data, use -'\\[revert-buffer]' if you want the full update." - (interactive) - (let* ((old-point (point)) - ;; For simplicity, ignore an unlikely case when multiple - ;; windows display the same buffer. - (window (car (get-buffer-window-list (current-buffer) nil t))) - (window-start (and window (window-start window)))) - (guix-set-buffer guix-profile guix-entries guix-buffer-type - guix-entry-type guix-search-type guix-search-vals - t t) - (goto-char old-point) - (run-hooks 'guix-buffer-after-redisplay-hook) - (when window - (set-window-point window (point)) - (set-window-start window window-start)))) - -(defun guix-buffer-redisplay-goto-button () - "Redisplay the current buffer and go to the next button, if needed." - (let ((guix-buffer-after-redisplay-hook - (cons (lambda () - (unless (button-at (point)) - (forward-button 1))) - guix-buffer-after-redisplay-hook))) - (guix-buffer-redisplay))) - ;;; Generations @@ -640,13 +261,14 @@ Create the buffer if needed." (defun guix-profile-generation-manifest-file (generation) "Return the file name of a GENERATION's manifest. -GENERATION is a generation number of `guix-profile' profile." - (guix-manifest-file guix-profile generation)) +GENERATION is a generation number of the current profile." + (guix-manifest-file (guix-ui-current-profile) generation)) (defun guix-profile-generation-packages-buffer (generation) "Insert GENERATION's package outputs in a buffer and return it. -GENERATION is a generation number of `guix-profile' profile." - (guix-generation-packages-buffer guix-profile generation)) +GENERATION is a generation number of the current profile." + (guix-generation-packages-buffer (guix-ui-current-profile) + generation)) ;;; Actions on packages and generations @@ -757,7 +379,7 @@ Ask a user if needed (see `guix-operation-confirm'). INSTALL, UPGRADE, REMOVE are 'package action specifications'. See `guix-process-package-actions' for details." (or (null guix-operation-confirm) - (let* ((entries (guix-get-entries + (let* ((entries (guix-ui-get-entries profile 'package 'id (append (mapcar #'car install) (mapcar #'car upgrade) @@ -930,12 +552,12 @@ See Info node `(guix) Invoking guix package' for details. Interactively, use the current profile and prompt for manifest FILE. With a prefix argument, also prompt for PROFILE." (interactive - (let* ((default-profile (or guix-profile guix-current-profile)) + (let* ((current-profile (guix-ui-current-profile)) (profile (if current-prefix-arg (guix-profile-prompt) - default-profile)) + (or current-profile guix-current-profile))) (file (read-file-name "File with manifest: ")) - (buffer (and guix-profile (current-buffer)))) + (buffer (and current-profile (current-buffer)))) (list profile file buffer))) (when (or (not guix-operation-confirm) (y-or-n-p (format "Apply manifest from '%s' to profile '%s'? " |