Many improvements to corfu

elisp/corfu-terminal-popupinfo.el

@@ -0,0 +1,307 @@
+;;; 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

init.el

@@ -24,7 +24,6 @@
         package-user-dir "~/.emacs.d/var/elpa")
   (require 'use-package))
 
-
 ;; no-littering
 (use-package no-littering
   :autoload (no-littering-theme-backups
@@ -657,14 +656,50 @@ visual states."
   (setq corfu-cycle t
         corfu-auto t
         corfu-on-exact-match nil
-        completion-cycle-threshold nil)
+        corfu-popupinfo-delay '(1.0 . 0.5)
+        completion-cycle-threshold nil
+        global-corfu-minibuffer
+        ;; only enable corfu in the minibuffer in graphical frames
+        (lambda ()
+          (and (display-graphic-p)
+               (not (eq (current-local-map)
+                        read-passwd-map)))))
   (global-corfu-mode 1)
   (corfu-popupinfo-mode 1)
   :config
-  (add-to-list 'corfu-continue-commands #'my/corfu-move-to-minibuffer))
+  (add-to-list 'corfu-continue-commands #'my/corfu-move-to-minibuffer)
+  (defun my/help-buffer-exists-p ()
+    "Return if the buffer that `help-buffer' would, or nil if it doesn't exist."
+    (or (and help-xref-following (derived-mode-p 'help-mode))
+        (get-buffer "*Help*")))
+  (defun my/-corfu-popupinfo-close-help-buffer (oldfun &rest args)
+    (if (derived-mode-p 'emacs-lisp-mode)
+        (let ((help-buf (my/help-buffer-exists-p)))
+          (prog1
+              (apply oldfun args)
+            (when-let (((not help-buf))
+                       (buf (help-buffer)))
+              ;; Ensure that, even if `help-buffer' returns nil in the future, we
+              ;; don't kill the current buffer
+              (kill-buffer buf))))
+      (apply oldfun args)))
+  (advice-add 'corfu-popupinfo--get-documentation :around
+              'my/-corfu-popupinfo-close-help-buffer))
 (use-package corfu-terminal
   :init
   (corfu-terminal-mode 1))
+(use-package corfu-terminal-popupinfo
+  :ensure nil
+  :init
+  (corfu-terminal-popupinfo-mode 1))
+
+(use-package dabbrev
+  :ensure nil
+  :config
+  (add-to-list 'dabbrev-ignored-buffer-regexps "\\` ")
+  (add-to-list 'dabbrev-ignored-buffer-modes 'doc-view-mode)
+  (add-to-list 'dabbrev-ignored-buffer-modes 'pdf-view-mode)
+  (add-to-list 'dabbrev-ignored-buffer-modes 'tags-table-mode))
 
 ;; cape (a bunch of capfs!)
 (use-package cape
@@ -1032,7 +1067,8 @@ COMMAND and COMINT are like `compile'."
                 '(rng-completion-at-point cape-file)))
   (add-to-list 'auto-mode-alist
                `(,(concat
-                   (regexp-opt '("gschema" "gresource" "ui")) "\\'") . nxml-mode)))
+                   (regexp-opt '("gschema" "gresource" "ui")) "\\'")
+                 . nxml-mode)))
 
 ;; Bibtex (built in)
 (require 'bibtex)
@@ -1541,7 +1577,8 @@ argument."
         (puthash nil (let ((eat-term-name (if (file-remote-p default-directory)
                                               "xterm-256color"
                                             eat-term-name)))
-                       (eat)) my/project-eat-hash-table)))))
+                       (eat))
+                 my/project-eat-hash-table)))))
 
 ;; eshell stuff
 (use-package eshell