emacs: Add 'guix-keyword-args-let'.
* emacs/guix-utils.el (guix-keyword-args-let): New macro. (guix-utils-font-lock-keywords): Add it. * emacs/guix-base.el (guix-define-buffer-type): Use it. * emacs/guix-list.el (guix-list-define-entry-type): Use it. * emacs/guix-read.el (guix-define-readers): Use it.
This commit is contained in:
Alex Kost
parent
376af769f9
commit
4ba476f949
4 changed files with 131 additions and 109 deletions
|
|
@ -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)))
|
||||
(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)))
|
||||
|
||||
;; 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))))
|
||||
(defgroup ,faces-group nil
|
||||
,(concat "Faces for " buf-type-str " buffer with " entry-str ".")
|
||||
:group ',(intern (concat "guix-" buf-type-str "-faces")))
|
||||
|
||||
`(progn
|
||||
(defgroup ,group nil
|
||||
,(concat Buf-type-str " buffer with " entry-str ".")
|
||||
:prefix ,(concat prefix "-")
|
||||
:group ',(intern (concat "guix-" buf-type-str)))
|
||||
(defcustom ,buf-name-var ,buf-name-val
|
||||
,(concat "Default name of the " buf-str " for displaying " entry-str ".")
|
||||
:type 'string
|
||||
:group ',group)
|
||||
|
||||
(defgroup ,faces-group nil
|
||||
,(concat "Faces for " buf-type-str " buffer with " entry-str ".")
|
||||
:group ',(intern (concat "guix-" buf-type-str "-faces")))
|
||||
(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 ,buf-name-var ,buf-name-val
|
||||
,(concat "Default name of the " buf-str " for displaying " entry-str ".")
|
||||
:type 'string
|
||||
: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)
|
||||
|
||||
(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)
|
||||
(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."))
|
||||
|
||||
(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))))))
|
||||
(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)
|
||||
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
(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'."))
|
||||
|
||||
;; 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))))
|
||||
,@(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)
|
||||
|
||||
`(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)))))
|
||||
(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)
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 "("
|
||||
|
|
|
|||
Reference in a new issue