308 lines
12 KiB
EmacsLisp
308 lines
12 KiB
EmacsLisp
|
;;; corfu-terminal-popupinfo.el --- corfu-popupinfo support in the terminal -*- lexical-binding: t -*-
|
||
|
|
|
||
|
|
;;; Commentary:
|
||
|
|
;; To make use of this file, simply `require' it, and then enable
|
||
|
|
;; `corfu-terminal-popupinfo-mode', which is a global mode. Note that
|
||
|
|
;; `corfu-terminal-mode' MUST be loaded and enabled for this to work.
|
||
|
|
|
||
|
|
;;; Code:
|
||
|
|
(require 'popon)
|
||
|
|
(require 'corfu-terminal)
|
||
|
|
(require 'corfu-popupinfo)
|
||
|
|
(require 'cl-lib)
|
||
|
|
|
||
|
|
(defvar ctp--popon nil
|
||
|
|
"The current popon, or nil if there is none.")
|
||
|
|
|
||
|
|
(defvar ctp--buffer nil
|
||
|
|
"The buffer holding the current candidate's documentation.")
|
||
|
|
|
||
|
|
(defun ctp--get-buffer ()
|
||
|
|
"Create or return `ctp--buffer'."
|
||
|
|
(unless (and (bufferp ctp--buffer) (buffer-live-p ctp--buffer))
|
||
|
|
(setq ctp--buffer (generate-new-buffer " *corfu-terminal-popupinfo*" t)))
|
||
|
|
ctp--buffer)
|
||
|
|
|
||
|
|
(defun ctp--visible-p ()
|
||
|
|
"Return non-nil if the terminal popup window is visible."
|
||
|
|
(popon-live-p ctp--popon))
|
||
|
|
|
||
|
|
(defun ctp--corfu-popupinfo--visible-p-advice (oldfun &optional frame)
|
||
|
|
"Advice for `corfu-popupinfo--visible-p'.
|
||
|
|
If FRAME is nil, this will return `ctp--visible-p'. If
|
||
|
|
FRAME is `corfu--frame', this will return weather the `corfu-terminal--popon' is
|
||
|
|
live or not.
|
||
|
|
|
||
|
|
As this is :around advice, OLDFUN is the real (advised) function to call."
|
||
|
|
(cond
|
||
|
|
((and (not frame) (ctp--visible-p)))
|
||
|
|
((and (eq frame corfu--frame) (popon-live-p corfu-terminal--popon)))
|
||
|
|
((funcall oldfun frame))))
|
||
|
|
|
||
|
|
(defun ctp--close ()
|
||
|
|
"Close the popon."
|
||
|
|
(popon-kill ctp--popon)
|
||
|
|
(setq ctp--popon nil))
|
||
|
|
|
||
|
|
(defalias 'ctp--corfu-popupinfo--hide-advice 'ctp--close
|
||
|
|
"Advice for `corfu-popupinfo--hide' that works in the terminal.")
|
||
|
|
|
||
|
|
(defun ctp--load-content (candidate buffer)
|
||
|
|
"Load the documentation for CANDIDATE into BUFFER."
|
||
|
|
(when-let ((content (funcall corfu-popupinfo--function candidate)))
|
||
|
|
;; A bunch of this comes straight from `corfu-popupinfo--show'
|
||
|
|
(with-current-buffer buffer
|
||
|
|
(dolist (var corfu-popupinfo--buffer-parameters)
|
||
|
|
(set (make-local-variable (car var)) (cdr var)))
|
||
|
|
(with-silent-modifications
|
||
|
|
(erase-buffer)
|
||
|
|
(insert content)
|
||
|
|
;; popon.el requires that each line be of the same width. As we are in
|
||
|
|
;; the terminal, we assume that each character is the same width (and
|
||
|
|
;; we can't do anything, or even know, if this is not the case). Thus,
|
||
|
|
;; we run over the buffer to pad out each line to the width of the
|
||
|
|
;; longest line.
|
||
|
|
(goto-char (point-min))
|
||
|
|
(let ((wrap-p (and (not truncate-lines) word-wrap))
|
||
|
|
(longest-line 0))
|
||
|
|
(cl-block nil
|
||
|
|
(while (not (eobp))
|
||
|
|
(let ((len (- (pos-eol) (pos-bol))))
|
||
|
|
(when (> len longest-line)
|
||
|
|
(setq longest-line len))
|
||
|
|
(when (and wrap-p (> longest-line corfu-popupinfo-max-width))
|
||
|
|
(setq longest-line corfu-popupinfo-max-width)
|
||
|
|
(cl-return)))
|
||
|
|
(forward-line)))
|
||
|
|
(setq-local fill-column longest-line)
|
||
|
|
(when wrap-p
|
||
|
|
(fill-region (point-min) (point-max)))
|
||
|
|
(goto-char (point-min))
|
||
|
|
(while (not (eobp))
|
||
|
|
(end-of-line)
|
||
|
|
(let ((len (- (point) (pos-bol))))
|
||
|
|
(when (< len longest-line)
|
||
|
|
(insert (make-string (- longest-line len) ? ))))
|
||
|
|
(forward-line))))
|
||
|
|
(goto-char (point-min))
|
||
|
|
(put-text-property (point-min) (point-max) 'face 'corfu-popupinfo)
|
||
|
|
(when-let ((m (memq 'corfu-default (alist-get 'default face-remapping-alist))))
|
||
|
|
(setcar m 'corfu-popupinfo)))))
|
||
|
|
|
||
|
|
(defun ctp--popon-position (buffer)
|
||
|
|
"Find a good position to open the popon for BUFFER's content.
|
||
|
|
Return a list of the position, the max line length that can be shown, and the
|
||
|
|
max height that can be shown. Each line of BUFFER _MUST_ be the same lenght."
|
||
|
|
(when-let ((point-posn (posn-at-point))
|
||
|
|
(point-x (car (posn-x-y point-posn)))
|
||
|
|
(point-y (cdr (posn-x-y point-posn))))
|
||
|
|
(with-current-buffer buffer
|
||
|
|
(when-let ((completion-pos (popon-position corfu-terminal--popon))
|
||
|
|
(completion-size (popon-size corfu-terminal--popon))
|
||
|
|
(comp-x (car completion-pos))
|
||
|
|
(comp-y (cdr completion-pos))
|
||
|
|
(comp-w (car completion-size))
|
||
|
|
(comp-h (cdr completion-size))
|
||
|
|
(win-w (window-max-chars-per-line))
|
||
|
|
(win-h (window-body-height))
|
||
|
|
(line-len (- (pos-eol) (pos-bol)))
|
||
|
|
(num-lines (count-lines (point-min) (point-max))))
|
||
|
|
(let* ((align 'row)
|
||
|
|
(width (min line-len corfu-popupinfo-max-width))
|
||
|
|
(pop-x (cond
|
||
|
|
((<= (+ comp-x comp-w width) win-w)
|
||
|
|
(+ comp-x comp-w))
|
||
|
|
((>= (- comp-x width) 0)
|
||
|
|
(- comp-x width))
|
||
|
|
((<= (+ comp-x width) win-w)
|
||
|
|
(setq align 'col)
|
||
|
|
comp-x)
|
||
|
|
((>= (- win-w width) 0)
|
||
|
|
(setq align 'col)
|
||
|
|
(- win-w width))
|
||
|
|
(t
|
||
|
|
(setq align 'col
|
||
|
|
width win-w)
|
||
|
|
0)))
|
||
|
|
(height (min num-lines corfu-popupinfo-max-height))
|
||
|
|
(pop-y (cl-case align
|
||
|
|
(row (if (<= (+ comp-y height) win-h)
|
||
|
|
comp-y
|
||
|
|
(max 0 (- win-h height))))
|
||
|
|
(col (cond
|
||
|
|
((<= (+ comp-y comp-h height)
|
||
|
|
(- win-h scroll-margin))
|
||
|
|
(+ comp-y comp-h))
|
||
|
|
;; If the completion dialog is above the point
|
||
|
|
((and (< comp-y point-y)
|
||
|
|
(>= (- comp-y height) 0))
|
||
|
|
(- comp-y height))
|
||
|
|
;; Emacs seems to hide the current text if this
|
||
|
|
;; number is 1 (I think it's too close to two
|
||
|
|
;; overlays)
|
||
|
|
((>= (- comp-y height 2) 0)
|
||
|
|
(- comp-y height 2))
|
||
|
|
(t (+ comp-y comp-h)))))))
|
||
|
|
(list (cons pop-x pop-y) width height))))))
|
||
|
|
|
||
|
|
(defun ctp--extract-content (buffer width height)
|
||
|
|
"Extract the content from BUFFER for a popon.
|
||
|
|
The content extracted is for a popon of size WIDTH by HEIGHT."
|
||
|
|
(let (start end)
|
||
|
|
(with-current-buffer buffer
|
||
|
|
;; we assume that we are scrolled to the start of the region we care about
|
||
|
|
(save-excursion
|
||
|
|
(let ((rem-lines (count-lines (point) (point-max))))
|
||
|
|
(when (< rem-lines height)
|
||
|
|
(forward-line (- rem-lines height))))
|
||
|
|
(setq start (point)
|
||
|
|
end (pos-eol height))))
|
||
|
|
(with-temp-buffer
|
||
|
|
(insert-buffer-substring buffer start end)
|
||
|
|
(goto-char (point-min))
|
||
|
|
(cl-loop repeat height
|
||
|
|
until (eobp) do
|
||
|
|
(let ((len (- (pos-eol) (pos-bol))))
|
||
|
|
(when (> len width)
|
||
|
|
(delete-region (+ (pos-bol) width) (pos-eol))))
|
||
|
|
(forward-line))
|
||
|
|
;; "delete" the rest of the lines
|
||
|
|
(narrow-to-region (point-min) (point))
|
||
|
|
(buffer-string))))
|
||
|
|
|
||
|
|
(defun ctp--display-buffer (buffer)
|
||
|
|
"Display or redisplay BUFFER in a popon."
|
||
|
|
(let ((inhibit-redisplay t))
|
||
|
|
(cl-destructuring-bind (&optional pos width height)
|
||
|
|
(ctp--popon-position buffer)
|
||
|
|
(popon-kill ctp--popon)
|
||
|
|
(when-let ((pos)
|
||
|
|
(content (ctp--extract-content buffer width height)))
|
||
|
|
(setq ctp--popon
|
||
|
|
;; appear behind the auto-complete window, in case something
|
||
|
|
;; happens
|
||
|
|
(popon-create content pos nil nil 100))))))
|
||
|
|
|
||
|
|
(defun ctp--corfu-popupinfo--show-advice (oldfun candidate)
|
||
|
|
"Advice for `corfu-popupinfo--show' that works in the terminal.
|
||
|
|
CANDIDATE is the same as for `corfu-popupinfo--show'. As this is meant to be
|
||
|
|
:around advice, OLDFUN is assumed to be the real (advised) function."
|
||
|
|
(if (display-graphic-p)
|
||
|
|
(progn
|
||
|
|
(popon-kill ctp--popon)
|
||
|
|
(funcall oldfun candidate))
|
||
|
|
(when corfu-popupinfo--timer
|
||
|
|
(cancel-timer corfu-popupinfo--timer)
|
||
|
|
(setq corfu-popupinfo--timer nil))
|
||
|
|
(when (and (frame-live-p corfu-popupinfo--frame)
|
||
|
|
(frame-visible-p corfu-popupinfo--frame))
|
||
|
|
(corfu--hide-frame corfu-popupinfo--frame))
|
||
|
|
(when (or (not (ctp--visible-p))
|
||
|
|
(not (corfu--equal-including-properties
|
||
|
|
candidate corfu-popupinfo--candidate)))
|
||
|
|
(let ((buf (ctp--get-buffer)))
|
||
|
|
(ctp--load-content candidate buf)
|
||
|
|
(ctp--display-buffer buf))
|
||
|
|
(setq corfu-popupinfo--candidate candidate
|
||
|
|
corfu-popupinfo--toggle t))))
|
||
|
|
|
||
|
|
(defun ctp--move-away-from-eob ()
|
||
|
|
"Ensure the point isn't too close to the end of the buffer."
|
||
|
|
(if-let ((total-lines (count-lines (point-min) (point-max)))
|
||
|
|
((> total-lines corfu-popupinfo-max-height))
|
||
|
|
(rem-lines (count-lines (point) (point-max)))
|
||
|
|
((< rem-lines corfu-popupinfo-max-height)))
|
||
|
|
(forward-line (- (- corfu-popupinfo-max-height rem-lines)))))
|
||
|
|
|
||
|
|
(defun ctp--corfu-popupinfo-scroll-up-advice
|
||
|
|
(oldfun &optional n)
|
||
|
|
"Advice for `corfu-popupinfo-scroll-up'.
|
||
|
|
N is the number of lines. As this is :around advice, OLDFUN is the real
|
||
|
|
\(advised) function."
|
||
|
|
(if (ctp--visible-p)
|
||
|
|
(let ((buf (ctp--get-buffer)))
|
||
|
|
(with-current-buffer buf
|
||
|
|
(forward-line n)
|
||
|
|
(beginning-of-line)
|
||
|
|
(ctp--move-away-from-eob))
|
||
|
|
(ctp--display-buffer buf))
|
||
|
|
(funcall oldfun n)))
|
||
|
|
|
||
|
|
(defun ctp--corfu-popupinfo-end-advice (oldfun &optional n)
|
||
|
|
"Advice for `corfu-popupinfo-end'.
|
||
|
|
N is the same as for `corfu-popupinfo-end'. As this is :around advice, OLDFUN
|
||
|
|
is the real (advised) function."
|
||
|
|
(if (ctp--visible-p)
|
||
|
|
(let ((buf (ctp--get-buffer)))
|
||
|
|
(with-current-buffer buf
|
||
|
|
(let ((size (- (point-max) (point-min))))
|
||
|
|
(goto-char (if n
|
||
|
|
(- (point-max) (/ (* size n) 10))
|
||
|
|
(point-max))))
|
||
|
|
(beginning-of-line)
|
||
|
|
(ctp--move-away-from-eob))
|
||
|
|
(ctp--display-buffer buf))
|
||
|
|
(funcall oldfun n)))
|
||
|
|
|
||
|
|
(defun ctp--corfu--popup-hide-advice ()
|
||
|
|
":after advice for `corfu--popup-hide'."
|
||
|
|
(unless completion-in-region-mode
|
||
|
|
(ctp--close)))
|
||
|
|
|
||
|
|
(defun ctp--enable ()
|
||
|
|
"Enable corfu terminal popupinfo by advising some corfu functions."
|
||
|
|
(advice-add 'corfu-popupinfo--visible-p :around
|
||
|
|
'ctp--corfu-popupinfo--visible-p-advice)
|
||
|
|
(advice-add 'corfu-popupinfo--hide :after
|
||
|
|
'ctp--corfu-popupinfo--hide-advice)
|
||
|
|
(advice-add 'corfu-popupinfo--show :around
|
||
|
|
'ctp--corfu-popupinfo--show-advice)
|
||
|
|
(advice-add 'corfu-popupinfo-scroll-up :around
|
||
|
|
'ctp--corfu-popupinfo-scroll-up-advice)
|
||
|
|
(advice-add 'corfu-popupinfo-end :around
|
||
|
|
'ctp--corfu-popupinfo-end-advice)
|
||
|
|
(advice-add 'corfu--popup-hide :after
|
||
|
|
'ctp--corfu--popup-hide-advice))
|
||
|
|
|
||
|
|
(defun ctp--disable ()
|
||
|
|
"Disable corfu terminal popupinfo by remove advice added by `ctp--enable'."
|
||
|
|
(ctp--close)
|
||
|
|
(advice-remove 'corfu-popupinfo--visible-p
|
||
|
|
'ctp--corfu-popupinfo--visible-p-advice)
|
||
|
|
(advice-remove 'corfu-popupinfo--hide
|
||
|
|
'ctp--corfu-popupinfo--hide-advice)
|
||
|
|
(advice-remove 'corfu-popupinfo--show
|
||
|
|
'ctp--corfu-popupinfo--show-advice)
|
||
|
|
(advice-remove 'corfu-popupinfo-scroll-up
|
||
|
|
'ctp--corfu-popupinfo-scroll-up-advice)
|
||
|
|
(advice-remove 'corfu-popupinfo-end
|
||
|
|
'ctp--corfu-popupinfo-end-advice)
|
||
|
|
(advice-remove 'corfu--popup-hide
|
||
|
|
'ctp--corfu--popup-hide-advice))
|
||
|
|
|
||
|
|
(defun ctp--corfu-terminal-mode-hook ()
|
||
|
|
"Hook run from `corfu-terminal-mode-hook'."
|
||
|
|
(if (and corfu-terminal-mode
|
||
|
|
(bound-and-true-p corfu-terminal-popupinfo-mode))
|
||
|
|
(ctp--enable)
|
||
|
|
(ctp--disable)))
|
||
|
|
|
||
|
|
;;;###autoload
|
||
|
|
(define-minor-mode corfu-terminal-popupinfo-mode
|
||
|
|
"Minor mode shows the `corfu-popupinfo-mode' popup in the terminal.
|
||
|
|
Note that even with this enabled, you still need to enable the actual popup
|
||
|
|
using `corfu-popupinfo-toggle'. Also, this does not do anything if
|
||
|
|
`corfu-terminal-mode' is not enabled."
|
||
|
|
:global t
|
||
|
|
:group 'corfu-terminal-popupinfo
|
||
|
|
(if corfu-terminal-popupinfo-mode
|
||
|
|
(progn
|
||
|
|
(add-hook corfu-terminal-mode-hook 'ctp--corfu-terminal-mode-hook)
|
||
|
|
(when corfu-terminal-mode
|
||
|
|
(ctp--enable)))
|
||
|
|
(remove-hook corfu-terminal-mode-hook 'ctp--corfu-terminal-mode-hook)
|
||
|
|
(ctp--disable)))
|
||
|
|
|
||
|
|
(provide 'corfu-terminal-popupinfo)
|
||
|
|
;;; corfu-terminal-popupinfo.el ends here
|