From 2b0a825cabfa34c3c28910933c68d16c31947de6 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/31] 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 72ec76ce..146a17b8 100644 --- a/agent-shell.el +++ b/agent-shell.el @@ -50,6 +50,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-codebuddy) @@ -100,6 +101,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. @@ -3055,7 +3083,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). @@ -3067,7 +3095,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) @@ -3113,7 +3141,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 @@ -3125,7 +3153,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 @@ -5437,7 +5465,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) @@ -6175,7 +6203,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 f0b75751d22d372a859a23520bf038fd0ed3626d 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/31] 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 42bc922bea4b7284c4d390111fddb0797d6f275f 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/31] 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 d29d30594b228302b67745f25837e6614bbcddfc 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/31] 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 146a17b8..b5adf3f1 100644 --- a/agent-shell.el +++ b/agent-shell.el @@ -3135,26 +3135,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 e9a76cdc5aeb748f5234c5ee31bb29c5542df066 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/31] 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 b5adf3f1..e9a52798 100644 --- a/agent-shell.el +++ b/agent-shell.el @@ -50,7 +50,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-codebuddy) @@ -102,30 +102,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 "⚠" @@ -3139,7 +3136,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 322be2865e12b6dc529e0b99eeb292380ec2070a 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/31] 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 7fa66343fbc5a2d4871a2782dcc8166cb71d2061 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/31] 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 d7761286f1fea359dfd3f815195c40423872a50d 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 08/31] 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 6f16f4668b7cc7a1763d93508c80f36a3c4b8b15 Mon Sep 17 00:00:00 2001 From: xenodium <8107219+xenodium@users.noreply.github.com> Date: Thu, 21 May 2026 15:10:52 +0100 Subject: [PATCH 09/31] agent-shell-markdown.el perf improvements - avoid-ranges is now a sorted vector; --in-avoid-range-p does binary search and returns the containing range. - --replace-* passes use that return value to jump past avoid-ranges instead of re-matching inside them. - --find-tables skips avoid-ranges in one hop and uses forward-line 1 between non-matches (table regex is bol-anchored). --- agent-shell-markdown.el | 356 ++++++++++++++++++++++++---------------- 1 file changed, 219 insertions(+), 137 deletions(-) diff --git a/agent-shell-markdown.el b/agent-shell-markdown.el index b68c0d19..44461b1c 100644 --- a/agent-shell-markdown.el +++ b/agent-shell-markdown.el @@ -216,14 +216,17 @@ changes, so adjacent delimiters peel one layer per round 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))) + (let* ((source-ranges (agent-shell-markdown--sort-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))) + :avoid-ranges (agent-shell-markdown--sort-ranges + source-ranges rendered-ranges)))) + (avoid-ranges (agent-shell-markdown--sort-ranges + 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 @@ -274,18 +277,22 @@ world.\" with face `agent-shell-markdown-bold' on \"world\"." (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)))) + (let* ((markup-start (match-beginning 1)) + (markup-end (match-end 1)) + (avoid (agent-shell-markdown--in-avoid-range-p + markup-start markup-end avoid-ranges))) + (if avoid + (goto-char (cdr avoid)) + (let ((text (buffer-substring + (or (match-beginning 2) (match-beginning 3)) + (or (match-end 2) (match-end 3))))) + (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) @@ -309,18 +316,22 @@ world.\" with face `agent-shell-markdown-italic' on \"world\"." (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)))) + (let* ((markup-start (or (match-beginning 2) (match-beginning 5))) + (markup-end (match-end 0)) + (avoid (agent-shell-markdown--in-avoid-range-p + markup-start markup-end avoid-ranges))) + (if avoid + (goto-char (cdr avoid)) + (let ((text (buffer-substring + (or (match-beginning 3) (match-beginning 6)) + (or (match-end 3) (match-end 6))))) + (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) @@ -339,17 +350,20 @@ For example, the buffer \"a ~~b~~ c\" becomes \"a b c\" with face (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)))) + (let* ((markup-start (match-beginning 0)) + (markup-end (match-end 0)) + (avoid (agent-shell-markdown--in-avoid-range-p + markup-start markup-end avoid-ranges))) + (if avoid + (goto-char (cdr avoid)) + (let ((text (buffer-substring (match-beginning 1) (match-end 1)))) + (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) @@ -369,18 +383,21 @@ face `agent-shell-markdown-header-2'." (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))))))))) + (let* ((markup-start (match-beginning 0)) + (markup-end (match-end 0)) + (avoid (agent-shell-markdown--in-avoid-range-p + markup-start markup-end avoid-ranges))) + (if avoid + (goto-char (cdr avoid)) + (let ((level (- (match-end 1) (match-beginning 1))) + (text (buffer-substring (match-beginning 2) (match-end 2)))) + (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. @@ -398,18 +415,21 @@ 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))))))))) + (let* ((markup-start (match-beginning 0)) + (markup-end (match-end 0)) + (avoid (agent-shell-markdown--in-avoid-range-p + markup-start markup-end avoid-ranges))) + (if avoid + (goto-char (cdr avoid)) + (let ((text (buffer-substring (match-beginning 1) (match-end 1)))) + (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. @@ -433,22 +453,29 @@ and a keymap that opens the URL." (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))))))) + (let* ((markup-start (match-beginning 0)) + (markup-end (match-end 0)) + (is-image (eq (char-before markup-start) ?!)) + (avoid (unless is-image + (agent-shell-markdown--in-avoid-range-p + markup-start markup-end avoid-ranges)))) + (cond + (avoid (goto-char (cdr avoid))) + (is-image nil) + (t + (let ((title (buffer-substring (match-beginning 1) (match-end 1))) + (url (buffer-substring-no-properties + (match-beginning 2) (match-end 2)))) + (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. @@ -475,28 +502,34 @@ For example, the buffer \"see ![logo](logo.png)\" becomes 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)))))))) + (avoid (agent-shell-markdown--in-avoid-range-p + markup-start markup-end avoid-ranges))) + (cond + (avoid (goto-char (cdr avoid))) + (t + (let* ((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)) + (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. @@ -520,27 +553,31 @@ renders the image in place of that text." (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))))))))) + (avoid (agent-shell-markdown--in-avoid-range-p + line-start line-end avoid-ranges))) + (cond + (avoid (goto-char (cdr avoid))) + (t + (let* ((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)) + (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. @@ -562,9 +599,12 @@ property, so the source markdown round-trips through copy/save." (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) + (let* ((rule-start (match-beginning 0)) + (rule-end (match-end 0)) + (avoid (agent-shell-markdown--in-avoid-range-p + rule-start rule-end avoid-ranges))) + (if avoid + (goto-char (cdr avoid)) (add-text-properties rule-start rule-end (list 'display @@ -749,6 +789,15 @@ unchanged source is a no-op." (while (< pos (point-max)) (goto-char pos) (cond + ;; Skip past any avoid-range containing POS in one hop — + ;; otherwise multi-line ranges (open fences, big rendered + ;; spans) make us walk every line just to fall through. + ;; Query with `[pos, pos+1)' so a range whose half-open + ;; exclusive END equals POS doesn't match (would otherwise + ;; setq POS back to itself → infinite loop). + ((let ((avoid (agent-shell-markdown--in-avoid-range-p + pos (1+ pos) avoid-ranges))) + (when avoid (setq pos (cdr avoid)) t))) ((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 @@ -794,8 +843,7 @@ unchanged source is a no-op." ;; 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))) + (not (get-text-property pos 'agent-shell-markdown-frozen))) (let ((table-start pos) (table-end nil) (row-count 0)) @@ -824,8 +872,18 @@ unchanged source is a no-op." (:end . ,table-end) (:source . ,(buffer-substring table-start table-end))) tables)) - (setq pos (or table-end (1+ pos))))) - (t (setq pos (1+ pos)))))) + ;; If we matched table rows, `table-end' is past them. + ;; Otherwise advance to the next line — the table regex + ;; needs `bol' to match, so scanning the rest of this line + ;; char-by-char can never produce a hit. + (setq pos (or table-end + (progn (forward-line 1) (point)))))) + (t + ;; No table-source here and no table starts at this position. + ;; The table regex requires `bol', so jump straight to the + ;; next line start rather than crawling each char. + (forward-line 1) + (setq pos (point)))))) (nreverse tables))) (defun agent-shell-markdown--parse-table-row (start end) @@ -1651,15 +1709,39 @@ Resolves `agent-shell-markdown-image-max-width' which may be an integer (copy-marker (cdr range)))) ranges)) +(defun agent-shell-markdown--sort-ranges (&rest range-collections) + "Merge RANGE-COLLECTIONS into a vector sorted by start position. +Each collection is a sequence of (BEG . END) cons cells — list or +vector — so already-sorted vectors can be re-merged without first +being flattened. Endpoints may be integers or markers. The +returned vector enables O(log n) lookup via +`agent-shell-markdown--in-avoid-range-p'." + (sort (apply #'vconcat range-collections) + (lambda (a b) (< (car a) (car b))))) + (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)) + "Return the avoid-range fully containing START..END, or nil. + +AVOID-RANGES is a vector of (BEG . END) cons cells sorted by BEG +— produce one with `agent-shell-markdown--sort-ranges'. +Endpoints may be integers or markers. Ranges are assumed +non-overlapping (callers compose disjoint sources), so the first +candidate found suffices to decide containment. The returned +range lets callers advance point past it instead of re-checking +the same range on every match inside it." + (when avoid-ranges + (let ((lo 0) + (hi (length avoid-ranges)) + (candidate nil)) + (while (< lo hi) + (let* ((mid (/ (+ lo hi) 2)) + (range (aref avoid-ranges mid))) + (if (<= (car range) start) + (setq candidate range + lo (1+ mid)) + (setq hi mid)))) + (when (and candidate (<= end (cdr candidate))) + candidate)))) (defun agent-shell-markdown--source-block-ranges () "Return list of (start . end) ranges covering fenced code blocks. From f5b826dbe3191f366abd03c73c15444ab719e6cd Mon Sep 17 00:00:00 2001 From: xenodium <8107219+xenodium@users.noreply.github.com> Date: Thu, 21 May 2026 17:28:36 +0100 Subject: [PATCH 10/31] Improving streaming performance MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Skip re-rendering already-processed prefix on each call Streaming use of `agent-shell-markdown-replace-markup' calls the renderer once per chunk, so every pass was re-walking the entire buffer from `point-min' on each call — O(N^2) over N chunks. Track a per-buffer "watermark": the position before which content is fully rendered and stable. Stored as an `agent-shell-markdown-watermark' text property on the first character (so a propertized string returned from `agent-shell-markdown-convert' carries it without a buffer-local variable). Re-stamped at the end of each render to: - start of the last line in the buffer; clamped back to - start of any open fence (so a future closing ``` still matches), - start of any rendered table whose extension is still possible (so streamed continuation rows still fold in). The next call narrows to (watermark, point-max) and every pass runs inside the narrow. `:force' on `agent-shell-markdown-replace-markup' drops the watermark and re-renders the whole buffer. --- agent-shell-markdown.el | 209 ++++++++++++++++++++++------ tests/agent-shell-markdown-tests.el | 89 ++++++++++++ 2 files changed, 256 insertions(+), 42 deletions(-) diff --git a/agent-shell-markdown.el b/agent-shell-markdown.el index 44461b1c..012bed54 100644 --- a/agent-shell-markdown.el +++ b/agent-shell-markdown.el @@ -196,7 +196,7 @@ For example: (agent-shell-markdown-replace-markup) (buffer-string))) -(cl-defun agent-shell-markdown-replace-markup () +(cl-defun agent-shell-markdown-replace-markup (&key force) "Replace Markdown markup in current buffer with propertized text. Rewrites the buffer in place: markup characters are removed and @@ -214,48 +214,70 @@ 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." +styling, and table styling run once after the loop. + +The buffer is narrowed to the streaming watermark for the +duration of the passes — content before the watermark is already +rendered and stable, so every regex / property scan starts there +instead of `point-min'. The watermark is read off the +`agent-shell-markdown-watermark' text property on the first +character and re-stamped at the end of the call. Pass FORCE +non-nil to drop the watermark and re-render the whole buffer +(useful after mid-buffer edits, or for tests)." (save-excursion - (let* ((source-ranges (agent-shell-markdown--sort-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 (agent-shell-markdown--sort-ranges - source-ranges rendered-ranges)))) - (avoid-ranges (agent-shell-markdown--sort-ranges - 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))))) + (when force + (with-silent-modifications + (remove-text-properties (point-min) (point-max) + '(agent-shell-markdown-watermark nil)))) + (let ((watermark (agent-shell-markdown--watermark-start))) + (save-restriction + (narrow-to-region watermark (point-max)) + (let* ((source-ranges (agent-shell-markdown--sort-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 (agent-shell-markdown--sort-ranges + source-ranges rendered-ranges)))) + (avoid-ranges (agent-shell-markdown--sort-ranges + 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. Watermark backs off past any rendered + ;; table whose extension is still possible (see + ;; `--set-watermark'), so `--find-tables' under the narrow + ;; always sees the existing `agent-shell-markdown-table-source' + ;; needed to fold new rows in. + (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))))) + (agent-shell-markdown--set-watermark))) (cl-defun agent-shell-markdown--replace-bolds (&key avoid-ranges) "Replace `**X**' / `__X__' spans in current buffer with bold X. @@ -1702,6 +1724,109 @@ Resolves `agent-shell-markdown-image-max-width' which may be an integer (window-body-width window t)))) agent-shell-markdown-image-max-width)) +(defun agent-shell-markdown--watermark-start () + "Return the position the next scan should start from. + +Reads the `agent-shell-markdown-watermark' text property off the +first character. When absent or out of range, returns +`point-min' (whole-buffer scan — the conservative default for the +first call or after the watermark anchor has been rewritten away). + +The property is stored on the rendered text itself so it travels +with the string when callers shuttle the buffer contents around +via `agent-shell-markdown-convert', avoiding a buffer-local +variable that wouldn't survive serialization." + (let ((stored (and (> (point-max) (point-min)) + (get-text-property (point-min) + 'agent-shell-markdown-watermark)))) + (if (and (integerp stored) + (>= stored (point-min)) + (<= stored (point-max))) + stored + (point-min)))) + +(defun agent-shell-markdown--extending-table-start () + "Start of a table region whose rendering is still pending, or nil. + +Walks lines backward from `point-max' through pipe-row +candidates. Two cases warrant a backoff: + +- A line already carries `agent-shell-markdown-table-source' — + i.e. a previously-rendered table whose new rows we want + `--find-tables' to fold in on the next call. + +- An unbroken streak of raw pipe-rows leads back from + `point-max' — i.e. a table whose rows have streamed in but + whose row count has never been high enough at one call for + `--find-tables' to render. Without this backoff, the + watermark advances past each row one chunk at a time and the + table is silently never rendered. + +Stops on the first non-pipe-row non-table line — past that +point, a table from there can no longer accumulate." + (when (> (point-max) (point-min)) + (save-excursion + (goto-char (point-max)) + (let (rendered-table-start + pending-table-start + (continue t)) + (while continue + (forward-line -1) + (cond + ;; Hit a char already inside a rendered table — find its start. + ((get-text-property (point) 'agent-shell-markdown-table-source) + (setq rendered-table-start + (or (previous-single-property-change + (1+ (point)) + 'agent-shell-markdown-table-source) + (point-min))) + (setq continue nil)) + ((bobp) (setq continue nil)) + ;; Raw pipe-row — remember the earliest streak entry. + ((looking-at agent-shell-markdown--table-line-regexp) + (setq pending-table-start (point))) + ;; Anything else — extension impossible from here. + (t (setq continue nil)))) + (or rendered-table-start pending-table-start))))) + +(defun agent-shell-markdown--set-watermark () + "Stamp the safe-frontier on the first character as a text property. + +Safe-frontier = start of the last line in the buffer, clamped +back to the start of: +- the oldest open fenced block (if any), so the closing fence on + a future chunk gets matched; +- a rendered table that might still extend (see + `--extending-table-start'), so `--find-tables' under the narrow + on the next call still sees its stashed + `agent-shell-markdown-table-source' and folds streamed rows in. + +Any position before the frontier is fully rendered and stable; +any position from the frontier onward may still resolve into new +markup as more chunks stream in. Single-line patterns (bold, +italic, strike, header, link, image, inline code, divider) cannot +span a newline, so backing off to start-of-last-line covers their +split-across-chunks case. Open inline backticks already extend +only to end-of-line, so they're naturally within that zone." + (when (> (point-max) (point-min)) + (let* ((source-ranges (agent-shell-markdown--source-block-ranges)) + (open-fence-start + (let ((last (car (last source-ranges)))) + (when (and last (= (cdr last) (point-max))) + (car last)))) + (extending-table-start + (agent-shell-markdown--extending-table-start)) + (last-line-start + (save-excursion (goto-char (point-max)) + (line-beginning-position))) + (frontier (apply #'min + (delq nil (list last-line-start + open-fence-start + extending-table-start))))) + (with-silent-modifications + (put-text-property (point-min) (1+ (point-min)) + 'agent-shell-markdown-watermark frontier))))) + (defun agent-shell-markdown--make-markers (ranges) "Convert each (start . end) in RANGES to (start-marker . end-marker)." (mapcar (lambda (range) diff --git a/tests/agent-shell-markdown-tests.el b/tests/agent-shell-markdown-tests.el index 6ad45c19..dc0f5b02 100644 --- a/tests/agent-shell-markdown-tests.el +++ b/tests/agent-shell-markdown-tests.el @@ -786,6 +786,95 @@ A " nil) (" 2 " nil) ("│" (agent-shell-markdown-table-border)))))) +(ert-deftest agent-shell-markdown-watermark-skips-prefix-on-streamed-append () + ;; After a render, the prefix carries the watermark text property and + ;; the next render — narrowed to (watermark, point-max) — must not + ;; revisit the rendered prefix. Verify by injecting a sentinel + ;; `font-lock-face' at point-min after the first render; the mirror + ;; pass on the second render would overwrite it if the prefix were + ;; re-scanned, but with the watermark in place it stays put. + (with-temp-buffer + (insert "**hello**\n") + (agent-shell-markdown-replace-markup) + (put-text-property (point-min) (1+ (point-min)) + 'font-lock-face 'agent-shell-markdown-test-sentinel) + (goto-char (point-max)) + (insert "**world**\n") + (agent-shell-markdown-replace-markup) + (should (eq (get-text-property (point-min) 'font-lock-face) + 'agent-shell-markdown-test-sentinel)) + ;; And the newly-streamed bold still rendered normally. + (should (string-match-p "^hello\nworld\n$" + (substring-no-properties (buffer-string)))))) + +(ert-deftest agent-shell-markdown-watermark-keeps-pending-table-in-scope () + ;; When table rows stream in one at a time, the table needs at least + ;; two consecutive pipe-rows in scope before `--find-tables' will + ;; render anything. If the watermark advances past each row as it + ;; arrives, the renderer never sees enough rows at once and the + ;; whole table stays raw forever. `--extending-table-start' has to + ;; back off through a streak of raw pipe-rows just like it does + ;; through a rendered table, so the next chunk's narrow includes the + ;; whole accumulating table. + (with-temp-buffer + (insert "intro paragraph\n\n") + (agent-shell-markdown-replace-markup) + (dolist (row '("| A | B |\n" + "|---|---|\n" + "| 1 | 2 |\n" + "| 3 | 4 |\n")) + (goto-char (point-max)) + (insert row) + (agent-shell-markdown-replace-markup)) + (should (string-match-p "│" + (substring-no-properties (buffer-string)))) + (should-not (string-match-p "^| A | B |" + (substring-no-properties (buffer-string)))))) + +(ert-deftest agent-shell-markdown-inline-code-completes-across-chunk-boundary () + ;; LLM streams may split an inline-code span across chunks (e.g. + ;; `\\`co' lands first, then `de\\`'). The first render sees an + ;; unclosed backtick on the last line — `--inline-code-ranges' marks + ;; the rest of the line as a still-streaming range so `--style- + ;; inline-code's two-backtick regex doesn't match yet, and the + ;; watermark stays at the start of that line. When the closing + ;; backtick arrives on the same line in the next chunk, the second + ;; render matches the full span and strips both backticks. + ;; + ;; This regression-guards the watermark too: if a future change + ;; advanced the watermark past the open backtick, the second render + ;; would narrow past the opener and leave it raw. + (with-temp-buffer + (insert "text `co") + (agent-shell-markdown-replace-markup) + (should (string-match-p "`co" + (substring-no-properties (buffer-string)))) + (goto-char (point-max)) + (insert "de`") + (agent-shell-markdown-replace-markup) + (should (equal (substring-no-properties (buffer-string)) + "text code")) + (should (eq (get-text-property (- (point-max) 1) 'face) + 'agent-shell-markdown-inline-code)))) + +(ert-deftest agent-shell-markdown-replace-markup-force-clears-watermark () + ;; The `:force' key drops the stored watermark before the call, so + ;; the whole buffer is re-scanned. We simulate a maximally + ;; advanced watermark by stamping one at `point-max' — a non-force + ;; call narrows to (point-max, point-max) and is a no-op; a `:force + ;; t' call clears the watermark first and renders normally. + (with-temp-buffer + (insert "**bold**\n") + (with-silent-modifications + (put-text-property (point-min) (1+ (point-min)) + 'agent-shell-markdown-watermark (point-max))) + (agent-shell-markdown-replace-markup) + (should (string-match-p "\\*\\*bold\\*\\*" + (substring-no-properties (buffer-string)))) + (agent-shell-markdown-replace-markup :force t) + (should-not (string-match-p "\\*\\*" + (substring-no-properties (buffer-string)))))) + (provide 'agent-shell-markdown-tests) ;;; agent-shell-markdown-tests.el ends here From 11894103b990e27a32c9b370a4b363ee92c8c99e Mon Sep 17 00:00:00 2001 From: xenodium <8107219+xenodium@users.noreply.github.com> Date: Thu, 21 May 2026 18:10:44 +0100 Subject: [PATCH 11/31] Fixes headings partially rendered when partially streamed --- agent-shell-markdown.el | 14 ++++++++---- tests/agent-shell-markdown-tests.el | 35 ++++++++++++++++++++++++----- 2 files changed, 39 insertions(+), 10 deletions(-) diff --git a/agent-shell-markdown.el b/agent-shell-markdown.el index 012bed54..94ffe8c5 100644 --- a/agent-shell-markdown.el +++ b/agent-shell-markdown.el @@ -396,14 +396,20 @@ 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'." +Requires an explicit trailing newline — a header at end-of-buffer +without `\\n' is treated as still streaming and left raw, so a +chunk that lands `# He' followed later by `llo World\\n' renders +the full `Hello World' on the second call rather than eagerly +facing `He' and leaving `llo World' plain. + +For example, the buffer \"## My title\\n\" becomes \"My title\\n\" +with face `agent-shell-markdown-header-2' on \"My title\"." (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) + (group (one-or-more (not (any "\n")))) "\n") nil t) (let* ((markup-start (match-beginning 0)) (markup-end (match-end 0)) @@ -415,7 +421,7 @@ face `agent-shell-markdown-header-2'." (text (buffer-substring (match-beginning 2) (match-end 2)))) (delete-region markup-start markup-end) (goto-char markup-start) - (insert text) + (insert text "\n") (add-face-text-property markup-start (+ markup-start (length text)) (intern (format "agent-shell-markdown-header-%d" diff --git a/tests/agent-shell-markdown-tests.el b/tests/agent-shell-markdown-tests.el index dc0f5b02..1e5dca79 100644 --- a/tests/agent-shell-markdown-tests.el +++ b/tests/agent-shell-markdown-tests.el @@ -111,20 +111,25 @@ '(("bold-strike" (agent-shell-markdown-bold agent-shell-markdown-strikethrough)))))) (ert-deftest agent-shell-markdown-convert-header-level-1 () + ;; Header rendering requires a trailing newline to complete; an + ;; eob-only header is treated as still streaming and left raw. (should (equal (agent-shell-markdown--deconstruct - (agent-shell-markdown-convert "# Title")) - '(("Title" (agent-shell-markdown-header-1)))))) + (agent-shell-markdown-convert "# Title\n")) + '(("Title" (agent-shell-markdown-header-1)) + ("\n" nil))))) (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)))))) + (agent-shell-markdown-convert "### Title\n")) + '(("Title" (agent-shell-markdown-header-3)) + ("\n" nil))))) (ert-deftest agent-shell-markdown-convert-header-with-bold () (should (equal (agent-shell-markdown--deconstruct - (agent-shell-markdown-convert "## **Big** title")) + (agent-shell-markdown-convert "## **Big** title\n")) '(("Big" (agent-shell-markdown-header-2 agent-shell-markdown-bold)) - (" title" (agent-shell-markdown-header-2)))))) + (" title" (agent-shell-markdown-header-2)) + ("\n" nil))))) (ert-deftest agent-shell-markdown-convert-fenced-block-protects-markup () (should (equal (agent-shell-markdown--deconstruct @@ -807,6 +812,24 @@ A " nil) (should (string-match-p "^hello\nworld\n$" (substring-no-properties (buffer-string)))))) +(ert-deftest agent-shell-markdown-header-waits-for-newline-across-chunks () + ;; A header split across two chunks (chunk 1 = `# He', chunk 2 = + ;; `llo World\\n') must not render eagerly on chunk 1 — the + ;; trailing-newline gate keeps `# He' raw, and chunk 2's render + ;; faces the entire `Hello World' once the line completes. + (with-temp-buffer + (insert "# He") + (agent-shell-markdown-replace-markup) + (should (equal (substring-no-properties (buffer-string)) "# He")) + (goto-char (point-max)) + (insert "llo World\n") + (agent-shell-markdown-replace-markup) + (should (equal (substring-no-properties (buffer-string)) + "Hello World\n")) + (dotimes (i (length "Hello World")) + (should (eq (get-text-property (+ (point-min) i) 'face) + 'agent-shell-markdown-header-1))))) + (ert-deftest agent-shell-markdown-watermark-keeps-pending-table-in-scope () ;; When table rows stream in one at a time, the table needs at least ;; two consecutive pipe-rows in scope before `--find-tables' will From 8f6fe6df172b37ac66e2fa26931f90bd64675085 Mon Sep 17 00:00:00 2001 From: xenodium <8107219+xenodium@users.noreply.github.com> Date: Thu, 21 May 2026 18:29:53 +0100 Subject: [PATCH 12/31] Render blockquotes --- agent-shell-markdown.el | 56 ++++++++++++++++++++++- tests/agent-shell-markdown-tests.el | 69 +++++++++++++++++++++++++++++ 2 files changed, 124 insertions(+), 1 deletion(-) diff --git a/agent-shell-markdown.el b/agent-shell-markdown.el index 94ffe8c5..33d178ff 100644 --- a/agent-shell-markdown.el +++ b/agent-shell-markdown.el @@ -93,6 +93,11 @@ "Face for link titles rendered by `agent-shell-markdown-convert'." :group 'agent-shell-markdown) +(defface agent-shell-markdown-blockquote + '((t :inherit font-lock-comment-face)) + "Face for blockquoted text 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'." @@ -256,6 +261,7 @@ non-nil to drop the watermark and re-render the whole buffer (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-blockquotes :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.). @@ -636,12 +642,60 @@ property, so the source markdown round-trips through copy/save." (add-text-properties rule-start rule-end (list 'display - (concat (propertize (make-string (agent-shell-markdown--display-width) ?\s) + (concat (propertize (make-string 12 ?\s) 'face '(:underline t)) "\n") 'agent-shell-markdown-frozen t 'rear-nonsticky '(display agent-shell-markdown-frozen)))))))) +(cl-defun agent-shell-markdown--style-blockquotes (&key avoid-ranges) + "Render `>'-prefixed lines as blockquotes with vertical bars. + +Each leading `>' character on the line is shown as `▌' via a +`display' text property; the underlying `>' chars stay in the +buffer so the source markdown round-trips through copy/save and +re-rendering remains idempotent. Remaining content on the line +gets face `agent-shell-markdown-blockquote' (composes with any +face already applied by an earlier pass — bold/italic/inline-code +inside a blockquote still render). + +Multiple nesting levels are supported: each leading `>' renders +as its own bar, so `>> text' shows two bars and `>>> text' three. +Whitespace between `>'s is preserved literally. + +Requires an explicit trailing newline — a blockquote line at +end-of-buffer without `\\n' is treated as still streaming and +left raw, matching the header behaviour. + +Lines inside any of AVOID-RANGES (e.g. fenced code blocks) are +left untouched." + (let ((case-fold-search nil) + (bar (propertize "▌" 'face 'agent-shell-markdown-blockquote))) + (goto-char (point-min)) + (while (re-search-forward + (rx bol (zero-or-more blank) + ">" (zero-or-more (any " \t>")) + (zero-or-more (not (any "\n"))) "\n") + nil t) + (let* ((line-start (match-beginning 0)) + (line-end (match-end 0)) + (avoid (agent-shell-markdown--in-avoid-range-p + line-start line-end avoid-ranges))) + (if avoid + (goto-char (cdr avoid)) + (save-excursion + (goto-char line-start) + (skip-chars-forward " \t" line-end) + (while (eq (char-after) ?>) + (put-text-property (point) (1+ (point)) 'display bar) + (forward-char 1) + (skip-chars-forward " \t" line-end))) + (add-face-text-property line-start (1- line-end) + 'agent-shell-markdown-blockquote) + (add-text-properties line-start line-end + '(agent-shell-markdown-frozen t + rear-nonsticky (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 diff --git a/tests/agent-shell-markdown-tests.el b/tests/agent-shell-markdown-tests.el index 1e5dca79..88d754db 100644 --- a/tests/agent-shell-markdown-tests.el +++ b/tests/agent-shell-markdown-tests.el @@ -812,6 +812,75 @@ A " nil) (should (string-match-p "^hello\nworld\n$" (substring-no-properties (buffer-string)))))) +(ert-deftest agent-shell-markdown-convert-blockquote-single-level () + ;; `> text\n' keeps the `>' in the buffer (source round-trips) but + ;; shows `▌' as a display override. The line content carries the + ;; blockquote face. + (let ((s (agent-shell-markdown-convert "> hello\n"))) + (should (equal (substring-no-properties s) "> hello\n")) + (should (equal (get-text-property 0 'display s) + (propertize "▌" + 'face 'agent-shell-markdown-blockquote))) + (should (eq (get-text-property 2 'face s) + 'agent-shell-markdown-blockquote)) + (should (eq (get-text-property 0 'agent-shell-markdown-frozen s) t)))) + +(ert-deftest agent-shell-markdown-convert-blockquote-multi-level () + ;; Each leading `>' gets its own bar — `>> ' shows two, `>>> ' + ;; shows three. Whitespace between `>'s is preserved. + (let ((s (agent-shell-markdown-convert ">> level 2\n"))) + (should (equal (get-text-property 0 'display s) + (propertize "▌" + 'face 'agent-shell-markdown-blockquote))) + (should (equal (get-text-property 1 'display s) + (propertize "▌" + 'face 'agent-shell-markdown-blockquote)))) + (let ((s (agent-shell-markdown-convert ">>> level 3\n"))) + (dolist (i '(0 1 2)) + (should (equal (get-text-property i 'display s) + (propertize "▌" + 'face 'agent-shell-markdown-blockquote)))))) + +(ert-deftest agent-shell-markdown-convert-blockquote-with-bold () + ;; Inline markup inside a blockquote still renders — bold runs + ;; before blockquote, and the blockquote face composes on top so + ;; the bold text ends up with both faces. + (should (equal (agent-shell-markdown--deconstruct + (agent-shell-markdown-convert "> hello **world**\n")) + '(("> hello " (agent-shell-markdown-blockquote)) + ("world" (agent-shell-markdown-blockquote + agent-shell-markdown-bold)) + ("\n" nil))))) + +(ert-deftest agent-shell-markdown-blockquote-waits-for-newline-across-chunks () + ;; A blockquote line streamed across two chunks (`> hel' then `lo\n') + ;; must not render until the line completes — otherwise `> hel' + ;; would face only `hel' and leave the rest plain on the next call. + (with-temp-buffer + (insert "> hel") + (agent-shell-markdown-replace-markup) + (should (equal (substring-no-properties (buffer-string)) "> hel")) + (should-not (get-text-property (point-min) 'display)) + (goto-char (point-max)) + (insert "lo\n") + (agent-shell-markdown-replace-markup) + (should (equal (get-text-property (point-min) 'display) + (propertize "▌" + 'face 'agent-shell-markdown-blockquote))) + (should (eq (get-text-property (+ (point-min) 2) 'face) + 'agent-shell-markdown-blockquote)))) + +(ert-deftest agent-shell-markdown-blockquote-inside-fence-stays-raw () + ;; A `>'-prefixed line inside a fenced code block must not be + ;; styled — the source-block range is in avoid-ranges. + (let ((s (agent-shell-markdown-convert "``` +> not a quote +``` +"))) + (should (string-match-p "^> not a quote" (substring-no-properties s))) + (let ((quote-pos (string-match "> not a quote" (substring-no-properties s)))) + (should-not (get-text-property quote-pos 'display s))))) + (ert-deftest agent-shell-markdown-header-waits-for-newline-across-chunks () ;; A header split across two chunks (chunk 1 = `# He', chunk 2 = ;; `llo World\\n') must not render eagerly on chunk 1 — the From 8065f8591071faa9f62f99535d4cc56878468fe4 Mon Sep 17 00:00:00 2001 From: xenodium <8107219+xenodium@users.noreply.github.com> Date: Thu, 21 May 2026 18:50:30 +0100 Subject: [PATCH 13/31] Fixing blockquote test --- tests/agent-shell-markdown-tests.el | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/tests/agent-shell-markdown-tests.el b/tests/agent-shell-markdown-tests.el index 88d754db..b9a09c1a 100644 --- a/tests/agent-shell-markdown-tests.el +++ b/tests/agent-shell-markdown-tests.el @@ -872,14 +872,20 @@ A " nil) (ert-deftest agent-shell-markdown-blockquote-inside-fence-stays-raw () ;; A `>'-prefixed line inside a fenced code block must not be - ;; styled — the source-block range is in avoid-ranges. - (let ((s (agent-shell-markdown-convert "``` + ;; styled as a blockquote — the source-block range is in + ;; avoid-ranges. The `>' should keep its source-block face and not + ;; get the blockquote face. + (let* ((s (agent-shell-markdown-convert "``` > not a quote ``` -"))) - (should (string-match-p "^> not a quote" (substring-no-properties s))) - (let ((quote-pos (string-match "> not a quote" (substring-no-properties s)))) - (should-not (get-text-property quote-pos 'display s))))) +")) + (quote-pos (string-match "> not a quote" + (substring-no-properties s)))) + (should quote-pos) + (should (eq (get-text-property quote-pos 'face s) + 'agent-shell-markdown-source-block)) + (should-not (eq (get-text-property quote-pos 'face s) + 'agent-shell-markdown-blockquote)))) (ert-deftest agent-shell-markdown-header-waits-for-newline-across-chunks () ;; A header split across two chunks (chunk 1 = `# He', chunk 2 = From de08d34fa35a62b72a2dca1c9cf9675075a89eec Mon Sep 17 00:00:00 2001 From: xenodium <8107219+xenodium@users.noreply.github.com> Date: Thu, 21 May 2026 22:39:57 +0100 Subject: [PATCH 14/31] Strip rendered properties when pasting copied text --- agent-shell-markdown.el | 10 +++++++++- tests/agent-shell-markdown-tests.el | 16 ++++++++++++++++ 2 files changed, 25 insertions(+), 1 deletion(-) diff --git a/agent-shell-markdown.el b/agent-shell-markdown.el index 33d178ff..13206258 100644 --- a/agent-shell-markdown.el +++ b/agent-shell-markdown.el @@ -282,7 +282,15 @@ non-nil to drop the watermark and re-render the whole buffer ;; / 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))))) + (point-min) (point-max)) + ;; Tag rendered chars so a yank into another buffer drops the + ;; styling, display overrides, internal markers, and keymaps + ;; we layered on — paste should give plain chars, not our + ;; implementation cruft. + (put-text-property (point-min) (point-max) + 'yank-handler + (list (lambda (s) + (insert (substring-no-properties s)))))))) (agent-shell-markdown--set-watermark))) (cl-defun agent-shell-markdown--replace-bolds (&key avoid-ranges) diff --git a/tests/agent-shell-markdown-tests.el b/tests/agent-shell-markdown-tests.el index b9a09c1a..87224239 100644 --- a/tests/agent-shell-markdown-tests.el +++ b/tests/agent-shell-markdown-tests.el @@ -812,6 +812,22 @@ A " nil) (should (string-match-p "^hello\nworld\n$" (substring-no-properties (buffer-string)))))) +(ert-deftest agent-shell-markdown-yank-strips-properties () + ;; Rendered chars carry a `yank-handler' that strips every text + ;; property on paste — display overrides, internal markers, faces, + ;; keymaps — so a copy/paste into another buffer gives plain chars, + ;; not our implementation cruft. + (with-temp-buffer + (insert "**bold** and `code`\n") + (agent-shell-markdown-replace-markup) + (kill-new (buffer-substring (point-min) (point-max)))) + (with-temp-buffer + (yank) + (let ((pos (point-min))) + (while (< pos (point-max)) + (should-not (text-properties-at pos)) + (setq pos (1+ pos)))))) + (ert-deftest agent-shell-markdown-convert-blockquote-single-level () ;; `> text\n' keeps the `>' in the buffer (source round-trips) but ;; shows `▌' as a display override. The line content carries the From b53ebebde5854c11aea3813fa7731bbee2b26a67 Mon Sep 17 00:00:00 2001 From: xenodium <8107219+xenodium@users.noreply.github.com> Date: Fri, 22 May 2026 14:02:50 +0100 Subject: [PATCH 15/31] Improve code block handling --- agent-shell-markdown.el | 60 +++++++++++++++++++---------- tests/agent-shell-markdown-tests.el | 16 ++++++++ 2 files changed, 56 insertions(+), 20 deletions(-) diff --git a/agent-shell-markdown.el b/agent-shell-markdown.el index 13206258..611d5f22 100644 --- a/agent-shell-markdown.el +++ b/agent-shell-markdown.el @@ -739,23 +739,32 @@ 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)) + ;; Group 2 captures the opening backtick run; `backref' on the + ;; closer matches the same literal run, so a 4-backtick outer + ;; fence requires a 4-backtick close — a 3-backtick line inside + ;; is just body. Note this is slightly tighter than CommonMark + ;; (which permits close > open), but every-LLM-I've-seen emits + ;; matched counts, so the simplification is worth it. (while (re-search-forward - (rx (group bol (zero-or-more blank) "```" (zero-or-more blank) + (rx (group bol (zero-or-more blank) + (group (>= 3 "`")) + (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))) + (group bol (zero-or-more blank) + (backref 2) + (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)) + (lang (buffer-substring-no-properties (match-beginning 3) + (match-end 3))) + (body-start (copy-marker (match-beginning 4))) + (body-end (copy-marker (match-end 4))) + (close-start (match-beginning 5)) + (close-end (match-end 5)) (highlighted (agent-shell-markdown--highlight-code (buffer-substring-no-properties body-start body-end) lang))) @@ -1939,11 +1948,16 @@ the same range on every match inside it." (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 +Each range spans from the opening fence line to the start of the +line after the closing fence 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. +Fence widths pair like CommonMark: an opening fence of N +backticks (N>=3) is closed only by a fence line with M>=N +backticks, so a 4-backtick outer fence wraps any 3-backtick inner +fence as body rather than terminating on it. + For example, given the buffer: ```python @@ -1952,20 +1966,26 @@ For example, given the buffer: returns a list with one range covering the whole block." (let ((ranges '()) - (open nil) + (open-start nil) + (open-count 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)) + (rx bol (zero-or-more whitespace) + (group (>= 3 "`")) + (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))) + (let ((count (- (match-end 1) (match-beginning 1)))) + (cond + ((and open-count (>= count open-count)) + (push (cons open-start (line-beginning-position 2)) ranges) + (setq open-start nil open-count nil)) + ((not open-count) + (setq open-start (match-beginning 0) + open-count count))))) + (when open-count + (push (cons open-start (point-max)) ranges))) (nreverse ranges))) (defun agent-shell-markdown--frozen-ranges () diff --git a/tests/agent-shell-markdown-tests.el b/tests/agent-shell-markdown-tests.el index 87224239..9fbcc6e1 100644 --- a/tests/agent-shell-markdown-tests.el +++ b/tests/agent-shell-markdown-tests.el @@ -238,6 +238,22 @@ body '(("body " (agent-shell-markdown-source-block)))))) +(ert-deftest agent-shell-markdown-convert-source-block-nested-fences () + ;; A 4-backtick outer fence wraps inner 3-backtick fences as + ;; literal body — the inner ```python ... ``` is *not* re-rendered + ;; as a code block. Mirrors CommonMark's variable-width fence + ;; rule: a closer must match the opener's backtick count, and a + ;; shorter run inside is part of the body. + (should (equal (agent-shell-markdown--deconstruct + (agent-shell-markdown-convert + "````markdown +```python +print(\"hi\") +``` +````")) + '(("```python\nprint(\"hi\")\n```\n" + (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 *plus* the From 2c2990b0c07ad218833e63a15dff453bcc1cda7c Mon Sep 17 00:00:00 2001 From: xenodium <8107219+xenodium@users.noreply.github.com> Date: Fri, 22 May 2026 14:17:53 +0100 Subject: [PATCH 16/31] Render code block language --- agent-shell-markdown.el | 34 ++++++++++++++++++++++------- tests/agent-shell-markdown-tests.el | 25 +++++++++++++++++++++ 2 files changed, 51 insertions(+), 8 deletions(-) diff --git a/agent-shell-markdown.el b/agent-shell-markdown.el index 611d5f22..ff31f716 100644 --- a/agent-shell-markdown.el +++ b/agent-shell-markdown.el @@ -151,6 +151,11 @@ the window, so the block reads as a contiguous panel rather than a per-char highlight." :group 'agent-shell-markdown) +(defface agent-shell-markdown-source-block-language + '((t :inherit (italic font-lock-type-face agent-shell-markdown-source-block))) + "Face for the language label shown above a fenced source block." + :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 @@ -805,10 +810,10 @@ with `emacs-lisp-mode' face properties on the body and a line-prefix ,prefix wrap-prefix ,prefix))) ;; Vertical padding via `display' property. The first body - ;; char renders as "" and the + ;; 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 + ;; visually inserting bg-tinted lines 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 @@ -816,13 +821,26 @@ with `emacs-lisp-mode' face properties on the body and a ;; 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))) + ;; + ;; When the fence carries a language, the top padding grows + ;; to three lines with the language label on the middle one; + ;; languageless fences keep the single-line padding so we + ;; don't waste vertical space when there's no label to show. + (let* ((vpad (propertize "\n" 'face + 'agent-shell-markdown-source-block)) + (top-pad (if (string-empty-p lang) + vpad + (concat vpad + (propertize + lang 'face + 'agent-shell-markdown-source-block-language) + vpad + vpad))) + (first-pos (marker-position body-start)) + (last-pos (marker-position body-end))) (put-text-property first-pos (1+ first-pos) 'display - (concat vpad + (concat top-pad (buffer-substring first-pos (1+ first-pos)))) (put-text-property last-pos (1+ last-pos) diff --git a/tests/agent-shell-markdown-tests.el b/tests/agent-shell-markdown-tests.el index 9fbcc6e1..03f42704 100644 --- a/tests/agent-shell-markdown-tests.el +++ b/tests/agent-shell-markdown-tests.el @@ -238,6 +238,31 @@ body '(("body " (agent-shell-markdown-source-block)))))) +(ert-deftest agent-shell-markdown-convert-source-block-language-padding () + ;; A language-tagged fence renders with 3 lines of top padding + ;; where the middle (line 2) shows the language label. No- + ;; language fences keep the single-line top padding so the empty + ;; lines aren't wasted on something that has nothing to label. + (let* ((with-lang (agent-shell-markdown-convert "```python +print(\"hi\") +``` +")) + (no-lang (agent-shell-markdown-convert "``` +body +``` +")) + (with-lang-display (get-text-property 0 'display with-lang)) + (no-lang-display (get-text-property 0 'display no-lang))) + ;; With-language: display string is "\nLANG\n\n" + first-char. + (should (equal (substring-no-properties with-lang-display) + "\npython\n\np")) + ;; The "python" segment carries the language face. + (should (eq (get-text-property 1 'face with-lang-display) + 'agent-shell-markdown-source-block-language)) + ;; No-language: keep the original single-newline padding. + (should (equal (substring-no-properties no-lang-display) + "\nb")))) + (ert-deftest agent-shell-markdown-convert-source-block-nested-fences () ;; A 4-backtick outer fence wraps inner 3-backtick fences as ;; literal body — the inner ```python ... ``` is *not* re-rendered From 8286a09e19adbf229dfaeac972c8baedab42d275 Mon Sep 17 00:00:00 2001 From: xenodium <8107219+xenodium@users.noreply.github.com> Date: Fri, 22 May 2026 14:49:07 +0100 Subject: [PATCH 17/31] Add copy buttons to snippets --- agent-shell-markdown.el | 33 ++++++++++++++++++----------- tests/agent-shell-markdown-tests.el | 10 ++++++--- 2 files changed, 28 insertions(+), 15 deletions(-) diff --git a/agent-shell-markdown.el b/agent-shell-markdown.el index ff31f716..1a27169e 100644 --- a/agent-shell-markdown.el +++ b/agent-shell-markdown.el @@ -822,20 +822,29 @@ with `emacs-lisp-mode' face properties on the body and a ;; stripe on top of the prefix, which then flashes the region ;; face when the underlying char is selected. ;; - ;; When the fence carries a language, the top padding grows - ;; to three lines with the language label on the middle one; - ;; languageless fences keep the single-line padding so we - ;; don't waste vertical space when there's no label to show. + ;; Top padding is three lines with the label on the middle + ;; one — "LANG ⧉" if a language was given, otherwise the + ;; fallback "snippet ⧉". The whole label is actionable: RET + ;; or mouse-1 anywhere on it kills the body to the kill ring. (let* ((vpad (propertize "\n" 'face 'agent-shell-markdown-source-block)) - (top-pad (if (string-empty-p lang) - vpad - (concat vpad - (propertize - lang 'face - 'agent-shell-markdown-source-block-language) - vpad - vpad))) + (label-text (concat (if (string-empty-p lang) "snippet" lang) + " ⧉")) + (label + (propertize + label-text + 'face 'agent-shell-markdown-source-block-language + 'mouse-face 'highlight + 'pointer 'hand + 'keymap (agent-shell-markdown--make-ret-binding-map + (lambda () + (interactive) + (kill-new + (buffer-substring-no-properties + (marker-position body-start) + (marker-position body-end))) + (message "Copied"))))) + (top-pad (concat vpad label vpad vpad)) (first-pos (marker-position body-start)) (last-pos (marker-position body-end))) (put-text-property first-pos (1+ first-pos) diff --git a/tests/agent-shell-markdown-tests.el b/tests/agent-shell-markdown-tests.el index 03f42704..ca40fa94 100644 --- a/tests/agent-shell-markdown-tests.el +++ b/tests/agent-shell-markdown-tests.el @@ -253,12 +253,16 @@ body ")) (with-lang-display (get-text-property 0 'display with-lang)) (no-lang-display (get-text-property 0 'display no-lang))) - ;; With-language: display string is "\nLANG\n\n" + first-char. + ;; With-language: display is "\nLANG ⧉\n\n" + first-char. The + ;; copy character carries `mouse-face' + a keymap that kills the + ;; body to the kill ring on RET / mouse-1. (should (equal (substring-no-properties with-lang-display) - "\npython\n\np")) - ;; The "python" segment carries the language face. + "\npython ⧉\n\np")) (should (eq (get-text-property 1 'face with-lang-display) 'agent-shell-markdown-source-block-language)) + (should (eq (get-text-property 8 'mouse-face with-lang-display) + 'highlight)) + (should (keymapp (get-text-property 8 'keymap with-lang-display))) ;; No-language: keep the original single-newline padding. (should (equal (substring-no-properties no-lang-display) "\nb")))) From 5a8758b94234ece9cdbc1074796ecba5c194bfb0 Mon Sep 17 00:00:00 2001 From: xenodium <8107219+xenodium@users.noreply.github.com> Date: Fri, 22 May 2026 18:47:04 +0100 Subject: [PATCH 18/31] Fixing code block test supporting labels + button --- tests/agent-shell-markdown-tests.el | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/tests/agent-shell-markdown-tests.el b/tests/agent-shell-markdown-tests.el index ca40fa94..6105c06f 100644 --- a/tests/agent-shell-markdown-tests.el +++ b/tests/agent-shell-markdown-tests.el @@ -239,10 +239,11 @@ body " (agent-shell-markdown-source-block)))))) (ert-deftest agent-shell-markdown-convert-source-block-language-padding () - ;; A language-tagged fence renders with 3 lines of top padding - ;; where the middle (line 2) shows the language label. No- - ;; language fences keep the single-line top padding so the empty - ;; lines aren't wasted on something that has nothing to label. + ;; Every fence renders with 3 lines of top padding and a label on + ;; the middle line — "LANG ⧉" when the fence declared a language, + ;; the fallback "snippet ⧉" otherwise. The whole label is + ;; actionable (RET / mouse-1 kills the body to the kill ring), not + ;; just the copy glyph. (let* ((with-lang (agent-shell-markdown-convert "```python print(\"hi\") ``` @@ -253,19 +254,18 @@ body ")) (with-lang-display (get-text-property 0 'display with-lang)) (no-lang-display (get-text-property 0 'display no-lang))) - ;; With-language: display is "\nLANG ⧉\n\n" + first-char. The - ;; copy character carries `mouse-face' + a keymap that kills the - ;; body to the kill ring on RET / mouse-1. (should (equal (substring-no-properties with-lang-display) "\npython ⧉\n\np")) - (should (eq (get-text-property 1 'face with-lang-display) - 'agent-shell-markdown-source-block-language)) - (should (eq (get-text-property 8 'mouse-face with-lang-display) - 'highlight)) - (should (keymapp (get-text-property 8 'keymap with-lang-display))) - ;; No-language: keep the original single-newline padding. (should (equal (substring-no-properties no-lang-display) - "\nb")))) + "\nsnippet ⧉\n\nb")) + ;; Label face + actionable props cover the whole label (both the + ;; first char of the name and the ⧉ glyph). + (dolist (i '(1 8)) + (should (eq (get-text-property i 'face with-lang-display) + 'agent-shell-markdown-source-block-language)) + (should (eq (get-text-property i 'mouse-face with-lang-display) + 'highlight)) + (should (keymapp (get-text-property i 'keymap with-lang-display)))))) (ert-deftest agent-shell-markdown-convert-source-block-nested-fences () ;; A 4-backtick outer fence wraps inner 3-backtick fences as From 48a6152ee64ec933b71a2ab132bbdd1c620a2642 Mon Sep 17 00:00:00 2001 From: xenodium <8107219+xenodium@users.noreply.github.com> Date: Sat, 23 May 2026 07:41:11 +0100 Subject: [PATCH 19/31] Fixing incomplete table header recognition while streaming --- agent-shell-markdown.el | 32 ++++++++++++++++++++++++----- tests/agent-shell-markdown-tests.el | 27 ++++++++++++++++++++++++ 2 files changed, 54 insertions(+), 5 deletions(-) diff --git a/agent-shell-markdown.el b/agent-shell-markdown.el index 1a27169e..e38fffe7 100644 --- a/agent-shell-markdown.el +++ b/agent-shell-markdown.el @@ -868,6 +868,14 @@ with `emacs-lisp-mode' face properties on the body and a line-end) "Regexp matching a single line of a markdown table.") +(defconst agent-shell-markdown--table-pending-line-regexp + (rx line-start (zero-or-more (any " \t")) "|") + "Lenient regexp matching a line that might still be streaming into +a table row — anything starting with `|' (after optional leading +whitespace). Used by `--extending-table-start' so the watermark +can back off past a partial separator like `|---|---|----' that +hasn't grown its closing `|' yet.") + (defconst agent-shell-markdown--table-separator-regexp (rx line-start (zero-or-more (any " \t")) @@ -1870,12 +1878,19 @@ Stops on the first non-pipe-row non-table line — past that point, a table from there can no longer accumulate." (when (> (point-max) (point-min)) (save-excursion + ;; Walk from the last content line. `forward-line 0' moves to + ;; the start of the line containing point; if that landed us on + ;; an empty trailing line (buffer ends with `\\n'), step one + ;; line further back so the loop's first iteration examines + ;; actual content rather than the empty tail. (goto-char (point-max)) + (forward-line 0) + (when (and (eobp) (not (bobp))) + (forward-line -1)) (let (rendered-table-start pending-table-start (continue t)) (while continue - (forward-line -1) (cond ;; Hit a char already inside a rendered table — find its start. ((get-text-property (point) 'agent-shell-markdown-table-source) @@ -1885,10 +1900,17 @@ point, a table from there can no longer accumulate." 'agent-shell-markdown-table-source) (point-min))) (setq continue nil)) - ((bobp) (setq continue nil)) - ;; Raw pipe-row — remember the earliest streak entry. - ((looking-at agent-shell-markdown--table-line-regexp) - (setq pending-table-start (point))) + ;; Pipe-row (or still-streaming partial of one) — remember + ;; the earliest streak entry and step back another line. + ;; The lenient regex also matches partial separators that + ;; haven't grown their closing `|' yet, so the watermark + ;; doesn't slip past the header while the separator is + ;; mid-stream. + ((looking-at agent-shell-markdown--table-pending-line-regexp) + (setq pending-table-start (point)) + (if (bobp) + (setq continue nil) + (forward-line -1))) ;; Anything else — extension impossible from here. (t (setq continue nil)))) (or rendered-table-start pending-table-start))))) diff --git a/tests/agent-shell-markdown-tests.el b/tests/agent-shell-markdown-tests.el index 6105c06f..ec6a8277 100644 --- a/tests/agent-shell-markdown-tests.el +++ b/tests/agent-shell-markdown-tests.el @@ -990,6 +990,33 @@ A " nil) (should-not (string-match-p "^| A | B |" (substring-no-properties (buffer-string)))))) +(ert-deftest agent-shell-markdown-watermark-keeps-pending-table-with-partial-separator () + ;; Real-world regression: an LLM streams a 5-column table cell-by- + ;; cell and the separator row arrives as a sequence of `|-------' + ;; chunks that aren't a complete pipe-row until the trailing `|' + ;; lands. While the separator is mid-stream, the strict pipe-row + ;; regex doesn't match (it needs the closing `|'); the lenient + ;; pending-line regex must still recognise it so the watermark + ;; stays at the header line. Otherwise the watermark slips past + ;; the header and `--find-tables' eventually renders only + ;; separator + data rows, leaving the header raw outside the table. + (with-temp-buffer + (dolist (chunk '("| Col 1 | Col 2 |\n" + "|-------" + "|-------" + "|" + "\n" + "| Row 1 | A |\n" + "| Row 2 | B |\n")) + (goto-char (point-max)) + (insert chunk) + (agent-shell-markdown-replace-markup)) + (let ((rendered (substring-no-properties (buffer-string)))) + ;; Header is part of the rendered Unicode table — no raw `|' on + ;; its line. + (should (string-match-p "│ Col 1 *│ Col 2 *│" rendered)) + (should-not (string-match-p "^| Col 1" rendered))))) + (ert-deftest agent-shell-markdown-inline-code-completes-across-chunk-boundary () ;; LLM streams may split an inline-code span across chunks (e.g. ;; `\\`co' lands first, then `de\\`'). The first render sees an From 262b470c4139430654dfcabbcaaa484199ebec8a Mon Sep 17 00:00:00 2001 From: xenodium <8107219+xenodium@users.noreply.github.com> Date: Sat, 23 May 2026 15:22:24 +0100 Subject: [PATCH 20/31] Getting rid of snippet background color and all the padding --- agent-shell-markdown.el | 85 ++++++--------------------- tests/agent-shell-markdown-tests.el | 89 ++++++++++++----------------- 2 files changed, 52 insertions(+), 122 deletions(-) diff --git a/agent-shell-markdown.el b/agent-shell-markdown.el index e38fffe7..d6f12e94 100644 --- a/agent-shell-markdown.el +++ b/agent-shell-markdown.el @@ -143,16 +143,8 @@ "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) - (defface agent-shell-markdown-source-block-language - '((t :inherit (italic font-lock-type-face agent-shell-markdown-source-block))) + '((t :inherit (italic font-lock-type-face))) "Face for the language label shown above a fenced source block." :group 'agent-shell-markdown) @@ -777,58 +769,20 @@ 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) + ;; Apply the language's font-lock faces over the body. No + ;; bg-panel face: the block reads inline with surrounding + ;; prose rather than as a tinted panel. (agent-shell-markdown--apply-faces-from highlighted (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 bg-tinted lines 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. - ;; - ;; Top padding is three lines with the label on the middle - ;; one — "LANG ⧉" if a language was given, otherwise the - ;; fallback "snippet ⧉". The whole label is actionable: RET - ;; or mouse-1 anywhere on it kills the body to the kill ring. - (let* ((vpad (propertize "\n" 'face - 'agent-shell-markdown-source-block)) - (label-text (concat (if (string-empty-p lang) "snippet" lang) + (add-text-properties body-start body-end + '(agent-shell-markdown-frozen t + rear-nonsticky (agent-shell-markdown-frozen))) + ;; Render an actionable "LANG ⧉" / "snippet ⧉" header above + ;; the body via a `display' property on the first body char. + ;; The label sits directly above the body with no padding. + ;; RET or mouse-1 on the label kills the body to the kill + ;; ring. + (let* ((label-text (concat (if (string-empty-p lang) "snippet" lang) " ⧉")) (label (propertize @@ -844,19 +798,12 @@ with `emacs-lisp-mode' face properties on the body and a (marker-position body-start) (marker-position body-end))) (message "Copied"))))) - (top-pad (concat vpad label vpad vpad)) - (first-pos (marker-position body-start)) - (last-pos (marker-position body-end))) + (first-pos (marker-position body-start))) (put-text-property first-pos (1+ first-pos) 'display - (concat top-pad + (concat label "\n\n" (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))))))) + (1+ first-pos))))))))) (defconst agent-shell-markdown--table-line-regexp (rx line-start diff --git a/tests/agent-shell-markdown-tests.el b/tests/agent-shell-markdown-tests.el index ec6a8277..3a06ed32 100644 --- a/tests/agent-shell-markdown-tests.el +++ b/tests/agent-shell-markdown-tests.el @@ -143,11 +143,9 @@ after **b2**")) '(("before " nil) ("b" (agent-shell-markdown-bold)) (" -" nil) - ("**not bold** +**not bold** _not italic_ -" (agent-shell-markdown-source-block)) - ("after " nil) +after " nil) ("b2" (agent-shell-markdown-bold)))))) (ert-deftest agent-shell-markdown-convert-open-fence-protects-rest () @@ -204,9 +202,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. + ;; The `[b](v)' inside fences stays literal — it isn't re-processed + ;; as a link. Body chars carry the `agent-shell-markdown-frozen' + ;; tag (which `--deconstruct' doesn't surface). (should (equal (agent-shell-markdown--deconstruct (agent-shell-markdown-convert "before [a](u) @@ -217,33 +215,28 @@ after [c](w)")) '(("before " nil) ("a" (agent-shell-markdown-link)) (" -" nil) - ("[b](v) -" (agent-shell-markdown-source-block)) - ("after " nil) +[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. - ;; 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. + ;; Plain fenced block (no language): fences deleted, body remains + ;; with no face (only `agent-shell-markdown-frozen' tag, which + ;; `--deconstruct' doesn't surface). (should (equal (agent-shell-markdown--deconstruct (agent-shell-markdown-convert "``` body ```")) '(("body -" (agent-shell-markdown-source-block)))))) - -(ert-deftest agent-shell-markdown-convert-source-block-language-padding () - ;; Every fence renders with 3 lines of top padding and a label on - ;; the middle line — "LANG ⧉" when the fence declared a language, - ;; the fallback "snippet ⧉" otherwise. The whole label is - ;; actionable (RET / mouse-1 kills the body to the kill ring), not - ;; just the copy glyph. +" nil))))) + +(ert-deftest agent-shell-markdown-convert-source-block-language-label () + ;; Every fence renders with an actionable label directly above the + ;; body — "LANG ⧉" when a language is declared, the fallback + ;; "snippet ⧉" otherwise. Label is followed by a single newline; + ;; no padding, no bg panel. RET or mouse-1 anywhere on the label + ;; kills the body to the kill ring. (let* ((with-lang (agent-shell-markdown-convert "```python print(\"hi\") ``` @@ -255,12 +248,12 @@ body (with-lang-display (get-text-property 0 'display with-lang)) (no-lang-display (get-text-property 0 'display no-lang))) (should (equal (substring-no-properties with-lang-display) - "\npython ⧉\n\np")) + "python ⧉\n\np")) (should (equal (substring-no-properties no-lang-display) - "\nsnippet ⧉\n\nb")) - ;; Label face + actionable props cover the whole label (both the - ;; first char of the name and the ⧉ glyph). - (dolist (i '(1 8)) + "snippet ⧉\n\nb")) + ;; Label face + actionable props on both the first name char and + ;; the ⧉ glyph. + (dolist (i '(0 7)) (should (eq (get-text-property i 'face with-lang-display) 'agent-shell-markdown-source-block-language)) (should (eq (get-text-property i 'mouse-face with-lang-display) @@ -280,27 +273,21 @@ body print(\"hi\") ``` ````")) - '(("```python\nprint(\"hi\")\n```\n" - (agent-shell-markdown-source-block)))))) + '(("```python\nprint(\"hi\")\n```\n" 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 *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. + ;; `emacs-lisp' source block: fences deleted, body chars get the + ;; language's `font-lock' faces. In batch the keyword `if' is + ;; faced; the rest of the body stays unfaced (no bg panel). (should (equal (agent-shell-markdown--deconstruct (agent-shell-markdown-convert "```emacs-lisp (if t nil) ```")) - '(("(" (agent-shell-markdown-source-block)) - ("if" (font-lock-keyword-face - agent-shell-markdown-source-block)) + '(("(" nil) + ("if" (font-lock-keyword-face)) (" t nil) -" (agent-shell-markdown-source-block)))))) +" nil))))) (ert-deftest agent-shell-markdown-convert-source-block-body-tagged () ;; Body chars carry `agent-shell-markdown-frozen t' so subsequent calls @@ -339,8 +326,7 @@ print(\"hi\") (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))))))) @@ -813,10 +799,8 @@ A " nil) ("code" (agent-shell-markdown-inline-code)) (". -" nil) - ("**not bold** -" (agent-shell-markdown-source-block)) - (" +**not bold** + ![alt](/missing). " nil) @@ -934,8 +918,8 @@ A " nil) (ert-deftest agent-shell-markdown-blockquote-inside-fence-stays-raw () ;; A `>'-prefixed line inside a fenced code block must not be ;; styled as a blockquote — the source-block range is in - ;; avoid-ranges. The `>' should keep its source-block face and not - ;; get the blockquote face. + ;; avoid-ranges. The `>' carries the source-block's + ;; `agent-shell-markdown-frozen' tag and no blockquote face. (let* ((s (agent-shell-markdown-convert "``` > not a quote ``` @@ -943,8 +927,7 @@ A " nil) (quote-pos (string-match "> not a quote" (substring-no-properties s)))) (should quote-pos) - (should (eq (get-text-property quote-pos 'face s) - 'agent-shell-markdown-source-block)) + (should (eq t (get-text-property quote-pos 'agent-shell-markdown-frozen s))) (should-not (eq (get-text-property quote-pos 'face s) 'agent-shell-markdown-blockquote)))) From 36d505e8c212b70612018a05678e9f4851bf252e Mon Sep 17 00:00:00 2001 From: xenodium <8107219+xenodium@users.noreply.github.com> Date: Mon, 25 May 2026 20:00:05 +0100 Subject: [PATCH 21/31] Fix body-invisible-p for whitespace-only bodies #597 MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Reported in PR #597: pi-acp tool-call fragments rendered with the indicator showing `▶' (collapsed) but the body fully visible. --- agent-shell-ui.el | 17 +++++++++-------- tests/agent-shell-ui-tests.el | 26 ++++++++++++++++++++++++++ 2 files changed, 35 insertions(+), 8 deletions(-) create mode 100644 tests/agent-shell-ui-tests.el diff --git a/agent-shell-ui.el b/agent-shell-ui.el index af3876c8..28f8e2eb 100644 --- a/agent-shell-ui.el +++ b/agent-shell-ui.el @@ -235,14 +235,15 @@ trailing-whitespace chars." (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)))) +Inspects the `invisible' property on the first body char. The +trailing-whitespace handler only sets `invisible' on chars from +the last non-whitespace position onwards, never the first char, +so the first char's `invisible' tracks the body's true collapse +state — including whitespace-only bodies (e.g. a body left as +two newlines after the markdown renderer stripped an empty +fenced block)." + (and (< body-start body-end) + (eq (get-text-property body-start '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. diff --git a/tests/agent-shell-ui-tests.el b/tests/agent-shell-ui-tests.el new file mode 100644 index 00000000..25f87e91 --- /dev/null +++ b/tests/agent-shell-ui-tests.el @@ -0,0 +1,26 @@ +;;; agent-shell-ui-tests.el --- Tests for agent-shell-ui -*- lexical-binding: t; -*- + +(require 'ert) +(require 'agent-shell-ui) + +;;; Code: + +(ert-deftest agent-shell-ui-body-invisible-p-handles-whitespace-only-body () + ;; Regression for PR #597 (pi-acp): the markdown renderer strips + ;; an empty `\\`\\`\\`console' fence down to a body of only + ;; newlines. On the next `surgical-replace-body', + ;; `--body-invisible-p' must still report the body as hidden when + ;; its chars carry `invisible t' — otherwise new chars come in + ;; visible and the fragment "expands" on every subsequent update + ;; while still showing the `▶' collapsed indicator. + (with-temp-buffer + (insert "\n\n") + (add-text-properties (point-min) (point-max) '(invisible t)) + (should (agent-shell-ui--body-invisible-p (point-min) (point-max)))) + (with-temp-buffer + (insert "\n\n") + (should-not (agent-shell-ui--body-invisible-p (point-min) (point-max))))) + +(provide 'agent-shell-ui-tests) + +;;; agent-shell-ui-tests.el ends here From ad37c43028268ba123849e5727517695b583b3b3 Mon Sep 17 00:00:00 2001 From: xenodium <8107219+xenodium@users.noreply.github.com> Date: Wed, 27 May 2026 21:58:30 +0100 Subject: [PATCH 22/31] Make code block label actual buffer text (not display only) #597 --- agent-shell-markdown.el | 66 ++++++++++++-------- tests/agent-shell-markdown-tests.el | 94 ++++++++++++++++++++++------- 2 files changed, 113 insertions(+), 47 deletions(-) diff --git a/agent-shell-markdown.el b/agent-shell-markdown.el index d6f12e94..df8a629e 100644 --- a/agent-shell-markdown.el +++ b/agent-shell-markdown.el @@ -777,33 +777,49 @@ with `emacs-lisp-mode' face properties on the body and a (add-text-properties body-start body-end '(agent-shell-markdown-frozen t rear-nonsticky (agent-shell-markdown-frozen))) - ;; Render an actionable "LANG ⧉" / "snippet ⧉" header above - ;; the body via a `display' property on the first body char. - ;; The label sits directly above the body with no padding. - ;; RET or mouse-1 on the label kills the body to the kill - ;; ring. + ;; Insert an actionable "LANG ⧉" / "snippet ⧉" header as real + ;; buffer text directly above the body — no `display' + ;; properties (avoids embedded-`\\n' rendering quirks that + ;; can hide the body's first char) and no overlays. RET or + ;; mouse-1 on the label kills the body to the kill ring. + ;; `content-start' uses insertion-type t so it stays AFTER + ;; the inserted label, giving the kill-action a stable + ;; pointer to the body content even though `body-start' + ;; itself collapses to the label's first char. After + ;; insertion we carry the body's caller-set properties + ;; (`invisible', agent-shell-ui block/section markers, + ;; `read-only', etc.) onto the inserted chars — propertize'd + ;; inserts ignore stickiness, and without this the inserted + ;; label punches a hole in the caller's contiguous block + ;; range and breaks toggle/replace operations. (let* ((label-text (concat (if (string-empty-p lang) "snippet" lang) " ⧉")) - (label - (propertize - label-text - 'face 'agent-shell-markdown-source-block-language - 'mouse-face 'highlight - 'pointer 'hand - 'keymap (agent-shell-markdown--make-ret-binding-map - (lambda () - (interactive) - (kill-new - (buffer-substring-no-properties - (marker-position body-start) - (marker-position body-end))) - (message "Copied"))))) - (first-pos (marker-position body-start))) - (put-text-property first-pos (1+ first-pos) - 'display - (concat label "\n\n" - (buffer-substring first-pos - (1+ first-pos))))))))) + (content-start (copy-marker (marker-position body-start) t)) + (kill-action (lambda () + (interactive) + (kill-new (buffer-substring-no-properties + (marker-position content-start) + (marker-position body-end))) + (message "Copied"))) + (label (propertize + label-text + 'face 'agent-shell-markdown-source-block-language + 'mouse-face 'highlight + 'pointer 'hand + 'keymap (agent-shell-markdown--make-ret-binding-map + kill-action) + 'agent-shell-markdown-frozen t + 'rear-nonsticky '(agent-shell-markdown-frozen))) + (carried (agent-shell-markdown--carry-properties body-start))) + (goto-char body-start) + (insert label "\n\n") + (when carried + (add-text-properties (marker-position body-start) (point) + carried)) + ;; Move point past the body so the outer `re-search-forward' + ;; loop doesn't backtrack into body content (e.g. shorter + ;; inner fences inside a wider outer fence). + (goto-char (marker-position body-end))))))) (defconst agent-shell-markdown--table-line-regexp (rx line-start diff --git a/tests/agent-shell-markdown-tests.el b/tests/agent-shell-markdown-tests.el index 3a06ed32..03f51565 100644 --- a/tests/agent-shell-markdown-tests.el +++ b/tests/agent-shell-markdown-tests.el @@ -143,6 +143,10 @@ after **b2**")) '(("before " nil) ("b" (agent-shell-markdown-bold)) (" +" nil) + ("snippet ⧉" (agent-shell-markdown-source-block-language)) + (" + **not bold** _not italic_ after " nil) @@ -215,27 +219,36 @@ after [c](w)")) '(("before " nil) ("a" (agent-shell-markdown-link)) (" +" nil) + ("snippet ⧉" (agent-shell-markdown-source-block-language)) + (" + [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 no face (only `agent-shell-markdown-frozen' tag, which - ;; `--deconstruct' doesn't surface). + ;; Plain fenced block (no language): fences deleted, a "snippet ⧉" + ;; header is inserted directly above the body as real buffer text + ;; (no display property), and the body chars carry the + ;; `agent-shell-markdown-frozen' tag (not surfaced by + ;; `--deconstruct'). (should (equal (agent-shell-markdown--deconstruct (agent-shell-markdown-convert "``` body ```")) - '(("body + '(("snippet ⧉" (agent-shell-markdown-source-block-language)) + (" + +body " nil))))) (ert-deftest agent-shell-markdown-convert-source-block-language-label () - ;; Every fence renders with an actionable label directly above the - ;; body — "LANG ⧉" when a language is declared, the fallback - ;; "snippet ⧉" otherwise. Label is followed by a single newline; - ;; no padding, no bg panel. RET or mouse-1 anywhere on the label + ;; Every fence renders with an actionable label inserted as real + ;; buffer text directly above the body — "LANG ⧉" when a language + ;; is declared, "snippet ⧉" otherwise. No display property, no + ;; overlays, no bg panel. RET or mouse-1 anywhere on the label ;; kills the body to the kill ring. (let* ((with-lang (agent-shell-markdown-convert "```python print(\"hi\") @@ -244,21 +257,19 @@ print(\"hi\") (no-lang (agent-shell-markdown-convert "``` body ``` -")) - (with-lang-display (get-text-property 0 'display with-lang)) - (no-lang-display (get-text-property 0 'display no-lang))) - (should (equal (substring-no-properties with-lang-display) - "python ⧉\n\np")) - (should (equal (substring-no-properties no-lang-display) - "snippet ⧉\n\nb")) +"))) + (should (string-prefix-p "python ⧉\n\nprint(" + (substring-no-properties with-lang))) + (should (string-prefix-p "snippet ⧉\n\nbody" + (substring-no-properties no-lang))) ;; Label face + actionable props on both the first name char and ;; the ⧉ glyph. (dolist (i '(0 7)) - (should (eq (get-text-property i 'face with-lang-display) + (should (eq (get-text-property i 'face with-lang) 'agent-shell-markdown-source-block-language)) - (should (eq (get-text-property i 'mouse-face with-lang-display) + (should (eq (get-text-property i 'mouse-face with-lang) 'highlight)) - (should (keymapp (get-text-property i 'keymap with-lang-display)))))) + (should (keymapp (get-text-property i 'keymap with-lang)))))) (ert-deftest agent-shell-markdown-convert-source-block-nested-fences () ;; A 4-backtick outer fence wraps inner 3-backtick fences as @@ -273,10 +284,17 @@ body print(\"hi\") ``` ````")) - '(("```python\nprint(\"hi\")\n```\n" nil))))) + '(("markdown ⧉" (agent-shell-markdown-source-block-language)) + (" + +```python +print(\"hi\") +``` +" nil))))) (ert-deftest agent-shell-markdown-convert-source-block-with-language () - ;; `emacs-lisp' source block: fences deleted, body chars get the + ;; `emacs-lisp' source block: fences deleted, an "emacs-lisp ⧉" + ;; header is inserted as buffer text, then the body chars get the ;; language's `font-lock' faces. In batch the keyword `if' is ;; faced; the rest of the body stays unfaced (no bg panel). (should (equal (agent-shell-markdown--deconstruct @@ -284,7 +302,10 @@ print(\"hi\") "```emacs-lisp (if t nil) ```")) - '(("(" nil) + '(("emacs-lisp ⧉" (agent-shell-markdown-source-block-language)) + (" + +(" nil) ("if" (font-lock-keyword-face)) (" t nil) " nil))))) @@ -310,6 +331,28 @@ print(\"hi\") (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-streamed-in-chunks () + ;; Real-world LLM streaming: a fenced code block arrives in small + ;; chunks that split the opening fence, the language line, body + ;; chars, and the closing fence. After every chunk the renderer + ;; is called. Once the closing fence lands, the final buffer + ;; should show the inserted "python ⧉" label above the body, with + ;; no raw fence markers remaining. + (with-temp-buffer + (dolist (chunk '("``" "`p" "yt" "hon\n" + "pri" "nt(" "\"hi\")\n" + "ra" "ise " "Sys" "temExit\n" + "``" "`\n")) + (goto-char (point-max)) + (insert chunk) + (agent-shell-markdown-replace-markup)) + (should (equal (substring-no-properties (buffer-string)) + "python ⧉ + +print(\"hi\") +raise SystemExit +")))) + (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 @@ -325,7 +368,10 @@ print(\"hi\") **real bold**") (agent-shell-markdown-replace-markup) (should (equal (agent-shell-markdown--deconstruct (buffer-string)) - '(("**not bold** + '(("snippet ⧉" (agent-shell-markdown-source-block-language)) + (" + +**not bold** " nil) ("real bold" (agent-shell-markdown-bold))))))) @@ -799,6 +845,10 @@ A " nil) ("code" (agent-shell-markdown-inline-code)) (". +" nil) + ("snippet ⧉" (agent-shell-markdown-source-block-language)) + (" + **not bold** ![alt](/missing). From 912dae1888793f00349c1c0146f9706d5e5356c3 Mon Sep 17 00:00:00 2001 From: xenodium <8107219+xenodium@users.noreply.github.com> Date: Thu, 28 May 2026 19:56:19 +0100 Subject: [PATCH 23/31] Echo "Press RET to copy" on snippet label point entering --- agent-shell-markdown.el | 3 +++ 1 file changed, 3 insertions(+) diff --git a/agent-shell-markdown.el b/agent-shell-markdown.el index df8a629e..b046676e 100644 --- a/agent-shell-markdown.el +++ b/agent-shell-markdown.el @@ -808,6 +808,9 @@ with `emacs-lisp-mode' face properties on the body and a 'pointer 'hand 'keymap (agent-shell-markdown--make-ret-binding-map kill-action) + 'cursor-sensor-functions (list (lambda (_window _old-pos sensor-action) + (when (eq sensor-action 'entered) + (message "Press RET to copy")))) 'agent-shell-markdown-frozen t 'rear-nonsticky '(agent-shell-markdown-frozen))) (carried (agent-shell-markdown--carry-properties body-start))) From 2c80f175786138c7ff7bd866854f64c6aa9f5265 Mon Sep 17 00:00:00 2001 From: xenodium <8107219+xenodium@users.noreply.github.com> Date: Fri, 29 May 2026 14:11:12 +0100 Subject: [PATCH 24/31] Fix rendering diff #597 --- agent-shell-markdown.el | 14 ++++++++++++-- agent-shell-ui.el | 23 ++++++++++++++--------- agent-shell.el | 7 +++++++ 3 files changed, 33 insertions(+), 11 deletions(-) diff --git a/agent-shell-markdown.el b/agent-shell-markdown.el index b046676e..0113728f 100644 --- a/agent-shell-markdown.el +++ b/agent-shell-markdown.el @@ -428,11 +428,21 @@ with face `agent-shell-markdown-header-2' on \"My title\"." markup-start markup-end avoid-ranges))) (if avoid (goto-char (cdr avoid)) - (let ((level (- (match-end 1) (match-beginning 1))) - (text (buffer-substring (match-beginning 2) (match-end 2)))) + (let* ((level (- (match-end 1) (match-beginning 1))) + (text (buffer-substring (match-beginning 2) (match-end 2))) + ;; The trailing `\\n' we re-insert below would otherwise + ;; punch a hole in the caller's contiguous block range + ;; (eg. `invisible'/`agent-shell-ui-section') and break + ;; toggle/replace operations — same hazard called out in + ;; `--style-source-blocks'. Carry over the original + ;; newline's caller props. + (carried (agent-shell-markdown--carry-properties + (1- markup-end)))) (delete-region markup-start markup-end) (goto-char markup-start) (insert text "\n") + (when carried + (add-text-properties markup-start (point) carried)) (add-face-text-property markup-start (+ markup-start (length text)) (intern (format "agent-shell-markdown-header-%d" diff --git a/agent-shell-ui.el b/agent-shell-ui.el index 28f8e2eb..adb33d0e 100644 --- a/agent-shell-ui.el +++ b/agent-shell-ui.el @@ -706,16 +706,21 @@ When NO-UNDO is non-nil, disable undo recording." (defun agent-shell-ui--indent-text (text &optional indent-string) "Indent TEXT visually without affecting copied text. INDENT-STRING defaults to two spaces. -Uses `line-prefix' display property so indentation is visual only." +Uses `line-prefix' display property so indentation is visual only. + +TEXT's caller-set text properties (eg. `agent-shell-markdown-frozen' +on a pre-rendered diff) are preserved on every char — the previous +split-and-rejoin reconstructed the inter-line `\\n's as bare strings, +which broke contiguous property ranges and made the markdown +renderer's avoid-range checks miss header / blockquote matches +that span a line break." (when text - (let* ((indent (or indent-string " ")) - (lines (split-string text "\n"))) - (concat - (propertize (car lines) 'line-prefix indent 'wrap-prefix indent) - (mapconcat (lambda (line) - (propertize (concat "\n" line) 'line-prefix indent 'wrap-prefix indent)) - (cdr lines) - ""))))) + (let ((indent (or indent-string " ")) + (copy (copy-sequence text))) + (add-text-properties 0 (length copy) + `(line-prefix ,indent wrap-prefix ,indent) + copy) + copy))) (defun agent-shell-ui-forward-block () "Jump to the next block." diff --git a/agent-shell.el b/agent-shell.el index e9a52798..8bbbd2cb 100644 --- a/agent-shell.el +++ b/agent-shell.el @@ -2382,6 +2382,13 @@ DIFF should be in the form returned by `agent-shell--make-diff-info': (add-text-properties line-start line-end '(font-lock-face diff-hunk-header)))) (forward-line 1))) + ;; Tag the whole diff as already-rendered output so the + ;; markdown renderer's avoid-ranges include it — context + ;; lines like ` # Foo' or ` > Bar' must display verbatim, + ;; not as a header / blockquote. See PR #597. + (add-text-properties (point-min) (point-max) + '(agent-shell-markdown-frozen t + rear-nonsticky (agent-shell-markdown-frozen))) (buffer-string))) (delete-file old-file) (delete-file new-file)))) From d4d916d5162fa8ca3a9aca7391c5020f90842a40 Mon Sep 17 00:00:00 2001 From: xenodium <8107219+xenodium@users.noreply.github.com> Date: Fri, 29 May 2026 14:12:30 +0100 Subject: [PATCH 25/31] Update markdown rendering test #597 --- tests/agent-shell-markdown-tests.el | 30 +++++++++++++++++++++++++++++ 1 file changed, 30 insertions(+) diff --git a/tests/agent-shell-markdown-tests.el b/tests/agent-shell-markdown-tests.el index 03f51565..234b3e53 100644 --- a/tests/agent-shell-markdown-tests.el +++ b/tests/agent-shell-markdown-tests.el @@ -999,6 +999,36 @@ A " nil) (should (eq (get-text-property (+ (point-min) i) 'face) 'agent-shell-markdown-header-1))))) +(ert-deftest agent-shell-markdown-frozen-region-skips-header-pass () + ;; Callers (eg. `agent-shell--format-diff-as-text') tag pre-rendered + ;; content with `agent-shell-markdown-frozen t' so it displays verbatim. + ;; The header pass must respect that tag — a diff context line like + ;; ` # Foo' must not be rewritten as an H1. See PR #597. + (with-temp-buffer + (insert (propertize "@@ -1,2 +1,2 @@\n # Test Document Title\n-old\n+new\n" + 'agent-shell-markdown-frozen t)) + (agent-shell-markdown-replace-markup) + (should (equal (substring-no-properties (buffer-string)) + "@@ -1,2 +1,2 @@\n # Test Document Title\n-old\n+new\n")))) + +(ert-deftest agent-shell-markdown-header-preserves-caller-text-properties () + ;; The header pass deletes the matched `#…\n' and re-inserts the + ;; faced title plus a fresh `\n'. The inserted newline must carry + ;; the caller's text properties — otherwise it punches a hole in any + ;; contiguous block tagging (eg. `invisible' / `agent-shell-ui-section') + ;; that brackets the body, breaking toggle/replace operations on the + ;; surrounding fragment. See PR #597. + (with-temp-buffer + (insert (propertize "# Title\nbody line\n" + 'agent-shell-ui-section 'body + 'invisible t)) + (agent-shell-markdown-replace-markup) + (dotimes (i (1- (point-max))) + (let ((pos (1+ i))) + (should (eq 'body + (get-text-property pos 'agent-shell-ui-section))) + (should (eq t (get-text-property pos 'invisible))))))) + (ert-deftest agent-shell-markdown-watermark-keeps-pending-table-in-scope () ;; When table rows stream in one at a time, the table needs at least ;; two consecutive pipe-rows in scope before `--find-tables' will From 70041aa57043622eecc21084497d9d1f8384f13c Mon Sep 17 00:00:00 2001 From: xenodium <8107219+xenodium@users.noreply.github.com> Date: Fri, 29 May 2026 14:20:30 +0100 Subject: [PATCH 26/31] Add markdown avoiding diff test #597 --- tests/agent-shell-ui-tests.el | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/tests/agent-shell-ui-tests.el b/tests/agent-shell-ui-tests.el index 25f87e91..870f3d1a 100644 --- a/tests/agent-shell-ui-tests.el +++ b/tests/agent-shell-ui-tests.el @@ -21,6 +21,22 @@ (insert "\n\n") (should-not (agent-shell-ui--body-invisible-p (point-min) (point-max))))) +(ert-deftest agent-shell-ui-indent-text-preserves-caller-text-properties () + ;; A pre-rendered body (eg. a diff tagged `agent-shell-markdown-frozen') + ;; passes through `--indent-text' on its way into the fragment buffer. + ;; Every char of the indented result — including the inter-line `\\n's + ;; — must keep the caller's text properties, otherwise the markdown + ;; renderer's contiguous frozen-range collapses per-line and the + ;; header / blockquote passes match across the now-bare line breaks. + ;; See PR #597. + (let* ((input (propertize "line one\nline two\nline three" + 'agent-shell-markdown-frozen t)) + (out (agent-shell-ui--indent-text input " "))) + (dotimes (i (length out)) + (should (eq t (get-text-property i 'agent-shell-markdown-frozen out))) + (should (equal " " (get-text-property i 'line-prefix out))) + (should (equal " " (get-text-property i 'wrap-prefix out)))))) + (provide 'agent-shell-ui-tests) ;;; agent-shell-ui-tests.el ends here From 00f680817e9bba970800e8e1060eca72c4a21ebb Mon Sep 17 00:00:00 2001 From: xenodium <8107219+xenodium@users.noreply.github.com> Date: Fri, 29 May 2026 14:27:26 +0100 Subject: [PATCH 27/31] Fixing tests --- tests/agent-shell-markdown-tests.el | 18 ++++++++++-------- tests/agent-shell-tests.el | 5 +++++ 2 files changed, 15 insertions(+), 8 deletions(-) diff --git a/tests/agent-shell-markdown-tests.el b/tests/agent-shell-markdown-tests.el index 234b3e53..2b3db00b 100644 --- a/tests/agent-shell-markdown-tests.el +++ b/tests/agent-shell-markdown-tests.el @@ -276,21 +276,23 @@ body ;; literal body — the inner ```python ... ``` is *not* re-rendered ;; as a code block. Mirrors CommonMark's variable-width fence ;; rule: a closer must match the opener's backtick count, and a - ;; shorter run inside is part of the body. - (should (equal (agent-shell-markdown--deconstruct - (agent-shell-markdown-convert - "````markdown + ;; shorter run inside is part of the body. Face buckets vary by + ;; env (markdown-mode's font-lock highlights ``` markup when the + ;; mode is loadable; in bare batch it's not), so the contract is + ;; asserted on the rendered text, not on the face cascade. + (let ((rendered (substring-no-properties + (agent-shell-markdown-convert + "````markdown ```python print(\"hi\") ``` -````")) - '(("markdown ⧉" (agent-shell-markdown-source-block-language)) - (" +````")))) + (should (equal rendered "markdown ⧉ ```python print(\"hi\") ``` -" nil))))) +")))) (ert-deftest agent-shell-markdown-convert-source-block-with-language () ;; `emacs-lisp' source block: fences deleted, an "emacs-lisp ⧉" diff --git a/tests/agent-shell-tests.el b/tests/agent-shell-tests.el index ab9c106b..30a0a19f 100644 --- a/tests/agent-shell-tests.el +++ b/tests/agent-shell-tests.el @@ -697,6 +697,11 @@ (options . [((value . "code") (name . "Code"))]))])) (cl-letf (((symbol-function 'agent-shell--update-header-and-mode-line) + #'ignore) + ;; `--emit-event' calls `(agent-shell--state)' which errors + ;; outside of an `agent-shell-mode' buffer; the test exercises + ;; the data layer, not subscription dispatch. + ((symbol-function 'agent-shell--emit-event) #'ignore)) (agent-shell--on-notification :state state From 4250eadf86d47c8e39592fe3d17e92b2c206a00c Mon Sep 17 00:00:00 2001 From: xenodium <8107219+xenodium@users.noreply.github.com> Date: Fri, 29 May 2026 17:59:52 +0100 Subject: [PATCH 28/31] Make code block padded background non-trimmeable --- agent-shell-markdown.el | 175 +++++++++++++++++++++++++------------ agent-shell-viewport.el | 3 +- agent-shell.el | 56 +++++++++++- tests/agent-shell-tests.el | 23 +++++ 4 files changed, 199 insertions(+), 58 deletions(-) diff --git a/agent-shell-markdown.el b/agent-shell-markdown.el index 0113728f..33d02d1b 100644 --- a/agent-shell-markdown.el +++ b/agent-shell-markdown.el @@ -143,8 +143,16 @@ "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) + (defface agent-shell-markdown-source-block-language - '((t :inherit (italic font-lock-type-face))) + '((t :inherit (italic font-lock-type-face agent-shell-markdown-source-block))) "Face for the language label shown above a fenced source block." :group 'agent-shell-markdown) @@ -779,60 +787,117 @@ 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) - ;; Apply the language's font-lock faces over the body. No - ;; bg-panel face: the block reads inline with surrounding - ;; prose rather than as a tinted panel. - (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))) - ;; Insert an actionable "LANG ⧉" / "snippet ⧉" header as real - ;; buffer text directly above the body — no `display' - ;; properties (avoids embedded-`\\n' rendering quirks that - ;; can hide the body's first char) and no overlays. RET or - ;; mouse-1 on the label kills the body to the kill ring. - ;; `content-start' uses insertion-type t so it stays AFTER - ;; the inserted label, giving the kill-action a stable - ;; pointer to the body content even though `body-start' - ;; itself collapses to the label's first char. After - ;; insertion we carry the body's caller-set properties - ;; (`invisible', agent-shell-ui block/section markers, - ;; `read-only', etc.) onto the inserted chars — propertize'd - ;; inserts ignore stickiness, and without this the inserted - ;; label punches a hole in the caller's contiguous block - ;; range and breaks toggle/replace operations. - (let* ((label-text (concat (if (string-empty-p lang) "snippet" lang) - " ⧉")) - (content-start (copy-marker (marker-position body-start) t)) - (kill-action (lambda () - (interactive) - (kill-new (buffer-substring-no-properties - (marker-position content-start) - (marker-position body-end))) - (message "Copied"))) - (label (propertize - label-text - 'face 'agent-shell-markdown-source-block-language - 'mouse-face 'highlight - 'pointer 'hand - 'keymap (agent-shell-markdown--make-ret-binding-map - kill-action) - 'cursor-sensor-functions (list (lambda (_window _old-pos sensor-action) - (when (eq sensor-action 'entered) - (message "Press RET to copy")))) - 'agent-shell-markdown-frozen t - 'rear-nonsticky '(agent-shell-markdown-frozen))) - (carried (agent-shell-markdown--carry-properties body-start))) - (goto-char body-start) - (insert label "\n\n") - (when carried - (add-text-properties (marker-position body-start) (point) - carried)) - ;; Move point past the body so the outer `re-search-forward' - ;; loop doesn't backtrack into body content (e.g. shorter - ;; inner fences inside a wider outer fence). - (goto-char (marker-position body-end))))))) + ;; Seed the bg panel on body chars first, then layer language + ;; font-lock faces on top — the foreground colors take priority + ;; per glyph while the `:extend t' background fills the gaps + ;; and reaches the right edge of the window. Include the + ;; trailing `\\n' (the one that sat between body and close + ;; fence, preserved by the deletes 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. + (let ((body-bg-end (min (1+ (marker-position body-end)) + (point-max))) + ;; `line-prefix' / `wrap-prefix' visually inset each + ;; rendered line: 2 plain cols then 2 bg-tinted cols. + ;; Copying chars out of the block yanks raw source with + ;; no leading indentation. `wrap-prefix' handles long + ;; lines that wrap. Splitting the prefix this way keeps + ;; the panel from running hard to the window's left edge + ;; while still drawing a clear tinted gutter. + (prefix (concat " " + (propertize + " " 'face + 'agent-shell-markdown-source-block)))) + (put-text-property (marker-position body-start) body-bg-end + 'face 'agent-shell-markdown-source-block) + (agent-shell-markdown--apply-faces-from highlighted + (marker-position body-start)) + (add-text-properties (marker-position body-start) body-bg-end + `(agent-shell-markdown-frozen t + agent-shell-non-trimmable t + rear-nonsticky (agent-shell-markdown-frozen + agent-shell-non-trimmable) + line-prefix ,prefix + wrap-prefix ,prefix)) + ;; Insert an actionable "LANG ⧉" / "snippet ⧉" label and the + ;; surrounding panel padding as REAL BUFFER TEXT — no + ;; `display' properties (which previously caused the body's + ;; first char to be hidden / clipped, see #597 "Make code + ;; block label actual buffer text"), no overlays. Layout + ;; relative to the original body: `\\n