diff options
Diffstat (limited to 'emacs')
| -rw-r--r-- | emacs/guix-base.el | 106 | ||||
| -rw-r--r-- | emacs/guix-list.el | 70 | ||||
| -rw-r--r-- | emacs/guix-read.el | 28 | ||||
| -rw-r--r-- | emacs/guix-utils.el | 52 |
4 files changed, 139 insertions, 117 deletions
diff --git a/emacs/guix-base.el b/emacs/guix-base.el index 91b52db188..f55e1c67e0 100644 --- a/emacs/guix-base.el +++ b/emacs/guix-base.el @@ -382,63 +382,55 @@ following keywords are available: (buf-name-var (intern (concat prefix "-buffer-name"))) (revert-var (intern (concat prefix "-revert-no-confirm"))) (history-var (intern (concat prefix "-history-size"))) - (params-var (intern (concat prefix "-required-params"))) - (buf-name-val (format "*Guix %s %s*" Entry-type-str Buf-type-str)) - (revert-val nil) - (history-val 20) - (params-val '(id))) - - ;; Process the keyword args. - (while (keywordp (car args)) - (pcase (pop args) - (`:required (setq params-val (pop args))) - (`:history-size (setq history-val (pop args))) - (`:revert (setq revert-val (pop args))) - (`:buffer-name (setq buf-name-val (pop args))) - (_ (pop args)))) - - `(progn - (defgroup ,group nil - ,(concat Buf-type-str " buffer with " entry-str ".") - :prefix ,(concat prefix "-") - :group ',(intern (concat "guix-" buf-type-str))) - - (defgroup ,faces-group nil - ,(concat "Faces for " buf-type-str " buffer with " entry-str ".") - :group ',(intern (concat "guix-" buf-type-str "-faces"))) - - (defcustom ,buf-name-var ,buf-name-val - ,(concat "Default name of the " buf-str " for displaying " entry-str ".") - :type 'string - :group ',group) - - (defcustom ,history-var ,history-val - ,(concat "Maximum number of items saved in the history of the " buf-str ".\n" - "If 0, the history is disabled.") - :type 'integer - :group ',group) - - (defcustom ,revert-var ,revert-val - ,(concat "If non-nil, do not ask to confirm for reverting the " buf-str ".") - :type 'boolean - :group ',group) - - (defvar ,params-var ',params-val - ,(concat "List of required " entry-type-str " parameters.\n\n" - "Displayed parameters and parameters from this list are received\n" - "for each " entry-type-str ".\n\n" - "May be a special value `all', in which case all supported\n" - "parameters are received (this may be very slow for a big number\n" - "of entries).\n\n" - "Do not remove `id' from this list as it is required for\n" - "identifying an entry.")) - - (define-derived-mode ,mode ,parent-mode ,(concat "Guix-" Buf-type-str) - ,(concat "Major mode for displaying information about " entry-str ".\n\n" - "\\{" mode-map-str "}") - (setq-local revert-buffer-function 'guix-revert-buffer) - (setq-local guix-history-size ,history-var) - (and (fboundp ',mode-init-fun) (,mode-init-fun)))))) + (params-var (intern (concat prefix "-required-params")))) + (guix-keyword-args-let args + ((params-val :required '(id)) + (history-val :history-size 20) + (revert-val :revert) + (buf-name-val :buffer-name + (format "*Guix %s %s*" Entry-type-str Buf-type-str))) + `(progn + (defgroup ,group nil + ,(concat Buf-type-str " buffer with " entry-str ".") + :prefix ,(concat prefix "-") + :group ',(intern (concat "guix-" buf-type-str))) + + (defgroup ,faces-group nil + ,(concat "Faces for " buf-type-str " buffer with " entry-str ".") + :group ',(intern (concat "guix-" buf-type-str "-faces"))) + + (defcustom ,buf-name-var ,buf-name-val + ,(concat "Default name of the " buf-str " for displaying " entry-str ".") + :type 'string + :group ',group) + + (defcustom ,history-var ,history-val + ,(concat "Maximum number of items saved in the history of the " buf-str ".\n" + "If 0, the history is disabled.") + :type 'integer + :group ',group) + + (defcustom ,revert-var ,revert-val + ,(concat "If non-nil, do not ask to confirm for reverting the " buf-str ".") + :type 'boolean + :group ',group) + + (defvar ,params-var ',params-val + ,(concat "List of required " entry-type-str " parameters.\n\n" + "Displayed parameters and parameters from this list are received\n" + "for each " entry-type-str ".\n\n" + "May be a special value `all', in which case all supported\n" + "parameters are received (this may be very slow for a big number\n" + "of entries).\n\n" + "Do not remove `id' from this list as it is required for\n" + "identifying an entry.")) + + (define-derived-mode ,mode ,parent-mode ,(concat "Guix-" Buf-type-str) + ,(concat "Major mode for displaying information about " entry-str ".\n\n" + "\\{" mode-map-str "}") + (setq-local revert-buffer-function 'guix-revert-buffer) + (setq-local guix-history-size ,history-var) + (and (fboundp ',mode-init-fun) (,mode-init-fun))))))) (put 'guix-define-buffer-type 'lisp-indent-function 'defun) diff --git a/emacs/guix-list.el b/emacs/guix-list.el index f0e20193c0..3e846a3377 100644 --- a/emacs/guix-list.el +++ b/emacs/guix-list.el @@ -416,45 +416,37 @@ This macro defines the following functions: (prefix (concat "guix-" entry-type-str "-list")) (mode-str (concat prefix "-mode")) (init-fun (intern (concat prefix "-mode-initialize"))) - (marks-var (intern (concat prefix "-mark-alist"))) - (marks-val nil) - (sort-key nil) - (invert-sort nil)) - - ;; Process the keyword args. - (while (keywordp (car args)) - (pcase (pop args) - (`:sort-key (setq sort-key (pop args))) - (`:invert-sort (setq invert-sort (pop args))) - (`:marks (setq marks-val (pop args))) - (_ (pop args)))) - - `(progn - (defvar ,marks-var ',marks-val - ,(concat "Alist of additional marks for `" mode-str "'.\n" - "Marks from this list are added to `guix-list-mark-alist'.")) - - ,@(mapcar (lambda (mark-spec) - (let* ((mark-name (car mark-spec)) - (mark-name-str (symbol-name mark-name))) - `(defun ,(intern (concat prefix "-mark-" mark-name-str "-simple")) () - ,(concat "Put '" mark-name-str "' mark and move to the next line.\n" - "Also add the current entry to `guix-list-marked'.") - (interactive) - (guix-list--mark ',mark-name t)))) - marks-val) - - (defun ,init-fun () - ,(concat "Initial settings for `" mode-str "'.") - ,(when sort-key - `(setq tabulated-list-sort-key - (guix-list-tabulated-sort-key - ',entry-type ',sort-key ,invert-sort))) - (setq tabulated-list-format - (guix-list-tabulated-format ',entry-type)) - (setq-local guix-list-mark-alist - (append guix-list-mark-alist ,marks-var)) - (tabulated-list-init-header))))) + (marks-var (intern (concat prefix "-mark-alist")))) + (guix-keyword-args-let args + ((sort-key :sort-key) + (invert-sort :invert-sort) + (marks-val :marks)) + `(progn + (defvar ,marks-var ',marks-val + ,(concat "Alist of additional marks for `" mode-str "'.\n" + "Marks from this list are added to `guix-list-mark-alist'.")) + + ,@(mapcar (lambda (mark-spec) + (let* ((mark-name (car mark-spec)) + (mark-name-str (symbol-name mark-name))) + `(defun ,(intern (concat prefix "-mark-" mark-name-str "-simple")) () + ,(concat "Put '" mark-name-str "' mark and move to the next line.\n" + "Also add the current entry to `guix-list-marked'.") + (interactive) + (guix-list--mark ',mark-name t)))) + marks-val) + + (defun ,init-fun () + ,(concat "Initial settings for `" mode-str "'.") + ,(when sort-key + `(setq tabulated-list-sort-key + (guix-list-tabulated-sort-key + ',entry-type ',sort-key ,invert-sort))) + (setq tabulated-list-format + (guix-list-tabulated-format ',entry-type)) + (setq-local guix-list-mark-alist + (append guix-list-mark-alist ,marks-var)) + (tabulated-list-init-header)))))) (put 'guix-list-define-entry-type 'lisp-indent-function 'defun) diff --git a/emacs/guix-read.el b/emacs/guix-read.el index e60af9c2f7..82eccbd678 100644 --- a/emacs/guix-read.el +++ b/emacs/guix-read.el @@ -66,26 +66,14 @@ keywords are available: `<multiple-reader-name>-string' function returning a string of multiple values separated the specified separator will be defined." - (let (completions-var - completions-getter - single-reader - single-prompt - multiple-reader - multiple-prompt - multiple-separator) - - ;; Process the keyword args. - (while (keywordp (car args)) - (pcase (pop args) - (`:completions-var (setq completions-var (pop args))) - (`:completions-getter (setq completions-getter (pop args))) - (`:single-reader (setq single-reader (pop args))) - (`:single-prompt (setq single-prompt (pop args))) - (`:multiple-reader (setq multiple-reader (pop args))) - (`:multiple-prompt (setq multiple-prompt (pop args))) - (`:multiple-separator (setq multiple-separator (pop args))) - (_ (pop args)))) - + (guix-keyword-args-let args + ((completions-var :completions-var) + (completions-getter :completions-getter) + (single-reader :single-reader) + (single-prompt :single-prompt) + (multiple-reader :multiple-reader) + (multiple-prompt :multiple-prompt) + (multiple-separator :multiple-separator)) (let ((completions (cond ((and completions-var completions-getter) `(or ,completions-var diff --git a/emacs/guix-utils.el b/emacs/guix-utils.el index e24b58fb17..3748350b87 100644 --- a/emacs/guix-utils.el +++ b/emacs/guix-utils.el @@ -257,6 +257,55 @@ modifier call." (guix-modify (funcall (car modifiers) object) (cdr modifiers)))) +(defmacro guix-keyword-args-let (args varlist &rest body) + "Parse ARGS, bind variables from VARLIST and eval BODY. + +Find keyword values in ARGS, bind them to variables according to +VARLIST, then evaluate BODY. + +ARGS is a keyword/value property list. + +Each element of VARLIST has a form: + + (SYMBOL KEYWORD [DEFAULT-VALUE]) + +SYMBOL is a varible name. KEYWORD is a symbol that will be +searched in ARGS for an according value. If the value of KEYWORD +does not exist, bind SYMBOL to DEFAULT-VALUE or nil. + +The rest arguments (that present in ARGS but not in VARLIST) will +be bound to `%foreign-args' variable. + +Example: + + (guix-keyword-args-let '(:two 8 :great ! :guix is) + ((one :one 1) + (two :two 2) + (foo :smth)) + (list one two foo %foreign-args)) + + => (1 8 nil (:guix is :great !))" + (declare (indent 2)) + (let ((args-var (make-symbol "args"))) + `(let (,@(mapcar (lambda (spec) + (pcase-let ((`(,name ,_ ,val) spec)) + (list name val))) + varlist) + (,args-var ,args) + %foreign-args) + (while ,args-var + (pcase ,args-var + (`(,key ,val . ,rest-args) + (cl-case key + ,@(mapcar (lambda (spec) + (pcase-let ((`(,name ,key ,_) spec)) + `(,key (setq ,name val)))) + varlist) + (t (setq %foreign-args + (cl-list* key val %foreign-args)))) + (setq ,args-var rest-args)))) + ,@body))) + ;;; Alist accessors @@ -326,7 +375,8 @@ See `defun' for the meaning of arguments." (defvar guix-utils-font-lock-keywords (eval-when-compile - `((,(rx "(" (group "guix-with-indent") + `((,(rx "(" (group (or "guix-keyword-args-let" + "guix-with-indent")) symbol-end) . 1) (,(rx "(" |