corfu-popupinfo.el (22065B)
1 ;;; corfu-popupinfo.el --- Candidate information popup for Corfu -*- lexical-binding: t -*- 2 3 ;; Copyright (C) 2021-2023 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: 0.1 9 ;; Package-Requires: ((emacs "27.1") (corfu "0.36")) 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 very small delay, since this 64 will create high load for Emacs since retrieving the 65 documentation 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 directionse 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-horizontal) 115 (const force-vertical))) 116 :group 'corfu) 117 118 (defvar-keymap corfu-popupinfo-map 119 :doc "Additional keymap activated in popupinfo mode." 120 "M-t" #'corfu-popupinfo-toggle 121 "<remap> <corfu-info-documentation>" #'corfu-popupinfo-documentation 122 "<remap> <corfu-info-location>" #'corfu-popupinfo-location 123 "<remap> <scroll-other-window>" #'corfu-popupinfo-scroll-up 124 "<remap> <scroll-other-window-down>" #'corfu-popupinfo-scroll-down 125 "<remap> <end-of-buffer-other-window>" #'corfu-popupinfo-end 126 "<remap> <beginning-of-buffer-other-window>" #'corfu-popupinfo-beginning) 127 128 (defvar corfu-popupinfo--buffer-parameters 129 '((truncate-partial-width-windows . nil) 130 (truncate-lines . nil) 131 (left-margin-width . 1) 132 (right-margin-width . 1) 133 (word-wrap . t) 134 (fringe-indicator-alist (continuation))) 135 "Buffer parameters.") 136 137 (defvar-local corfu-popupinfo--toggle 'init 138 "Local toggle state.") 139 140 (defvar-local corfu-popupinfo--function 141 #'corfu-popupinfo--get-documentation 142 "Function called to obtain documentation string.") 143 144 (defvar corfu-popupinfo--frame nil 145 "Info popup child frame.") 146 147 (defvar corfu-popupinfo--timer nil 148 "Corfu info popup auto display timer.") 149 150 (defvar-local corfu-popupinfo--candidate nil 151 "Completion candidate for the info popup.") 152 153 (defvar-local corfu-popupinfo--coordinates nil 154 "Coordinates of the candidate popup. 155 The coordinates list has the form (LEFT TOP RIGHT BOTTOM) where 156 all values are in pixels relative to the origin. See 157 `frame-edges' for details.") 158 159 (defvar-local corfu-popupinfo--lock-dir nil 160 "Locked position direction of the info popup.") 161 162 (defconst corfu-popupinfo--state-vars 163 '(corfu-popupinfo--candidate 164 corfu-popupinfo--coordinates 165 corfu-popupinfo--lock-dir 166 corfu-popupinfo--toggle 167 corfu-popupinfo--function) 168 "Buffer-local state variables used by corfu-popupinfo.") 169 170 (defun corfu-popupinfo--visible-p (&optional frame) 171 "Return non-nil if FRAME is visible." 172 (setq frame (or frame corfu-popupinfo--frame)) 173 (and (frame-live-p frame) (frame-visible-p frame))) 174 175 (defun corfu-popupinfo--get-location (candidate) 176 "Get source at location of CANDIDATE." 177 (save-excursion 178 (let ((old-buffers (buffer-list)) (buffer nil)) 179 (unwind-protect 180 (when-let 181 ((fun (plist-get corfu--extra :company-location)) 182 ;; BUG: company-location may throw errors if location is not found 183 (loc (ignore-errors (funcall fun candidate))) 184 ((setq buffer 185 (or (and (bufferp (car loc)) (car loc)) 186 (get-file-buffer (car loc)) 187 (let ((inhibit-message t) 188 (inhibit-redisplay t) 189 (enable-dir-local-variables nil) 190 (enable-local-variables :safe) 191 (non-essential t) 192 (delay-mode-hooks t) 193 (find-file-hook '(global-font-lock-mode-check-buffers))) 194 (find-file-noselect (car loc) t)))))) 195 (with-current-buffer buffer 196 (save-excursion 197 (save-restriction 198 (widen) 199 (goto-char (point-min)) 200 (when-let (pos (cdr loc)) 201 (if (bufferp (car loc)) 202 (goto-char pos) 203 (forward-line (1- pos)))) 204 (let ((beg (point))) 205 ;; Support a little bit of scrolling. 206 (forward-line (* 10 corfu-popupinfo-max-height)) 207 (when jit-lock-mode 208 (jit-lock-fontify-now beg (point))) 209 (let ((res (buffer-substring beg (point)))) 210 (and (not (string-blank-p res)) res))))))) 211 (when (and buffer (not (memq buffer old-buffers))) 212 (kill-buffer buffer)))))) 213 214 (defun corfu-popupinfo--get-documentation (candidate) 215 "Get the documentation for CANDIDATE." 216 (when-let ((fun (plist-get corfu--extra :company-doc-buffer)) 217 (res (save-excursion 218 (let ((inhibit-message t) 219 (inhibit-redisplay t) 220 (message-log-max nil) 221 ;; Reduce print length for elisp backend (#249) 222 (print-level 3) 223 (print-length (* corfu-popupinfo-max-width 224 corfu-popupinfo-max-height))) 225 (funcall fun candidate))))) 226 (with-current-buffer (or (car-safe res) res) 227 (setq res (string-trim 228 (replace-regexp-in-string 229 "[\n\t ]*\\[back\\][\n\t ]*" "" 230 (buffer-string)))) 231 (and (not (string-blank-p res)) res)))) 232 233 (defun corfu-popupinfo--size () 234 "Return popup size as pair." 235 (let* ((cw (default-font-width)) 236 (lh (default-line-height)) 237 (margin 238 (* cw (+ (alist-get 'left-margin-width corfu-popupinfo--buffer-parameters) 239 (alist-get 'right-margin-width corfu-popupinfo--buffer-parameters)))) 240 (max-height (* lh corfu-popupinfo-max-height)) 241 (max-width (* cw corfu-popupinfo-max-width))) 242 (or (when corfu-popupinfo-resize 243 (with-current-buffer " *corfu-popupinfo*" 244 (cl-letf* (((window-dedicated-p) nil) 245 ((window-buffer) (current-buffer)) 246 (size (window-text-pixel-size 247 nil (point-min) (point-max) 248 ;; Use 3*max-height as y-limit, to take more text 249 ;; into account. 250 max-width (* 3 max-height)))) 251 ;; Check that width is not exceeded. Otherwise use full height, 252 ;; since lines will get wrapped. 253 (when (<= (car size) max-width) 254 (cons (+ margin (car size)) 255 ;; XXX HACK: Ensure that popup has at least a height of 1, 256 ;; which is the minimum frame height (#261). Maybe we 257 ;; should ask upstream how smaller frames can be created. 258 ;; I only managed to create smaller frames by setting 259 ;; `window-safe-min-height' to 0, which feels problematic. 260 (min (max (cdr size) lh) max-height)))))) 261 (cons (+ margin max-width) max-height)))) 262 263 (defun corfu-popupinfo--frame-geometry (frame) 264 "Return position and size geometric attributes of FRAME. 265 266 The geometry represents the position and size in pixels 267 in the form of (X Y WIDTH HEIGHT)." 268 (pcase-let ((`(,x . ,y) (frame-position frame))) 269 (list x y (frame-pixel-width frame) (frame-pixel-height frame)))) 270 271 (defun corfu-popupinfo--fits-p (size area) 272 "Check if SIZE fits into the AREA. 273 274 SIZE is in the form (WIDTH . HEIGHT). 275 AREA is in the form (X Y WIDTH HEIGHT DIR)." 276 (and (>= (nth 2 area) (car size)) (>= (nth 3 area) (cdr size)))) 277 278 (defun corfu-popupinfo--larger-p (area1 area2) 279 "Check if AREA1 is larger than AREA2. 280 281 AREA1 and AREA2 are both in the form (X Y WIDTH HEIGHT DIR)." 282 (>= (* (nth 2 area1) (nth 3 area1)) (* (nth 2 area2) (nth 3 area2)))) 283 284 (defun corfu-popupinfo--area (ps) 285 "Calculate the display area for the info popup. 286 287 PS is the pixel size of the popup. The calculated area is in the 288 form (X Y WIDTH HEIGHT DIR)." 289 (pcase-let* 290 ((cw (default-font-width)) 291 (lh (default-line-height)) 292 (border (alist-get 'child-frame-border-width corfu--frame-parameters)) 293 (`(,_pfx ,_pfy ,pfw ,pfh) 294 (corfu-popupinfo--frame-geometry (frame-parent corfu--frame))) 295 (`(,cfx ,cfy ,cfw ,cfh) (corfu-popupinfo--frame-geometry corfu--frame)) 296 ;; Candidates popup below input 297 (below (>= cfy (+ lh (cadr (window-inside-pixel-edges)) 298 (window-tab-line-height) 299 (or (cdr (posn-x-y (posn-at-point (point)))) 0)))) 300 ;; Popups aligned at top 301 (top-aligned (or below (< (cdr ps) cfh))) 302 ;; Left display area 303 (ahy (if top-aligned 304 cfy 305 (max 0 (- (+ cfy cfh) border border (cdr ps))))) 306 (ahh (if top-aligned 307 (min (- pfh cfy) (cdr ps)) 308 (min (- (+ cfy cfh) border border) (cdr ps)))) 309 (al (list (max 0 (- cfx (car ps) border)) ahy 310 (min (- cfx border) (car ps)) ahh 'left)) 311 ;; Right display area 312 (arx (+ cfx cfw (- border))) 313 (ar (list arx ahy (min (- pfw arx border border) (car ps)) ahh 'right)) 314 ;; Vertical display area 315 (avw (min (car ps) (- pfw cfx border border))) 316 (av (if below 317 (list cfx (+ cfy cfh (- border)) avw (min (- pfh cfy cfh border) (cdr ps)) 'vertical) 318 (let ((h (min (- cfy border border) (cdr ps)))) 319 (list cfx (max 0 (- cfy h border)) avw h 'vertical))))) 320 (unless (and corfu-popupinfo--lock-dir 321 (corfu-popupinfo--fits-p 322 (cons (* cw corfu-popupinfo-min-width) (* lh corfu-popupinfo-min-height)) 323 (pcase corfu-popupinfo--lock-dir ('left al) ('right ar) ('vertical av)))) 324 (setq corfu-popupinfo--lock-dir nil)) 325 (or 326 (cl-loop for dir in corfu-popupinfo-direction thereis 327 (pcase dir 328 ((or 'force-right (guard (eq corfu-popupinfo--lock-dir 'right))) ar) 329 ((or 'force-left (guard (eq corfu-popupinfo--lock-dir 'left))) al) 330 ((or 'force-vertical (guard (eq corfu-popupinfo--lock-dir 'vertical))) av) 331 ((and 'right (guard (corfu-popupinfo--fits-p ps ar))) ar) 332 ((and 'left (guard (corfu-popupinfo--fits-p ps al))) al) 333 ((and 'vertical (guard (corfu-popupinfo--fits-p ps av))) av))) 334 (let ((ah (if (corfu-popupinfo--larger-p ar al) ar al))) 335 (if (corfu-popupinfo--larger-p av ah) av ah))))) 336 337 (defun corfu-popupinfo--show (candidate) 338 "Show the info popup for CANDIDATE." 339 (when corfu-popupinfo--timer 340 (cancel-timer corfu-popupinfo--timer) 341 (setq corfu-popupinfo--timer nil)) 342 (when (and (corfu-popupinfo--visible-p corfu--frame)) 343 (let* ((cand-changed 344 (not (and (corfu-popupinfo--visible-p) 345 (equal candidate corfu-popupinfo--candidate)))) 346 (new-coords (frame-edges corfu--frame 'inner-edges)) 347 (coords-changed (not (equal new-coords corfu-popupinfo--coordinates)))) 348 (when cand-changed 349 (if-let (content (funcall corfu-popupinfo--function candidate)) 350 (with-current-buffer (corfu--make-buffer " *corfu-popupinfo*") 351 (with-silent-modifications 352 (erase-buffer) 353 (insert content) 354 (goto-char (point-min))) 355 (dolist (var corfu-popupinfo--buffer-parameters) 356 (set (make-local-variable (car var)) (cdr var))) 357 (setf face-remapping-alist (copy-tree face-remapping-alist) 358 (alist-get 'default face-remapping-alist) 'corfu-popupinfo)) 359 (unless (eq corfu-popupinfo--toggle 'init) 360 (message "No %s available for `%s'" 361 (car (last (split-string (symbol-name corfu-popupinfo--function) "-+"))) 362 candidate)) 363 (corfu-popupinfo--hide) 364 (setq cand-changed nil coords-changed nil))) 365 (when (or cand-changed coords-changed) 366 (pcase-let* ((border (alist-get 'child-frame-border-width corfu--frame-parameters)) 367 (`(,area-x ,area-y ,area-w ,area-h ,area-d) 368 (corfu-popupinfo--area 369 (if cand-changed 370 (corfu-popupinfo--size) 371 (cons 372 (- (frame-pixel-width corfu-popupinfo--frame) border border) 373 (- (frame-pixel-height corfu-popupinfo--frame) border border))))) 374 (margin-quirk (not corfu-popupinfo--frame))) 375 (setq corfu-popupinfo--frame 376 (corfu--make-frame corfu-popupinfo--frame 377 area-x area-y area-w area-h 378 " *corfu-popupinfo*") 379 corfu-popupinfo--toggle t 380 corfu-popupinfo--lock-dir area-d 381 corfu-popupinfo--candidate candidate 382 corfu-popupinfo--coordinates new-coords) 383 ;; XXX HACK: Force margin update. For some reason, the call to 384 ;; `set-window-buffer' in `corfu--make-frame' is not effective the 385 ;; first time. Why does Emacs have all these quirks? 386 (when margin-quirk 387 (set-window-buffer 388 (frame-root-window corfu-popupinfo--frame) 389 " *corfu-popupinfo*"))))))) 390 391 (defun corfu-popupinfo--hide () 392 "Clear the info popup buffer content and hide it." 393 (corfu--hide-frame corfu-popupinfo--frame)) 394 395 (defun corfu-popupinfo-end (&optional n) 396 "Scroll text of info popup window to its end. 397 398 If arg N is omitted or nil, scroll to end. If a numerical value, 399 put point N/10 of the way from the end. If the info popup is not 400 visible, the other window is moved to beginning or end." 401 (interactive "P") 402 (if (corfu-popupinfo--visible-p) 403 (with-selected-frame corfu-popupinfo--frame 404 (with-current-buffer " *corfu-popupinfo*" 405 (with-no-warnings 406 (end-of-buffer n)))) 407 (end-of-buffer-other-window n))) 408 409 (defun corfu-popupinfo-beginning (&optional n) 410 "Scroll text of info popup window to beginning of buffer. 411 412 See `corfu-popupinfo-end' for the argument N." 413 (interactive "P") 414 (corfu-popupinfo-end (- 10 (if (numberp n) n 0)))) 415 416 (defun corfu-popupinfo-scroll-up (&optional n) 417 "Scroll text of info popup window upward N lines. 418 419 If ARG is omitted or nil, scroll upward by a near full screen. 420 See `scroll-up' for details. If the info popup is not visible, 421 the other window is scrolled." 422 (interactive "p") 423 (if (corfu-popupinfo--visible-p) 424 (with-selected-frame corfu-popupinfo--frame 425 (with-current-buffer " *corfu-popupinfo*" 426 (scroll-up n))) 427 (scroll-other-window n))) 428 429 (defun corfu-popupinfo-scroll-down (&optional n) 430 "Scroll text of info popup window down N lines. 431 432 See `corfu-popupinfo-scroll-up' for more details." 433 (interactive "p") 434 (corfu-popupinfo-scroll-up (- (or n 1)))) 435 436 (defun corfu-popupinfo--toggle (fun) 437 "Set documentation getter FUN and toggle popup." 438 (when (< corfu--index 0) 439 (corfu-popupinfo--hide) 440 (user-error "No candidate selected")) 441 (setq corfu-popupinfo--toggle 442 (not (and (corfu-popupinfo--visible-p) 443 (eq corfu-popupinfo--function fun)))) 444 (if (not corfu-popupinfo--toggle) 445 (corfu-popupinfo--hide) 446 (setq corfu-popupinfo--function fun 447 corfu-popupinfo--candidate nil) 448 (corfu-popupinfo--show (nth corfu--index corfu--candidates)))) 449 450 (defun corfu-popupinfo-documentation () 451 "Show or hide documentation in popup. 452 Behaves like `corfu-popupinfo-toggle'." 453 (interactive) 454 (corfu-popupinfo--toggle #'corfu-popupinfo--get-documentation)) 455 456 (defun corfu-popupinfo-location () 457 "Show or hide location in popup. 458 Behaves like `corfu-popupinfo-toggle'." 459 (interactive) 460 (corfu-popupinfo--toggle #'corfu-popupinfo--get-location)) 461 462 (defun corfu-popupinfo-toggle () 463 "Toggle the info popup display or hide. 464 465 When using this command to manually hide the info popup, it will 466 not be displayed until this command is called again, even if 467 `corfu-popupinfo-delay' is non-nil." 468 (interactive) 469 (corfu-popupinfo--toggle corfu-popupinfo--function)) 470 471 ;;;###autoload 472 (define-minor-mode corfu-popupinfo-mode 473 "Corfu info popup minor mode." 474 :global t :group 'corfu) 475 476 (cl-defmethod corfu--exhibit :after (&context (corfu-popupinfo-mode (eql t)) &optional _auto) 477 (when completion-in-region-mode 478 (setf (alist-get #'corfu-popupinfo-mode minor-mode-overriding-map-alist) 479 corfu-popupinfo-map) 480 (when corfu-popupinfo--timer 481 (cancel-timer corfu-popupinfo--timer) 482 (setq corfu-popupinfo--timer nil)) 483 (if (and (>= corfu--index 0) (corfu-popupinfo--visible-p corfu--frame)) 484 (let ((candidate (nth corfu--index corfu--candidates))) 485 (if-let ((delay (if (consp corfu-popupinfo-delay) 486 (funcall (if (eq corfu-popupinfo--toggle 'init) #'car #'cdr) 487 corfu-popupinfo-delay) 488 corfu-popupinfo-delay)) 489 (corfu-popupinfo--toggle)) 490 (if (or (<= delay 0) 491 (and (equal candidate corfu-popupinfo--candidate) 492 (corfu-popupinfo--visible-p))) 493 (corfu-popupinfo--show candidate) 494 (when (corfu-popupinfo--visible-p) 495 (cond 496 (corfu-popupinfo-hide 497 (corfu-popupinfo--hide)) 498 (corfu-popupinfo--candidate 499 (corfu-popupinfo--show corfu-popupinfo--candidate)))) 500 (setq corfu-popupinfo--timer 501 (run-at-time delay nil #'corfu-popupinfo--show candidate))) 502 (unless (equal candidate corfu-popupinfo--candidate) 503 (corfu-popupinfo--hide)))) 504 (corfu-popupinfo--hide)))) 505 506 (cl-defmethod corfu--teardown :before (&context (corfu-popupinfo-mode (eql t))) 507 (corfu-popupinfo--hide) 508 (mapc #'kill-local-variable corfu-popupinfo--state-vars) 509 (setq minor-mode-overriding-map-alist 510 (assq-delete-all #'corfu-popupinfo-mode 511 minor-mode-overriding-map-alist))) 512 513 ;; Emacs 28: Do not show Corfu commands with M-X 514 (dolist (sym '(corfu-popupinfo-scroll-down corfu-popupinfo-scroll-up 515 corfu-popupinfo-documentation corfu-popupinfo-location 516 corfu-popupinfo-beginning corfu-popupinfo-end 517 corfu-popupinfo-toggle)) 518 (put sym 'completion-predicate #'ignore)) 519 520 (provide 'corfu-popupinfo) 521 ;;; corfu-popupinfo.el ends here