emacs-orgmode@gnu.org archives
 help / color / mirror / code / Atom feed
From: Nathaniel Nicandro <nathanielnicandro@gmail.com>
To: Ihor Radchenko <yantar92@posteo.net>
Cc: Nathaniel Nicandro <nathanielnicandro@gmail.com>,
	emacs-orgmode <emacs-orgmode@gnu.org>
Subject: Re: [PATCH] Highlight ANSI sequences in the whole buffer  (was [PATCH] ANSI color on example blocks and fixed width elements)
Date: Tue, 26 Mar 2024 09:02:18 -0500	[thread overview]
Message-ID: <87plvhf5gf.fsf@gmail.com> (raw)
In-Reply-To: <875xzsjfvo.fsf@localhost>

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


Ihor Radchenko <yantar92@posteo.net> writes:

> Nathaniel Nicandro <nathanielnicandro@gmail.com> writes:

Hello,

I've finally implemented a solution to what I've discussed previously,
inserting zero width spaces as boundary characters after an ANSI
sequence to act as a separator from the text after the sequence.  This
would handle the scenario where deleting into the end byte of a
sequence causes ansi-color to recognize the partially deleted sequence
plus the character directly after the end byte to be a new sequence.
This looked like the invisible region containing a sequence eating up
other characters not intended to be part of the region.

So for example, suppose you had a control sequence, ^[[42m, where m is
the end byte that says the sequence is a color sequence.  Let point be
signified by *.  If we have

^[[42m*text

then deletion into the end byte would result in 

^[[42*text

t is still a valid end byte so the fontification process will
recognized the whole thing as a valid sequence still and the t would
then become part of the invisible region containing the sequence.

To avoid this from happening I have introduced the rule that any valid
sequence shall have a zero width space immediately after it and this
space remains in the buffer even on deleting into it with, for
example, backward-delete-char.  Let the zero width space be signified
by |.  If we have 

^[[42m|*text

then deletion into the space would now result in

^[[42*|text

i.e., the effect is that the deletion went past the space, leaving it
alone, and deleted the end byte of the control sequence.  Since the
control sequence is no longer valid, due to the space being at the
position of the end byte, it becomes visible.

If you then insert a valid end byte, e.g. m, then the effect is

^[[42m|*text

i.e., point moved past the space character.

So the implementation of that rule of maintaining a zero width space
after valid sequences and the rules around deleting into the space or
insertion in front of a space are the main changes in this patch
compared to previous versions.

>
> I tried to test your newest patch with the example file you provided and
> I notice two things that would be nice:
>
> 1. It is a bit confusing to understand why one or other text is colored
>    without seeing the escape characters. Some customization like
>    `org-link-descriptive' and a command like `org-toggle-link-display'
>    would be nice. I can see some users prefer seeing the escape codes.

I've gone ahead and implemented the toggling of the visibility of the
escapes sequences.  The variable is `org-ansi-hide-sequences` and the
function is `org-toggle-ansi-display`.

I just used buffer-invisibility-spec for this.

>
> 2. Using overlays for fontification is problematic. In your example
>    file, table alignment becomes broken when escape sequences are hidden
>    inside overlays:
>
>    | [31mcell 1 | cell 2 |
>    | cell 3       | cell 4 |
>
>    looks like
>
>    |       cell 1 | cell 2 |
>    | cell 3       | cell 4 |
>
>    Using text properties would make table alignment work without
>    adjustments in the org-table.el code.
>

I've gone ahead and used text properties instead of overlays.

>> One thing I would like to start doing is writing some tests for this
>> feature.  It would be great if someone could point me to some tests
>> that I can peruse so that I can get an idea of how I can go about
>> writing some of my own.  Also, are there any procedures or things I
>> should be aware of when trying to write my own tests?
>
> Check out testing/README file in the Org repository.
>
> Unfortunately, we do not yet have any existing tests for font-locking in
> Org tests. You may still refer to the files in testing/lisp/ to see some
> example tests.
>
> Also, Emacs has built-in library to help writing font-lock tests -
> faceup.el. You may consider using it. Its top comment also contains a
> number of references to various tools that could be useful to diagnose
> font-locking code.

I have not looked into testing this feature yet.

Feedback appreciated!


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

From ea2345ab218d3bc9c07452b2171afc1361b74b9d Mon Sep 17 00:00:00 2001
From: Nathaniel Nicandro <nathanielnicandro@gmail.com>
Date: Tue, 9 May 2023 19:58:11 -0500
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-hide-sequences)
(org-ansi-highlightable-elements)
(org-ansi-highlightable-objects): New customization variables.
(org-ansi--before-command, org-ansi--after-command)
(org-ansi--before-control-seq-deletion)
(org-ansi--after-control-seq-deletion)
(org-ansi-zero-width-space, org-ansi-is-zero-width-space)
(org-ansi-new-context, org-ansi-process-region)
(org-ansi-process-block, org-ansi-process-paragraph)
(org-ansi-process-fixed-width)
(org-fontify-ansi-sequences-1)
(org-toggle-ansi-display): New functions.
(org-ansi--control-seq-positions)
(org-ansi--change-pending, org-ansi--point-before-command)
(org-ansi--point-after-command, org-ansi--at-zero-width-space-p)
(org-ansi--delete-through-space-p): New internal variables.
(org-set-font-lock-defaults): Add the `org-fontify-ansi-sequences`
function to the font-lock keywords.
(org-unfontify-region): Delete ANSI specific overlays.
(org-ansi-mode): New minor mode to enable/disable highlighting of the
sequences.  Enabled in Org buffers by default.
---
 etc/ORG-NEWS |  18 ++
 lisp/org.el  | 469 ++++++++++++++++++++++++++++++++++++++++++++++++++-
 2 files changed, 486 insertions(+), 1 deletion(-)

diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS
index ca744b9..378eddf 100644
--- a/etc/ORG-NEWS
+++ b/etc/ORG-NEWS
@@ -946,6 +946,24 @@ properties, links to headlines in the file can also be made more
 robust by using the file id instead of the file path.
 
 ** New features
+
+*** 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=.
+
 *** =ob-tangle.el=: New flag to remove tangle targets before writing
 
 When ~org-babel-tangle-remove-file-before-write~ is set to ~t~ the
diff --git a/lisp/org.el b/lisp/org.el
index 7e3bbf9..8bf189a 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -81,6 +81,7 @@ (eval-when-compile (require 'gnus-sum))
 (require 'calendar)
 (require 'find-func)
 (require 'format-spec)
+(require 'ansi-color)
 
 (condition-case nil
     (load (concat (file-name-directory load-file-name)
@@ -3674,6 +3675,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.7"))
+
 (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
@@ -5686,6 +5693,438 @@ (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
+    example-block export-block fixed-width paragraph)
+  "A list of element types that will have ANSI sequences processed."
+  :type '(list (symbol :tag "Element Type"))
+  :version "9.7"
+  :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"))
+  :version "9.7"
+  :group 'org-appearance)
+
+(defcustom org-ansi-hide-sequences t
+  "Non-nil means Org hides ANSI sequences."
+  :type 'boolean
+  :version "9.7"
+  :group 'org-appearance)
+
+(defvar org-ansi--control-seq-positions nil)
+(defvar org-ansi--change-pending nil)
+(defvar org-ansi--point-after-command nil)
+(defvar org-ansi--point-before-command nil)
+(defvar org-ansi--at-zero-width-space-p nil)
+(defvar org-ansi--delete-through-space-p nil)
+
+(defun org-ansi--before-command ()
+  (setq org-ansi--point-before-command (point))
+  (setq org-ansi--delete-through-space-p nil
+        org-ansi--at-zero-width-space-p
+        (and (org-ansi-is-zero-width-space (char-before))
+             (get-text-property (1- (point)) 'org-ansi))))
+
+(defun org-ansi--after-command ()
+  (setq org-ansi--point-after-command (point))
+  (when (and org-ansi--at-zero-width-space-p
+             (= (- org-ansi--point-after-command
+                   org-ansi--point-before-command)
+                -1)
+             (not (org-ansi-is-zero-width-space (char-after))))
+    (setq org-ansi--delete-through-space-p t))
+  (setq org-ansi--at-zero-width-space-p nil))
+
+(defun org-ansi--before-control-seq-deletion (beg end)
+  (unless org-ansi--change-pending
+    ;; Don't repeat work.  This modification hook can be called
+    ;; multiple times all on the same region being modified, once for
+    ;; each org-ansi region contained in or overlapping with the
+    ;; modified region.
+    (setq org-ansi--change-pending t)
+    (org-with-wide-buffer
+     ;; The endpoints of the region being modified are fully contained
+     ;; within org-ansi marked regions if these are true.  Fully
+     ;; contained in this context means that the point does not lie at
+     ;; the edge or boundary of an org-ansi marked region.
+     (let ((beg-boundary
+            (and (get-text-property beg 'org-ansi)
+                 (get-text-property (max (1- beg) (point-min)) 'org-ansi)))
+           (end-boundary
+             (and (get-text-property end 'org-ansi)
+                  (get-text-property (min (1+ end) (point-max)) 'org-ansi))))
+       (if (and beg-boundary end-boundary
+                (= end (next-single-property-change beg 'org-ansi nil end)))
+           ;; If the region being modified is fully contained in a
+           ;; single contiguous org-ansi region, save the beginning
+           ;; position of the ANSI sequence that this modification
+           ;; will affect.
+           (push (if (setq beg (previous-single-property-change beg 'org-ansi))
+                     (1+ beg)
+                   (point-min))
+                 org-ansi--control-seq-positions)
+         ;; Otherwise the region being modified may have multiple
+         ;; org-ansi regions in its span.
+         (when beg-boundary
+           ;; Save start of sequence.
+           (push (if (setq beg (previous-single-property-change beg 'org-ansi))
+                     (1+ beg)
+                   (point-min))
+                 org-ansi--control-seq-positions))
+         (when (and end-boundary
+                    (< (1+ end) (point-max)))
+           ;; Save start of remainder of sequence outside region being
+           ;; modified.  It's a marker since we are mainly concerned
+           ;; with deletions which will move the start of the
+           ;; remainder after the change.
+           (let ((m (make-marker)))
+             (set-marker m (1+ end))
+             (push m org-ansi--control-seq-positions))))))))
+
+(defun org-ansi--after-control-seq-deletion (_beg _end _len)
+  (setq org-ansi--change-pending nil)
+  ;; Loop over the saved positions to check to see if the ANSI
+  ;; sequences they corresponded to before the modification are still
+  ;; valid sequences after the modification.
+  (when org-ansi--control-seq-positions
+    ;; When there are saved positions, either the beginning or end or
+    ;; both of the region being modified was fully contained in an
+    ;; org-ansi region.  If the beginning and end are fully contained
+    ;; in the same org-ansi region then a partial modification of the
+    ;; ANSI sequence is taking place and it needs to be seen that the
+    ;; sequence is still valid.  The saved position in this case is
+    ;; the start of the sequence.  If the beginning and end are fully
+    ;; contained in separate org-ansi regions then there will be a
+    ;; saved position for both of the regions.  The one that fully
+    ;; contains the beginning of the modified region will be the start
+    ;; of the sequence whereas the one that fully contains the end of
+    ;; the modified region will be the beginning of the remainder of
+    ;; the sequence that lies outside the modified region.
+    (let (pos)
+      (save-excursion
+        (while (setq pos (pop org-ansi--control-seq-positions))
+          (goto-char pos)
+          ;; Typically the position is the start of an ANSI sequence,
+          ;; but in the case that the end position of the region being
+          ;; modified was fully contained in an org-ansi region, the
+          ;; position will be the start of the remainder of the region
+          ;; that is unaffected by the modification.  In this case we
+          ;; check to see if the modification somehow joined an
+          ;; earlier org-ansi region to the one being processed.
+          (when (get-text-property (max (1- pos) (point-min)) 'org-ansi)
+            (goto-char (previous-single-property-change pos 'org-ansi nil (point-min)))
+            (unless (get-text-property (point) 'org-ansi)
+              (forward-char))
+            (setq pos (point)))
+          (unless (re-search-forward
+                   ansi-color-control-seq-regexp
+                   (next-single-property-change (point) 'org-ansi nil (point-max))
+                   'noerror)
+            (unless (get-text-property (point) 'org-ansi)
+              (backward-char))
+            (when (<= pos org-ansi--point-after-command (point))
+              ;; Disable adjustment of point when the sequence is no
+              ;; longer valid so that point does not move to the edge
+              ;; of the invisible region before making it visible
+              ;; again due to it not being a valid sequence.
+              (setq disable-point-adjustment t))
+            ;; No need to remove the org-ansi property since that is
+            ;; handled by font-lock.  We remove the modification hooks
+            ;; since the region is no longer a valid ANSI sequence.
+            (remove-text-properties
+             pos (point) '(modification-hooks t))))))))
+
+(defun org-ansi-new-context (pos)
+  "Return a new ANSI context.
+An ANSI context has the structure defined in
+`ansi-color-context-region'."
+  (list (list (make-bool-vector 8 nil)
+              nil nil)
+        (copy-marker pos)))
+
+(defun org-ansi-zero-width-space ()
+  "Return an invisible zero width space as a propertized string."
+  (propertize "​" 'invisible 'org-ansi 'org-ansi t
+              'modification-hooks
+              (list #'org-ansi--before-control-seq-deletion)))
+
+(defun org-ansi-is-zero-width-space (c)
+  "Return non-nil if C is a zero-width space."
+  (eq c ?​))
+
+(defun org-ansi-process-region (beg end &optional context)
+  (let ((adjust-point
+         (lambda (pos)
+           (letrec ((buf (current-buffer))
+                    (move
+                     (lambda (_window)
+                       (when (eq (current-buffer) buf)
+                         (goto-char pos)
+                         (remove-hook 'pre-redisplay-functions move)))))
+             (add-hook 'pre-redisplay-functions move)))))
+    ;; Handle the case when deleting backward into a zero width space.
+    ;; What we want to happen is that the deletion goes through the
+    ;; space and deletes the previous character as well so that the
+    ;; effect is as if the zero width space wasn't present before the
+    ;; deletion.
+    (when (and org-ansi--delete-through-space-p
+               (<= beg org-ansi--point-after-command end))
+      (save-excursion
+        (goto-char org-ansi--point-after-command)
+        (delete-char -1)
+        (insert "​")
+        (funcall adjust-point (1- (point)))))
+    ;; Apply the colors.
+    (or context (setq context (org-ansi-new-context beg)))
+    (move-marker (cadr context) beg)
+    (let ((ansi-color-context-region context)
+          (ansi-color-apply-face-function
+           (lambda (beg end face)
+             (when face
+               (font-lock-prepend-text-property beg end 'face face)
+               (add-text-properties beg end '(font-lock-multiline t))))))
+      (ansi-color-apply-on-region beg end t))
+    ;; Make adjustments to the regions containing the sequences.
+    (save-excursion
+      (goto-char beg)
+      (let ((mend (set-marker (make-marker) end)))
+        (while (re-search-forward ansi-color-control-seq-regexp mend t)
+          (let ((beg (match-beginning 0))
+                (end (point)))
+            (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' and convert it to a
+                ;; text property.
+                (delete-overlay ov)
+                (add-text-properties
+                 beg end (list 'invisible 'org-ansi 'org-ansi t
+                               'modification-hooks
+                               (list #'org-ansi--before-control-seq-deletion)))
+                ;; Handle the case when inserting a character such
+                ;; that it produces a valid sequence and the point
+                ;; after the insertion command is located in front of
+                ;; where the zero width space will be inserted.  In
+                ;; that case, point should be moved after the space to
+                ;; avoid the situation where inserting another
+                ;; character will cause a separation between the
+                ;; sequence and the space which will lead to a new
+                ;; space being inserted after the sequence to maintain
+                ;; the invariant that a valid sequence shall always
+                ;; have a space after it.
+                (when (and (eq (point) org-ansi--point-after-command)
+                           (< org-ansi--point-before-command
+                              org-ansi--point-after-command))
+                  (funcall adjust-point (1+ (point))))
+                ;; Account for zero width spaces already present in
+                ;; the buffer, e.g. from opening an Org file that has
+                ;; already had ANSI sequences processed and is then
+                ;; saved.
+                (when (org-ansi-is-zero-width-space (char-after))
+                  (delete-char 1))
+                (insert (org-ansi-zero-width-space))))))
+        (set-marker mend nil)))))
+
+(defun org-ansi-process-block (el &optional context)
+  (let ((beg (org-element-property :begin el))
+        (end (org-element-property :end el)))
+    (save-excursion
+      (goto-char beg)
+      (while (org-at-keyword-p)
+        (forward-line))
+      (setq beg (line-beginning-position 2)))
+    (save-excursion
+      (goto-char end)
+      (skip-chars-backward " \t\n")
+      (setq end (line-beginning-position)))
+    (org-ansi-process-region beg end context)))
+
+(defun org-ansi-process-paragraph (el &optional context)
+  ;; Compute the regions of the paragraph excluding inline
+  ;; source blocks.
+  (let ((pend (org-element-property :contents-end el)) beg end)
+    (push (point) beg)
+    (while (re-search-forward
+            "\\<src_\\([^ \t\n[{]+\\)[{[]" pend t)
+      (let ((el (org-element-context)))
+        (when (eq (org-element-type el) 'inline-src-block)
+          (push (org-element-property :begin el) end)
+          (goto-char (org-element-property :end el))
+          (push (point) beg))))
+    (push pend end)
+    (let ((ansi-context (or context (org-ansi-new-context (point)))))
+      (while beg
+        (org-ansi-process-region (pop beg) (pop end) ansi-context)))))
+
+(defun org-ansi-process-fixed-width (el &optional context)
+  (org-ansi-process-region
+   (org-element-property :begin el)
+   (save-excursion
+     (goto-char (org-element-property :end el))
+     (skip-chars-backward " \t\n")
+     (point))
+   context))
+
+(defun org-fontify-ansi-sequences-1 (limit &optional ansi-context)
+  (let ((skip-to-end-p
+         (lambda (el)
+           (or (null (org-element-property :contents-begin el))
+               (<= (org-element-property :contents-end el)
+                   (point)
+                   (org-element-property :end el))))))
+    (while (< (point) limit)
+      (let* ((el (org-element-at-point))
+             (type (org-element-type el)))
+        (pcase type
+          ;; Greater elements
+          ((or `headline `inlinetask `item
+               `center-block `quote-block `special-block
+               `drawer)
+           (if (funcall skip-to-end-p el)
+               (goto-char (org-element-property :end el))
+             (goto-char (org-element-property :contents-begin el))))
+          ((or `dynamic-block `footnote-definition `property-drawer)
+           (goto-char (org-element-property :end el)))
+          (`plain-list
+           (let ((end (org-element-property :end el)))
+             (goto-char (org-element-property :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-property :contents-begin item)))
+                 (when cbeg
+                   (goto-char cbeg)
+                   (org-fontify-ansi-sequences-1
+                    (org-element-property :contents-end item)
+                    ansi-context))
+                 (goto-char (org-element-property :end item))
+                 (skip-chars-forward " \t\n")))))
+          (`table
+           (if (funcall skip-to-end-p el)
+               (goto-char (org-element-property :end el))
+             (goto-char (org-element-property :contents-begin el))
+             ;; Move to within the table-row of a table to continue
+             ;; processing it.
+             (forward-char)))
+          ;; Lesser elements
+          (`table-row
+           (if (eq (org-element-property :type el) 'rule)
+               (goto-char (org-element-property :end el))
+             (let ((end-1 (1- (org-element-property :end el))))
+               (goto-char (org-element-property :contents-begin el))
+               (while (< (point) end-1)
+                 (let ((cell (org-element-context)))
+                   (org-ansi-process-region
+                    (org-element-property :contents-begin cell)
+                    (org-element-property :contents-end cell)
+                    ansi-context)
+                   (goto-char (org-element-property :end cell))))
+               (forward-char))))
+          ((or `example-block `export-block)
+           (org-ansi-process-block el ansi-context)
+           (goto-char (org-element-property :end el)))
+          (`fixed-width
+           (org-ansi-process-fixed-width el ansi-context)
+           (goto-char (org-element-property :end el)))
+          (`paragraph
+           (org-ansi-process-paragraph el ansi-context)
+           (goto-char (org-element-property :end el)))
+          (_
+           (goto-char (org-element-property :end el))))))))
+
+(defvar org-ansi-mode)
+
+(defun org-fontify-ansi-sequences (limit)
+  "Fontify ANSI sequences."
+  (when (and org-fontify-ansi-sequences org-ansi-mode)
+    (while (< (point) limit)
+      (if (re-search-forward ansi-color-control-seq-regexp limit t)
+          (let* ((ctx (progn
+                        (goto-char (match-beginning 0))
+                        (org-element-context)))
+                 (type (org-element-type ctx)))
+            (cond
+             ((memq type org-ansi-highlightable-objects)
+              ;; If the element-context is an object then there has not
+              ;; been a sequence at the element level so limit the
+              ;; effect of the sequence to the object.
+              (org-ansi-process-region
+               (point)
+               (or (org-element-property :contents-end ctx)
+                   (- (org-element-property :end ctx)
+                      (org-element-property :post-blank ctx)
+                      1))
+               (org-ansi-new-context (point)))
+              (goto-char (org-element-property :end ctx)))
+             ((memq type org-ansi-highlightable-elements)
+              (let ((el ctx))
+                (while (and el (not (org-element-property :results el)))
+                  (setq el (org-element-property :parent el)))
+                (if (and el (not (eq el ctx)))
+                    ;; If the element-context is a highlightable element
+                    ;; that has an ancestor with a RESULTS affiliated
+                    ;; keyword, process the full greater element with
+                    ;; that keyword.
+                    (if (not (memq (org-element-type el)
+                                   org-ansi-highlightable-elements))
+                        ;; Skip over the greater element if not
+                        ;; highlightable.
+                        (goto-char (org-element-property :end el))
+                      (goto-char (org-element-property :begin el))
+                      (add-text-properties
+                       (point) (org-element-property :end el)
+                       '(font-lock-multiline t))
+                      (org-fontify-ansi-sequences-1
+                       (or (org-element-property :contents-end el)
+                           (org-element-property :end el))
+                       (org-ansi-new-context (point)))
+                      (goto-char (org-element-property :end el)))
+                  ;; If the element-context is not a part of a greater
+                  ;; element with a RESULTS affiliated keyword, then it
+                  ;; is just a highlightable lesser element.  Process
+                  ;; the element.
+                  (pcase type
+                    ((or `headline `inlinetask)
+                     (org-ansi-process-region
+                      (org-element-property :begin ctx)
+                      (org-element-property :contents-begin ctx))
+                     (goto-char (or (org-element-property :contents-begin ctx)
+                                    (org-element-property :end ctx))))
+                    ((or `example-block `export-block)
+                     (org-ansi-process-block ctx)
+                     (goto-char (org-element-property :end ctx)))
+                    (`fixed-width
+                     (org-ansi-process-fixed-width ctx)
+                     (goto-char (org-element-property :end ctx)))
+                    (`paragraph
+                     (org-ansi-process-paragraph ctx)
+                     (goto-char (org-element-property :end ctx)))
+                    (_
+                     (goto-char (org-element-property :end ctx)))))))
+             (t
+              (pcase type
+                ((or `headline `inlinetask)
+                 (goto-char (or (org-element-property :contents-begin ctx)
+                                (org-element-property :end ctx))))
+                (_
+                 (goto-char (org-element-property :end ctx)))))))
+        (goto-char limit)))))
+
+(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)))
@@ -6026,6 +6465,7 @@ (defun org-set-font-lock-defaults ()
 	  ;; Blocks and meta lines
 	  '(org-fontify-meta-lines-and-blocks)
           '(org-fontify-inline-src-blocks)
+          '(org-fontify-ansi-sequences)
           ;; Citations.  When an activate processor is specified, if
           ;; specified, try loading it beforehand.
           (progn
@@ -6205,7 +6645,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 t))
     (org-fold-region beg end nil 'org-link)
     (org-fold-region beg end nil 'org-link-description)
     (org-fold-core-update-optimisation beg end)
@@ -15789,6 +16229,33 @@ (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
+        (if org-ansi-hide-sequences
+            (add-to-invisibility-spec 'org-ansi)
+          (remove-from-invisibility-spec 'org-ansi))
+        (add-hook 'after-change-functions #'org-ansi--after-control-seq-deletion nil t)
+        (add-hook 'pre-command-hook #'org-ansi--before-command nil t)
+        (add-hook 'post-command-hook #'org-ansi--after-command nil t))
+
+    (remove-from-invisibility-spec 'org-ansi)
+    (remove-hook 'pre-command-hook #'org-ansi--before-command t)
+    (remove-hook 'post-command-hook #'org-ansi--after-command t)
+    (remove-hook 'after-change-functions #'org-ansi--after-control-seq-deletion t))
+  (org-restart-font-lock))
+
+(add-hook 'org-mode-hook #'org-ansi-mode)
+
 \f
 ;;;; CDLaTeX minor mode
 
-- 
2.39.1


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


-- 
Nathaniel

  reply	other threads:[~2024-03-26 14:44 UTC|newest]

Thread overview: 23+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2023-04-05 12:03 [PATCH] ANSI color on example blocks and fixed width elements Nathaniel Nicandro
2023-04-05 13:43 ` Ihor Radchenko
2023-04-13 20:18   ` [PATCH] Highlight ANSI sequences in the whole buffer (was [PATCH] ANSI color on example blocks and fixed width elements) Nathaniel Nicandro
2023-04-14  8:49     ` Ihor Radchenko
2023-04-25 20:33       ` Nathaniel Nicandro
2023-05-10 10:27         ` Ihor Radchenko
2023-05-15  0:18           ` Nathaniel Nicandro
2023-05-18 19:45             ` Ihor Radchenko
2023-05-23  0:55               ` Nathaniel Nicandro
2023-08-08 11:02                 ` Ihor Radchenko
2023-11-08  9:56                   ` Ihor Radchenko
2023-11-08 15:35                   ` Nathaniel Nicandro
2023-11-10 10:25                     ` Ihor Radchenko
2023-11-17 21:18               ` Nathaniel Nicandro
2023-12-14 14:34                 ` Ihor Radchenko
2023-12-24 12:49                   ` Nathaniel Nicandro
2024-01-17  0:02                   ` Nathaniel Nicandro
2024-01-17 12:36                     ` Ihor Radchenko
2024-03-26 14:02                       ` Nathaniel Nicandro [this message]
2024-03-28  8:52                         ` Ihor Radchenko
2023-12-14 14:37                 ` Ihor Radchenko
2023-12-15 12:50                   ` Matt
2023-12-25  2:20                     ` Nathaniel Nicandro

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.orgmode.org/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=87plvhf5gf.fsf@gmail.com \
    --to=nathanielnicandro@gmail.com \
    --cc=emacs-orgmode@gnu.org \
    --cc=yantar92@posteo.net \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs/org-mode.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).