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