diff options
| -rw-r--r-- | corfu.el | 65 | ||||
| -rw-r--r-- | extensions/corfu-popupinfo.el | 81 |
2 files changed, 112 insertions, 34 deletions
@@ -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) |