From b7065e9a022a4440dda57b0409cd440efd286837 Mon Sep 17 00:00:00 2001 From: Clemens Radermacher Date: Mon, 15 Feb 2021 02:03:02 +0100 Subject: [PATCH] Rework state mamagement --- selectrum.el | 410 +++++++++++++++++++++++++-------------------------- 1 file changed, 197 insertions(+), 213 deletions(-) diff --git a/selectrum.el b/selectrum.el index 87ea338d..275e744c 100644 --- a/selectrum.el +++ b/selectrum.el @@ -487,7 +487,7 @@ change. The results are subsequently preprocessed by `selectrum--preprocessed-candidates'. See `selectrum-read' for more details on function collections.") -(defvar selectrum--preprocessed-candidates nil +(defvar-local selectrum--preprocessed-candidates nil "Preprocessed list of candidates. This list contains the candidates of the current session after preprocessing them with @@ -495,14 +495,14 @@ preprocessing them with subsequently passed to `selectrum-refine-candidates-function'. For the refined candidates see `selectrum--refined-candidates'.") -(defvar selectrum--refined-candidates nil +(defvar-local selectrum--refined-candidates nil "Refined list of candidates to be displayed. This is derived from `selectrum--preprocessed-candidates' by `selectrum-refine-candidates-function' every time the user input changes, and is subsequently passed to `selectrum-highlight-candidates-function'.") -(defvar selectrum--current-candidate-index nil +(defvar-local selectrum--current-candidate-index nil "Index of currently selected candidate, or nil if no candidates.") (defvar-local selectrum--first-index-displayed nil @@ -511,12 +511,12 @@ changes, and is subsequently passed to (defvar-local selectrum--actual-num-candidates-displayed nil "The actual number of candidates displayed.") -(defvar selectrum--previous-input-string nil +(defvar-local selectrum--previous-input-string nil "Previous user input string in the minibuffer. Used to check if the user input has changed and candidates need to be re-filtered.") -(defvar selectrum--match-required-p nil +(defvar-local selectrum--match-required-p nil "Non-nil if the user must select one of the candidates. Equivalently, nil if the user is allowed to submit their own input that does not match any of the displayed candidates.") @@ -524,34 +524,34 @@ input that does not match any of the displayed candidates.") (defvar selectrum--crm-p nil "Non-nil for `selectrum-completing-read-multiple' sessions.") -(defvar selectrum--move-default-candidate-p nil +(defvar-local selectrum--move-default-candidate-p nil "Non-nil means move default candidate to start of list. Nil means select the default candidate initially even if it's not at the start of the list.") -(defvar selectrum--default-candidate nil +(defvar-local selectrum--default-candidate nil "Default candidate, or nil if none given.") ;; The existence of this variable is a bit of a mess, but we'll run ;; with it for now. -(defvar selectrum--visual-input nil +(defvar-local selectrum--visual-input nil "User input string as transformed by candidate refinement. See `selectrum-refine-candidates-function'.") -(defvar selectrum--read-args nil +(defvar-local selectrum--read-args nil "List of arguments passed to `selectrum-read'. Passed to various hook functions.") -(defvar selectrum--count-overlay nil +(defvar-local selectrum--count-overlay nil "Overlay used to display count information before prompt.") -(defvar selectrum--last-command nil +(defvar-local selectrum--last-command nil "Name of last interactive command that invoked Selectrum.") -(defvar selectrum--last-prefix-arg nil +(defvar-local selectrum--last-prefix-arg nil "Prefix argument given to last interactive command that invoked Selectrum.") -(defvar selectrum--repeat nil +(defvar-local selectrum--repeat nil "Non-nil means try to restore the minibuffer state during setup. This is used to implement `selectrum-repeat'.") @@ -660,9 +660,9 @@ behavior." (when selectrum-active-p (with-selected-window (active-minibuffer-window) (let ((string (or string (minibuffer-contents)))) - (setq selectrum--refined-candidates - (list string)) - (setq selectrum--current-candidate-index 0) + (setq-local selectrum--refined-candidates + (list string)) + (setq-local selectrum--current-candidate-index 0) ;; Skip updates. (setq-local selectrum--skip-updates-p t))))) @@ -709,8 +709,8 @@ when possible (it is still a member of the candidate set)." (with-selected-window mini (when (and minibuffer-completion-table (not selectrum--dynamic-candidates)) - (setq selectrum--preprocessed-candidates nil)) - (setq selectrum--previous-input-string nil) + (setq-local selectrum--preprocessed-candidates nil)) + (setq-local selectrum--previous-input-string nil) (selectrum--update (and keep-selection (selectrum-get-current-candidate)))))) @@ -1046,46 +1046,49 @@ the update." (point-max))) (keep-mark-active (not deactivate-mark))) (unless (equal input selectrum--previous-input-string) - (setq selectrum--previous-input-string input) + ;; Always save globally, too. + (setq-default selectrum--previous-input-string input) + (setq-local selectrum--previous-input-string input) ;; Reset the persistent input, so that it will be nil if ;; there's no special attention needed. - (setq selectrum--visual-input nil) + (setq-local selectrum--visual-input nil) (let ((dynamic (functionp selectrum--dynamic-candidates)) (init-table (and (not selectrum--preprocessed-candidates) minibuffer-completion-table))) ;; Compute `selectrum--preprocessed-candidates' if necessary. (when (or dynamic init-table) - (setq selectrum--preprocessed-candidates - (cond (dynamic - (let* ((result - ;; Ensure dynamic functions won't - ;; break in post command hook. - (condition-case-unless-debug err - (funcall - selectrum--dynamic-candidates - input) - (error (message (error-message-string err)) - nil))) - (cands - ;; Avoid modifying the returned - ;; candidates to let the function - ;; reuse them. - (copy-sequence - (if (stringp (car result)) - result - (setq input (or (alist-get 'input result) - input)) - (setq selectrum--visual-input input) - (alist-get 'candidates result))))) - (funcall selectrum-preprocess-candidates-function - cands))) - (init-table - ;; No candidates were passed, initialize them - ;; from `minibuffer-completion-table'. - (funcall selectrum-preprocess-candidates-function - (selectrum--normalize-collection - minibuffer-completion-table - minibuffer-completion-predicate))))) + (setq-local + selectrum--preprocessed-candidates + (cond (dynamic + (let* ((result + ;; Ensure dynamic functions won't + ;; break in post command hook. + (condition-case-unless-debug err + (funcall + selectrum--dynamic-candidates + input) + (error (message (error-message-string err)) + nil))) + (cands + ;; Avoid modifying the returned + ;; candidates to let the function + ;; reuse them. + (copy-sequence + (if (stringp (car result)) + result + (setq input (or (alist-get 'input result) + input)) + (setq-local selectrum--visual-input input) + (alist-get 'candidates result))))) + (funcall selectrum-preprocess-candidates-function + cands))) + (init-table + ;; No candidates were passed, initialize them + ;; from `minibuffer-completion-table'. + (funcall selectrum-preprocess-candidates-function + (selectrum--normalize-collection + minibuffer-completion-table + minibuffer-completion-predicate))))) (setq selectrum--total-num-candidates (length selectrum--preprocessed-candidates)))) ;; Do refinement. @@ -1101,81 +1104,83 @@ the update." selectrum--completion-pcm-all-completions "") completion-styles-alist) completion-styles-alist))) - (setq selectrum--refined-candidates - (funcall selectrum-refine-candidates-function - input cands))) + (setq-local selectrum--refined-candidates + (funcall selectrum-refine-candidates-function + input cands))) (when selectrum--virtual-default-file - (setq selectrum--refined-candidates - (cons (propertize - selectrum--virtual-default-file - 'face 'shadow) - selectrum--refined-candidates)) + (setq-local selectrum--refined-candidates + (cons (propertize + selectrum--virtual-default-file + 'face 'shadow) + selectrum--refined-candidates)) (setq-local selectrum--virtual-default-file nil)) (when (and selectrum--move-default-candidate-p selectrum--default-candidate) - (setq selectrum--refined-candidates - (selectrum--move-to-front-destructive - selectrum--default-candidate - selectrum--refined-candidates))) - (setq selectrum--refined-candidates - (selectrum--move-to-front-destructive - ;; Make sure matching dirnames are sorted first. - (if (and minibuffer-completing-file-name - (member (file-name-as-directory input) - selectrum--refined-candidates)) - (file-name-as-directory input) - input) - selectrum--refined-candidates)) - (setq selectrum--refined-candidates - (delete "" selectrum--refined-candidates)) + (setq-local selectrum--refined-candidates + (selectrum--move-to-front-destructive + selectrum--default-candidate + selectrum--refined-candidates))) + (setq-local selectrum--refined-candidates + (selectrum--move-to-front-destructive + ;; Make sure matching dirnames are sorted first. + (if (and minibuffer-completing-file-name + (member (file-name-as-directory input) + selectrum--refined-candidates)) + (file-name-as-directory input) + input) + selectrum--refined-candidates)) + (setq-local selectrum--refined-candidates + (delete "" selectrum--refined-candidates)) (setq-local selectrum--first-index-displayed nil) (setq-local selectrum--actual-num-candidates-displayed nil) (if selectrum--repeat (progn - (setq selectrum--current-candidate-index - (and (> (length selectrum--refined-candidates) 0) - (min (or selectrum--current-candidate-index 0) - (1- (length selectrum--refined-candidates))))) - (setq selectrum--repeat nil)) - (setq selectrum--current-candidate-index - (cond - ;; Check for candidates needs to be first! - ((null selectrum--refined-candidates) - (when (or (not selectrum--match-required-p) - (selectrum--at-existing-prompt-path-p)) - -1)) - (keep-selected - (or (cl-position keep-selected - selectrum--refined-candidates - :key #'selectrum--get-full - :test #'equal) - 0)) - ((and selectrum--default-candidate - (string-empty-p (minibuffer-contents)) - (not (member selectrum--default-candidate - selectrum--refined-candidates))) - -1) - ((or (and selectrum--init-p - (equal selectrum--default-candidate - (minibuffer-contents))) - (and (not (= (minibuffer-prompt-end) (point-max))) - (or (and minibuffer-history-position - (not (zerop minibuffer-history-position)) - isearch-mode) - (memq this-command - '(next-history-element - previous-history-element))) - (or (not selectrum--match-required-p) - (selectrum--at-existing-prompt-path-p)))) - -1) - (selectrum--move-default-candidate-p - 0) - (t - (or (cl-position selectrum--default-candidate - selectrum--refined-candidates - :key #'selectrum--get-full - :test #'equal) - 0)))))) + (setq-default + selectrum--current-candidate-index + (and (> (length selectrum--refined-candidates) 0) + (min (or selectrum--current-candidate-index 0) + (1- (length selectrum--refined-candidates))))) + (setq-local selectrum--repeat nil)) + (setq-local selectrum--current-candidate-index + (cond + ;; Check for candidates needs to be first! + ((null selectrum--refined-candidates) + (when (or (not selectrum--match-required-p) + (selectrum--at-existing-prompt-path-p)) + -1)) + (keep-selected + (or (cl-position keep-selected + selectrum--refined-candidates + :key #'selectrum--get-full + :test #'equal) + 0)) + ((and selectrum--default-candidate + (string-empty-p (minibuffer-contents)) + (not (member selectrum--default-candidate + selectrum--refined-candidates))) + -1) + ((or (and selectrum--init-p + (equal selectrum--default-candidate + (minibuffer-contents))) + (and (not (= (minibuffer-prompt-end) (point-max))) + (or (and minibuffer-history-position + (not (zerop + minibuffer-history-position)) + isearch-mode) + (memq this-command + '(next-history-element + previous-history-element))) + (or (not selectrum--match-required-p) + (selectrum--at-existing-prompt-path-p)))) + -1) + (selectrum--move-default-candidate-p + 0) + (t + (or (cl-position selectrum--default-candidate + selectrum--refined-candidates + :key #'selectrum--get-full + :test #'equal) + 0)))))) ;; Always keep the visual input if defined. (setq input (or selectrum--visual-input input)) ;; Handle prompt selection. @@ -1676,7 +1681,7 @@ defaults to `completion-extra-properties'." (remove-hook 'minibuffer-exit-hook #'selectrum--minibuffer-exit-hook 'local) (when (overlayp selectrum--count-overlay) (delete-overlay selectrum--count-overlay)) - (setq selectrum--count-overlay nil)) + (setq-local selectrum--count-overlay nil)) (defun selectrum--minibuffer-setup-hook (candidates default buf) "Set up minibuffer for interactive candidate selection. @@ -1685,13 +1690,20 @@ CANDIDATES is the list of strings that was passed to overridden and BUF the buffer the session was started from." (setq-local selectrum-active-p t) (setq-local selectrum--last-buffer buf) + (cond (selectrum--repeat + (delete-minibuffer-contents) + (insert selectrum--previous-input-string)) + ((eq (minibuffer-depth) t) + (setq-default selectrum--last-command this-command) + (setq-default selectrum--last-prefix-arg current-prefix-arg)) + (t + (with-current-buffer selectrum--last-buffer + (setq-local selectrum--last-command this-command) + (setq-local selectrum--last-prefix-arg current-prefix-arg)))) (setq-local auto-hscroll-mode nil) (add-hook 'minibuffer-exit-hook #'selectrum--minibuffer-exit-hook nil 'local) (setq-local selectrum--init-p t) - (when selectrum--repeat - (delete-minibuffer-contents) - (insert selectrum--previous-input-string)) (unless selectrum--candidates-overlay (setq selectrum--candidates-overlay (make-overlay (point) (point) nil 'front-advance 'rear-advance))) @@ -1700,23 +1712,23 @@ overridden and BUF the buffer the session was started from." (when-let ((sortf (selectrum--get-meta 'display-sort-function))) (setq-local selectrum-preprocess-candidates-function sortf)) (cond ((functionp candidates) - (setq selectrum--preprocessed-candidates nil) + (setq-local selectrum--preprocessed-candidates nil) (setq selectrum--total-num-candidates 0) (setq-local selectrum--dynamic-candidates candidates)) (t - (setq selectrum--preprocessed-candidates - (funcall selectrum-preprocess-candidates-function - candidates)) + (setq-local selectrum--preprocessed-candidates + (funcall selectrum-preprocess-candidates-function + candidates)) (setq selectrum--total-num-candidates (length candidates)))) - (setq selectrum--default-candidate - (if (and default (symbolp default)) - (symbol-name default) - default)) + (setq-local selectrum--default-candidate + (if (and default (symbolp default)) + (symbol-name default) + default)) ;; Make sure to trigger an "user input changed" event, so that ;; candidate refinement happens in `post-command-hook' and an index ;; is assigned. - (setq selectrum--previous-input-string nil) - (setq selectrum--count-overlay (make-overlay (point-min) (point-min))) + (setq-local selectrum--previous-input-string nil) + (setq-local selectrum--count-overlay (make-overlay (point-min) (point-min))) (setq-local selectrum--line-height (line-pixel-height)) (add-hook 'post-command-hook @@ -1756,25 +1768,25 @@ overridden and BUF the buffer the session was started from." "Move selection downwards by ARG pages, stopping at the end." (interactive "p") (when selectrum--current-candidate-index - (setq selectrum--current-candidate-index - (selectrum--clamp - (+ selectrum--current-candidate-index - (* (or arg 1) selectrum--actual-num-candidates-displayed)) - 0 - (1- (length selectrum--refined-candidates)))))) + (setq-local selectrum--current-candidate-index + (selectrum--clamp + (+ selectrum--current-candidate-index + (* (or arg 1) selectrum--actual-num-candidates-displayed)) + 0 + (1- (length selectrum--refined-candidates)))))) (defun selectrum-goto-beginning () "Move selection to first candidate." (interactive) (when selectrum--current-candidate-index - (setq selectrum--current-candidate-index 0))) + (setq-local selectrum--current-candidate-index 0))) (defun selectrum-goto-end () "Move selection to last candidate." (interactive) (when selectrum--current-candidate-index - (setq selectrum--current-candidate-index - (1- (length selectrum--refined-candidates))))) + (setq-local selectrum--current-candidate-index + (1- (length selectrum--refined-candidates))))) (defun selectrum-kill-ring-save () "Save current candidate to kill ring. @@ -1934,7 +1946,7 @@ refresh." ;; Ensure refresh of UI. The input input string might be the ;; same when the prompt was reinserted. When the prompt was ;; selected this will switch selection to first candidate. - (setq selectrum--previous-input-string nil) + (setq-local selectrum--previous-input-string nil) (when minibuffer-completing-file-name ;; Possibly force a refresh for files. (setq-local selectrum--inserted-file-completion t)) @@ -2016,33 +2028,6 @@ Otherwise, just eval BODY." ,@body) ,@body)) -(defmacro selectrum--save-global-state (&rest body) - "Eval BODY, restoring all Selectrum global variables afterward." - (declare (indent 0)) - `(let (,@(mapcar - (lambda (var) - `(,var ,var)) - '(selectrum--preprocessed-candidates - selectrum--refined-candidates - selectrum--match-required-p - selectrum--move-default-candidate-p - selectrum--default-candidate - selectrum--visual-input - selectrum--read-args - selectrum--count-overlay - selectrum--repeat))) - ;; https://github.com/raxod502/selectrum/issues/39#issuecomment-618350477 - (selectrum--let-maybe - selectrum-active-p - (,@(mapcar - (lambda (var) - `(,var ,var)) - '(selectrum--current-candidate-index - selectrum--previous-input-string - selectrum--last-command - selectrum--last-prefix-arg))) - ,@body))) - (cl-defun selectrum-read (prompt candidates &rest args &key default-candidate initial-input require-match @@ -2101,48 +2086,45 @@ semantics of `cl-defun'." (unless (or may-modify-candidates (functionp candidates)) (setq candidates (copy-sequence candidates))) - (selectrum--save-global-state - (setq selectrum--read-args (cl-list* prompt candidates args)) - (unless selectrum--repeat - (setq selectrum--last-command this-command) - (setq selectrum--last-prefix-arg current-prefix-arg)) - (setq selectrum--match-required-p require-match) - (setq selectrum--move-default-candidate-p (not no-move-default-candidate)) - (let* ((minibuffer-allow-text-properties t) - (resize-mini-windows 'grow-only) - (prompt (selectrum--remove-default-from-prompt prompt)) - ;; - (icomplete-mode nil) - (buf (current-buffer)) - (res + (setq-local selectrum--read-args (cl-list* prompt candidates args)) + (setq-local selectrum--match-required-p require-match) + (setq-local selectrum--move-default-candidate-p + (not no-move-default-candidate)) + (let* ((minibuffer-allow-text-properties t) + (resize-mini-windows 'grow-only) + (prompt (selectrum--remove-default-from-prompt prompt)) + ;; + (icomplete-mode nil) + (buf (current-buffer)) + (res + (selectrum--minibuffer-with-setup-hook + (lambda () + ;; Already set the active flag as early as possible + ;; so client setup hooks can use it to detect if + ;; they are running in a Selectrum session. + (setq-local selectrum-active-p t)) (selectrum--minibuffer-with-setup-hook - (lambda () - ;; Already set the active flag as early as possible - ;; so client setup hooks can use it to detect if - ;; they are running in a Selectrum session. - (setq-local selectrum-active-p t)) - (selectrum--minibuffer-with-setup-hook - (:append (lambda () - (selectrum--minibuffer-setup-hook - candidates - (or (car-safe minibuffer-default) - minibuffer-default - default-candidate) - buf))) - (read-from-minibuffer - prompt initial-input selectrum-minibuffer-map nil - (or history 'minibuffer-history) default-candidate))))) - (cond (minibuffer-completion-table - ;; Behave like completing-read-default which strips the - ;; text properties but leaves the default unchanged - ;; when submitting the empty prompt to get it (see - ;; #180, #107). - (if (and selectrum--previous-input-string - (string-empty-p selectrum--previous-input-string) - (equal res selectrum--default-candidate)) - default-candidate - (substring-no-properties res))) - (t res))))) + (:append (lambda () + (selectrum--minibuffer-setup-hook + candidates + (or (car-safe minibuffer-default) + minibuffer-default + default-candidate) + buf))) + (read-from-minibuffer + prompt initial-input selectrum-minibuffer-map nil + (or history 'minibuffer-history) default-candidate))))) + (cond (minibuffer-completion-table + ;; Behave like completing-read-default which strips the + ;; text properties but leaves the default unchanged + ;; when submitting the empty prompt to get it (see + ;; #180, #107). + (if (and selectrum--previous-input-string + (string-empty-p selectrum--previous-input-string) + (equal res selectrum--default-candidate)) + default-candidate + (substring-no-properties res))) + (t res)))) ;;;###autoload (defun selectrum-completing-read @@ -2712,9 +2694,11 @@ shadows correctly." (interactive) (unless selectrum--last-command (user-error "No Selectrum command has been run yet")) - (let ((selectrum--repeat t)) - (setq current-prefix-arg selectrum--last-prefix-arg - this-command selectrum--last-command) + (setq current-prefix-arg selectrum--last-prefix-arg + this-command selectrum--last-command) + (selectrum--minibuffer-with-setup-hook + (lambda () + (setq-local selectrum--repeat t)) (call-interactively selectrum--last-command))) ;;;###autoload