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