;;; klammertext-align.el --- Table alignment for Klammertext -*- lexical-binding: t; -*-

;; EXPERIMENTAL.  Aligns the columns of a table klammer: with point anywhere
;; inside a @table span, `klammertext-align-table' (bound C-c C-a) pads the
;; cells of its rows so the | separators line up vertically:
;;
;;   @table
;;     First item | Second | A third item that's longer ||
;;     Row 2      | Text   | Not as long                ||
;;   @
;;
;; This file is a separate unit, loaded from the init file:
;;
;;   (require 'klammertext-align)
;;
;; Comment that line out to disable alignment entirely.  The Sublime Text
;; port doc/sublime/Klammertext_align.py implements the same algorithm —
;; keep the two in step.
;;
;; Alignment is for SMALL data items (2026-07-27):
;;
;;   * A row is one line ending with the row delimiter || (the customary
;;     trailing delimiter; the parser strips one trailing top-level
;;     delimiter, and it keeps every row uniform).  The last row may omit
;;     the ||.
;;   * A row is LEFT UNTOUCHED when any of its cells is longer than
;;     `klammertext-align-cell-max' (30) characters, or when the row spans
;;     lines (a cell with a newline).  Untouched rows do not contribute to
;;     the column widths.
;;   * If the aligned rows would exceed `klammertext-align-row-max' (100)
;;     columns, nothing is changed and the reason is reported — the general
;;     case of long rows has no good answer, so the command declines rather
;;     than guessing.
;;
;; Cell padding is semantically free: the SKS strips cell content, and no
;; whitespace is ever inserted inside a bar run (that would turn a || row
;; separator into an empty | | cell — the load-bearing-whitespace trap).
;; Bars inside a nested klammer (e.g. @frac 1 | 2 @ in a cell) belong to
;; that klammer, not the table: only bars at nesting depth 0 within the
;; table span count, the same depth rule the Klammermachine itself applies
;; to @cond.  Aligned rows adopt the leading whitespace of the first
;; aligned row; run TAB / `indent-region' first if the rows disagree.
;;
;; SYNC: `klammertext-align-klammers' / `-cell-max' / `-row-max' are
;; mirrored as ALIGN_KLAMMERS / CELL_MAX / ROW_MAX in Klammertext_align.py
;; (a Sublime plugin cannot read these defcustoms).

;;; Code:

(require 'klammertext-mode)

(defgroup klammertext-align nil
  "Table alignment for Klammertext files."
  :group 'klammertext)

(defcustom klammertext-align-klammers '("table")
  "Klammers whose rows `klammertext-align-table' aligns."
  :type '(repeat string)
  :group 'klammertext-align)

(defcustom klammertext-align-cell-max 30
  "A row with a cell longer than this many characters is left untouched.
Alignment is for small data items."
  :type 'integer
  :group 'klammertext-align)

(defcustom klammertext-align-row-max 100
  "Refuse to align when the aligned rows would exceed this many columns.
nil means no limit."
  :type '(choice integer (const nil))
  :group 'klammertext-align)

;; --- string helpers (the mode's helpers are buffer-based) ----------------

(defun klammertext-align--escaped-p (s pos)
  "Non-nil if the char at POS in string S is escaped by an odd run of ^."
  (let ((n 0) (i (1- pos)))
    (while (and (>= i 0) (eq (aref s i) ?^))
      (setq n (1+ n) i (1- i)))
    (= (mod n 2) 1)))

(defun klammertext-align--block-end (s frm)
  "Index just after the ]# closing a #[ block opened at FRM in string S.
Counts nested #[ ... ]#; (length S) if unclosed."
  (let ((depth 1) (i frm) (n (length s)))
    (while (> depth 0)
      (let ((a (string-search "#[" s i))
            (b (string-search "]#" s i)))
        (cond
         ((and (null a) (null b))
          (setq i n depth 0))
         ((or (null b) (and a (< a b)))
          (setq depth (1+ depth) i (+ a 2)))
         (t
          (setq depth (1- depth) i (+ b 2))))))
    i))

(defun klammertext-align--at-run-end (s pos)
  "Index just after the run of @ that begins at POS in string S."
  (let ((p pos) (n (length s)))
    (while (and (< p n) (eq (aref s p) ?@))
      (setq p (1+ p)))
    p))

(defun klammertext-align--name-end (s pos)
  "Index just past the run of name chars starting at POS in string S."
  (let ((k pos) (n (length s)))
    (while (and (< k n) (klammertext--name-char-p (aref s k)))
      (setq k (1+ k)))
    k))

;; --- finding the enclosing table span (buffer-based) ---------------------

(defun klammertext-align--enclosing-span (pos names)
  "Innermost span of a klammer named in NAMES that contains POS.
Return (NAME CONTENT-START CONTENT-END) with CONTENT-START just after the
opening @NAME token and CONTENT-END at the start of the closing delimiter
token, or nil.  Scans the buffer from the top with a position stack,
stepping over removed text, literal spans, escaped characters, and the
abbreviated @name-arg form."
  (save-excursion
    (goto-char (point-min))
    (let ((stack nil) (found nil) (go t))
      (while (and go (not found)
                  (re-search-forward "[@#]" nil t))
        (let ((hit (1- (point))))
          (cond
           ((klammertext--escaped-p hit))
           ((eq (char-after hit) ?#)
            (let ((next (char-after (1+ hit))))
              (cond
               ((eq next ?#) (setq go nil))
               ((eq next ?\[) (goto-char (klammertext--block-end (+ hit 2))))
               ((memq next '(?+ ?/ ?-)))
               (t (goto-char (line-end-position))))))
           (t
            (let* ((run-end (klammertext--at-run-end hit))
                   (len (- run-end hit)))
              (if (klammertext--name-char-p (char-after run-end))
                  (progn
                    (goto-char run-end)
                    (skip-chars-forward "A-Za-z0-9_")
                    (let ((name (buffer-substring-no-properties run-end (point))))
                      (cond
                       ((and (= len 1)
                             (member name klammertext-literal-klammers))
                        (unless (re-search-forward
                                 (concat (regexp-quote name) "@") nil t)
                          (setq go nil)))
                       ((and (= len 1) (eq (char-after) ?-)))
                       (t (push (list name hit (point)) stack)))))
                ;; a close: token starts at the preceding name run, if any
                (let* ((ns (save-excursion
                             (goto-char hit)
                             (skip-chars-backward "A-Za-z0-9_")
                             (point)))
                       (tok-start (if (and (< ns hit)
                                           (or (= ns (point-min))
                                               (not (eq (char-before ns) ?@))))
                                      ns
                                    hit))
                       (entry (pop stack)))
                  (when (and entry
                             (member (nth 0 entry) names)
                             (<= (nth 1 entry) pos)
                             (<= pos run-end))
                    (setq found (list (nth 0 entry) (nth 2 entry) tok-start)))
                  (goto-char run-end))))))))
      found)))

;; --- scanning the span content, line by line -----------------------------
;; A line record is a vector:
;;   [START END START-DEPTH END-DEPTH BARS BLOCKED COMMENT]
;; START/END are offsets into the content string (END excludes the newline);
;; BARS is a list of (POS . RUNLEN) for unescaped depth-0 bar runs, in order.

(defun klammertext-align--line-index (starts p)
  "Index of the line (in the STARTS vector) containing offset P."
  (let ((lo 0) (hi (1- (length starts))))
    (while (< lo hi)
      (let ((mid (/ (+ lo hi 1) 2)))
        (if (<= (aref starts mid) p)
            (setq lo mid)
          (setq hi (1- mid)))))
    lo))

(defun klammertext-align--block-lines (lines starts n a b)
  "Mark every line record touched by [A, B) as blocked."
  (let* ((last (max a (1- b)))
         (k0 (klammertext-align--line-index starts a))
         (k1 (klammertext-align--line-index starts (min last (max 0 (1- n))))))
    (let ((k k0))
      (while (<= k k1)
        (aset (aref lines k) 5 t)
        (setq k (1+ k))))))

(defun klammertext-align--scan-lines (content)
  "Scan CONTENT (a table span's text).  Return the vector of line records."
  (let* ((n (length content))
         (starts (let ((acc (list 0)))
                   (dotimes (idx n)
                     (when (eq (aref content idx) ?\n)
                       (push (1+ idx) acc)))
                   (vconcat (nreverse acc))))
         (nlines (length starts))
         (lines (make-vector nlines nil)))
    (dotimes (k nlines)
      (aset lines k (vector (aref starts k)
                            (if (< (1+ k) nlines)
                                (1- (aref starts (1+ k)))
                              n)
                            nil nil nil nil nil)))
    (aset (aref lines 0) 2 0)
    (let ((depth 0) (i 0) (go t))
      (while (and go (< i n))
        (let ((j i))
          (while (and (< j n)
                      (not (memq (aref content j) '(?@ ?# ?| ?\n))))
            (setq j (1+ j)))
          (if (>= j n)
              (setq go nil)
            (let ((hit j) (c (aref content j)))
              (setq i (1+ hit))
              (cond
               ((eq c ?\n)
                (let ((k (klammertext-align--line-index starts hit)))
                  (aset (aref lines k) 3 depth)
                  (when (< (1+ k) nlines)
                    (aset (aref lines (1+ k)) 2 depth))))
               ((klammertext-align--escaped-p content hit))
               ((eq c ?#)
                (let ((next (and (< (1+ hit) n) (aref content (1+ hit)))))
                  (cond
                   ((eq next ?#)
                    (klammertext-align--block-lines lines starts n hit n)
                    (setq go nil))
                   ((eq next ?\[)
                    (let ((e (klammertext-align--block-end content (+ hit 2))))
                      (unless (= (klammertext-align--line-index starts (max hit (1- e)))
                                 (klammertext-align--line-index starts hit))
                        (klammertext-align--block-lines lines starts n hit e))
                      (setq i e)))
                   ((memq next '(?+ ?/ ?-)))
                   (t
                    (aset (aref lines (klammertext-align--line-index starts hit)) 6 t)
                    (let ((eol (string-search "\n" content hit)))
                      (setq i (or eol n)))))))
               ((eq c ?|)
                (unless (and (> hit 0) (eq (aref content (1- hit)) ?|))
                  (let ((k hit))
                    (while (and (< k n) (eq (aref content k) ?|))
                      (setq k (1+ k)))
                    (when (= depth 0)
                      (let ((rec (aref lines (klammertext-align--line-index starts hit))))
                        (aset rec 4 (append (aref rec 4)
                                            (list (cons hit (- k hit)))))))
                    (setq i k))))
               (t                        ; ?@
                (let* ((run-end (klammertext-align--at-run-end content hit))
                       (run-len (- run-end hit))
                       (after (and (< run-end n) (aref content run-end))))
                  (if (klammertext--name-char-p after)
                      (let* ((k (klammertext-align--name-end content run-end))
                             (name (substring content run-end k)))
                        (setq i k)
                        (cond
                         ((and (= run-len 1)
                               (member name klammertext-literal-klammers))
                          (let* ((idx (string-search (concat name "@") content k))
                                 (e (if idx (+ idx (length name) 1) n)))
                            (unless (= (klammertext-align--line-index
                                        starts (max hit (1- e)))
                                       (klammertext-align--line-index starts hit))
                              (klammertext-align--block-lines lines starts n hit e))
                            (setq i e)))
                         ((and (= run-len 1) (< k n) (eq (aref content k) ?-)))
                         (t (setq depth (1+ depth)))))
                    (setq depth (max 0 (1- depth)))
                    (setq i run-end)))))))))
      (dotimes (k nlines)
        (let ((rec (aref lines k)))
          (unless (aref rec 2) (aset rec 5 t))
          (unless (aref rec 3) (aset rec 3 depth)))))
    lines))

;; --- the alignment -------------------------------------------------------

(defun klammertext-align--indent-width (content rec)
  "Width of the leading whitespace of line REC in CONTENT."
  (let ((i (aref rec 0)) (end (aref rec 1)))
    (while (and (< i end) (memq (aref content i) '(?\s ?\t)))
      (setq i (1+ i)))
    (- i (aref rec 0))))

(defun klammertext-align--trailing-rowsep-p (content rec)
  "Non-nil when line REC's last depth-0 bar run is a || at the end of the
line (only whitespace after it)."
  (let ((bars (aref rec 4)))
    (and bars
         (let* ((run (car (last bars)))
                (pos (car run)))
           (and (= (cdr run) 2)
                (string-blank-p (substring content (+ pos 2) (aref rec 1))))))))

(defun klammertext-align--parse-row (content rec text chain-ok last-content-p)
  "If line REC is an alignable row, return (REC CELLS TRAILING-P); else nil.
TEXT is the line's text; see the file header for the rules."
  (catch 'no
    (when (or (aref rec 5) (aref rec 6) (not chain-ok))
      (throw 'no nil))
    (unless (and (eql (aref rec 2) 0) (eql (aref rec 3) 0))
      (throw 'no nil))
    (unless (aref rec 4)
      (throw 'no nil))
    (let* ((trailing (klammertext-align--trailing-rowsep-p content rec))
           (bars (aref rec 4))
           (singles (if trailing (butlast bars) bars)))
      (dolist (run singles)
        (unless (= (cdr run) 1)
          (throw 'no nil)))              ; a mid-line || or ||| : not one row
      (unless (or trailing last-content-p)
        (throw 'no nil))                 ; row continues onto the next line
      (ignore text)
      (let* ((cell-start (+ (aref rec 0)
                            (klammertext-align--indent-width content rec)))
             (cell-end (if trailing (car (car (last bars))) (aref rec 1)))
             (bounds (append (list cell-start)
                             (mapcar #'car singles)
                             (list cell-end)))
             (cells nil)
             (b-idx 0))
        (while (< b-idx (1- (length bounds)))
          (let* ((a (+ (nth b-idx bounds) (if (> b-idx 0) 1 0)))
                 (cell (string-trim (substring content a (nth (1+ b-idx) bounds)))))
            (when (> (length cell) klammertext-align-cell-max)
              (throw 'no nil))
            (push cell cells)
            (setq b-idx (1+ b-idx))))
        (list rec (nreverse cells) trailing)))))

(defun klammertext-align--pad (cell width)
  (concat cell (make-string (max 0 (- width (length cell))) ?\s)))

(defun klammertext-align--edits (content)
  "Compute the alignment edits for CONTENT (a table span's text).
Return (EDITS . MESSAGE): EDITS is a list of (START END NEW) triples
relative to CONTENT, ascending; MESSAGE is a status string (a reason when
EDITS is nil)."
  (let* ((lines (klammertext-align--scan-lines content))
         (nlines (length lines))
         (last-content nil))
    (let ((k (1- nlines)))
      (while (and (>= k 1) (null last-content))
        (let ((rec (aref lines k)))
          (unless (string-blank-p (substring content (aref rec 0) (aref rec 1)))
            (setq last-content k)))
        (setq k (1- k))))
    (let ((rows nil) (chain-ok t))
      (let ((k 1))
        (while (< k nlines)
          (let* ((rec (aref lines k))
                 (text (substring content (aref rec 0) (aref rec 1)))
                 (stripped (string-trim text)))
            (cond
             ((string-empty-p stripped))          ; blank: chain unchanged
             ((and (string-prefix-p ":" stripped) ; option line: unchanged
                   (null (aref rec 4))))
             (t
              (let ((row (klammertext-align--parse-row
                          content rec text chain-ok (eql k last-content))))
                (setq chain-ok (klammertext-align--trailing-rowsep-p content rec))
                (when row (push row rows))))))
          (setq k (1+ k))))
      (setq rows (nreverse rows))
      (if (null rows)
          (cons nil "no alignable rows found")
        (let* ((ncols (apply #'max (mapcar (lambda (r) (length (nth 1 r))) rows)))
               (widths (make-vector ncols 0)))
          (dolist (r rows)
            (let ((c-idx 0))
              (dolist (cell (nth 1 r))
                (aset widths c-idx (max (aref widths c-idx) (length cell)))
                (setq c-idx (1+ c-idx)))))
          (let* ((indent (make-string (klammertext-align--indent-width
                                       content (nth 0 (car rows)))
                                      ?\s))
                 (longest 0))
            (dolist (r rows)
              (let* ((m (length (nth 1 r)))
                     (w (+ (length indent)
                           (let ((sum 0) (c 0))
                             (while (< c m)
                               (setq sum (+ sum (aref widths c)) c (1+ c)))
                             sum)
                           (* 3 (1- m))
                           (if (nth 2 r) 3 0))))
                (setq longest (max longest w))))
            (if (and klammertext-align-row-max
                     (> longest klammertext-align-row-max))
                (cons nil (format "aligned rows would be %d characters (limit %d); not aligning"
                                  longest klammertext-align-row-max))
              (let ((edits nil))
                (dolist (r rows)
                  (let* ((rec (nth 0 r))
                         (cells (nth 1 r))
                         (trailing (nth 2 r))
                         (m (length cells))
                         (parts nil)
                         (c-idx 0))
                    (dolist (cell cells)
                      (push (if (and (= c-idx (1- m)) (not trailing))
                                cell
                              (klammertext-align--pad cell (aref widths c-idx)))
                            parts)
                      (setq c-idx (1+ c-idx)))
                    (let ((new (concat indent
                                       (mapconcat #'identity (nreverse parts) " | ")
                                       (if trailing " ||" ""))))
                      (unless (string= new (substring content
                                                      (aref rec 0) (aref rec 1)))
                        (push (list (aref rec 0) (aref rec 1) new) edits)))))
                (setq edits (nreverse edits))
                (cons edits
                      (if edits
                          (format "aligned %d rows" (length rows))
                        "already aligned"))))))))))

;; --- the command ---------------------------------------------------------

(defun klammertext-align-table ()
  "Align the columns of the table klammer containing point.
Rows with a cell longer than `klammertext-align-cell-max' characters, or
spanning lines, are left untouched; see the file header for the full rules."
  (interactive)
  (let ((span (klammertext-align--enclosing-span (point)
                                                 klammertext-align-klammers)))
    (unless span
      (user-error "Point is not inside a table klammer (%s)"
                  (mapconcat (lambda (name) (concat "@" name))
                             klammertext-align-klammers ", ")))
    (let* ((beg (nth 1 span))
           (content (buffer-substring-no-properties beg (nth 2 span)))
           (result (klammertext-align--edits content)))
      (save-excursion
        (dolist (e (sort (copy-sequence (car result))
                         (lambda (a b) (> (nth 0 a) (nth 0 b)))))
          (goto-char (+ beg (nth 0 e)))
          (delete-region (+ beg (nth 0 e)) (+ beg (nth 1 e)))
          (insert (nth 2 e))))
      (message "Klammertext: %s" (cdr result)))))

(define-key klammertext-mode-map (kbd "C-c C-a") #'klammertext-align-table)

(provide 'klammertext-align)
;;; klammertext-align.el ends here