From dac0307a8004d5ef5d9436ac2dec8f16771ce8b8 Mon Sep 17 00:00:00 2001 From: Henrik Lissner Date: Wed, 14 Mar 2018 19:03:28 -0400 Subject: [PATCH] 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). --- core/autoload/menu.el | 105 ++++++++++++++++++++++++------------------ 1 file changed, 60 insertions(+), 45 deletions(-) diff --git a/core/autoload/menu.el b/core/autoload/menu.el index c9e86a0b5..722ebec53 100644 --- a/core/autoload/menu.el +++ b/core/autoload/menu.el @@ -7,6 +7,9 @@ "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!').") +(defvar-local doom-menu-last-command nil + "TODO") + (defun doom-menu-read-default (prompt commands) "Default method for displaying a completion-select prompt." (completing-read prompt (mapcar #'car commands))) @@ -19,27 +22,31 @@ PROMPT (a string) and COMMAND (a list of command plists; see `def-menu!').") ;;;###autoload (defun doom--menu-exec (plist) - (let ((command (plist-get plist :exec)) - (cwd (plist-get plist :cwd))) - (let ((default-directory - (cond ((eq cwd t) (doom-project-root)) - ((stringp cwd) cwd) - (t default-directory)))) - (cond ((stringp command) - (with-current-buffer (get-buffer-create "*compilation*") - (save-window-excursion - (compile command)) - (setq header-line-format - (concat (propertize "$ " 'face 'font-lock-doc-face) - (propertize command 'face 'font-lock-preprocessor-face))) - (pop-to-buffer (current-buffer)))) - ((or (symbolp command) - (functionp command)) - (call-interactively command)) - ((and command (listp command)) - (eval command t)) - (t - (error "Not a valid command: %s" command)))))) + (save-selected-window + (let ((command (plist-get plist :exec)) + (cwd (plist-get plist :cwd))) + (let ((default-directory + (cond ((eq cwd t) (doom-project-root)) + ((stringp cwd) cwd) + ((functionp cwd) (funcall cwd)) + (t default-directory)))) + (cond ((stringp command) + (let (buf) + (compile command) + (setq buf next-error-last-buffer) + (unless buf + (error "Couldn't create compilation buffer")) + (with-current-buffer buf + (setq header-line-format + (concat (propertize "$ " 'face 'font-lock-doc-face) + (propertize command 'face 'font-lock-preprocessor-face)))))) + ((or (symbolp command) + (functionp command)) + (call-interactively command)) + ((and command (listp command)) + (eval command t)) + (t + (error "Not a valid command: %s" command))))))) ;;;###autoload (defmacro def-menu! (name desc commands &rest plist) @@ -56,8 +63,8 @@ PROPERTIES accepts the following properties: :when FORM :unless FORM :region BOOL - :cwd t|PATH - :project BOOL|DIRECTORY + :cwd BOOL|PATH|FUNCTION + :project BOOL|PATH|FUNCTION COMMAND can be a string (a shell command), a symbol (an elisp function) or a lisp form. @@ -70,34 +77,42 @@ lisp form. (prop-prompt (or (plist-get plist :prompt) "> ")) (prop-sort (plist-get plist :sort))) `(progn - (defvar ,commands-var + (defconst ,commands-var ,(if prop-sort `(cl-sort ,commands #'string-lessp :key #'car) commands) ,(format "Menu for %s" name)) - (defun ,name () - ,desc - (interactive) + (defun ,name (arg) + ,(concat + (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 (user-error "The '%s' menu is empty" ',name)) (doom--menu-exec - (or (doom--menu-read - ,prop-prompt - (or (cl-remove-if-not - (let ((project-root (doom-project-root))) - (lambda (cmd) - (let ((plist (cdr cmd))) - (and (cond ((not (plist-member plist :region)) t) - ((plist-get plist :region) (use-region-p)) - (t (not (use-region-p)))) - (let ((when (plist-get plist :when)) - (unless (plist-get plist :unless)) - (project (plist-get plist :project))) - (or (or (not when) (eval when)) - (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"))) + (or (unless arg doom-menu-last-command) + (setq doom-menu-last-command + (doom--menu-read + ,prop-prompt + (or (cl-remove-if-not + (let ((project-root (doom-project-root))) + (lambda (cmd) + (let ((plist (cdr cmd))) + (and (cond ((not (plist-member plist :region)) t) + ((plist-get plist :region) (use-region-p)) + (t (not (use-region-p)))) + (let ((when (plist-get plist :when)) + (unless (plist-get plist :unless)) + (project (plist-get plist :project))) + (when (functionp project) + (setq project (funcall project))) + (or (or (not when) (eval when)) + (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")))))))