;;; 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)))
;; We succeeded in loading the data
t))
(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)))
(if (ctp--load-content candidate buf)
(progn
(ctp--display-buffer buf)
(setq corfu-popupinfo--candidate candidate
corfu-popupinfo--toggle t))
(corfu-popupinfo--hide))))))
(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