echo-bar-render.el

;;; echo-bar-render.el --- Layout, overlays, and message handling -*- lexical-binding: t -*-

;; Author: Anton Chen <mail@antonchen.ca>
;; Version: 0.1.0
;; Package-Requires: ((emacs "29.1"))
;; Keywords: frames, convenience
;; URL: https://github.com/chenanton/echo-bar
;; SPDX-License-Identifier: GPL-3.0-or-later
;; Copyright (C) 2026 Anton Chen

;;; Commentary:
;; Rendering pipeline: assemble cached segment outputs into a positioned
;; display string, manage echo-area overlays, truncate messages.

;;; Code:

(require 'cl-lib)
(require 'subr-x)
(require 'echo-bar-segments)

;;; Width helpers

(defvar echo-bar--mb-width-cache nil
  "Cached minibuffer width in characters.")

(defvar echo-bar--char-width-cache nil
  "Cached `frame-char-width' for pixel->char conversion.")

(defun echo-bar--minibuffer-width ()
  "Return the minibuffer window width in characters (cached)."
  (or echo-bar--mb-width-cache
      (setq echo-bar--mb-width-cache
            (window-body-width (minibuffer-window)))))

(defun echo-bar--string-width (str)
  "Return the display width of STR in characters."
  (if (or (null str) (string-empty-p str))
      0
    (if (display-graphic-p)
        (let ((char-w (or echo-bar--char-width-cache
                          (setq echo-bar--char-width-cache
                                (float (frame-char-width))))))
          (ceiling (/ (float (string-pixel-width str)) char-w)))
      (string-width str))))

(defun echo-bar--on-resize (&rest _)
  "Invalidate width caches on window resize."
  (setq echo-bar--mb-width-cache nil
        echo-bar--char-width-cache nil)
  (echo-bar--idle-refresh))

(defun echo-bar--on-font-change (&rest _)
  "Invalidate char-width cache on font change."
  (setq echo-bar--char-width-cache nil))

;;; Layout

(defun echo-bar--layout-segments (key)
  "Return the list of segment name symbols for layout KEY."
  (mapcar #'intern (plist-get echo-bar-layout key)))

(defun echo-bar--join-group (key)
  "Join cached outputs of segments in layout group KEY.
Returns a separator-delimited string, or \"\" if nothing to show."
  (let* ((names (echo-bar--layout-segments key))
         (parts
          (cl-loop for name-sym in names
                   for seg = (gethash name-sym echo-bar--segments)
                   when seg
                   for cached = (echo-bar--get-cache
                                 name-sym (echo-bar-segment-scope seg))
                   when (and cached (not (string-empty-p cached)))
                   collect cached)))
    (if parts
        (string-join parts echo-bar-separator)
      "")))

(defvar echo-bar--left-width-cache 0
  "Character width of the left group from the last render.
Used by `echo-bar--message-advice' to compute message padding.")

(defun echo-bar--render ()
  "Build the echo area display as a (BEFORE-STR . AFTER-STR) cons.
The left group goes into BEFORE-STR (the overlay `before-string'),
while center and right groups go into AFTER-STR (the overlay
`after-string').  This separation lets Emacs messages (buffer text)
appear between the two, avoiding collision with the left group.

Both strings are bookended with display spacers and have the
`echo-bar-default' face applied for full-width background coverage.

Returns (\"\" . \"\") when no segments have content."
  (let* ((left-str   (echo-bar--join-group :left))
         (center-str (echo-bar--join-group :center))
         (right-str  (echo-bar--join-group :right))
         (mb-width   (echo-bar--minibuffer-width))
         (right-len  (echo-bar--string-width right-str))
         (right-pad  (+ echo-bar-right-padding right-len))
         (left-width (echo-bar--string-width left-str))
         (has-left   (not (string-empty-p left-str)))
         (after-parts nil)
         (before-str "")
         (after-str  ""))
    ;; Cache left width for message padding
    (setq echo-bar--left-width-cache left-width)
    ;; ── Before-string: left group ──
    ;; A trailing space separates the left group from any message that
    ;; Emacs writes as buffer text in the echo area.
    (when has-left
      (let* ((lead  (propertize " " 'display
                                    `(space :align-to ,echo-bar-left-padding)))
             (result (concat lead left-str " ")))
        (add-face-text-property 0 (length result) 'echo-bar-default t result)
        (setq before-str result)))
    ;; ── After-string: center + right groups ──
    ;; Center group: centered, clamped to avoid right overlap
    (when (not (string-empty-p center-str))
      (let* ((center-len (echo-bar--string-width center-str))
             (ideal-pos  (max 0 (/ (- mb-width center-len) 2)))
             (clamped (if (and (> right-len 0)
                                (> (+ ideal-pos center-len
                                      echo-bar-center-right-gap)
                                   (- mb-width right-pad)))
                           (max 0 (- mb-width right-pad center-len
                                     echo-bar-center-right-gap))
                         ideal-pos)))
        (push (concat (propertize " " 'display `(space :align-to ,clamped))
                      center-str)
              after-parts)))
    ;; Right group: align to right edge
    (when (not (string-empty-p right-str))
      (push (concat (propertize " " 'cursor 1 'display
                                `(space :align-to (- right-fringe ,right-pad)))
                    right-str)
            after-parts))
    ;; Build after-string with bookend spacers
    (when after-parts
      (let* ((inner (nreverse after-parts))
             ;; When there is no left group the after-string starts right
             ;; after the buffer anchor, so we need a leading spacer to
             ;; cover it.  When a left group exists the before-string
             ;; already covers the anchor.
             (lead (unless has-left
                     (propertize " " 'display
                                 `(space :align-to ,echo-bar-left-padding))))
             (trail (propertize " " 'display '(space :align-to right-fringe)))
             (pieces (append (if lead (list lead) nil)
                             inner
                             (list trail)))
             (result (apply #'concat pieces)))
        (add-face-text-property 0 (length result) 'echo-bar-default t result)
        (setq after-str result)))
    (cons before-str after-str)))

;;; Overlay management

(defconst echo-bar--echo-buffers
  '(" *Echo Area 0*" " *Echo Area 1*" " *Minibuf-0*")
  "Internal buffers used for the echo area display.")

(defvar echo-bar--overlays nil
  "List of overlays used by echo-bar.")

(defvar echo-bar--face-remap-cookies nil
  "Alist of (BUFFER . COOKIE) for removing face remappings on teardown.")

(defun echo-bar--setup-overlays ()
  "Create overlays on the echo area buffers.
Remap the `default' face to `echo-bar-message' in echo area buffers
so C-level messages inherit a configurable foreground, and to
`echo-bar-default' in minibuffer buffers to avoid colouring input."
  (echo-bar--remove-overlays)
  (dolist (buf-name echo-bar--echo-buffers)
    (with-current-buffer (get-buffer-create buf-name)
      (when (and (minibufferp) (= (buffer-size) 0))
        (insert " "))
      ;; Remap default face so buffer background matches mode-line.
      ;; Echo area buffers use `echo-bar-message' so that C-level
      ;; messages (Quit, Beginning of buffer, …) inherit a user-
      ;; configurable foreground.  *Minibuf-0* uses `echo-bar-default'
      ;; to avoid colouring active minibuffer input.
      (let ((face (if (minibufferp) 'echo-bar-default 'echo-bar-message)))
        (push (cons (current-buffer)
                    (face-remap-add-relative 'default face))
              echo-bar--face-remap-cookies))
      (let ((ov (make-overlay (point-min) (point-max) nil nil t)))
        (overlay-put ov 'before-string "")
        (overlay-put ov 'after-string "")
        (push ov echo-bar--overlays)))))

(defun echo-bar--remove-overlays ()
  "Remove all echo-bar overlays and face remappings."
  (dolist (ov echo-bar--overlays)
    (when (overlayp ov)
      (delete-overlay ov)))
  (setq echo-bar--overlays nil)
  (dolist (entry echo-bar--face-remap-cookies)
    (when (buffer-live-p (car entry))
      (with-current-buffer (car entry)
        (face-remap-remove-relative (cdr entry)))))
  (setq echo-bar--face-remap-cookies nil))

(defun echo-bar--fontify-echo-area ()
  "Re-apply face remapping in the current buffer.
Emacs resets `face-remapping-alist' on minibuffer transitions, so
this must be called from `minibuffer-setup-hook' and
`minibuffer-inactive-mode-hook' to keep the background consistent.
Echo area buffers remap to `echo-bar-message'; minibuffer buffers
remap to `echo-bar-default'."
  (when echo-bar-mode
    (let ((face (if (minibufferp) 'echo-bar-default 'echo-bar-message)))
      (face-remap-add-relative 'default face))))

(defun echo-bar--write-overlays (display)
  "Set the DISPLAY cons (BEFORE-STR . AFTER-STR) on all echo-bar overlays."
  (let ((before (or (car-safe display) ""))
        (after  (or (cdr-safe display) "")))
    (dolist (ov echo-bar--overlays)
      (when (overlayp ov)
        (overlay-put ov 'before-string before)
        (overlay-put ov 'after-string after)))))

(defun echo-bar--current-display-width ()
  "Return the total character width of segment content in the bar.
Sums the widths of both the before-string (left group) and
after-string (center + right groups) from the last render."
  (if (consp echo-bar--last-display)
      (+ (echo-bar--string-width (car echo-bar--last-display))
         (echo-bar--string-width (cdr echo-bar--last-display)))
    0))

;;; Message truncation

(defvar echo-bar--in-message-advice nil
  "Non-nil while inside `echo-bar--message-advice' to prevent recursion.")

(defun echo-bar--message-advice (orig-fn format-string &rest args)
  "Truncate messages to fit alongside echo-bar content.
ORIG-FN is the original `message' function.  FORMAT-STRING and ARGS
are passed through.  The message is truncated to
`echo-bar-message-max-width' characters with an ellipsis."
  (if (and echo-bar-mode
           format-string
           (not echo-bar--in-message-advice)
           (not inhibit-message)
           (not (active-minibuffer-window)))
      (let* ((echo-bar--in-message-advice t)
             (msg (if args
                      (apply #'format-message format-string args)
                    (format-message format-string)))
             (max-w echo-bar-message-max-width)
             (msg-width (string-width msg))
             (truncated (if (> msg-width max-w)
                            (concat (truncate-string-to-width
                                     msg (max 1 (1- max-w)))
                                    "\u2026")
                          msg))
             (styled (progn
                       (add-face-text-property
                        0 (length truncated) 'echo-bar-message t truncated)
                       truncated)))
        (funcall orig-fn "%s" styled))
    (if format-string
        (apply orig-fn format-string args)
      (funcall orig-fn nil))))

(provide 'echo-bar-render)
;;; echo-bar-render.el ends here