Try to support displaying borders in TTY child frames (#531)tty-borders

2 files changed, 112 insertions, 34 deletions

diff --git a/corfu.el b/corfu.el
index 3a2d80e..86f53c4 100644
--- a/corfu.el
+++ b/corfu.el
@@ -210,6 +210,22 @@ settings `corfu-auto-delay', `corfu-auto-prefix' and
 `corfu-auto-commands'."
   :type 'boolean)
 
+(defcustom corfu-border-on-tty 'blended
+  "Display popup borders on TTY.
+
+Setting this to nil disables the popup border.
+
+If set to t, a 1-character-wide border is displayed while
+retaining the popup\\='s background color.
+
+If set to \\='blended, the border is displayed, and the popup background
+will match the \\='default face to achieve a blended appearance, making the
+popup look as if it has no independent background."
+  :type '(choice
+          (const :tag "No border" nil)
+          (const :tag "Display border" t)
+          (const :tag "Display border (blended background)" blended)))
+
 (defgroup corfu-faces nil
   "Faces used by Corfu."
   :group 'corfu
@@ -351,7 +367,6 @@ settings `corfu-auto-delay', `corfu-auto-prefix' and
     (tab-bar-lines-keep-state . t)
     (no-other-frame . t)
     (unsplittable . t)
-    (undecorated . t)
     (fullscreen . nil)
     (cursor-type . nil)
     (no-special-glyphs . t)
@@ -449,6 +464,10 @@ is a prefix length override, which is t for manual completion."
         (set (make-local-variable (car var)) (cdr var)))
       (setq-local face-remapping-alist (copy-tree fr)
                   line-spacing ls)
+      (when (and (not (display-graphic-p))
+                 (eq corfu-border-on-tty 'blended))
+        (face-remap-add-relative 'corfu-default
+                                 :background (face-attribute 'default :background)))
       (cl-pushnew 'corfu-default (alist-get 'default face-remapping-alist))
       buffer)))
 
@@ -486,13 +505,17 @@ FRAME is the existing frame."
          (after-make-frame-functions)
          (parent (window-frame))
          (graphic (display-graphic-p parent))
+         (undecorated (or graphic (not corfu-border-on-tty)))
          (params `((background-color
-                    . ,(face-attribute 'corfu-default :background nil 'default))
+                    . ,(if (and (not graphic) (eq corfu-border-on-tty 'blended))
+                           (face-background 'default)
+                         (face-background 'corfu-default nil 'default)))
                    (font . ,(frame-parameter parent 'font))
                    (right-fringe . ,right-fringe-width)
                    (left-fringe . ,left-fringe-width)
                    (internal-border-width . ,corfu-border-width)
                    (child-frame-border-width . ,corfu-border-width)
+                   (undecorated . ,undecorated)
                    ,@corfu--frame-parameters)))
     (unless (and (frame-live-p frame)
                  (eq (frame-parent frame)
@@ -500,6 +523,8 @@ FRAME is the existing frame."
                           parent))
                  ;; Handle mixed tty/graphical sessions
                  (eq graphic (display-graphic-p frame))
+                 ;; Handle TTY border visibility changes
+                 (eq undecorated (frame-parameter frame 'undecorated))
                  ;; If there is more than one window, `frame-root-window' may
                  ;; return nil.  Recreate the frame in this case.
                  (window-live-p (frame-root-window frame)))
@@ -515,12 +540,16 @@ FRAME is the existing frame."
     ;; on Mac. We have to apply the face background before adjusting the frame
     ;; parameter, otherwise the border is not updated.
     (let ((new (face-attribute 'corfu-border :background nil 'default)))
-      (unless (equal (face-attribute 'internal-border :background frame 'default) new)
-        (set-face-background 'internal-border new frame))
-      ;; XXX The Emacs Mac Port does not support `internal-border', we also have
-      ;; to set `child-frame-border'.
-      (unless (equal (face-attribute 'child-frame-border :background frame 'default) new)
-        (set-face-background 'child-frame-border new frame)))
+      (if (and (not graphic) corfu-border-on-tty)
+          ;; Set the foreground color of the `border' face on TTY.
+          (unless (equal (face-attribute 'border :foreground frame 'default) new)
+            (set-face-foreground 'border new frame))
+        (unless (equal (face-attribute 'internal-border :background frame 'default) new)
+          (set-face-background 'internal-border new frame))
+        ;; XXX The Emacs Mac Port does not support `internal-border', we also have
+        ;; to set `child-frame-border'.
+        (unless (equal (face-attribute 'child-frame-border :background frame 'default) new)
+          (set-face-background 'child-frame-border new frame))))
     ;; Reset frame parameters if they changed.  For example `tool-bar-mode'
     ;; overrides the parameter `tool-bar-lines' for every frame, including child
     ;; frames.  The child frame API is a pleasure to work with.  It is full of
@@ -1133,15 +1162,21 @@ A scroll bar is displayed from LO to LO+BAR."
              ;; parent frame (gh:minad/corfu#261).
              (height (max lh (* (length lines) ch)))
              (edge (window-inside-pixel-edges))
-             (border (if graphic corfu-border-width 0))
-             (x (max 0 (min (+ (car edge) (- (or (car pos) 0) ml (* cw off) border))
-                            (- (frame-pixel-width) width
-                               (if graphic (+ ml mr (* 2 border)) 0)))))
+             (border (cond
+                       (graphic corfu-border-width)
+                       (corfu-border-on-tty 1)
+                       (t 0)))
+             ;; 1-character-wide offset when corfu-border-on-tty is non-nil
+             (offset (if (and (not graphic) corfu-border-on-tty) border 0))
+             (x (max offset
+                     (min (+ (car edge) (- (or (car pos) 0) ml (* cw off) border) offset)
+                          (- (frame-pixel-width) width
+                             (if graphic (+ ml mr (* 2 border)) 0) offset))))
              (yb (+ (cadr edge) (or (cdr pos) 0) lh
                     (static-if (< emacs-major-version 31) (window-tab-line-height) 0)))
-             (y (if (> (+ yb (* corfu-count ch) lh lh) (frame-pixel-height))
-                    (- yb height lh border border)
-                  yb))
+             (y (+ offset (if (> (+ yb (* corfu-count ch) lh lh) (frame-pixel-height))
+                              (- yb height lh border border)
+                            yb)))
              (bmp (logxor (1- (ash 1 mr)) (1- (ash 1 bw)))))
         (setq left-fringe-width (if graphic ml 0) right-fringe-width (if graphic mr 0))
         ;; Define an inverted corfu--bar face
diff --git a/extensions/corfu-popupinfo.el b/extensions/corfu-popupinfo.el
index 7b3b2f2..209e237 100644
--- a/extensions/corfu-popupinfo.el
+++ b/extensions/corfu-popupinfo.el
@@ -304,32 +304,71 @@ AREA1 and AREA2 are both in the form (X Y WIDTH HEIGHT DIR)."
 PS is the pixel size of the popup.  Return a list of left area, right
 area and vertical area."
   (pcase-let*
-      ((lh (default-line-height))
-       (`(,pw . ,ph) ps)
-       (border (if (display-graphic-p corfu--frame) corfu-border-width 0))
+      ((`(,pw . ,ph) ps)
        (`(,_pfx ,_pfy ,pfw ,pfh)
         (corfu-popupinfo--frame-geometry (frame-parent corfu--frame)))
        (`(,cfx ,cfy ,cfw ,cfh) (corfu-popupinfo--frame-geometry corfu--frame))
-       ;; Candidates popup below input
-       (below (>= cfy (+ lh (cadr (window-inside-pixel-edges))
+       ;; Check if the candidates popup is positioned below the input line
+       (below (>= cfy (+ (default-line-height)
+                         (cadr (window-inside-pixel-edges))
                          (window-tab-line-height)
                          (or (cdr (posn-x-y (posn-at-point (point)))) 0))))
        ;; Popups aligned at top
-       (top-aligned (or below (< ph cfh)))
-       ;; Left display area
-       (ahy (if top-aligned cfy (max 0 (- (+ cfy cfh) border border ph))))
-       (ahh (min ph (if top-aligned (- pfh cfy) (- (+ cfy cfh) border border))))
-       (al (list (max 0 (- cfx pw border)) ahy
-                 (min (- cfx border) pw) ahh 'left))
+       (top-aligned (or below (<= ph cfh)))
+       (graphic (display-graphic-p corfu--frame))
+       (tty-and-border (and (not graphic) corfu-border-on-tty))
+       (border (cond
+                 (graphic corfu-border-width)
+                 (corfu-border-on-tty 1)
+                 (t 0)))
+       (offset (if tty-and-border 1 0))
+       (cfx-right (- (+ cfx cfw) border))
+       (cfy-bottom (- (+ cfy cfh) border))
+       ;; Horizontal area
+       (ahy (if top-aligned
+                cfy
+              (max offset (- cfy-bottom ph border))))
+       (ahh (min ph (if top-aligned
+                        (- pfh border cfy)
+                      (if tty-and-border
+                          cfy-bottom
+                        (- cfy-bottom border)))))
+       ;; Left area: positioned to the left of candidate popup
+       (alx (max offset (if tty-and-border
+                            (- cfx pw (* 2 border))
+                          (- cfx pw border))))
+       (alw (min pw (if tty-and-border
+                        (- cfx (* 3 border))
+                      (- cfx border))))
+       (al (list alx ahy alw ahh 'left))
        ;; Right display area
-       (arx (+ cfx cfw (- border)))
-       (ar (list arx ahy (min (- pfw arx border border) pw) ahh 'right))
+       (arx (if tty-and-border
+                (+ cfx-right (* 2 border) 1)
+              cfx-right))
+       (arw (min pw (if tty-and-border
+                        (- pfw arx border)
+                      (- pfw arx (* 2 border)))))
+       (ar (list arx ahy arw ahh 'right))
        ;; Vertical display area
-       (avw (min pw (- pfw cfx border border)))
-       (av (if below
-               (list cfx (+ cfy cfh (- border)) avw (min (- pfh cfy cfh border) ph) 'vertical)
-             (let ((h (min (- cfy border border) ph)))
-               (list cfx (max 0 (- cfy h border)) avw h 'vertical)))))
+       (avx cfx)
+       (avy (if below
+                (if tty-and-border
+                    (+ cfy-bottom (* 2 border) 1)
+                  cfy-bottom)
+              (max offset (if tty-and-border
+                              (- cfy ph (* 2 border))
+                            (- cfy ph border)))))
+       (avw (min pw (if tty-and-border
+                        (- pfw cfx border)
+                      (- pfw cfx (* 2 border)))))
+       (avh (min ph (if below
+                        (if tty-and-border
+                            (- pfh avy border)
+                          (- pfh avy (* 2 border)))
+                      (if tty-and-border
+                          (- cfy (* 3 border))
+                        (- cfy border)))))
+       (av (list avx avy avw avh 'vertical)))
     (list al ar av)))
 
 (defun corfu-popupinfo--area (ps)
@@ -364,7 +403,8 @@ form (X Y WIDTH HEIGHT DIR)."
             (not (and (corfu-popupinfo--visible-p)
                       (equal-including-properties candidate corfu-popupinfo--candidate))))
            (new-coords (frame-edges corfu--frame 'inner-edges))
-           (coords-changed (not (equal new-coords corfu-popupinfo--coordinates))))
+           (coords-changed (not (equal new-coords corfu-popupinfo--coordinates)))
+           (graphic (display-graphic-p corfu--frame)))
       (when cand-changed
         (if-let ((content (funcall corfu-popupinfo--function candidate)))
             (with-current-buffer (corfu--make-buffer corfu-popupinfo--buffer)
@@ -376,6 +416,9 @@ form (X Y WIDTH HEIGHT DIR)."
                 (set (make-local-variable (car var)) (cdr var)))
               (setq left-margin-width corfu-popupinfo-margin-width
                     right-margin-width corfu-popupinfo-margin-width)
+              (when (and (not graphic) (eq corfu-border-on-tty 'blended))
+                (face-remap-add-relative 'corfu-popupinfo
+                                         :background (face-attribute 'default :background)))
               (when-let ((m (memq 'corfu-default (alist-get 'default face-remapping-alist))))
                 (setcar m 'corfu-popupinfo)))
           (corfu-popupinfo--hide)