From adfccae7be2dff68ecbded1b47d5029e4e86dc00 Mon Sep 17 00:00:00 2001 From: Daniel Mendler Date: Wed, 3 Jan 2024 15:01:08 +0100 Subject: Store extra properties in completion-in-region--data --- README.org | 2 +- corfu.el | 51 +++++++++++++++++++------------------------ extensions/corfu-echo.el | 3 ++- extensions/corfu-info.el | 10 +++++---- extensions/corfu-popupinfo.el | 6 +++-- 5 files changed, 36 insertions(+), 36 deletions(-) diff --git a/README.org b/README.org index f2497e5..7d4a52d 100644 --- a/README.org +++ b/README.org @@ -470,7 +470,7 @@ The command ~corfu-move-to-minibuffer~ is defined here in terms of (defun corfu-move-to-minibuffer () (interactive) (when completion-in-region--data - (let ((completion-extra-properties corfu--extra) + (let ((completion-extra-properties (nth 4 completion-in-region--data)) completion-cycle-threshold completion-cycling) (apply #'consult-completion-in-region completion-in-region--data)))) (keymap-set corfu-map "M-m" #'corfu-move-to-minibuffer) diff --git a/corfu.el b/corfu.el index dbdf6f1..941005b 100644 --- a/corfu.el +++ b/corfu.el @@ -295,9 +295,6 @@ See also the settings `corfu-auto-delay', `corfu-auto-prefix' and (defvar corfu--preview-ov nil "Current candidate overlay.") -(defvar corfu--extra nil - "Extra completion properties.") - (defvar corfu--change-group nil "Undo change group.") @@ -316,7 +313,6 @@ See also the settings `corfu-auto-delay', `corfu-auto-prefix' and corfu--input corfu--total corfu--preview-ov - corfu--extra corfu--change-group corfu--metadata)) "Initial Corfu state.") @@ -684,7 +680,7 @@ FRAME is the existing frame." (defun corfu--update (&optional interruptible) "Update state, optionally INTERRUPTIBLE." - (pcase-let* ((`(,beg ,end ,table ,pred) completion-in-region--data) + (pcase-let* ((`(,beg ,end ,table ,pred . ,_) completion-in-region--data) (pt (- (point) beg)) (str (buffer-substring-no-properties beg end)) (input (cons str pt))) @@ -863,7 +859,7 @@ Lookup STR in CANDS to restore text properties." (defun corfu--done (str status cands) "Exit completion and call the exit function with STR and STATUS. Lookup STR in CANDS to restore text properties." - (let ((completion-extra-properties corfu--extra)) + (let ((completion-extra-properties (nth 4 completion-in-region--data))) ;; For successful completions, amalgamate undo operations, ;; such that completion can be undone in a single step. (undo-amalgamate-change-group corfu--change-group) @@ -875,8 +871,7 @@ Lookup STR in CANDS to restore text properties." See `completion-in-region' for the arguments BEG, END, TABLE, PRED." (setq beg (if (markerp beg) beg (copy-marker beg)) end (if (and (markerp end) (marker-insertion-type end)) end (copy-marker end t)) - completion-in-region--data (list beg end table pred) - corfu--extra completion-extra-properties) + completion-in-region--data (list beg end table pred completion-extra-properties)) (completion-in-region-mode 1) (activate-change-group (setq corfu--change-group (prepare-change-group))) (setcdr (assq #'completion-in-region-mode minor-mode-overriding-map-alist) corfu-map) @@ -1088,25 +1083,25 @@ A scroll bar is displayed from LO to LO+BAR." (cl-defgeneric corfu--affixate (cands) "Annotate CANDS with annotation function." - (setq cands - (if-let ((aff (or (corfu--metadata-get 'affixation-function) - (plist-get corfu--extra :affixation-function)))) - (funcall aff cands) - (if-let ((ann (or (corfu--metadata-get 'annotation-function) - (plist-get corfu--extra :annotation-function)))) - (cl-loop for cand in cands collect - (let ((suffix (or (funcall ann cand) ""))) - ;; The default completion UI adds the - ;; `completions-annotations' face if no other faces are - ;; present. We use a custom `corfu-annotations' face to - ;; allow further styling which fits better for popups. - (unless (text-property-not-all 0 (length suffix) 'face nil suffix) - (setq suffix (propertize suffix 'face 'corfu-annotations))) - (list cand "" suffix))) - (cl-loop for cand in cands collect (list cand "" ""))))) - (let* ((dep (plist-get corfu--extra :company-deprecated)) - (completion-extra-properties corfu--extra) + (let* ((completion-extra-properties (nth 4 completion-in-region--data)) + (dep (plist-get completion-extra-properties :company-deprecated)) (mf (run-hook-with-args-until-success 'corfu-margin-formatters corfu--metadata))) + (setq cands + (if-let ((aff (or (corfu--metadata-get 'affixation-function) + (plist-get completion-extra-properties :affixation-function)))) + (funcall aff cands) + (if-let ((ann (or (corfu--metadata-get 'annotation-function) + (plist-get completion-extra-properties :annotation-function)))) + (cl-loop for cand in cands collect + (let ((suff (or (funcall ann cand) ""))) + ;; The default completion UI adds the + ;; `completions-annotations' face if no other faces are + ;; present. We use a custom `corfu-annotations' face to + ;; allow further styling which fits better for popups. + (unless (text-property-not-all 0 (length suff) 'face nil suff) + (setq suff (propertize suff 'face 'corfu-annotations))) + (list cand "" suff))) + (cl-loop for cand in cands collect (list cand "" ""))))) (cl-loop for x in cands for (c . _) = x do (when mf (setf (cadr x) (funcall mf c))) @@ -1137,7 +1132,7 @@ A scroll bar is displayed from LO to LO+BAR." (cl-defgeneric corfu--exhibit (&optional auto) "Exhibit Corfu UI. AUTO is non-nil when initializing auto completion." - (pcase-let ((`(,beg ,end ,table ,pred) completion-in-region--data) + (pcase-let ((`(,beg ,end ,table ,pred . ,_) completion-in-region--data) (`(,str . ,pt) (corfu--update 'interruptible))) (cond ;; 1) Single exactly matching candidate and no further completion is possible. @@ -1278,7 +1273,7 @@ first." "Try to complete current input. If a candidate is selected, insert it." (interactive) - (pcase-let ((`(,beg ,end ,table ,pred) completion-in-region--data)) + (pcase-let ((`(,beg ,end ,table ,pred . ,_) completion-in-region--data)) (if (>= corfu--index 0) ;; Continue completion with selected candidate. Exit with status ;; 'finished if input is a valid match and no further completion is diff --git a/extensions/corfu-echo.el b/extensions/corfu-echo.el index d93d819..3053fe5 100644 --- a/extensions/corfu-echo.el +++ b/extensions/corfu-echo.el @@ -85,7 +85,8 @@ subsequent delay." (funcall (if corfu-echo--message #'cdr #'car) corfu-echo-delay) corfu-echo-delay)) - (fun (plist-get corfu--extra :company-docsig)) + (extra (nth 4 completion-in-region--data)) + (fun (plist-get extra :company-docsig)) (cand (and (>= corfu--index 0) (nth corfu--index corfu--candidates)))) (if (<= delay 0) diff --git a/extensions/corfu-info.el b/extensions/corfu-info.el index d0f483e..4f13037 100644 --- a/extensions/corfu-info.el +++ b/extensions/corfu-info.el @@ -74,7 +74,8 @@ If called with a prefix ARG, the buffer is persistent." (when (< corfu--index 0) (user-error "No candidate selected")) (let ((cand (nth corfu--index corfu--candidates))) - (if-let ((fun (plist-get corfu--extra :company-doc-buffer)) + (if-let ((extra (nth 4 completion-in-region--data)) + (fun (plist-get extra :company-doc-buffer)) (res (funcall fun cand))) (set-window-start (corfu-info--display-buffer (get-buffer (or (car-safe res) res)) @@ -91,9 +92,10 @@ If called with a prefix ARG, the buffer is persistent." (when (< corfu--index 0) (user-error "No candidate selected")) (let ((cand (nth corfu--index corfu--candidates))) - ;; BUG: company-location may throw errors if location is not found - (if-let ((fun (ignore-errors (plist-get corfu--extra :company-location))) - (loc (funcall fun cand))) + (if-let ((extra (nth 4 completion-in-region--data)) + (fun (plist-get extra :company-location)) + ;; BUG: company-location may throw errors if location is not found + (loc (ignore-errors (funcall fun cand)))) (with-selected-window (corfu-info--display-buffer (or (and (bufferp (car loc)) (car loc)) diff --git a/extensions/corfu-popupinfo.el b/extensions/corfu-popupinfo.el index 2b8b2d6..3aa4f55 100644 --- a/extensions/corfu-popupinfo.el +++ b/extensions/corfu-popupinfo.el @@ -179,7 +179,8 @@ all values are in pixels relative to the origin. See (let ((old-buffers (buffer-list)) (buffer nil)) (unwind-protect (when-let - ((fun (plist-get corfu--extra :company-location)) + ((extra (nth 4 completion-in-region--data)) + (fun (plist-get extra :company-location)) ;; BUG: company-location may throw errors if location is not found (loc (ignore-errors (funcall fun candidate))) ((setq buffer @@ -214,7 +215,8 @@ all values are in pixels relative to the origin. See (defun corfu-popupinfo--get-documentation (candidate) "Get the documentation for CANDIDATE." - (when-let ((fun (plist-get corfu--extra :company-doc-buffer)) + (when-let ((extra (nth 4 completion-in-region--data)) + (fun (plist-get extra :company-doc-buffer)) (res (save-excursion (let ((inhibit-message t) (message-log-max nil) -- cgit v1.0