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

2 files changed, 79 insertions, 30 deletions

diff --git a/corfu.el b/corfu.el
index 2c31ff6..c0769aa 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,13 +540,17 @@ 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 (or (not (facep 'child-frame-border))
-                  (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 (or (not (facep 'child-frame-border))
+                    (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
@@ -1134,15 +1163,20 @@ 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 (if graphic
+                         corfu-border-width
+                       (if corfu-border-on-tty 1 0)))
+             ;; 1 border-width space when corfu-border-on-tty is non-nil
+             (space (if (and (not graphic) corfu-border-on-tty) border 0))
+             (x (max space
+                     (min (+ (car edge) (- (or (car pos) 0) ml (* cw off) border) space)
+                          (- (frame-pixel-width) width
+                             (if graphic (+ ml mr (* 2 border)) 0) space))))
              (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 (+ space (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 a34c08c..ce89fb5 100644
--- a/extensions/corfu-popupinfo.el
+++ b/extensions/corfu-popupinfo.el
@@ -303,7 +303,6 @@ form (X Y WIDTH HEIGHT DIR)."
   (pcase-let*
       ((cw (default-font-width))
        (lh (default-line-height))
-       (border (if (display-graphic-p corfu--frame) corfu-border-width 0))
        (`(,_pfx ,_pfy ,pfw ,pfh)
         (corfu-popupinfo--frame-geometry (frame-parent corfu--frame)))
        (`(,cfx ,cfy ,cfw ,cfh) (corfu-popupinfo--frame-geometry corfu--frame))
@@ -313,24 +312,34 @@ form (X Y WIDTH HEIGHT DIR)."
                          (or (cdr (posn-x-y (posn-at-point (point)))) 0))))
        ;; Popups aligned at top
        (top-aligned (or below (< (cdr ps) cfh)))
-       ;; Left display area
+       (graphic (display-graphic-p corfu--frame))
+       (border (if graphic
+                   corfu-border-width
+                 (if corfu-border-on-tty 1 0)))
+       ;; 1 border-width space when corfu-border-on-tty is non-nil
+       (space (if (and (not graphic) corfu-border-on-tty) border 0))
+       ;; Horizontal display area
        (ahy (if top-aligned
                 cfy
-              (max 0 (- (+ cfy cfh) border border (cdr ps)))))
+              (max space (+ (- (+ cfy cfh) border border (cdr ps)) space space))))
        (ahh (if top-aligned
                 (min (- pfh cfy) (cdr ps))
-              (min (- (+ cfy cfh) border border) (cdr ps))))
-       (al (list (max 0 (- cfx (car ps) border)) ahy
-                 (min (- cfx border) (car ps)) ahh 'left))
+              (min (+ (- (+ cfy cfh) border border) space) (cdr ps))))
+       ;; Left display area
+       (al (list (max space (- cfx (car ps) border space)) ahy
+                 (min (- cfx border space space) (car ps)) ahh 'left))
        ;; Right display area
-       (arx (+ cfx cfw (- border)))
-       (ar (list arx ahy (min (- pfw arx border border) (car ps)) ahh 'right))
+       (arx (+ cfx cfw (- border) space space space))
+       (ar (list arx ahy
+                 (min (+ (- pfw arx border border) space) (car ps)) ahh 'right))
        ;; Vertical display area
-       (avw (min (car ps) (- pfw cfx border border)))
+       (avw (min (car ps) (+ (- pfw cfx border border) space)))
        (av (if below
-               (list cfx (+ cfy cfh (- border)) avw (min (- pfh cfy cfh border) (cdr ps)) 'vertical)
-             (let ((h (min (- cfy border border) (cdr ps))))
-               (list cfx (max 0 (- cfy h border)) avw h 'vertical)))))
+               (list cfx (+ cfy cfh (- border) space space space)
+                     avw (min (- pfh cfy cfh border space space) (cdr ps)) 'vertical)
+             (let ((h (min (- cfy border border space) (cdr ps))))
+               (list cfx (max space (- cfy h border space))
+                     avw h 'vertical)))))
     (unless (and corfu-popupinfo--lock-dir
                  (corfu-popupinfo--fits-p
                   (cons (* cw corfu-popupinfo-min-width) (* lh corfu-popupinfo-min-height))
@@ -358,7 +367,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)
@@ -370,12 +380,17 @@ 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)
           (setq cand-changed nil coords-changed nil)))
       (when (or cand-changed coords-changed)
-        (pcase-let* ((border (if (display-graphic-p corfu--frame) corfu-border-width 0))
+        (pcase-let* ((border (if graphic
+                                 corfu-border-width
+                               (if corfu-border-on-tty 1 0)))
                      (`(,area-x ,area-y ,area-w ,area-h ,area-d)
                       (corfu-popupinfo--area
                        (if cand-changed