M emacs/guix-base.el => emacs/guix-base.el +49 -57
@@ 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)
M emacs/guix-list.el => emacs/guix-list.el +31 -39
@@ 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)
M emacs/guix-read.el => emacs/guix-read.el +8 -20
@@ 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
M emacs/guix-utils.el => emacs/guix-utils.el +51 -1
@@ 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 "("