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)
(let ((command (plist-get plist :exec)) (save-selected-window
(cwd (plist-get plist :cwd))) (let ((command (plist-get plist :exec))
(let ((default-directory (cwd (plist-get plist :cwd)))
(cond ((eq cwd t) (doom-project-root)) (let ((default-directory
((stringp cwd) cwd) (cond ((eq cwd t) (doom-project-root))
(t default-directory)))) ((stringp cwd) cwd)
(cond ((stringp command) ((functionp cwd) (funcall cwd))
(with-current-buffer (get-buffer-create "*compilation*") (t default-directory))))
(save-window-excursion (cond ((stringp command)
(compile command)) (let (buf)
(setq header-line-format (compile command)
(concat (propertize "$ " 'face 'font-lock-doc-face) (setq buf next-error-last-buffer)
(propertize command 'face 'font-lock-preprocessor-face))) (unless buf
(pop-to-buffer (current-buffer)))) (error "Couldn't create compilation buffer"))
((or (symbolp command) (with-current-buffer buf
(functionp command)) (setq header-line-format
(call-interactively command)) (concat (propertize "$ " 'face 'font-lock-doc-face)
((and command (listp command)) (propertize command 'face 'font-lock-preprocessor-face))))))
(eval command t)) ((or (symbolp command)
(t (functionp command))
(error "Not a valid command: %s" command)))))) (call-interactively command))
((and command (listp command))
(eval command t))
(t
(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,34 +77,42 @@ 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)
,prop-prompt (setq doom-menu-last-command
(or (cl-remove-if-not (doom--menu-read
(let ((project-root (doom-project-root))) ,prop-prompt
(lambda (cmd) (or (cl-remove-if-not
(let ((plist (cdr cmd))) (let ((project-root (doom-project-root)))
(and (cond ((not (plist-member plist :region)) t) (lambda (cmd)
((plist-get plist :region) (use-region-p)) (let ((plist (cdr cmd)))
(t (not (use-region-p)))) (and (cond ((not (plist-member plist :region)) t)
(let ((when (plist-get plist :when)) ((plist-get plist :region) (use-region-p))
(unless (plist-get plist :unless)) (t (not (use-region-p))))
(project (plist-get plist :project))) (let ((when (plist-get plist :when))
(or (or (not when) (eval when)) (unless (plist-get plist :unless))
(or (not unless) (not (eval unless))) (project (plist-get plist :project)))
(and (stringp project) (when (functionp project)
(file-in-directory-p buffer-file-name project-root)))))))) (setq project (funcall project)))
,commands-var) (or (or (not when) (eval when))
(user-error "No commands available here"))) (or (not unless) (not (eval unless)))
(and (stringp project)
(file-in-directory-p buffer-file-name project-root))))))))
,commands-var)
(user-error "No commands available here"))))
(user-error "No command selected"))))))) (user-error "No command selected")))))))