Rewrite menu system

On consecutive runs, def-menu dispatchers now rerun the last command,
unless the universal argument is passed. e.g. SPC u SPC m b

The :cwd and :project properties now accept functions (take no arguments
and return a directory or boolean).
This commit is contained in:
Henrik Lissner 2018-03-14 19:03:28 -04:00
parent dba1f20dd3
commit dac0307a80
No known key found for this signature in database
GPG key ID: 5F6C0EA160557395

View file

@ -7,6 +7,9 @@
"The method to use to prompt the user with the menu. This takes two arguments: "The method to use to prompt the user with the menu. This takes two arguments:
PROMPT (a string) and COMMAND (a list of command plists; see `def-menu!').") PROMPT (a string) and COMMAND (a list of command plists; see `def-menu!').")
(defvar-local doom-menu-last-command nil
"TODO")
(defun doom-menu-read-default (prompt commands) (defun doom-menu-read-default (prompt commands)
"Default method for displaying a completion-select prompt." "Default method for displaying a completion-select prompt."
(completing-read prompt (mapcar #'car commands))) (completing-read prompt (mapcar #'car commands)))
@ -19,27 +22,31 @@ PROMPT (a string) and COMMAND (a list of command plists; see `def-menu!').")
;;;###autoload ;;;###autoload
(defun doom--menu-exec (plist) (defun doom--menu-exec (plist)
(save-selected-window
(let ((command (plist-get plist :exec)) (let ((command (plist-get plist :exec))
(cwd (plist-get plist :cwd))) (cwd (plist-get plist :cwd)))
(let ((default-directory (let ((default-directory
(cond ((eq cwd t) (doom-project-root)) (cond ((eq cwd t) (doom-project-root))
((stringp cwd) cwd) ((stringp cwd) cwd)
((functionp cwd) (funcall cwd))
(t default-directory)))) (t default-directory))))
(cond ((stringp command) (cond ((stringp command)
(with-current-buffer (get-buffer-create "*compilation*") (let (buf)
(save-window-excursion (compile command)
(compile command)) (setq buf next-error-last-buffer)
(unless buf
(error "Couldn't create compilation buffer"))
(with-current-buffer buf
(setq header-line-format (setq header-line-format
(concat (propertize "$ " 'face 'font-lock-doc-face) (concat (propertize "$ " 'face 'font-lock-doc-face)
(propertize command 'face 'font-lock-preprocessor-face))) (propertize command 'face 'font-lock-preprocessor-face))))))
(pop-to-buffer (current-buffer))))
((or (symbolp command) ((or (symbolp command)
(functionp command)) (functionp command))
(call-interactively command)) (call-interactively command))
((and command (listp command)) ((and command (listp command))
(eval command t)) (eval command t))
(t (t
(error "Not a valid command: %s" command)))))) (error "Not a valid command: %s" command)))))))
;;;###autoload ;;;###autoload
(defmacro def-menu! (name desc commands &rest plist) (defmacro def-menu! (name desc commands &rest plist)
@ -56,8 +63,8 @@ PROPERTIES accepts the following properties:
:when FORM :when FORM
:unless FORM :unless FORM
:region BOOL :region BOOL
:cwd t|PATH :cwd BOOL|PATH|FUNCTION
:project BOOL|DIRECTORY :project BOOL|PATH|FUNCTION
COMMAND can be a string (a shell command), a symbol (an elisp function) or a COMMAND can be a string (a shell command), a symbol (an elisp function) or a
lisp form. lisp form.
@ -70,18 +77,24 @@ lisp form.
(prop-prompt (or (plist-get plist :prompt) "> ")) (prop-prompt (or (plist-get plist :prompt) "> "))
(prop-sort (plist-get plist :sort))) (prop-sort (plist-get plist :sort)))
`(progn `(progn
(defvar ,commands-var (defconst ,commands-var
,(if prop-sort ,(if prop-sort
`(cl-sort ,commands #'string-lessp :key #'car) `(cl-sort ,commands #'string-lessp :key #'car)
commands) commands)
,(format "Menu for %s" name)) ,(format "Menu for %s" name))
(defun ,name () (defun ,name (arg)
,desc ,(concat
(interactive) (if (stringp desc) (concat desc "\n\n"))
"This is a command dispatcher. It will rerun the last command on\n"
"consecutive executions. If ARG (universal argument) is non-nil\n"
"then it always prompt you.")
(interactive "P")
(unless ,commands-var (unless ,commands-var
(user-error "The '%s' menu is empty" ',name)) (user-error "The '%s' menu is empty" ',name))
(doom--menu-exec (doom--menu-exec
(or (doom--menu-read (or (unless arg doom-menu-last-command)
(setq doom-menu-last-command
(doom--menu-read
,prop-prompt ,prop-prompt
(or (cl-remove-if-not (or (cl-remove-if-not
(let ((project-root (doom-project-root))) (let ((project-root (doom-project-root)))
@ -93,11 +106,13 @@ lisp form.
(let ((when (plist-get plist :when)) (let ((when (plist-get plist :when))
(unless (plist-get plist :unless)) (unless (plist-get plist :unless))
(project (plist-get plist :project))) (project (plist-get plist :project)))
(when (functionp project)
(setq project (funcall project)))
(or (or (not when) (eval when)) (or (or (not when) (eval when))
(or (not unless) (not (eval unless))) (or (not unless) (not (eval unless)))
(and (stringp project) (and (stringp project)
(file-in-directory-p buffer-file-name project-root)))))))) (file-in-directory-p buffer-file-name project-root))))))))
,commands-var) ,commands-var)
(user-error "No commands available here"))) (user-error "No commands available here"))))
(user-error "No command selected"))))))) (user-error "No command selected")))))))