echo-bar-segments.el

;;; echo-bar-segments.el --- Segment macro and built-in segments -*- 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) 2024-2026 Anton Chen

;;; Commentary:
;; The `echo-bar-defsegment' macro and all built-in segment definitions.
;; Segments declare what triggers them; the engine (echo-bar-engine.el)
;; wires up hooks and advice at mode activation time.

;;; Code:

(require 'cl-lib)
(require 'subr-x)

;; Struct and state needed by the macro and segment functions.
;; Defined here to avoid circular deps with the engine.

(cl-defstruct echo-bar-segment
  "A displayable segment in the echo bar."
  name       ; symbol
  fn         ; function returning string or nil
  face       ; face symbol or nil
  scope      ; :buffer or :global
  triggers   ; plist (:hooks :advice :timers)
  setup      ; function to run once on first activation, or nil
  (activated nil))  ; whether :setup has run

(defvar echo-bar--segments (make-hash-table :test 'eq)
  "Registry of all defined segments, keyed by name symbol.")

(defvar echo-bar--post-command-segments nil
  "List of segment name symbols triggered by `post-command-hook'.")

;; Per-buffer cache: segment-name -> output string
(defvar-local echo-bar--buffer-cache nil
  "Buffer-local cache of segment output strings.")

;; Global cache for :global scope segments
(defvar echo-bar--global-cache (make-hash-table :test 'eq)
  "Global cache of segment output strings for :global scope segments.")

;; Per-buffer dirty set
(defvar-local echo-bar--buffer-dirty nil
  "Buffer-local set of dirty segment names.")

;; Global dirty set
(defvar echo-bar--global-dirty (make-hash-table :test 'eq)
  "Global set of dirty :global segment names.")

(defun echo-bar--buffer-cache ()
  "Return the buffer-local segment cache, creating if needed."
  (or echo-bar--buffer-cache
      (setq echo-bar--buffer-cache (make-hash-table :test 'eq))))

(defun echo-bar--buffer-dirty ()
  "Return the buffer-local dirty set, creating if needed."
  (or echo-bar--buffer-dirty
      (setq echo-bar--buffer-dirty (make-hash-table :test 'eq))))

(defun echo-bar--get-cache (name scope)
  "Get cached output for segment NAME with SCOPE."
  (gethash name (if (eq scope :global)
                    echo-bar--global-cache
                  (echo-bar--buffer-cache))))

(defun echo-bar--set-cache (name scope value)
  "Set cached output for segment NAME with SCOPE to VALUE."
  (puthash name value (if (eq scope :global)
                          echo-bar--global-cache
                        (echo-bar--buffer-cache))))

(defun echo-bar--recompute-segment (name)
  "Recompute segment NAME: call its fn, apply face, update cache."
  (when-let* ((seg (gethash name echo-bar--segments)))
    ;; Run setup once on first activation
    (unless (echo-bar-segment-activated seg)
      (setf (echo-bar-segment-activated seg) t)
      (when-let* ((setup (echo-bar-segment-setup seg)))
        (funcall setup)))
    ;; Compute output
    (let* ((raw (condition-case err
                    (funcall (echo-bar-segment-fn seg))
                  (error
                   (message "echo-bar: segment `%s' error: %S" name err)
                   nil)))
           (output (if (and raw (not (string-empty-p raw))
                            (echo-bar-segment-face seg))
                       (propertize raw 'face (echo-bar-segment-face seg))
                     raw)))
      (echo-bar--set-cache name (echo-bar-segment-scope seg) output))))

;;; Macro

(defmacro echo-bar-defsegment (name docstring &rest props)
  "Define an echo-bar segment NAME with DOCSTRING and properties PROPS.

PROPS is a plist supporting:
  :triggers  Plist of (:hooks :advice :timers) that trigger updates.
             :hooks   - list of hook symbols
             :advice  - alist of (FUNCTION . HOW) pairs
             :timers  - plist (:idle SECS :repeat BOOL)
                        Fires after SECS of idle; repeats each idle if REPEAT.
  :fn        Body form(s) evaluated to produce the segment string (or nil).
  :face      Face symbol applied to the output.
  :scope     :buffer (default) or :global.
  :setup     Form(s) run once on first activation."
  (declare (indent 2) (doc-string 2))
  (let* ((fn-sym (intern (format "echo-bar-segment--%s" name)))
         (triggers (plist-get props :triggers))
         (fn-body (plist-get props :fn))
         (face (plist-get props :face))
         (scope (or (plist-get props :scope) :buffer))
         (setup-body (plist-get props :setup))
         (setup-sym (when setup-body
                      (intern (format "echo-bar-segment--setup-%s" name)))))
    `(progn
       (defun ,fn-sym ()
         ,docstring
         ,fn-body)
       ;; Byte-compile at load time if not already compiled/native-compiled
       ,(unless (bound-and-true-p byte-compile-current-file)
          `(unless (or (byte-code-function-p (symbol-function #',fn-sym))
                       (and (fboundp 'subr-native-elisp-p)
                            (subr-native-elisp-p (symbol-function #',fn-sym))))
             (let (byte-compile-warnings)
               (byte-compile #',fn-sym))))
       ,@(when setup-sym
           `((defun ,setup-sym () ,setup-body)))
       (puthash ',name
                (make-echo-bar-segment
                 :name ',name
                 :fn #',fn-sym
                 :face ',face
                 :scope ,scope
                 :triggers ',triggers
                 :setup ,(when setup-sym `#',setup-sym))
                echo-bar--segments)
       ,@(when (memq 'post-command-hook (plist-get triggers :hooks))
           `((cl-pushnew ',name echo-bar--post-command-segments))))))

;;; Built-in segments ──────────────────────────────────────────────

;; Post-command-hook group (handled by single combined handler)

(echo-bar-defsegment buffer-name
  "Buffer name with modification and read-only indicators."
  :triggers (:hooks (post-command-hook after-save-hook read-only-mode-hook))
  :fn (let ((name (buffer-name)))
        (cond
         (buffer-read-only
          (concat name "%"))
         ((and (buffer-file-name) (buffer-modified-p))
          (concat name "*"))
         (t name)))
  :face echo-bar-buffer-name)

(echo-bar-defsegment buffer-position
  "Cursor line and column."
  :triggers (:hooks (post-command-hook))
  :fn (format "%d:%d" (line-number-at-pos) (current-column))
  :face echo-bar-buffer-position)

(echo-bar-defsegment selection-info
  "Line and character count when region is active."
  :triggers (:hooks (post-command-hook))
  :fn (when (use-region-p)
        (let ((lines (count-lines (region-beginning) (region-end)))
              (chars (abs (- (region-end) (region-beginning)))))
          (format "%dL,%dC" lines chars)))
  :face echo-bar-selection)

(echo-bar-defsegment narrow
  "Indicator when buffer is narrowed."
  :triggers (:hooks (post-command-hook))
  :fn (when (buffer-narrowed-p) "Narrow")
  :face echo-bar-warning)

(echo-bar-defsegment macro
  "Indicator when recording a keyboard macro."
  :triggers (:hooks (post-command-hook))
  :fn (when defining-kbd-macro "REC")
  :face echo-bar-warning)

(echo-bar-defsegment process
  "Active process indicator from mode-line-process."
  :triggers (:hooks (post-command-hook))
  :fn (when mode-line-process
        (let ((str (string-trim (format-mode-line mode-line-process))))
          (unless (string-empty-p str) str)))
  :face echo-bar-dim)

(echo-bar-defsegment profiler
  "Indicator when the Emacs profiler is running."
  :scope :global
  :triggers (:hooks (post-command-hook))
  :fn (when (or (and (fboundp 'profiler-cpu-running-p)
                     (profiler-cpu-running-p))
                (and (fboundp 'profiler-memory-running-p)
                     (profiler-memory-running-p)))
        "PROF")
  :face echo-bar-warning)

;; Event-driven segments

(echo-bar-defsegment major-mode
  "Current major mode name."
  :triggers (:hooks (after-change-major-mode-hook))
  :fn (format-mode-line mode-name)
  :face echo-bar-major-mode)

(echo-bar-defsegment vcs
  "Version control branch."
  :triggers (:hooks (find-file-hook after-save-hook)
             :advice ((vc-refresh-state . :after)))
  :fn (when-let* ((vc vc-mode))
        (string-trim (substring-no-properties vc)))
  :face echo-bar-vcs)

(echo-bar-defsegment project
  "Current project name."
  :triggers (:hooks (find-file-hook))
  :fn (when-let* ((proj (project-current)))
        (project-name proj))
  :face echo-bar-project)

(echo-bar-defsegment blame
  "Indicator when magit-blame is active."
  :triggers (:hooks (magit-blame-mode-hook))
  :fn (when (bound-and-true-p magit-blame-mode) "Blame")
  :face echo-bar-dim)

(echo-bar-defsegment text-scale
  "Text scale level when non-zero."
  :triggers (:hooks (text-scale-mode-hook))
  :fn (when (and (boundp 'text-scale-mode-amount)
                 (not (zerop text-scale-mode-amount)))
        (format "Zoom:%+d" text-scale-mode-amount))
  :face echo-bar-dim)

(echo-bar-defsegment repeat
  "Indicator when repeat-mode is in progress."
  :scope :global
  :triggers (:advice ((repeat-post-hook . :after)))
  :fn (when (and (bound-and-true-p repeat-mode)
                 (bound-and-true-p repeat-in-progress))
        "REPEAT")
  :face echo-bar-warning)

;; Timer/piggyback global segments

(echo-bar-defsegment time
  "Current time."
  :scope :global
  :triggers (:timers (:idle 10 :repeat t))
  :fn (format-time-string echo-bar-time-format)
  :face echo-bar-time)

(echo-bar-defsegment battery
  "Battery status."
  :scope :global
  :triggers (:advice ((battery-update . :after)))
  :setup (display-battery-mode 1)
  :fn (when (bound-and-true-p battery-mode-line-string)
        (string-trim battery-mode-line-string))
  :face echo-bar-battery)

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