corfu-popupinfo.el (22107B)
1 ;;; corfu-popupinfo.el --- Candidate information popup for Corfu -*- lexical-binding: t -*- 2 3 ;; Copyright (C) 2021-2024 Free Software Foundation, Inc. 4 5 ;; Author: Yuwei Tian <fishtai0@gmail.com>, Daniel Mendler <mail@daniel-mendler.de> 6 ;; Maintainer: Daniel Mendler <mail@daniel-mendler.de> 7 ;; Created: 2022 8 ;; Version: 1.4 9 ;; Package-Requires: ((emacs "27.1") (compat "29.1.4.4") (corfu "1.4")) 10 ;; Homepage: https://github.com/minad/corfu 11 12 ;; This file is part of GNU Emacs. 13 14 ;; This program is free software: you can redistribute it and/or modify 15 ;; it under the terms of the GNU General Public License as published by 16 ;; the Free Software Foundation, either version 3 of the License, or 17 ;; (at your option) any later version. 18 19 ;; This program is distributed in the hope that it will be useful, 20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 22 ;; GNU General Public License for more details. 23 24 ;; You should have received a copy of the GNU General Public License 25 ;; along with this program. If not, see <https://www.gnu.org/licenses/>. 26 27 ;;; Commentary: 28 29 ;; Display an information popup for completion candidate when using 30 ;; Corfu. The popup displays either the candidate documentation or the 31 ;; candidate location. The `corfu-popupinfo-mode' must be enabled 32 ;; globally. Set `corfu-popupinfo-delay' to nil if the info popup should 33 ;; not update automatically. If the popup should not appear initially, 34 ;; but update automatically afterwards, use `(setq corfu-popupinfo-delay 35 ;; (cons nil 1.0))'. 36 37 ;; For manual toggling the commands `corfu-popupinfo-toggle', 38 ;; `corfu-popupinfo-location' and `corfu-popupinfo-documentation' are 39 ;; bound in the `corfu-popupinfo-map'. 40 41 ;;; Code: 42 43 (require 'corfu) 44 (eval-when-compile 45 (require 'cl-lib) 46 (require 'subr-x)) 47 48 (defface corfu-popupinfo 49 '((t :inherit corfu-default)) 50 "Face used for the info popup." 51 :group 'corfu-faces) 52 53 (defcustom corfu-popupinfo-delay '(2.0 . 1.0) 54 "Automatically update info popup after that number of seconds. 55 56 The value can be a pair of two floats to specify initial and 57 subsequent delay. If the value is non-nil or the car of the pair 58 is non-nil, the popup will automatically appear for the 59 preselected candidate. Otherwise the popup can be requested 60 manually via `corfu-popupinfo-toggle', 61 `corfu-popupinfo-documentation' and `corfu-popupinfo-location'. 62 63 It is *not recommended* to use a short delay or even 0, since 64 this will create high load for Emacs. Retrieving the 65 documentation from the backend is usually expensive." 66 :type '(choice (const :tag "Never" nil) 67 (number :tag "Delay in seconds") 68 (cons :tag "Two Delays" 69 (choice :tag "Initial " 70 (choice (const nil) number)) 71 (choice :tag "Subsequent" 72 (choice (const nil) number)))) 73 :group 'corfu) 74 75 (defcustom corfu-popupinfo-hide t 76 "Hide the popup during the transition between candidates." 77 :type 'boolean 78 :group 'corfu) 79 80 (defcustom corfu-popupinfo-max-width 80 81 "The maximum width of the info popup in characters." 82 :type 'natnum 83 :group 'corfu) 84 85 (defcustom corfu-popupinfo-min-width 30 86 "The minimum width of the info popup in characters." 87 :type 'natnum 88 :group 'corfu) 89 90 (defcustom corfu-popupinfo-max-height 10 91 "The maximum height of the info popup in characters." 92 :type 'natnum 93 :group 'corfu) 94 95 (defcustom corfu-popupinfo-min-height 1 96 "The minimum height of the info popup in characters." 97 :type 'natnum 98 :group 'corfu) 99 100 (defcustom corfu-popupinfo-resize t 101 "Resize the info popup automatically if non-nil." 102 :type 'boolean 103 :group 'corfu) 104 105 (defcustom corfu-popupinfo-direction '(right left vertical) 106 "Preferred directions for the popup in order." 107 :type '(repeat 108 (choice 109 (const left) 110 (const right) 111 (const vertical) 112 (const force-left) 113 (const force-right) 114 (const force-vertical))) 115 :group 'corfu) 116 117 (defvar-keymap corfu-popupinfo-map 118 :doc "Additional keymap activated in popupinfo mode." 119 "M-t" #'corfu-popupinfo-toggle 120 "<remap> <corfu-info-documentation>" #'corfu-popupinfo-documentation 121 "<remap> <corfu-info-location>" #'corfu-popupinfo-location 122 "<remap> <scroll-other-window>" #'corfu-popupinfo-scroll-up 123 "<remap> <scroll-other-window-down>" #'corfu-popupinfo-scroll-down 124 "<remap> <end-of-buffer-other-window>" #'corfu-popupinfo-end 125 "<remap> <beginning-of-buffer-other-window>" #'corfu-popupinfo-beginning) 126 127 (defvar corfu-popupinfo--buffer-parameters 128 '((truncate-partial-width-windows . nil) 129 (truncate-lines . nil) 130 (left-margin-width . 1) 131 (right-margin-width . 1) 132 (word-wrap . t) 133 (fringe-indicator-alist (continuation))) 134 "Buffer parameters.") 135 136 (defvar corfu-popupinfo--frame nil 137 "Info popup child frame.") 138 139 (defvar corfu-popupinfo--timer nil 140 "Corfu info popup auto display timer.") 141 142 (defvar corfu-popupinfo--toggle 'init 143 "Toggle state.") 144 145 (defvar corfu-popupinfo--function 146 #'corfu-popupinfo--get-documentation 147 "Function called to obtain documentation string.") 148 149 (defvar corfu-popupinfo--candidate nil 150 "Completion candidate for the info popup.") 151 152 (defvar corfu-popupinfo--coordinates nil 153 "Coordinates of the candidate popup. 154 The coordinates list has the form (LEFT TOP RIGHT BOTTOM) where 155 all values are in pixels relative to the origin. See 156 `frame-edges' for details.") 157 158 (defvar corfu-popupinfo--lock-dir nil 159 "Locked position direction of the info popup.") 160 161 (defconst corfu-popupinfo--initial-state 162 (mapcar 163 (lambda (k) (cons k (symbol-value k))) 164 '(corfu-popupinfo--candidate 165 corfu-popupinfo--coordinates 166 corfu-popupinfo--lock-dir 167 corfu-popupinfo--toggle 168 corfu-popupinfo--function)) 169 "Initial state of `corfu-popupinfo-mode'.") 170 171 (defun corfu-popupinfo--visible-p (&optional frame) 172 "Return non-nil if FRAME is visible." 173 (setq frame (or frame corfu-popupinfo--frame)) 174 (and (frame-live-p frame) (frame-visible-p frame))) 175 176 (defun corfu-popupinfo--get-location (candidate) 177 "Get source at location of CANDIDATE." 178 (save-excursion 179 (let ((old-buffers (buffer-list)) (buffer nil)) 180 (unwind-protect 181 (when-let 182 ((extra (nth 4 completion-in-region--data)) 183 (fun (plist-get extra :company-location)) 184 ;; BUG: company-location may throw errors if location is not found 185 (loc (ignore-errors (funcall fun candidate))) 186 ((setq buffer 187 (or (and (bufferp (car loc)) (car loc)) 188 (get-file-buffer (car loc)) 189 (let ((inhibit-message t) 190 (message-log-max nil) 191 (inhibit-redisplay t) 192 (enable-dir-local-variables nil) 193 (enable-local-variables :safe) 194 (non-essential t) 195 (delay-mode-hooks t) 196 (find-file-hook '(global-font-lock-mode-check-buffers))) 197 (find-file-noselect (car loc) t)))))) 198 (with-current-buffer buffer 199 (save-excursion 200 (without-restriction 201 (goto-char (point-min)) 202 (when-let ((pos (cdr loc))) 203 (if (bufferp (car loc)) 204 (goto-char pos) 205 (forward-line (1- pos)))) 206 (let ((beg (point))) 207 ;; Support a little bit of scrolling. 208 (forward-line (* 10 corfu-popupinfo-max-height)) 209 (when jit-lock-mode 210 (jit-lock-fontify-now beg (point))) 211 (let ((res (buffer-substring beg (point)))) 212 (and (not (string-blank-p res)) res))))))) 213 (when (and buffer (not (memq buffer old-buffers))) 214 (kill-buffer buffer)))))) 215 216 (defun corfu-popupinfo--get-documentation (candidate) 217 "Get the documentation for CANDIDATE." 218 (when-let ((extra (nth 4 completion-in-region--data)) 219 (fun (plist-get extra :company-doc-buffer)) 220 (res (save-excursion 221 (let ((inhibit-message t) 222 (message-log-max nil) 223 (inhibit-redisplay t) 224 ;; Reduce print length for elisp backend (#249) 225 (print-level 3) 226 (print-length (* corfu-popupinfo-max-width 227 corfu-popupinfo-max-height))) 228 (funcall fun candidate))))) 229 (with-current-buffer (or (car-safe res) res) 230 (setq res (string-trim 231 (replace-regexp-in-string 232 "[\n\t ]*\\[back\\][\n\t ]*" "" 233 (buffer-string)))) 234 (and (not (string-blank-p res)) res)))) 235 236 (defun corfu-popupinfo--size () 237 "Return popup size as pair." 238 (let* ((cw (default-font-width)) 239 (lh (default-line-height)) 240 (margin 241 (* cw (+ (alist-get 'left-margin-width corfu-popupinfo--buffer-parameters) 242 (alist-get 'right-margin-width corfu-popupinfo--buffer-parameters)))) 243 (max-height (* lh corfu-popupinfo-max-height)) 244 (max-width (* cw corfu-popupinfo-max-width))) 245 (or (when corfu-popupinfo-resize 246 (with-current-buffer " *corfu-popupinfo*" 247 (cl-letf* (((window-dedicated-p) nil) 248 ((window-buffer) (current-buffer)) 249 (size (window-text-pixel-size 250 nil (point-min) (point-max) 251 ;; Use 3*max-height as y-limit, to take more text 252 ;; into account. 253 max-width (* 3 max-height)))) 254 ;; Check that width is not exceeded. Otherwise use full height, 255 ;; since lines will get wrapped. 256 (when (<= (car size) max-width) 257 (cons (+ margin (car size)) 258 ;; XXX HACK: Ensure that popup has at least a height of 1, 259 ;; which is the minimum frame height (#261). Maybe we 260 ;; should ask upstream how smaller frames can be created. 261 ;; I only managed to create smaller frames by setting 262 ;; `window-safe-min-height' to 0, which feels problematic. 263 (min (max (cdr size) lh) max-height)))))) 264 (cons (+ margin max-width) max-height)))) 265 266 (defun corfu-popupinfo--frame-geometry (frame) 267 "Return position and size geometric attributes of FRAME. 268 269 The geometry represents the position and size in pixels 270 in the form of (X Y WIDTH HEIGHT)." 271 (pcase-let ((`(,x . ,y) (frame-position frame))) 272 (list x y (frame-pixel-width frame) (frame-pixel-height frame)))) 273 274 (defun corfu-popupinfo--fits-p (size area) 275 "Check if SIZE fits into the AREA. 276 277 SIZE is in the form (WIDTH . HEIGHT). 278 AREA is in the form (X Y WIDTH HEIGHT DIR)." 279 (and (>= (nth 2 area) (car size)) (>= (nth 3 area) (cdr size)))) 280 281 (defun corfu-popupinfo--larger-p (area1 area2) 282 "Check if AREA1 is larger than AREA2. 283 284 AREA1 and AREA2 are both in the form (X Y WIDTH HEIGHT DIR)." 285 (>= (* (nth 2 area1) (nth 3 area1)) (* (nth 2 area2) (nth 3 area2)))) 286 287 (defun corfu-popupinfo--area (ps) 288 "Calculate the display area for the info popup. 289 290 PS is the pixel size of the popup. The calculated area is in the 291 form (X Y WIDTH HEIGHT DIR)." 292 (pcase-let* 293 ((cw (default-font-width)) 294 (lh (default-line-height)) 295 (border (alist-get 'internal-border-width corfu--frame-parameters)) 296 (`(,_pfx ,_pfy ,pfw ,pfh) 297 (corfu-popupinfo--frame-geometry (frame-parent corfu--frame))) 298 (`(,cfx ,cfy ,cfw ,cfh) (corfu-popupinfo--frame-geometry corfu--frame)) 299 ;; Candidates popup below input 300 (below (>= cfy (+ lh (cadr (window-inside-pixel-edges)) 301 (window-tab-line-height) 302 (or (cdr (posn-x-y (posn-at-point (point)))) 0)))) 303 ;; Popups aligned at top 304 (top-aligned (or below (< (cdr ps) cfh))) 305 ;; Left display area 306 (ahy (if top-aligned 307 cfy 308 (max 0 (- (+ cfy cfh) border border (cdr ps))))) 309 (ahh (if top-aligned 310 (min (- pfh cfy) (cdr ps)) 311 (min (- (+ cfy cfh) border border) (cdr ps)))) 312 (al (list (max 0 (- cfx (car ps) border)) ahy 313 (min (- cfx border) (car ps)) ahh 'left)) 314 ;; Right display area 315 (arx (+ cfx cfw (- border))) 316 (ar (list arx ahy (min (- pfw arx border border) (car ps)) ahh 'right)) 317 ;; Vertical display area 318 (avw (min (car ps) (- pfw cfx border border))) 319 (av (if below 320 (list cfx (+ cfy cfh (- border)) avw (min (- pfh cfy cfh border) (cdr ps)) 'vertical) 321 (let ((h (min (- cfy border border) (cdr ps)))) 322 (list cfx (max 0 (- cfy h border)) avw h 'vertical))))) 323 (unless (and corfu-popupinfo--lock-dir 324 (corfu-popupinfo--fits-p 325 (cons (* cw corfu-popupinfo-min-width) (* lh corfu-popupinfo-min-height)) 326 (pcase corfu-popupinfo--lock-dir ('left al) ('right ar) ('vertical av)))) 327 (setq corfu-popupinfo--lock-dir nil)) 328 (or 329 (cl-loop for dir in corfu-popupinfo-direction thereis 330 (pcase dir 331 ((or 'force-right (guard (eq corfu-popupinfo--lock-dir 'right))) ar) 332 ((or 'force-left (guard (eq corfu-popupinfo--lock-dir 'left))) al) 333 ((or 'force-vertical (guard (eq corfu-popupinfo--lock-dir 'vertical))) av) 334 ((and 'right (guard (corfu-popupinfo--fits-p ps ar))) ar) 335 ((and 'left (guard (corfu-popupinfo--fits-p ps al))) al) 336 ((and 'vertical (guard (corfu-popupinfo--fits-p ps av))) av))) 337 (let ((ah (if (corfu-popupinfo--larger-p ar al) ar al))) 338 (if (corfu-popupinfo--larger-p av ah) av ah))))) 339 340 (defun corfu-popupinfo--show (candidate) 341 "Show the info popup for CANDIDATE." 342 (when corfu-popupinfo--timer 343 (cancel-timer corfu-popupinfo--timer) 344 (setq corfu-popupinfo--timer nil)) 345 (when (and (corfu-popupinfo--visible-p corfu--frame)) 346 (let* ((cand-changed 347 (not (and (corfu-popupinfo--visible-p) 348 (equal candidate corfu-popupinfo--candidate)))) 349 (new-coords (frame-edges corfu--frame 'inner-edges)) 350 (coords-changed (not (equal new-coords corfu-popupinfo--coordinates)))) 351 (when cand-changed 352 (if-let ((content (funcall corfu-popupinfo--function candidate))) 353 (with-current-buffer (corfu--make-buffer " *corfu-popupinfo*") 354 (with-silent-modifications 355 (erase-buffer) 356 (insert content) 357 (goto-char (point-min))) 358 (dolist (var corfu-popupinfo--buffer-parameters) 359 (set (make-local-variable (car var)) (cdr var))) 360 (when-let ((m (memq 'corfu-default (alist-get 'default face-remapping-alist)))) 361 (setcar m 'corfu-popupinfo))) 362 (corfu-popupinfo--hide) 363 (setq cand-changed nil coords-changed nil))) 364 (when (or cand-changed coords-changed) 365 (pcase-let* ((border (alist-get 'internal-border-width corfu--frame-parameters)) 366 (`(,area-x ,area-y ,area-w ,area-h ,area-d) 367 (corfu-popupinfo--area 368 (if cand-changed 369 (corfu-popupinfo--size) 370 (cons 371 (- (frame-pixel-width corfu-popupinfo--frame) border border) 372 (- (frame-pixel-height corfu-popupinfo--frame) border border))))) 373 (margin-quirk (not corfu-popupinfo--frame))) 374 (setq corfu-popupinfo--frame 375 (corfu--make-frame corfu-popupinfo--frame 376 area-x area-y area-w area-h 377 " *corfu-popupinfo*") 378 corfu-popupinfo--toggle t 379 corfu-popupinfo--lock-dir area-d 380 corfu-popupinfo--candidate candidate 381 corfu-popupinfo--coordinates new-coords) 382 ;; XXX HACK: Force margin update. For some reason, the call to 383 ;; `set-window-buffer' in `corfu--make-frame' is not effective the 384 ;; first time. Why does Emacs have all these quirks? 385 (when margin-quirk 386 (set-window-buffer 387 (frame-root-window corfu-popupinfo--frame) 388 " *corfu-popupinfo*"))))))) 389 390 (defun corfu-popupinfo--hide () 391 "Clear the info popup buffer content and hide it." 392 (corfu--hide-frame corfu-popupinfo--frame)) 393 394 (defun corfu-popupinfo-end (&optional n) 395 "Scroll text of info popup window to its end. 396 397 If arg N is omitted or nil, scroll to end. If a numerical value, 398 put point N/10 of the way from the end. If the info popup is not 399 visible, the other window is moved to beginning or end." 400 (interactive "P") 401 (if (corfu-popupinfo--visible-p) 402 (with-selected-frame corfu-popupinfo--frame 403 (with-current-buffer " *corfu-popupinfo*" 404 (with-no-warnings 405 (end-of-buffer n)))) 406 (end-of-buffer-other-window n))) 407 408 (defun corfu-popupinfo-beginning (&optional n) 409 "Scroll text of info popup window to beginning of buffer. 410 411 See `corfu-popupinfo-end' for the argument N." 412 (interactive "P") 413 (corfu-popupinfo-end (- 10 (if (numberp n) n 0)))) 414 415 (defun corfu-popupinfo-scroll-up (&optional n) 416 "Scroll text of info popup window upward N lines. 417 418 If ARG is omitted or nil, scroll upward by a near full screen. 419 See `scroll-up' for details. If the info popup is not visible, 420 the other window is scrolled." 421 (interactive "p") 422 (if (corfu-popupinfo--visible-p) 423 (with-selected-frame corfu-popupinfo--frame 424 (with-current-buffer " *corfu-popupinfo*" 425 (scroll-up n))) 426 (scroll-other-window n))) 427 428 (defun corfu-popupinfo-scroll-down (&optional n) 429 "Scroll text of info popup window down N lines. 430 431 See `corfu-popupinfo-scroll-up' for more details." 432 (interactive "p") 433 (corfu-popupinfo-scroll-up (- (or n 1)))) 434 435 (defun corfu-popupinfo--toggle (fun) 436 "Set documentation getter FUN and toggle popup." 437 (when (< corfu--index 0) 438 (corfu-popupinfo--hide) 439 (user-error "No candidate selected")) 440 (setq corfu-popupinfo--toggle 441 (not (and (corfu-popupinfo--visible-p) 442 (eq corfu-popupinfo--function fun)))) 443 (if (not corfu-popupinfo--toggle) 444 (corfu-popupinfo--hide) 445 (setq corfu-popupinfo--function fun 446 corfu-popupinfo--candidate nil) 447 (let ((cand (nth corfu--index corfu--candidates))) 448 (corfu-popupinfo--show cand) 449 (unless (corfu-popupinfo--visible-p) 450 (user-error "No %s available for `%s'" 451 (car (last (split-string (symbol-name fun) "-+"))) 452 cand))))) 453 454 (defun corfu-popupinfo-documentation () 455 "Show or hide documentation in popup. 456 Behaves like `corfu-popupinfo-toggle'." 457 (interactive) 458 (corfu-popupinfo--toggle #'corfu-popupinfo--get-documentation)) 459 460 (defun corfu-popupinfo-location () 461 "Show or hide location in popup. 462 Behaves like `corfu-popupinfo-toggle'." 463 (interactive) 464 (corfu-popupinfo--toggle #'corfu-popupinfo--get-location)) 465 466 (defun corfu-popupinfo-toggle () 467 "Toggle the info popup display or hide. 468 469 When using this command to manually hide the info popup, it will 470 not be displayed until this command is called again, even if 471 `corfu-popupinfo-delay' is non-nil." 472 (interactive) 473 (corfu-popupinfo--toggle corfu-popupinfo--function)) 474 475 ;;;###autoload 476 (define-minor-mode corfu-popupinfo-mode 477 "Corfu info popup minor mode." 478 :global t :group 'corfu) 479 480 (cl-defmethod corfu--exhibit :after (&context (corfu-popupinfo-mode (eql t)) &optional _auto) 481 (when completion-in-region-mode 482 (setf (alist-get #'corfu-popupinfo-mode minor-mode-overriding-map-alist) 483 corfu-popupinfo-map) 484 (when corfu-popupinfo--timer 485 (cancel-timer corfu-popupinfo--timer) 486 (setq corfu-popupinfo--timer nil)) 487 (if (and (>= corfu--index 0) (corfu-popupinfo--visible-p corfu--frame)) 488 (let ((cand (nth corfu--index corfu--candidates))) 489 (if-let ((delay (if (consp corfu-popupinfo-delay) 490 (funcall (if (eq corfu-popupinfo--toggle 'init) #'car #'cdr) 491 corfu-popupinfo-delay) 492 corfu-popupinfo-delay)) 493 (corfu-popupinfo--toggle)) 494 (if (or (<= delay 0) 495 (and (equal cand corfu-popupinfo--candidate) 496 (corfu-popupinfo--visible-p))) 497 (corfu-popupinfo--show cand) 498 (when (corfu-popupinfo--visible-p) 499 (cond 500 (corfu-popupinfo-hide 501 (corfu-popupinfo--hide)) 502 (corfu-popupinfo--candidate 503 (corfu-popupinfo--show corfu-popupinfo--candidate)))) 504 (setq corfu-popupinfo--timer 505 (run-at-time delay nil #'corfu-popupinfo--show cand))) 506 (unless (equal cand corfu-popupinfo--candidate) 507 (corfu-popupinfo--hide)))) 508 (corfu-popupinfo--hide)))) 509 510 (cl-defmethod corfu--teardown :before (_buf &context (corfu-popupinfo-mode (eql t))) 511 (corfu-popupinfo--hide) 512 (cl-loop for (k . v) in corfu-popupinfo--initial-state do (set k v)) 513 (cl-callf2 assq-delete-all #'corfu-popupinfo-mode minor-mode-overriding-map-alist)) 514 515 ;; Emacs 28: Do not show Corfu commands with M-X 516 (dolist (sym '(corfu-popupinfo-scroll-down corfu-popupinfo-scroll-up 517 corfu-popupinfo-documentation corfu-popupinfo-location 518 corfu-popupinfo-beginning corfu-popupinfo-end 519 corfu-popupinfo-toggle)) 520 (put sym 'completion-predicate #'ignore)) 521 522 (provide 'corfu-popupinfo) 523 ;;; corfu-popupinfo.el ends here