From: Nathaniel Nicandro <nathanielnicandro@gmail.com>
To: Ihor Radchenko <yantar92@posteo.net>
Cc: 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: Mon, 01 Jul 2024 13:39:17 -0500 [thread overview]
Message-ID: <87wmm5yn1m.fsf@gmail.com> (raw)
In-Reply-To: <87bk3kuj20.fsf@localhost> (Ihor Radchenko's message of "Sat, 29 Jun 2024 10:42:15 +0000")
[-- Attachment #1: Type: text/plain, Size: 6867 bytes --]
Ihor Radchenko <yantar92@posteo.net> writes:
> Ihor Radchenko <yantar92@posteo.net> writes:
>
>> Nathaniel Nicandro <nathanielnicandro@gmail.com> writes:
>>
>>> Feedback appreciated!
>>
>> Thanks for the update!
>> ...
>>> I've finally implemented a solution to what I've discussed previously,
>> ...
>
> It has been a while since the last update in this thread.
> Nathaniel, may I know if you are still working on this?
Hello Ihor,
Yes I'm still working on this. Attached is an updated patch with some
tests this time. It's still a work in progress. Below are responses to
your previous comments about my last update and some comments about this
current patch.
> This is very fragile.
> I believe that hooking into `org-fold-check-before-invisible-edit'
> would lead to simpler implementation.
Thank you for the feedback. I indeed was able to come up with a
more simpler solution by hooking into that function.
To integrate with `org-fold-check-before-invisible-edit' I had to
introduce two variables, `org-fold-visibility-detail' which is set to
the argument of `org-fold-show-set-visibility' when that function is
called and `org-ansi-fontify-begin' to determine the start of the
fontification region to see if it's close to the beginning of an
invisible sequence that should be turned visible.
Let me know if this is an OK approach.
I ran into an issue when trying to hook into
`org-fold-check-before-invisible-edit' in that when it revealed a
sequence at the end of a line, there would be an extra fontification
cycle that would occur after the reveal which would cause the sequence
to be re-hidden again. To counteract this I had to use
`buffer-chars-modified-tick' in the way I do. I couldn't figure out
why redisplay was causing that extra fontification cycle when there
were no modifications to the buffer.
> 1. Open the file and move to the end of the headline "Greater elements"
> 2. <backspace> <space>
> 3. Observe fontification extending past the title.
This is fixed. I think it was due to specifying the contents-end
position as the end of the region to highlight instead of the
line-end-position for headlines.
> I also edited it around in various places and I managed to trigger
> parser errors when the parser lost track of the modifications. This
> was presumably because your patch edited the buffer.
I no longer make edits to the buffer. The ANSI sequences are no
longer accompanied by the zero width spaces from the idea that I had
before.
With this patch, editing around sequences should be more stable and
non-surprising. Basically if a sequence is invisible around point and
you edit it, the sequence remains visible. It is only after the first
edit outside of a sequence that should make the sequence invisible.
Whenever a sequence is being edited, it should always be visible and
not turn invisible while in the middle of editing it, e.g. due to an
invalid sequence turning valid.
Some comments about the patch, as it currently stands, follow.
- I've introduced two text properties `org-ansi' and
`org-ansi-context'.
The first is placed on the regions that actually contain ANSI
sequences and holds information about the sequence that is useful to
keep around to detect when a sequence has been modified or deleted
between fontification cycles, as well as information about whether
or not a sequence should be revealed due to modifications or because
of visibility changes.
The second property holds the ANSI context, as defined by
`ansi-color-context-region', for regions that actually have been
highlighted or processed by `org-ansi-process-region'. Storing the
ANSI context is done so that on fontifying some new region, the
context that should be used can be determined simply by examining
the property on an appropriate region before the start of the
fontification. The property is also used to determine the extent of
a context or sequence, how far forward into the buffer its effects
last. The extent of a context is useful for extending the region
being fontified to include the extent of a sequence which has been
modified or deleted between fontification cycles.
Currently I only extend the fontification region to include the
extent when there has been a deletion or modification of a sequence
in the region up for fontification (`org-ansi-extend-region'). I've
not found a way to extend the fontification to a region including
the full extent of a newly inserted sequence, in such cases the code
as it stands now will fontify past the limit of fontification to the
end of the element.
- The `org-ansi-process-*' functions boil down to calls to
`org-ansi-process-region' which does the actual highlighting and
bookkeeping of text properties on the regions. Each of the process
functions are just aware of the varying types of element structure
in an Org document. They are supposed to process an element's
region from point to some limit or to the end of the element,
applying properties to the highlightable regions. If it's to the
end of the element than they are supposed to move point to that end,
otherwise move point to limit.
- `org-ansi-visit-elements' is supposed to be a function that
traverses the element structure up to some limit and applies the
processing functions to the lesser elements that are highlightable.
It is supposed to take care of moving point to the beginning of the
actual highlightable regions (if not already contained within one of
those regions), past any begin lines, list structure, and whatnot.
It then calls a function that processes the element and moves point
past the element processed to the next element or to some limit.
- The logic to use in `org-fontify-ansi-sequences' and how to maintain
the highlighting across edits in the buffer are my main focus at
this point. I think I've basically figured out the gist of the
logic, just need to clean it up. What I have not really considered
that much is how to maintain/remove the highlighting across edits,
e.g. when there is something like
<ANSI>line1
line2
line3
line4
all lines being highlighted by the sequence, and the paragraph is
split at line3 so it becomes
<ANSI>line1
line2
line3
line4
the highlighting is removed from line3 but not line4. And there are
other situations where editing the buffer does not result in the
maintenance of the highlighting across the affected elements. I
think I had it working in more situations when I had also placed the
`font-lock-multiline' property on the highlighted regions, but I tried
to simplify things by just using the `org-ansi-context' property
which may be able to handle these kinds of situations also somehow,
by detecting these kinds of edits and extending the region to
account for them.
[-- Attachment #2: patch --]
[-- Type: text/x-patch, Size: 52528 bytes --]
From fcdd77870b65639e830475d300e05b35e70a7430 Mon Sep 17 00:00:00 2001
From: Nathaniel Nicandro <nathanielnicandro@gmail.com>
Date: Thu, 11 Apr 2024 23:09:21 -0500
Subject: [PATCH] Highlight ANSI escape sequences
* etc/ORG-NEWS: Describe the new feature.
* lisp/org-fold.el (org-fold-visibility-detail): New variable.
(org-fold-show-set-visibility): Let-bind the new variable to the
argument of this function during its evaluation.
(org-fold-check-before-invisible-edit): Consider invisible ANSI sequences.
* 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-fontify-begin): New variables.
(org-ansi-new-context, org-ansi-copy-context, org-ansi-null-context-p)
(org-ansi-clear-context, org-ansi-greater-element-context)
(org-ansi-highlightable-element-p, org-ansi-context-contained-p)
(org-ansi-extent-of-context, org-ansi-extend-region)
(org-ansi-previous-context, org-ansi-point-context)
(org-ansi-process-region, org-ansi-process-object)
(org-ansi-process-lines, org-ansi-process-lines-consider-objects)
(org-ansi-process-block, org-ansi-process-paragraph)
(org-ansi-process-fixed-width, org-ansi-process-table-row)
(org-ansi-process-at-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 from
the region.
(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-fold.el | 111 +++----
lisp/org.el | 613 ++++++++++++++++++++++++++++++++++++++-
testing/lisp/test-org.el | 313 ++++++++++++++++++++
4 files changed, 1000 insertions(+), 54 deletions(-)
diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS
index b9f5166..d158775 100644
--- a/etc/ORG-NEWS
+++ b/etc/ORG-NEWS
@@ -31,6 +31,23 @@ batch scripts.
# 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=.
+
*** =ol.el=: New =shortdoc= link type
You can now create links to =shortdoc= documentation groups for Emacs
diff --git a/lisp/org-fold.el b/lisp/org-fold.el
index 1b62168..da0ced9 100644
--- a/lisp/org-fold.el
+++ b/lisp/org-fold.el
@@ -643,6 +643,8 @@ (defun org-fold-show-context (&optional key)
((cdr (assq key org-fold-show-context-detail)))
(t (cdr (assq 'default org-fold-show-context-detail))))))
+(defvar org-fold-visibility-detail nil
+ "Detail setting when `org-fold-show-set-visibility' is called.")
(defvar org-hide-emphasis-markers); Defined in org.el
(defvar org-pretty-entities); Defined in org.el
@@ -651,55 +653,56 @@ (defun org-fold-show-set-visibility (detail)
DETAIL is either nil, `minimal', `local', `ancestors',
`ancestors-full', `lineage', `tree', `canonical' or t. See
`org-show-context-detail' for more information."
- ;; Show current heading and possibly its entry, following headline
- ;; or all children.
- (if (and (org-at-heading-p) (not (eq detail 'local)))
- (org-fold-heading nil)
- (org-fold-show-entry)
- ;; If point is hidden make sure to expose it.
- (when (org-invisible-p)
- ;; FIXME: No clue why, but otherwise the following might not work.
- (redisplay)
- ;; Reveal emphasis markers.
- (when (eq detail 'local)
- (let (org-hide-emphasis-markers
- org-link-descriptive
- org-pretty-entities
- (org-hide-macro-markers nil)
- (region (or (org-find-text-property-region (point) 'org-emphasis)
- (org-find-text-property-region (point) 'org-macro)
- (org-find-text-property-region (point) 'invisible))))
- ;; Silence byte-compiler.
- (ignore org-hide-macro-markers)
- (when region
- (org-with-point-at (car region)
- (forward-line 0)
- (let (font-lock-extend-region-functions)
- (font-lock-fontify-region (max (point-min) (1- (car region))) (cdr region)))))))
- (let (region)
- (dolist (spec (org-fold-core-folding-spec-list))
- (setq region (org-fold-get-region-at-point spec))
- (when region
- (org-fold-region (car region) (cdr region) nil spec)))))
- (unless (org-before-first-heading-p)
- (org-with-limited-levels
- (cl-case detail
- ((tree canonical t) (org-fold-show-children))
- ((nil minimal ancestors ancestors-full))
- (t (save-excursion
- (outline-next-heading)
- (org-fold-heading nil)))))))
- ;; Show whole subtree.
- (when (eq detail 'ancestors-full) (org-fold-show-subtree))
- ;; Show all siblings.
- (when (eq detail 'lineage) (org-fold-show-siblings))
- ;; Show ancestors, possibly with their children.
- (when (memq detail '(ancestors ancestors-full lineage tree canonical t))
- (save-excursion
- (while (org-up-heading-safe)
- (org-fold-heading nil)
- (when (memq detail '(canonical t)) (org-fold-show-entry))
- (when (memq detail '(tree canonical t)) (org-fold-show-children))))))
+ (let ((org-fold-visibility-detail detail))
+ ;; Show current heading and possibly its entry, following headline
+ ;; or all children.
+ (if (and (org-at-heading-p) (not (eq detail 'local)))
+ (org-fold-heading nil)
+ (org-fold-show-entry)
+ ;; If point is hidden make sure to expose it.
+ (when (org-invisible-p)
+ ;; FIXME: No clue why, but otherwise the following might not work.
+ (redisplay)
+ ;; Reveal emphasis markers.
+ (when (eq detail 'local)
+ (let (org-hide-emphasis-markers
+ org-link-descriptive
+ org-pretty-entities
+ (org-hide-macro-markers nil)
+ (region (or (org-find-text-property-region (point) 'org-emphasis)
+ (org-find-text-property-region (point) 'org-macro)
+ (org-find-text-property-region (point) 'invisible))))
+ ;; Silence byte-compiler.
+ (ignore org-hide-macro-markers)
+ (when region
+ (org-with-point-at (car region)
+ (forward-line 0)
+ (let (font-lock-extend-region-functions)
+ (font-lock-fontify-region (max (point-min) (1- (car region))) (cdr region)))))))
+ (let (region)
+ (dolist (spec (org-fold-core-folding-spec-list))
+ (setq region (org-fold-get-region-at-point spec))
+ (when region
+ (org-fold-region (car region) (cdr region) nil spec)))))
+ (unless (org-before-first-heading-p)
+ (org-with-limited-levels
+ (cl-case detail
+ ((tree canonical t) (org-fold-show-children))
+ ((nil minimal ancestors ancestors-full))
+ (t (save-excursion
+ (outline-next-heading)
+ (org-fold-heading nil)))))))
+ ;; Show whole subtree.
+ (when (eq detail 'ancestors-full) (org-fold-show-subtree))
+ ;; Show all siblings.
+ (when (eq detail 'lineage) (org-fold-show-siblings))
+ ;; Show ancestors, possibly with their children.
+ (when (memq detail '(ancestors ancestors-full lineage tree canonical t))
+ (save-excursion
+ (while (org-up-heading-safe)
+ (org-fold-heading nil)
+ (when (memq detail '(canonical t)) (org-fold-show-entry))
+ (when (memq detail '(tree canonical t)) (org-fold-show-children)))))))
(defun org-fold-reveal (&optional siblings)
"Show current entry, hierarchy above it, and the following headline.
@@ -888,12 +891,14 @@ (defun org-fold-check-before-invisible-edit (kind)
(or (org-invisible-p)
(org-invisible-p (max (point-min) (1- (point))))))
;; OK, we need to take a closer look. Only consider invisibility
- ;; caused by folding of headlines, drawers, and blocks. Edits
- ;; inside links will be handled by font-lock.
- (let* ((invisible-at-point (org-fold-folded-p (point) '(headline drawer block)))
+ ;; caused by folding of headlines, drawers, blocks, or ANSI
+ ;; sequences. Edits inside links will be handled by font-lock.
+ (let* ((invisible-at-point (or (org-fold-folded-p (point) '(headline drawer block))
+ (eq (get-text-property (point) 'invisible) 'org-ansi)))
(invisible-before-point
(and (not (bobp))
- (org-fold-folded-p (1- (point)) '(headline drawer block))))
+ (or (org-fold-folded-p (1- (point)) '(headline drawer block))
+ (eq (get-text-property (1- (point)) 'invisible) 'org-ansi))))
(border-and-ok-direction
(or
;; Check if we are acting predictably before invisible
diff --git a/lisp/org.el b/lisp/org.el
index f4abfa6..e2c9696 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,585 @@ (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 t
+ "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 ANSI context has the same structure as defined in
+`ansi-color-context-region'.")
+(make-variable-buffer-local 'org-ansi-context)
+
+(defvar org-ansi-fontify-begin nil
+ "Beginning position for this fontification cycle.")
+
+(defun org-ansi-new-context (&optional pos)
+ "Return a new ANSI context for POS.
+If POS is nil, it defaults to `point'.
+See `org-ansi-context'."
+ (list (list (make-bool-vector 8 nil)
+ nil nil)
+ (copy-marker (or pos (point)))))
+
+(defun org-ansi-copy-context (context)
+ (if (org-ansi-null-context-p context)
+ (list (list (make-bool-vector 8 nil)
+ nil nil)
+ (make-marker))
+ (let ((basic-faces (make-bool-vector 8 nil)))
+ (bool-vector-union basic-faces (caar context) basic-faces)
+ (list (list basic-faces
+ (cadar context)
+ (caddar context))
+ (make-marker)))))
+
+(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'."
+ (let ((vec (car context)))
+ (and (zerop (bool-vector-count-population (car vec)))
+ (null (cadr vec))
+ (null (caddr vec)))))
+
+(defun org-ansi-clear-context (context)
+ "Destructively clear CONTEXT.
+See `org-ansi-context'."
+ (pcase context
+ (`((,basic-faces . ,colors) . ,_)
+ ;; From `ansi-color--update-face-vec'
+ (bool-vector-intersection basic-faces #&8"\0" basic-faces)
+ (setcar colors nil)
+ (setcar (cdr colors) nil))))
+
+(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)
+ (or (org-ansi-greater-element-context el)
+ (memq (org-element-type el) org-ansi-highlightable-elements)))
+
+(defun org-ansi-context-contained-p (a b)
+ "Return non-nil if ANSI context A is contained in B.
+A is contained in B if some of the effect of A is also in B's
+effect."
+ (pcase-let ((`(,bf-a ,fg-a ,bg-a) (car a))
+ (`(,bf-b ,fg-b ,bg-b) (car b)))
+ (or (not (zerop (bool-vector-count-population
+ (bool-vector-intersection bf-a bf-b))))
+ (and fg-a (equal fg-a fg-b))
+ (and bg-a (equal bg-a bg-b)))))
+
+;; TODO Consider contexts in objects
+(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.
+
+Determining the influence of the context is non-trivial as a
+context's influence can span multiple elements and be contained
+in other contexts."
+ (let ((context (get-text-property (point) 'org-ansi-context)))
+ (when context
+ (let* ((el (org-element-at-point))
+ (pos (next-single-property-change (point) 'org-ansi-context))
+ (end (if-let ((parent (org-ansi-greater-element-context el)))
+ (org-element-contents-end parent)
+ (or (org-element-contents-end el)
+ (org-element-end el)))))
+ (while (and (< pos end)
+ (let ((other (get-text-property pos 'org-ansi-context)))
+ (or (null 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))))
+
+(defvar font-lock-beg)
+(defvar font-lock-end)
+
+(defun org-ansi-extend-region ()
+ (let ((old-end font-lock-end)
+ (end font-lock-end))
+ (save-excursion
+ (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)))
+ (car 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)
+ (setq font-lock-end end)
+ t)))
+
+(defun org-ansi-previous-context (pos limit)
+ (let (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)))
+ context))
+
+(defun org-ansi-point-context ()
+ "Return the ANSI context associated with `point'.
+If no context is associated with `point' return nil."
+ (when-let ((context
+ (let ((el (org-element-at-point)))
+ (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-copy-context context)))
+
+(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."
+ ;; Apply the colors.
+ (move-marker (cadr org-ansi-context) beg)
+ (let ((ansi-color-context-region org-ansi-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 (list 'org-ansi-context
+ ;; TODO: Only copy when the context has
+ ;; actually been modified to avoid so many
+ ;; copies, e.g. during processing of lines.
+ (org-ansi-copy-context org-ansi-context))))))
+ (ansi-color-apply-on-region beg end t))
+ ;; Make adjustments to the regions containing the sequences.
+ (goto-char beg)
+ (let ((highlight-beg beg))
+ (while (re-search-forward ansi-color-control-seq-regexp end 'noerror)
+ (let ((beg (match-beginning 0))
+ (end (point))
+ (seq (intern (buffer-substring-no-properties beg end))))
+ (remove-text-properties highlight-beg beg '(org-ansi t))
+ (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-copy-context org-ansi-context)))
+ (setq highlight-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)
+ (pcase-let*
+ (((and state (or (and (pred null) (let new-seq t))
+ `(,_ . ,(or
+ ;; Previously invisible
+ (and (pred numberp) len)
+ ;; Previously revealed
+ (or `(,len) `(,len ,tick))))))
+ (get-text-property beg 'org-ansi))
+ (reveal-due-to-visibility
+ (and (eq org-fold-visibility-detail 'local)
+ (<= (1- beg) org-ansi-fontify-begin end)))
+ (reveal-due-to-modification
+ (unless new-seq
+ (or (text-property-not-all beg end 'org-ansi state)
+ (not (eq (- end beg) len)))))
+ (invisible
+ (unless (or reveal-due-to-visibility
+ reveal-due-to-modification)
+ 'org-ansi)))
+ (let ((new-state (cons seq (- end beg))))
+ ;; Previously revealed due to local visibility
+ ;; changes.
+ (when (and tick invisible
+ (eq tick (buffer-chars-modified-tick)))
+ (setq invisible nil
+ reveal-due-to-visibility t))
+ (unless invisible
+ (setcdr new-state
+ (cons (cdr new-state)
+ (when reveal-due-to-visibility
+ (list (buffer-chars-modified-tick))))))
+ (add-text-properties
+ beg end (list 'invisible invisible
+ 'rear-nonsticky '(org-ansi)
+ 'org-ansi new-state))))))))
+ (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-block (el &optional limit)
+ "Highlight ANSI sequences in EL, a block element."
+ (let ((beg (point))
+ (end (save-excursion
+ (goto-char (org-element-end el))
+ (skip-chars-backward " \t\r\n")
+ (line-beginning-position))))
+ (if limit (setq limit (min end limit))
+ (setq limit end))
+ ;; TODO Have this be process-lines to ignore whitespace at the
+ ;; beginning of lines.
+ (org-ansi-process-region beg limit)
+ (if (eq limit end)
+ (goto-char (org-element-end el))
+ (goto-char limit))))
+
+(defun org-ansi-process-paragraph (el &optional limit)
+ "Highlight ANSI sequences in a paragraph element, EL.
+Exclude inline source blocks or babel calls from being
+highlighted."
+ (let ((pend (1- (org-element-contents-end el))) beg end)
+ (if limit (setq limit (min pend limit))
+ (setq 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))))
+
+(defun org-ansi-process-fixed-width (el &optional limit)
+ "Highlight ANSI sequences in a fixed-width element, EL."
+ (if limit
+ (setq limit (min (org-element-end el) limit))
+ (setq 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")))
+
+;; 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.
+(defun org-ansi-process-table-row (el &optional _limit)
+ "Highlight ANSI sequences in a table-row element, EL"
+ (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))))
+
+(defun org-ansi-process-at-element (el &optional limit)
+ (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
+ (org-ansi-process-table-row el limit))
+ ;; `export-block `src-block
+ (`example-block
+ (org-ansi-process-block el limit))
+ (`fixed-width
+ (org-ansi-process-fixed-width el limit))
+ (`paragraph
+ (org-ansi-process-paragraph el 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.
+
+TODO Is this an actual guarantee?
+After a call to this function, it is guaranteed that `point' will
+either be at LIMIT or at the beginning of the first element past
+LIMIT."
+ (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))
+ ;; TODO Is there a possibility that visiting an item will
+ ;; get stuck or process the same item indefinitely if the
+ ;; limit is the end of the contents?
+ (org-ansi-visit-elements
+ (min limit (org-element-contents-end el))
+ visitor)))
+ (`property-drawer
+ (goto-char (org-element-end el)))
+ (`plain-list
+ (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 within the highlightable region when `point'
+ ;; is before it.
+ ;;
+ ;; TODO Move to the first non-whitespace character since
+ ;; the process functions only apply the highlighting to
+ ;; non-whitespace regions.
+ (pcase type
+ (`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)))))
+ (`example-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
+ (funcall visitor el limit))))
+ (_
+ (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)
+ (setq org-ansi-fontify-begin (point))
+ (or org-ansi-context
+ (setq org-ansi-context (org-ansi-new-context)))
+ (let* ((did-process nil)
+ (maybe-process
+ (lambda (el limit)
+ (if-let ((context (org-ansi-point-context)))
+ (setq org-ansi-context context)
+ ;; FIXME There are extra clears that are happening
+ ;; when they don't need to happen.
+ (org-ansi-clear-context org-ansi-context))
+ (let* ((el (or (org-ansi-greater-element-context el) el))
+ ;; Process only up to the end of the element at
+ ;; point, the end of the greater element context,
+ ;; or to limit whichever comes first (typically limit).
+ (limit (min (or (pcase (org-element-type el)
+ ((or `headline `inlinetask)
+ (org-element-contents-begin el)))
+ (org-element-end el))
+ limit)))
+ (org-ansi-visit-elements limit
+ (lambda (el limit)
+ (unless (org-ansi-greater-element-context el)
+ (org-ansi-clear-context org-ansi-context))
+ (setq did-process t)
+ (org-ansi-process-at-element el limit)))))))
+ (skip-chars-forward " \n\r\t")
+ (while (< (point) limit)
+ ;; TODO Would I have to remove the context property when
+ ;; turning on/off org-ansi-mode?
+ (cond
+ ((org-ansi-point-context)
+ ;; A context exists before point in this element so it
+ ;; must have been highlightable, process the element
+ ;; starting with the previous context.
+ (funcall maybe-process (org-element-at-point) limit))
+ (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 maybe-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.
+ (when (and did-process
+ (not (org-ansi-null-context-p org-ansi-context)))
+ (let* ((el (org-element-at-point))
+ (end (org-element-end
+ (or (org-ansi-greater-element-context el) el))))
+ (unless (catch 'matching-contexts
+ (org-ansi-visit-elements end
+ (lambda (&rest _)
+ (let ((context (get-text-property
+ (point) 'org-ansi-context)))
+ (throw 'matching-contexts
+ (equal (car org-ansi-context)
+ (car context))))))
+ t)
+ (org-ansi-visit-elements end
+ (lambda (el limit)
+ (org-ansi-process-at-element el limit)
+ (unless (org-ansi-greater-element-context 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 +6557,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 +6746,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)))
@@ -15930,6 +16517,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 f21e52b..dfb5916 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
@@ -2241,6 +2243,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 where 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"
+ "line 2\n"
+ "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 that the context is being picked up by the elements.
+ (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")))))))
+
+(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)
+ (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"))
+ ;; Check integration with
+ ;; `org-fold-check-before-invisible-edit'
+ (org-test-with-temp-text
+ (concat (fg-start) "<point>line1" (clear) "\n"
+ "line2\n")
+ (org-ansi-mode)
+ (font-lock-ensure)
+ (should (invisible-p (1- (point))))
+ (should-not (invisible-p (point)))
+ (let ((this-command 'org-delete-backward-char))
+ (should-error (call-interactively #'org-delete-backward-char)))
+ (should-not (invisible-p (1- (point)))))
+ ;; Sequence revealed upon modification and hidden after first
+ ;; edit outside of sequence.
+ (org-test-with-temp-text
+ (concat (fg-start) "<point>line1" (clear) "\n"
+ "line2\n")
+ (org-ansi-mode)
+ (font-lock-ensure)
+ (should (invisible-p (- (point) 2)))
+ (backward-delete-char 1)
+ (font-lock-ensure)
+ (should-not (invisible-p (- (point) 1)))
+ ;; Insert a new end byte.
+ (insert "t")
+ (font-lock-ensure)
+ (should-not (invisible-p (- (point) 2)))
+ (insert "x")
+ (font-lock-ensure)
+ (should (invisible-p (- (point) 2))))
+ ;; fixed-width regions and font-lock-multiline
+ (org-test-with-temp-text
+ (concat ": " (fg-start) "line1\n: line2\n<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 first looks at the context property of
+ ;; the end of the previous line in `org-ansi-point-context'.
+ (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"))))))
+
\f
;;; Fixed-Width Areas
--
2.41.0
[-- Attachment #3: Type: text/plain, Size: 15 bytes --]
--
Nathaniel
next prev parent reply other threads:[~2024-07-01 18:40 UTC|newest]
Thread overview: 29+ 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
2024-03-28 8:52 ` Ihor Radchenko
2024-06-29 10:42 ` Ihor Radchenko
2024-07-01 18:39 ` Nathaniel Nicandro [this message]
2024-07-06 13:28 ` Ihor Radchenko
2024-07-16 20:53 ` Nathaniel Nicandro
2024-07-17 22:50 ` Nathaniel Nicandro
2024-07-20 17:57 ` 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=87wmm5yn1m.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).