Re: [PATCH] Highlight ANSI sequences in the whole buffer (was [PATCH] ANSI color on example blocks and fixed width elements)

[Nathaniel Nicandro <nathanielnicandro@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 2091 bytes --]


Hello,

I've gotten around to working on this again.  Sorry for the long
periods between updates.

Ihor Radchenko <yantar92@posteo.net> writes:

>> You want me to remove the code that is responsible for keeping the
>> sequences visible according to `org-fold-show-set-visibility` and
>> according to whether or not the sequence is currently being edited
>> then?
>
>Yes.

Done.

> For now, let's default `org-ansi-hide-sequences' to nil.

Done.

With this patch, I have implemented the extend the font-lock region
idea to account for editing around elements that have highlights which
need to be maintained across edits, e.g. due to a split in a
paragraph.

The additional idea to the previous patch, other than the extend
region stuff, is the packing of the `org-ansi-context` variable,
essentially the same as the `ansi-color-context-region` variable, into
an integer representation and storing it as the `org-ansi-context`
text property (discussed in a previous email) of the highlighted
regions.  This is done to make that text property `eq` comparable for
determining the extent of the highlight at point
(`org-ansi-extent-of-context`).

One other thing to note is that the ANSI sequences don't really play
well with `flyspell-mode`.  If you have something like

[42mparagraph

The end byte of the sequence, the 'm', causes flyspell to think the
word is mparagraph instead of paragraph.  Haven't looked into this at
all yet.  Wondering if anyone is more familiar with flyspell has an
ideas as to a solution.

Please review the patch and tell me what you think.  I'm happy with
the solution that I've come up with so far.  There could be more tests
for the extend region functionality, but I think its simple enough.  I
have extensive tests for the essential highlighting feature though,
they could be a little cleaner though.  There are not too many tests
for the maintenance of highlighting across edits, developing unit
tests for ensuring the highlights are proper after an edit is a little
cumbersome given my understanding of font-lock.  I wonder if there is
any better approach.


[-- Attachment #2: patch --]
[-- Type: text/x-patch, Size: 49839 bytes --]

From 49f3c562cd6a0fbe8efd29aee5230b70fb8d0473 Mon Sep 17 00:00:00 2001
From: Nathaniel Nicandro <nathanielnicandro@gmail.com>
Date: Sun, 17 Nov 2024 16:18:22 -0600
Subject: [PATCH] Highlight ANSI escape sequences

* etc/ORG-NEWS: Describe the new feature.

* lisp/org.el (org-fontify-ansi-sequences): New customization variable
and function which does the work of fontifying the sequences.
(org-ansi-highlightable-elements)
(org-ansi-highlightable-objects)
(org-ansi-hide-sequences): New customization variables.
(org-ansi-context, org-ansi-ansi-color-context): New variables.
(org-ansi-new-context, org-ansi-copy-context, org-ansi-null-context-p)
(org-ansi-clear-context, org-ansi-pack-context)
(org-ansi-unpack-to-context, org-ansi-context-contained-p)
(org-ansi-previous-context-position)
(org-ansi-previous-context, org-ansi-point-context)
(org-ansi-greater-element-context)
(org-ansi-highlightable-element-p)
(org-ansi-extent-of-context)
(org-ansi-widened-element-and-end)
(org-ansi-apply-on-region)
(org-ansi-extend-region)
(org-ansi-process-region, org-ansi-process-object)
(org-ansi-process-lines, org-ansi-process-lines-consider-objects)
(org-ansi-process-element)
(org-ansi-visit-elements)
(org-toggle-ansi-display): New functions.
(org-set-font-lock-defaults): Add the `org-fontify-ansi-sequences`
function to the font-lock keywords.
(org-unfontify-region): Remove the `org-ansi-context` property.
(org-ansi-mode): New minor mode to enable/disable highlighting of the
sequences.  Enable it in Org buffers by default.

* testing/lisp/test-org.el (faceup): New require.
(test-org/ansi-sequence-fontification):
(test-org/ansi-sequence-editing): New tests.
---
 etc/ORG-NEWS             |  17 +
 lisp/org.el              | 698 ++++++++++++++++++++++++++++++++++++++-
 testing/lisp/test-org.el | 313 ++++++++++++++++++
 3 files changed, 1027 insertions(+), 1 deletion(-)

diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS
index 92bfe35..cd875a8 100644
--- a/etc/ORG-NEWS
+++ b/etc/ORG-NEWS
@@ -76,6 +76,23 @@ now have diary timestamps included as well.
 # We list the most important features, and the features that may
 # require user action to be used.
 
+*** ANSI escape sequences are now highlighted in the whole buffer
+
+A new customization ~org-fontify-ansi-sequences~ is available which
+tells Org to highlight all ANSI sequences in the buffer if non-nil and
+the new minor mode ~org-ansi-mode~ is enabled.
+
+To disable highlighting of the sequences you can either
+disable ~org-ansi-mode~ or set ~org-fontify-ansi-sequences~ to ~nil~
+and =M-x org-mode-restart RET=.  Doing the latter will disable
+highlighting of sequences in all newly opened Org buffers whereas
+doing the former disables highlighting locally to the current buffer.
+
+The visibility of the ANSI sequences is controlled by the new
+customization ~org-ansi-hide-sequences~ which, if non-nil, makes the
+regions containing the sequences invisible.  The visibility can be
+toggled with =M-x org-toggle-ansi-display RET=.
+
 *** Alignment of image previews can be customized
 
 This is not a new feature.  It has been added in Org 9.7, but not
diff --git a/lisp/org.el b/lisp/org.el
index 1e90579..cca6f26 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -82,6 +82,7 @@ (require 'calendar)
 (require 'find-func)
 (require 'format-spec)
 (require 'thingatpt)
+(require 'ansi-color)
 
 (condition-case nil
     (load (concat (file-name-directory load-file-name)
@@ -3688,6 +3689,12 @@ (defcustom org-fontify-whole-block-delimiter-line t
   :group 'org-appearance
   :type 'boolean)
 
+(defcustom org-fontify-ansi-sequences t
+  "Non-nil means to highlight ANSI escape sequences."
+  :group 'org-appearance
+  :type 'boolean
+  :package-version '(Org . "9.8"))
+
 (defcustom org-highlight-latex-and-related nil
   "Non-nil means highlight LaTeX related syntax in the buffer.
 When non-nil, the value should be a list containing any of the
@@ -5627,6 +5634,670 @@ (defun org-fontify-extend-region (beg end _old-len)
 	     (cons beg (or (funcall extend "end" "]" 1) end)))
 	    (t (cons beg end))))))
 
+(defcustom org-ansi-highlightable-elements
+  '(plain-list drawer headline inlinetask table
+               table-row paragraph example-block export-block fixed-width)
+  "A list of element types that will have ANSI sequences processed."
+  :type '(list (symbol :tag "Element Type"))
+  :package-version '(Org . "9.8")
+  :group 'org-appearance)
+
+(defcustom org-ansi-highlightable-objects
+  '(bold code export-snippet italic macro
+    strike-through table-cell underline verbatim)
+  "A list of object types that will have ANSI sequences processed."
+  :type '(list (symbol :tag "Object Type"))
+  :package-version '(Org . "9.8")
+  :group 'org-appearance)
+
+(defcustom org-ansi-hide-sequences nil
+  "Non-nil means Org hides ANSI sequences."
+  :type 'boolean
+  :package-version '(Org . "9.8")
+  :group 'org-appearance)
+
+(defvar org-ansi-context nil
+  "The ANSI color context for the buffer.
+An Org ANSI context is the same as the FACE-VEC structure defined
+in `ansi-color-context-region'.")
+(make-variable-buffer-local 'org-ansi-context)
+
+(defun org-ansi-new-context ()
+  "Return a new ANSI context.
+See `org-ansi-context'."
+  (list (make-bool-vector 8 nil) nil nil))
+
+(defun org-ansi-copy-context (context)
+  "Return a copy of CONTEXT.
+See `org-ansi-context'."
+  (let ((basic-faces (make-bool-vector 8 nil)))
+    (bool-vector-union basic-faces (car context) basic-faces)
+    (list basic-faces
+          (cadr context)
+          (caddr context))))
+
+(defun org-ansi-null-context-p (context)
+  "Return non-nil if CONTEXT does not set a face when applied to a region.
+See `org-ansi-context'."
+  (and (zerop (bool-vector-count-population (car context)))
+       (null (cadr context))
+       (null (caddr context))))
+
+(defun org-ansi-clear-context (context)
+  "Destructively clear CONTEXT.
+See `org-ansi-context'."
+  (let ((basic-faces (car context)))
+    ;; From `ansi-color--update-face-vec'
+    (bool-vector-intersection basic-faces #&8"\0" basic-faces)
+    (setcar (cdr context) nil)
+    (setcar (cddr context) nil)))
+
+(defun org-ansi-pack-context (context)
+  (pcase-let ((`(,bf ,fg ,bg) context))
+    (logior
+     (ash (cl-loop
+           with x = 0
+           for i from 0 to (1- (length bf))
+           if (aref bf i) do (setq x (+ x (ash 1 i)))
+           finally return x)
+          (+ 25 25))
+     (if fg
+         (logior (ash fg (+ 25 1))
+                 (ash 1 25))
+       0)
+     (if bg
+         (logior (ash bg 1) 1)
+       0))))
+
+(defun org-ansi-unpack-to-context (int)
+  (list
+   (apply #'bool-vector
+          (cl-loop
+           with mask = (ash 1 (+ 25 25))
+           repeat 8
+           collect (not (zerop (logand int mask)))
+           and do (cl-callf ash mask 1)))
+   (unless (zerop (logand (ash 1 25) int))
+     (logand #xffffff (ash int (- (+ 25 1)))))
+   (unless (zerop (logand 1 int))
+     (logand #xffffff (ash int -1)))))
+
+(defun org-ansi-context-contained-p (a b)
+  (let ((get
+         (lambda (color int)
+           (when (eq color 'fg)
+             (cl-callf ash int -25))
+           (unless (zerop (logand 1 int))
+             (logand #xffffff (ash int -1))))))
+    (or (let ((bf-mask (ash #xff (+ 25 25))))
+          (not (zerop (logand (logand a bf-mask)
+                              (logand b bf-mask)))))
+        (let ((fg-a (funcall get 'fg a)))
+          (and fg-a (eq fg-a (funcall get 'fg b))))
+        (let ((bg-a (funcall get 'bg a)))
+          (and bg-a (eq bg-a (funcall get 'bg b)))))))
+
+;; TODO: Is this actually correct?  The (1- pos) has me doubting it.
+(defun org-ansi-previous-context-position (limit)
+  (let ((pos (point)) context)
+    (while (and (< limit pos)
+                (null context))
+      (setq context (get-text-property
+                     (max (1- pos) (point-min)) 'org-ansi-context)
+            pos (previous-single-property-change
+                 pos 'org-ansi-context nil limit)))
+    (when context
+      pos)))
+
+(defun org-ansi-previous-context (pos limit)
+  (let ((pos (save-excursion
+               (goto-char pos)
+               (org-ansi-previous-context-position limit))))
+    (when pos
+      (get-text-property pos 'org-ansi-context))))
+
+(defun org-ansi-point-context ()
+  "Return the ANSI context associated with `point'.
+If no context is associated with `point' return nil."
+  (when-let ((packed-context
+              (let ((el (org-element-at-point)))
+                ;; A region AB where there is a context at the end of
+                ;; A, but no context anywhere in B will result in that
+                ;; ending context of A being picked up here by
+                ;; `org-ansi-previous-context' since that function
+                ;; finds the first non-null context between POS and
+                ;; LIMIT.  Since B has no context and A ends in a
+                ;; context, it must be that A ends in an effectively
+                ;; null context (i.e. no foreground or background)
+                ;; which is just the implicit context on B so
+                ;; everything works out OK.
+                (or (org-ansi-previous-context (point) (org-element-begin el))
+                    (when-let ((parent (org-ansi-greater-element-context el)))
+                      (org-ansi-previous-context
+                       (org-element-begin el)
+                       (org-element-contents-begin parent)))))))
+    (org-ansi-unpack-to-context packed-context)))
+
+(defvar org-element-greater-elements)
+
+(defun org-ansi-greater-element-context (el)
+  "Return non-nil if ANSI sequences in EL can span multiple elements.
+They can if EL is contained in a greater element with a RESULTS
+affiliated keyword.  Or if EL is such a greater element.
+
+Specifically returns that greater element or nil."
+  (if (and (org-element-property :results el)
+           (memq (org-element-type el) org-ansi-highlightable-elements)
+           (memq (org-element-type el) org-element-greater-elements))
+      el
+    (let ((parent el))
+      (while (and parent
+                  (not (eq (org-element-type parent) 'section))
+                  (not (org-element-property :results parent)))
+        (setq parent (org-element-parent parent)))
+      (when (and parent (not (eq parent el))
+                 (org-element-property :results parent)
+                 (memq (org-element-type parent)
+                       org-ansi-highlightable-elements))
+        parent))))
+
+(defun org-ansi-highlightable-element-p (el)
+  "Return non-nil if EL can have ANSI sequences highlighted in it.
+See `org-ansi-highlightable-elements'."
+  (or (org-ansi-greater-element-context el)
+      (memq (org-element-type el) org-ansi-highlightable-elements)))
+
+(defun org-ansi-extent-of-context ()
+  "Return the end of the influence of the ANSI context at `point'.
+Return nil if `point' has no ANSI context."
+  (when-let ((context (get-text-property (point) 'org-ansi-context)))
+    (let* ((el (org-element-at-point))
+           (pos (next-single-property-change (point) 'org-ansi-context))
+           (end (cadr (org-ansi-widened-element-and-end el))))
+      (while (and (< pos end)
+                  (let ((other (get-text-property pos 'org-ansi-context)))
+                    (or (null other)
+                        (eq context other)
+                        (org-ansi-context-contained-p context other))))
+        (setq pos (next-single-property-change pos 'org-ansi-context nil end)))
+      (unless (get-text-property pos 'org-ansi-context)
+        (setq pos (previous-single-property-change pos 'org-ansi-context)))
+      pos)))
+
+(defun org-ansi-widened-element-and-end (el)
+  (let* ((greater-el (org-ansi-greater-element-context el))
+         (el (or greater-el el)))
+    (if-let ((parent (org-ansi-greater-element-context el)))
+        (list parent (org-element-contents-end parent))
+      (list el (pcase (org-element-type el)
+                 ((or `headline `inlinetask)
+                  (org-element-contents-begin el))
+                 (_
+                  (or (org-element-contents-end el)
+                      (org-element-end el))))))))
+
+;; What will be set as the `ansi-color-context-region' below.
+(defvar org-ansi-ansi-color-context (list nil (make-marker)))
+
+(defun org-ansi-apply-on-region (beg end &optional face-function seq-function)
+  "Apply ANSI sequences between (BEG END), maintain Org specific state.
+Calls `ansi-color-apply-on-region' on the region between BEG and
+END using FACE-FUNCTION as the `ansi-color-apply-face-function'
+which defaults to a function prepends the face and adds an
+`org-ansi-context' property to the highlighted regions.
+
+SEQ-FUNCTION is a function to apply to the ANSI sequences found
+in the region.  It is called with the bounds of the sequence as
+arguments.  It defaults to doing nothing on the sequences."
+  (setcar org-ansi-ansi-color-context org-ansi-context)
+  (move-marker (cadr org-ansi-ansi-color-context) beg)
+  (let ((ansi-color-context-region org-ansi-ansi-color-context)
+        (ansi-color-apply-face-function
+         (or face-function
+             (lambda (beg end face)
+               (when face
+                 (font-lock-prepend-text-property beg end 'face face))
+               (add-text-properties
+                beg end (list 'org-ansi-context
+                              (org-ansi-pack-context org-ansi-context)))))))
+    (ansi-color-apply-on-region beg end t))
+  (goto-char beg)
+  (while (re-search-forward ansi-color-control-seq-regexp end 'noerror)
+    (let ((beg (match-beginning 0))
+          (end (point)))
+      (when seq-function
+        (funcall seq-function beg end))
+      (dolist (ov (overlays-at beg))
+        (when (and (= beg (overlay-start ov))
+                   (= end (overlay-end ov))
+                   (overlay-get ov 'invisible))
+          ;; Assume this is the overlay added by
+          ;; `ansi-color-apply-on-region'.
+          (delete-overlay ov))))))
+
+(defvar font-lock-beg)
+(defvar font-lock-end)
+
+(defun org-ansi-extend-region ()
+  (let ((old-end font-lock-end)
+        (end font-lock-end)
+        (changed nil))
+    (save-excursion
+      ;; Extend due to deletions or modifications of sequences.
+      (goto-char font-lock-beg)
+      (while (< (point) end)
+        (let ((context (get-text-property (point) 'org-ansi-context))
+              (seq-state (get-text-property (point) 'org-ansi)))
+          (if (and context seq-state)
+              (if (and (looking-at ansi-color-control-seq-regexp)
+                       (eq (intern (buffer-substring-no-properties
+                                    (match-beginning 0) (match-end 0)))
+                           seq-state))
+                  (goto-char (next-single-property-change
+                              (point) 'org-ansi-context nil end))
+                ;; Either a sequence was deleted or a sequence was
+                ;; replaced with some other sequence.  Extend the
+                ;; region to include the extent of the changed
+                ;; sequence.
+                (let ((ctx-end (org-ansi-extent-of-context)))
+                  (setq end (max end ctx-end))
+                  (goto-char ctx-end)))
+            (goto-char (next-single-property-change
+                        (point) 'org-ansi-context nil end)))))
+      (unless (eq old-end end)
+        (goto-char end)
+        (unless (eq (point) (line-beginning-position))
+          (forward-line))
+        (setq font-lock-end (point)
+              changed t))
+      ;; Extend due to splits of elements into multiple other
+      ;; elements.
+      (goto-char font-lock-end)
+      (skip-chars-forward " \r\n\t")
+      (let* ((el (org-element-at-point))
+             ;; FIXME Consider elements like plain-list and table, we
+             ;; don't want to end up fontifying the whole plain-list
+             ;; or table if the highlighting can be determined to only
+             ;; be up to some point before the end, e.g. within a
+             ;; paragraph or table row.
+             (end (pcase (org-element-type el)
+                    ((or `headline `inlinetask)
+                     (org-element-contents-begin el))
+                    (_
+                     (org-element-end el)))))
+        ;; Move to the first highlight within the element if not
+        ;; already at one.
+        (unless (get-text-property (point) 'org-ansi-context)
+          (let ((next (next-single-property-change
+                       (point) 'org-ansi-context nil end)))
+            (unless (eq next end)
+              (goto-char next))))
+        (when (get-text-property (point) 'org-ansi-context)
+          (if (get-text-property (point) 'org-ansi)
+              (let ((seq-context
+                     (progn
+                       (org-ansi-clear-context org-ansi-context)
+                       ;; Purely for the side effect of
+                       ;; setting `org-ansi-context'
+                       (org-ansi-apply-on-region
+                        (point)
+                        (next-single-property-change (point) 'org-ansi)
+                        #'ignore)
+                       (org-ansi-pack-context org-ansi-context)))
+                    (context (get-text-property (point) 'org-ansi-context)))
+                (unless (eq seq-context context)
+                  (setq font-lock-end (org-ansi-extent-of-context)
+                        changed t)))
+            ;; Include the whole element for lack of a better way of
+            ;; determining when to stop.  See FIXME above.  Could just
+            ;; look for the next sequence in this element...
+            (setq font-lock-end end
+                  changed t)))))
+    changed))
+
+(defun org-ansi-process-region (beg end)
+  "Process ANSI sequences in the region (BEG END).
+Use and update the value of `org-ansi-context' during the
+processing."
+  (let* ((highlight-beg beg)
+         (set-seq-properties
+          (lambda (beg end)
+            (let ((seq (intern (buffer-substring-no-properties beg end))))
+              (remove-text-properties highlight-beg beg '(org-ansi t))
+              (setq highlight-beg end)
+              (add-text-properties
+               beg end (list 'invisible 'org-ansi
+                             'rear-nonsticky '(org-ansi)
+                             'org-ansi seq))
+              (put-text-property beg end 'org-ansi-context
+                                 (or (get-text-property end 'org-ansi-context)
+                                     ;; Handle edge case that a sequence
+                                     ;; occurs at the end of the region
+                                     ;; being processed.
+                                     (org-ansi-pack-context org-ansi-context)))))))
+    (org-ansi-apply-on-region beg end nil set-seq-properties)
+    (remove-text-properties highlight-beg end '(org-ansi t))))
+
+(defun org-ansi-process-object (obj)
+  "Highlight the ANSI sequences contained in OBJ."
+  (org-ansi-process-region
+   (point)
+   (or (org-element-contents-end obj)
+       (- (org-element-end obj)
+          (org-element-post-blank obj)
+          1)))
+  (goto-char (org-element-end obj)))
+
+(defun org-ansi-process-lines (beg end)
+  "Highlight the ANSI sequences of the lines between BEG and END.
+Exclude whitespace at the beginning of the lines."
+  (goto-char beg)
+  (while (< (point) end)
+    (org-ansi-process-region (point) (min end (line-end-position)))
+    (forward-line)
+    (skip-chars-forward " \t"))
+  (goto-char end))
+
+(defvar org-element-all-objects)
+
+(defun org-ansi-process-lines-consider-objects (beg end)
+  "Highlight the ANSI sequences of the lines between BEG and END.
+Consider objects when highlighting."
+  (goto-char beg)
+  (while (re-search-forward ansi-color-control-seq-regexp end 'noerror)
+    (goto-char (match-beginning 0))
+    (let ((seq-end (match-end 0))
+          (el (org-element-context)))
+      ;; If the context is empty and the current sequence lies in an
+      ;; object, relegate the effect of the sequence to the object.
+      (if (org-ansi-null-context-p org-ansi-context)
+          (let ((type (org-element-type el)))
+            (if (memq type org-element-all-objects)
+                (if (not (memq type org-ansi-highlightable-objects))
+                    (goto-char seq-end)
+                  (org-ansi-process-object el)
+                  (org-ansi-clear-context org-ansi-context)
+                  (setq beg (point)))
+              (org-ansi-process-lines beg seq-end)))
+        (org-ansi-process-lines beg seq-end))
+      (setq beg seq-end)))
+  (org-ansi-process-lines beg end))
+
+(defun org-ansi-process-element (el &optional limit)
+  "Process ANSI sequences in EL up to LIMIT.
+EL should be a lesser element or headline.  If EL can't be
+processed, move `point' to its end.  Otherwise process the
+element, i.e. highlight the ANSI sequences beginning at
+`point' (assumed to be within EL) and ending at LIMIT or the end
+of the element, whichever comes first.
+
+After a call to this function `point' will be at LIMIT or the
+next element that comes after EL."
+  (pcase (org-element-type el)
+    ((or `headline `inlinetask)
+     (org-ansi-process-lines-consider-objects
+      (point) (line-end-position))
+     (goto-char (org-element-contents-begin el)))
+    (`table-row
+     ;; NOTE Limit not used here since a row is a line and it doesn't
+     ;; seem to make sense to process only some of the cells in a row.
+     ;; Limit is usually a line beginning position anyways which is
+     ;; the end of a table row in the first place.
+     (if (eq (org-element-property :type el) 'rule)
+         (goto-char (org-element-end el))
+       (let ((end-1 (1- (org-element-end el))))
+         (while (< (point) end-1)
+           (let ((cell (org-element-context)))
+             (org-ansi-process-region
+              (org-element-contents-begin cell)
+              (org-element-contents-end cell))
+             (goto-char (org-element-end cell))))
+         (forward-char))))
+    ((or `example-block `export-block `src-block)
+     (let ((beg (point))
+           (end (save-excursion
+                  (goto-char (org-element-end el))
+                  (skip-chars-backward " \t\r\n")
+                  (line-beginning-position))))
+       (setq limit (if limit (min end limit)
+                     end))
+       (org-ansi-process-lines beg limit)
+       (if (eq limit end)
+           (goto-char (org-element-end el))
+         (goto-char limit))))
+    (`fixed-width
+     (setq limit (if limit (min (org-element-end el) limit)
+                   (org-element-end el)))
+     (while (< (point) limit)
+       (when (eq (char-after) ?:)
+         (forward-char)
+         (when (eq (char-after) ?\s)
+           (forward-char)))
+       (org-ansi-process-region (point) (line-end-position))
+       (skip-chars-forward " \n\r\t")))
+    (`paragraph
+     (let ((pend (1- (org-element-contents-end el))) beg end)
+       (setq limit (if limit (min pend limit) pend))
+       ;; Compute the regions of the paragraph excluding inline
+       ;; source blocks or babel calls.
+       (push (point) beg)
+       (while (re-search-forward
+               "\\<\\(src\\|call\\)_[^ \t\n[{]+[{(]" limit t)
+         (let ((el (org-element-context)))
+           (when (memq (org-element-type el)
+                       '(inline-src-block inline-babel-call))
+             (push (org-element-begin el) end)
+             (goto-char (min (org-element-end el) limit))
+             (push (point) beg))))
+       (push limit end)
+       (setq beg (nreverse beg)
+             end (nreverse end))
+       (while beg
+         (org-ansi-process-lines-consider-objects (pop beg) (pop end)))
+       (if (eq limit pend)
+           (goto-char (org-element-end el))
+         (goto-char limit))))
+    (_
+     (goto-char (org-element-end el)))))
+
+(defun org-ansi-visit-elements (limit visitor)
+  "Visit highlightable elements between `point' and LIMIT with VISITOR.
+LIMIT is supposed to be a hard limit which VISITOR should not
+visit anything past it.
+
+VISITOR is a function that takes an element and LIMIT as
+arguments.  It is called for every highlightable lesser element
+within the visited region.  After being called it is expected
+that `point' is moved past the visited element, to the next
+element to potentially process, or to LIMIT, whichever comes
+first."
+  (declare (indent 1))
+  (let ((skip-to-end-p
+         (lambda (el)
+           (or (null (org-element-contents-begin el))
+               (<= (org-element-contents-end el)
+                   (point)
+                   (org-element-end el))))))
+    (while (< (point) limit)
+      (let* ((el (org-element-at-point))
+             (type (org-element-type el)))
+        (pcase type
+          ;; Greater elements
+          ((or `item `center-block `quote-block `special-block
+               `dynamic-block `drawer `footnote-definition)
+           (if (funcall skip-to-end-p el)
+               (goto-char (org-element-end el))
+             (goto-char (org-element-contents-begin el))
+             (org-ansi-visit-elements
+                 (min limit (org-element-contents-end el))
+               visitor)))
+          (`property-drawer
+           (goto-char (org-element-end el)))
+          (`plain-list
+           (if (funcall skip-to-end-p el)
+               (goto-char (org-element-end el))
+             (let ((end (min limit (org-element-end el))))
+               (goto-char (org-element-contents-begin el))
+               (while (< (point) end)
+                 ;; Move to within the first item of a list.
+                 (forward-char)
+                 (let* ((item (org-element-at-point))
+                        (cbeg (org-element-contents-begin item)))
+                   (when cbeg
+                     (goto-char cbeg)
+                     (org-ansi-visit-elements
+                         (min limit (org-element-contents-end item))
+                       visitor))
+                   (when (< (point) limit)
+                     (goto-char (org-element-end item)))
+                   (skip-chars-forward " \t\n\r"))))))
+          (`table
+           (if (funcall skip-to-end-p el)
+               (goto-char (org-element-end el))
+             (goto-char (org-element-contents-begin el))
+             ;; Move to within the table-row of a table to continue
+             ;; processing it.
+             (forward-char)))
+          ((or `headline `inlinetask)
+           (if (funcall skip-to-end-p el)
+               (goto-char (org-element-end el))
+             (if (org-ansi-highlightable-element-p el)
+                 (funcall visitor el limit)
+               (goto-char (org-element-contents-begin el)))))
+          ((guard (org-ansi-highlightable-element-p el))
+           (let ((visit t))
+             ;; Move to the beginning of the highlightable region if not already
+             ;; within one.
+             (pcase (org-element-type el)
+               (`table-row
+                (if (eq (org-element-property :type el) 'rule)
+                    (progn
+                      (setq visit nil)
+                      (goto-char (org-element-end el)))
+                  (when (< (point) (org-element-contents-begin el))
+                    (goto-char (org-element-contents-begin el)))))
+               ((or `example-block `export-block `src-block)
+                (let ((start (save-excursion
+                               (goto-char (org-element-post-affiliated el))
+                               (line-beginning-position 2))))
+                  (when (< (point) start)
+                    (goto-char start))))
+               (`fixed-width
+                (when (< (point) (org-element-post-affiliated el))
+                  (goto-char (org-element-post-affiliated el))))
+               (`paragraph
+                (when (< (point) (org-element-contents-begin el))
+                  (goto-char (org-element-contents-begin el)))))
+             (when visit
+               ;; Move past any whitespace at the beginning of a line if
+               ;; `point' is within that whitespace.
+               (let ((pos (point))
+                     (skipped (not (zerop (skip-chars-backward " \t")))))
+                 (if (eq (point) (line-beginning-position))
+                     (skip-chars-forward " \t")
+                   (when skipped
+                     (goto-char pos))))
+               (funcall visitor el limit))))
+          (_
+           (goto-char (org-element-end el))))))
+    ;; Move to the next element when `point' is basically at the end
+    ;; of an element.
+    (let ((el (org-element-at-point)))
+      (when (and (org-element-contents-begin el)
+                 (<= (org-element-contents-end el)
+                     (point)
+                     (org-element-end el)))
+        (goto-char (org-element-end el))))))
+
+(defvar org-ansi-mode)
+
+(defun org-fontify-ansi-sequences (limit)
+  "Fontify ANSI sequences."
+  (when (and org-fontify-ansi-sequences org-ansi-mode)
+    (or org-ansi-context
+        (setq org-ansi-context (org-ansi-new-context)))
+    (org-ansi-clear-context org-ansi-context)
+    (let* ((last-el-processed nil)
+           (process
+            (lambda (el limit &optional context)
+              (when-let ((context (or context (org-ansi-point-context))))
+                (setq org-ansi-context context))
+              (pcase-let* ((`(,widened-el ,end) (org-ansi-widened-element-and-end el))
+                           ;; Preserve the context when processing a
+                           ;; highlightable greater element or when
+                           ;; the processing limit falls within an
+                           ;; element.  In both cases, the context may
+                           ;; be needed for post processing.
+                           (preserve-context (or (< limit end)
+                                                 (not (eq widened-el el)))))
+                (org-ansi-visit-elements (min end limit)
+                  (lambda (el limit)
+                    (setq last-el-processed el)
+                    (org-ansi-process-element el limit)
+                    (unless preserve-context
+                      (org-ansi-clear-context org-ansi-context))))))))
+      (skip-chars-forward " \n\r\t")
+      (while (< (point) limit)
+        (let ((context (org-ansi-point-context)))
+          (cond
+           (context
+            ;; A context exists before point in this element so it
+            ;; must have been highlightable, process the element
+            ;; starting with the previous context.
+            (funcall process (org-element-at-point) limit context))
+           (t
+            ;; No previous context at this point, so it's safe to
+            ;; begin processing at the start of the next sequence.
+            ;; There is no context prior to the sequence to consider.
+            (when (re-search-forward ansi-color-control-seq-regexp limit 'noerror)
+              (goto-char (match-beginning 0))
+              (funcall process (org-element-at-point) limit)))))
+        (skip-chars-forward " \n\r\t"))
+      ;; Post processing to highlight to the proper end (past limit)
+      ;; when there is a non-null context remaining and the region
+      ;; after limit does not match with the context.
+      (pcase-let* ((el (org-element-at-point))
+                   (`(,widened-el ,end) (org-ansi-widened-element-and-end el)))
+        (when (and (not (org-ansi-null-context-p org-ansi-context))
+                   (or
+                    ;; A partial processing of the element.  `point'
+                    ;; is still inside of it.
+                    (eq last-el-processed el)
+                    ;; Inside a highlightable greater element context.
+                    ;; Processing ended at the end of an element and
+                    ;; thus `point' will be at the beginning of the
+                    ;; next element.  If that next element is inside
+                    ;; the same greater element context then the
+                    ;; highlighting should continue through to that
+                    ;; next element and beyond.
+                    (and (not (eq widened-el el))
+                         (<= (org-element-contents-begin widened-el) (point)
+                             (org-element-contents-end widened-el)))))
+          (let ((visit 'check))
+            (catch 'visit
+              (org-ansi-visit-elements end
+                (lambda (el limit)
+                  (when (eq visit 'check)
+                    (let ((context (get-text-property
+                                    (point) 'org-ansi-context)))
+                      (when (eq context
+                                (org-ansi-pack-context org-ansi-context))
+                        ;; Only continue the highlighting past limit
+                        ;; when the contexts don't match.
+                        (throw 'visit nil)))
+                    (setq visit t))
+                  (org-ansi-process-element el limit)
+                  (when (eq widened-el el)
+                    (org-ansi-clear-context org-ansi-context)))))))))))
+
+(defun org-toggle-ansi-display ()
+  "Toggle the visible state of ANSI sequences in the current buffer."
+  (interactive)
+  (setq org-ansi-hide-sequences (not org-ansi-hide-sequences))
+  (if org-ansi-hide-sequences
+      (add-to-invisibility-spec 'org-ansi)
+    (remove-from-invisibility-spec 'org-ansi)))
+
 (defun org-activate-footnote-links (limit)
   "Add text properties for footnotes."
   (let ((fn (org-footnote-next-reference-or-definition limit)))
@@ -5971,6 +6642,7 @@ (defun org-set-font-lock-defaults ()
           ;; `org-fontify-inline-src-blocks' prepends object boundary
           ;; faces and overrides native faces.
           '(org-fontify-inline-src-blocks)
+          '(org-fontify-ansi-sequences)
           ;; Citations.  When an activate processor is specified, if
           ;; specified, try loading it beforehand.
           (progn
@@ -6159,7 +6831,7 @@ (defun org-unfontify-region (beg end &optional _maybe_loudly)
     (remove-text-properties beg end
 			    '(mouse-face t keymap t org-linked-text t
 					 invisible t intangible t
-					 org-emphasis t))
+					 org-emphasis t org-ansi-context t))
     (org-fold-core-update-optimisation beg end)
     (org-remove-font-lock-display-properties beg end)))
 
@@ -15950,6 +16622,30 @@ (defun org-agenda-prepare-buffers (files)
     (when org-agenda-file-menu-enabled
       (org-install-agenda-files-menu))))
 
+\f
+;;;; ANSI minor mode
+
+(define-minor-mode org-ansi-mode
+  "Toggle the minor `org-ansi-mode'.
+This mode adds support to highlight ANSI sequences in Org mode.
+The sequences are highlighted only if the customization
+`org-fontify-ansi-sequences' is non-nil when the mode is enabled.
+\\{org-ansi-mode-map}"
+  :lighter " OANSI"
+  (if org-ansi-mode
+      (progn
+        (add-hook 'font-lock-extend-region-functions
+                  #'org-ansi-extend-region 'append t)
+        (if org-ansi-hide-sequences
+            (add-to-invisibility-spec 'org-ansi)
+          (remove-from-invisibility-spec 'org-ansi)))
+    (remove-hook 'font-lock-extend-region-functions
+                 #'org-ansi-extend-region t)
+    (remove-from-invisibility-spec 'org-ansi))
+  (org-restart-font-lock))
+
+(add-hook 'org-mode-hook #'org-ansi-mode)
+
 \f
 ;;;; CDLaTeX minor mode
 
diff --git a/testing/lisp/test-org.el b/testing/lisp/test-org.el
index 2487c9a..a376d90 100644
--- a/testing/lisp/test-org.el
+++ b/testing/lisp/test-org.el
@@ -28,6 +28,8 @@ (require 'org)
 (require 'org-inlinetask)
 (require 'org-refile)
 (require 'org-agenda)
+(require 'faceup)
+
 
 \f
 ;;; Helpers
@@ -2253,6 +2255,317 @@ (ert-deftest test-org/clone-with-time-shift ()
              (org-test-with-result 'buffer
                (org-clone-subtree-with-time-shift 1 "-2h")))))))
 
+\f
+;;; ANSI sequences
+
+(ert-deftest test-org/ansi-sequence-fontification ()
+  "Test correct behavior of ANSI sequences."
+  (let ((org-fontify-ansi-sequences t))
+    (cl-labels
+        ((faceup
+           (text)
+           (org-test-with-temp-text text
+             (org-ansi-mode)
+             (font-lock-ensure)
+             (let ((fontified (current-buffer)))
+               (with-temp-buffer
+                 (faceup-markup-to-buffer (current-buffer) fontified)
+                 (buffer-string)))))
+         (test
+           (text text-faceup)
+           ;; Don't spill over sequences to the rest of the terminal
+           ;; when a test fails.
+           (setq text (concat text "\n^[[0m\n")
+                 text-faceup (concat text-faceup "\n^[[0m\n"))
+           (should (faceup-test-equal (faceup text) text-faceup))))
+      (cl-macrolet ((face (f &rest args)
+                      (let* ((short-name (alist-get f faceup-face-short-alist))
+                             (name (or short-name f))
+                             (prefix (format (if short-name "%s:" "%S:") name)))
+                        (unless short-name
+                          (cl-callf2 concat ":" prefix))
+                        (cl-callf2 concat "«" prefix)
+                        `(concat ,prefix ,@args "»")))
+                    (fg (&rest args) `(face (:foreground "green3") ,@args))
+                    (bg (&rest args) `(face (:background "green3") ,@args))
+                    (fg-bg (&rest args) `(fg (bg ,@args)))
+                    (bold (&rest args) `(face bold ,@args))
+                    (org (text) `(faceup ,text))
+                    (fg-start () "^[[32m")
+                    (bg-start () "^[[42m")
+                    (clear () "^[[0m"))
+        ;; Objects
+        ;; Sequence's effect remains in object...
+        (test
+         (concat "1 An *obj" (fg-start) "ect*. text after\n")
+         (concat "1 An " (bold "*obj" (fg-start) (fg "ect") "*") ". text after\n"))
+        ;; ...except when there were sequences at the element level previously.
+        (test
+         (concat "2 " (fg-start) "text *obj" (bg-start) "ect*. text after\n")
+         (concat "2 " (fg-start) (fg "text ")
+                 (bold (fg "*obj") (bg-start) (fg-bg "ect*"))
+                 (fg-bg ". text after") "\n"))
+        ;; Sequence in object before sequence at element level.
+        (test
+         (concat
+          "3 *obj" (fg-start) "ect*. text "
+          (bg-start) "after\n")
+         (concat
+          "3 " (bold "*obj" (fg-start) (fg "ect") "*") ". text "
+          (bg-start) (bg "after") "\n"))
+        ;; Clearing the ANSI context in a paragraph, resets things so
+        ;; that sequences appearing in objects later in the paragraph
+        ;; have their effects localized to the objects.
+        (test
+         (concat
+          "4 *obj" (fg-start) "ect* " (fg-start) " text"
+          (clear) " text *obj" (bg-start) "ect* more text\n")
+         (concat
+          "4 " (bold "*obj" (fg-start) (fg "ect") "*") " " (fg-start) (fg " text")
+          (clear) " text " (bold "*obj" (bg-start) (bg "ect") "*") " more text\n"))
+        ;; Tables
+        (test
+         (concat
+          "#+RESULTS:\n"
+          "| " (fg-start) "10a | b |\n"
+          "| c | d |\n")
+         (concat
+          (org "#+RESULTS:\n")
+          (face org-table "| " (fg-start) (fg "10a") " | " (fg "b") " |") (face org-table-row "\n")
+          (face org-table "| " (fg "c") " | " (fg "d") " |") (face org-table-row "\n")))
+        (test
+         (concat
+          "| " (fg-start) "5a | b |\n"
+          "| cell  | d |\n")
+         (concat
+          (face org-table "| " (fg-start) (fg "5a")" | " (fg "b") " |") (face org-table-row "\n")
+          (face org-table "| cell" "  | d |") (face org-table-row "\n")))
+        ;; Paragraphs
+        (test
+         (concat
+          (fg-start) "6 paragraph1\ntext\n"
+          "\nparagraph2\n\n"
+          (fg-start) "text src_python{return 1 + 1} "
+          (bg-start) "more text\n")
+         (concat
+          (fg-start) (fg "6 paragraph1") "\n"
+          (fg "text") "\n"
+          "\nparagraph2\n\n"
+          ;; Effect of sequences skips inline source blocks.
+          (fg-start) (fg "text ") (org "src_python{return 1 + 1} ")
+          (bg-start) (fg (bg "more text")) "\n"))
+        ;; Don't fontify whitespace 
+        ;; Fixed width
+        (test
+         (concat
+          "#+RESULTS:\n"
+          ": 4 one " (fg-start) "two\n"
+          ": three\n")
+         (concat
+          (org "#+RESULTS:\n")
+          (face org-code
+                ": 4 one " (fg-start) (fg "two") "\n"
+                ": " (fg "three") "\n")))
+        ;; Blocks
+        (test
+         (concat
+          "#+begin_example\n"
+          "5 li " (fg-start) "ne 1\n"
+          "line 2\n"
+          "line 3\n"
+          "#+end_example\n"
+          "\ntext after\n")
+         (concat
+          (face org-block-begin-line "#+begin_example\n")
+          (face org-block
+                "5 li " (fg-start) (fg "ne 1") "\n"
+                (fg "line 2") "\n"
+                (fg "line 3") "\n")
+          (face org-block-end-line "#+end_example\n")
+          "\ntext after\n"))
+        ;; Avoid processing some elements according to
+        ;; `org-ansi-highlightable-elements' or
+        ;; `org-ansi-highlightable-objects'.
+        (let ((org-ansi-highlightable-objects
+               (delete 'verbatim org-ansi-highlightable-objects))
+              (org-ansi-highlightable-elements
+               (delete 'src-block org-ansi-highlightable-elements)))
+          (test
+           (concat
+            "6 =verb" (fg-start) "atim=\n\n"
+            "#+begin_src python\n"
+            "return \"str " (fg-start) "ing\"\n"
+            "#+end_src\n")
+           (org
+            (concat
+             "6 =verb" (fg-start) "atim=\n\n"
+             "#+begin_src python\n"
+             "return \"str " (fg-start) "ing\"\n"
+             "#+end_src\n"))))
+        ;; Headlines
+        (test
+         (concat
+          "* 7 Head" (fg-start) "line 1\n"
+          "\ntext after\n")
+         (concat
+          (face org-level-1 "* 7 Head" (fg-start) (fg "line 1")) "\n"
+          "\ntext after\n"))
+        ;; Sequences span the whole list with a RESULTS affiliated
+        ;; keyword.
+        (test
+         (concat
+          "- " (fg-start) "one\n"
+          "  - two\n"
+          "- three\n\n"
+          "#+RESULTS:\n"
+          "- " (fg-start) "one\n"
+          "  - two\n"
+          "- three\n")
+         (concat
+          "- " (fg-start) (fg "one") "\n"
+          "  - two\n"
+          "- three\n\n"
+          (org "#+RESULTS:\n")
+          "- " (fg-start) (fg "one") "\n"
+          "  - " (fg "two") "\n"
+          "- " (fg "three") "\n"))
+        (test
+         (concat
+          "#+RESULTS:\n"
+          "| " (fg-start) "b | c |\n"
+          "|---+---|\n"
+          "| a | b |\n\n"
+          "paragraph1\n\n"
+          "-----\n\n"
+          "paragraph2\n")
+         (concat
+          (org "#+RESULTS:\n")
+          (face org-table "| " (fg-start) (fg "b") " | " (fg "c") " |") (face org-table-row "\n")
+          (face org-table "|---+---|") (face org-table-row "\n")
+          (face org-table "| " (fg "a") " | " (fg "b") " |") (face org-table-row "\n")
+          "\nparagraph1\n\n"
+          "-----\n\n"
+          "paragraph2\n"))
+        (test
+         (concat
+          "#+RESULTS:\n"
+          ":drawer:\n"
+          (fg-start) "paragraph\n\n"
+          "#+begin_center\n"
+          "- item1\n"
+          "- item2\n"
+          "  - item3\n"
+          "#+end_center\n\n"
+          "paragraph2\n"
+          ":end:\n")
+         (concat
+          (org "#+RESULTS:\n")
+          (org ":drawer:\n")
+          (fg-start) (fg "paragraph") "\n\n"
+          (face org-block-begin-line "#+begin_center\n")
+          "- " (fg "item1") "\n"
+          "- " (fg "item2") "\n"
+          "  - " (fg "item3") "\n"
+          (face org-block-end-line "#+end_center\n") "\n"
+          (fg "paragraph2") "\n"
+          (org ":end:\n")))
+        ;; Highlighting context doesn't spill over to elements when it
+        ;; shouldn't.
+        (test
+         (concat
+          "#+BEGIN: dblock\n"
+          "- Item 1\n"
+          "- Item 2\n"
+          "- " (fg-start) "Item 3\n"
+          "#+END:\n\n"
+          "[fn:1] Footnote " (bg-start) "definition\n")
+         (concat
+          (face org-meta-line "#+BEGIN: dblock") "\n"
+          "- Item 1\n"
+          "- Item 2\n"
+          "- " (fg-start) (fg "Item 3") "\n"
+          (face org-meta-line "#+END:") "\n\n"
+          (face org-footnote "[fn:1]") " Footnote " (bg-start) (bg "definition") "\n"))))))
+
+(ert-deftest test-org/ansi-sequence-editing ()
+  (cl-labels ((test (text-faceup)
+                (let ((fontified (current-buffer)))
+                  (with-temp-buffer
+                    (faceup-markup-to-buffer (current-buffer) fontified)
+                    (should (faceup-test-equal (buffer-string) text-faceup)))))
+              (test-lines (n text-faceup &optional no-ensure)
+                (unless no-ensure
+                  (font-lock-ensure (line-beginning-position) (1+ (line-end-position n))))
+                (save-restriction
+                  (narrow-to-region (line-beginning-position) (1+ (line-end-position n)))
+                  (test text-faceup))))
+      (cl-macrolet ((face (f &rest args) `(concat "«" ,(format ":%S:" f) ,@args "»"))
+                    (fg (&rest args) `(face (:foreground "green3") ,@args))
+                    (fg-start () "^[[32m")
+                    (clear () "^[[0m"))
+        ;; fixed-width regions and font-lock-multiline
+        (org-test-with-temp-text
+            (concat "\
+: " (fg-start) "line1
+: line2
+<point>")
+          (org-ansi-mode)
+          (font-lock-ensure)
+          (insert ": line3\n")
+          (forward-line -1)
+          ;; Sequence effects spill over to newly inserted fixed-width line.
+          (test-lines 1 (face org-code ": " (fg "line3") "\n"))
+          (forward-line -1)
+          (goto-char (line-end-position))
+          (insert "text")
+          ;; Editing a line that is affected by some previous line's
+          ;; sequence maintains the effect of that sequence on the
+          ;; line.
+          (test-lines 2 (face org-code
+                              ": " (fg "line2text") "\n"
+                              ": " (fg "line3") "\n")))
+        ;; Test that the highlighting spans all nested elements inside
+        ;; an element with a RESULTS keyword and the highlighting
+        ;; remains after edits to any of the elements.
+        (org-test-with-temp-text
+            (concat "#+RESULTS:\n"
+                    ":drawer:\n"
+                    (fg-start) "paragraph\n\n"
+                    "#+begin_center\n"
+                    "- item1\n"
+                    "- item2\n"
+                    "  - item3\n"
+                    "#+end_center\n\n"
+                    "paragraph2<point>\n"
+                    ":end:\n")
+          (org-ansi-mode)
+          (font-lock-ensure)
+          (insert "more text")
+          (test-lines 1 (concat (fg "paragraph2more text") "\n"))
+          (re-search-backward "item3")
+          (forward-char)
+          (insert "x")
+          (test-lines 1 (concat "  - " (fg "ixtem3") "\n")))
+        ;; Joining paragraphs takes into account highlighting.
+        (org-test-with-temp-text
+            (concat (fg-start) "paragraph1\n\n<point>paragraph2\n")
+          (org-ansi-mode)
+          (font-lock-ensure)
+          (test-lines 1 "paragraph2\n")
+          (delete-char -1)
+          (test-lines 1 (concat (fg "paragraph2") "\n")))
+        ;; Splits in a highlighted region remove highlighting from the
+        ;; region split.
+        (org-test-with-temp-text
+            (concat (fg-start) "line1\nline2\n<point>line3\nline4\n")
+          (org-ansi-mode)
+          (font-lock-ensure)
+          (insert "\n")
+          ;; Test `org-ansi-extend-region' by limiting the region
+          ;; font-locked so it can be extended.
+          (font-lock-ensure (point) (1+ (line-end-position)))
+          (test-lines 2 "line3\nline4\n" t)))))
+
 \f
 ;;; Fixed-Width Areas
 
-- 
2.41.0


[-- Attachment #3: Type: text/plain, Size: 15 bytes --]


-- 
Nathaniel