From b23ec7e9e074f544aa003533ee472f80103e6f67 Mon Sep 17 00:00:00 2001 From: xenodium <8107219+xenodium@users.noreply.github.com> Date: Sun, 17 May 2026 16:48:31 +0100 Subject: [PATCH 01/16] Initial markdown-text integration --- agent-shell.el | 40 ++++++++++++++++++++++++++++++++++------ 1 file changed, 34 insertions(+), 6 deletions(-) diff --git a/agent-shell.el b/agent-shell.el index 0b39dc4c..4c8dc6a3 100644 --- a/agent-shell.el +++ b/agent-shell.el @@ -48,6 +48,7 @@ (require 'map) (unless (require 'markdown-overlays nil 'noerror) (error "Please update 'shell-maker' to v0.91.2 or newer")) +(require 'markdown-text nil :noerror) (require 'agent-shell-anthropic) (require 'agent-shell-auggie) (require 'agent-shell-cline) @@ -97,6 +98,33 @@ ;; lexical bindings (which would not affect `auto-insert' behavior). (defvar auto-insert) +(defvar agent-shell--experimental-renderer nil + "When non-nil, render markdown via `markdown-text'. + +Internal/experimental. `markdown-text' replaces markup +characters with propertized text in place (no overlays), which +avoids the redisplay overhead of large overlay counts but +destroys the source markdown. Defaults to nil (keep current +`markdown-overlays' behaviour). + +Has no effect when `markdown-text' isn't installed.") + +(defun agent-shell--render-markdown () + "Render markdown in current (narrowed) buffer. + +Dispatches to `markdown-text-replace-markup' when +`agent-shell--experimental-renderer' is non-nil and the package +is loadable; otherwise falls back to `markdown-overlays-put'. + +`markdown-overlays-*' config bindings around the call still apply +in the overlay branch; they're intentionally ignored by +`markdown-text', which always highlights blocks and renders +resolvable images." + (if (and agent-shell--experimental-renderer + (fboundp 'markdown-text-replace-markup)) + (markdown-text-replace-markup) + (markdown-overlays-put))) + (defcustom agent-shell-permission-icon "⚠" "Icon displayed when shell commands require permission to execute. @@ -3029,7 +3057,7 @@ by default, RENDER-BODY-IMAGES to enable inline image rendering in body." (narrow-to-region body-start body-end) (let ((markdown-overlays-highlight-blocks agent-shell-highlight-blocks) (markdown-overlays-render-images render-body-images)) - (markdown-overlays-put)))) + (agent-shell--render-markdown)))) ;; Note: For now, we're skipping applying markdown overlays ;; on left labels as they currently carry propertized text ;; for statuses (ie. boxed). @@ -3041,7 +3069,7 @@ by default, RENDER-BODY-IMAGES to enable inline image rendering in body." (narrow-to-region label-right-start label-right-end) (let ((markdown-overlays-highlight-blocks agent-shell-highlight-blocks) (markdown-overlays-render-images nil)) - (markdown-overlays-put)))) + (agent-shell--render-markdown)))) (when auto-scroll (goto-char (point-max))))))) (with-current-buffer (map-elt state :buffer) @@ -3087,7 +3115,7 @@ by default, RENDER-BODY-IMAGES to enable inline image rendering in body." (body-end (map-nested-elt range '(:body :end)))) (narrow-to-region body-start body-end) (let ((markdown-overlays-highlight-blocks agent-shell-highlight-blocks)) - (markdown-overlays-put)) + (agent-shell--render-markdown)) (widen)) ;; ;; Note: For now, we're skipping applying markdown overlays @@ -3099,7 +3127,7 @@ by default, RENDER-BODY-IMAGES to enable inline image rendering in body." (label-right-end (map-nested-elt range '(:label-right :end)))) (narrow-to-region label-right-start label-right-end) (let ((markdown-overlays-highlight-blocks agent-shell-highlight-blocks)) - (markdown-overlays-put)) + (agent-shell--render-markdown)) (widen))) (run-hook-with-args 'agent-shell-section-functions range))) (unless auto-scroll @@ -5309,7 +5337,7 @@ inserted into the shell buffer prompt." ```" (with-current-buffer output-buffer (buffer-string)))))) (let ((markdown-overlays-highlight-blocks agent-shell-highlight-blocks)) - (markdown-overlays-put)) + (agent-shell--render-markdown)) (when (buffer-live-p output-buffer) (kill-buffer output-buffer))))))) (set-process-query-on-exit-flag proc nil) @@ -6047,7 +6075,7 @@ Returns an alist with insertion details or nil otherwise: (narrow-to-region insert-start insert-end) (let ((markdown-overlays-highlight-blocks agent-shell-highlight-blocks) (markdown-overlays-render-images nil)) - (markdown-overlays-put)))) + (agent-shell--render-markdown)))) (when submit (shell-maker-submit))) `((:buffer . ,shell-buffer) From 5574e5d396f350353ea269f3500684d01e6a026d Mon Sep 17 00:00:00 2001 From: xenodium <8107219+xenodium@users.noreply.github.com> Date: Sun, 17 May 2026 18:29:50 +0100 Subject: [PATCH 02/16] Getting rid of cache to avoid regeneration. Always append. --- agent-shell-ui.el | 406 +++++++++++++++++++++++++++++++--------------- 1 file changed, 271 insertions(+), 135 deletions(-) diff --git a/agent-shell-ui.el b/agent-shell-ui.el index 74e3e36a..4cd066c6 100644 --- a/agent-shell-ui.el +++ b/agent-shell-ui.el @@ -37,10 +37,6 @@ (require 'subr-x) (require 'text-property-search) -(defvar-local agent-shell-ui--content-store nil - "A hash table used to save sui content like body. -This avoids duplicating body content in text properties which is more costly.") - (cl-defun agent-shell-ui-make-fragment-model (&key (namespace-id "global") (block-id "1") label-left label-right body) "Create a fragment model alist. NAMESPACE-ID, BLOCK-ID, LABEL-LEFT, LABEL-RIGHT, and BODY are the keys." @@ -69,131 +65,288 @@ When NAVIGATION is `always', block is always TAB navigatable. When EXPANDED is non-nil, body will be expanded by default. When NO-UNDO is non-nil, disable undo recording for this operation. -For existing blocks, the current expansion state is preserved unless overridden." - (let* ((inhibit-read-only t) - (buffer-undo-list (if no-undo t buffer-undo-list)) - (window (get-buffer-window (current-buffer))) - (saved-point (point)) - (saved-mark (mark t)) - (saved-mark-active mark-active) - (saved-window-start (and window (window-start window))) - (namespace-id (map-elt model :namespace-id)) - (qualified-id (format "%s-%s" namespace-id (map-elt model :block-id))) - (new-label-left (map-elt model :label-left)) - (new-label-right (map-elt model :label-right)) - (new-body (map-elt model :body)) - (block-start nil) - (padding-start nil) - (padding-end nil) - (match (save-mark-and-excursion - (goto-char (point-max)) - (text-property-search-backward - 'agent-shell-ui-state nil - (lambda (_ state) - (equal (map-elt state :qualified-id) qualified-id)) - t)))) +For existing blocks, the current expansion state is preserved unless overridden. + +Updates to existing blocks are applied surgically per section: a body +append inserts the new chunk at the end of the body region without +disturbing already-rendered content, so `markdown-text' frozen ranges +stay intact and streaming append is O(new-chunk) rather than +O(accumulated-body). Label-only updates leave the body untouched." + (let* ((window (get-buffer-window (current-buffer))) + (saved-window-start (and window (window-start window)))) (unwind-protect - (progn - (when (or new-label-left new-label-right new-body) - (when match - (goto-char (prop-match-beginning match))) - (if (and match (not create-new)) - ;; Found existing block - delete and regenerate - (let* ((existing-model (agent-shell-ui--read-fragment-at-point)) - (state (get-text-property (point) 'agent-shell-ui-state)) - (existing-body (map-elt existing-model :body)) + (save-mark-and-excursion + (let* ((inhibit-read-only t) + (buffer-undo-list (if no-undo t buffer-undo-list)) + (namespace-id (map-elt model :namespace-id)) + (qualified-id (format "%s-%s" namespace-id (map-elt model :block-id))) + (new-label-left (map-elt model :label-left)) + (new-label-right (map-elt model :label-right)) + (new-body (map-elt model :body)) + (block-start nil) + (padding-start nil) + (padding-end nil) + (match (save-mark-and-excursion + (goto-char (point-max)) + (text-property-search-backward + 'agent-shell-ui-state nil + (lambda (_ state) + (equal (map-elt state :qualified-id) qualified-id)) + t)))) + (when (or new-label-left new-label-right new-body) + (cond + ;; Existing block — apply surgical edits per changed section. + ((and match (not create-new)) + (let* ((state (get-text-property (prop-match-beginning match) + 'agent-shell-ui-state)) + (collapsed (map-elt state :collapsed)) (block-end (prop-match-end match)) - (final-body (if new-body - (if (and append existing-body) - (concat existing-body new-body) - new-body) - existing-body)) - (final-model (list (cons :namespace-id namespace-id) - (cons :block-id (map-elt model :block-id)) - (cons :label-left (or new-label-left - (map-elt existing-model :label-left))) - (cons :label-right (or new-label-right - (map-elt existing-model :label-right))) - (cons :body final-body)))) + (existing-body-range + (agent-shell-ui--nearest-range-matching-property + :property 'agent-shell-ui-section :value 'body + :from (prop-match-beginning match) + :to block-end))) (setq block-start (prop-match-beginning match)) - - ;; Safely replace existing block using narrow-to-region (save-excursion (goto-char block-start) (skip-chars-backward "\n") (setq padding-start (point))) - - ;; Replace block - (delete-region block-start block-end) - (goto-char block-start) - (agent-shell-ui--insert-fragment final-model qualified-id - (not (map-elt state :collapsed)) - navigation) - (setq padding-end (point))) - - ;; Not found or create-new - insert new block - (goto-char (point-max)) - (setq padding-start (point)) - (agent-shell-ui--insert-read-only (agent-shell-ui--required-newlines 2)) - (setq block-start (point)) - (agent-shell-ui--insert-fragment model qualified-id expanded navigation) - (agent-shell-ui--insert-read-only "\n\n") - (setq padding-end (point)))) - (when on-post-process - (funcall on-post-process)) - (when-let ((block-range (agent-shell-ui--block-range :position block-start))) - (list (cons :block block-range) - (cons :body (agent-shell-ui--nearest-range-matching-property - :property 'agent-shell-ui-section :value 'body - :from (map-elt block-range :start) - :to (map-elt block-range :end))) - (cons :label-left (agent-shell-ui--nearest-range-matching-property - :property 'agent-shell-ui-section :value 'label-left - :from (map-elt block-range :start) - :to (map-elt block-range :end))) - (cons :label-right (agent-shell-ui--nearest-range-matching-property - :property 'agent-shell-ui-section :value 'label-right - :from (map-elt block-range :start) - :to (map-elt block-range :end))) - (cons :padding (when (and padding-start padding-end) - (list (cons :start padding-start) - (cons :end padding-end))))))) - (goto-char saved-point) - (when saved-mark - (set-marker (mark-marker) saved-mark)) - (setq mark-active saved-mark-active) + (when new-label-left + (agent-shell-ui--surgical-replace-label + qualified-id 'label-left new-label-left)) + (when new-label-right + (agent-shell-ui--surgical-replace-label + qualified-id 'label-right new-label-right)) + (when new-body + (cond + ;; Append to existing body — preserves rendered content. + ((and append existing-body-range) + (agent-shell-ui--surgical-append-body + existing-body-range new-body qualified-id collapsed)) + ;; Replace existing body in place. + (existing-body-range + (agent-shell-ui--surgical-replace-body + existing-body-range new-body qualified-id collapsed)) + ;; Body arriving for the first time on a labels-only + ;; block — fall back to delete-and-regenerate so the + ;; indicator transitions from placeholder to triangle + ;; and the labels↔body separator is inserted. Labels + ;; are recovered from the buffer (no cache). + (t + (let* ((existing-labels + (agent-shell-ui--read-fragment-labels + (prop-match-beginning match) block-end)) + (final-model + (list (cons :namespace-id namespace-id) + (cons :block-id (map-elt model :block-id)) + (cons :label-left + (or new-label-left + (map-elt existing-labels :label-left))) + (cons :label-right + (or new-label-right + (map-elt existing-labels :label-right))) + (cons :body new-body)))) + (delete-region block-start block-end) + (goto-char block-start) + (agent-shell-ui--insert-fragment + final-model qualified-id (not collapsed) navigation))))) + (setq padding-end + (or (when-let ((block-range + (agent-shell-ui--block-range :position block-start))) + (map-elt block-range :end)) + (point))))) + ;; New block. + (t + (goto-char (point-max)) + (setq padding-start (point)) + (agent-shell-ui--insert-read-only (agent-shell-ui--required-newlines 2)) + (setq block-start (point)) + (agent-shell-ui--insert-fragment model qualified-id expanded navigation) + (agent-shell-ui--insert-read-only "\n\n") + (setq padding-end (point))))) + (when on-post-process + (funcall on-post-process)) + (when-let ((block-range (agent-shell-ui--block-range :position block-start))) + (list (cons :block block-range) + (cons :body (agent-shell-ui--nearest-range-matching-property + :property 'agent-shell-ui-section :value 'body + :from (map-elt block-range :start) + :to (map-elt block-range :end))) + (cons :label-left (agent-shell-ui--nearest-range-matching-property + :property 'agent-shell-ui-section :value 'label-left + :from (map-elt block-range :start) + :to (map-elt block-range :end))) + (cons :label-right (agent-shell-ui--nearest-range-matching-property + :property 'agent-shell-ui-section :value 'label-right + :from (map-elt block-range :start) + :to (map-elt block-range :end))) + (cons :padding (when (and padding-start padding-end) + (list (cons :start padding-start) + (cons :end padding-end)))))))) (when window (set-window-start window saved-window-start t))))) +(defun agent-shell-ui--read-fragment-labels (block-start block-end) + "Return alist with :label-left and :label-right strings (no properties). +Reads from the buffer between BLOCK-START and BLOCK-END. Used only by +the body-arriving-on-labels-only fallback in `agent-shell-ui-update-fragment'. +Labels are short, prop-free strings — safe to round-trip through the +buffer." + (let (fields) + (when-let ((range (agent-shell-ui--nearest-range-matching-property + :property 'agent-shell-ui-section :value 'label-right + :from block-start :to block-end))) + (push (cons :label-right + (buffer-substring-no-properties (map-elt range :start) + (map-elt range :end))) + fields)) + (when-let ((range (agent-shell-ui--nearest-range-matching-property + :property 'agent-shell-ui-section :value 'label-left + :from block-start :to block-end))) + (push (cons :label-left + (buffer-substring-no-properties (map-elt range :start) + (map-elt range :end))) + fields)) + fields)) + +(defun agent-shell-ui--apply-body-section-properties (start end qualified-id state body-invisible) + "Apply body-section text properties to chars in [START, END). +QUALIFIED-ID and STATE feed the help-echo and agent-shell-ui-state +properties. BODY-INVISIBLE non-nil means the existing body region +is currently hidden (collapsed label-ful fragment); new chars must +match. Explicit `invisible' assignment overrides any value the +new chars might have inherited via rear-stickiness from preceding +trailing-whitespace chars." + (add-text-properties start end + `(agent-shell-ui-section body + help-echo ,qualified-id + read-only t + front-sticky (read-only))) + (when state + (put-text-property start end 'agent-shell-ui-state state)) + (put-text-property start end 'invisible (if body-invisible t nil))) + +(defun agent-shell-ui--body-invisible-p (body-start body-end) + "Return non-nil if the existing body region [BODY-START, BODY-END) is hidden. +Inspects the `invisible' property on the first non-whitespace char. +Trailing whitespace alone is always hidden even on visible bodies, +so checking the first body char would misclassify whitespace-leading +bodies." + (save-excursion + (goto-char body-start) + (and (re-search-forward "[^ \t\n]" body-end t) + (eq (get-text-property (1- (point)) 'invisible) t)))) + +(defun agent-shell-ui--apply-trailing-whitespace-invisible (body-start body-end) + "Hide trailing whitespace within [BODY-START, BODY-END) via invisible property. +Marks the hidden chars `rear-nonsticky' for `invisible' so chars later +inserted at BODY-END don't silently inherit `invisible t' from the +trailing-whitespace tail." + (save-excursion + (goto-char body-end) + (when (re-search-backward "[^ \t\n]" body-start t) + (forward-char 1) + (when (< (point) body-end) + (add-text-properties (point) body-end + '(invisible t rear-nonsticky (invisible))))))) + +(defun agent-shell-ui--surgical-append-body (body-range chunk qualified-id _collapsed) + "Insert CHUNK at the end of BODY-RANGE. +Existing body chars stay in place — `markdown-text' frozen tags +and per-char faces are preserved across streaming chunks. +Visibility for new chars is derived from the current visibility of +the existing body, not from caller-supplied state, because +label-less fragments don't follow `state :collapsed' (their bodies +stay visible regardless of how `:collapsed' was stored)." + (when (and (stringp chunk) (not (string-empty-p chunk))) + (let* ((body-start (map-elt body-range :start)) + (body-end (map-elt body-range :end)) + (state (get-text-property (max body-start (1- body-end)) + 'agent-shell-ui-state)) + (body-invisible (agent-shell-ui--body-invisible-p body-start body-end))) + ;; Trailing-whitespace invisibility on the old tail may no longer + ;; apply once the chunk lands — clear and re-derive. Only when + ;; the body is visible; for a hidden body the existing invisible + ;; spans the whole body and must stay. + (unless body-invisible + (remove-text-properties body-start body-end '(invisible nil))) + (goto-char body-end) + (let ((insert-start (point))) + (insert (agent-shell-ui--indent-text chunk " ")) + (let ((insert-end (point))) + (agent-shell-ui--apply-body-section-properties + insert-start insert-end qualified-id state body-invisible) + (agent-shell-ui--apply-trailing-whitespace-invisible + body-start insert-end)))))) + +(defun agent-shell-ui--surgical-replace-body (body-range new-body qualified-id _collapsed) + "Replace body chars in BODY-RANGE with NEW-BODY." + (let* ((body-start (map-elt body-range :start)) + (body-end (map-elt body-range :end)) + (state (get-text-property (max body-start (1- body-end)) + 'agent-shell-ui-state)) + (body-invisible (agent-shell-ui--body-invisible-p body-start body-end))) + (delete-region body-start body-end) + (goto-char body-start) + (when (and (stringp new-body) (not (string-empty-p new-body))) + (let ((trimmed new-body)) + (when (string-prefix-p "\n" trimmed) + (setq trimmed (string-trim-left trimmed "\n"))) + (when (string-suffix-p "\n\n" trimmed) + (setq trimmed (concat (string-trim-right trimmed) "\n\n"))) + (let ((insert-start (point))) + (insert (agent-shell-ui--indent-text + (string-remove-prefix " " trimmed) " ")) + (let ((insert-end (point))) + (agent-shell-ui--apply-body-section-properties + insert-start insert-end qualified-id state body-invisible) + (agent-shell-ui--apply-trailing-whitespace-invisible + insert-start insert-end))))))) + +(defun agent-shell-ui--surgical-replace-label (qualified-id section new-text) + "Replace SECTION region of fragment QUALIFIED-ID with NEW-TEXT. +SECTION is one of `label-left' or `label-right'. Other sections in +the block stay untouched." + (when (stringp new-text) + (when-let* ((block-match + (save-excursion + (goto-char (point-max)) + (text-property-search-backward + 'agent-shell-ui-state nil + (lambda (_ state) + (equal (map-elt state :qualified-id) qualified-id)) + t))) + (region + (save-excursion + (goto-char (prop-match-beginning block-match)) + (when-let ((m (text-property-search-forward + 'agent-shell-ui-section section t t))) + (when (<= (prop-match-end m) (prop-match-end block-match)) + (cons (prop-match-beginning m) + (prop-match-end m))))))) + (let* ((region-start (car region)) + (region-end (cdr region)) + (state (get-text-property region-start 'agent-shell-ui-state))) + (delete-region region-start region-end) + (goto-char region-start) + (let ((insert-start (point))) + (insert (agent-shell-ui-add-action-to-text + new-text + (lambda () + (interactive) + (agent-shell-ui-toggle-fragment-at-point)) + (lambda () + (message "Press RET to toggle")))) + (let ((insert-end (point))) + (add-text-properties insert-start insert-end + `(agent-shell-ui-section ,section + help-echo ,qualified-id + read-only t + front-sticky (read-only))) + (when state + (put-text-property insert-start insert-end + 'agent-shell-ui-state state)))))))) -(defun agent-shell-ui--read-fragment-at (position qualified-id) - "Read fragment at POSITION with QUALIFIED-ID." - (when-let ((fragment (list (cons :block-id qualified-id))) - (state (get-text-property position 'agent-shell-ui-state)) - (range (agent-shell-ui--block-range :position position))) - ;; TODO: Get rid of merging block namespace and id. - ;; Extract namespace-id from qualified-id if it contains a dash - (when (string-match "^\\(.+\\)-\\(.+\\)$" qualified-id) - (setf (map-elt fragment :namespace-id) (match-string 1 qualified-id)) - (setf (map-elt fragment :block-id) (match-string 2 qualified-id))) - (save-mark-and-excursion - (save-restriction - (narrow-to-region (map-elt range :start) - (map-elt range :end)) - (goto-char (map-elt range :start)) - (setf (map-elt fragment :collapsed) (map-elt state :collapsed)) - (when-let ((label-left (agent-shell-ui--nearest-range-matching-property - :property 'agent-shell-ui-section :value 'label-left))) - (setf (map-elt fragment :label-left) (buffer-substring (map-elt label-left :start) - (map-elt label-left :end)))) - (when-let ((label-right (agent-shell-ui--nearest-range-matching-property - :property 'agent-shell-ui-section :value 'label-right))) - (setf (map-elt fragment :label-right) (buffer-substring (map-elt label-right :start) - (map-elt label-right :end)))) - (when agent-shell-ui--content-store - (when-let ((body (gethash (concat qualified-id "-body") agent-shell-ui--content-store))) - (setf (map-elt fragment :body) body))))) - fragment)) (cl-defun agent-shell-ui-delete-fragment (&key namespace-id block-id no-undo) "Delete fragment with NAMESPACE-ID and BLOCK-ID. @@ -213,21 +366,12 @@ When NO-UNDO is non-nil, disable undo recording for this operation." (when match (let ((block-start (prop-match-beginning match)) (block-end (prop-match-end match))) - (when agent-shell-ui--content-store - (remhash qualified-id agent-shell-ui--content-store)) ;; Remove vertical space that's part of the block. (goto-char block-end) (skip-chars-forward " \t\n") (setq block-end (point)) (delete-region block-start block-end)))))) -(defun agent-shell-ui--read-fragment-at-point () - "Read fragment at point, returning model or nil if none found." - (when-let ((state (get-text-property (point) 'agent-shell-ui-state)) - (range (agent-shell-ui--block-range :position (point)))) - (agent-shell-ui--read-fragment-at (map-elt range :start) - (map-elt state :qualified-id)))) - (cl-defun agent-shell-ui--block-range (&key position) "Get block range at POSITION if found. Nil otherwise. @@ -391,17 +535,9 @@ NAVIGATION controls navigability: (when (< (point) body-end) (add-text-properties (point) body-end '(invisible t)))))) - (when body - (unless agent-shell-ui--content-store - (setq agent-shell-ui--content-store (make-hash-table :test 'equal))) - (puthash (concat qualified-id "-body") body agent-shell-ui--content-store)) (put-text-property block-start (or body-end label-right-end label-left-end) 'agent-shell-ui-state (list - ;; Note: Avoid storing chunky data in - ;; agent-shell-ui-state as it will impact performance. - ;; Use agent-shell-ui--content-store for these instances. - ;; For example, fragment body. (cons :qualified-id qualified-id) (cons :collapsed (not expanded)) (cons :navigatable (cond From 0ff7ac5ae647c5dc7555984a22df6509b9e38c3c Mon Sep 17 00:00:00 2001 From: xenodium <8107219+xenodium@users.noreply.github.com> Date: Mon, 18 May 2026 16:34:24 +0100 Subject: [PATCH 03/16] Fixes updating fragment labels --- agent-shell-ui.el | 19 +++++++++++++------ 1 file changed, 13 insertions(+), 6 deletions(-) diff --git a/agent-shell-ui.el b/agent-shell-ui.el index 4cd066c6..6ecbbf9d 100644 --- a/agent-shell-ui.el +++ b/agent-shell-ui.el @@ -100,12 +100,11 @@ O(accumulated-body). Label-only updates leave the body untouched." (let* ((state (get-text-property (prop-match-beginning match) 'agent-shell-ui-state)) (collapsed (map-elt state :collapsed)) - (block-end (prop-match-end match)) (existing-body-range (agent-shell-ui--nearest-range-matching-property :property 'agent-shell-ui-section :value 'body :from (prop-match-beginning match) - :to block-end))) + :to (prop-match-end match)))) (setq block-start (prop-match-beginning match)) (save-excursion (goto-char block-start) @@ -131,11 +130,19 @@ O(accumulated-body). Label-only updates leave the body untouched." ;; block — fall back to delete-and-regenerate so the ;; indicator transitions from placeholder to triangle ;; and the labels↔body separator is inserted. Labels - ;; are recovered from the buffer (no cache). + ;; are recovered from the buffer (no cache). The block + ;; extent is re-derived from the buffer here because + ;; `surgical-replace-label' may have changed label + ;; length, leaving the original `prop-match-end' stale. (t - (let* ((existing-labels + (let* ((current-block-range + (agent-shell-ui--block-range :position block-start)) + (current-block-end + (or (map-elt current-block-range :end) + (prop-match-end match))) + (existing-labels (agent-shell-ui--read-fragment-labels - (prop-match-beginning match) block-end)) + block-start current-block-end)) (final-model (list (cons :namespace-id namespace-id) (cons :block-id (map-elt model :block-id)) @@ -146,7 +153,7 @@ O(accumulated-body). Label-only updates leave the body untouched." (or new-label-right (map-elt existing-labels :label-right))) (cons :body new-body)))) - (delete-region block-start block-end) + (delete-region block-start current-block-end) (goto-char block-start) (agent-shell-ui--insert-fragment final-model qualified-id (not collapsed) navigation))))) From 7c8f75e5a901993e2499f7213e1bba81b225c89b Mon Sep 17 00:00:00 2001 From: xenodium <8107219+xenodium@users.noreply.github.com> Date: Wed, 20 May 2026 00:21:35 +0100 Subject: [PATCH 04/16] Fixing inline markup rendering regression --- agent-shell.el | 44 ++++++++++++++++++++++++-------------------- 1 file changed, 24 insertions(+), 20 deletions(-) diff --git a/agent-shell.el b/agent-shell.el index 4c8dc6a3..88ffd18f 100644 --- a/agent-shell.el +++ b/agent-shell.el @@ -3109,26 +3109,30 @@ by default, RENDER-BODY-IMAGES to enable inline image rendering in body." ;; Marking as field to avoid false positives in ;; `agent-shell-next-item' and `agent-shell-previous-item'. (add-text-properties (or padding-start block-start) - (or padding-end block-end) '(field output))) - ;; Apply markdown overlay to body. - (when-let ((body-start (map-nested-elt range '(:body :start))) - (body-end (map-nested-elt range '(:body :end)))) - (narrow-to-region body-start body-end) - (let ((markdown-overlays-highlight-blocks agent-shell-highlight-blocks)) - (agent-shell--render-markdown)) - (widen)) - ;; - ;; Note: For now, we're skipping applying markdown overlays - ;; on left labels as they currently carry propertized text - ;; for statuses (ie. boxed). - ;; - ;; Apply markdown overlay to right label. - (when-let ((label-right-start (map-nested-elt range '(:label-right :start))) - (label-right-end (map-nested-elt range '(:label-right :end)))) - (narrow-to-region label-right-start label-right-end) - (let ((markdown-overlays-highlight-blocks agent-shell-highlight-blocks)) - (agent-shell--render-markdown)) - (widen))) + (or padding-end block-end) '(field output)) + ;; Apply markdown overlay to body. `inhibit-read-only' + ;; must wrap the render call too — chars in the body + ;; carry `read-only t' from `agent-shell-ui--insert-fragment', + ;; and `markdown-text' modifies buffer chars (unlike the + ;; overlay renderer which only adds overlays). + (when-let ((body-start (map-nested-elt range '(:body :start))) + (body-end (map-nested-elt range '(:body :end)))) + (narrow-to-region body-start body-end) + (let ((markdown-overlays-highlight-blocks agent-shell-highlight-blocks)) + (agent-shell--render-markdown)) + (widen)) + ;; + ;; Note: For now, we're skipping applying markdown overlays + ;; on left labels as they currently carry propertized text + ;; for statuses (ie. boxed). + ;; + ;; Apply markdown overlay to right label. + (when-let ((label-right-start (map-nested-elt range '(:label-right :start))) + (label-right-end (map-nested-elt range '(:label-right :end)))) + (narrow-to-region label-right-start label-right-end) + (let ((markdown-overlays-highlight-blocks agent-shell-highlight-blocks)) + (agent-shell--render-markdown)) + (widen)))) (run-hook-with-args 'agent-shell-section-functions range))) (unless auto-scroll (goto-char saved-point) From 079df835ec1f3f88e75f17fcca4354714d90b9c3 Mon Sep 17 00:00:00 2001 From: xenodium <8107219+xenodium@users.noreply.github.com> Date: Wed, 20 May 2026 00:37:33 +0100 Subject: [PATCH 05/16] Bundle experimental markdown renderer --- agent-shell-markdown.el | 1707 +++++++++++++++++++++++++++ agent-shell-ui.el | 4 +- agent-shell.el | 25 +- tests/agent-shell-markdown-tests.el | 775 ++++++++++++ 4 files changed, 2495 insertions(+), 16 deletions(-) create mode 100644 agent-shell-markdown.el create mode 100644 tests/agent-shell-markdown-tests.el diff --git a/agent-shell-markdown.el b/agent-shell-markdown.el new file mode 100644 index 00000000..fbee660a --- /dev/null +++ b/agent-shell-markdown.el @@ -0,0 +1,1707 @@ +;;; agent-shell-markdown.el --- Replace Markdown markup with propertized text -*- lexical-binding: t -*- + +;; Copyright (C) 2026 Alvaro Ramirez + +;; Author: Alvaro Ramirez https://xenodium.com +;; URL: https://github.com/xenodium/agent-shell + +;; This package is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; This package is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: +;; +;; Convert a Markdown string into propertized text: +;; +;; (agent-shell-markdown-convert "hello **world**") +;; +;; Or rewrite the current buffer in place: +;; +;; (agent-shell-markdown-replace-markup) +;; +;; Both remove the markup characters and leave behind face text +;; properties. Supported markup: +;; +;; bold `**X**' / `__X__' face `agent-shell-markdown-bold' +;; italic `*X*' / `_X_' face `agent-shell-markdown-italic' +;; strike `~~X~~' face `agent-shell-markdown-strikethrough' +;; header `# X' .. `###### X' face `agent-shell-markdown-header-1' .. `-6' +;; inline code `` `X` `` face `agent-shell-markdown-inline-code' +;; link `[title](url)' face `agent-shell-markdown-link', keymap opens URL +;; image `![alt](url)' `display' property carries image +;; image path bare image path on a line same as `![alt](url)' (no markup) +;; divider `---' / `***' / `___' rendered as an underlined rule line +;; fenced code ```LANG\nX\n``` body syntax-highlighted via LANG mode +;; tables `| A | B |' grid rows rendered with aligned columns, +;; unicode borders, header/zebra rows +;; and wrap-to-window-width support +;; +;; All agent-shell-markdown-* faces inherit from the conventional faces +;; (`bold', `italic', `org-level-N', etc.) so default rendering is +;; unchanged, while still letting users customize markdown output +;; without disturbing the source faces elsewhere. +;; +;; Open / streaming fenced blocks (no closing fence yet) are +;; left alone so their contents stay protected as the buffer +;; grows. + +;;; Code: + +(eval-when-compile + (require 'cl-lib)) +(require 'map) +(require 'seq) +(require 'org-faces) +(require 'url-parse) +(require 'url-util) + +(defgroup agent-shell-markdown nil + "Render Markdown text into propertized form." + :group 'text) + +(defface agent-shell-markdown-bold + '((t :inherit bold)) + "Face for bold text rendered by `agent-shell-markdown-convert'." + :group 'agent-shell-markdown) + +(defface agent-shell-markdown-italic + '((t :inherit italic)) + "Face for italic text rendered by `agent-shell-markdown-convert'." + :group 'agent-shell-markdown) + +(defface agent-shell-markdown-strikethrough + '((t :strike-through t)) + "Face for strikethrough text rendered by `agent-shell-markdown-convert'." + :group 'agent-shell-markdown) + +(defface agent-shell-markdown-inline-code + '((t :inherit font-lock-doc-markup-face)) + "Face for inline code rendered by `agent-shell-markdown-convert'." + :group 'agent-shell-markdown) + +(defface agent-shell-markdown-link + '((t :inherit link)) + "Face for link titles rendered by `agent-shell-markdown-convert'." + :group 'agent-shell-markdown) + +(defface agent-shell-markdown-header-1 + '((t :inherit org-level-1)) + "Face for level-1 headers rendered by `agent-shell-markdown-convert'." + :group 'agent-shell-markdown) + +(defface agent-shell-markdown-header-2 + '((t :inherit org-level-2)) + "Face for level-2 headers rendered by `agent-shell-markdown-convert'." + :group 'agent-shell-markdown) + +(defface agent-shell-markdown-header-3 + '((t :inherit org-level-3)) + "Face for level-3 headers rendered by `agent-shell-markdown-convert'." + :group 'agent-shell-markdown) + +(defface agent-shell-markdown-header-4 + '((t :inherit org-level-4)) + "Face for level-4 headers rendered by `agent-shell-markdown-convert'." + :group 'agent-shell-markdown) + +(defface agent-shell-markdown-header-5 + '((t :inherit org-level-5)) + "Face for level-5 headers rendered by `agent-shell-markdown-convert'." + :group 'agent-shell-markdown) + +(defface agent-shell-markdown-header-6 + '((t :inherit org-level-6)) + "Face for level-6 headers rendered by `agent-shell-markdown-convert'." + :group 'agent-shell-markdown) + +(defface agent-shell-markdown-table-header + '((t :inherit bold)) + "Face for table header row content." + :group 'agent-shell-markdown) + +(defface agent-shell-markdown-table-border + '((t :inherit font-lock-comment-face)) + "Face for table borders (pipes and dashes)." + :group 'agent-shell-markdown) + +(defface agent-shell-markdown-table-zebra + '((t :inherit lazy-highlight)) + "Face for alternating (zebra) data rows in tables." + :group 'agent-shell-markdown) + +(defvar agent-shell-markdown-image-max-width 0.4 + "Maximum width for inline images rendered from `![alt](url)'. +An integer is taken as pixels. A float between 0 and 1 is a +ratio of the window body width.") + +(defvar agent-shell-markdown-prettify-tables t + "When non-nil, render markdown tables with aligned columns.") + +(defvar agent-shell-markdown-table-use-unicode-borders t + "When non-nil, use Unicode box-drawing chars (│ ─ ┼ ├ ┤) for borders. +When nil, fall back to ASCII pipes and dashes.") + +(defvar agent-shell-markdown-table-wrap-columns t + "When non-nil, wrap table columns to fit within window width.") + +(defvar agent-shell-markdown-table-max-width-fraction 0.9 + "Fraction of window width to use as max table width when wrapping.") + +(defvar agent-shell-markdown-table-zebra-stripe t + "When non-nil, alternate row backgrounds in tables for readability.") + +(defvar agent-shell-markdown-language-mapping + '(("elisp" . "emacs-lisp") + ("objective-c" . "objc") + ("objectivec" . "objc") + ("cpp" . "c++")) + "Map of fenced-block language aliases to Emacs major mode prefixes. +Keys are lower-case language names as written after the opening +backticks; values are the corresponding Emacs mode prefix (the +`-mode' suffix is appended internally). Example: + + (\"elisp\" . \"emacs-lisp\") ; ```elisp -> emacs-lisp-mode") + +(cl-defun agent-shell-markdown-convert (markdown) + "Convert MARKDOWN string into propertized text. + +Bold, italic, strikethrough, headers, and inline code are +rendered as text properties on the inner text; the markup +characters are removed. See `agent-shell-markdown-replace-markup' for +the in-buffer equivalent. + +For example: + + (agent-shell-markdown-convert \"_my_ **text**\") + => #(\"my text\" 0 2 (face italic) 3 7 (face bold))" + (with-temp-buffer + (insert markdown) + (agent-shell-markdown-replace-markup) + (buffer-string))) + +(cl-defun agent-shell-markdown-replace-markup () + "Replace Markdown markup in current buffer with propertized text. + +Rewrites the buffer in place: markup characters are removed and +the remaining text carries face properties. Faces compose, so a +span nested inside another type ends up with all applicable +faces. + +Markup inside fenced code blocks and inline code spans is left +alone. Streaming-friendly: an unclosed fence protects the rest +of the buffer, an unclosed inline backtick protects the rest of +its line, and incomplete bold/italic/strike spans are skipped +until their closing delimiter arrives. + +Italic, bold, and strike passes loop until a full round makes no +changes, so adjacent delimiters peel one layer per round +(e.g. `**_X_**' resolves in two rounds). Headers, inline code, +links, images, bare image-path lines, dividers, source-block +styling, and table styling run once after the loop." + (save-excursion + (let* ((source-ranges (agent-shell-markdown--make-markers + (agent-shell-markdown--source-block-ranges))) + (rendered-ranges (agent-shell-markdown--make-markers + (agent-shell-markdown--frozen-ranges))) + (inline-ranges (agent-shell-markdown--make-markers + (agent-shell-markdown--inline-code-ranges + :avoid-ranges (append source-ranges rendered-ranges)))) + (avoid-ranges (append source-ranges rendered-ranges inline-ranges))) + (while (let ((italic-changed (agent-shell-markdown--replace-italics + :avoid-ranges avoid-ranges)) + (bold-changed (agent-shell-markdown--replace-bolds + :avoid-ranges avoid-ranges)) + (strike-changed (agent-shell-markdown--replace-strikethroughs + :avoid-ranges avoid-ranges))) + (or italic-changed bold-changed strike-changed))) + (agent-shell-markdown--replace-headers :avoid-ranges avoid-ranges) + (agent-shell-markdown--style-inline-code :avoid-ranges source-ranges) + (agent-shell-markdown--replace-links :avoid-ranges avoid-ranges) + (agent-shell-markdown--replace-images :avoid-ranges avoid-ranges) + (agent-shell-markdown--replace-image-file-paths :avoid-ranges avoid-ranges) + (agent-shell-markdown--style-dividers :avoid-ranges avoid-ranges) + (agent-shell-markdown--style-source-blocks) + ;; Tables run last so cell content has already been processed by + ;; every other pass (bold, italic, links, inline code, etc.). + ;; The cell parser respects face and `agent-shell-markdown-frozen' so it + ;; doesn't mis-split on pipes that got swallowed by other markup. + ;; AVOID-RANGES protects content inside still-open fenced blocks + ;; (where the closing fence hasn't streamed in yet) — without it + ;; a table inside a code block would render eagerly and the + ;; fences would then strip out, leaving a rendered table. + (agent-shell-markdown--style-tables :avoid-ranges source-ranges) + ;; Mirror every `face' we composed onto `font-lock-face' so our + ;; styling survives `font-lock-mode' re-fontification — comint + ;; / shell-maker / agent-shell buffers fontify on every output + ;; chunk and would otherwise clear our `face' properties. + (agent-shell-markdown--mirror-face-to-font-lock-face (point-min) + (point-max))))) + +(cl-defun agent-shell-markdown--replace-bolds (&key avoid-ranges) + "Replace `**X**' / `__X__' spans in current buffer with bold X. + +Markup characters are deleted; remaining inner text carries face +`agent-shell-markdown-bold' layered on top of any existing face +properties. Spans that fall inside any of AVOID-RANGES are left +untouched. Returns non-nil if at least one replacement was made. + +For example, the buffer \"hello **world**.\" becomes \"hello +world.\" with face `agent-shell-markdown-bold' on \"world\"." + (let ((case-fold-search nil) + (changed nil)) + (goto-char (point-min)) + (while (re-search-forward + (rx (or line-start (syntax whitespace)) + (group + (or (seq "**" (group (one-or-more (not (any "\n*")))) "**") + (seq "__" (group (one-or-more (not (any "\n_")))) "__"))) + (or (syntax punctuation) (syntax whitespace) line-end)) + nil t) + (let ((markup-start (match-beginning 1)) + (markup-end (match-end 1)) + (text (buffer-substring (or (match-beginning 2) (match-beginning 3)) + (or (match-end 2) (match-end 3))))) + (unless (agent-shell-markdown--in-avoid-range-p markup-start markup-end avoid-ranges) + (delete-region markup-start markup-end) + (goto-char markup-start) + (insert text) + (add-face-text-property markup-start + (+ markup-start (length text)) + 'agent-shell-markdown-bold) + (setq changed t)))) + changed)) + +(cl-defun agent-shell-markdown--replace-italics (&key avoid-ranges) + "Replace `*X*' / `_X_' spans in current buffer with italic X. + +Markup characters are deleted; remaining inner text carries face +`agent-shell-markdown-italic' layered on top of any existing face +properties. Spans that fall inside any of AVOID-RANGES are left +untouched. Returns non-nil if at least one replacement was made. + +For example, the buffer \"hello *world*.\" becomes \"hello +world.\" with face `agent-shell-markdown-italic' on \"world\"." + (let ((case-fold-search nil) + (changed nil)) + (goto-char (point-min)) + (while (re-search-forward + (rx (or (group (or bol (one-or-more (any "\n \t"))) + (group "*") + (group (one-or-more (not (any "\n*")))) "*") + (group (or bol (one-or-more (any "\n \t"))) + (group "_") + (group (one-or-more (not (any "\n_")))) "_"))) + nil t) + (let ((markup-start (or (match-beginning 2) (match-beginning 5))) + (markup-end (match-end 0)) + (text (buffer-substring (or (match-beginning 3) (match-beginning 6)) + (or (match-end 3) (match-end 6))))) + (unless (agent-shell-markdown--in-avoid-range-p markup-start markup-end avoid-ranges) + (delete-region markup-start markup-end) + (goto-char markup-start) + (insert text) + (add-face-text-property markup-start + (+ markup-start (length text)) + 'agent-shell-markdown-italic) + (setq changed t)))) + changed)) + +(cl-defun agent-shell-markdown--replace-strikethroughs (&key avoid-ranges) + "Replace `~~X~~' spans in current buffer with strike-through-faced X. + +Markup characters are deleted; remaining inner text carries face +`agent-shell-markdown-strikethrough' layered on top of any existing face +properties. Spans inside any of AVOID-RANGES are left untouched. +Returns non-nil if at least one replacement was made. + +For example, the buffer \"a ~~b~~ c\" becomes \"a b c\" with face +`agent-shell-markdown-strikethrough' on \"b\"." + (let ((case-fold-search nil) + (changed nil)) + (goto-char (point-min)) + (while (re-search-forward + (rx "~~" (group (one-or-more (not (any "\n~")))) "~~") + nil t) + (let ((markup-start (match-beginning 0)) + (markup-end (match-end 0)) + (text (buffer-substring (match-beginning 1) (match-end 1)))) + (unless (agent-shell-markdown--in-avoid-range-p markup-start markup-end avoid-ranges) + (delete-region markup-start markup-end) + (goto-char markup-start) + (insert text) + (add-face-text-property markup-start + (+ markup-start (length text)) + 'agent-shell-markdown-strikethrough) + (setq changed t)))) + changed)) + +(cl-defun agent-shell-markdown--replace-headers (&key avoid-ranges) + "Replace `# X' / `## X' / ... headers with X faced as `org-level-N'. + +The `#' prefix and one or more separator spaces are stripped; the +title text is left with face `agent-shell-markdown-header-N' where N is +the number of `#' characters clamped to 1..6. Headers inside any +of AVOID-RANGES are left untouched. + +For example, the buffer \"## My title\" becomes \"My title\" with +face `agent-shell-markdown-header-2'." + (let ((case-fold-search nil)) + (goto-char (point-min)) + (while (re-search-forward + (rx bol (zero-or-more blank) (group (one-or-more "#")) + (one-or-more blank) + (group (one-or-more (not (any "\n")))) eol) + nil t) + (let ((markup-start (match-beginning 0)) + (markup-end (match-end 0)) + (level (- (match-end 1) (match-beginning 1))) + (text (buffer-substring (match-beginning 2) (match-end 2)))) + (unless (agent-shell-markdown--in-avoid-range-p markup-start markup-end avoid-ranges) + (delete-region markup-start markup-end) + (goto-char markup-start) + (insert text) + (add-face-text-property markup-start + (+ markup-start (length text)) + (intern (format "agent-shell-markdown-header-%d" + (min (max level 1) 6))))))))) + +(cl-defun agent-shell-markdown--style-inline-code (&key avoid-ranges) + "Strip backticks from complete inline `X` spans and face the body. + +The body of each well-formed `` `X` `` is left in place with +face `agent-shell-markdown-inline-code' and tagged with the text +property `agent-shell-markdown-frozen t' so it is never re-processed +on subsequent calls (the body can legitimately contain +markdown-looking chars like `**' once the surrounding backticks +are gone). Spans inside any of AVOID-RANGES (typically fenced +code blocks) are left untouched. + +For example, the buffer \"a `code` b\" becomes \"a code b\" with +face `agent-shell-markdown-inline-code' on \"code\"." + (let ((case-fold-search nil)) + (goto-char (point-min)) + (while (re-search-forward "`\\([^`\n]+\\)`" nil t) + (let ((markup-start (match-beginning 0)) + (markup-end (match-end 0)) + (text (buffer-substring (match-beginning 1) (match-end 1)))) + (unless (agent-shell-markdown--in-avoid-range-p markup-start markup-end avoid-ranges) + (delete-region markup-start markup-end) + (goto-char markup-start) + (insert text) + (let ((end (+ markup-start (length text)))) + (add-face-text-property markup-start end 'agent-shell-markdown-inline-code) + (add-text-properties markup-start end + '(agent-shell-markdown-frozen t + rear-nonsticky (agent-shell-markdown-frozen))))))))) + +(cl-defun agent-shell-markdown--replace-links (&key avoid-ranges) + "Replace `[title](url)' markup with title faced as link. + +The bracket/parenthesis markup is stripped; the title is left +with face `agent-shell-markdown-link' and a keymap text property that +opens the URL on RET or mouse-1. Matches preceded by `!' (the +image syntax) are skipped, as are links inside any of +AVOID-RANGES. + +For example, the buffer \"see [docs](https://example.com)\" +becomes \"see docs\" with face `agent-shell-markdown-link' on \"docs\" +and a keymap that opens the URL." + (let ((case-fold-search nil)) + (goto-char (point-min)) + (while (re-search-forward + (rx "[" + (group (one-or-more (not (any "]")))) + "]" + "(" + (group (one-or-more (not (any ")")))) + ")") + nil t) + (let ((markup-start (match-beginning 0)) + (markup-end (match-end 0)) + (title (buffer-substring (match-beginning 1) (match-end 1))) + (url (buffer-substring-no-properties (match-beginning 2) (match-end 2)))) + (unless (or (eq (char-before markup-start) ?!) + (agent-shell-markdown--in-avoid-range-p markup-start markup-end avoid-ranges)) + (delete-region markup-start markup-end) + (goto-char markup-start) + (insert title) + (let ((end (+ markup-start (length title)))) + (add-face-text-property markup-start end 'agent-shell-markdown-link) + (put-text-property markup-start end 'keymap + (agent-shell-markdown--make-ret-binding-map + (lambda () (interactive) + (agent-shell-markdown--open-link url)))) + (put-text-property markup-start end 'mouse-face 'highlight))))))) + +(cl-defun agent-shell-markdown--replace-images (&key avoid-ranges) + "Replace `![alt](url)' image markup with displayed images. + +If URL resolves to an existing local file that is image-supported +and a graphical display is available, the full markup is replaced +by the alt text (or a single space if alt is empty) carrying a +`display' property with the image and a keymap that opens the +file on RET or mouse-1. Otherwise the markup is left untouched. +Images inside any of AVOID-RANGES are left alone. + +For example, the buffer \"see ![logo](logo.png)\" becomes +\"see logo\" with the image shown in place of \"logo\"." + (let ((case-fold-search nil)) + (goto-char (point-min)) + (while (re-search-forward + (rx "!" + "[" + (group (zero-or-more (not (any "]")))) + "]" + "(" + (group (one-or-more (not (any ")")))) + ")") + nil t) + (let* ((markup-start (match-beginning 0)) + (markup-end (match-end 0)) + (alt (buffer-substring-no-properties (match-beginning 1) (match-end 1))) + (url (buffer-substring-no-properties (match-beginning 2) (match-end 2))) + (path (agent-shell-markdown--resolve-image-url url))) + (when (and path + (image-supported-file-p path) + (display-graphic-p) + (not (agent-shell-markdown--in-avoid-range-p + markup-start markup-end avoid-ranges))) + (let ((image (create-image path nil nil + :max-width (agent-shell-markdown--image-max-width))) + (placeholder (if (string-empty-p alt) " " alt))) + (image-flush image) + (delete-region markup-start markup-end) + (goto-char markup-start) + (insert placeholder) + (let ((end (+ markup-start (length placeholder)))) + (put-text-property markup-start end 'display image) + (put-text-property markup-start end 'keymap + (agent-shell-markdown--make-ret-binding-map + (lambda () (interactive) + (find-file path)))) + (put-text-property markup-start end 'mouse-face 'highlight)))))))) + +(cl-defun agent-shell-markdown--replace-image-file-paths (&key avoid-ranges) + "Render bare image-path lines as displayed images. + +A line that is solely a local path or `file://' URI ending in a +supported image extension is treated like an `![alt](url)' image: +when the path resolves to an existing image-supported file and a +graphical display is available, the line text is left in place +carrying a `display' property with the image and a keymap that +opens the file. Lines inside any of AVOID-RANGES are left +untouched, as are unresolvable paths. + +For example, a buffer line containing just `/abs/path/img.png' +renders the image in place of that text." + (let* ((case-fold-search t) + (ext-re (regexp-opt image-file-name-extensions)) + (regex (concat "^[ \t]*\\(\\(?:file://\\|[/~.]\\)[^ \t\n]*\\." + ext-re + "\\)[ \t]*$"))) + (goto-char (point-min)) + (while (re-search-forward regex nil t) + (let* ((line-start (match-beginning 0)) + (line-end (match-end 0)) + (path-start (match-beginning 1)) + (path-end (match-end 1)) + (raw (buffer-substring-no-properties path-start path-end)) + (resolved (agent-shell-markdown--resolve-image-url raw))) + (when (and resolved + (image-supported-file-p resolved) + (display-graphic-p) + (not (agent-shell-markdown--in-avoid-range-p + line-start line-end avoid-ranges))) + (let ((image (create-image resolved nil nil + :max-width (agent-shell-markdown--image-max-width)))) + (image-flush image) + (put-text-property path-start path-end 'display image) + (put-text-property path-start path-end 'keymap + (agent-shell-markdown--make-ret-binding-map + (lambda () (interactive) + (find-file resolved)))) + (put-text-property path-start path-end 'mouse-face 'highlight) + (add-text-properties path-start path-end + '(agent-shell-markdown-frozen t + rear-nonsticky (agent-shell-markdown-frozen))))))))) + +(cl-defun agent-shell-markdown--style-dividers (&key avoid-ranges) + "Render `---' / `***' / `___' horizontal-rule lines as styled rules. + +Each line consisting of 3+ matching dash/star/underscore chars +(optionally surrounded by spaces or tabs) gets a `display' text +property that draws an underlined rule across the window, plus a +`agent-shell-markdown-frozen' tag so subsequent calls don't re-process +it. Dividers inside any of AVOID-RANGES are left untouched. + +The chars themselves remain in the buffer beneath the display +property, so the source markdown round-trips through copy/save." + (let ((case-fold-search nil)) + (goto-char (point-min)) + (while (re-search-forward + (rx bol (zero-or-more blank) + (or (seq "***" (zero-or-more "*")) + (seq "---" (zero-or-more "-")) + (seq "___" (zero-or-more "_"))) + (zero-or-more blank) eol) + nil t) + (let ((rule-start (match-beginning 0)) + (rule-end (match-end 0))) + (unless (agent-shell-markdown--in-avoid-range-p rule-start rule-end avoid-ranges) + (add-text-properties + rule-start rule-end + (list 'display + (concat (propertize (make-string (agent-shell-markdown--display-width) ?\s) + 'face '(:underline t)) + "\n") + 'agent-shell-markdown-frozen t + 'rear-nonsticky '(display agent-shell-markdown-frozen)))))))) + +(defun agent-shell-markdown--display-width () + "Return a usable display width for divider rendering. +Tries the selected window's body width and falls back to 80 +characters when no usable window is available (e.g. batch)." + (or (ignore-errors (window-body-width)) + 80)) + +(defun agent-shell-markdown--style-source-blocks () + "Strip fenced code block markup and syntax-highlight the body. + +For each complete `\\`\\`\\`LANG' / `\\`\\`\\`' fenced block, +the opening and closing fence lines are deleted from the buffer. +The body text stays in place with face properties from LANG's +major mode (when loadable) and a `agent-shell-markdown-frozen t' text +property tagging it as rendered output. That tag is read back +as an avoid-range on subsequent calls, so the body is never +re-processed as inline markup even though its surrounding +fences are gone. + +Open / streaming fences (no closing line yet) are left alone. + +For example, the buffer: + + ```elisp + (message \"hi\") + ``` + +becomes: + + (message \"hi\") + +with `emacs-lisp-mode' face properties on the body and a +`agent-shell-markdown-frozen' tag covering those same chars." + (let ((case-fold-search nil)) + (goto-char (point-min)) + (while (re-search-forward + (rx (group bol (zero-or-more blank) "```" (zero-or-more blank) + (group (zero-or-more (or alphanumeric "-" "+" "#"))) + (zero-or-more blank) "\n") + (group (*? anychar)) + "\n" + (group bol (zero-or-more blank) "```" (zero-or-more blank) + (or "\n" eol))) + nil t) + (let* ((open-start (match-beginning 1)) + (open-end (match-end 1)) + (lang (buffer-substring-no-properties (match-beginning 2) + (match-end 2))) + (body-start (copy-marker (match-beginning 3))) + (body-end (copy-marker (match-end 3))) + (close-start (match-beginning 4)) + (close-end (match-end 4)) + (highlighted (agent-shell-markdown--highlight-code + (buffer-substring-no-properties body-start body-end) + lang))) + ;; Delete in reverse position order so earlier offsets stay + ;; valid; body markers adjust automatically. + (delete-region close-start close-end) + (delete-region open-start open-end) + (agent-shell-markdown--apply-faces-from highlighted + (marker-position body-start)) + (add-text-properties body-start body-end + '(agent-shell-markdown-frozen t + rear-nonsticky (agent-shell-markdown-frozen))))))) + +(defconst agent-shell-markdown--table-line-regexp + (rx line-start + (zero-or-more (any " \t")) + "|" + (one-or-more (not (any "\n"))) + "|" + (zero-or-more (any " \t")) + line-end) + "Regexp matching a single line of a markdown table.") + +(defconst agent-shell-markdown--table-separator-regexp + (rx line-start + (zero-or-more (any " \t")) + "|" + (one-or-more (or "-" ":" "|" " " "\t")) + "|" + (zero-or-more (any " \t")) + line-end) + "Regexp matching a table separator row (e.g. `|---|---|').") + +(cl-defun agent-shell-markdown--find-tables (&key avoid-ranges) + "Return tables to (re-)render in current buffer. + +Each element is an alist with keys :start, :end (the region to +replace), and :source (the markdown table source — a propertized +string — that should be rendered into that region). + +Two flavours of region are collected: + + - Pure ASCII tables: 2 or more consecutive `|...|' lines, not + in a frozen region. A `|---|...' separator row is optional + — when present it splits header from data; when absent all + rows are rendered as data. + + - Rendered table + extension: a previously-rendered table + carries its original source on each char via the + `agent-shell-markdown-table-source' property. Chars immediately + after the rendered region are folded back in: characters up + to the next `\\n' are continuation of the rendered table's + last source row (i.e. a chunk boundary that split a row mid- + cell), and any complete `|...|' lines that follow extend the + table with new rows. The combined source is stashed and the + region is re-rendered. + +A rendered table with no extension is skipped — re-rendering +unchanged source is a no-op." + ;; agent-shell tags its body chars with `field output' while the + ;; `\\n's between rows may not carry the same field value; without + ;; this binding, `forward-line' / `line-end-position' would stop at + ;; those field boundaries and silently truncate table rows. + (let ((inhibit-field-text-motion t) + (tables '()) + (pos (point-min))) + (save-excursion + (while (< pos (point-max)) + (goto-char pos) + (cond + ((get-text-property pos 'agent-shell-markdown-table-source) + (let* ((stashed (get-text-property pos 'agent-shell-markdown-table-source)) + (rendered-end (or (next-single-property-change + pos 'agent-shell-markdown-table-source + nil (point-max)) + (point-max))) + (trailing-end rendered-end)) + ;; Scan forward from rendered-end accumulating chars that + ;; extend the rendered table: first any continuation chars + ;; on the same physical line (a chunk boundary that split + ;; a row mid-cell), then complete table rows after the + ;; next `\n'. Both kinds end up in one substring that + ;; `concat'-ing onto STASHED yields valid markdown, + ;; because the trailing substring's own `\n's handle the + ;; row boundaries. + (save-excursion + (goto-char rendered-end) + (when (and (< (point) (point-max)) + (not (eq (char-after) ?\n))) + (end-of-line) + (setq trailing-end (point))) + (when (and (< (point) (point-max)) + (eq (char-after) ?\n)) + (forward-char 1) + (while (and (not (eobp)) + (looking-at agent-shell-markdown--table-line-regexp) + (not (get-text-property (point) + 'agent-shell-markdown-frozen)) + (not (agent-shell-markdown--in-avoid-range-p + (point) (line-end-position) avoid-ranges))) + (setq trailing-end (line-end-position)) + (forward-line 1)))) + (if (> trailing-end rendered-end) + (let ((combined (concat stashed + (buffer-substring rendered-end + trailing-end)))) + (push `((:start . ,pos) + (:end . ,trailing-end) + (:source . ,combined)) + tables) + (setq pos trailing-end)) + ;; Nothing to fold — re-rendering unchanged source would + ;; be a no-op, so skip past the rendered region. + (setq pos rendered-end)))) + ((and (looking-at agent-shell-markdown--table-line-regexp) + (not (get-text-property pos 'agent-shell-markdown-frozen)) + (not (agent-shell-markdown--in-avoid-range-p pos pos avoid-ranges))) + (let ((table-start pos) + (table-end nil) + (row-count 0)) + ;; Greedily consume rows that match the table regex. Mid- + ;; stream chunk boundaries that split a row are handled by + ;; the streaming-extension branch above, which folds + ;; continuation chars back into the rendered table's last + ;; row on the next render. AVOID-RANGES (e.g. an open + ;; fenced block whose closing fence hasn't streamed in + ;; yet) keeps the contained rows raw. + (while (and (not (eobp)) + (looking-at agent-shell-markdown--table-line-regexp) + (not (get-text-property (point) + 'agent-shell-markdown-frozen)) + (not (agent-shell-markdown--in-avoid-range-p + (point) (line-end-position) avoid-ranges))) + (setq table-end (line-end-position)) + (setq row-count (1+ row-count)) + (forward-line 1)) + ;; >=2 pipe rows is enough to render; a separator + ;; (`|---|...') is not required. When present it splits + ;; header from data (and styles the header). When absent + ;; all rows are data. + (when (>= row-count 2) + (push `((:start . ,table-start) + (:end . ,table-end) + (:source . ,(buffer-substring table-start table-end))) + tables)) + (setq pos (or table-end (1+ pos))))) + (t (setq pos (1+ pos)))))) + (nreverse tables))) + +(defun agent-shell-markdown--parse-table-row (start end) + "Parse table row from START to END into cells. + +Returns a list of alists with :start, :end, :content for each +cell, where :content carries any text properties applied by the +earlier passes (bold, italic, inline-code, link, etc.). + +A `|' is treated as a cell separator unless it (a) is preceded by +a `\\' escape, or (b) carries `agent-shell-markdown-frozen' — in which +case it lives inside a region one of our passes has already +rendered (e.g. inline-code body containing a literal `|') and +isn't a real delimiter. We deliberately don't check `face' so +that pipes faced by external font-lock (markdown-mode, etc.) +are still parsed as cell separators." + (let ((cells '())) + (save-excursion + (goto-char start) + (when (looking-at (rx (zero-or-more (any " \t")) "|")) + (goto-char (match-end 0))) + (let ((cell-start (point))) + (while (< (point) end) + (if (re-search-forward (rx (any "|\\")) end t) + (let ((ch (char-before)) + (pipe-pos (1- (point)))) + (cond + ((and (eq ch ?|) + (not (get-text-property pipe-pos + 'agent-shell-markdown-frozen))) + (let ((cell-end pipe-pos)) + (push `((:start . ,cell-start) + (:end . ,cell-end) + (:content . ,(string-trim + (buffer-substring + cell-start cell-end)))) + cells) + (setq cell-start (point)))) + ((eq ch ?\\) + (when (< (point) end) (forward-char 1))))) + (goto-char end))))) + (nreverse cells))) + +(defvar-local agent-shell-markdown--table-char-pixel-cache nil + "Cons cell (FONT-WIDTH . SPACE-PIXELS). +Caches the rendered pixel width of a single space in the buffer; +invalidated when the font width changes (e.g. text scaling). +Stored in the destination buffer (the one displayed in the +window passed to the measurement helpers), so cache lookups are +per-destination.") + +(defun agent-shell-markdown--table-measure-string (str window) + "Return real pixel width of STR rendered at point-max of WINDOW's buffer. + +Briefly inserts STR, measures with `window-text-pixel-size', and +deletes; `inhibit-modification-hooks' and the modified flag are +preserved so callers never observe the mutation." + (with-current-buffer (window-buffer window) + (let ((inhibit-read-only t) + (inhibit-modification-hooks t) + (modified (buffer-modified-p)) + real) + (save-excursion + (goto-char (point-max)) + (let ((m (point-marker))) + (set-marker-insertion-type m nil) + (insert str) + (setq real (car (window-text-pixel-size window m (point)))) + (delete-region m (point)) + (set-marker m nil))) + (set-buffer-modified-p modified) + real))) + +(defun agent-shell-markdown--table-char-pixel-width (window) + "Return real pixel width of a single space in WINDOW, cached. +Cache lives in the destination buffer and is invalidated when +its font width changes." + (with-current-buffer (window-buffer window) + (let ((fw (window-font-width window))) + (if (and agent-shell-markdown--table-char-pixel-cache + (= fw (car agent-shell-markdown--table-char-pixel-cache))) + (cdr agent-shell-markdown--table-char-pixel-cache) + (let ((sw (agent-shell-markdown--table-measure-string " " window))) + (setq agent-shell-markdown--table-char-pixel-cache (cons fw sw)) + sw))))) + +(defun agent-shell-markdown--table-needs-pixel-p (str) + "Return non-nil if STR contains chars that `string-width' miscounts. +Specifically: + - U+200D ZERO WIDTH JOINER, which combines surrounding emoji into + one rendered glyph (family / profession sequences). + - U+1F1E6 .. U+1F1FF REGIONAL INDICATOR SYMBOLs, which pair into + a single flag glyph. + +For these sequences `string-width' sums the codepoint widths but +the glyph renders narrower, so column sizing must fall back to +`window-text-pixel-size'. ASCII, CJK, and single-codepoint emoji +are correctly measured by `string-width' and skip the pixel path." + (let ((i 0) + (len (length str)) + (found nil)) + (while (and (not found) (< i len)) + (let ((c (aref str i))) + (when (or (= c #x200D) + (and (>= c #x1F1E6) (<= c #x1F1FF))) + (setq found t))) + (setq i (1+ i))) + found)) + +(cl-defun agent-shell-markdown--table-display-width (&key str window) + "Return display width of STR in character units. + +Uses `string-width' for the vast majority of content — ASCII, CJK, +and single-codepoint emoji are all measured correctly by it. +Falls back to `window-text-pixel-size' only for sequences that +`string-width' miscounts (ZWJ compound emoji, regional-indicator +flag pairs); see `agent-shell-markdown--table-needs-pixel-p'." + (if (and window + (window-live-p window) + (fboundp 'window-text-pixel-size) + (display-graphic-p) + (agent-shell-markdown--table-needs-pixel-p str)) + (condition-case nil + (let ((char-px (agent-shell-markdown--table-char-pixel-width window)) + (real-px (agent-shell-markdown--table-measure-string str window))) + (ceiling (/ (float real-px) char-px))) + (error (string-width str))) + (string-width str))) + +(cl-defun agent-shell-markdown--table-longest-word (&key str window) + "Return display width of longest word in STR. +Uses `agent-shell-markdown--table-display-width' so non-ASCII words +get accurate measurement when WINDOW is given." + (if (or (null str) (string-empty-p str)) + 0 + (let ((words (split-string str "[ \t\n]+" t))) + (if words + (apply #'max + (mapcar (lambda (w) + (agent-shell-markdown--table-display-width + :str w :window window)) + words)) + 0)))) + +(defun agent-shell-markdown--table-total-width (widths) + "Return total rendered width for a table with column WIDTHS. +Accounts for borders and padding (`| X | Y |' = 2 padding + +1 pipe per column, plus one leading pipe)." + (+ 1 (seq-reduce (lambda (acc w) (+ acc w 3)) widths 0))) + +(defun agent-shell-markdown--table-allocate-widths (natural-widths min-widths target) + "Shrink NATURAL-WIDTHS proportionally to fit TARGET, respecting MIN-WIDTHS." + (let* ((total (agent-shell-markdown--table-total-width natural-widths)) + (excess (- total target))) + (if (<= excess 0) + natural-widths + (let* ((shrinkable (seq-mapn (lambda (w m) (max 0 (- w m))) + natural-widths min-widths)) + (total-shrinkable (seq-reduce #'+ shrinkable 0))) + (if (<= total-shrinkable 0) + min-widths + (let ((ratio (min 1.0 (/ (float excess) total-shrinkable)))) + (seq-mapn (lambda (w m s) + (max m (floor (- w (* s ratio))))) + natural-widths min-widths shrinkable))))))) + +(defun agent-shell-markdown--table-wrap-text (text width) + "Wrap TEXT to fit within WIDTH, returning a list of lines. +Preserves text properties across wrapped lines." + (cond + ((or (null text) (string-empty-p text)) (list "")) + ((<= (string-width text) width) (list text)) + (t + (let ((lines '()) + (pos 0) + (len (length text))) + (while (< pos len) + ;; Greedily consume chars until adding the next one would + ;; exceed WIDTH. + (let ((end-pos pos) + (line-width 0)) + (while (and (< end-pos len) + (<= (+ line-width (char-width (aref text end-pos))) + width)) + (setq line-width (+ line-width (char-width (aref text end-pos)))) + (setq end-pos (1+ end-pos))) + ;; Make sure at least one char advances even when the very + ;; first char already exceeds WIDTH (e.g. wide glyph). + (when (= end-pos pos) + (setq end-pos (1+ pos))) + ;; Try to break at the last whitespace within [pos, end-pos). + (let ((break-pos end-pos)) + (when (< end-pos len) + (let ((scan (1- end-pos))) + (while (and (> scan pos) + (not (memq (aref text scan) '(?\s ?\t)))) + (setq scan (1- scan))) + (when (> scan pos) + (setq break-pos (1+ scan))))) + (push (string-trim-right (substring text pos break-pos)) lines) + (setq pos break-pos) + (while (and (< pos len) + (memq (aref text pos) '(?\s ?\t))) + (setq pos (1+ pos)))))) + (nreverse lines))))) + +(cl-defun agent-shell-markdown--pad-table-string (&key str width window) + "Pad STR with spaces to reach WIDTH columns. + +`string-width' is reliable for ASCII, CJK, and single-codepoint +emoji, so the cheap padding path is taken for almost all content. +The pixel-accurate `display'-space path runs only for strings +flagged by `agent-shell-markdown--table-needs-pixel-p' (ZWJ compound +emoji, regional-indicator flag pairs) where `string-width' would +otherwise miscount and the column right-border would drift." + (if (and window + (window-live-p window) + (fboundp 'window-text-pixel-size) + (display-graphic-p) + (agent-shell-markdown--table-needs-pixel-p str)) + (condition-case nil + (let* ((char-px (agent-shell-markdown--table-char-pixel-width window)) + (target-px (* width char-px)) + (content-px (agent-shell-markdown--table-measure-string str window)) + (pad-px (- target-px content-px))) + (if (<= pad-px 0) + str + (let* ((full-spaces (floor (/ (float pad-px) char-px))) + (remaining-px (- pad-px (* full-spaces char-px)))) + (concat str + (make-string full-spaces ?\s) + (if (> remaining-px 0) + (propertize " " 'display + `(space :width (,remaining-px))) + ""))))) + (error (agent-shell-markdown--pad-table-string-ascii :str str :width width))) + (agent-shell-markdown--pad-table-string-ascii :str str :width width))) + +(cl-defun agent-shell-markdown--pad-table-string-ascii (&key str width) + "ASCII / fallback padding: append plain spaces to reach WIDTH columns." + (let ((current (string-width str))) + (if (>= current width) + str + (concat str (make-string (- width current) ?\s))))) + +(defun agent-shell-markdown--make-table-separator-cell (width) + "Return a separator-cell string of WIDTH dashes." + (make-string width + (if agent-shell-markdown-table-use-unicode-borders ?─ ?-))) + +(defun agent-shell-markdown--render-table-separator-row (col-widths) + "Build the rendered separator line for COL-WIDTHS." + (let ((pipe (if agent-shell-markdown-table-use-unicode-borders "┼" "|")) + (left (if agent-shell-markdown-table-use-unicode-borders "├" "|")) + (right (if agent-shell-markdown-table-use-unicode-borders "┤" "|"))) + (concat + (propertize left 'face 'agent-shell-markdown-table-border) + (mapconcat + (lambda (w) + (propertize (agent-shell-markdown--make-table-separator-cell (+ w 2)) + 'face 'agent-shell-markdown-table-border)) + col-widths + (propertize pipe 'face 'agent-shell-markdown-table-border)) + (propertize right 'face 'agent-shell-markdown-table-border)))) + +(cl-defun agent-shell-markdown--render-table-data-row (&key processed-cells col-widths row-face window) + "Build the rendered string for a data row, possibly multi-line. + +PROCESSED-CELLS is the list of propertized cell strings. +COL-WIDTHS is the list of column widths. ROW-FACE, when non-nil, +is layered on top of the row content (preserving inline faces). +WINDOW, when given, is forwarded to `agent-shell-markdown--pad-table-string' +for pixel-accurate padding of non-ASCII content. + +Each cell on the first physical line of a wrapped row carries +`agent-shell-markdown-table-cell-start' on its leading padding char so +`agent-shell-markdown-table-next-cell' / `-previous-cell' can navigate +logical rows (skipping the visual continuation lines)." + (let* ((pipe (if agent-shell-markdown-table-use-unicode-borders "│" "|")) + (styled-pipe (propertize pipe 'face 'agent-shell-markdown-table-border)) + (wrapped (seq-mapn + (lambda (cell width) + (agent-shell-markdown--table-wrap-text cell width)) + processed-cells col-widths)) + (max-lines (apply #'max 1 (mapcar #'length wrapped))) + (lines '())) + (dotimes (line-idx max-lines) + (let ((parts '())) + (seq-mapn + (lambda (cell-lines width) + (let* ((line (if (< line-idx (length cell-lines)) + (nth line-idx cell-lines) + "")) + (padded (concat " " + (agent-shell-markdown--pad-table-string + :str line :width width :window window) + " "))) + (when row-face + (add-face-text-property 0 (length padded) row-face t padded)) + ;; Mark first physical line of each cell as navigable — + ;; continuation lines of a wrapped row aren't standalone + ;; cells. Tag the first content char (index 1, past the + ;; leading padding space) so navigation lands cursor on + ;; the content rather than the border-adjacent space. + (when (and (zerop line-idx) (> (length padded) 1)) + (put-text-property 1 2 'agent-shell-markdown-table-cell-start t padded)) + (push padded parts))) + wrapped col-widths) + (push (concat styled-pipe + (string-join (nreverse parts) styled-pipe) + styled-pipe) + lines))) + (mapconcat #'identity (nreverse lines) "\n"))) + +(cl-defun agent-shell-markdown--preprocess-table (&key rows window) + "Parse cells in ROWS and compute natural column widths. +Returns a plist with :natural-widths and :processed-rows. + +`:min-widths' (wrap-allocation widths from longest words) is no +longer computed here — it's only needed when the table has to be +allocated narrower than its natural total, and computing it for +every cell on every render is a substantial cost. Callers that +need it should use `agent-shell-markdown--table-min-widths'. + +When WINDOW is given, cell widths are measured with +pixel-accurate `agent-shell-markdown--table-display-width' so columns +containing emoji/CJK line up with the column's right border." + (let ((widths nil) + (processed-rows nil)) + (dolist (row rows) + (if (map-elt row :separator) + (push (cons row nil) processed-rows) + (let ((cells (agent-shell-markdown--parse-table-row + (map-elt row :start) (map-elt row :end))) + (col 0) + (processed-cells nil)) + (dolist (cell cells) + (let* ((processed (map-elt cell :content)) + (dw (agent-shell-markdown--table-display-width + :str processed :window window))) + (push processed processed-cells) + (if (nth col widths) + (setf (nth col widths) (max (nth col widths) dw)) + (setq widths (append widths (list dw)))) + (setq col (1+ col)))) + (push (cons row (nreverse processed-cells)) processed-rows)))) + (list :natural-widths widths + :processed-rows (nreverse processed-rows)))) + +(cl-defun agent-shell-markdown--table-min-widths (&key processed-rows window) + "Return the minimum (longest-word) widths per column. +Called only when a table needs to be allocated narrower than its +natural total — see `agent-shell-markdown--render-table-source'." + (let ((min-widths nil)) + (dolist (entry processed-rows) + (let ((cells (cdr entry)) + (col 0)) + (dolist (processed cells) + (let ((mw (agent-shell-markdown--table-longest-word + :str processed :window window))) + (if (nth col min-widths) + (setf (nth col min-widths) (max (nth col min-widths) mw)) + (setq min-widths (append min-widths (list mw)))) + (setq col (1+ col)))))) + min-widths)) + +(defun agent-shell-markdown--render-table (table) + "Render TABLE by replacing [:start, :end] with the rendered :source. + +The rendered chars carry: + - `agent-shell-markdown-frozen t' — so subsequent passes skip them. + - `agent-shell-markdown-table-source SOURCE' — the original markdown + source, stashed so a future `agent-shell-markdown-replace-markup' + call can combine it with freshly-streamed rows that arrive + right after, then re-render the whole table with updated + column widths. + +Caller-set text properties at the table's start position (e.g., +`read-only', application-specific tags like an agent-shell block +id) are also carried onto the rendered region — otherwise the +delete+insert would drop them and break callers that look up +regions by text property. + +`rear-nonsticky' prevents new chars inserted just after the +rendered region from inheriting either of our two properties." + (let* ((source (map-elt table :source)) + (table-start (map-elt table :start)) + (table-end (map-elt table :end)) + ;; Capture the destination window for pixel-accurate + ;; measurement of non-ASCII cells. This is the window into + ;; which we're rendering; the render-table-source helper + ;; forwards it through to width / padding measurement. + (window (or (get-buffer-window (current-buffer)) + (selected-window))) + (rendered (agent-shell-markdown--render-table-source + :source source :window window)) + (carried (agent-shell-markdown--carry-properties table-start))) + (delete-region table-start table-end) + (goto-char table-start) + (insert rendered) + (let ((end (+ table-start (length rendered)))) + (when carried + (add-text-properties table-start end carried)) + (add-text-properties + table-start end + `(agent-shell-markdown-frozen t + agent-shell-markdown-table-source ,source + rear-nonsticky (agent-shell-markdown-frozen + agent-shell-markdown-table-source)))))) + +(defun agent-shell-markdown--carry-properties (pos) + "Return a plist of properties at POS to carry across our delete+insert. + +Filters out properties our rendering itself sets (`face', +`agent-shell-markdown-frozen', `agent-shell-markdown-table-source', +`rear-nonsticky') so callers' application-level properties +(read-only, agent-shell block ids, etc.) survive on the rendered +output." + (let ((props (text-properties-at pos)) + (carried nil)) + (while props + (let ((key (car props)) + (val (cadr props))) + (unless (memq key '(face + agent-shell-markdown-frozen + agent-shell-markdown-table-source + rear-nonsticky)) + (setq carried (cons val (cons key carried)))) + (setq props (cddr props)))) + (nreverse carried))) + +(cl-defun agent-shell-markdown--render-table-source (&key source window) + "Render SOURCE (markdown table text) to a propertized string. + +SOURCE may carry text properties from earlier passes (bold faces +on cell content, `agent-shell-markdown-frozen' on inline-code bodies, +etc.); these are preserved through to the rendered output via +the cell parser. + +WINDOW, when given, is the destination window used for pixel- +accurate width measurement of non-ASCII cell content (emoji, +CJK) so right borders align across rows. Without it, +measurement falls back to `string-width' — fine for ASCII but +prone to a few-pixel drift on emoji-heavy tables." + (with-temp-buffer + (insert source) + ;; SOURCE inherits `field' text properties from the calling buffer + ;; (e.g. agent-shell tags chars with `field output'); inter-row + ;; `\\n's may carry different field values, which would otherwise + ;; cause `forward-line' / `line-end-position' in the parsers below + ;; to stop at field boundaries and silently drop rows. + (setq-local inhibit-field-text-motion t) + (let* ((rows (agent-shell-markdown--collect-table-rows)) + (separator-row-num (agent-shell-markdown--find-separator-row-num rows)) + (preprocessed (agent-shell-markdown--preprocess-table + :rows rows :window window)) + (natural-widths (plist-get preprocessed :natural-widths)) + (processed-rows (plist-get preprocessed :processed-rows)) + (target-width (when agent-shell-markdown-table-wrap-columns + (floor (* (agent-shell-markdown--display-width) + agent-shell-markdown-table-max-width-fraction)))) + (needs-allocation (and target-width + (> (agent-shell-markdown--table-total-width + natural-widths) + target-width))) + ;; `:min-widths' is expensive (longest-word per cell) and only + ;; consumed by allocation, which kicks in only when the + ;; natural total exceeds the target. Compute lazily. + (col-widths (if needs-allocation + (agent-shell-markdown--table-allocate-widths + natural-widths + (agent-shell-markdown--table-min-widths + :processed-rows processed-rows + :window window) + target-width) + natural-widths)) + (data-row-num 0) + (rendered-rows '())) + (dolist (entry processed-rows) + (let* ((row (car entry)) + (processed-cells (cdr entry)) + (row-num (map-elt row :num)) + (is-separator (map-elt row :separator)) + (is-header (and separator-row-num + (< row-num separator-row-num))) + (is-zebra (and agent-shell-markdown-table-zebra-stripe + (not is-header) + (not is-separator) + (= (mod data-row-num 2) 1))) + (row-face (cond + (is-header 'agent-shell-markdown-table-header) + (is-zebra 'agent-shell-markdown-table-zebra)))) + (unless (or is-header is-separator) + (setq data-row-num (1+ data-row-num))) + (push (if is-separator + (agent-shell-markdown--render-table-separator-row col-widths) + (agent-shell-markdown--render-table-data-row + :processed-cells processed-cells + :col-widths col-widths + :row-face row-face + :window window)) + rendered-rows))) + (string-join (nreverse rendered-rows) "\n")))) + +(defun agent-shell-markdown--collect-table-rows () + "Collect table rows in current buffer (typically a temp buffer). +Each row is an alist with :start, :end, :num, :separator." + (save-excursion + (goto-char (point-min)) + (let ((rows '()) + (row-num 0)) + (while (and (not (eobp)) + (looking-at agent-shell-markdown--table-line-regexp)) + (push `((:start . ,(point)) + (:end . ,(line-end-position)) + (:num . ,row-num) + (:separator . ,(looking-at + agent-shell-markdown--table-separator-regexp))) + rows) + (setq row-num (1+ row-num)) + (forward-line 1)) + (nreverse rows)))) + +(defun agent-shell-markdown--find-separator-row-num (rows) + "Return the index of the first separator row in ROWS, or nil." + (let ((idx 0) (result nil)) + (dolist (row rows) + (when (and (not result) (map-elt row :separator)) + (setq result idx)) + (setq idx (1+ idx))) + result)) + +(cl-defun agent-shell-markdown--style-tables (&key avoid-ranges) + "Render markdown tables found in current buffer. + +Each detected table has its source rows deleted from the buffer +and the prettified rendering inserted in their place; the +inserted text carries `agent-shell-markdown-frozen' so subsequent calls +skip it. Tables whose first row is already frozen — meaning +they live inside a fenced block, an inline-code body, or a +previously-rendered table — are left alone. + +AVOID-RANGES is a list of (START . END) cons cells covering +regions the renderer must not touch (e.g. still-open fenced code +blocks whose closing fence hasn't streamed in yet). + +Honours `agent-shell-markdown-prettify-tables'. Cell content is taken +directly from the buffer (with text properties preserved from +the earlier inline passes), so bold/italic/inline-code/link +rendering inside cells is provided for free." + (when agent-shell-markdown-prettify-tables + ;; Process tables in reverse so earlier positions stay valid as + ;; each replacement shifts everything after it. + (dolist (table (nreverse (agent-shell-markdown--find-tables + :avoid-ranges avoid-ranges))) + (agent-shell-markdown--render-table table)))) + +(defun agent-shell-markdown-table-next-cell () + "Move point to the start of the next table cell. +Wraps from the end of a row to the first cell of the next row. +Skips the separator row. Signals `No more cells left' when +point is at or past the last cell of the table at point. + +For example, with point inside cell `A' of: + + │ A │ B │ + ├───┼───┤ + │ 1 │ 2 │ + +a single call lands point on `B', another lands on `1', another +on `2', and a fourth signals `No more cells left'." + (interactive) + (agent-shell-markdown-table--move-cell :forward)) + +(defun agent-shell-markdown-table-previous-cell () + "Move point to the start of the previous table cell. +Wraps from the start of a row to the last cell of the previous +row. Skips the separator row. Signals `No more cells left' +when point is at or before the first cell of the table at point. + +Inverse of `agent-shell-markdown-table-next-cell'." + (interactive) + (agent-shell-markdown-table--move-cell :backward)) + +(defun agent-shell-markdown-table--move-cell (direction) + "Move point to the next or previous cell in the table at point. +DIRECTION is `:forward' or `:backward'. Signals `user-error' when +there's no cell in that direction." + (let* ((cells (agent-shell-markdown-table--cell-starts)) + (idx (or (cl-position-if (lambda (c) (<= c (point))) cells + :from-end t) + -1)) + (target (if (eq direction :forward) (1+ idx) (1- idx)))) + (if (and cells (<= 0 target) (< target (length cells))) + (goto-char (nth target cells)) + (user-error "No more cells left")))) + +(defun agent-shell-markdown-table--cell-starts () + "Return a sorted list of cell-start positions in the table at point. +Returns nil when point isn't inside a rendered agent-shell-markdown +table. Navigable cells are tagged by the renderer with the +`agent-shell-markdown-table-cell-start' text property, so separator rows +and continuation lines of wrapped rows are skipped automatically." + (when-let ((region (agent-shell-markdown-table--region-at-point))) + (let ((positions nil)) + (save-excursion + (save-restriction + (narrow-to-region (car region) (cdr region)) + (goto-char (point-min)) + (while (let ((m (text-property-search-forward + 'agent-shell-markdown-table-cell-start t t))) + (when m + (push (prop-match-beginning m) positions) + t))))) + (nreverse positions)))) + +(defun agent-shell-markdown-table--region-at-point () + "Return (START . END) of the rendered table at point, or nil." + (when (get-text-property (point) 'agent-shell-markdown-table-source) + (cons (or (previous-single-property-change + (1+ (point)) 'agent-shell-markdown-table-source nil (point-min)) + (point-min)) + (or (next-single-property-change + (point) 'agent-shell-markdown-table-source nil (point-max)) + (point-max))))) + +(defun agent-shell-markdown--apply-faces-from (propertized buffer-start) + "Copy `face' properties from PROPERTIZED string to chars at BUFFER-START.. + +Chars in PROPERTIZED without a `face' property cause the +corresponding buffer chars' `face' to be cleared, so re-running +on an already-highlighted body is idempotent." + (let ((pos 0) + (len (length propertized))) + (while (< pos len) + (let ((face (get-text-property pos 'face propertized)) + (next (or (next-single-property-change pos 'face propertized) len))) + (put-text-property (+ buffer-start pos) (+ buffer-start next) + 'face face) + (setq pos next))))) + +(defun agent-shell-markdown--mirror-face-to-font-lock-face (start end) + "Copy each `face' run across [START, END) to `font-lock-face'. + +`font-lock-mode' takes ownership of the `face' property and +clears it on re-fontification, which would wipe out our markup +styling in buffers that fontify continuously (comint, shell-maker, +agent-shell, etc.). `font-lock-face' is the property reserved +for callers who want their face to coexist — when font-lock is +on, the display engine renders `font-lock-face' as if it were +`face' and font-lock leaves it alone; when font-lock is off, +`font-lock-face' is ignored and our plain `face' renders. +Setting both means we look right in both contexts. + +Only positions with a non-nil `face' are mirrored; positions +already carrying a `font-lock-face' from elsewhere are +overwritten — agent-shell-markdown owns the styling for the chars it +produced." + (let ((pos start)) + (while (< pos end) + (let ((face (get-text-property pos 'face)) + (next (or (next-single-property-change pos 'face nil end) end))) + (when face + (put-text-property pos next 'font-lock-face face)) + (setq pos next))))) + +(defun agent-shell-markdown--highlight-code (code lang) + "Return CODE syntax-highlighted using LANG's major mode. + +LANG is a language identifier as written after the opening +fence (e.g. \"python\", \"elisp\"). When the resolved mode is +loadable, CODE is fontified in a temporary buffer and returned +with face properties applied. Otherwise CODE is returned +unchanged." + (if-let ((mode (agent-shell-markdown--resolve-lang-mode lang)) + ((fboundp mode))) + (with-temp-buffer + (insert code) + (let ((inhibit-message t) + (delay-mode-hooks t)) + (funcall mode) + (font-lock-ensure)) + (buffer-string)) + code)) + +(defun agent-shell-markdown--resolve-lang-mode (lang) + "Resolve LANG string to a major mode symbol, or nil. +LANG is case-folded and trimmed; `agent-shell-markdown-language-mapping' +is consulted for aliases before the `-mode' suffix is appended." + (when (and lang (not (string-empty-p (string-trim lang)))) + (let* ((normalized (downcase (string-trim lang))) + (resolved (or (cdr (assoc normalized agent-shell-markdown-language-mapping)) + normalized)) + (mode (intern (concat resolved "-mode")))) + (when (fboundp mode) + mode)))) + +(defun agent-shell-markdown--make-ret-binding-map (fun) + "Return a sparse keymap binding RET and mouse-1 to FUN." + (let ((map (make-sparse-keymap))) + (define-key map (kbd "RET") fun) + (define-key map [mouse-1] fun) + (define-key map [remap self-insert-command] 'ignore) + map)) + +(defun agent-shell-markdown--open-link (url) + "Open URL. Use local navigation for file links, `browse-url' otherwise." + (unless (agent-shell-markdown--open-local-link url) + (browse-url url))) + +(defun agent-shell-markdown--open-local-link (url) + "Open URL as a local file link if possible. +Return non-nil if handled, nil otherwise." + (when-let ((parsed (agent-shell-markdown--parse-local-link url))) + (find-file (car parsed)) + (when (cdr parsed) + (goto-char (point-min)) + (forward-line (1- (cdr parsed)))) + t)) + +(defun agent-shell-markdown--parse-local-link (url) + "Parse URL as a local file link. +Return a (FILE . LINE) cons when URL points to an existing local +file (LINE may be nil), or nil otherwise. + +For example: + + \"foo.el#L10\" => (\"/abs/foo.el\" . 10) + \"foo.el\" => (\"/abs/foo.el\" . nil) + \"file:src/bar.el:5\" => (\"/abs/src/bar.el\" . 5) + \"file:///tmp/baz.el#L20\" => (\"/tmp/baz.el\" . 20) + \"https://example.com\" => nil" + (when-let ((match + (cond + ((string-match + (rx bos "file://" + (group (+? anything)) + (optional (or (seq "#L" (group (one-or-more digit))) + (seq ":" (group (one-or-more digit))))) + eos) + url) + (cons (match-string 1 url) + (or (match-string 2 url) (match-string 3 url)))) + ((string-match + (rx bos "file:" + (group (not (any "/")) (+? anything)) + (optional (or (seq "#L" (group (one-or-more digit))) + (seq ":" (group (one-or-more digit))))) + eos) + url) + (cons (match-string 1 url) + (or (match-string 2 url) (match-string 3 url)))) + ((string-match + (rx bos + (group (? (optional "/") alpha ":/") + (one-or-more (not (any ":#")))) + "#L" (group (one-or-more digit)) + eos) + url) + (cons (match-string 1 url) (match-string 2 url))) + ((string-match + (rx bos + (group (? (optional "/") alpha ":/") + (one-or-more (not (any ":#")))) + ":" (group (one-or-more digit)) + eos) + url) + (cons (match-string 1 url) (match-string 2 url))) + ((not (string-empty-p url)) + (cons url nil)))) + (filepath (expand-file-name (car match)))) + (when (file-exists-p filepath) + (cons filepath + (when (cdr match) + (string-to-number (cdr match))))))) + +(defun agent-shell-markdown--resolve-image-url (url) + "Resolve image URL to an absolute local file path, or nil. +Handles file:// URIs, absolute paths, and paths starting with +`~/', `./', or `../'." + (when-let* ((path (cond + ((string-prefix-p "file://" url) + (url-unhex-string + (url-filename (url-generic-parse-url url)))) + ((string-prefix-p "file:" url) + (substring url (length "file:"))) + ((or (file-name-absolute-p url) + (string-prefix-p "~" url) + (string-prefix-p "./" url) + (string-prefix-p "../" url)) + url))) + (expanded (expand-file-name path)) + ((file-exists-p expanded))) + expanded)) + +(defun agent-shell-markdown--image-max-width () + "Return the maximum image width in pixels. +Resolves `agent-shell-markdown-image-max-width' which may be an integer +(pixels) or a float between 0 and 1 (ratio of window body width)." + (if (floatp agent-shell-markdown-image-max-width) + (let ((window (or (get-buffer-window (current-buffer)) + (frame-first-window)))) + (round (* agent-shell-markdown-image-max-width + (window-body-width window t)))) + agent-shell-markdown-image-max-width)) + +(defun agent-shell-markdown--make-markers (ranges) + "Convert each (start . end) in RANGES to (start-marker . end-marker)." + (mapcar (lambda (range) + (cons (copy-marker (car range)) + (copy-marker (cdr range)))) + ranges)) + +(defun agent-shell-markdown--in-avoid-range-p (start end avoid-ranges) + "Return non-nil if positions START..END are fully inside any AVOID-RANGES. + +AVOID-RANGES is a list of (start . end) cons cells; values may be +integers or markers (comparison works for both)." + (seq-find (lambda (range) + (and (>= start (car range)) + (<= end (cdr range)))) + avoid-ranges)) + +(defun agent-shell-markdown--source-block-ranges () + "Return list of (start . end) ranges covering fenced code blocks. + +Each range spans from the opening ``` line to the start of the +line after the closing ``` line. A fence that is open but not +yet closed (mid-stream) extends to `point-max', so its contents +are protected as the buffer grows. + +For example, given the buffer: + + ```python + print(\"hi\") + ``` + +returns a list with one range covering the whole block." + (let ((ranges '()) + (open nil) + (case-fold-search nil)) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward + (rx bol (zero-or-more whitespace) "```" (zero-or-more not-newline)) + nil t) + (if open + (progn + (push (cons open (line-beginning-position 2)) ranges) + (setq open nil)) + (setq open (match-beginning 0)))) + (when open + (push (cons open (point-max)) ranges))) + (nreverse ranges))) + +(defun agent-shell-markdown--frozen-ranges () + "Return ranges of buffer chars tagged `agent-shell-markdown-frozen'. + +The tag is written on rendered content whose body text could +otherwise look like markdown (e.g. inline code body or source +block body). Treating tagged ranges as avoid-ranges keeps +subsequent calls from re-processing them — important for +streaming, where the convert/replace-markup function may be +invoked many times as content grows." + (let ((ranges '()) + (pos (point-min)) + (limit (point-max))) + (while (< pos limit) + (if (get-text-property pos 'agent-shell-markdown-frozen) + (let ((end (or (next-single-property-change + pos 'agent-shell-markdown-frozen nil limit) + limit))) + (push (cons pos end) ranges) + (setq pos end)) + (setq pos (or (next-single-property-change + pos 'agent-shell-markdown-frozen nil limit) + limit)))) + (nreverse ranges))) + +(cl-defun agent-shell-markdown--inline-code-ranges (&key avoid-ranges) + "Return list of (start . end) ranges covering inline `X` bodies. + +Each range covers the text between backticks (the backticks +themselves are not included). Backticks inside any of +AVOID-RANGES are ignored. A line with an odd number of backticks +has its trailing unmatched backtick treated as still-streaming: +the range extends from that backtick to end-of-line. + +For example, given the buffer \"a `code` b\" returns a list with +one range covering the body \"code\"." + (let ((ranges '()) + (case-fold-search nil)) + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (let ((line-end (line-end-position)) + (open nil)) + (while (re-search-forward "`" line-end t) + (let ((pos (match-beginning 0))) + (unless (agent-shell-markdown--in-avoid-range-p pos pos avoid-ranges) + (if open + (progn + (push (cons (1+ open) pos) ranges) + (setq open nil)) + (setq open pos))))) + (when open + (push (cons (1+ open) line-end) ranges))) + (forward-line 1))) + (nreverse ranges))) + +(defun agent-shell-markdown--deconstruct (text) + "Return TEXT broken into (SUBSTRING FACES) runs. + +Each element is a contiguous run of characters with the same +`face' property: SUBSTRING is the run text, FACES is a list of +face symbols (a single symbol is wrapped, an unfaced run gets an +empty list). Runs are returned in left-to-right order and cover +TEXT in full. + +For example: + + (agent-shell-markdown--deconstruct (agent-shell-markdown-convert \"_my_ **text**\")) + => ((\"my\" (italic)) (\" \" nil) (\"text\" (bold)))" + (let ((runs '()) + (pos 0) + (len (length text))) + (while (< pos len) + (let ((face (get-text-property pos 'face text)) + (next (or (next-single-property-change pos 'face text) len))) + (push (list (substring-no-properties text pos next) + (cond ((null face) nil) + ((listp face) face) + (t (list face)))) + runs) + (setq pos next))) + (nreverse runs))) + +(provide 'agent-shell-markdown) + +;;; agent-shell-markdown.el ends here diff --git a/agent-shell-ui.el b/agent-shell-ui.el index 6ecbbf9d..af3876c8 100644 --- a/agent-shell-ui.el +++ b/agent-shell-ui.el @@ -69,7 +69,7 @@ For existing blocks, the current expansion state is preserved unless overridden. Updates to existing blocks are applied surgically per section: a body append inserts the new chunk at the end of the body region without -disturbing already-rendered content, so `markdown-text' frozen ranges +disturbing already-rendered content, so `agent-shell-markdown' frozen ranges stay intact and streaming append is O(new-chunk) rather than O(accumulated-body). Label-only updates leave the body untouched." (let* ((window (get-buffer-window (current-buffer))) @@ -259,7 +259,7 @@ trailing-whitespace tail." (defun agent-shell-ui--surgical-append-body (body-range chunk qualified-id _collapsed) "Insert CHUNK at the end of BODY-RANGE. -Existing body chars stay in place — `markdown-text' frozen tags +Existing body chars stay in place — `agent-shell-markdown' frozen tags and per-char faces are preserved across streaming chunks. Visibility for new chars is derived from the current visibility of the existing body, not from caller-supplied state, because diff --git a/agent-shell.el b/agent-shell.el index 88ffd18f..fc2ea550 100644 --- a/agent-shell.el +++ b/agent-shell.el @@ -48,7 +48,7 @@ (require 'map) (unless (require 'markdown-overlays nil 'noerror) (error "Please update 'shell-maker' to v0.91.2 or newer")) -(require 'markdown-text nil :noerror) +(require 'agent-shell-markdown) (require 'agent-shell-anthropic) (require 'agent-shell-auggie) (require 'agent-shell-cline) @@ -99,30 +99,27 @@ (defvar auto-insert) (defvar agent-shell--experimental-renderer nil - "When non-nil, render markdown via `markdown-text'. + "When non-nil, render markdown via `agent-shell-markdown'. -Internal/experimental. `markdown-text' replaces markup +Internal/experimental. `agent-shell-markdown' replaces markup characters with propertized text in place (no overlays), which avoids the redisplay overhead of large overlay counts but destroys the source markdown. Defaults to nil (keep current -`markdown-overlays' behaviour). - -Has no effect when `markdown-text' isn't installed.") +`markdown-overlays' behaviour).") (defun agent-shell--render-markdown () "Render markdown in current (narrowed) buffer. -Dispatches to `markdown-text-replace-markup' when -`agent-shell--experimental-renderer' is non-nil and the package -is loadable; otherwise falls back to `markdown-overlays-put'. +Dispatches to `agent-shell-markdown-replace-markup' when +`agent-shell--experimental-renderer' is non-nil; otherwise falls +back to `markdown-overlays-put'. `markdown-overlays-*' config bindings around the call still apply in the overlay branch; they're intentionally ignored by -`markdown-text', which always highlights blocks and renders +`agent-shell-markdown', which always highlights blocks and renders resolvable images." - (if (and agent-shell--experimental-renderer - (fboundp 'markdown-text-replace-markup)) - (markdown-text-replace-markup) + (if agent-shell--experimental-renderer + (agent-shell-markdown-replace-markup) (markdown-overlays-put))) (defcustom agent-shell-permission-icon "⚠" @@ -3113,7 +3110,7 @@ by default, RENDER-BODY-IMAGES to enable inline image rendering in body." ;; Apply markdown overlay to body. `inhibit-read-only' ;; must wrap the render call too — chars in the body ;; carry `read-only t' from `agent-shell-ui--insert-fragment', - ;; and `markdown-text' modifies buffer chars (unlike the + ;; and `agent-shell-markdown' modifies buffer chars (unlike the ;; overlay renderer which only adds overlays). (when-let ((body-start (map-nested-elt range '(:body :start))) (body-end (map-nested-elt range '(:body :end)))) diff --git a/tests/agent-shell-markdown-tests.el b/tests/agent-shell-markdown-tests.el new file mode 100644 index 00000000..bf8326d7 --- /dev/null +++ b/tests/agent-shell-markdown-tests.el @@ -0,0 +1,775 @@ +;;; agent-shell-markdown-tests.el --- Tests for agent-shell-markdown -*- lexical-binding: t; -*- + +;;; Commentary: +;; +;; Run via: +;; +;; emacs -batch -l ert -l tests/agent-shell-markdown-tests.el \ +;; -f ert-run-tests-batch-and-exit + +;;; Code: + +(require 'cl-lib) +(require 'ert) + +(load-file (expand-file-name "../agent-shell-markdown.el" + (file-name-directory + (or load-file-name buffer-file-name)))) + +(ert-deftest agent-shell-markdown-convert-bold () + (should (equal (agent-shell-markdown--deconstruct + (agent-shell-markdown-convert "hello **world**")) + '(("hello " nil) + ("world" (agent-shell-markdown-bold)))))) + +(ert-deftest agent-shell-markdown-convert-bold-underscore () + (should (equal (agent-shell-markdown--deconstruct + (agent-shell-markdown-convert "hello __world__")) + '(("hello " nil) + ("world" (agent-shell-markdown-bold)))))) + +(ert-deftest agent-shell-markdown-convert-italic () + (should (equal (agent-shell-markdown--deconstruct + (agent-shell-markdown-convert "hello *world*")) + '(("hello " nil) + ("world" (agent-shell-markdown-italic)))))) + +(ert-deftest agent-shell-markdown-convert-italic-underscore () + (should (equal (agent-shell-markdown--deconstruct + (agent-shell-markdown-convert "hello _world_")) + '(("hello " nil) + ("world" (agent-shell-markdown-italic)))))) + +(ert-deftest agent-shell-markdown-convert-multiple () + (should (equal (agent-shell-markdown--deconstruct + (agent-shell-markdown-convert "_my_ **text**")) + '(("my" (agent-shell-markdown-italic)) + (" " nil) + ("text" (agent-shell-markdown-bold)))))) + +(ert-deftest agent-shell-markdown-convert-italic-wrapping-bold () + (should (equal (agent-shell-markdown--deconstruct + (agent-shell-markdown-convert "_**my text**_")) + '(("my text" (agent-shell-markdown-bold agent-shell-markdown-italic)))))) + +(ert-deftest agent-shell-markdown-convert-bold-wrapping-italic () + (should (equal (agent-shell-markdown--deconstruct + (agent-shell-markdown-convert "**_my text_**")) + '(("my text" (agent-shell-markdown-italic agent-shell-markdown-bold)))))) + +(ert-deftest agent-shell-markdown-convert-bold-with-inner-italic () + (should (equal (agent-shell-markdown--deconstruct + (agent-shell-markdown-convert "**outer _both_ outer**")) + '(("outer " (agent-shell-markdown-bold)) + ("both" (agent-shell-markdown-bold agent-shell-markdown-italic)) + (" outer" (agent-shell-markdown-bold)))))) + +(ert-deftest agent-shell-markdown-convert-italic-with-inner-bold () + (should (equal (agent-shell-markdown--deconstruct + (agent-shell-markdown-convert "_outer **both** outer_")) + '(("outer " (agent-shell-markdown-italic)) + ("both" (agent-shell-markdown-bold agent-shell-markdown-italic)) + (" outer" (agent-shell-markdown-italic)))))) + +(ert-deftest agent-shell-markdown-convert-no-markup () + (should (equal (agent-shell-markdown--deconstruct + (agent-shell-markdown-convert "no markup here")) + '(("no markup here" nil))))) + +(ert-deftest agent-shell-markdown-convert-empty () + (should (equal (agent-shell-markdown--deconstruct + (agent-shell-markdown-convert "")) + '()))) + +(ert-deftest agent-shell-markdown-convert-inline-code-protects-markup () + (should (equal (agent-shell-markdown--deconstruct + (agent-shell-markdown-convert + "before **b** and `**not bold**` after")) + '(("before " nil) + ("b" (agent-shell-markdown-bold)) + (" and " nil) + ("**not bold**" (agent-shell-markdown-inline-code)) + (" after" nil))))) + +(ert-deftest agent-shell-markdown-convert-inline-code () + (should (equal (agent-shell-markdown--deconstruct + (agent-shell-markdown-convert "a `code` b")) + '(("a " nil) + ("code" (agent-shell-markdown-inline-code)) + (" b" nil))))) + +(ert-deftest agent-shell-markdown-convert-strikethrough () + (should (equal (agent-shell-markdown--deconstruct + (agent-shell-markdown-convert "a ~~b~~ c")) + '(("a " nil) + ("b" (agent-shell-markdown-strikethrough)) + (" c" nil))))) + +(ert-deftest agent-shell-markdown-convert-strikethrough-wrapping-bold () + (should (equal (agent-shell-markdown--deconstruct + (agent-shell-markdown-convert "~~**bold-strike**~~")) + '(("bold-strike" (agent-shell-markdown-bold agent-shell-markdown-strikethrough)))))) + +(ert-deftest agent-shell-markdown-convert-header-level-1 () + (should (equal (agent-shell-markdown--deconstruct + (agent-shell-markdown-convert "# Title")) + '(("Title" (agent-shell-markdown-header-1)))))) + +(ert-deftest agent-shell-markdown-convert-header-level-3 () + (should (equal (agent-shell-markdown--deconstruct + (agent-shell-markdown-convert "### Title")) + '(("Title" (agent-shell-markdown-header-3)))))) + +(ert-deftest agent-shell-markdown-convert-header-with-bold () + (should (equal (agent-shell-markdown--deconstruct + (agent-shell-markdown-convert "## **Big** title")) + '(("Big" (agent-shell-markdown-header-2 agent-shell-markdown-bold)) + (" title" (agent-shell-markdown-header-2)))))) + +(ert-deftest agent-shell-markdown-convert-fenced-block-protects-markup () + (should (equal (agent-shell-markdown--deconstruct + (agent-shell-markdown-convert + "before **b** +``` +**not bold** +_not italic_ +``` +after **b2**")) + '(("before " nil) + ("b" (agent-shell-markdown-bold)) + (" +**not bold** +_not italic_ +after " nil) + ("b2" (agent-shell-markdown-bold)))))) + +(ert-deftest agent-shell-markdown-convert-open-fence-protects-rest () + (should (equal (agent-shell-markdown--deconstruct + (agent-shell-markdown-convert + "before **b** +``` +streaming **not bold**")) + '(("before " nil) + ("b" (agent-shell-markdown-bold)) + (" +``` +streaming **not bold**" nil))))) + +(ert-deftest agent-shell-markdown-convert-open-inline-code-protects-rest-of-line () + (should (equal (agent-shell-markdown--deconstruct + (agent-shell-markdown-convert + "before **b** and `streaming *not italic*")) + '(("before " nil) + ("b" (agent-shell-markdown-bold)) + (" and `streaming *not italic*" nil))))) + +(ert-deftest agent-shell-markdown-convert-incomplete-bold-untouched () + (should (equal (agent-shell-markdown--deconstruct + (agent-shell-markdown-convert + "complete **b** and incomplete **par")) + '(("complete " nil) + ("b" (agent-shell-markdown-bold)) + (" and incomplete **par" nil))))) + +(ert-deftest agent-shell-markdown-convert-link () + (should (equal (agent-shell-markdown--deconstruct + (agent-shell-markdown-convert "see [docs](https://example.com) please")) + '(("see " nil) + ("docs" (agent-shell-markdown-link)) + (" please" nil))))) + +(ert-deftest agent-shell-markdown-convert-link-with-bold-inside-untouched () + ;; Bold inside link title is left literal (mirrors markdown-overlays: + ;; bold regex requires whitespace/BOL before `**', and `[' isn't either). + (should (equal (agent-shell-markdown--deconstruct + (agent-shell-markdown-convert "[**bold**](url)")) + '(("**bold**" (agent-shell-markdown-link)))))) + +(ert-deftest agent-shell-markdown-convert-link-after-image-not-confused () + ;; `[X](Y)' inside `![X](Y)' must not be treated as a link. + (should (equal (agent-shell-markdown--deconstruct + (agent-shell-markdown-convert "![alt](missing.png)")) + '(("![alt](missing.png)" nil))))) + +(ert-deftest agent-shell-markdown-convert-image-unresolvable-untouched () + (should (equal (agent-shell-markdown--deconstruct + (agent-shell-markdown-convert "see ![alt](/no/such/file.png) end")) + '(("see ![alt](/no/such/file.png) end" nil))))) + +(ert-deftest agent-shell-markdown-convert-link-in-fenced-block-untouched () + (should (equal (agent-shell-markdown--deconstruct + (agent-shell-markdown-convert + "before [a](u) +``` +[b](v) +``` +after [c](w)")) + '(("before " nil) + ("a" (agent-shell-markdown-link)) + (" +[b](v) +after " nil) + ("c" (agent-shell-markdown-link)))))) + +(ert-deftest agent-shell-markdown-convert-source-block-no-language () + ;; Plain fenced block (no language): fences deleted, body remains + ;; (with `agent-shell-markdown-frozen t' tagged on body chars, which + ;; `--deconstruct' doesn't surface — it tracks face only). + (should (equal (agent-shell-markdown--deconstruct + (agent-shell-markdown-convert + "``` +body +```")) + '(("body +" nil))))) + +(ert-deftest agent-shell-markdown-convert-source-block-with-language () + ;; `emacs-lisp' source block: fences deleted, body chars get + ;; `emacs-lisp-mode' font-lock faces. In batch the keyword `if' + ;; is faced. (Note: the faces here come directly from the + ;; language major mode and are intentionally not wrapped in our + ;; own `agent-shell-markdown-*' faces.) + (should (equal (agent-shell-markdown--deconstruct + (agent-shell-markdown-convert + "```emacs-lisp +(if t nil) +```")) + '(("(" nil) + ("if" (font-lock-keyword-face)) + (" t nil) +" nil))))) + +(ert-deftest agent-shell-markdown-convert-source-block-body-tagged () + ;; Body chars carry `agent-shell-markdown-frozen t' so subsequent calls + ;; treat them as an avoid-range (streaming-safe). Body in the + ;; rendered output is "**not bold**" followed by a newline — the + ;; chars before that trailing newline are tagged; the newline + ;; itself is not. + (let ((s (agent-shell-markdown-convert "``` +**not bold** +```"))) + (should (eq t (get-text-property 0 'agent-shell-markdown-frozen s))) + (should (eq t (get-text-property 5 'agent-shell-markdown-frozen s))) + (should (null (get-text-property (1- (length s)) 'agent-shell-markdown-frozen s))))) + +(ert-deftest agent-shell-markdown-convert-inline-code-body-tagged () + ;; Inline code body chars are also `agent-shell-markdown-frozen t'-tagged + ;; so a stray "**X**" inside backticks stays literal on re-runs. + (let ((s (agent-shell-markdown-convert "a `**not bold**` b"))) + (should (eq t (get-text-property 2 'agent-shell-markdown-frozen s))) + (should (eq t (get-text-property 13 'agent-shell-markdown-frozen s))) + (should (null (get-text-property 0 'agent-shell-markdown-frozen s))))) + +(ert-deftest agent-shell-markdown-source-block-body-protected-across-calls () + ;; Streaming: render a block, then append more markdown and re-render. + ;; The previously-rendered body (`agent-shell-markdown-frozen t') must stay + ;; literal — its `**not bold**' must not turn into bold X on the + ;; second pass, while newly-appended `**real bold**' does. + (with-temp-buffer + (insert "``` +**not bold** +```") + (agent-shell-markdown-replace-markup) + (goto-char (point-max)) + (insert " +**real bold**") + (agent-shell-markdown-replace-markup) + (should (equal (agent-shell-markdown--deconstruct (buffer-string)) + '(("**not bold** + +" nil) + ("real bold" (agent-shell-markdown-bold))))))) + +(ert-deftest agent-shell-markdown-inline-code-body-protected-across-calls () + ;; Streaming counterpart for inline code: after the backticks + ;; are gone, body chars must not be re-bolded on a second pass. + (with-temp-buffer + (insert "a `**not bold**` b") + (agent-shell-markdown-replace-markup) + (goto-char (point-max)) + (insert " **real bold**") + (agent-shell-markdown-replace-markup) + (should (equal (agent-shell-markdown--deconstruct (buffer-string)) + '(("a " nil) + ("**not bold**" (agent-shell-markdown-inline-code)) + (" b " nil) + ("real bold" (agent-shell-markdown-bold))))))) + +(ert-deftest agent-shell-markdown-convert-divider-dashes () + ;; A `---' line gets a `display' property and `agent-shell-markdown-frozen' + ;; tag. The chars themselves stay in the buffer beneath the display. + (let ((s (agent-shell-markdown-convert "above +--- +below"))) + (should (eq t (get-text-property 6 'agent-shell-markdown-frozen s))) + (should (get-text-property 6 'display s)))) + +(ert-deftest agent-shell-markdown-convert-divider-stars () + (let ((s (agent-shell-markdown-convert "above +*** +below"))) + (should (eq t (get-text-property 6 'agent-shell-markdown-frozen s))) + (should (get-text-property 6 'display s)))) + +(ert-deftest agent-shell-markdown-convert-divider-underscores () + (let ((s (agent-shell-markdown-convert "above +___ +below"))) + (should (eq t (get-text-property 6 'agent-shell-markdown-frozen s))) + (should (get-text-property 6 'display s)))) + +(ert-deftest agent-shell-markdown-convert-divider-not-matched-with-text () + ;; `*** hello ***' is not a divider — has other content on the line. + (should (equal (agent-shell-markdown--deconstruct + (agent-shell-markdown-convert "*** hello ***")) + '(("*** hello ***" nil))))) + +(ert-deftest agent-shell-markdown-convert-image-file-path-unresolvable-untouched () + ;; Path doesn't exist (and batch mode has no graphics anyway), so + ;; the line is left untouched. + (should (equal (agent-shell-markdown--deconstruct + (agent-shell-markdown-convert + "before +/no/such/img.png +after")) + '(("before +/no/such/img.png +after" nil))))) + +(ert-deftest agent-shell-markdown-convert-table-basic () + ;; A complete table is replaced by its prettified rendering and the + ;; inserted chars carry `agent-shell-markdown-frozen' so subsequent calls + ;; skip them. (Rendering shape is covered more thoroughly by the + ;; `-output-*' tests.) + (let ((s (agent-shell-markdown-convert "| A | B | +|---|---| +| 1 | 2 |"))) + (should (equal (substring-no-properties s) + "│ A │ B │ +├───┼───┤ +│ 1 │ 2 │")) + (should (eq t (get-text-property 0 'agent-shell-markdown-frozen s))))) + +(ert-deftest agent-shell-markdown-convert-table-without-separator-renders () + ;; A separator row (`|---|---|') is optional. Two or more `|...|' + ;; rows are enough to render — without a separator, all rows are + ;; treated as data (no header styling, no separator border in the + ;; output). + (should (equal (substring-no-properties + (agent-shell-markdown-convert "| a | b | +| hello | world |")) + "│ a │ b │ +│ hello │ world │"))) + +(ert-deftest agent-shell-markdown-convert-table-cell-uses-bold () + ;; Bold inside a cell is processed by the main pass; the rendered + ;; table preserves the bold face on \"Alice\". + (let* ((s (agent-shell-markdown-convert "| Name | Role | +|------|------| +| **Alice** | Engineer |")) + (alice-pos (string-match "Alice" s))) + (should alice-pos) + (should (eq 'agent-shell-markdown-bold (get-text-property alice-pos 'face s))))) + +(ert-deftest agent-shell-markdown-convert-table-skips-frozen-cell-pipe () + ;; `| `a|b` | c |' — inline-code body contains a `|', which our + ;; inline-code styling tags `agent-shell-markdown-frozen'. The cell parser + ;; should treat that pipe as part of the cell rather than a + ;; separator, yielding 2 cells (not 3). + (let* ((s (agent-shell-markdown-convert "| `a|b` | c | +|---|---| +| x | y |")) + (header-line (car (split-string s " +"))) + ;; In a 2-column rendering, count the leading-pipe + col-pipe + ;; + trailing-pipe = 3 borders. (For 3 cols there would be 4.) + (pipe-count (length (seq-filter (lambda (c) (eq c ?│)) + header-line)))) + (should (eq 3 pipe-count)))) + +(ert-deftest agent-shell-markdown-convert-table-output-plain () + ;; End-to-end multi-line input → multi-line output comparison. + ;; Checks the rendered text only (no text-property assertions). + (should (equal (substring-no-properties + (agent-shell-markdown-convert + "| A | B | +|---|---| +| 1 | 2 |")) + "│ A │ B │ +├───┼───┤ +│ 1 │ 2 │"))) + +(ert-deftest agent-shell-markdown-convert-table-output-with-bold () + ;; Bold markup inside cells is stripped by the main pipeline before + ;; the table is rendered, so the rendered string contains \"Alice\" + ;; (the `**...**' is gone) and columns are sized for the stripped + ;; content. Compares text only. + (should (equal (substring-no-properties + (agent-shell-markdown-convert + "| Name | Role | +|------|------| +| **Alice** | Engineer | +| Bob | Manager |")) + "│ Name │ Role │ +├───────┼──────────┤ +│ Alice │ Engineer │ +│ Bob │ Manager │"))) + +(ert-deftest agent-shell-markdown-convert-table-output-wraps-one-cell () + ;; When the table's natural width exceeds the target, the widest + ;; column shrinks and its content wraps at word boundaries. + ;; Mocks `agent-shell-markdown--display-width' to 30 so the result is + ;; deterministic. Other columns stay at natural width. + (let ((agent-shell-markdown-table-max-width-fraction 1.0)) + (cl-letf (((symbol-function 'agent-shell-markdown--display-width) + (lambda () 30))) + (should (equal (substring-no-properties + (agent-shell-markdown-convert + "| A | B | +|---|---| +| short | this is a much longer description |")) + "│ A │ B │ +├───────┼────────────────────┤ +│ short │ this is a much │ +│ │ longer description │"))))) + +(ert-deftest agent-shell-markdown-convert-table-output-wraps-both-cells () + ;; Both columns shrink and wrap when both are too wide. Column + ;; widths are allocated proportionally to their natural width. + (let ((agent-shell-markdown-table-max-width-fraction 1.0)) + (cl-letf (((symbol-function 'agent-shell-markdown--display-width) + (lambda () 30))) + (should (equal (substring-no-properties + (agent-shell-markdown-convert + "| Header A | Header B | +|---|---| +| first quite long content | second cell also long enough |")) + "│ Header A │ Header B │ +├─────────────┼─────────────┤ +│ first │ second │ +│ quite long │ cell also │ +│ content │ long enough │"))))) + +(ert-deftest agent-shell-markdown-mirrors-face-to-font-lock-face () + ;; Faces are mirrored to `font-lock-face' so our styling survives + ;; `font-lock-mode' re-fontification in comint / shell-maker buffers. + (let* ((s (agent-shell-markdown-convert "hello **world**")) + (world-pos (string-match "world" s))) + (should (eq 'agent-shell-markdown-bold (get-text-property world-pos 'face s))) + (should (eq 'agent-shell-markdown-bold + (get-text-property world-pos 'font-lock-face s))) + ;; Composed faces (`(bold italic)') mirror as the same list. + (let* ((composed (agent-shell-markdown-convert "_**X**_")) + (x-pos (string-match "X" composed))) + (should (equal '(agent-shell-markdown-bold agent-shell-markdown-italic) + (get-text-property x-pos 'face composed))) + (should (equal '(agent-shell-markdown-bold agent-shell-markdown-italic) + (get-text-property x-pos 'font-lock-face composed)))))) + +(ert-deftest agent-shell-markdown-table-preserves-caller-text-properties () + ;; Caller-set text properties (here: a custom symbol) at the + ;; table's start position must survive the render's delete+insert, + ;; so callers can keep using text-property scans to bracket regions + ;; — e.g., agent-shell uses `agent-shell-ui-state' to find blocks. + (with-temp-buffer + (insert "| A | B | +|---|---| +| 1 | 2 |") + (put-text-property (point-min) (point-max) 'agent-shell-ui-state 'my-block) + (agent-shell-markdown-replace-markup) + ;; Every char in the rendered output should carry the tag. + (should (eq 'my-block + (get-text-property (point-min) 'agent-shell-ui-state))) + (should (eq 'my-block + (get-text-property (1- (point-max)) 'agent-shell-ui-state))))) + +(ert-deftest agent-shell-markdown-table-extends-on-streamed-rows () + ;; First render a 3-row table. Then append a 4th data row to the + ;; buffer (simulating an LLM streaming more content) and re-render. + ;; The renderer should see the stashed source on the already-rendered + ;; region, combine it with the new ASCII row, and emit a single + ;; 4-row table with recomputed column widths. Trailing newlines on + ;; each row signal completeness — the renderer defers rendering of a + ;; trailing row that isn't yet `\\n'-terminated, since a streaming + ;; chunk may have ended mid-row. + (with-temp-buffer + (insert "| Col | Width | +|---|---| +| 1 | 2 | +") + (agent-shell-markdown-replace-markup) + (goto-char (point-max)) + (insert "| three | four | +") + (agent-shell-markdown-replace-markup) + (should (equal (substring-no-properties (buffer-string)) + "│ Col │ Width │ +├───────┼───────┤ +│ 1 │ 2 │ +│ three │ four │ +")))) + +(ert-deftest agent-shell-markdown-table-folds-mid-stream-continuation () + ;; A streamed chunk may end mid-row (chunk boundary splits a + ;; row's cells). Each render commits the latest chars to a + ;; prettified table. The next chunk's continuation chars (no + ;; leading newline — they extend the current last row) get folded + ;; back into the rendered table's last source row, so the final + ;; render shows all rows with consistent column widths and no + ;; orphan raw markdown stuck on a `│' line. + (with-temp-buffer + ;; Chunk 1: 3-row table. The last row is intentionally short + ;; (4 cells; header has 5) with no trailing newline — the chunk + ;; boundary fell mid-row. + (insert "| # | Name | Role | Country | Status | +|---|---|---|---|---| +| 1 | Alice | Engineer | USA |") + (agent-shell-markdown-replace-markup) + ;; Chunk 2: the continuation of row 1 (the missing `Status' + ;; cell — note it starts with a space, not a newline) plus a + ;; complete row 2. + (goto-char (point-max)) + (insert " Active | +| 2 | Bob | Designer | UK | Historical | +") + (agent-shell-markdown-replace-markup) + ;; All rows render as a single 4-row table with the continuation + ;; folded into row 1. Column widths are consistent. + (should (equal (substring-no-properties (buffer-string)) + "│ # │ Name │ Role │ Country │ Status │ +├───┼───────┼──────────┼─────────┼────────────┤ +│ 1 │ Alice │ Engineer │ USA │ Active │ +│ 2 │ Bob │ Designer │ UK │ Historical │ +")))) + +(ert-deftest agent-shell-markdown-table-inside-open-fence-stays-raw () + ;; A table inside a fenced block whose closing fence hasn't + ;; streamed in yet must NOT get table-rendered. Otherwise the + ;; rendered table would survive when the closing fence finally + ;; arrives and the source-block pass strips the fences — the + ;; user would see a styled table where they asked for verbatim + ;; code. + (with-temp-buffer + (insert "``` +| A | B | +|---|---| +| 1 | 2 | +") + (agent-shell-markdown-replace-markup) + ;; The pipes stay as ASCII `|', not unicode `│' — the table + ;; renderer respected the open-fence range. + (should (string-match-p "| A | B |" (buffer-string))) + (should-not (string-match-p "│" (buffer-string))))) + +(ert-deftest agent-shell-markdown-table-renders-final-row-without-trailing-newline () + ;; A complete table whose last row isn't terminated by `\n' (e.g. + ;; the final chunk of a streaming response) must still render — + ;; callers like agent-shell narrow to the body section, which + ;; excludes the trailing `\n', so even when streaming has stopped + ;; the row would appear unterminated within the narrow. + (with-temp-buffer + (insert "| Name | Age | +|---|---| +| Alice | 28 | +| Bob | 35 |") + (agent-shell-markdown-replace-markup) + (should (equal (substring-no-properties (buffer-string)) + "│ Name │ Age │ +├───────┼─────┤ +│ Alice │ 28 │ +│ Bob │ 35 │")))) + +(ert-deftest agent-shell-markdown-table-renders-with-field-boundaries () + ;; Callers (e.g. agent-shell) tag body chars with the `field' text + ;; property. Streamed chunks may not propagate `field' onto inter- + ;; row newlines uniformly, creating field boundaries inside the table + ;; source. `forward-line' / `line-end-position' are field-aware by + ;; default, so without protection the parsers would stop at those + ;; boundaries and render some rows as empty `││'. + (with-temp-buffer + (insert "| Name | Age | +|---|---| +| Alice | 28 | +| Bob | 35 | +| Carol | 42 | +") + ;; Strip `field' from the inter-row newlines while leaving it on + ;; the row content — mimics the agent-shell streaming-chunk shape + ;; that triggered the original bug. + (put-text-property (point-min) (point-max) 'field 'output) + (save-excursion + (goto-char (point-min)) + (while (search-forward "\n" nil t) + (remove-text-properties (1- (point)) (point) '(field nil)))) + (agent-shell-markdown-replace-markup) + (should (equal (substring-no-properties (buffer-string)) + "│ Name │ Age │ +├───────┼─────┤ +│ Alice │ 28 │ +│ Bob │ 35 │ +│ Carol │ 42 │ +")))) + +(ert-deftest agent-shell-markdown-table-next-cell-walks-cells-in-order () + ;; Cells walk row-by-row, skipping the separator, and signal + ;; `user-error' at the table boundary. + (with-temp-buffer + (insert "| A | B | +|---|---| +| 1 | 2 | +") + (agent-shell-markdown-replace-markup) + ;; Point at A. + (goto-char (point-min)) + (search-forward "A") + (backward-char) + (agent-shell-markdown-table-next-cell) + (should (eq (char-after) ?B)) + (agent-shell-markdown-table-next-cell) + (should (eq (char-after) ?1)) + (agent-shell-markdown-table-next-cell) + (should (eq (char-after) ?2)) + (should-error (agent-shell-markdown-table-next-cell) :type 'user-error))) + +(ert-deftest agent-shell-markdown-table-previous-cell-walks-cells-in-reverse () + (with-temp-buffer + (insert "| A | B | +|---|---| +| 1 | 2 | +") + (agent-shell-markdown-replace-markup) + ;; Point at 2. + (goto-char (point-min)) + (search-forward "2") + (backward-char) + (agent-shell-markdown-table-previous-cell) + (should (eq (char-after) ?1)) + (agent-shell-markdown-table-previous-cell) + (should (eq (char-after) ?B)) + (agent-shell-markdown-table-previous-cell) + (should (eq (char-after) ?A)) + (should-error (agent-shell-markdown-table-previous-cell) :type 'user-error))) + +(ert-deftest agent-shell-markdown-table-next-cell-skips-wrapped-continuation () + ;; A wrapped row spans multiple physical lines; only the first + ;; line carries navigable cells. Continuation lines (with the + ;; remainder of wrapped content in some cells, padding in others) + ;; must not register as separate cells. + (let ((agent-shell-markdown-table-max-width-fraction 1.0)) + (cl-letf (((symbol-function 'agent-shell-markdown--display-width) + (lambda () 30))) + (with-temp-buffer + (insert "| A | B | +|---|---| +| short | this is a much longer description | +") + (agent-shell-markdown-replace-markup) + ;; The rendered table has the data row wrapped to 2 physical + ;; lines. There should be exactly 4 navigable cells: A, B + ;; (header), short, "this is a much" (the data row's first + ;; line — but logically one cell, "this is a much longer + ;; description"). + (goto-char (point-min)) + (search-forward "A") + (backward-char) + (agent-shell-markdown-table-next-cell) + (should (eq (char-after) ?B)) + (agent-shell-markdown-table-next-cell) + (should (looking-at-p "short")) + (agent-shell-markdown-table-next-cell) + (should (looking-at-p "this is a much")) + ;; The continuation line "longer description" is NOT a cell. + (should-error (agent-shell-markdown-table-next-cell) :type 'user-error))))) + +(ert-deftest agent-shell-markdown-table-next-cell-errors-outside-table () + (with-temp-buffer + (insert "not a table at all") + (goto-char (point-min)) + (should-error (agent-shell-markdown-table-next-cell) :type 'user-error) + (should-error (agent-shell-markdown-table-previous-cell) :type 'user-error))) + +(ert-deftest agent-shell-markdown-convert-table-in-fenced-block-untouched () + ;; A table inside a fenced block stays untouched (source-block body + ;; is frozen, so table detection skips it — and source-block fences + ;; are themselves deleted, but the body chars stay literal). + (let ((s (agent-shell-markdown-convert "``` +| A | B | +|---|---| +| 1 | 2 | +```"))) + (should (string-match-p "| A | B |" s)) + (should (not (string-match-p "│" s))))) + +(ert-deftest agent-shell-markdown-convert-everything () + (should (equal + (agent-shell-markdown--deconstruct + (agent-shell-markdown-convert + "# Top + +Some **bold** and _italic_ with ~~strike~~ done. + +--- + +## Sub with **mixed _both_ end** + +A [link](https://example.com) and `code`. + +``` +**not bold** +``` + +![alt](/missing). + +| A | B | +|---|---| +| 1 | 2 |")) + '(("Top" (agent-shell-markdown-header-1)) + (" + +Some " nil) + ("bold" (agent-shell-markdown-bold)) + (" and " nil) + ("italic" (agent-shell-markdown-italic)) + (" with " nil) + ("strike" (agent-shell-markdown-strikethrough)) + (" done. + +--- + +" nil) + ("Sub with " (agent-shell-markdown-header-2)) + ("mixed " (agent-shell-markdown-header-2 agent-shell-markdown-bold)) + ("both" (agent-shell-markdown-header-2 agent-shell-markdown-bold agent-shell-markdown-italic)) + (" end" (agent-shell-markdown-header-2 agent-shell-markdown-bold)) + (" + +A " nil) + ("link" (agent-shell-markdown-link)) + (" and " nil) + ("code" (agent-shell-markdown-inline-code)) + (". + +**not bold** + +![alt](/missing). + +" nil) + ("│" (agent-shell-markdown-table-border)) + (" A " (agent-shell-markdown-table-header)) + ("│" (agent-shell-markdown-table-border)) + (" B " (agent-shell-markdown-table-header)) + ("│" (agent-shell-markdown-table-border)) + (" +" nil) + ("├───┼───┤" (agent-shell-markdown-table-border)) + (" +" nil) + ("│" (agent-shell-markdown-table-border)) + (" 1 " nil) + ("│" (agent-shell-markdown-table-border)) + (" 2 " nil) + ("│" (agent-shell-markdown-table-border)))))) + +(provide 'agent-shell-markdown-tests) + +;;; agent-shell-markdown-tests.el ends here From ff47dd482354ee04496a4bab6a1b78fb3e3e1efd Mon Sep 17 00:00:00 2001 From: xenodium <8107219+xenodium@users.noreply.github.com> Date: Wed, 20 May 2026 00:45:03 +0100 Subject: [PATCH 06/16] Removing cl-position-if usage --- agent-shell-markdown.el | 22 +++++++++++++++------- 1 file changed, 15 insertions(+), 7 deletions(-) diff --git a/agent-shell-markdown.el b/agent-shell-markdown.el index fbee660a..5a5a104f 100644 --- a/agent-shell-markdown.el +++ b/agent-shell-markdown.el @@ -1354,13 +1354,21 @@ Inverse of `agent-shell-markdown-table-next-cell'." DIRECTION is `:forward' or `:backward'. Signals `user-error' when there's no cell in that direction." (let* ((cells (agent-shell-markdown-table--cell-starts)) - (idx (or (cl-position-if (lambda (c) (<= c (point))) cells - :from-end t) - -1)) - (target (if (eq direction :forward) (1+ idx) (1- idx)))) - (if (and cells (<= 0 target) (< target (length cells))) - (goto-char (nth target cells)) - (user-error "No more cells left")))) + ;; Largest cell-start index whose position is <= point — the + ;; cell currently containing point. -1 means point is before + ;; the first cell. CELLS is sorted ascending so we just walk + ;; it tracking the last index that still satisfies the bound. + (point-pos (point)) + (current -1) + (i 0)) + (dolist (c cells) + (when (<= c point-pos) + (setq current i)) + (setq i (1+ i))) + (let ((target (if (eq direction :forward) (1+ current) (1- current)))) + (if (and cells (<= 0 target) (< target (length cells))) + (goto-char (nth target cells)) + (user-error "No more cells left"))))) (defun agent-shell-markdown-table--cell-starts () "Return a sorted list of cell-start positions in the table at point. From 448592b5541737a11aff949f303808e22d009e8a Mon Sep 17 00:00:00 2001 From: xenodium <8107219+xenodium@users.noreply.github.com> Date: Wed, 20 May 2026 16:41:10 +0100 Subject: [PATCH 07/16] Favor map.el --- agent-shell-markdown.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/agent-shell-markdown.el b/agent-shell-markdown.el index 5a5a104f..18667a22 100644 --- a/agent-shell-markdown.el +++ b/agent-shell-markdown.el @@ -1464,7 +1464,8 @@ LANG is case-folded and trimmed; `agent-shell-markdown-language-mapping' is consulted for aliases before the `-mode' suffix is appended." (when (and lang (not (string-empty-p (string-trim lang)))) (let* ((normalized (downcase (string-trim lang))) - (resolved (or (cdr (assoc normalized agent-shell-markdown-language-mapping)) + (resolved (or (map-elt agent-shell-markdown-language-mapping + normalized nil #'equal) normalized)) (mode (intern (concat resolved "-mode")))) (when (fboundp mode) From a3b3b137bc37f0bb6e59416dfcd94b605942c481 Mon Sep 17 00:00:00 2001 From: xenodium <8107219+xenodium@users.noreply.github.com> Date: Sun, 17 May 2026 16:48:31 +0100 Subject: [PATCH 08/16] Initial markdown-text integration --- agent-shell.el | 40 ++++++++++++++++++++++++++++++++++------ 1 file changed, 34 insertions(+), 6 deletions(-) diff --git a/agent-shell.el b/agent-shell.el index 2ca70982..a1dfbeb7 100644 --- a/agent-shell.el +++ b/agent-shell.el @@ -49,6 +49,7 @@ (require 'map) (unless (require 'markdown-overlays nil 'noerror) (error "Please update 'shell-maker' to v0.91.2 or newer")) +(require 'markdown-text nil :noerror) (require 'agent-shell-anthropic) (require 'agent-shell-auggie) (require 'agent-shell-cline) @@ -98,6 +99,33 @@ ;; lexical bindings (which would not affect `auto-insert' behavior). (defvar auto-insert) +(defvar agent-shell--experimental-renderer nil + "When non-nil, render markdown via `markdown-text'. + +Internal/experimental. `markdown-text' replaces markup +characters with propertized text in place (no overlays), which +avoids the redisplay overhead of large overlay counts but +destroys the source markdown. Defaults to nil (keep current +`markdown-overlays' behaviour). + +Has no effect when `markdown-text' isn't installed.") + +(defun agent-shell--render-markdown () + "Render markdown in current (narrowed) buffer. + +Dispatches to `markdown-text-replace-markup' when +`agent-shell--experimental-renderer' is non-nil and the package +is loadable; otherwise falls back to `markdown-overlays-put'. + +`markdown-overlays-*' config bindings around the call still apply +in the overlay branch; they're intentionally ignored by +`markdown-text', which always highlights blocks and renders +resolvable images." + (if (and agent-shell--experimental-renderer + (fboundp 'markdown-text-replace-markup)) + (markdown-text-replace-markup) + (markdown-overlays-put))) + (defcustom agent-shell-permission-icon "⚠" "Icon displayed when shell commands require permission to execute. @@ -3031,7 +3059,7 @@ by default, RENDER-BODY-IMAGES to enable inline image rendering in body." (narrow-to-region body-start body-end) (let ((markdown-overlays-highlight-blocks agent-shell-highlight-blocks) (markdown-overlays-render-images render-body-images)) - (markdown-overlays-put)))) + (agent-shell--render-markdown)))) ;; Note: For now, we're skipping applying markdown overlays ;; on left labels as they currently carry propertized text ;; for statuses (ie. boxed). @@ -3043,7 +3071,7 @@ by default, RENDER-BODY-IMAGES to enable inline image rendering in body." (narrow-to-region label-right-start label-right-end) (let ((markdown-overlays-highlight-blocks agent-shell-highlight-blocks) (markdown-overlays-render-images nil)) - (markdown-overlays-put)))) + (agent-shell--render-markdown)))) (when auto-scroll (goto-char (point-max))))))) (with-current-buffer (map-elt state :buffer) @@ -3089,7 +3117,7 @@ by default, RENDER-BODY-IMAGES to enable inline image rendering in body." (body-end (map-nested-elt range '(:body :end)))) (narrow-to-region body-start body-end) (let ((markdown-overlays-highlight-blocks agent-shell-highlight-blocks)) - (markdown-overlays-put)) + (agent-shell--render-markdown)) (widen)) ;; ;; Note: For now, we're skipping applying markdown overlays @@ -3101,7 +3129,7 @@ by default, RENDER-BODY-IMAGES to enable inline image rendering in body." (label-right-end (map-nested-elt range '(:label-right :end)))) (narrow-to-region label-right-start label-right-end) (let ((markdown-overlays-highlight-blocks agent-shell-highlight-blocks)) - (markdown-overlays-put)) + (agent-shell--render-markdown)) (widen))) (run-hook-with-args 'agent-shell-section-functions range))) (unless auto-scroll @@ -5313,7 +5341,7 @@ inserted into the shell buffer prompt." ```" (with-current-buffer output-buffer (buffer-string)))))) (let ((markdown-overlays-highlight-blocks agent-shell-highlight-blocks)) - (markdown-overlays-put)) + (agent-shell--render-markdown)) (when (buffer-live-p output-buffer) (kill-buffer output-buffer))))))) (set-process-query-on-exit-flag proc nil) @@ -6051,7 +6079,7 @@ Returns an alist with insertion details or nil otherwise: (narrow-to-region insert-start insert-end) (let ((markdown-overlays-highlight-blocks agent-shell-highlight-blocks) (markdown-overlays-render-images nil)) - (markdown-overlays-put)))) + (agent-shell--render-markdown)))) (when submit (shell-maker-submit))) `((:buffer . ,shell-buffer) From 658f3a987e0aa08b4ece2c10eac322245204ef99 Mon Sep 17 00:00:00 2001 From: xenodium <8107219+xenodium@users.noreply.github.com> Date: Sun, 17 May 2026 18:29:50 +0100 Subject: [PATCH 09/16] Getting rid of cache to avoid regeneration. Always append. --- agent-shell-ui.el | 406 +++++++++++++++++++++++++++++++--------------- 1 file changed, 271 insertions(+), 135 deletions(-) diff --git a/agent-shell-ui.el b/agent-shell-ui.el index 74e3e36a..4cd066c6 100644 --- a/agent-shell-ui.el +++ b/agent-shell-ui.el @@ -37,10 +37,6 @@ (require 'subr-x) (require 'text-property-search) -(defvar-local agent-shell-ui--content-store nil - "A hash table used to save sui content like body. -This avoids duplicating body content in text properties which is more costly.") - (cl-defun agent-shell-ui-make-fragment-model (&key (namespace-id "global") (block-id "1") label-left label-right body) "Create a fragment model alist. NAMESPACE-ID, BLOCK-ID, LABEL-LEFT, LABEL-RIGHT, and BODY are the keys." @@ -69,131 +65,288 @@ When NAVIGATION is `always', block is always TAB navigatable. When EXPANDED is non-nil, body will be expanded by default. When NO-UNDO is non-nil, disable undo recording for this operation. -For existing blocks, the current expansion state is preserved unless overridden." - (let* ((inhibit-read-only t) - (buffer-undo-list (if no-undo t buffer-undo-list)) - (window (get-buffer-window (current-buffer))) - (saved-point (point)) - (saved-mark (mark t)) - (saved-mark-active mark-active) - (saved-window-start (and window (window-start window))) - (namespace-id (map-elt model :namespace-id)) - (qualified-id (format "%s-%s" namespace-id (map-elt model :block-id))) - (new-label-left (map-elt model :label-left)) - (new-label-right (map-elt model :label-right)) - (new-body (map-elt model :body)) - (block-start nil) - (padding-start nil) - (padding-end nil) - (match (save-mark-and-excursion - (goto-char (point-max)) - (text-property-search-backward - 'agent-shell-ui-state nil - (lambda (_ state) - (equal (map-elt state :qualified-id) qualified-id)) - t)))) +For existing blocks, the current expansion state is preserved unless overridden. + +Updates to existing blocks are applied surgically per section: a body +append inserts the new chunk at the end of the body region without +disturbing already-rendered content, so `markdown-text' frozen ranges +stay intact and streaming append is O(new-chunk) rather than +O(accumulated-body). Label-only updates leave the body untouched." + (let* ((window (get-buffer-window (current-buffer))) + (saved-window-start (and window (window-start window)))) (unwind-protect - (progn - (when (or new-label-left new-label-right new-body) - (when match - (goto-char (prop-match-beginning match))) - (if (and match (not create-new)) - ;; Found existing block - delete and regenerate - (let* ((existing-model (agent-shell-ui--read-fragment-at-point)) - (state (get-text-property (point) 'agent-shell-ui-state)) - (existing-body (map-elt existing-model :body)) + (save-mark-and-excursion + (let* ((inhibit-read-only t) + (buffer-undo-list (if no-undo t buffer-undo-list)) + (namespace-id (map-elt model :namespace-id)) + (qualified-id (format "%s-%s" namespace-id (map-elt model :block-id))) + (new-label-left (map-elt model :label-left)) + (new-label-right (map-elt model :label-right)) + (new-body (map-elt model :body)) + (block-start nil) + (padding-start nil) + (padding-end nil) + (match (save-mark-and-excursion + (goto-char (point-max)) + (text-property-search-backward + 'agent-shell-ui-state nil + (lambda (_ state) + (equal (map-elt state :qualified-id) qualified-id)) + t)))) + (when (or new-label-left new-label-right new-body) + (cond + ;; Existing block — apply surgical edits per changed section. + ((and match (not create-new)) + (let* ((state (get-text-property (prop-match-beginning match) + 'agent-shell-ui-state)) + (collapsed (map-elt state :collapsed)) (block-end (prop-match-end match)) - (final-body (if new-body - (if (and append existing-body) - (concat existing-body new-body) - new-body) - existing-body)) - (final-model (list (cons :namespace-id namespace-id) - (cons :block-id (map-elt model :block-id)) - (cons :label-left (or new-label-left - (map-elt existing-model :label-left))) - (cons :label-right (or new-label-right - (map-elt existing-model :label-right))) - (cons :body final-body)))) + (existing-body-range + (agent-shell-ui--nearest-range-matching-property + :property 'agent-shell-ui-section :value 'body + :from (prop-match-beginning match) + :to block-end))) (setq block-start (prop-match-beginning match)) - - ;; Safely replace existing block using narrow-to-region (save-excursion (goto-char block-start) (skip-chars-backward "\n") (setq padding-start (point))) - - ;; Replace block - (delete-region block-start block-end) - (goto-char block-start) - (agent-shell-ui--insert-fragment final-model qualified-id - (not (map-elt state :collapsed)) - navigation) - (setq padding-end (point))) - - ;; Not found or create-new - insert new block - (goto-char (point-max)) - (setq padding-start (point)) - (agent-shell-ui--insert-read-only (agent-shell-ui--required-newlines 2)) - (setq block-start (point)) - (agent-shell-ui--insert-fragment model qualified-id expanded navigation) - (agent-shell-ui--insert-read-only "\n\n") - (setq padding-end (point)))) - (when on-post-process - (funcall on-post-process)) - (when-let ((block-range (agent-shell-ui--block-range :position block-start))) - (list (cons :block block-range) - (cons :body (agent-shell-ui--nearest-range-matching-property - :property 'agent-shell-ui-section :value 'body - :from (map-elt block-range :start) - :to (map-elt block-range :end))) - (cons :label-left (agent-shell-ui--nearest-range-matching-property - :property 'agent-shell-ui-section :value 'label-left - :from (map-elt block-range :start) - :to (map-elt block-range :end))) - (cons :label-right (agent-shell-ui--nearest-range-matching-property - :property 'agent-shell-ui-section :value 'label-right - :from (map-elt block-range :start) - :to (map-elt block-range :end))) - (cons :padding (when (and padding-start padding-end) - (list (cons :start padding-start) - (cons :end padding-end))))))) - (goto-char saved-point) - (when saved-mark - (set-marker (mark-marker) saved-mark)) - (setq mark-active saved-mark-active) + (when new-label-left + (agent-shell-ui--surgical-replace-label + qualified-id 'label-left new-label-left)) + (when new-label-right + (agent-shell-ui--surgical-replace-label + qualified-id 'label-right new-label-right)) + (when new-body + (cond + ;; Append to existing body — preserves rendered content. + ((and append existing-body-range) + (agent-shell-ui--surgical-append-body + existing-body-range new-body qualified-id collapsed)) + ;; Replace existing body in place. + (existing-body-range + (agent-shell-ui--surgical-replace-body + existing-body-range new-body qualified-id collapsed)) + ;; Body arriving for the first time on a labels-only + ;; block — fall back to delete-and-regenerate so the + ;; indicator transitions from placeholder to triangle + ;; and the labels↔body separator is inserted. Labels + ;; are recovered from the buffer (no cache). + (t + (let* ((existing-labels + (agent-shell-ui--read-fragment-labels + (prop-match-beginning match) block-end)) + (final-model + (list (cons :namespace-id namespace-id) + (cons :block-id (map-elt model :block-id)) + (cons :label-left + (or new-label-left + (map-elt existing-labels :label-left))) + (cons :label-right + (or new-label-right + (map-elt existing-labels :label-right))) + (cons :body new-body)))) + (delete-region block-start block-end) + (goto-char block-start) + (agent-shell-ui--insert-fragment + final-model qualified-id (not collapsed) navigation))))) + (setq padding-end + (or (when-let ((block-range + (agent-shell-ui--block-range :position block-start))) + (map-elt block-range :end)) + (point))))) + ;; New block. + (t + (goto-char (point-max)) + (setq padding-start (point)) + (agent-shell-ui--insert-read-only (agent-shell-ui--required-newlines 2)) + (setq block-start (point)) + (agent-shell-ui--insert-fragment model qualified-id expanded navigation) + (agent-shell-ui--insert-read-only "\n\n") + (setq padding-end (point))))) + (when on-post-process + (funcall on-post-process)) + (when-let ((block-range (agent-shell-ui--block-range :position block-start))) + (list (cons :block block-range) + (cons :body (agent-shell-ui--nearest-range-matching-property + :property 'agent-shell-ui-section :value 'body + :from (map-elt block-range :start) + :to (map-elt block-range :end))) + (cons :label-left (agent-shell-ui--nearest-range-matching-property + :property 'agent-shell-ui-section :value 'label-left + :from (map-elt block-range :start) + :to (map-elt block-range :end))) + (cons :label-right (agent-shell-ui--nearest-range-matching-property + :property 'agent-shell-ui-section :value 'label-right + :from (map-elt block-range :start) + :to (map-elt block-range :end))) + (cons :padding (when (and padding-start padding-end) + (list (cons :start padding-start) + (cons :end padding-end)))))))) (when window (set-window-start window saved-window-start t))))) +(defun agent-shell-ui--read-fragment-labels (block-start block-end) + "Return alist with :label-left and :label-right strings (no properties). +Reads from the buffer between BLOCK-START and BLOCK-END. Used only by +the body-arriving-on-labels-only fallback in `agent-shell-ui-update-fragment'. +Labels are short, prop-free strings — safe to round-trip through the +buffer." + (let (fields) + (when-let ((range (agent-shell-ui--nearest-range-matching-property + :property 'agent-shell-ui-section :value 'label-right + :from block-start :to block-end))) + (push (cons :label-right + (buffer-substring-no-properties (map-elt range :start) + (map-elt range :end))) + fields)) + (when-let ((range (agent-shell-ui--nearest-range-matching-property + :property 'agent-shell-ui-section :value 'label-left + :from block-start :to block-end))) + (push (cons :label-left + (buffer-substring-no-properties (map-elt range :start) + (map-elt range :end))) + fields)) + fields)) + +(defun agent-shell-ui--apply-body-section-properties (start end qualified-id state body-invisible) + "Apply body-section text properties to chars in [START, END). +QUALIFIED-ID and STATE feed the help-echo and agent-shell-ui-state +properties. BODY-INVISIBLE non-nil means the existing body region +is currently hidden (collapsed label-ful fragment); new chars must +match. Explicit `invisible' assignment overrides any value the +new chars might have inherited via rear-stickiness from preceding +trailing-whitespace chars." + (add-text-properties start end + `(agent-shell-ui-section body + help-echo ,qualified-id + read-only t + front-sticky (read-only))) + (when state + (put-text-property start end 'agent-shell-ui-state state)) + (put-text-property start end 'invisible (if body-invisible t nil))) + +(defun agent-shell-ui--body-invisible-p (body-start body-end) + "Return non-nil if the existing body region [BODY-START, BODY-END) is hidden. +Inspects the `invisible' property on the first non-whitespace char. +Trailing whitespace alone is always hidden even on visible bodies, +so checking the first body char would misclassify whitespace-leading +bodies." + (save-excursion + (goto-char body-start) + (and (re-search-forward "[^ \t\n]" body-end t) + (eq (get-text-property (1- (point)) 'invisible) t)))) + +(defun agent-shell-ui--apply-trailing-whitespace-invisible (body-start body-end) + "Hide trailing whitespace within [BODY-START, BODY-END) via invisible property. +Marks the hidden chars `rear-nonsticky' for `invisible' so chars later +inserted at BODY-END don't silently inherit `invisible t' from the +trailing-whitespace tail." + (save-excursion + (goto-char body-end) + (when (re-search-backward "[^ \t\n]" body-start t) + (forward-char 1) + (when (< (point) body-end) + (add-text-properties (point) body-end + '(invisible t rear-nonsticky (invisible))))))) + +(defun agent-shell-ui--surgical-append-body (body-range chunk qualified-id _collapsed) + "Insert CHUNK at the end of BODY-RANGE. +Existing body chars stay in place — `markdown-text' frozen tags +and per-char faces are preserved across streaming chunks. +Visibility for new chars is derived from the current visibility of +the existing body, not from caller-supplied state, because +label-less fragments don't follow `state :collapsed' (their bodies +stay visible regardless of how `:collapsed' was stored)." + (when (and (stringp chunk) (not (string-empty-p chunk))) + (let* ((body-start (map-elt body-range :start)) + (body-end (map-elt body-range :end)) + (state (get-text-property (max body-start (1- body-end)) + 'agent-shell-ui-state)) + (body-invisible (agent-shell-ui--body-invisible-p body-start body-end))) + ;; Trailing-whitespace invisibility on the old tail may no longer + ;; apply once the chunk lands — clear and re-derive. Only when + ;; the body is visible; for a hidden body the existing invisible + ;; spans the whole body and must stay. + (unless body-invisible + (remove-text-properties body-start body-end '(invisible nil))) + (goto-char body-end) + (let ((insert-start (point))) + (insert (agent-shell-ui--indent-text chunk " ")) + (let ((insert-end (point))) + (agent-shell-ui--apply-body-section-properties + insert-start insert-end qualified-id state body-invisible) + (agent-shell-ui--apply-trailing-whitespace-invisible + body-start insert-end)))))) + +(defun agent-shell-ui--surgical-replace-body (body-range new-body qualified-id _collapsed) + "Replace body chars in BODY-RANGE with NEW-BODY." + (let* ((body-start (map-elt body-range :start)) + (body-end (map-elt body-range :end)) + (state (get-text-property (max body-start (1- body-end)) + 'agent-shell-ui-state)) + (body-invisible (agent-shell-ui--body-invisible-p body-start body-end))) + (delete-region body-start body-end) + (goto-char body-start) + (when (and (stringp new-body) (not (string-empty-p new-body))) + (let ((trimmed new-body)) + (when (string-prefix-p "\n" trimmed) + (setq trimmed (string-trim-left trimmed "\n"))) + (when (string-suffix-p "\n\n" trimmed) + (setq trimmed (concat (string-trim-right trimmed) "\n\n"))) + (let ((insert-start (point))) + (insert (agent-shell-ui--indent-text + (string-remove-prefix " " trimmed) " ")) + (let ((insert-end (point))) + (agent-shell-ui--apply-body-section-properties + insert-start insert-end qualified-id state body-invisible) + (agent-shell-ui--apply-trailing-whitespace-invisible + insert-start insert-end))))))) + +(defun agent-shell-ui--surgical-replace-label (qualified-id section new-text) + "Replace SECTION region of fragment QUALIFIED-ID with NEW-TEXT. +SECTION is one of `label-left' or `label-right'. Other sections in +the block stay untouched." + (when (stringp new-text) + (when-let* ((block-match + (save-excursion + (goto-char (point-max)) + (text-property-search-backward + 'agent-shell-ui-state nil + (lambda (_ state) + (equal (map-elt state :qualified-id) qualified-id)) + t))) + (region + (save-excursion + (goto-char (prop-match-beginning block-match)) + (when-let ((m (text-property-search-forward + 'agent-shell-ui-section section t t))) + (when (<= (prop-match-end m) (prop-match-end block-match)) + (cons (prop-match-beginning m) + (prop-match-end m))))))) + (let* ((region-start (car region)) + (region-end (cdr region)) + (state (get-text-property region-start 'agent-shell-ui-state))) + (delete-region region-start region-end) + (goto-char region-start) + (let ((insert-start (point))) + (insert (agent-shell-ui-add-action-to-text + new-text + (lambda () + (interactive) + (agent-shell-ui-toggle-fragment-at-point)) + (lambda () + (message "Press RET to toggle")))) + (let ((insert-end (point))) + (add-text-properties insert-start insert-end + `(agent-shell-ui-section ,section + help-echo ,qualified-id + read-only t + front-sticky (read-only))) + (when state + (put-text-property insert-start insert-end + 'agent-shell-ui-state state)))))))) -(defun agent-shell-ui--read-fragment-at (position qualified-id) - "Read fragment at POSITION with QUALIFIED-ID." - (when-let ((fragment (list (cons :block-id qualified-id))) - (state (get-text-property position 'agent-shell-ui-state)) - (range (agent-shell-ui--block-range :position position))) - ;; TODO: Get rid of merging block namespace and id. - ;; Extract namespace-id from qualified-id if it contains a dash - (when (string-match "^\\(.+\\)-\\(.+\\)$" qualified-id) - (setf (map-elt fragment :namespace-id) (match-string 1 qualified-id)) - (setf (map-elt fragment :block-id) (match-string 2 qualified-id))) - (save-mark-and-excursion - (save-restriction - (narrow-to-region (map-elt range :start) - (map-elt range :end)) - (goto-char (map-elt range :start)) - (setf (map-elt fragment :collapsed) (map-elt state :collapsed)) - (when-let ((label-left (agent-shell-ui--nearest-range-matching-property - :property 'agent-shell-ui-section :value 'label-left))) - (setf (map-elt fragment :label-left) (buffer-substring (map-elt label-left :start) - (map-elt label-left :end)))) - (when-let ((label-right (agent-shell-ui--nearest-range-matching-property - :property 'agent-shell-ui-section :value 'label-right))) - (setf (map-elt fragment :label-right) (buffer-substring (map-elt label-right :start) - (map-elt label-right :end)))) - (when agent-shell-ui--content-store - (when-let ((body (gethash (concat qualified-id "-body") agent-shell-ui--content-store))) - (setf (map-elt fragment :body) body))))) - fragment)) (cl-defun agent-shell-ui-delete-fragment (&key namespace-id block-id no-undo) "Delete fragment with NAMESPACE-ID and BLOCK-ID. @@ -213,21 +366,12 @@ When NO-UNDO is non-nil, disable undo recording for this operation." (when match (let ((block-start (prop-match-beginning match)) (block-end (prop-match-end match))) - (when agent-shell-ui--content-store - (remhash qualified-id agent-shell-ui--content-store)) ;; Remove vertical space that's part of the block. (goto-char block-end) (skip-chars-forward " \t\n") (setq block-end (point)) (delete-region block-start block-end)))))) -(defun agent-shell-ui--read-fragment-at-point () - "Read fragment at point, returning model or nil if none found." - (when-let ((state (get-text-property (point) 'agent-shell-ui-state)) - (range (agent-shell-ui--block-range :position (point)))) - (agent-shell-ui--read-fragment-at (map-elt range :start) - (map-elt state :qualified-id)))) - (cl-defun agent-shell-ui--block-range (&key position) "Get block range at POSITION if found. Nil otherwise. @@ -391,17 +535,9 @@ NAVIGATION controls navigability: (when (< (point) body-end) (add-text-properties (point) body-end '(invisible t)))))) - (when body - (unless agent-shell-ui--content-store - (setq agent-shell-ui--content-store (make-hash-table :test 'equal))) - (puthash (concat qualified-id "-body") body agent-shell-ui--content-store)) (put-text-property block-start (or body-end label-right-end label-left-end) 'agent-shell-ui-state (list - ;; Note: Avoid storing chunky data in - ;; agent-shell-ui-state as it will impact performance. - ;; Use agent-shell-ui--content-store for these instances. - ;; For example, fragment body. (cons :qualified-id qualified-id) (cons :collapsed (not expanded)) (cons :navigatable (cond From 12176bd87b99f9206e90a1cd16e8d919865131ee Mon Sep 17 00:00:00 2001 From: xenodium <8107219+xenodium@users.noreply.github.com> Date: Mon, 18 May 2026 16:34:24 +0100 Subject: [PATCH 10/16] Fixes updating fragment labels --- agent-shell-ui.el | 19 +++++++++++++------ 1 file changed, 13 insertions(+), 6 deletions(-) diff --git a/agent-shell-ui.el b/agent-shell-ui.el index 4cd066c6..6ecbbf9d 100644 --- a/agent-shell-ui.el +++ b/agent-shell-ui.el @@ -100,12 +100,11 @@ O(accumulated-body). Label-only updates leave the body untouched." (let* ((state (get-text-property (prop-match-beginning match) 'agent-shell-ui-state)) (collapsed (map-elt state :collapsed)) - (block-end (prop-match-end match)) (existing-body-range (agent-shell-ui--nearest-range-matching-property :property 'agent-shell-ui-section :value 'body :from (prop-match-beginning match) - :to block-end))) + :to (prop-match-end match)))) (setq block-start (prop-match-beginning match)) (save-excursion (goto-char block-start) @@ -131,11 +130,19 @@ O(accumulated-body). Label-only updates leave the body untouched." ;; block — fall back to delete-and-regenerate so the ;; indicator transitions from placeholder to triangle ;; and the labels↔body separator is inserted. Labels - ;; are recovered from the buffer (no cache). + ;; are recovered from the buffer (no cache). The block + ;; extent is re-derived from the buffer here because + ;; `surgical-replace-label' may have changed label + ;; length, leaving the original `prop-match-end' stale. (t - (let* ((existing-labels + (let* ((current-block-range + (agent-shell-ui--block-range :position block-start)) + (current-block-end + (or (map-elt current-block-range :end) + (prop-match-end match))) + (existing-labels (agent-shell-ui--read-fragment-labels - (prop-match-beginning match) block-end)) + block-start current-block-end)) (final-model (list (cons :namespace-id namespace-id) (cons :block-id (map-elt model :block-id)) @@ -146,7 +153,7 @@ O(accumulated-body). Label-only updates leave the body untouched." (or new-label-right (map-elt existing-labels :label-right))) (cons :body new-body)))) - (delete-region block-start block-end) + (delete-region block-start current-block-end) (goto-char block-start) (agent-shell-ui--insert-fragment final-model qualified-id (not collapsed) navigation))))) From e94aace55a2c508d0b543fe548fdd20133534845 Mon Sep 17 00:00:00 2001 From: xenodium <8107219+xenodium@users.noreply.github.com> Date: Wed, 20 May 2026 00:21:35 +0100 Subject: [PATCH 11/16] Fixing inline markup rendering regression --- agent-shell.el | 44 ++++++++++++++++++++++++-------------------- 1 file changed, 24 insertions(+), 20 deletions(-) diff --git a/agent-shell.el b/agent-shell.el index a1dfbeb7..a836467b 100644 --- a/agent-shell.el +++ b/agent-shell.el @@ -3111,26 +3111,30 @@ by default, RENDER-BODY-IMAGES to enable inline image rendering in body." ;; Marking as field to avoid false positives in ;; `agent-shell-next-item' and `agent-shell-previous-item'. (add-text-properties (or padding-start block-start) - (or padding-end block-end) '(field output))) - ;; Apply markdown overlay to body. - (when-let ((body-start (map-nested-elt range '(:body :start))) - (body-end (map-nested-elt range '(:body :end)))) - (narrow-to-region body-start body-end) - (let ((markdown-overlays-highlight-blocks agent-shell-highlight-blocks)) - (agent-shell--render-markdown)) - (widen)) - ;; - ;; Note: For now, we're skipping applying markdown overlays - ;; on left labels as they currently carry propertized text - ;; for statuses (ie. boxed). - ;; - ;; Apply markdown overlay to right label. - (when-let ((label-right-start (map-nested-elt range '(:label-right :start))) - (label-right-end (map-nested-elt range '(:label-right :end)))) - (narrow-to-region label-right-start label-right-end) - (let ((markdown-overlays-highlight-blocks agent-shell-highlight-blocks)) - (agent-shell--render-markdown)) - (widen))) + (or padding-end block-end) '(field output)) + ;; Apply markdown overlay to body. `inhibit-read-only' + ;; must wrap the render call too — chars in the body + ;; carry `read-only t' from `agent-shell-ui--insert-fragment', + ;; and `markdown-text' modifies buffer chars (unlike the + ;; overlay renderer which only adds overlays). + (when-let ((body-start (map-nested-elt range '(:body :start))) + (body-end (map-nested-elt range '(:body :end)))) + (narrow-to-region body-start body-end) + (let ((markdown-overlays-highlight-blocks agent-shell-highlight-blocks)) + (agent-shell--render-markdown)) + (widen)) + ;; + ;; Note: For now, we're skipping applying markdown overlays + ;; on left labels as they currently carry propertized text + ;; for statuses (ie. boxed). + ;; + ;; Apply markdown overlay to right label. + (when-let ((label-right-start (map-nested-elt range '(:label-right :start))) + (label-right-end (map-nested-elt range '(:label-right :end)))) + (narrow-to-region label-right-start label-right-end) + (let ((markdown-overlays-highlight-blocks agent-shell-highlight-blocks)) + (agent-shell--render-markdown)) + (widen)))) (run-hook-with-args 'agent-shell-section-functions range))) (unless auto-scroll (goto-char saved-point) From 41cc5e705957d03c573e1c0ad68f657b16886e02 Mon Sep 17 00:00:00 2001 From: xenodium <8107219+xenodium@users.noreply.github.com> Date: Wed, 20 May 2026 00:37:33 +0100 Subject: [PATCH 12/16] Bundle experimental markdown renderer --- agent-shell-markdown.el | 1707 +++++++++++++++++++++++++++ agent-shell-ui.el | 4 +- agent-shell.el | 25 +- tests/agent-shell-markdown-tests.el | 775 ++++++++++++ 4 files changed, 2495 insertions(+), 16 deletions(-) create mode 100644 agent-shell-markdown.el create mode 100644 tests/agent-shell-markdown-tests.el diff --git a/agent-shell-markdown.el b/agent-shell-markdown.el new file mode 100644 index 00000000..fbee660a --- /dev/null +++ b/agent-shell-markdown.el @@ -0,0 +1,1707 @@ +;;; agent-shell-markdown.el --- Replace Markdown markup with propertized text -*- lexical-binding: t -*- + +;; Copyright (C) 2026 Alvaro Ramirez + +;; Author: Alvaro Ramirez https://xenodium.com +;; URL: https://github.com/xenodium/agent-shell + +;; This package is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; This package is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: +;; +;; Convert a Markdown string into propertized text: +;; +;; (agent-shell-markdown-convert "hello **world**") +;; +;; Or rewrite the current buffer in place: +;; +;; (agent-shell-markdown-replace-markup) +;; +;; Both remove the markup characters and leave behind face text +;; properties. Supported markup: +;; +;; bold `**X**' / `__X__' face `agent-shell-markdown-bold' +;; italic `*X*' / `_X_' face `agent-shell-markdown-italic' +;; strike `~~X~~' face `agent-shell-markdown-strikethrough' +;; header `# X' .. `###### X' face `agent-shell-markdown-header-1' .. `-6' +;; inline code `` `X` `` face `agent-shell-markdown-inline-code' +;; link `[title](url)' face `agent-shell-markdown-link', keymap opens URL +;; image `![alt](url)' `display' property carries image +;; image path bare image path on a line same as `![alt](url)' (no markup) +;; divider `---' / `***' / `___' rendered as an underlined rule line +;; fenced code ```LANG\nX\n``` body syntax-highlighted via LANG mode +;; tables `| A | B |' grid rows rendered with aligned columns, +;; unicode borders, header/zebra rows +;; and wrap-to-window-width support +;; +;; All agent-shell-markdown-* faces inherit from the conventional faces +;; (`bold', `italic', `org-level-N', etc.) so default rendering is +;; unchanged, while still letting users customize markdown output +;; without disturbing the source faces elsewhere. +;; +;; Open / streaming fenced blocks (no closing fence yet) are +;; left alone so their contents stay protected as the buffer +;; grows. + +;;; Code: + +(eval-when-compile + (require 'cl-lib)) +(require 'map) +(require 'seq) +(require 'org-faces) +(require 'url-parse) +(require 'url-util) + +(defgroup agent-shell-markdown nil + "Render Markdown text into propertized form." + :group 'text) + +(defface agent-shell-markdown-bold + '((t :inherit bold)) + "Face for bold text rendered by `agent-shell-markdown-convert'." + :group 'agent-shell-markdown) + +(defface agent-shell-markdown-italic + '((t :inherit italic)) + "Face for italic text rendered by `agent-shell-markdown-convert'." + :group 'agent-shell-markdown) + +(defface agent-shell-markdown-strikethrough + '((t :strike-through t)) + "Face for strikethrough text rendered by `agent-shell-markdown-convert'." + :group 'agent-shell-markdown) + +(defface agent-shell-markdown-inline-code + '((t :inherit font-lock-doc-markup-face)) + "Face for inline code rendered by `agent-shell-markdown-convert'." + :group 'agent-shell-markdown) + +(defface agent-shell-markdown-link + '((t :inherit link)) + "Face for link titles rendered by `agent-shell-markdown-convert'." + :group 'agent-shell-markdown) + +(defface agent-shell-markdown-header-1 + '((t :inherit org-level-1)) + "Face for level-1 headers rendered by `agent-shell-markdown-convert'." + :group 'agent-shell-markdown) + +(defface agent-shell-markdown-header-2 + '((t :inherit org-level-2)) + "Face for level-2 headers rendered by `agent-shell-markdown-convert'." + :group 'agent-shell-markdown) + +(defface agent-shell-markdown-header-3 + '((t :inherit org-level-3)) + "Face for level-3 headers rendered by `agent-shell-markdown-convert'." + :group 'agent-shell-markdown) + +(defface agent-shell-markdown-header-4 + '((t :inherit org-level-4)) + "Face for level-4 headers rendered by `agent-shell-markdown-convert'." + :group 'agent-shell-markdown) + +(defface agent-shell-markdown-header-5 + '((t :inherit org-level-5)) + "Face for level-5 headers rendered by `agent-shell-markdown-convert'." + :group 'agent-shell-markdown) + +(defface agent-shell-markdown-header-6 + '((t :inherit org-level-6)) + "Face for level-6 headers rendered by `agent-shell-markdown-convert'." + :group 'agent-shell-markdown) + +(defface agent-shell-markdown-table-header + '((t :inherit bold)) + "Face for table header row content." + :group 'agent-shell-markdown) + +(defface agent-shell-markdown-table-border + '((t :inherit font-lock-comment-face)) + "Face for table borders (pipes and dashes)." + :group 'agent-shell-markdown) + +(defface agent-shell-markdown-table-zebra + '((t :inherit lazy-highlight)) + "Face for alternating (zebra) data rows in tables." + :group 'agent-shell-markdown) + +(defvar agent-shell-markdown-image-max-width 0.4 + "Maximum width for inline images rendered from `![alt](url)'. +An integer is taken as pixels. A float between 0 and 1 is a +ratio of the window body width.") + +(defvar agent-shell-markdown-prettify-tables t + "When non-nil, render markdown tables with aligned columns.") + +(defvar agent-shell-markdown-table-use-unicode-borders t + "When non-nil, use Unicode box-drawing chars (│ ─ ┼ ├ ┤) for borders. +When nil, fall back to ASCII pipes and dashes.") + +(defvar agent-shell-markdown-table-wrap-columns t + "When non-nil, wrap table columns to fit within window width.") + +(defvar agent-shell-markdown-table-max-width-fraction 0.9 + "Fraction of window width to use as max table width when wrapping.") + +(defvar agent-shell-markdown-table-zebra-stripe t + "When non-nil, alternate row backgrounds in tables for readability.") + +(defvar agent-shell-markdown-language-mapping + '(("elisp" . "emacs-lisp") + ("objective-c" . "objc") + ("objectivec" . "objc") + ("cpp" . "c++")) + "Map of fenced-block language aliases to Emacs major mode prefixes. +Keys are lower-case language names as written after the opening +backticks; values are the corresponding Emacs mode prefix (the +`-mode' suffix is appended internally). Example: + + (\"elisp\" . \"emacs-lisp\") ; ```elisp -> emacs-lisp-mode") + +(cl-defun agent-shell-markdown-convert (markdown) + "Convert MARKDOWN string into propertized text. + +Bold, italic, strikethrough, headers, and inline code are +rendered as text properties on the inner text; the markup +characters are removed. See `agent-shell-markdown-replace-markup' for +the in-buffer equivalent. + +For example: + + (agent-shell-markdown-convert \"_my_ **text**\") + => #(\"my text\" 0 2 (face italic) 3 7 (face bold))" + (with-temp-buffer + (insert markdown) + (agent-shell-markdown-replace-markup) + (buffer-string))) + +(cl-defun agent-shell-markdown-replace-markup () + "Replace Markdown markup in current buffer with propertized text. + +Rewrites the buffer in place: markup characters are removed and +the remaining text carries face properties. Faces compose, so a +span nested inside another type ends up with all applicable +faces. + +Markup inside fenced code blocks and inline code spans is left +alone. Streaming-friendly: an unclosed fence protects the rest +of the buffer, an unclosed inline backtick protects the rest of +its line, and incomplete bold/italic/strike spans are skipped +until their closing delimiter arrives. + +Italic, bold, and strike passes loop until a full round makes no +changes, so adjacent delimiters peel one layer per round +(e.g. `**_X_**' resolves in two rounds). Headers, inline code, +links, images, bare image-path lines, dividers, source-block +styling, and table styling run once after the loop." + (save-excursion + (let* ((source-ranges (agent-shell-markdown--make-markers + (agent-shell-markdown--source-block-ranges))) + (rendered-ranges (agent-shell-markdown--make-markers + (agent-shell-markdown--frozen-ranges))) + (inline-ranges (agent-shell-markdown--make-markers + (agent-shell-markdown--inline-code-ranges + :avoid-ranges (append source-ranges rendered-ranges)))) + (avoid-ranges (append source-ranges rendered-ranges inline-ranges))) + (while (let ((italic-changed (agent-shell-markdown--replace-italics + :avoid-ranges avoid-ranges)) + (bold-changed (agent-shell-markdown--replace-bolds + :avoid-ranges avoid-ranges)) + (strike-changed (agent-shell-markdown--replace-strikethroughs + :avoid-ranges avoid-ranges))) + (or italic-changed bold-changed strike-changed))) + (agent-shell-markdown--replace-headers :avoid-ranges avoid-ranges) + (agent-shell-markdown--style-inline-code :avoid-ranges source-ranges) + (agent-shell-markdown--replace-links :avoid-ranges avoid-ranges) + (agent-shell-markdown--replace-images :avoid-ranges avoid-ranges) + (agent-shell-markdown--replace-image-file-paths :avoid-ranges avoid-ranges) + (agent-shell-markdown--style-dividers :avoid-ranges avoid-ranges) + (agent-shell-markdown--style-source-blocks) + ;; Tables run last so cell content has already been processed by + ;; every other pass (bold, italic, links, inline code, etc.). + ;; The cell parser respects face and `agent-shell-markdown-frozen' so it + ;; doesn't mis-split on pipes that got swallowed by other markup. + ;; AVOID-RANGES protects content inside still-open fenced blocks + ;; (where the closing fence hasn't streamed in yet) — without it + ;; a table inside a code block would render eagerly and the + ;; fences would then strip out, leaving a rendered table. + (agent-shell-markdown--style-tables :avoid-ranges source-ranges) + ;; Mirror every `face' we composed onto `font-lock-face' so our + ;; styling survives `font-lock-mode' re-fontification — comint + ;; / shell-maker / agent-shell buffers fontify on every output + ;; chunk and would otherwise clear our `face' properties. + (agent-shell-markdown--mirror-face-to-font-lock-face (point-min) + (point-max))))) + +(cl-defun agent-shell-markdown--replace-bolds (&key avoid-ranges) + "Replace `**X**' / `__X__' spans in current buffer with bold X. + +Markup characters are deleted; remaining inner text carries face +`agent-shell-markdown-bold' layered on top of any existing face +properties. Spans that fall inside any of AVOID-RANGES are left +untouched. Returns non-nil if at least one replacement was made. + +For example, the buffer \"hello **world**.\" becomes \"hello +world.\" with face `agent-shell-markdown-bold' on \"world\"." + (let ((case-fold-search nil) + (changed nil)) + (goto-char (point-min)) + (while (re-search-forward + (rx (or line-start (syntax whitespace)) + (group + (or (seq "**" (group (one-or-more (not (any "\n*")))) "**") + (seq "__" (group (one-or-more (not (any "\n_")))) "__"))) + (or (syntax punctuation) (syntax whitespace) line-end)) + nil t) + (let ((markup-start (match-beginning 1)) + (markup-end (match-end 1)) + (text (buffer-substring (or (match-beginning 2) (match-beginning 3)) + (or (match-end 2) (match-end 3))))) + (unless (agent-shell-markdown--in-avoid-range-p markup-start markup-end avoid-ranges) + (delete-region markup-start markup-end) + (goto-char markup-start) + (insert text) + (add-face-text-property markup-start + (+ markup-start (length text)) + 'agent-shell-markdown-bold) + (setq changed t)))) + changed)) + +(cl-defun agent-shell-markdown--replace-italics (&key avoid-ranges) + "Replace `*X*' / `_X_' spans in current buffer with italic X. + +Markup characters are deleted; remaining inner text carries face +`agent-shell-markdown-italic' layered on top of any existing face +properties. Spans that fall inside any of AVOID-RANGES are left +untouched. Returns non-nil if at least one replacement was made. + +For example, the buffer \"hello *world*.\" becomes \"hello +world.\" with face `agent-shell-markdown-italic' on \"world\"." + (let ((case-fold-search nil) + (changed nil)) + (goto-char (point-min)) + (while (re-search-forward + (rx (or (group (or bol (one-or-more (any "\n \t"))) + (group "*") + (group (one-or-more (not (any "\n*")))) "*") + (group (or bol (one-or-more (any "\n \t"))) + (group "_") + (group (one-or-more (not (any "\n_")))) "_"))) + nil t) + (let ((markup-start (or (match-beginning 2) (match-beginning 5))) + (markup-end (match-end 0)) + (text (buffer-substring (or (match-beginning 3) (match-beginning 6)) + (or (match-end 3) (match-end 6))))) + (unless (agent-shell-markdown--in-avoid-range-p markup-start markup-end avoid-ranges) + (delete-region markup-start markup-end) + (goto-char markup-start) + (insert text) + (add-face-text-property markup-start + (+ markup-start (length text)) + 'agent-shell-markdown-italic) + (setq changed t)))) + changed)) + +(cl-defun agent-shell-markdown--replace-strikethroughs (&key avoid-ranges) + "Replace `~~X~~' spans in current buffer with strike-through-faced X. + +Markup characters are deleted; remaining inner text carries face +`agent-shell-markdown-strikethrough' layered on top of any existing face +properties. Spans inside any of AVOID-RANGES are left untouched. +Returns non-nil if at least one replacement was made. + +For example, the buffer \"a ~~b~~ c\" becomes \"a b c\" with face +`agent-shell-markdown-strikethrough' on \"b\"." + (let ((case-fold-search nil) + (changed nil)) + (goto-char (point-min)) + (while (re-search-forward + (rx "~~" (group (one-or-more (not (any "\n~")))) "~~") + nil t) + (let ((markup-start (match-beginning 0)) + (markup-end (match-end 0)) + (text (buffer-substring (match-beginning 1) (match-end 1)))) + (unless (agent-shell-markdown--in-avoid-range-p markup-start markup-end avoid-ranges) + (delete-region markup-start markup-end) + (goto-char markup-start) + (insert text) + (add-face-text-property markup-start + (+ markup-start (length text)) + 'agent-shell-markdown-strikethrough) + (setq changed t)))) + changed)) + +(cl-defun agent-shell-markdown--replace-headers (&key avoid-ranges) + "Replace `# X' / `## X' / ... headers with X faced as `org-level-N'. + +The `#' prefix and one or more separator spaces are stripped; the +title text is left with face `agent-shell-markdown-header-N' where N is +the number of `#' characters clamped to 1..6. Headers inside any +of AVOID-RANGES are left untouched. + +For example, the buffer \"## My title\" becomes \"My title\" with +face `agent-shell-markdown-header-2'." + (let ((case-fold-search nil)) + (goto-char (point-min)) + (while (re-search-forward + (rx bol (zero-or-more blank) (group (one-or-more "#")) + (one-or-more blank) + (group (one-or-more (not (any "\n")))) eol) + nil t) + (let ((markup-start (match-beginning 0)) + (markup-end (match-end 0)) + (level (- (match-end 1) (match-beginning 1))) + (text (buffer-substring (match-beginning 2) (match-end 2)))) + (unless (agent-shell-markdown--in-avoid-range-p markup-start markup-end avoid-ranges) + (delete-region markup-start markup-end) + (goto-char markup-start) + (insert text) + (add-face-text-property markup-start + (+ markup-start (length text)) + (intern (format "agent-shell-markdown-header-%d" + (min (max level 1) 6))))))))) + +(cl-defun agent-shell-markdown--style-inline-code (&key avoid-ranges) + "Strip backticks from complete inline `X` spans and face the body. + +The body of each well-formed `` `X` `` is left in place with +face `agent-shell-markdown-inline-code' and tagged with the text +property `agent-shell-markdown-frozen t' so it is never re-processed +on subsequent calls (the body can legitimately contain +markdown-looking chars like `**' once the surrounding backticks +are gone). Spans inside any of AVOID-RANGES (typically fenced +code blocks) are left untouched. + +For example, the buffer \"a `code` b\" becomes \"a code b\" with +face `agent-shell-markdown-inline-code' on \"code\"." + (let ((case-fold-search nil)) + (goto-char (point-min)) + (while (re-search-forward "`\\([^`\n]+\\)`" nil t) + (let ((markup-start (match-beginning 0)) + (markup-end (match-end 0)) + (text (buffer-substring (match-beginning 1) (match-end 1)))) + (unless (agent-shell-markdown--in-avoid-range-p markup-start markup-end avoid-ranges) + (delete-region markup-start markup-end) + (goto-char markup-start) + (insert text) + (let ((end (+ markup-start (length text)))) + (add-face-text-property markup-start end 'agent-shell-markdown-inline-code) + (add-text-properties markup-start end + '(agent-shell-markdown-frozen t + rear-nonsticky (agent-shell-markdown-frozen))))))))) + +(cl-defun agent-shell-markdown--replace-links (&key avoid-ranges) + "Replace `[title](url)' markup with title faced as link. + +The bracket/parenthesis markup is stripped; the title is left +with face `agent-shell-markdown-link' and a keymap text property that +opens the URL on RET or mouse-1. Matches preceded by `!' (the +image syntax) are skipped, as are links inside any of +AVOID-RANGES. + +For example, the buffer \"see [docs](https://example.com)\" +becomes \"see docs\" with face `agent-shell-markdown-link' on \"docs\" +and a keymap that opens the URL." + (let ((case-fold-search nil)) + (goto-char (point-min)) + (while (re-search-forward + (rx "[" + (group (one-or-more (not (any "]")))) + "]" + "(" + (group (one-or-more (not (any ")")))) + ")") + nil t) + (let ((markup-start (match-beginning 0)) + (markup-end (match-end 0)) + (title (buffer-substring (match-beginning 1) (match-end 1))) + (url (buffer-substring-no-properties (match-beginning 2) (match-end 2)))) + (unless (or (eq (char-before markup-start) ?!) + (agent-shell-markdown--in-avoid-range-p markup-start markup-end avoid-ranges)) + (delete-region markup-start markup-end) + (goto-char markup-start) + (insert title) + (let ((end (+ markup-start (length title)))) + (add-face-text-property markup-start end 'agent-shell-markdown-link) + (put-text-property markup-start end 'keymap + (agent-shell-markdown--make-ret-binding-map + (lambda () (interactive) + (agent-shell-markdown--open-link url)))) + (put-text-property markup-start end 'mouse-face 'highlight))))))) + +(cl-defun agent-shell-markdown--replace-images (&key avoid-ranges) + "Replace `![alt](url)' image markup with displayed images. + +If URL resolves to an existing local file that is image-supported +and a graphical display is available, the full markup is replaced +by the alt text (or a single space if alt is empty) carrying a +`display' property with the image and a keymap that opens the +file on RET or mouse-1. Otherwise the markup is left untouched. +Images inside any of AVOID-RANGES are left alone. + +For example, the buffer \"see ![logo](logo.png)\" becomes +\"see logo\" with the image shown in place of \"logo\"." + (let ((case-fold-search nil)) + (goto-char (point-min)) + (while (re-search-forward + (rx "!" + "[" + (group (zero-or-more (not (any "]")))) + "]" + "(" + (group (one-or-more (not (any ")")))) + ")") + nil t) + (let* ((markup-start (match-beginning 0)) + (markup-end (match-end 0)) + (alt (buffer-substring-no-properties (match-beginning 1) (match-end 1))) + (url (buffer-substring-no-properties (match-beginning 2) (match-end 2))) + (path (agent-shell-markdown--resolve-image-url url))) + (when (and path + (image-supported-file-p path) + (display-graphic-p) + (not (agent-shell-markdown--in-avoid-range-p + markup-start markup-end avoid-ranges))) + (let ((image (create-image path nil nil + :max-width (agent-shell-markdown--image-max-width))) + (placeholder (if (string-empty-p alt) " " alt))) + (image-flush image) + (delete-region markup-start markup-end) + (goto-char markup-start) + (insert placeholder) + (let ((end (+ markup-start (length placeholder)))) + (put-text-property markup-start end 'display image) + (put-text-property markup-start end 'keymap + (agent-shell-markdown--make-ret-binding-map + (lambda () (interactive) + (find-file path)))) + (put-text-property markup-start end 'mouse-face 'highlight)))))))) + +(cl-defun agent-shell-markdown--replace-image-file-paths (&key avoid-ranges) + "Render bare image-path lines as displayed images. + +A line that is solely a local path or `file://' URI ending in a +supported image extension is treated like an `![alt](url)' image: +when the path resolves to an existing image-supported file and a +graphical display is available, the line text is left in place +carrying a `display' property with the image and a keymap that +opens the file. Lines inside any of AVOID-RANGES are left +untouched, as are unresolvable paths. + +For example, a buffer line containing just `/abs/path/img.png' +renders the image in place of that text." + (let* ((case-fold-search t) + (ext-re (regexp-opt image-file-name-extensions)) + (regex (concat "^[ \t]*\\(\\(?:file://\\|[/~.]\\)[^ \t\n]*\\." + ext-re + "\\)[ \t]*$"))) + (goto-char (point-min)) + (while (re-search-forward regex nil t) + (let* ((line-start (match-beginning 0)) + (line-end (match-end 0)) + (path-start (match-beginning 1)) + (path-end (match-end 1)) + (raw (buffer-substring-no-properties path-start path-end)) + (resolved (agent-shell-markdown--resolve-image-url raw))) + (when (and resolved + (image-supported-file-p resolved) + (display-graphic-p) + (not (agent-shell-markdown--in-avoid-range-p + line-start line-end avoid-ranges))) + (let ((image (create-image resolved nil nil + :max-width (agent-shell-markdown--image-max-width)))) + (image-flush image) + (put-text-property path-start path-end 'display image) + (put-text-property path-start path-end 'keymap + (agent-shell-markdown--make-ret-binding-map + (lambda () (interactive) + (find-file resolved)))) + (put-text-property path-start path-end 'mouse-face 'highlight) + (add-text-properties path-start path-end + '(agent-shell-markdown-frozen t + rear-nonsticky (agent-shell-markdown-frozen))))))))) + +(cl-defun agent-shell-markdown--style-dividers (&key avoid-ranges) + "Render `---' / `***' / `___' horizontal-rule lines as styled rules. + +Each line consisting of 3+ matching dash/star/underscore chars +(optionally surrounded by spaces or tabs) gets a `display' text +property that draws an underlined rule across the window, plus a +`agent-shell-markdown-frozen' tag so subsequent calls don't re-process +it. Dividers inside any of AVOID-RANGES are left untouched. + +The chars themselves remain in the buffer beneath the display +property, so the source markdown round-trips through copy/save." + (let ((case-fold-search nil)) + (goto-char (point-min)) + (while (re-search-forward + (rx bol (zero-or-more blank) + (or (seq "***" (zero-or-more "*")) + (seq "---" (zero-or-more "-")) + (seq "___" (zero-or-more "_"))) + (zero-or-more blank) eol) + nil t) + (let ((rule-start (match-beginning 0)) + (rule-end (match-end 0))) + (unless (agent-shell-markdown--in-avoid-range-p rule-start rule-end avoid-ranges) + (add-text-properties + rule-start rule-end + (list 'display + (concat (propertize (make-string (agent-shell-markdown--display-width) ?\s) + 'face '(:underline t)) + "\n") + 'agent-shell-markdown-frozen t + 'rear-nonsticky '(display agent-shell-markdown-frozen)))))))) + +(defun agent-shell-markdown--display-width () + "Return a usable display width for divider rendering. +Tries the selected window's body width and falls back to 80 +characters when no usable window is available (e.g. batch)." + (or (ignore-errors (window-body-width)) + 80)) + +(defun agent-shell-markdown--style-source-blocks () + "Strip fenced code block markup and syntax-highlight the body. + +For each complete `\\`\\`\\`LANG' / `\\`\\`\\`' fenced block, +the opening and closing fence lines are deleted from the buffer. +The body text stays in place with face properties from LANG's +major mode (when loadable) and a `agent-shell-markdown-frozen t' text +property tagging it as rendered output. That tag is read back +as an avoid-range on subsequent calls, so the body is never +re-processed as inline markup even though its surrounding +fences are gone. + +Open / streaming fences (no closing line yet) are left alone. + +For example, the buffer: + + ```elisp + (message \"hi\") + ``` + +becomes: + + (message \"hi\") + +with `emacs-lisp-mode' face properties on the body and a +`agent-shell-markdown-frozen' tag covering those same chars." + (let ((case-fold-search nil)) + (goto-char (point-min)) + (while (re-search-forward + (rx (group bol (zero-or-more blank) "```" (zero-or-more blank) + (group (zero-or-more (or alphanumeric "-" "+" "#"))) + (zero-or-more blank) "\n") + (group (*? anychar)) + "\n" + (group bol (zero-or-more blank) "```" (zero-or-more blank) + (or "\n" eol))) + nil t) + (let* ((open-start (match-beginning 1)) + (open-end (match-end 1)) + (lang (buffer-substring-no-properties (match-beginning 2) + (match-end 2))) + (body-start (copy-marker (match-beginning 3))) + (body-end (copy-marker (match-end 3))) + (close-start (match-beginning 4)) + (close-end (match-end 4)) + (highlighted (agent-shell-markdown--highlight-code + (buffer-substring-no-properties body-start body-end) + lang))) + ;; Delete in reverse position order so earlier offsets stay + ;; valid; body markers adjust automatically. + (delete-region close-start close-end) + (delete-region open-start open-end) + (agent-shell-markdown--apply-faces-from highlighted + (marker-position body-start)) + (add-text-properties body-start body-end + '(agent-shell-markdown-frozen t + rear-nonsticky (agent-shell-markdown-frozen))))))) + +(defconst agent-shell-markdown--table-line-regexp + (rx line-start + (zero-or-more (any " \t")) + "|" + (one-or-more (not (any "\n"))) + "|" + (zero-or-more (any " \t")) + line-end) + "Regexp matching a single line of a markdown table.") + +(defconst agent-shell-markdown--table-separator-regexp + (rx line-start + (zero-or-more (any " \t")) + "|" + (one-or-more (or "-" ":" "|" " " "\t")) + "|" + (zero-or-more (any " \t")) + line-end) + "Regexp matching a table separator row (e.g. `|---|---|').") + +(cl-defun agent-shell-markdown--find-tables (&key avoid-ranges) + "Return tables to (re-)render in current buffer. + +Each element is an alist with keys :start, :end (the region to +replace), and :source (the markdown table source — a propertized +string — that should be rendered into that region). + +Two flavours of region are collected: + + - Pure ASCII tables: 2 or more consecutive `|...|' lines, not + in a frozen region. A `|---|...' separator row is optional + — when present it splits header from data; when absent all + rows are rendered as data. + + - Rendered table + extension: a previously-rendered table + carries its original source on each char via the + `agent-shell-markdown-table-source' property. Chars immediately + after the rendered region are folded back in: characters up + to the next `\\n' are continuation of the rendered table's + last source row (i.e. a chunk boundary that split a row mid- + cell), and any complete `|...|' lines that follow extend the + table with new rows. The combined source is stashed and the + region is re-rendered. + +A rendered table with no extension is skipped — re-rendering +unchanged source is a no-op." + ;; agent-shell tags its body chars with `field output' while the + ;; `\\n's between rows may not carry the same field value; without + ;; this binding, `forward-line' / `line-end-position' would stop at + ;; those field boundaries and silently truncate table rows. + (let ((inhibit-field-text-motion t) + (tables '()) + (pos (point-min))) + (save-excursion + (while (< pos (point-max)) + (goto-char pos) + (cond + ((get-text-property pos 'agent-shell-markdown-table-source) + (let* ((stashed (get-text-property pos 'agent-shell-markdown-table-source)) + (rendered-end (or (next-single-property-change + pos 'agent-shell-markdown-table-source + nil (point-max)) + (point-max))) + (trailing-end rendered-end)) + ;; Scan forward from rendered-end accumulating chars that + ;; extend the rendered table: first any continuation chars + ;; on the same physical line (a chunk boundary that split + ;; a row mid-cell), then complete table rows after the + ;; next `\n'. Both kinds end up in one substring that + ;; `concat'-ing onto STASHED yields valid markdown, + ;; because the trailing substring's own `\n's handle the + ;; row boundaries. + (save-excursion + (goto-char rendered-end) + (when (and (< (point) (point-max)) + (not (eq (char-after) ?\n))) + (end-of-line) + (setq trailing-end (point))) + (when (and (< (point) (point-max)) + (eq (char-after) ?\n)) + (forward-char 1) + (while (and (not (eobp)) + (looking-at agent-shell-markdown--table-line-regexp) + (not (get-text-property (point) + 'agent-shell-markdown-frozen)) + (not (agent-shell-markdown--in-avoid-range-p + (point) (line-end-position) avoid-ranges))) + (setq trailing-end (line-end-position)) + (forward-line 1)))) + (if (> trailing-end rendered-end) + (let ((combined (concat stashed + (buffer-substring rendered-end + trailing-end)))) + (push `((:start . ,pos) + (:end . ,trailing-end) + (:source . ,combined)) + tables) + (setq pos trailing-end)) + ;; Nothing to fold — re-rendering unchanged source would + ;; be a no-op, so skip past the rendered region. + (setq pos rendered-end)))) + ((and (looking-at agent-shell-markdown--table-line-regexp) + (not (get-text-property pos 'agent-shell-markdown-frozen)) + (not (agent-shell-markdown--in-avoid-range-p pos pos avoid-ranges))) + (let ((table-start pos) + (table-end nil) + (row-count 0)) + ;; Greedily consume rows that match the table regex. Mid- + ;; stream chunk boundaries that split a row are handled by + ;; the streaming-extension branch above, which folds + ;; continuation chars back into the rendered table's last + ;; row on the next render. AVOID-RANGES (e.g. an open + ;; fenced block whose closing fence hasn't streamed in + ;; yet) keeps the contained rows raw. + (while (and (not (eobp)) + (looking-at agent-shell-markdown--table-line-regexp) + (not (get-text-property (point) + 'agent-shell-markdown-frozen)) + (not (agent-shell-markdown--in-avoid-range-p + (point) (line-end-position) avoid-ranges))) + (setq table-end (line-end-position)) + (setq row-count (1+ row-count)) + (forward-line 1)) + ;; >=2 pipe rows is enough to render; a separator + ;; (`|---|...') is not required. When present it splits + ;; header from data (and styles the header). When absent + ;; all rows are data. + (when (>= row-count 2) + (push `((:start . ,table-start) + (:end . ,table-end) + (:source . ,(buffer-substring table-start table-end))) + tables)) + (setq pos (or table-end (1+ pos))))) + (t (setq pos (1+ pos)))))) + (nreverse tables))) + +(defun agent-shell-markdown--parse-table-row (start end) + "Parse table row from START to END into cells. + +Returns a list of alists with :start, :end, :content for each +cell, where :content carries any text properties applied by the +earlier passes (bold, italic, inline-code, link, etc.). + +A `|' is treated as a cell separator unless it (a) is preceded by +a `\\' escape, or (b) carries `agent-shell-markdown-frozen' — in which +case it lives inside a region one of our passes has already +rendered (e.g. inline-code body containing a literal `|') and +isn't a real delimiter. We deliberately don't check `face' so +that pipes faced by external font-lock (markdown-mode, etc.) +are still parsed as cell separators." + (let ((cells '())) + (save-excursion + (goto-char start) + (when (looking-at (rx (zero-or-more (any " \t")) "|")) + (goto-char (match-end 0))) + (let ((cell-start (point))) + (while (< (point) end) + (if (re-search-forward (rx (any "|\\")) end t) + (let ((ch (char-before)) + (pipe-pos (1- (point)))) + (cond + ((and (eq ch ?|) + (not (get-text-property pipe-pos + 'agent-shell-markdown-frozen))) + (let ((cell-end pipe-pos)) + (push `((:start . ,cell-start) + (:end . ,cell-end) + (:content . ,(string-trim + (buffer-substring + cell-start cell-end)))) + cells) + (setq cell-start (point)))) + ((eq ch ?\\) + (when (< (point) end) (forward-char 1))))) + (goto-char end))))) + (nreverse cells))) + +(defvar-local agent-shell-markdown--table-char-pixel-cache nil + "Cons cell (FONT-WIDTH . SPACE-PIXELS). +Caches the rendered pixel width of a single space in the buffer; +invalidated when the font width changes (e.g. text scaling). +Stored in the destination buffer (the one displayed in the +window passed to the measurement helpers), so cache lookups are +per-destination.") + +(defun agent-shell-markdown--table-measure-string (str window) + "Return real pixel width of STR rendered at point-max of WINDOW's buffer. + +Briefly inserts STR, measures with `window-text-pixel-size', and +deletes; `inhibit-modification-hooks' and the modified flag are +preserved so callers never observe the mutation." + (with-current-buffer (window-buffer window) + (let ((inhibit-read-only t) + (inhibit-modification-hooks t) + (modified (buffer-modified-p)) + real) + (save-excursion + (goto-char (point-max)) + (let ((m (point-marker))) + (set-marker-insertion-type m nil) + (insert str) + (setq real (car (window-text-pixel-size window m (point)))) + (delete-region m (point)) + (set-marker m nil))) + (set-buffer-modified-p modified) + real))) + +(defun agent-shell-markdown--table-char-pixel-width (window) + "Return real pixel width of a single space in WINDOW, cached. +Cache lives in the destination buffer and is invalidated when +its font width changes." + (with-current-buffer (window-buffer window) + (let ((fw (window-font-width window))) + (if (and agent-shell-markdown--table-char-pixel-cache + (= fw (car agent-shell-markdown--table-char-pixel-cache))) + (cdr agent-shell-markdown--table-char-pixel-cache) + (let ((sw (agent-shell-markdown--table-measure-string " " window))) + (setq agent-shell-markdown--table-char-pixel-cache (cons fw sw)) + sw))))) + +(defun agent-shell-markdown--table-needs-pixel-p (str) + "Return non-nil if STR contains chars that `string-width' miscounts. +Specifically: + - U+200D ZERO WIDTH JOINER, which combines surrounding emoji into + one rendered glyph (family / profession sequences). + - U+1F1E6 .. U+1F1FF REGIONAL INDICATOR SYMBOLs, which pair into + a single flag glyph. + +For these sequences `string-width' sums the codepoint widths but +the glyph renders narrower, so column sizing must fall back to +`window-text-pixel-size'. ASCII, CJK, and single-codepoint emoji +are correctly measured by `string-width' and skip the pixel path." + (let ((i 0) + (len (length str)) + (found nil)) + (while (and (not found) (< i len)) + (let ((c (aref str i))) + (when (or (= c #x200D) + (and (>= c #x1F1E6) (<= c #x1F1FF))) + (setq found t))) + (setq i (1+ i))) + found)) + +(cl-defun agent-shell-markdown--table-display-width (&key str window) + "Return display width of STR in character units. + +Uses `string-width' for the vast majority of content — ASCII, CJK, +and single-codepoint emoji are all measured correctly by it. +Falls back to `window-text-pixel-size' only for sequences that +`string-width' miscounts (ZWJ compound emoji, regional-indicator +flag pairs); see `agent-shell-markdown--table-needs-pixel-p'." + (if (and window + (window-live-p window) + (fboundp 'window-text-pixel-size) + (display-graphic-p) + (agent-shell-markdown--table-needs-pixel-p str)) + (condition-case nil + (let ((char-px (agent-shell-markdown--table-char-pixel-width window)) + (real-px (agent-shell-markdown--table-measure-string str window))) + (ceiling (/ (float real-px) char-px))) + (error (string-width str))) + (string-width str))) + +(cl-defun agent-shell-markdown--table-longest-word (&key str window) + "Return display width of longest word in STR. +Uses `agent-shell-markdown--table-display-width' so non-ASCII words +get accurate measurement when WINDOW is given." + (if (or (null str) (string-empty-p str)) + 0 + (let ((words (split-string str "[ \t\n]+" t))) + (if words + (apply #'max + (mapcar (lambda (w) + (agent-shell-markdown--table-display-width + :str w :window window)) + words)) + 0)))) + +(defun agent-shell-markdown--table-total-width (widths) + "Return total rendered width for a table with column WIDTHS. +Accounts for borders and padding (`| X | Y |' = 2 padding + +1 pipe per column, plus one leading pipe)." + (+ 1 (seq-reduce (lambda (acc w) (+ acc w 3)) widths 0))) + +(defun agent-shell-markdown--table-allocate-widths (natural-widths min-widths target) + "Shrink NATURAL-WIDTHS proportionally to fit TARGET, respecting MIN-WIDTHS." + (let* ((total (agent-shell-markdown--table-total-width natural-widths)) + (excess (- total target))) + (if (<= excess 0) + natural-widths + (let* ((shrinkable (seq-mapn (lambda (w m) (max 0 (- w m))) + natural-widths min-widths)) + (total-shrinkable (seq-reduce #'+ shrinkable 0))) + (if (<= total-shrinkable 0) + min-widths + (let ((ratio (min 1.0 (/ (float excess) total-shrinkable)))) + (seq-mapn (lambda (w m s) + (max m (floor (- w (* s ratio))))) + natural-widths min-widths shrinkable))))))) + +(defun agent-shell-markdown--table-wrap-text (text width) + "Wrap TEXT to fit within WIDTH, returning a list of lines. +Preserves text properties across wrapped lines." + (cond + ((or (null text) (string-empty-p text)) (list "")) + ((<= (string-width text) width) (list text)) + (t + (let ((lines '()) + (pos 0) + (len (length text))) + (while (< pos len) + ;; Greedily consume chars until adding the next one would + ;; exceed WIDTH. + (let ((end-pos pos) + (line-width 0)) + (while (and (< end-pos len) + (<= (+ line-width (char-width (aref text end-pos))) + width)) + (setq line-width (+ line-width (char-width (aref text end-pos)))) + (setq end-pos (1+ end-pos))) + ;; Make sure at least one char advances even when the very + ;; first char already exceeds WIDTH (e.g. wide glyph). + (when (= end-pos pos) + (setq end-pos (1+ pos))) + ;; Try to break at the last whitespace within [pos, end-pos). + (let ((break-pos end-pos)) + (when (< end-pos len) + (let ((scan (1- end-pos))) + (while (and (> scan pos) + (not (memq (aref text scan) '(?\s ?\t)))) + (setq scan (1- scan))) + (when (> scan pos) + (setq break-pos (1+ scan))))) + (push (string-trim-right (substring text pos break-pos)) lines) + (setq pos break-pos) + (while (and (< pos len) + (memq (aref text pos) '(?\s ?\t))) + (setq pos (1+ pos)))))) + (nreverse lines))))) + +(cl-defun agent-shell-markdown--pad-table-string (&key str width window) + "Pad STR with spaces to reach WIDTH columns. + +`string-width' is reliable for ASCII, CJK, and single-codepoint +emoji, so the cheap padding path is taken for almost all content. +The pixel-accurate `display'-space path runs only for strings +flagged by `agent-shell-markdown--table-needs-pixel-p' (ZWJ compound +emoji, regional-indicator flag pairs) where `string-width' would +otherwise miscount and the column right-border would drift." + (if (and window + (window-live-p window) + (fboundp 'window-text-pixel-size) + (display-graphic-p) + (agent-shell-markdown--table-needs-pixel-p str)) + (condition-case nil + (let* ((char-px (agent-shell-markdown--table-char-pixel-width window)) + (target-px (* width char-px)) + (content-px (agent-shell-markdown--table-measure-string str window)) + (pad-px (- target-px content-px))) + (if (<= pad-px 0) + str + (let* ((full-spaces (floor (/ (float pad-px) char-px))) + (remaining-px (- pad-px (* full-spaces char-px)))) + (concat str + (make-string full-spaces ?\s) + (if (> remaining-px 0) + (propertize " " 'display + `(space :width (,remaining-px))) + ""))))) + (error (agent-shell-markdown--pad-table-string-ascii :str str :width width))) + (agent-shell-markdown--pad-table-string-ascii :str str :width width))) + +(cl-defun agent-shell-markdown--pad-table-string-ascii (&key str width) + "ASCII / fallback padding: append plain spaces to reach WIDTH columns." + (let ((current (string-width str))) + (if (>= current width) + str + (concat str (make-string (- width current) ?\s))))) + +(defun agent-shell-markdown--make-table-separator-cell (width) + "Return a separator-cell string of WIDTH dashes." + (make-string width + (if agent-shell-markdown-table-use-unicode-borders ?─ ?-))) + +(defun agent-shell-markdown--render-table-separator-row (col-widths) + "Build the rendered separator line for COL-WIDTHS." + (let ((pipe (if agent-shell-markdown-table-use-unicode-borders "┼" "|")) + (left (if agent-shell-markdown-table-use-unicode-borders "├" "|")) + (right (if agent-shell-markdown-table-use-unicode-borders "┤" "|"))) + (concat + (propertize left 'face 'agent-shell-markdown-table-border) + (mapconcat + (lambda (w) + (propertize (agent-shell-markdown--make-table-separator-cell (+ w 2)) + 'face 'agent-shell-markdown-table-border)) + col-widths + (propertize pipe 'face 'agent-shell-markdown-table-border)) + (propertize right 'face 'agent-shell-markdown-table-border)))) + +(cl-defun agent-shell-markdown--render-table-data-row (&key processed-cells col-widths row-face window) + "Build the rendered string for a data row, possibly multi-line. + +PROCESSED-CELLS is the list of propertized cell strings. +COL-WIDTHS is the list of column widths. ROW-FACE, when non-nil, +is layered on top of the row content (preserving inline faces). +WINDOW, when given, is forwarded to `agent-shell-markdown--pad-table-string' +for pixel-accurate padding of non-ASCII content. + +Each cell on the first physical line of a wrapped row carries +`agent-shell-markdown-table-cell-start' on its leading padding char so +`agent-shell-markdown-table-next-cell' / `-previous-cell' can navigate +logical rows (skipping the visual continuation lines)." + (let* ((pipe (if agent-shell-markdown-table-use-unicode-borders "│" "|")) + (styled-pipe (propertize pipe 'face 'agent-shell-markdown-table-border)) + (wrapped (seq-mapn + (lambda (cell width) + (agent-shell-markdown--table-wrap-text cell width)) + processed-cells col-widths)) + (max-lines (apply #'max 1 (mapcar #'length wrapped))) + (lines '())) + (dotimes (line-idx max-lines) + (let ((parts '())) + (seq-mapn + (lambda (cell-lines width) + (let* ((line (if (< line-idx (length cell-lines)) + (nth line-idx cell-lines) + "")) + (padded (concat " " + (agent-shell-markdown--pad-table-string + :str line :width width :window window) + " "))) + (when row-face + (add-face-text-property 0 (length padded) row-face t padded)) + ;; Mark first physical line of each cell as navigable — + ;; continuation lines of a wrapped row aren't standalone + ;; cells. Tag the first content char (index 1, past the + ;; leading padding space) so navigation lands cursor on + ;; the content rather than the border-adjacent space. + (when (and (zerop line-idx) (> (length padded) 1)) + (put-text-property 1 2 'agent-shell-markdown-table-cell-start t padded)) + (push padded parts))) + wrapped col-widths) + (push (concat styled-pipe + (string-join (nreverse parts) styled-pipe) + styled-pipe) + lines))) + (mapconcat #'identity (nreverse lines) "\n"))) + +(cl-defun agent-shell-markdown--preprocess-table (&key rows window) + "Parse cells in ROWS and compute natural column widths. +Returns a plist with :natural-widths and :processed-rows. + +`:min-widths' (wrap-allocation widths from longest words) is no +longer computed here — it's only needed when the table has to be +allocated narrower than its natural total, and computing it for +every cell on every render is a substantial cost. Callers that +need it should use `agent-shell-markdown--table-min-widths'. + +When WINDOW is given, cell widths are measured with +pixel-accurate `agent-shell-markdown--table-display-width' so columns +containing emoji/CJK line up with the column's right border." + (let ((widths nil) + (processed-rows nil)) + (dolist (row rows) + (if (map-elt row :separator) + (push (cons row nil) processed-rows) + (let ((cells (agent-shell-markdown--parse-table-row + (map-elt row :start) (map-elt row :end))) + (col 0) + (processed-cells nil)) + (dolist (cell cells) + (let* ((processed (map-elt cell :content)) + (dw (agent-shell-markdown--table-display-width + :str processed :window window))) + (push processed processed-cells) + (if (nth col widths) + (setf (nth col widths) (max (nth col widths) dw)) + (setq widths (append widths (list dw)))) + (setq col (1+ col)))) + (push (cons row (nreverse processed-cells)) processed-rows)))) + (list :natural-widths widths + :processed-rows (nreverse processed-rows)))) + +(cl-defun agent-shell-markdown--table-min-widths (&key processed-rows window) + "Return the minimum (longest-word) widths per column. +Called only when a table needs to be allocated narrower than its +natural total — see `agent-shell-markdown--render-table-source'." + (let ((min-widths nil)) + (dolist (entry processed-rows) + (let ((cells (cdr entry)) + (col 0)) + (dolist (processed cells) + (let ((mw (agent-shell-markdown--table-longest-word + :str processed :window window))) + (if (nth col min-widths) + (setf (nth col min-widths) (max (nth col min-widths) mw)) + (setq min-widths (append min-widths (list mw)))) + (setq col (1+ col)))))) + min-widths)) + +(defun agent-shell-markdown--render-table (table) + "Render TABLE by replacing [:start, :end] with the rendered :source. + +The rendered chars carry: + - `agent-shell-markdown-frozen t' — so subsequent passes skip them. + - `agent-shell-markdown-table-source SOURCE' — the original markdown + source, stashed so a future `agent-shell-markdown-replace-markup' + call can combine it with freshly-streamed rows that arrive + right after, then re-render the whole table with updated + column widths. + +Caller-set text properties at the table's start position (e.g., +`read-only', application-specific tags like an agent-shell block +id) are also carried onto the rendered region — otherwise the +delete+insert would drop them and break callers that look up +regions by text property. + +`rear-nonsticky' prevents new chars inserted just after the +rendered region from inheriting either of our two properties." + (let* ((source (map-elt table :source)) + (table-start (map-elt table :start)) + (table-end (map-elt table :end)) + ;; Capture the destination window for pixel-accurate + ;; measurement of non-ASCII cells. This is the window into + ;; which we're rendering; the render-table-source helper + ;; forwards it through to width / padding measurement. + (window (or (get-buffer-window (current-buffer)) + (selected-window))) + (rendered (agent-shell-markdown--render-table-source + :source source :window window)) + (carried (agent-shell-markdown--carry-properties table-start))) + (delete-region table-start table-end) + (goto-char table-start) + (insert rendered) + (let ((end (+ table-start (length rendered)))) + (when carried + (add-text-properties table-start end carried)) + (add-text-properties + table-start end + `(agent-shell-markdown-frozen t + agent-shell-markdown-table-source ,source + rear-nonsticky (agent-shell-markdown-frozen + agent-shell-markdown-table-source)))))) + +(defun agent-shell-markdown--carry-properties (pos) + "Return a plist of properties at POS to carry across our delete+insert. + +Filters out properties our rendering itself sets (`face', +`agent-shell-markdown-frozen', `agent-shell-markdown-table-source', +`rear-nonsticky') so callers' application-level properties +(read-only, agent-shell block ids, etc.) survive on the rendered +output." + (let ((props (text-properties-at pos)) + (carried nil)) + (while props + (let ((key (car props)) + (val (cadr props))) + (unless (memq key '(face + agent-shell-markdown-frozen + agent-shell-markdown-table-source + rear-nonsticky)) + (setq carried (cons val (cons key carried)))) + (setq props (cddr props)))) + (nreverse carried))) + +(cl-defun agent-shell-markdown--render-table-source (&key source window) + "Render SOURCE (markdown table text) to a propertized string. + +SOURCE may carry text properties from earlier passes (bold faces +on cell content, `agent-shell-markdown-frozen' on inline-code bodies, +etc.); these are preserved through to the rendered output via +the cell parser. + +WINDOW, when given, is the destination window used for pixel- +accurate width measurement of non-ASCII cell content (emoji, +CJK) so right borders align across rows. Without it, +measurement falls back to `string-width' — fine for ASCII but +prone to a few-pixel drift on emoji-heavy tables." + (with-temp-buffer + (insert source) + ;; SOURCE inherits `field' text properties from the calling buffer + ;; (e.g. agent-shell tags chars with `field output'); inter-row + ;; `\\n's may carry different field values, which would otherwise + ;; cause `forward-line' / `line-end-position' in the parsers below + ;; to stop at field boundaries and silently drop rows. + (setq-local inhibit-field-text-motion t) + (let* ((rows (agent-shell-markdown--collect-table-rows)) + (separator-row-num (agent-shell-markdown--find-separator-row-num rows)) + (preprocessed (agent-shell-markdown--preprocess-table + :rows rows :window window)) + (natural-widths (plist-get preprocessed :natural-widths)) + (processed-rows (plist-get preprocessed :processed-rows)) + (target-width (when agent-shell-markdown-table-wrap-columns + (floor (* (agent-shell-markdown--display-width) + agent-shell-markdown-table-max-width-fraction)))) + (needs-allocation (and target-width + (> (agent-shell-markdown--table-total-width + natural-widths) + target-width))) + ;; `:min-widths' is expensive (longest-word per cell) and only + ;; consumed by allocation, which kicks in only when the + ;; natural total exceeds the target. Compute lazily. + (col-widths (if needs-allocation + (agent-shell-markdown--table-allocate-widths + natural-widths + (agent-shell-markdown--table-min-widths + :processed-rows processed-rows + :window window) + target-width) + natural-widths)) + (data-row-num 0) + (rendered-rows '())) + (dolist (entry processed-rows) + (let* ((row (car entry)) + (processed-cells (cdr entry)) + (row-num (map-elt row :num)) + (is-separator (map-elt row :separator)) + (is-header (and separator-row-num + (< row-num separator-row-num))) + (is-zebra (and agent-shell-markdown-table-zebra-stripe + (not is-header) + (not is-separator) + (= (mod data-row-num 2) 1))) + (row-face (cond + (is-header 'agent-shell-markdown-table-header) + (is-zebra 'agent-shell-markdown-table-zebra)))) + (unless (or is-header is-separator) + (setq data-row-num (1+ data-row-num))) + (push (if is-separator + (agent-shell-markdown--render-table-separator-row col-widths) + (agent-shell-markdown--render-table-data-row + :processed-cells processed-cells + :col-widths col-widths + :row-face row-face + :window window)) + rendered-rows))) + (string-join (nreverse rendered-rows) "\n")))) + +(defun agent-shell-markdown--collect-table-rows () + "Collect table rows in current buffer (typically a temp buffer). +Each row is an alist with :start, :end, :num, :separator." + (save-excursion + (goto-char (point-min)) + (let ((rows '()) + (row-num 0)) + (while (and (not (eobp)) + (looking-at agent-shell-markdown--table-line-regexp)) + (push `((:start . ,(point)) + (:end . ,(line-end-position)) + (:num . ,row-num) + (:separator . ,(looking-at + agent-shell-markdown--table-separator-regexp))) + rows) + (setq row-num (1+ row-num)) + (forward-line 1)) + (nreverse rows)))) + +(defun agent-shell-markdown--find-separator-row-num (rows) + "Return the index of the first separator row in ROWS, or nil." + (let ((idx 0) (result nil)) + (dolist (row rows) + (when (and (not result) (map-elt row :separator)) + (setq result idx)) + (setq idx (1+ idx))) + result)) + +(cl-defun agent-shell-markdown--style-tables (&key avoid-ranges) + "Render markdown tables found in current buffer. + +Each detected table has its source rows deleted from the buffer +and the prettified rendering inserted in their place; the +inserted text carries `agent-shell-markdown-frozen' so subsequent calls +skip it. Tables whose first row is already frozen — meaning +they live inside a fenced block, an inline-code body, or a +previously-rendered table — are left alone. + +AVOID-RANGES is a list of (START . END) cons cells covering +regions the renderer must not touch (e.g. still-open fenced code +blocks whose closing fence hasn't streamed in yet). + +Honours `agent-shell-markdown-prettify-tables'. Cell content is taken +directly from the buffer (with text properties preserved from +the earlier inline passes), so bold/italic/inline-code/link +rendering inside cells is provided for free." + (when agent-shell-markdown-prettify-tables + ;; Process tables in reverse so earlier positions stay valid as + ;; each replacement shifts everything after it. + (dolist (table (nreverse (agent-shell-markdown--find-tables + :avoid-ranges avoid-ranges))) + (agent-shell-markdown--render-table table)))) + +(defun agent-shell-markdown-table-next-cell () + "Move point to the start of the next table cell. +Wraps from the end of a row to the first cell of the next row. +Skips the separator row. Signals `No more cells left' when +point is at or past the last cell of the table at point. + +For example, with point inside cell `A' of: + + │ A │ B │ + ├───┼───┤ + │ 1 │ 2 │ + +a single call lands point on `B', another lands on `1', another +on `2', and a fourth signals `No more cells left'." + (interactive) + (agent-shell-markdown-table--move-cell :forward)) + +(defun agent-shell-markdown-table-previous-cell () + "Move point to the start of the previous table cell. +Wraps from the start of a row to the last cell of the previous +row. Skips the separator row. Signals `No more cells left' +when point is at or before the first cell of the table at point. + +Inverse of `agent-shell-markdown-table-next-cell'." + (interactive) + (agent-shell-markdown-table--move-cell :backward)) + +(defun agent-shell-markdown-table--move-cell (direction) + "Move point to the next or previous cell in the table at point. +DIRECTION is `:forward' or `:backward'. Signals `user-error' when +there's no cell in that direction." + (let* ((cells (agent-shell-markdown-table--cell-starts)) + (idx (or (cl-position-if (lambda (c) (<= c (point))) cells + :from-end t) + -1)) + (target (if (eq direction :forward) (1+ idx) (1- idx)))) + (if (and cells (<= 0 target) (< target (length cells))) + (goto-char (nth target cells)) + (user-error "No more cells left")))) + +(defun agent-shell-markdown-table--cell-starts () + "Return a sorted list of cell-start positions in the table at point. +Returns nil when point isn't inside a rendered agent-shell-markdown +table. Navigable cells are tagged by the renderer with the +`agent-shell-markdown-table-cell-start' text property, so separator rows +and continuation lines of wrapped rows are skipped automatically." + (when-let ((region (agent-shell-markdown-table--region-at-point))) + (let ((positions nil)) + (save-excursion + (save-restriction + (narrow-to-region (car region) (cdr region)) + (goto-char (point-min)) + (while (let ((m (text-property-search-forward + 'agent-shell-markdown-table-cell-start t t))) + (when m + (push (prop-match-beginning m) positions) + t))))) + (nreverse positions)))) + +(defun agent-shell-markdown-table--region-at-point () + "Return (START . END) of the rendered table at point, or nil." + (when (get-text-property (point) 'agent-shell-markdown-table-source) + (cons (or (previous-single-property-change + (1+ (point)) 'agent-shell-markdown-table-source nil (point-min)) + (point-min)) + (or (next-single-property-change + (point) 'agent-shell-markdown-table-source nil (point-max)) + (point-max))))) + +(defun agent-shell-markdown--apply-faces-from (propertized buffer-start) + "Copy `face' properties from PROPERTIZED string to chars at BUFFER-START.. + +Chars in PROPERTIZED without a `face' property cause the +corresponding buffer chars' `face' to be cleared, so re-running +on an already-highlighted body is idempotent." + (let ((pos 0) + (len (length propertized))) + (while (< pos len) + (let ((face (get-text-property pos 'face propertized)) + (next (or (next-single-property-change pos 'face propertized) len))) + (put-text-property (+ buffer-start pos) (+ buffer-start next) + 'face face) + (setq pos next))))) + +(defun agent-shell-markdown--mirror-face-to-font-lock-face (start end) + "Copy each `face' run across [START, END) to `font-lock-face'. + +`font-lock-mode' takes ownership of the `face' property and +clears it on re-fontification, which would wipe out our markup +styling in buffers that fontify continuously (comint, shell-maker, +agent-shell, etc.). `font-lock-face' is the property reserved +for callers who want their face to coexist — when font-lock is +on, the display engine renders `font-lock-face' as if it were +`face' and font-lock leaves it alone; when font-lock is off, +`font-lock-face' is ignored and our plain `face' renders. +Setting both means we look right in both contexts. + +Only positions with a non-nil `face' are mirrored; positions +already carrying a `font-lock-face' from elsewhere are +overwritten — agent-shell-markdown owns the styling for the chars it +produced." + (let ((pos start)) + (while (< pos end) + (let ((face (get-text-property pos 'face)) + (next (or (next-single-property-change pos 'face nil end) end))) + (when face + (put-text-property pos next 'font-lock-face face)) + (setq pos next))))) + +(defun agent-shell-markdown--highlight-code (code lang) + "Return CODE syntax-highlighted using LANG's major mode. + +LANG is a language identifier as written after the opening +fence (e.g. \"python\", \"elisp\"). When the resolved mode is +loadable, CODE is fontified in a temporary buffer and returned +with face properties applied. Otherwise CODE is returned +unchanged." + (if-let ((mode (agent-shell-markdown--resolve-lang-mode lang)) + ((fboundp mode))) + (with-temp-buffer + (insert code) + (let ((inhibit-message t) + (delay-mode-hooks t)) + (funcall mode) + (font-lock-ensure)) + (buffer-string)) + code)) + +(defun agent-shell-markdown--resolve-lang-mode (lang) + "Resolve LANG string to a major mode symbol, or nil. +LANG is case-folded and trimmed; `agent-shell-markdown-language-mapping' +is consulted for aliases before the `-mode' suffix is appended." + (when (and lang (not (string-empty-p (string-trim lang)))) + (let* ((normalized (downcase (string-trim lang))) + (resolved (or (cdr (assoc normalized agent-shell-markdown-language-mapping)) + normalized)) + (mode (intern (concat resolved "-mode")))) + (when (fboundp mode) + mode)))) + +(defun agent-shell-markdown--make-ret-binding-map (fun) + "Return a sparse keymap binding RET and mouse-1 to FUN." + (let ((map (make-sparse-keymap))) + (define-key map (kbd "RET") fun) + (define-key map [mouse-1] fun) + (define-key map [remap self-insert-command] 'ignore) + map)) + +(defun agent-shell-markdown--open-link (url) + "Open URL. Use local navigation for file links, `browse-url' otherwise." + (unless (agent-shell-markdown--open-local-link url) + (browse-url url))) + +(defun agent-shell-markdown--open-local-link (url) + "Open URL as a local file link if possible. +Return non-nil if handled, nil otherwise." + (when-let ((parsed (agent-shell-markdown--parse-local-link url))) + (find-file (car parsed)) + (when (cdr parsed) + (goto-char (point-min)) + (forward-line (1- (cdr parsed)))) + t)) + +(defun agent-shell-markdown--parse-local-link (url) + "Parse URL as a local file link. +Return a (FILE . LINE) cons when URL points to an existing local +file (LINE may be nil), or nil otherwise. + +For example: + + \"foo.el#L10\" => (\"/abs/foo.el\" . 10) + \"foo.el\" => (\"/abs/foo.el\" . nil) + \"file:src/bar.el:5\" => (\"/abs/src/bar.el\" . 5) + \"file:///tmp/baz.el#L20\" => (\"/tmp/baz.el\" . 20) + \"https://example.com\" => nil" + (when-let ((match + (cond + ((string-match + (rx bos "file://" + (group (+? anything)) + (optional (or (seq "#L" (group (one-or-more digit))) + (seq ":" (group (one-or-more digit))))) + eos) + url) + (cons (match-string 1 url) + (or (match-string 2 url) (match-string 3 url)))) + ((string-match + (rx bos "file:" + (group (not (any "/")) (+? anything)) + (optional (or (seq "#L" (group (one-or-more digit))) + (seq ":" (group (one-or-more digit))))) + eos) + url) + (cons (match-string 1 url) + (or (match-string 2 url) (match-string 3 url)))) + ((string-match + (rx bos + (group (? (optional "/") alpha ":/") + (one-or-more (not (any ":#")))) + "#L" (group (one-or-more digit)) + eos) + url) + (cons (match-string 1 url) (match-string 2 url))) + ((string-match + (rx bos + (group (? (optional "/") alpha ":/") + (one-or-more (not (any ":#")))) + ":" (group (one-or-more digit)) + eos) + url) + (cons (match-string 1 url) (match-string 2 url))) + ((not (string-empty-p url)) + (cons url nil)))) + (filepath (expand-file-name (car match)))) + (when (file-exists-p filepath) + (cons filepath + (when (cdr match) + (string-to-number (cdr match))))))) + +(defun agent-shell-markdown--resolve-image-url (url) + "Resolve image URL to an absolute local file path, or nil. +Handles file:// URIs, absolute paths, and paths starting with +`~/', `./', or `../'." + (when-let* ((path (cond + ((string-prefix-p "file://" url) + (url-unhex-string + (url-filename (url-generic-parse-url url)))) + ((string-prefix-p "file:" url) + (substring url (length "file:"))) + ((or (file-name-absolute-p url) + (string-prefix-p "~" url) + (string-prefix-p "./" url) + (string-prefix-p "../" url)) + url))) + (expanded (expand-file-name path)) + ((file-exists-p expanded))) + expanded)) + +(defun agent-shell-markdown--image-max-width () + "Return the maximum image width in pixels. +Resolves `agent-shell-markdown-image-max-width' which may be an integer +(pixels) or a float between 0 and 1 (ratio of window body width)." + (if (floatp agent-shell-markdown-image-max-width) + (let ((window (or (get-buffer-window (current-buffer)) + (frame-first-window)))) + (round (* agent-shell-markdown-image-max-width + (window-body-width window t)))) + agent-shell-markdown-image-max-width)) + +(defun agent-shell-markdown--make-markers (ranges) + "Convert each (start . end) in RANGES to (start-marker . end-marker)." + (mapcar (lambda (range) + (cons (copy-marker (car range)) + (copy-marker (cdr range)))) + ranges)) + +(defun agent-shell-markdown--in-avoid-range-p (start end avoid-ranges) + "Return non-nil if positions START..END are fully inside any AVOID-RANGES. + +AVOID-RANGES is a list of (start . end) cons cells; values may be +integers or markers (comparison works for both)." + (seq-find (lambda (range) + (and (>= start (car range)) + (<= end (cdr range)))) + avoid-ranges)) + +(defun agent-shell-markdown--source-block-ranges () + "Return list of (start . end) ranges covering fenced code blocks. + +Each range spans from the opening ``` line to the start of the +line after the closing ``` line. A fence that is open but not +yet closed (mid-stream) extends to `point-max', so its contents +are protected as the buffer grows. + +For example, given the buffer: + + ```python + print(\"hi\") + ``` + +returns a list with one range covering the whole block." + (let ((ranges '()) + (open nil) + (case-fold-search nil)) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward + (rx bol (zero-or-more whitespace) "```" (zero-or-more not-newline)) + nil t) + (if open + (progn + (push (cons open (line-beginning-position 2)) ranges) + (setq open nil)) + (setq open (match-beginning 0)))) + (when open + (push (cons open (point-max)) ranges))) + (nreverse ranges))) + +(defun agent-shell-markdown--frozen-ranges () + "Return ranges of buffer chars tagged `agent-shell-markdown-frozen'. + +The tag is written on rendered content whose body text could +otherwise look like markdown (e.g. inline code body or source +block body). Treating tagged ranges as avoid-ranges keeps +subsequent calls from re-processing them — important for +streaming, where the convert/replace-markup function may be +invoked many times as content grows." + (let ((ranges '()) + (pos (point-min)) + (limit (point-max))) + (while (< pos limit) + (if (get-text-property pos 'agent-shell-markdown-frozen) + (let ((end (or (next-single-property-change + pos 'agent-shell-markdown-frozen nil limit) + limit))) + (push (cons pos end) ranges) + (setq pos end)) + (setq pos (or (next-single-property-change + pos 'agent-shell-markdown-frozen nil limit) + limit)))) + (nreverse ranges))) + +(cl-defun agent-shell-markdown--inline-code-ranges (&key avoid-ranges) + "Return list of (start . end) ranges covering inline `X` bodies. + +Each range covers the text between backticks (the backticks +themselves are not included). Backticks inside any of +AVOID-RANGES are ignored. A line with an odd number of backticks +has its trailing unmatched backtick treated as still-streaming: +the range extends from that backtick to end-of-line. + +For example, given the buffer \"a `code` b\" returns a list with +one range covering the body \"code\"." + (let ((ranges '()) + (case-fold-search nil)) + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (let ((line-end (line-end-position)) + (open nil)) + (while (re-search-forward "`" line-end t) + (let ((pos (match-beginning 0))) + (unless (agent-shell-markdown--in-avoid-range-p pos pos avoid-ranges) + (if open + (progn + (push (cons (1+ open) pos) ranges) + (setq open nil)) + (setq open pos))))) + (when open + (push (cons (1+ open) line-end) ranges))) + (forward-line 1))) + (nreverse ranges))) + +(defun agent-shell-markdown--deconstruct (text) + "Return TEXT broken into (SUBSTRING FACES) runs. + +Each element is a contiguous run of characters with the same +`face' property: SUBSTRING is the run text, FACES is a list of +face symbols (a single symbol is wrapped, an unfaced run gets an +empty list). Runs are returned in left-to-right order and cover +TEXT in full. + +For example: + + (agent-shell-markdown--deconstruct (agent-shell-markdown-convert \"_my_ **text**\")) + => ((\"my\" (italic)) (\" \" nil) (\"text\" (bold)))" + (let ((runs '()) + (pos 0) + (len (length text))) + (while (< pos len) + (let ((face (get-text-property pos 'face text)) + (next (or (next-single-property-change pos 'face text) len))) + (push (list (substring-no-properties text pos next) + (cond ((null face) nil) + ((listp face) face) + (t (list face)))) + runs) + (setq pos next))) + (nreverse runs))) + +(provide 'agent-shell-markdown) + +;;; agent-shell-markdown.el ends here diff --git a/agent-shell-ui.el b/agent-shell-ui.el index 6ecbbf9d..af3876c8 100644 --- a/agent-shell-ui.el +++ b/agent-shell-ui.el @@ -69,7 +69,7 @@ For existing blocks, the current expansion state is preserved unless overridden. Updates to existing blocks are applied surgically per section: a body append inserts the new chunk at the end of the body region without -disturbing already-rendered content, so `markdown-text' frozen ranges +disturbing already-rendered content, so `agent-shell-markdown' frozen ranges stay intact and streaming append is O(new-chunk) rather than O(accumulated-body). Label-only updates leave the body untouched." (let* ((window (get-buffer-window (current-buffer))) @@ -259,7 +259,7 @@ trailing-whitespace tail." (defun agent-shell-ui--surgical-append-body (body-range chunk qualified-id _collapsed) "Insert CHUNK at the end of BODY-RANGE. -Existing body chars stay in place — `markdown-text' frozen tags +Existing body chars stay in place — `agent-shell-markdown' frozen tags and per-char faces are preserved across streaming chunks. Visibility for new chars is derived from the current visibility of the existing body, not from caller-supplied state, because diff --git a/agent-shell.el b/agent-shell.el index a836467b..98b27593 100644 --- a/agent-shell.el +++ b/agent-shell.el @@ -49,7 +49,7 @@ (require 'map) (unless (require 'markdown-overlays nil 'noerror) (error "Please update 'shell-maker' to v0.91.2 or newer")) -(require 'markdown-text nil :noerror) +(require 'agent-shell-markdown) (require 'agent-shell-anthropic) (require 'agent-shell-auggie) (require 'agent-shell-cline) @@ -100,30 +100,27 @@ (defvar auto-insert) (defvar agent-shell--experimental-renderer nil - "When non-nil, render markdown via `markdown-text'. + "When non-nil, render markdown via `agent-shell-markdown'. -Internal/experimental. `markdown-text' replaces markup +Internal/experimental. `agent-shell-markdown' replaces markup characters with propertized text in place (no overlays), which avoids the redisplay overhead of large overlay counts but destroys the source markdown. Defaults to nil (keep current -`markdown-overlays' behaviour). - -Has no effect when `markdown-text' isn't installed.") +`markdown-overlays' behaviour).") (defun agent-shell--render-markdown () "Render markdown in current (narrowed) buffer. -Dispatches to `markdown-text-replace-markup' when -`agent-shell--experimental-renderer' is non-nil and the package -is loadable; otherwise falls back to `markdown-overlays-put'. +Dispatches to `agent-shell-markdown-replace-markup' when +`agent-shell--experimental-renderer' is non-nil; otherwise falls +back to `markdown-overlays-put'. `markdown-overlays-*' config bindings around the call still apply in the overlay branch; they're intentionally ignored by -`markdown-text', which always highlights blocks and renders +`agent-shell-markdown', which always highlights blocks and renders resolvable images." - (if (and agent-shell--experimental-renderer - (fboundp 'markdown-text-replace-markup)) - (markdown-text-replace-markup) + (if agent-shell--experimental-renderer + (agent-shell-markdown-replace-markup) (markdown-overlays-put))) (defcustom agent-shell-permission-icon "⚠" @@ -3115,7 +3112,7 @@ by default, RENDER-BODY-IMAGES to enable inline image rendering in body." ;; Apply markdown overlay to body. `inhibit-read-only' ;; must wrap the render call too — chars in the body ;; carry `read-only t' from `agent-shell-ui--insert-fragment', - ;; and `markdown-text' modifies buffer chars (unlike the + ;; and `agent-shell-markdown' modifies buffer chars (unlike the ;; overlay renderer which only adds overlays). (when-let ((body-start (map-nested-elt range '(:body :start))) (body-end (map-nested-elt range '(:body :end)))) diff --git a/tests/agent-shell-markdown-tests.el b/tests/agent-shell-markdown-tests.el new file mode 100644 index 00000000..bf8326d7 --- /dev/null +++ b/tests/agent-shell-markdown-tests.el @@ -0,0 +1,775 @@ +;;; agent-shell-markdown-tests.el --- Tests for agent-shell-markdown -*- lexical-binding: t; -*- + +;;; Commentary: +;; +;; Run via: +;; +;; emacs -batch -l ert -l tests/agent-shell-markdown-tests.el \ +;; -f ert-run-tests-batch-and-exit + +;;; Code: + +(require 'cl-lib) +(require 'ert) + +(load-file (expand-file-name "../agent-shell-markdown.el" + (file-name-directory + (or load-file-name buffer-file-name)))) + +(ert-deftest agent-shell-markdown-convert-bold () + (should (equal (agent-shell-markdown--deconstruct + (agent-shell-markdown-convert "hello **world**")) + '(("hello " nil) + ("world" (agent-shell-markdown-bold)))))) + +(ert-deftest agent-shell-markdown-convert-bold-underscore () + (should (equal (agent-shell-markdown--deconstruct + (agent-shell-markdown-convert "hello __world__")) + '(("hello " nil) + ("world" (agent-shell-markdown-bold)))))) + +(ert-deftest agent-shell-markdown-convert-italic () + (should (equal (agent-shell-markdown--deconstruct + (agent-shell-markdown-convert "hello *world*")) + '(("hello " nil) + ("world" (agent-shell-markdown-italic)))))) + +(ert-deftest agent-shell-markdown-convert-italic-underscore () + (should (equal (agent-shell-markdown--deconstruct + (agent-shell-markdown-convert "hello _world_")) + '(("hello " nil) + ("world" (agent-shell-markdown-italic)))))) + +(ert-deftest agent-shell-markdown-convert-multiple () + (should (equal (agent-shell-markdown--deconstruct + (agent-shell-markdown-convert "_my_ **text**")) + '(("my" (agent-shell-markdown-italic)) + (" " nil) + ("text" (agent-shell-markdown-bold)))))) + +(ert-deftest agent-shell-markdown-convert-italic-wrapping-bold () + (should (equal (agent-shell-markdown--deconstruct + (agent-shell-markdown-convert "_**my text**_")) + '(("my text" (agent-shell-markdown-bold agent-shell-markdown-italic)))))) + +(ert-deftest agent-shell-markdown-convert-bold-wrapping-italic () + (should (equal (agent-shell-markdown--deconstruct + (agent-shell-markdown-convert "**_my text_**")) + '(("my text" (agent-shell-markdown-italic agent-shell-markdown-bold)))))) + +(ert-deftest agent-shell-markdown-convert-bold-with-inner-italic () + (should (equal (agent-shell-markdown--deconstruct + (agent-shell-markdown-convert "**outer _both_ outer**")) + '(("outer " (agent-shell-markdown-bold)) + ("both" (agent-shell-markdown-bold agent-shell-markdown-italic)) + (" outer" (agent-shell-markdown-bold)))))) + +(ert-deftest agent-shell-markdown-convert-italic-with-inner-bold () + (should (equal (agent-shell-markdown--deconstruct + (agent-shell-markdown-convert "_outer **both** outer_")) + '(("outer " (agent-shell-markdown-italic)) + ("both" (agent-shell-markdown-bold agent-shell-markdown-italic)) + (" outer" (agent-shell-markdown-italic)))))) + +(ert-deftest agent-shell-markdown-convert-no-markup () + (should (equal (agent-shell-markdown--deconstruct + (agent-shell-markdown-convert "no markup here")) + '(("no markup here" nil))))) + +(ert-deftest agent-shell-markdown-convert-empty () + (should (equal (agent-shell-markdown--deconstruct + (agent-shell-markdown-convert "")) + '()))) + +(ert-deftest agent-shell-markdown-convert-inline-code-protects-markup () + (should (equal (agent-shell-markdown--deconstruct + (agent-shell-markdown-convert + "before **b** and `**not bold**` after")) + '(("before " nil) + ("b" (agent-shell-markdown-bold)) + (" and " nil) + ("**not bold**" (agent-shell-markdown-inline-code)) + (" after" nil))))) + +(ert-deftest agent-shell-markdown-convert-inline-code () + (should (equal (agent-shell-markdown--deconstruct + (agent-shell-markdown-convert "a `code` b")) + '(("a " nil) + ("code" (agent-shell-markdown-inline-code)) + (" b" nil))))) + +(ert-deftest agent-shell-markdown-convert-strikethrough () + (should (equal (agent-shell-markdown--deconstruct + (agent-shell-markdown-convert "a ~~b~~ c")) + '(("a " nil) + ("b" (agent-shell-markdown-strikethrough)) + (" c" nil))))) + +(ert-deftest agent-shell-markdown-convert-strikethrough-wrapping-bold () + (should (equal (agent-shell-markdown--deconstruct + (agent-shell-markdown-convert "~~**bold-strike**~~")) + '(("bold-strike" (agent-shell-markdown-bold agent-shell-markdown-strikethrough)))))) + +(ert-deftest agent-shell-markdown-convert-header-level-1 () + (should (equal (agent-shell-markdown--deconstruct + (agent-shell-markdown-convert "# Title")) + '(("Title" (agent-shell-markdown-header-1)))))) + +(ert-deftest agent-shell-markdown-convert-header-level-3 () + (should (equal (agent-shell-markdown--deconstruct + (agent-shell-markdown-convert "### Title")) + '(("Title" (agent-shell-markdown-header-3)))))) + +(ert-deftest agent-shell-markdown-convert-header-with-bold () + (should (equal (agent-shell-markdown--deconstruct + (agent-shell-markdown-convert "## **Big** title")) + '(("Big" (agent-shell-markdown-header-2 agent-shell-markdown-bold)) + (" title" (agent-shell-markdown-header-2)))))) + +(ert-deftest agent-shell-markdown-convert-fenced-block-protects-markup () + (should (equal (agent-shell-markdown--deconstruct + (agent-shell-markdown-convert + "before **b** +``` +**not bold** +_not italic_ +``` +after **b2**")) + '(("before " nil) + ("b" (agent-shell-markdown-bold)) + (" +**not bold** +_not italic_ +after " nil) + ("b2" (agent-shell-markdown-bold)))))) + +(ert-deftest agent-shell-markdown-convert-open-fence-protects-rest () + (should (equal (agent-shell-markdown--deconstruct + (agent-shell-markdown-convert + "before **b** +``` +streaming **not bold**")) + '(("before " nil) + ("b" (agent-shell-markdown-bold)) + (" +``` +streaming **not bold**" nil))))) + +(ert-deftest agent-shell-markdown-convert-open-inline-code-protects-rest-of-line () + (should (equal (agent-shell-markdown--deconstruct + (agent-shell-markdown-convert + "before **b** and `streaming *not italic*")) + '(("before " nil) + ("b" (agent-shell-markdown-bold)) + (" and `streaming *not italic*" nil))))) + +(ert-deftest agent-shell-markdown-convert-incomplete-bold-untouched () + (should (equal (agent-shell-markdown--deconstruct + (agent-shell-markdown-convert + "complete **b** and incomplete **par")) + '(("complete " nil) + ("b" (agent-shell-markdown-bold)) + (" and incomplete **par" nil))))) + +(ert-deftest agent-shell-markdown-convert-link () + (should (equal (agent-shell-markdown--deconstruct + (agent-shell-markdown-convert "see [docs](https://example.com) please")) + '(("see " nil) + ("docs" (agent-shell-markdown-link)) + (" please" nil))))) + +(ert-deftest agent-shell-markdown-convert-link-with-bold-inside-untouched () + ;; Bold inside link title is left literal (mirrors markdown-overlays: + ;; bold regex requires whitespace/BOL before `**', and `[' isn't either). + (should (equal (agent-shell-markdown--deconstruct + (agent-shell-markdown-convert "[**bold**](url)")) + '(("**bold**" (agent-shell-markdown-link)))))) + +(ert-deftest agent-shell-markdown-convert-link-after-image-not-confused () + ;; `[X](Y)' inside `![X](Y)' must not be treated as a link. + (should (equal (agent-shell-markdown--deconstruct + (agent-shell-markdown-convert "![alt](missing.png)")) + '(("![alt](missing.png)" nil))))) + +(ert-deftest agent-shell-markdown-convert-image-unresolvable-untouched () + (should (equal (agent-shell-markdown--deconstruct + (agent-shell-markdown-convert "see ![alt](/no/such/file.png) end")) + '(("see ![alt](/no/such/file.png) end" nil))))) + +(ert-deftest agent-shell-markdown-convert-link-in-fenced-block-untouched () + (should (equal (agent-shell-markdown--deconstruct + (agent-shell-markdown-convert + "before [a](u) +``` +[b](v) +``` +after [c](w)")) + '(("before " nil) + ("a" (agent-shell-markdown-link)) + (" +[b](v) +after " nil) + ("c" (agent-shell-markdown-link)))))) + +(ert-deftest agent-shell-markdown-convert-source-block-no-language () + ;; Plain fenced block (no language): fences deleted, body remains + ;; (with `agent-shell-markdown-frozen t' tagged on body chars, which + ;; `--deconstruct' doesn't surface — it tracks face only). + (should (equal (agent-shell-markdown--deconstruct + (agent-shell-markdown-convert + "``` +body +```")) + '(("body +" nil))))) + +(ert-deftest agent-shell-markdown-convert-source-block-with-language () + ;; `emacs-lisp' source block: fences deleted, body chars get + ;; `emacs-lisp-mode' font-lock faces. In batch the keyword `if' + ;; is faced. (Note: the faces here come directly from the + ;; language major mode and are intentionally not wrapped in our + ;; own `agent-shell-markdown-*' faces.) + (should (equal (agent-shell-markdown--deconstruct + (agent-shell-markdown-convert + "```emacs-lisp +(if t nil) +```")) + '(("(" nil) + ("if" (font-lock-keyword-face)) + (" t nil) +" nil))))) + +(ert-deftest agent-shell-markdown-convert-source-block-body-tagged () + ;; Body chars carry `agent-shell-markdown-frozen t' so subsequent calls + ;; treat them as an avoid-range (streaming-safe). Body in the + ;; rendered output is "**not bold**" followed by a newline — the + ;; chars before that trailing newline are tagged; the newline + ;; itself is not. + (let ((s (agent-shell-markdown-convert "``` +**not bold** +```"))) + (should (eq t (get-text-property 0 'agent-shell-markdown-frozen s))) + (should (eq t (get-text-property 5 'agent-shell-markdown-frozen s))) + (should (null (get-text-property (1- (length s)) 'agent-shell-markdown-frozen s))))) + +(ert-deftest agent-shell-markdown-convert-inline-code-body-tagged () + ;; Inline code body chars are also `agent-shell-markdown-frozen t'-tagged + ;; so a stray "**X**" inside backticks stays literal on re-runs. + (let ((s (agent-shell-markdown-convert "a `**not bold**` b"))) + (should (eq t (get-text-property 2 'agent-shell-markdown-frozen s))) + (should (eq t (get-text-property 13 'agent-shell-markdown-frozen s))) + (should (null (get-text-property 0 'agent-shell-markdown-frozen s))))) + +(ert-deftest agent-shell-markdown-source-block-body-protected-across-calls () + ;; Streaming: render a block, then append more markdown and re-render. + ;; The previously-rendered body (`agent-shell-markdown-frozen t') must stay + ;; literal — its `**not bold**' must not turn into bold X on the + ;; second pass, while newly-appended `**real bold**' does. + (with-temp-buffer + (insert "``` +**not bold** +```") + (agent-shell-markdown-replace-markup) + (goto-char (point-max)) + (insert " +**real bold**") + (agent-shell-markdown-replace-markup) + (should (equal (agent-shell-markdown--deconstruct (buffer-string)) + '(("**not bold** + +" nil) + ("real bold" (agent-shell-markdown-bold))))))) + +(ert-deftest agent-shell-markdown-inline-code-body-protected-across-calls () + ;; Streaming counterpart for inline code: after the backticks + ;; are gone, body chars must not be re-bolded on a second pass. + (with-temp-buffer + (insert "a `**not bold**` b") + (agent-shell-markdown-replace-markup) + (goto-char (point-max)) + (insert " **real bold**") + (agent-shell-markdown-replace-markup) + (should (equal (agent-shell-markdown--deconstruct (buffer-string)) + '(("a " nil) + ("**not bold**" (agent-shell-markdown-inline-code)) + (" b " nil) + ("real bold" (agent-shell-markdown-bold))))))) + +(ert-deftest agent-shell-markdown-convert-divider-dashes () + ;; A `---' line gets a `display' property and `agent-shell-markdown-frozen' + ;; tag. The chars themselves stay in the buffer beneath the display. + (let ((s (agent-shell-markdown-convert "above +--- +below"))) + (should (eq t (get-text-property 6 'agent-shell-markdown-frozen s))) + (should (get-text-property 6 'display s)))) + +(ert-deftest agent-shell-markdown-convert-divider-stars () + (let ((s (agent-shell-markdown-convert "above +*** +below"))) + (should (eq t (get-text-property 6 'agent-shell-markdown-frozen s))) + (should (get-text-property 6 'display s)))) + +(ert-deftest agent-shell-markdown-convert-divider-underscores () + (let ((s (agent-shell-markdown-convert "above +___ +below"))) + (should (eq t (get-text-property 6 'agent-shell-markdown-frozen s))) + (should (get-text-property 6 'display s)))) + +(ert-deftest agent-shell-markdown-convert-divider-not-matched-with-text () + ;; `*** hello ***' is not a divider — has other content on the line. + (should (equal (agent-shell-markdown--deconstruct + (agent-shell-markdown-convert "*** hello ***")) + '(("*** hello ***" nil))))) + +(ert-deftest agent-shell-markdown-convert-image-file-path-unresolvable-untouched () + ;; Path doesn't exist (and batch mode has no graphics anyway), so + ;; the line is left untouched. + (should (equal (agent-shell-markdown--deconstruct + (agent-shell-markdown-convert + "before +/no/such/img.png +after")) + '(("before +/no/such/img.png +after" nil))))) + +(ert-deftest agent-shell-markdown-convert-table-basic () + ;; A complete table is replaced by its prettified rendering and the + ;; inserted chars carry `agent-shell-markdown-frozen' so subsequent calls + ;; skip them. (Rendering shape is covered more thoroughly by the + ;; `-output-*' tests.) + (let ((s (agent-shell-markdown-convert "| A | B | +|---|---| +| 1 | 2 |"))) + (should (equal (substring-no-properties s) + "│ A │ B │ +├───┼───┤ +│ 1 │ 2 │")) + (should (eq t (get-text-property 0 'agent-shell-markdown-frozen s))))) + +(ert-deftest agent-shell-markdown-convert-table-without-separator-renders () + ;; A separator row (`|---|---|') is optional. Two or more `|...|' + ;; rows are enough to render — without a separator, all rows are + ;; treated as data (no header styling, no separator border in the + ;; output). + (should (equal (substring-no-properties + (agent-shell-markdown-convert "| a | b | +| hello | world |")) + "│ a │ b │ +│ hello │ world │"))) + +(ert-deftest agent-shell-markdown-convert-table-cell-uses-bold () + ;; Bold inside a cell is processed by the main pass; the rendered + ;; table preserves the bold face on \"Alice\". + (let* ((s (agent-shell-markdown-convert "| Name | Role | +|------|------| +| **Alice** | Engineer |")) + (alice-pos (string-match "Alice" s))) + (should alice-pos) + (should (eq 'agent-shell-markdown-bold (get-text-property alice-pos 'face s))))) + +(ert-deftest agent-shell-markdown-convert-table-skips-frozen-cell-pipe () + ;; `| `a|b` | c |' — inline-code body contains a `|', which our + ;; inline-code styling tags `agent-shell-markdown-frozen'. The cell parser + ;; should treat that pipe as part of the cell rather than a + ;; separator, yielding 2 cells (not 3). + (let* ((s (agent-shell-markdown-convert "| `a|b` | c | +|---|---| +| x | y |")) + (header-line (car (split-string s " +"))) + ;; In a 2-column rendering, count the leading-pipe + col-pipe + ;; + trailing-pipe = 3 borders. (For 3 cols there would be 4.) + (pipe-count (length (seq-filter (lambda (c) (eq c ?│)) + header-line)))) + (should (eq 3 pipe-count)))) + +(ert-deftest agent-shell-markdown-convert-table-output-plain () + ;; End-to-end multi-line input → multi-line output comparison. + ;; Checks the rendered text only (no text-property assertions). + (should (equal (substring-no-properties + (agent-shell-markdown-convert + "| A | B | +|---|---| +| 1 | 2 |")) + "│ A │ B │ +├───┼───┤ +│ 1 │ 2 │"))) + +(ert-deftest agent-shell-markdown-convert-table-output-with-bold () + ;; Bold markup inside cells is stripped by the main pipeline before + ;; the table is rendered, so the rendered string contains \"Alice\" + ;; (the `**...**' is gone) and columns are sized for the stripped + ;; content. Compares text only. + (should (equal (substring-no-properties + (agent-shell-markdown-convert + "| Name | Role | +|------|------| +| **Alice** | Engineer | +| Bob | Manager |")) + "│ Name │ Role │ +├───────┼──────────┤ +│ Alice │ Engineer │ +│ Bob │ Manager │"))) + +(ert-deftest agent-shell-markdown-convert-table-output-wraps-one-cell () + ;; When the table's natural width exceeds the target, the widest + ;; column shrinks and its content wraps at word boundaries. + ;; Mocks `agent-shell-markdown--display-width' to 30 so the result is + ;; deterministic. Other columns stay at natural width. + (let ((agent-shell-markdown-table-max-width-fraction 1.0)) + (cl-letf (((symbol-function 'agent-shell-markdown--display-width) + (lambda () 30))) + (should (equal (substring-no-properties + (agent-shell-markdown-convert + "| A | B | +|---|---| +| short | this is a much longer description |")) + "│ A │ B │ +├───────┼────────────────────┤ +│ short │ this is a much │ +│ │ longer description │"))))) + +(ert-deftest agent-shell-markdown-convert-table-output-wraps-both-cells () + ;; Both columns shrink and wrap when both are too wide. Column + ;; widths are allocated proportionally to their natural width. + (let ((agent-shell-markdown-table-max-width-fraction 1.0)) + (cl-letf (((symbol-function 'agent-shell-markdown--display-width) + (lambda () 30))) + (should (equal (substring-no-properties + (agent-shell-markdown-convert + "| Header A | Header B | +|---|---| +| first quite long content | second cell also long enough |")) + "│ Header A │ Header B │ +├─────────────┼─────────────┤ +│ first │ second │ +│ quite long │ cell also │ +│ content │ long enough │"))))) + +(ert-deftest agent-shell-markdown-mirrors-face-to-font-lock-face () + ;; Faces are mirrored to `font-lock-face' so our styling survives + ;; `font-lock-mode' re-fontification in comint / shell-maker buffers. + (let* ((s (agent-shell-markdown-convert "hello **world**")) + (world-pos (string-match "world" s))) + (should (eq 'agent-shell-markdown-bold (get-text-property world-pos 'face s))) + (should (eq 'agent-shell-markdown-bold + (get-text-property world-pos 'font-lock-face s))) + ;; Composed faces (`(bold italic)') mirror as the same list. + (let* ((composed (agent-shell-markdown-convert "_**X**_")) + (x-pos (string-match "X" composed))) + (should (equal '(agent-shell-markdown-bold agent-shell-markdown-italic) + (get-text-property x-pos 'face composed))) + (should (equal '(agent-shell-markdown-bold agent-shell-markdown-italic) + (get-text-property x-pos 'font-lock-face composed)))))) + +(ert-deftest agent-shell-markdown-table-preserves-caller-text-properties () + ;; Caller-set text properties (here: a custom symbol) at the + ;; table's start position must survive the render's delete+insert, + ;; so callers can keep using text-property scans to bracket regions + ;; — e.g., agent-shell uses `agent-shell-ui-state' to find blocks. + (with-temp-buffer + (insert "| A | B | +|---|---| +| 1 | 2 |") + (put-text-property (point-min) (point-max) 'agent-shell-ui-state 'my-block) + (agent-shell-markdown-replace-markup) + ;; Every char in the rendered output should carry the tag. + (should (eq 'my-block + (get-text-property (point-min) 'agent-shell-ui-state))) + (should (eq 'my-block + (get-text-property (1- (point-max)) 'agent-shell-ui-state))))) + +(ert-deftest agent-shell-markdown-table-extends-on-streamed-rows () + ;; First render a 3-row table. Then append a 4th data row to the + ;; buffer (simulating an LLM streaming more content) and re-render. + ;; The renderer should see the stashed source on the already-rendered + ;; region, combine it with the new ASCII row, and emit a single + ;; 4-row table with recomputed column widths. Trailing newlines on + ;; each row signal completeness — the renderer defers rendering of a + ;; trailing row that isn't yet `\\n'-terminated, since a streaming + ;; chunk may have ended mid-row. + (with-temp-buffer + (insert "| Col | Width | +|---|---| +| 1 | 2 | +") + (agent-shell-markdown-replace-markup) + (goto-char (point-max)) + (insert "| three | four | +") + (agent-shell-markdown-replace-markup) + (should (equal (substring-no-properties (buffer-string)) + "│ Col │ Width │ +├───────┼───────┤ +│ 1 │ 2 │ +│ three │ four │ +")))) + +(ert-deftest agent-shell-markdown-table-folds-mid-stream-continuation () + ;; A streamed chunk may end mid-row (chunk boundary splits a + ;; row's cells). Each render commits the latest chars to a + ;; prettified table. The next chunk's continuation chars (no + ;; leading newline — they extend the current last row) get folded + ;; back into the rendered table's last source row, so the final + ;; render shows all rows with consistent column widths and no + ;; orphan raw markdown stuck on a `│' line. + (with-temp-buffer + ;; Chunk 1: 3-row table. The last row is intentionally short + ;; (4 cells; header has 5) with no trailing newline — the chunk + ;; boundary fell mid-row. + (insert "| # | Name | Role | Country | Status | +|---|---|---|---|---| +| 1 | Alice | Engineer | USA |") + (agent-shell-markdown-replace-markup) + ;; Chunk 2: the continuation of row 1 (the missing `Status' + ;; cell — note it starts with a space, not a newline) plus a + ;; complete row 2. + (goto-char (point-max)) + (insert " Active | +| 2 | Bob | Designer | UK | Historical | +") + (agent-shell-markdown-replace-markup) + ;; All rows render as a single 4-row table with the continuation + ;; folded into row 1. Column widths are consistent. + (should (equal (substring-no-properties (buffer-string)) + "│ # │ Name │ Role │ Country │ Status │ +├───┼───────┼──────────┼─────────┼────────────┤ +│ 1 │ Alice │ Engineer │ USA │ Active │ +│ 2 │ Bob │ Designer │ UK │ Historical │ +")))) + +(ert-deftest agent-shell-markdown-table-inside-open-fence-stays-raw () + ;; A table inside a fenced block whose closing fence hasn't + ;; streamed in yet must NOT get table-rendered. Otherwise the + ;; rendered table would survive when the closing fence finally + ;; arrives and the source-block pass strips the fences — the + ;; user would see a styled table where they asked for verbatim + ;; code. + (with-temp-buffer + (insert "``` +| A | B | +|---|---| +| 1 | 2 | +") + (agent-shell-markdown-replace-markup) + ;; The pipes stay as ASCII `|', not unicode `│' — the table + ;; renderer respected the open-fence range. + (should (string-match-p "| A | B |" (buffer-string))) + (should-not (string-match-p "│" (buffer-string))))) + +(ert-deftest agent-shell-markdown-table-renders-final-row-without-trailing-newline () + ;; A complete table whose last row isn't terminated by `\n' (e.g. + ;; the final chunk of a streaming response) must still render — + ;; callers like agent-shell narrow to the body section, which + ;; excludes the trailing `\n', so even when streaming has stopped + ;; the row would appear unterminated within the narrow. + (with-temp-buffer + (insert "| Name | Age | +|---|---| +| Alice | 28 | +| Bob | 35 |") + (agent-shell-markdown-replace-markup) + (should (equal (substring-no-properties (buffer-string)) + "│ Name │ Age │ +├───────┼─────┤ +│ Alice │ 28 │ +│ Bob │ 35 │")))) + +(ert-deftest agent-shell-markdown-table-renders-with-field-boundaries () + ;; Callers (e.g. agent-shell) tag body chars with the `field' text + ;; property. Streamed chunks may not propagate `field' onto inter- + ;; row newlines uniformly, creating field boundaries inside the table + ;; source. `forward-line' / `line-end-position' are field-aware by + ;; default, so without protection the parsers would stop at those + ;; boundaries and render some rows as empty `││'. + (with-temp-buffer + (insert "| Name | Age | +|---|---| +| Alice | 28 | +| Bob | 35 | +| Carol | 42 | +") + ;; Strip `field' from the inter-row newlines while leaving it on + ;; the row content — mimics the agent-shell streaming-chunk shape + ;; that triggered the original bug. + (put-text-property (point-min) (point-max) 'field 'output) + (save-excursion + (goto-char (point-min)) + (while (search-forward "\n" nil t) + (remove-text-properties (1- (point)) (point) '(field nil)))) + (agent-shell-markdown-replace-markup) + (should (equal (substring-no-properties (buffer-string)) + "│ Name │ Age │ +├───────┼─────┤ +│ Alice │ 28 │ +│ Bob │ 35 │ +│ Carol │ 42 │ +")))) + +(ert-deftest agent-shell-markdown-table-next-cell-walks-cells-in-order () + ;; Cells walk row-by-row, skipping the separator, and signal + ;; `user-error' at the table boundary. + (with-temp-buffer + (insert "| A | B | +|---|---| +| 1 | 2 | +") + (agent-shell-markdown-replace-markup) + ;; Point at A. + (goto-char (point-min)) + (search-forward "A") + (backward-char) + (agent-shell-markdown-table-next-cell) + (should (eq (char-after) ?B)) + (agent-shell-markdown-table-next-cell) + (should (eq (char-after) ?1)) + (agent-shell-markdown-table-next-cell) + (should (eq (char-after) ?2)) + (should-error (agent-shell-markdown-table-next-cell) :type 'user-error))) + +(ert-deftest agent-shell-markdown-table-previous-cell-walks-cells-in-reverse () + (with-temp-buffer + (insert "| A | B | +|---|---| +| 1 | 2 | +") + (agent-shell-markdown-replace-markup) + ;; Point at 2. + (goto-char (point-min)) + (search-forward "2") + (backward-char) + (agent-shell-markdown-table-previous-cell) + (should (eq (char-after) ?1)) + (agent-shell-markdown-table-previous-cell) + (should (eq (char-after) ?B)) + (agent-shell-markdown-table-previous-cell) + (should (eq (char-after) ?A)) + (should-error (agent-shell-markdown-table-previous-cell) :type 'user-error))) + +(ert-deftest agent-shell-markdown-table-next-cell-skips-wrapped-continuation () + ;; A wrapped row spans multiple physical lines; only the first + ;; line carries navigable cells. Continuation lines (with the + ;; remainder of wrapped content in some cells, padding in others) + ;; must not register as separate cells. + (let ((agent-shell-markdown-table-max-width-fraction 1.0)) + (cl-letf (((symbol-function 'agent-shell-markdown--display-width) + (lambda () 30))) + (with-temp-buffer + (insert "| A | B | +|---|---| +| short | this is a much longer description | +") + (agent-shell-markdown-replace-markup) + ;; The rendered table has the data row wrapped to 2 physical + ;; lines. There should be exactly 4 navigable cells: A, B + ;; (header), short, "this is a much" (the data row's first + ;; line — but logically one cell, "this is a much longer + ;; description"). + (goto-char (point-min)) + (search-forward "A") + (backward-char) + (agent-shell-markdown-table-next-cell) + (should (eq (char-after) ?B)) + (agent-shell-markdown-table-next-cell) + (should (looking-at-p "short")) + (agent-shell-markdown-table-next-cell) + (should (looking-at-p "this is a much")) + ;; The continuation line "longer description" is NOT a cell. + (should-error (agent-shell-markdown-table-next-cell) :type 'user-error))))) + +(ert-deftest agent-shell-markdown-table-next-cell-errors-outside-table () + (with-temp-buffer + (insert "not a table at all") + (goto-char (point-min)) + (should-error (agent-shell-markdown-table-next-cell) :type 'user-error) + (should-error (agent-shell-markdown-table-previous-cell) :type 'user-error))) + +(ert-deftest agent-shell-markdown-convert-table-in-fenced-block-untouched () + ;; A table inside a fenced block stays untouched (source-block body + ;; is frozen, so table detection skips it — and source-block fences + ;; are themselves deleted, but the body chars stay literal). + (let ((s (agent-shell-markdown-convert "``` +| A | B | +|---|---| +| 1 | 2 | +```"))) + (should (string-match-p "| A | B |" s)) + (should (not (string-match-p "│" s))))) + +(ert-deftest agent-shell-markdown-convert-everything () + (should (equal + (agent-shell-markdown--deconstruct + (agent-shell-markdown-convert + "# Top + +Some **bold** and _italic_ with ~~strike~~ done. + +--- + +## Sub with **mixed _both_ end** + +A [link](https://example.com) and `code`. + +``` +**not bold** +``` + +![alt](/missing). + +| A | B | +|---|---| +| 1 | 2 |")) + '(("Top" (agent-shell-markdown-header-1)) + (" + +Some " nil) + ("bold" (agent-shell-markdown-bold)) + (" and " nil) + ("italic" (agent-shell-markdown-italic)) + (" with " nil) + ("strike" (agent-shell-markdown-strikethrough)) + (" done. + +--- + +" nil) + ("Sub with " (agent-shell-markdown-header-2)) + ("mixed " (agent-shell-markdown-header-2 agent-shell-markdown-bold)) + ("both" (agent-shell-markdown-header-2 agent-shell-markdown-bold agent-shell-markdown-italic)) + (" end" (agent-shell-markdown-header-2 agent-shell-markdown-bold)) + (" + +A " nil) + ("link" (agent-shell-markdown-link)) + (" and " nil) + ("code" (agent-shell-markdown-inline-code)) + (". + +**not bold** + +![alt](/missing). + +" nil) + ("│" (agent-shell-markdown-table-border)) + (" A " (agent-shell-markdown-table-header)) + ("│" (agent-shell-markdown-table-border)) + (" B " (agent-shell-markdown-table-header)) + ("│" (agent-shell-markdown-table-border)) + (" +" nil) + ("├───┼───┤" (agent-shell-markdown-table-border)) + (" +" nil) + ("│" (agent-shell-markdown-table-border)) + (" 1 " nil) + ("│" (agent-shell-markdown-table-border)) + (" 2 " nil) + ("│" (agent-shell-markdown-table-border)))))) + +(provide 'agent-shell-markdown-tests) + +;;; agent-shell-markdown-tests.el ends here From bc1d46858b8682049c1b2b6fcd316c744f6f4d4d Mon Sep 17 00:00:00 2001 From: xenodium <8107219+xenodium@users.noreply.github.com> Date: Wed, 20 May 2026 00:45:03 +0100 Subject: [PATCH 13/16] Removing cl-position-if usage --- agent-shell-markdown.el | 22 +++++++++++++++------- 1 file changed, 15 insertions(+), 7 deletions(-) diff --git a/agent-shell-markdown.el b/agent-shell-markdown.el index fbee660a..5a5a104f 100644 --- a/agent-shell-markdown.el +++ b/agent-shell-markdown.el @@ -1354,13 +1354,21 @@ Inverse of `agent-shell-markdown-table-next-cell'." DIRECTION is `:forward' or `:backward'. Signals `user-error' when there's no cell in that direction." (let* ((cells (agent-shell-markdown-table--cell-starts)) - (idx (or (cl-position-if (lambda (c) (<= c (point))) cells - :from-end t) - -1)) - (target (if (eq direction :forward) (1+ idx) (1- idx)))) - (if (and cells (<= 0 target) (< target (length cells))) - (goto-char (nth target cells)) - (user-error "No more cells left")))) + ;; Largest cell-start index whose position is <= point — the + ;; cell currently containing point. -1 means point is before + ;; the first cell. CELLS is sorted ascending so we just walk + ;; it tracking the last index that still satisfies the bound. + (point-pos (point)) + (current -1) + (i 0)) + (dolist (c cells) + (when (<= c point-pos) + (setq current i)) + (setq i (1+ i))) + (let ((target (if (eq direction :forward) (1+ current) (1- current)))) + (if (and cells (<= 0 target) (< target (length cells))) + (goto-char (nth target cells)) + (user-error "No more cells left"))))) (defun agent-shell-markdown-table--cell-starts () "Return a sorted list of cell-start positions in the table at point. From 53610bea553756d1bc525f5a3050aff4491b5d6d Mon Sep 17 00:00:00 2001 From: xenodium <8107219+xenodium@users.noreply.github.com> Date: Wed, 20 May 2026 16:41:10 +0100 Subject: [PATCH 14/16] Favor map.el --- agent-shell-markdown.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/agent-shell-markdown.el b/agent-shell-markdown.el index 5a5a104f..18667a22 100644 --- a/agent-shell-markdown.el +++ b/agent-shell-markdown.el @@ -1464,7 +1464,8 @@ LANG is case-folded and trimmed; `agent-shell-markdown-language-mapping' is consulted for aliases before the `-mode' suffix is appended." (when (and lang (not (string-empty-p (string-trim lang)))) (let* ((normalized (downcase (string-trim lang))) - (resolved (or (cdr (assoc normalized agent-shell-markdown-language-mapping)) + (resolved (or (map-elt agent-shell-markdown-language-mapping + normalized nil #'equal) normalized)) (mode (intern (concat resolved "-mode")))) (when (fboundp mode) From b166fd5d03080e5dc5ef679f576ba143007ba049 Mon Sep 17 00:00:00 2001 From: xenodium <8107219+xenodium@users.noreply.github.com> Date: Wed, 20 May 2026 18:49:40 +0100 Subject: [PATCH 15/16] Add padding and background color to source blocks --- agent-shell-markdown.el | 84 +++++++++++++++++++++++++---- tests/agent-shell-markdown-tests.el | 52 +++++++++++------- 2 files changed, 108 insertions(+), 28 deletions(-) diff --git a/agent-shell-markdown.el b/agent-shell-markdown.el index 18667a22..b68c0d19 100644 --- a/agent-shell-markdown.el +++ b/agent-shell-markdown.el @@ -138,6 +138,14 @@ "Face for alternating (zebra) data rows in tables." :group 'agent-shell-markdown) +(defface agent-shell-markdown-source-block + '((t :inherit lazy-highlight :extend t)) + "Background face applied to rendered fenced source-block bodies. +`:extend t' makes the background color reach the right edge of +the window, so the block reads as a contiguous panel rather than +a per-char highlight." + :group 'agent-shell-markdown) + (defvar agent-shell-markdown-image-max-width 0.4 "Maximum width for inline images rendered from `![alt](url)'. An integer is taken as pixels. A float between 0 and 1 is a @@ -625,11 +633,64 @@ with `emacs-lisp-mode' face properties on the body and a ;; valid; body markers adjust automatically. (delete-region close-start close-end) (delete-region open-start open-end) + ;; Seed the background face on every body char first, then + ;; layer the language's font-lock faces on top — the + ;; foreground colors take priority for each glyph while the + ;; `:extend t' background fills the gaps and reaches the + ;; right edge of the window. Include the trailing `\n' (the + ;; one between body and close fence, preserved by our two + ;; `delete-region's above): `:extend t' only extends the + ;; background when the face is in effect at end-of-line, so + ;; without the `\n' carrying the face the last body line's + ;; bg would stop at the last content char instead of running + ;; to the window edge. + (put-text-property body-start (1+ (marker-position body-end)) + 'face 'agent-shell-markdown-source-block) (agent-shell-markdown--apply-faces-from highlighted - (marker-position body-start)) - (add-text-properties body-start body-end - '(agent-shell-markdown-frozen t - rear-nonsticky (agent-shell-markdown-frozen))))))) + (marker-position body-start)) + ;; `line-prefix' / `wrap-prefix' indent each rendered code-block + ;; line visually without inserting literal spaces. Copying chars + ;; out of the block yanks the raw source with no leading + ;; indentation. `wrap-prefix' handles long lines that wrap. + ;; The last 2 chars of the prefix carry the block's background + ;; face so the bg panel reaches 2 chars into the indent — + ;; visually the code block sits inside a slightly inset tinted + ;; panel rather than starting hard at column 4. + (let ((prefix (concat " " + (propertize + " " 'face + 'agent-shell-markdown-source-block)))) + (add-text-properties body-start body-end + `(agent-shell-markdown-frozen t + rear-nonsticky (agent-shell-markdown-frozen) + line-prefix ,prefix + wrap-prefix ,prefix))) + ;; Vertical padding via `display' property. The first body + ;; char renders as "" and the + ;; trailing \n renders as "", + ;; visually inserting a blank bg-tinted line above and below + ;; the block without modifying buffer text — copying the body + ;; still yanks the raw source. vpad is a single bg-faced \n: + ;; the `line-prefix' applied to body chars also paints these + ;; padding visual lines (cols 0-1 plain, cols 2-3 bg), and + ;; `:extend t' on the face fills cols 4+ to the right window + ;; edge. Adding a literal " " in vpad would put a plain + ;; stripe on top of the prefix, which then flashes the region + ;; face when the underlying char is selected. + (let ((vpad (propertize "\n" 'face + 'agent-shell-markdown-source-block)) + (first-pos (marker-position body-start)) + (last-pos (marker-position body-end))) + (put-text-property first-pos (1+ first-pos) + 'display + (concat vpad + (buffer-substring first-pos + (1+ first-pos)))) + (put-text-property last-pos (1+ last-pos) + 'display + (concat (buffer-substring last-pos + (1+ last-pos)) + vpad))))))) (defconst agent-shell-markdown--table-line-regexp (rx line-start @@ -1400,18 +1461,21 @@ and continuation lines of wrapped rows are skipped automatically." (point-max))))) (defun agent-shell-markdown--apply-faces-from (propertized buffer-start) - "Copy `face' properties from PROPERTIZED string to chars at BUFFER-START.. + "Layer `face' properties from PROPERTIZED on chars at BUFFER-START.. -Chars in PROPERTIZED without a `face' property cause the -corresponding buffer chars' `face' to be cleared, so re-running -on an already-highlighted body is idempotent." +Uses `add-face-text-property' with PREPEND so the language's +font-lock faces take priority in the cascade over whatever face +the caller seeded the region with (e.g. a background panel face). +Chars in PROPERTIZED without a `face' are left untouched, so the +caller's seeded face shows through." (let ((pos 0) (len (length propertized))) (while (< pos len) (let ((face (get-text-property pos 'face propertized)) (next (or (next-single-property-change pos 'face propertized) len))) - (put-text-property (+ buffer-start pos) (+ buffer-start next) - 'face face) + (when face + (add-face-text-property (+ buffer-start pos) (+ buffer-start next) + face)) (setq pos next))))) (defun agent-shell-markdown--mirror-face-to-font-lock-face (start end) diff --git a/tests/agent-shell-markdown-tests.el b/tests/agent-shell-markdown-tests.el index bf8326d7..6ad45c19 100644 --- a/tests/agent-shell-markdown-tests.el +++ b/tests/agent-shell-markdown-tests.el @@ -138,9 +138,11 @@ after **b2**")) '(("before " nil) ("b" (agent-shell-markdown-bold)) (" -**not bold** +" nil) + ("**not bold** _not italic_ -after " nil) +" (agent-shell-markdown-source-block)) + ("after " nil) ("b2" (agent-shell-markdown-bold)))))) (ert-deftest agent-shell-markdown-convert-open-fence-protects-rest () @@ -197,6 +199,9 @@ streaming **not bold**" nil))))) '(("see ![alt](/no/such/file.png) end" nil))))) (ert-deftest agent-shell-markdown-convert-link-in-fenced-block-untouched () + ;; The `[b](v)' inside fences stays literal (it isn't re-processed + ;; as a link), but rendered source-block bodies now carry the + ;; `agent-shell-markdown-source-block' background face. (should (equal (agent-shell-markdown--deconstruct (agent-shell-markdown-convert "before [a](u) @@ -207,37 +212,45 @@ after [c](w)")) '(("before " nil) ("a" (agent-shell-markdown-link)) (" -[b](v) -after " nil) +" nil) + ("[b](v) +" (agent-shell-markdown-source-block)) + ("after " nil) ("c" (agent-shell-markdown-link)))))) (ert-deftest agent-shell-markdown-convert-source-block-no-language () - ;; Plain fenced block (no language): fences deleted, body remains - ;; (with `agent-shell-markdown-frozen t' tagged on body chars, which - ;; `--deconstruct' doesn't surface — it tracks face only). + ;; Plain fenced block (no language): fences deleted, body remains. + ;; Body chars carry the `agent-shell-markdown-source-block' bg face + ;; (and the `agent-shell-markdown-frozen' tag, which `--deconstruct' + ;; doesn't surface). The body region includes the trailing `\\n' + ;; so `:extend t' on the bg face reaches the right edge of the + ;; window on the last line too. (should (equal (agent-shell-markdown--deconstruct (agent-shell-markdown-convert "``` body ```")) '(("body -" nil))))) +" (agent-shell-markdown-source-block)))))) (ert-deftest agent-shell-markdown-convert-source-block-with-language () ;; `emacs-lisp' source block: fences deleted, body chars get - ;; `emacs-lisp-mode' font-lock faces. In batch the keyword `if' - ;; is faced. (Note: the faces here come directly from the - ;; language major mode and are intentionally not wrapped in our - ;; own `agent-shell-markdown-*' faces.) + ;; `emacs-lisp-mode' font-lock faces *plus* the + ;; `agent-shell-markdown-source-block' background face (layered + ;; with `add-face-text-property' APPEND so it ends up at the tail + ;; of the cascade, behind the language's font-lock). In batch the + ;; keyword `if' is faced. The trailing `\\n' isn't part of the + ;; body region and stays unfaced. (should (equal (agent-shell-markdown--deconstruct (agent-shell-markdown-convert "```emacs-lisp (if t nil) ```")) - '(("(" nil) - ("if" (font-lock-keyword-face)) + '(("(" (agent-shell-markdown-source-block)) + ("if" (font-lock-keyword-face + agent-shell-markdown-source-block)) (" t nil) -" nil))))) +" (agent-shell-markdown-source-block)))))) (ert-deftest agent-shell-markdown-convert-source-block-body-tagged () ;; Body chars carry `agent-shell-markdown-frozen t' so subsequent calls @@ -276,7 +289,8 @@ body (agent-shell-markdown-replace-markup) (should (equal (agent-shell-markdown--deconstruct (buffer-string)) '(("**not bold** - +" (agent-shell-markdown-source-block)) + (" " nil) ("real bold" (agent-shell-markdown-bold))))))) @@ -749,8 +763,10 @@ A " nil) ("code" (agent-shell-markdown-inline-code)) (". -**not bold** - +" nil) + ("**not bold** +" (agent-shell-markdown-source-block)) + (" ![alt](/missing). " nil) From c58e5d5f93453204ff4d92096105e25feebdd843 Mon Sep 17 00:00:00 2001 From: Adam Niederer Date: Thu, 21 May 2026 00:02:17 -0400 Subject: [PATCH 16/16] Fast markdown renderer PoC This code is pretty terrible and not production ready at all but it demonstrates the benefits of offloading markdown parsing to a library using native code --- .gitignore | 6 + agent-shell-markdown-c.el | 337 +++++++++++++++++++ agent-shell.el | 5 +- pulldown-cmark-emacs/Cargo.toml | 11 + pulldown-cmark-emacs/pulldown-cmark-emacs.el | 46 +++ pulldown-cmark-emacs/src/lib.rs | 68 ++++ 6 files changed, 470 insertions(+), 3 deletions(-) create mode 100644 agent-shell-markdown-c.el create mode 100644 pulldown-cmark-emacs/Cargo.toml create mode 100644 pulldown-cmark-emacs/pulldown-cmark-emacs.el create mode 100644 pulldown-cmark-emacs/src/lib.rs diff --git a/.gitignore b/.gitignore index 0dfe168e..6f5ef1e3 100644 --- a/.gitignore +++ b/.gitignore @@ -1,3 +1,9 @@ /.agent-shell/ *.elc + +*~ +#* +*# + +target \ No newline at end of file diff --git a/agent-shell-markdown-c.el b/agent-shell-markdown-c.el new file mode 100644 index 00000000..88733eb4 --- /dev/null +++ b/agent-shell-markdown-c.el @@ -0,0 +1,337 @@ +;;; agent-shell-markdown-c.el -*- lexical-binding: t -*- + +(require 'org-faces) +(require 'url-parse) +(require 'url-util) + +(defgroup agent-shell-markdown-c nil + "Render Markdown text into propertized form (rust backend)." + :group 'text) + +(defface agent-shell-markdown-bold + '((t :inherit bold)) + "Face for bold text." + :group 'agent-shell-markdown-c) + +(defface agent-shell-markdown-italic + '((t :inherit italic)) + "Face for italic text." + :group 'agent-shell-markdown-c) + +(defface agent-shell-markdown-strikethrough + '((t :strike-through t)) + "Face for strikethrough text." + :group 'agent-shell-markdown-c) + +(defface agent-shell-markdown-inline-code + '((t :inherit font-lock-doc-markup-face)) + "Face for inline code." + :group 'agent-shell-markdown-c) + +(defface agent-shell-markdown-link + '((t :inherit link)) + "Face for link titles." + :group 'agent-shell-markdown-c) + +(defface agent-shell-markdown-header-1 + '((t :inherit org-level-1)) + "Face for level-1 headers." + :group 'agent-shell-markdown-c) + +(defface agent-shell-markdown-header-2 + '((t :inherit org-level-2)) + "Face for level-2 headers." + :group 'agent-shell-markdown-c) + +(defface agent-shell-markdown-header-3 + '((t :inherit org-level-3)) + "Face for level-3 headers." + :group 'agent-shell-markdown-c) + +(defface agent-shell-markdown-header-4 + '((t :inherit org-level-4)) + "Face for level-4 headers." + :group 'agent-shell-markdown-c) + +(defface agent-shell-markdown-header-5 + '((t :inherit org-level-5)) + "Face for level-5 headers." + :group 'agent-shell-markdown-c) + +(defface agent-shell-markdown-header-6 + '((t :inherit org-level-6)) + "Face for level-6 headers." + :group 'agent-shell-markdown-c) + +(defface agent-shell-markdown-source-block + '((t :inherit lazy-highlight :extend t)) + "Background face for fenced source-block bodies." + :group 'agent-shell-markdown-c) + +(defvar agent-shell-markdown-image-max-width 0.4 + "Maximum width for inline images.") + +(defun agent-shell-markdown-c-convert (markdown) + "Convert MARKDOWN string into propertized text." + (with-temp-buffer + (insert markdown) + (agent-shell-markdown-c-replace-markup) + (buffer-string))) + +(defvar drop-point 0) (setq drop-point 0) + +(defun agent-shell-markdown-c-replace-markup () + "Apply propertization to current buffer using aucmd4cw. +Formatting delimiters (*, _, ~~, etc.) are left in place." + (save-excursion + (let* ((markdown (buffer-string)) + (result (pulldown-cmark-emacs-parse markdown)) + (spans (drop drop-point result)) + (inhibit-modification-hooks t)) + (setq drop-point (1- (length result))) + (dolist (span spans) (agent-shell-markdown-c--apply-span span markdown)) + (agent-shell-markdown--mirror-face-to-font-lock-face + (point-min) (point-max))))) + +(defun agent-shell-markdown-c--apply-span (span markdown) + "Apply properties for SPAN to the current buffer. +MARKDOWN is the source string used for URL extraction." + (let ((type (plist-get span :type)) + (start (plist-get span :start)) + (end (plist-get span :end))) + (when (< start end) + (pcase type + (:strong (agent-shell-markdown-c--apply-face start end 'agent-shell-markdown-bold)) + (:emphasis (agent-shell-markdown-c--apply-face start end 'agent-shell-markdown-italic)) + (:strikethrough (agent-shell-markdown-c--apply-face start end 'agent-shell-markdown-strikethrough)) + (:code (agent-shell-markdown-c--apply-face start end 'agent-shell-markdown-inline-code)) + (:code-block (agent-shell-markdown-c--apply-face start end 'agent-shell-markdown-inline-code)) + (:heading (agent-shell-markdown-c--apply-heading start end)) + (:link (agent-shell-markdown-c--apply-link start end markdown)) + (:image (agent-shell-markdown-c--apply-image start end markdown)) + (:hr (agent-shell-markdown-c--apply-divider start end)) + ;; (:code-block (agent-shell-markdown-c--apply-source-block start end)) + ((or :paragraph :blockquote :unordered-list :ordered-list + :list-item :table :table-head :table-body :table-row + :table-header :table-cell) + nil))))) + +(defun agent-shell-markdown-c--buf-pos (pos) + "Convert 0-indexed POS to buffer position, clamped to accessible region." + (max (point-min) (min (point-max) (+ (point-min) pos)))) + +(defun agent-shell-markdown-c--apply-face (start end face) + "Apply FACE to buffer range [START, END). +START and END are 0-indexed positions from aucmd4cw-parse." + (let ((buf-start (agent-shell-markdown-c--buf-pos start)) + (buf-end (agent-shell-markdown-c--buf-pos end))) + (when (< buf-start buf-end) + (add-face-text-property buf-start buf-end face t (current-buffer)) + (put-text-property buf-start buf-end 'font-lock-face face)))) + +(defun agent-shell-markdown-c--apply-heading (start end) + "Apply heading face using positions from aucmd4cw-parse." + (let ((buf-start (agent-shell-markdown-c--buf-pos start)) + (buf-end (agent-shell-markdown-c--buf-pos end)) + (level (save-excursion + (goto-char (agent-shell-markdown-c--buf-pos start)) + (skip-chars-forward "#")))) + (add-face-text-property + buf-start buf-end + (intern (format "agent-shell-markdown-header-%d" + (max 1 (min level 6)))) + nil (current-buffer)))) + +(defun agent-shell-markdown-c--apply-link (start end markdown) + "Apply link face and keymap at [START, END)." + (let ((buf-start (agent-shell-markdown-c--buf-pos start)) + (buf-end (agent-shell-markdown-c--buf-pos end)) + (url (agent-shell-markdown-c--extract-url markdown start))) + (add-face-text-property buf-start buf-end + 'agent-shell-markdown-link nil (current-buffer)) + (when url + (let ((map (agent-shell-markdown-c--make-ret-binding-map + (lambda () (interactive) + (agent-shell-markdown-c--open-link url))))) + (put-text-property buf-start buf-end 'keymap map (current-buffer)) + (put-text-property buf-start buf-end + 'mouse-face 'highlight (current-buffer)))))) + +(defun agent-shell-markdown-c--extract-url (markdown title-start) + "Extract URL from markdown link surrounding TITLE-START." + (save-match-data + (let* ((i (1- title-start)) + (open-bracket (when (>= i 0) + (if (eq (aref markdown i) ?\[) + i + (when (and (> i 0) + (eq (aref markdown (1- i)) ?\[)) + (1- i)))))) + (when open-bracket + (let ((close-bracket (cl-loop for j from (1+ open-bracket) + while (< j (length markdown)) + when (eq (aref markdown j) ?\]) + return j))) + (when (and close-bracket + (< (1+ close-bracket) (length markdown)) + (eq (aref markdown (1+ close-bracket)) ?\()) + (let ((paren-start (1+ close-bracket))) + (cl-loop for j from (1+ paren-start) + while (< j (length markdown)) + when (eq (aref markdown j) ?\)) + return (substring markdown paren-start j))))))))) + +(defun agent-shell-markdown-c--apply-image (start end markdown) + "Render image at [START, END) using display property." + (let ((url (agent-shell-markdown-c--extract-url markdown start))) + (when-let ((path (and url + (agent-shell-markdown-c--resolve-image-url url))) + ((image-supported-file-p path)) + ((display-graphic-p))) + (let ((buf-start (agent-shell-markdown-c--buf-pos start)) + (buf-end (agent-shell-markdown-c--buf-pos end)) + (placeholder (let ((alt (substring markdown start end))) + (if (string-empty-p alt) " " alt))) + (image (create-image path nil nil + :max-width + (agent-shell-markdown-c--image-max-width)))) + (image-flush image) + (delete-region buf-start buf-end) + (goto-char buf-start) + (insert placeholder) + (let ((insert-end (point))) + (put-text-property buf-start insert-end 'display image) + (put-text-property buf-start insert-end 'keymap + (agent-shell-markdown-c--make-ret-binding-map + (lambda () (interactive) (find-file path)))) + (put-text-property buf-start insert-end + 'mouse-face 'highlight)))))) + +(defun agent-shell-markdown-c--apply-divider (start end) + "Render horizontal rule at [START, END)." + (let ((buf-start (agent-shell-markdown-c--buf-pos start)) + (buf-end (agent-shell-markdown-c--buf-pos end))) + (when (< buf-start buf-end) + (add-text-properties + buf-start buf-end + (list 'display + (concat (propertize (make-string + (agent-shell-markdown-c--display-width) ?\s) + 'face '(:underline t)) + "\n") + 'agent-shell-markdown-frozen t + 'rear-nonsticky '(display agent-shell-markdown-frozen)))))) + +(defun agent-shell-markdown-c--display-width () + "Return usable display width, falling back to 80." + (or (ignore-errors (window-body-width)) 80)) + +(defun agent-shell-markdown--mirror-face-to-font-lock-face (start end) + "Copy each `face' run across [START, END) to `font-lock-face'." + (let ((pos start)) + (while (< pos end) + (let ((face (get-text-property pos 'face)) + (next (or (next-single-property-change pos 'face nil end) end))) + (when face + (put-text-property pos next 'font-lock-face face)) + (setq pos next))))) + +(defun agent-shell-markdown-c--make-ret-binding-map (fun) + "Return a sparse keymap binding RET and mouse-1 to FUN." + (let ((map (make-sparse-keymap))) + (define-key map (kbd "RET") fun) + (define-key map [mouse-1] fun) + (define-key map [remap self-insert-command] 'ignore) + map)) + +(defun agent-shell-markdown-c--open-link (url) + "Open URL. Use local navigation for file links, browse-url otherwise." + (unless (agent-shell-markdown-c--open-local-link url) + (browse-url url))) + +(defun agent-shell-markdown-c--open-local-link (url) + "Open URL as a local file link if possible." + (when-let ((parsed (agent-shell-markdown-c--parse-local-link url))) + (find-file (car parsed)) + (when (cdr parsed) + (goto-char (point-min)) + (forward-line (1- (cdr parsed)))) + t)) + +(defun agent-shell-markdown-c--parse-local-link (url) + "Parse URL as a local file link. +Return (FILE . LINE) when URL points to an existing local file, +or nil otherwise." + (when-let ((match + (cond + ((string-match + (rx bos "file://" + (group (+? anything)) + (optional (or (seq "#L" (group (one-or-more digit))) + (seq ":" (group (one-or-more digit))))) + eos) + url) + (cons (match-string 1 url) + (or (match-string 2 url) (match-string 3 url)))) + ((string-match + (rx bos "file:" + (group (not (any "/")) (+? anything)) + (optional (or (seq "#L" (group (one-or-more digit))) + (seq ":" (group (one-or-more digit))))) + eos) + url) + (cons (match-string 1 url) + (or (match-string 2 url) (match-string 3 url)))) + ((string-match + (rx bos + (group (? (optional "/") alpha ":/") + (one-or-more (not (any ":#")))) + "#L" (group (one-or-more digit)) + eos) + url) + (cons (match-string 1 url) (match-string 2 url))) + ((string-match + (rx bos + (group (? (optional "/") alpha ":/") + (one-or-more (not (any ":#")))) + ":" (group (one-or-more digit)) + eos) + url) + (cons (match-string 1 url) (match-string 2 url))) + ((not (string-empty-p url)) + (cons url nil)))) + (filepath (expand-file-name (car match)))) + (when (file-exists-p filepath) + (cons filepath + (when (cdr match) + (string-to-number (cdr match))))))) + +(defun agent-shell-markdown-c--resolve-image-url (url) + "Resolve image URL to an absolute local file path, or nil." + (when-let* ((path (cond + ((string-prefix-p "file://" url) + (url-unhex-string + (url-filename (url-generic-parse-url url)))) + ((string-prefix-p "file:" url) + (substring url (length "file:"))) + ((or (file-name-absolute-p url) + (string-prefix-p "~" url) + (string-prefix-p "./" url) + (string-prefix-p "../" url)) + url))) + (expanded (expand-file-name path)) + ((file-exists-p expanded))) + expanded)) + +(defun agent-shell-markdown-c--image-max-width () + "Return the maximum image width in pixels." + (if (floatp agent-shell-markdown-image-max-width) + (let ((window (or (get-buffer-window (current-buffer)) + (frame-first-window)))) + (round (* agent-shell-markdown-image-max-width + (window-body-width window t)))) + agent-shell-markdown-image-max-width)) + +(provide 'agent-shell-markdown-c) + +;;; agent-shell-markdown-c.el ends here diff --git a/agent-shell.el b/agent-shell.el index 98b27593..a3a19775 100644 --- a/agent-shell.el +++ b/agent-shell.el @@ -50,6 +50,7 @@ (unless (require 'markdown-overlays nil 'noerror) (error "Please update 'shell-maker' to v0.91.2 or newer")) (require 'agent-shell-markdown) +(require 'agent-shell-markdown-c) (require 'agent-shell-anthropic) (require 'agent-shell-auggie) (require 'agent-shell-cline) @@ -119,9 +120,7 @@ back to `markdown-overlays-put'. in the overlay branch; they're intentionally ignored by `agent-shell-markdown', which always highlights blocks and renders resolvable images." - (if agent-shell--experimental-renderer - (agent-shell-markdown-replace-markup) - (markdown-overlays-put))) + (agent-shell-markdown-c-replace-markup)) (defcustom agent-shell-permission-icon "⚠" "Icon displayed when shell commands require permission to execute. diff --git a/pulldown-cmark-emacs/Cargo.toml b/pulldown-cmark-emacs/Cargo.toml new file mode 100644 index 00000000..f2713431 --- /dev/null +++ b/pulldown-cmark-emacs/Cargo.toml @@ -0,0 +1,11 @@ +[package] +name = "pulldown-cmark-emacs" +version = "0.1.0" +edition = "2024" + +[lib] +crate-type = ["cdylib"] + +[dependencies] +emacs = "0.21" # Compatible with standard Emacs module environments +pulldown-cmark = "0.13.4" \ No newline at end of file diff --git a/pulldown-cmark-emacs/pulldown-cmark-emacs.el b/pulldown-cmark-emacs/pulldown-cmark-emacs.el new file mode 100644 index 00000000..b9ffd2f0 --- /dev/null +++ b/pulldown-cmark-emacs/pulldown-cmark-emacs.el @@ -0,0 +1,46 @@ +;;; pulldown-cmark-emacs.el -*- lexical-binding: t -*- +(eval-when-compile + (require 'cl-lib) + (require 'subr-x)) + +(defvar pulldown-cmark-emacs-development-mode nil + "If non-nil, use `rs-module` to hot-reload the library on every initialization. +Set this to `t` in your development configuration before loading the package.") + +(defvar pulldown-cmark-emacs--module-loaded nil + "Non-nil after the native module has been loaded once.") + +(defun pulldown-cmark-emacs--so-path () + "Return the absolute path to pulldown-cmark-emacs.so, sibling of this file." + (expand-file-name + (if pulldown-cmark-emacs-development-mode + "target/debug/libpulldown_cmark_emacs.so" ; Usually debug during hot-reloads + "target/release/libpulldown_cmark_emacs.so") ; Production + (file-name-directory + (or load-file-name + (and (boundp 'byte-compile-current-file) + byte-compile-current-file) + default-directory)))) + +(defun pulldown-cmark-emacs-load-or-reload-module () + "Load or dynamically reload the pulldown-cmark-emacs native module." + (interactive) + (let ((so-path (pulldown-cmark-emacs--so-path))) + (if pulldown-cmark-emacs-development-mode + (progn + (require 'rs-module) + (rs-module/load so-path) + (setq pulldown-cmark-emacs--module-loaded t) + (message "pulldown-cmark-emacs: Hot-swapped module from %s" so-path)) + (unless pulldown-cmark-emacs--module-loaded + (if (file-exists-p so-path) + (progn + (module-load so-path) + (setq pulldown-cmark-emacs--module-loaded t)) + (error "Native module not found at %s. Did you run 'cargo build --release'?" so-path)))))) + +(unless noninteractive + (pulldown-cmark-emacs-load-or-reload-module)) + +(provide 'pulldown-cmark-emacs) +;;; pulldown-cmark-emacs.el ends here diff --git a/pulldown-cmark-emacs/src/lib.rs b/pulldown-cmark-emacs/src/lib.rs new file mode 100644 index 00000000..40127181 --- /dev/null +++ b/pulldown-cmark-emacs/src/lib.rs @@ -0,0 +1,68 @@ +use emacs::{defun, Env, Result, Value, IntoLisp}; +use pulldown_cmark::{Event, Options, Parser, Tag}; + +emacs::plugin_is_GPL_compatible!(); + +#[emacs::module(name = "pulldown-cmark-emacs")] +fn init(_env: &Env) -> Result<()> { + Ok(()) +} + +/// Helper function to convert a byte index into a UTF-8 character index +fn byte_to_char_idx(s: &str, byte_idx: usize) -> usize { + s[..byte_idx].chars().count() +} + +/// Parses a markdown string and returns a list of plists containing block/span locations. +/// Format: ((:type "paragraph" :start 0 :end 15) (:type "strong" :start 6 :end 12)) +#[defun] +fn parse(env: &Env, text: String) -> Result> { + let mut options = Options::empty(); + options.insert(Options::ENABLE_STRIKETHROUGH); + options.insert(Options::ENABLE_SUPERSCRIPT); + options.insert(Options::ENABLE_SUBSCRIPT); + let parser = Parser::new_ext(&text, options); + let mut elements = Vec::new(); + + let kw_type = env.intern(":type")?; + let kw_start = env.intern(":start")?; + let kw_end = env.intern(":end")?; + + for (event, range) in parser.into_offset_iter() { + let type_name = match event { + Event::Start(tag) => match tag { + Tag::Paragraph => None, + Tag::Strong => Some(":strong"), + Tag::Emphasis => Some(":emphasis"), + Tag::Strikethrough => Some(":strikethrough"), + Tag::Superscript => Some(":superscript"), + Tag::Subscript => Some(":subscript"), + Tag::Heading { .. } => Some(":heading"), + Tag::CodeBlock(_) => Some(":code-block"), + Tag::Link { .. } => Some(":link"), + Tag::Item => Some(":list"), + _ => None + }, + Event::Code(_) => Some(":code"), + _ => None, + }; + + if let Some(name) = type_name { + let start_char = byte_to_char_idx(&text, range.start); + let end_char = byte_to_char_idx(&text, range.end); + + let plist = env.list(&[ + kw_type, + env.intern(name)?, + kw_start, + start_char.into_lisp(env)?, + kw_end, + end_char.into_lisp(env)?, + ])?; + + elements.push(plist); + } + } + + env.list(&elements) +}