* [PATCH] ANSI color on example blocks and fixed width elements @ 2023-04-05 12:03 Nathaniel Nicandro 2023-04-05 13:43 ` Ihor Radchenko 0 siblings, 1 reply; 33+ messages in thread From: Nathaniel Nicandro @ 2023-04-05 12:03 UTC (permalink / raw) To: emacs-orgmode [-- Attachment #1: Type: text/plain, Size: 719 bytes --] Hello, Attached is the patch. Without this patch, ANSI escape sequences generated by the output of a source block will be left in the buffer without any fontification. With this patch, the escaped text is nicely colored and escape sequences hidden using overlays. It works for Emacs versions which have the `PRESERVE-SEQUENCES` argument to the `ansi-color-apply-on-region` function. It's a bit slow due to the use of overlays. My implementation of this feature in Emacs-Jupyter supports older versions of Emacs without that argument, it relies on a custom version of that function though and uses text properties instead of overlays. Let me know what else could be done on my end to get this patch in. Thanks. [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: ANSI color patch --] [-- Type: text/x-patch, Size: 1571 bytes --] diff --git a/lisp/org.el b/lisp/org.el index 4d12084..24617ad 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) @@ -5326,6 +5327,10 @@ (defsubst org-activate-links (limit) (defun org-activate-code (limit) (when (re-search-forward "^[ \t]*\\(:\\(?: .*\\|$\\)\n?\\)" limit t) (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) + (let ((ansi-color-apply-face-function + (lambda (beg end face) + (font-lock-prepend-text-property beg end 'face face)))) + (ansi-color-apply-on-region (match-beginning 0) (match-end 0) t)) (remove-text-properties (match-beginning 0) (match-end 0) '(display t invisible t intangible t)) t)) @@ -5421,7 +5426,12 @@ (defun org-fontify-meta-lines-and-blocks-1 (limit) (let ((face-name (intern (format "org-block-%s" lang)))) (append (and (facep face-name) (list face-name)) - '(org-block))))))) + '(org-block)))))) + (let ((ansi-color-apply-face-function + (lambda (beg end face) + (font-lock-prepend-text-property beg end 'face face)))) + (ansi-color-apply-on-region + bol-after-beginline beg-of-endline t))) ((not org-fontify-quote-and-verse-blocks)) ((string= block-type "quote") (add-face-text-property [-- Attachment #3: Type: text/plain, Size: 16 bytes --] -- Nathaniel ^ permalink raw reply related [flat|nested] 33+ messages in thread
* Re: [PATCH] ANSI color on example blocks and fixed width elements 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 0 siblings, 1 reply; 33+ messages in thread From: Ihor Radchenko @ 2023-04-05 13:43 UTC (permalink / raw) To: Nathaniel Nicandro; +Cc: emacs-orgmode Nathaniel Nicandro <nathanielnicandro@gmail.com> writes: > Attached is the patch. Without this patch, ANSI escape sequences > generated by the output of a source block will be left in the buffer > without any fontification. With this patch, the escaped text is nicely > colored and escape sequences hidden using overlays. > > It works for Emacs versions which have the `PRESERVE-SEQUENCES` argument > to the `ansi-color-apply-on-region` function. It's a bit slow due to > the use of overlays. My implementation of this feature in Emacs-Jupyter > supports older versions of Emacs without that argument, it relies on a > custom version of that function though and uses text properties instead > of overlays. > > Let me know what else could be done on my end to get this patch in. > Thanks. Thanks for the patch! This is an interesting idea, but I am not sure if we want to use this colouring by default. At least, it should be a minor mode. Probably enabled by default. Because not every possible user may want to have the escape sequences hidden away. Further, your patch only allows fontifying ANSI sequences in fixed-width elements, example blocks, export blocks, and src blocks without known major mode that does the fontification. I doubt that fontifying ANSI sequences in this specific subset of elements always makes sense - example blocks are not always used as src block output; bash code blocks may purposely contain escape sequences, but your patch will not handle them; inline src block output is not covered at all. Ideally, fontifying ANSI sequences should be fully controlled by users: 1. We may not want to touch src blocks by default, when `org-src-fontify-natively' is set to t. Only, maybe, provide an option. Or you may better publish a minor mode that does this for shell scripts. 2. We may allow all the ANSI sequences to be fontified in the whole buffer. 3. We may limit ANSI sequence fontification to results and only results. Or just certain types of results. The easiest will be implementing fontification in the whole buffer, early during fontification (and early in org-font-lock-keywords; see org-font-lock-set-keywords-hook). -- Ihor Radchenko // yantar92, Org mode contributor, Learn more about Org mode at <https://orgmode.org/>. Support Org development at <https://liberapay.com/org-mode>, or support my work at <https://liberapay.com/yantar92> ^ permalink raw reply [flat|nested] 33+ messages in thread
* [PATCH] Highlight ANSI sequences in the whole buffer (was [PATCH] ANSI color on example blocks and fixed width elements) 2023-04-05 13:43 ` Ihor Radchenko @ 2023-04-13 20:18 ` Nathaniel Nicandro 2023-04-14 8:49 ` Ihor Radchenko 0 siblings, 1 reply; 33+ messages in thread From: Nathaniel Nicandro @ 2023-04-13 20:18 UTC (permalink / raw) To: Ihor Radchenko; +Cc: Nathaniel Nicandro, emacs-orgmode [-- Attachment #1: Type: text/plain, Size: 2861 bytes --] Ihor Radchenko <yantar92@posteo.net> writes: > Nathaniel Nicandro <nathanielnicandro@gmail.com> writes: > >> Attached is the patch. Without this patch, ANSI escape sequences >> generated by the output of a source block will be left in the buffer >> without any fontification. With this patch, the escaped text is nicely >> colored and escape sequences hidden using overlays. >> >> It works for Emacs versions which have the `PRESERVE-SEQUENCES` argument >> to the `ansi-color-apply-on-region` function. It's a bit slow due to >> the use of overlays. My implementation of this feature in Emacs-Jupyter >> supports older versions of Emacs without that argument, it relies on a >> custom version of that function though and uses text properties instead >> of overlays. >> >> Let me know what else could be done on my end to get this patch in. >> Thanks. > > Thanks for the patch! > > This is an interesting idea, but I am not sure if we want to use this > colouring by default. At least, it should be a minor mode. Probably > enabled by default. Because not every possible user may want to have the > escape sequences hidden away. > > Further, your patch only allows fontifying ANSI sequences in fixed-width > elements, example blocks, export blocks, and src blocks without known > major mode that does the fontification. I doubt that fontifying ANSI > sequences in this specific subset of elements always makes sense - > example blocks are not always used as src block output; bash code blocks > may purposely contain escape sequences, but your patch will not handle > them; inline src block output is not covered at all. > > Ideally, fontifying ANSI sequences should be fully controlled by users: > 1. We may not want to touch src blocks by default, when > `org-src-fontify-natively' is set to t. Only, maybe, provide an > option. Or you may better publish a minor mode that does this for > shell scripts. > 2. We may allow all the ANSI sequences to be fontified in the whole > buffer. I've updated my patch to be a combination of (1) and (2), see the attached patch. Essentially every sequence is fontified except those in source blocks and a minor mode has been created to allow users to disable or enable fontification whenever they want. I've also attached an example Org file with some ANSI sequences in it for testing purposes that you can try out. One issue that remains is how to handle sequences within inline source blocks. Those don't have a src-block property so any sequences within an inline source block are currently fontified. > 3. We may limit ANSI sequence fontification to results and only results. > Or just certain types of results. > > The easiest will be implementing fontification in the whole buffer, > early during fontification (and early in org-font-lock-keywords; see > org-font-lock-set-keywords-hook). [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: test-ansi.org --] [-- Type: text/x-org, Size: 608 bytes --] * This is a ^[[42mtest^[[0m Of ^[[31mANSI^[[0m ^[[33mcolor^[[0m sequences #+begin_src python for x in y: print(x + "this is a ^[[43mtest^[[0m") #+end_src : this ^[[42mis a^[[0m td =testing= In paragraph a ~color ^[[44msequ^[[0mence~ is ^[[41mhere^[[0m. ^[[43mThis is a sequence that covers a block #+begin_example should be colored #+end_example there should be an end here^[[0m there is the end. begin ^[[43m sequence without end #+begin_src python 1 + 1 #+end_src Inline source blocks will have sequences highlighted because we only look for a src-block text property. src_python{return "t^[[43mest^[[0ming"} [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #3: 0001-Highlight-ANSI-escape-sequences.patch --] [-- Type: text/x-patch, Size: 7561 bytes --] From c9b505d022410a481210928ecc4cce1f199ec53b Mon Sep 17 00:00:00 2001 From: Nathaniel Nicandro <nathanielnicandro@gmail.com> Date: Thu, 13 Apr 2023 15:06:35 -0500 Subject: [PATCH] Highlight ANSI escape sequences * etc/ORG-NEWS: Describe the new feature. * org.el (org-fontify-ansi-sequences): New customization variable and function which does the work of fontifying the sequences. (org-set-font-lock-defaults): Add the `org-fontify-ansi-sequences` function to the font-lock keywords. (org-ansi-mode): New minor mode to enable/disable highlighting of the sequences. Enabled in Org buffers by default. --- etc/ORG-NEWS | 12 ++++++ lisp/org.el | 112 +++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 124 insertions(+) diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS index b7c88fd..8690540 100644 --- a/etc/ORG-NEWS +++ b/etc/ORG-NEWS @@ -169,6 +169,18 @@ official [[https://clojure.org/guides/deps_and_cli][Clojure CLI tools]]. The command can be customized with ~ob-clojure-cli-command~. ** 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 revert-buffer 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. + *** Add support for ~logind~ idle time in ~org-user-idle-seconds~ When Emacs is built with =dbus= support and diff --git a/lisp/org.el b/lisp/org.el index 26d2a86..62a5134 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) @@ -3582,6 +3583,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 @@ -5543,6 +5550,72 @@ (defun org-fontify-extend-region (beg end _old-len) (cons beg (or (funcall extend "end" "]" 1) end))) (t (cons beg end)))))) +(defvar org-ansi-mode) + +(defun org-fontify-ansi-sequences (limit) + "Fontify ANSI sequences." + (when (and org-fontify-ansi-sequences org-ansi-mode) + (let (end) + (while (/= (point) limit) + (cond + ((get-text-property (point) 'src-block) + ;; If point is on a src block, skip over it + (goto-char (next-single-property-change (point) 'src-block nil limit)) + (save-restriction + ;; Prevent moving past limit + (narrow-to-region (point) limit) + (forward-line))) + (t + (setq end (next-single-property-change (point) 'src-block nil limit)) + (let ((src-block-beg (and (get-text-property end 'src-block) end))) + (when src-block-beg + ;; Set the end of the region to be fontified to be the + ;; beginning of the src block when end is not limit + (save-excursion + (goto-char src-block-beg) + (forward-line -1) + (org-skip-whitespace) + (setq end (point)))) + (ansi-color-apply-on-region (point) end t) + ;; Reset the context before every fontification cycle. This + ;; avoids issues where `ansi-color-apply-on-region' attempts to + ;; use an old starting point that may be from a different part + ;; of the buffer, leading to "wrong side of point" errors. + (setq ansi-color-context-region nil) + (goto-char (or src-block-beg end))))))))) + +(defvar org-ansi-colors + '(black red green yellow blue purple cyan white)) + +(defun org-ansi-highlight (beg end seq) + (save-excursion + (goto-char end) + (insert "\e") + (insert "[0m") + (goto-char beg) + (insert "\e") + (insert (format "[%sm" seq)))) + +(defun org-ansi-highlight-foreground (beg end color) + "Highlight the foreground between BEG and END with COLOR." + (interactive + (let ((bounds (car (region-bounds)))) + (list (car bounds) (cdr bounds) + (completing-read "Color: " org-ansi-colors nil t)))) + (let ((n (- (length org-ansi-colors) + (length (memq color org-ansi-colors))))) + (org-ansi-highlight beg end (+ 30 n)))) + +(defun org-ansi-highlight-background (beg end color) + "Highlight the background between BEG and END with COLOR." + (interactive + (let ((bounds (car (region-bounds)))) + (list (car bounds) (cdr bounds) + (completing-read "Color: " org-ansi-colors nil t)))) + (let ((n (- (length org-ansi-colors) + (length (memq color org-ansi-colors))))) + (org-ansi-highlight beg end (+ 40 n)))) + (defun org-activate-footnote-links (limit) "Add text properties for footnotes." (let ((fn (org-footnote-next-reference-or-definition limit))) @@ -5861,6 +5934,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 @@ -15455,6 +15529,44 @@ (defun org-agenda-prepare-buffers (files) (when org-agenda-file-menu-enabled (org-install-agenda-files-menu)))) +\f +;;;; ANSI sequences minor mode + +(defvar org-ansi-mode-map (make-sparse-keymap) + "Keymap for the minor `org-ansi-mode'.") + +(org-defkey org-ansi-mode-map (kbd "C-c hf") #'org-ansi-highlight-foreground) +(org-defkey org-ansi-mode-map (kbd "C-c hb") #'org-ansi-highlight-background) + +(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" + (cond + ((and org-fontify-ansi-sequences org-ansi-mode) + (remove-text-properties (point-min) (point-max) '(fontified t)) + (font-lock-ensure)) + (t + (dolist (ov (overlays-in (point-min) (point-max))) + ;; Attempt to find ANSI specific overlays. See + ;; `ansi-color-make-extent'. + (when (eq (car-safe (overlay-get ov 'insert-behind-hooks)) + 'ansi-color-freeze-overlay) + ;; Delete the invisible overlays over the escape sequences + (dolist (ov (overlays-at (1- (overlay-start ov)))) + (when (overlay-get ov 'invisible) + (delete-overlay ov))) + (dolist (ov (overlays-at (1+ (overlay-end ov)))) + (when (overlay-get ov 'invisible) + (delete-overlay ov))) + ;; Delete the overlay over the highlighted text + (delete-overlay ov)))))) + +(add-hook 'org-mode-hook #'org-ansi-mode) + \f ;;;; CDLaTeX minor mode -- 2.39.1 [-- Attachment #4: Type: text/plain, Size: 15 bytes --] -- Nathaniel ^ permalink raw reply related [flat|nested] 33+ messages in thread
* Re: [PATCH] Highlight ANSI sequences in the whole buffer (was [PATCH] ANSI color on example blocks and fixed width elements) 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 0 siblings, 1 reply; 33+ messages in thread From: Ihor Radchenko @ 2023-04-14 8:49 UTC (permalink / raw) To: Nathaniel Nicandro; +Cc: emacs-orgmode Nathaniel Nicandro <nathanielnicandro@gmail.com> writes: >> Ideally, fontifying ANSI sequences should be fully controlled by users: >> 1. We may not want to touch src blocks by default, when >> `org-src-fontify-natively' is set to t. Only, maybe, provide an >> option. Or you may better publish a minor mode that does this for >> shell scripts. >> 2. We may allow all the ANSI sequences to be fontified in the whole >> buffer. > > I've updated my patch to be a combination of (1) and (2), see the > attached patch. Essentially every sequence is fontified except those in > source blocks and a minor mode has been created to allow users to > disable or enable fontification whenever they want. > > I've also attached an example Org file with some ANSI sequences in it > for testing purposes that you can try out. Thanks! > One issue that remains is how to handle sequences within inline source > blocks. Those don't have a src-block property so any sequences within > an inline source block are currently fontified. You should not use 'src-block property at all. There are scenarios when jit-lock defers source block fontification (in particular, when source block spans beyond the screen) and 'src-block property is not yet applied. Instead, you should query `org-element-at-point' or `org-element-context'. > +*** 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 revert-buffer 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. Rather than asking to use revert-buffer, we usually suggest M-x org-mode-restart. > +(defun org-fontify-ansi-sequences (limit) > + "Fontify ANSI sequences." > + (when (and org-fontify-ansi-sequences org-ansi-mode) > + (let (end) > + (while (/= (point) limit) Instead of this strict condition and later juggle with `narrow-to-region', just use the usual (while (< (point) limit) ...). > + (cond > + ((get-text-property (point) 'src-block) As I mentioned above, please use `org-element-at-point'. This function will also give you information about the block boundaries. > + (ansi-color-apply-on-region (point) end t) We should probably limit ANSI colour pairs to a single Org element. It does not make much sense to have text in-between the quotes below coloured: #+begin_quote ... <opening ANSI def> ... #+end_quote .... #+begin_quote ... <closing ANSI def> ... #+end_quote > + ;; Reset the context before every fontification cycle. This > + ;; avoids issues where `ansi-color-apply-on-region' attempts to > + ;; use an old starting point that may be from a different part > + ;; of the buffer, leading to "wrong side of point" errors. > + (setq ansi-color-context-region nil) This looks fragile. AFAIU, `ansi-color-context-region' is used to track currently active ANSI colour settings. Since your fontification function may be called with various LIMITs, depending on what is displayed on the user screen, the fontification results might be unpredictable for ANSI defs spanning across multiple screens. > +(defvar org-ansi-colors > + '(black red green yellow blue purple cyan white)) > + > +(defun org-ansi-highlight (beg end seq) > + (save-excursion > + (goto-char end) > + (insert "\e") > + (insert "[0m") > + (goto-char beg) > + (insert "\e") > + (insert (format "[%sm" seq)))) > + > +(defun org-ansi-highlight-foreground (beg end color) > + "Highlight the foreground between BEG and END with COLOR." > + (interactive > + (let ((bounds (car (region-bounds)))) > + (list (car bounds) (cdr bounds) > + (completing-read "Color: " org-ansi-colors nil t)))) > + (let ((n (- (length org-ansi-colors) > + (length (memq color org-ansi-colors))))) > + (org-ansi-highlight beg end (+ 30 n)))) > + > +(defun org-ansi-highlight-background (beg end color) > + "Highlight the background between BEG and END with COLOR." > + (interactive > + (let ((bounds (car (region-bounds)))) > + (list (car bounds) (cdr bounds) > + (completing-read "Color: " org-ansi-colors nil t)))) > + (let ((n (- (length org-ansi-colors) > + (length (memq color org-ansi-colors))))) > + (org-ansi-highlight beg end (+ 40 n)))) The above has no relation to fontification and does not belong to Org in general. Org syntax has no notion of ANSI escapes. We may support them as a useful feature, but no more. Editing ANSI escapes would make more sense in shell-script-mode or similar. > + :lighter " OANSI" > + (cond > + ((and org-fontify-ansi-sequences org-ansi-mode) > + (remove-text-properties (point-min) (point-max) '(fontified t)) > + (font-lock-ensure)) Just use `org-restart-font-lock'. > + (t > + (dolist (ov (overlays-in (point-min) (point-max))) > + ;; Attempt to find ANSI specific overlays. See > + ;; `ansi-color-make-extent'. > + (when (eq (car-safe (overlay-get ov 'insert-behind-hooks)) > + 'ansi-color-freeze-overlay) This is extremely awkward and relies on internal implementation details of ansi-color. Moreover, we must avoid overlays, if possible - they do not scale well. I recommend re-defining `ansi-color-apply-face-function' to something that uses text properties. Using text properties will also make restarting font-lock sufficient to clear the fontification. -- Ihor Radchenko // yantar92, Org mode contributor, Learn more about Org mode at <https://orgmode.org/>. Support Org development at <https://liberapay.com/org-mode>, or support my work at <https://liberapay.com/yantar92> ^ permalink raw reply [flat|nested] 33+ messages in thread
* Re: [PATCH] Highlight ANSI sequences in the whole buffer (was [PATCH] ANSI color on example blocks and fixed width elements) 2023-04-14 8:49 ` Ihor Radchenko @ 2023-04-25 20:33 ` Nathaniel Nicandro 2023-05-10 10:27 ` Ihor Radchenko 0 siblings, 1 reply; 33+ messages in thread From: Nathaniel Nicandro @ 2023-04-25 20:33 UTC (permalink / raw) To: Ihor Radchenko; +Cc: emacs-orgmode [-- Attachment #1: Type: text/plain, Size: 6999 bytes --] Ihor Radchenko <yantar92@posteo.net> writes: > Nathaniel Nicandro <nathanielnicandro@gmail.com> writes: > >>> Ideally, fontifying ANSI sequences should be fully controlled by users: >>> 1. We may not want to touch src blocks by default, when >>> `org-src-fontify-natively' is set to t. Only, maybe, provide an >>> option. Or you may better publish a minor mode that does this for >>> shell scripts. >>> 2. We may allow all the ANSI sequences to be fontified in the whole >>> buffer. >> >> I've updated my patch to be a combination of (1) and (2), see the >> attached patch. Essentially every sequence is fontified except those in >> source blocks and a minor mode has been created to allow users to >> disable or enable fontification whenever they want. >> >> I've also attached an example Org file with some ANSI sequences in it >> for testing purposes that you can try out. > > Thanks! > >> One issue that remains is how to handle sequences within inline source >> blocks. Those don't have a src-block property so any sequences within >> an inline source block are currently fontified. > > You should not use 'src-block property at all. There are scenarios when > jit-lock defers source block fontification (in particular, when source > block spans beyond the screen) and 'src-block property is not yet > applied. > > Instead, you should query `org-element-at-point' or > `org-element-context'. The attached patch now uses `org-element-at-point' and `org-element-context' to query for the bounds of elements. Note, I've also attached an updated example file which shows that the escape sequences in inline source blocks are now handled similarly to regular source blocks, i.e. they are not fontified. > >> +*** 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 revert-buffer 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. > > Rather than asking to use revert-buffer, we usually suggest M-x > org-mode-restart. Done. > >> +(defun org-fontify-ansi-sequences (limit) >> + "Fontify ANSI sequences." >> + (when (and org-fontify-ansi-sequences org-ansi-mode) >> + (let (end) >> + (while (/= (point) limit) > > Instead of this strict condition and later juggle with > `narrow-to-region', just use the usual (while (< (point) limit) ...). > Done. >> + (cond >> + ((get-text-property (point) 'src-block) > > As I mentioned above, please use `org-element-at-point'. This function > will also give you information about the block boundaries. > >> + (ansi-color-apply-on-region (point) end t) > > We should probably limit ANSI colour pairs to a single Org element. It > does not make much sense to have text in-between the quotes below > coloured: > > #+begin_quote > ... <opening ANSI def> ... > #+end_quote > > > .... > > #+begin_quote > ... <closing ANSI def> ... > #+end_quote > Makes sense. Done. >> + ;; Reset the context before every fontification cycle. This >> + ;; avoids issues where `ansi-color-apply-on-region' attempts to >> + ;; use an old starting point that may be from a different part >> + ;; of the buffer, leading to "wrong side of point" errors. >> + (setq ansi-color-context-region nil) > > This looks fragile. AFAIU, `ansi-color-context-region' is used to track > currently active ANSI colour settings. Since your fontification function > may be called with various LIMITs, depending on what is displayed on the > user screen, the fontification results might be unpredictable for ANSI > defs spanning across multiple screens. > It seems to be safe to reset `ansi-color-context-region' now given that org-element is used to find the bounds of the element at `point'. Although the fontification limits are dependent on screen size, the org-element functions are not and so the bounds used when applying the fontification for the ANSI sequences won't depend on screen size either. Also, re-setting `ansi-color-context-region' has the effect of not propagating previously applied color settings to other Org elements. >> +(defvar org-ansi-colors >> + '(black red green yellow blue purple cyan white)) >> + >> +(defun org-ansi-highlight (beg end seq) >> + (save-excursion >> + (goto-char end) >> + (insert "\e") >> + (insert "[0m") >> + (goto-char beg) >> + (insert "\e") >> + (insert (format "[%sm" seq)))) >> + >> +(defun org-ansi-highlight-foreground (beg end color) >> + "Highlight the foreground between BEG and END with COLOR." >> + (interactive >> + (let ((bounds (car (region-bounds)))) >> + (list (car bounds) (cdr bounds) >> + (completing-read "Color: " org-ansi-colors nil t)))) >> + (let ((n (- (length org-ansi-colors) >> + (length (memq color org-ansi-colors))))) >> + (org-ansi-highlight beg end (+ 30 n)))) >> + >> +(defun org-ansi-highlight-background (beg end color) >> + "Highlight the background between BEG and END with COLOR." >> + (interactive >> + (let ((bounds (car (region-bounds)))) >> + (list (car bounds) (cdr bounds) >> + (completing-read "Color: " org-ansi-colors nil t)))) >> + (let ((n (- (length org-ansi-colors) >> + (length (memq color org-ansi-colors))))) >> + (org-ansi-highlight beg end (+ 40 n)))) > > The above has no relation to fontification and does not belong to Org in > general. Org syntax has no notion of ANSI escapes. We may support them > as a useful feature, but no more. Editing ANSI escapes would make more > sense in shell-script-mode or similar. Removed. > >> + :lighter " OANSI" >> + (cond >> + ((and org-fontify-ansi-sequences org-ansi-mode) >> + (remove-text-properties (point-min) (point-max) '(fontified t)) >> + (font-lock-ensure)) > > Just use `org-restart-font-lock'. > Thanks. Done. >> + (t >> + (dolist (ov (overlays-in (point-min) (point-max))) >> + ;; Attempt to find ANSI specific overlays. See >> + ;; `ansi-color-make-extent'. >> + (when (eq (car-safe (overlay-get ov 'insert-behind-hooks)) >> + 'ansi-color-freeze-overlay) > > This is extremely awkward and relies on internal implementation details > of ansi-color. Moreover, we must avoid overlays, if possible - they do > not scale well. I recommend re-defining `ansi-color-apply-face-function' > to something that uses text properties. Using text properties will also > make restarting font-lock sufficient to clear the fontification. I've re-defined `ansi-color-apply-face-function' as you've said. [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: test-ansi.org --] [-- Type: text/x-org, Size: 879 bytes --] * This is a ^[[42mtest^[[0m :PROPERTIES: :CUSTOM_ID: 123 :END: Of ^[[31mANSI^[[0m ^[[33mcolor^[[0m sequences #+begin_src python for x in y: print(x + "this is a ^[[43mtest^[[0m") #+end_src : this ^[[42mis a^[[0m td =testing= In paragraph a ~color ^[[44msequ^[[0mence~ is ^[[41mhere^[[0m. ^[[43mThis is a sequence that covers a block #+begin_example shouldn't be colored #+end_example there should be an end here^[[0m there is the end. begin ^[[43m sequence without end #+begin_src python 1 + 1 #+end_src #+begin_quote open ^[[43m #+end_quote should not be highlighted #+begin_quote close ^[[0m #+end_quote This is a paragraph src_python{return "t^[[43mest^[[0ming"} {{{results(=t^[[43mest^[[0ming=)}}} with multiple inline src_python{return 5*4} {{{results(=20=)}}} source blocks. An inline source block src_python{return 1+ 1 without an end. src_python{return "t^[[43mest^[[0ming"}. [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #3: Patch --] [-- Type: text/x-patch, Size: 6527 bytes --] From c59d39d76266670200f9cfe70a1e1c2dad04c8bc 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. * org.el (org-fontify-ansi-sequences): New customization variable and function which does the work of fontifying the sequences. (org-set-font-lock-defaults): Add the `org-fontify-ansi-sequences` function to the font-lock keywords. (org-ansi-mode): New minor mode to enable/disable highlighting of the sequences. Enabled in Org buffers by default. --- etc/ORG-NEWS | 12 ++++++++ lisp/org.el | 82 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 94 insertions(+) diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS index b7c88fd..2c28785 100644 --- a/etc/ORG-NEWS +++ b/etc/ORG-NEWS @@ -169,6 +169,18 @@ official [[https://clojure.org/guides/deps_and_cli][Clojure CLI tools]]. The command can be customized with ~ob-clojure-cli-command~. ** 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. + *** Add support for ~logind~ idle time in ~org-user-idle-seconds~ When Emacs is built with =dbus= support and diff --git a/lisp/org.el b/lisp/org.el index 26d2a86..6742449 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) @@ -3582,6 +3583,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 @@ -5543,6 +5550,66 @@ (defun org-fontify-extend-region (beg end _old-len) (cons beg (or (funcall extend "end" "]" 1) end))) (t (cons beg end)))))) +(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) + (let ((el (org-element-at-point)) beg end next) + (pcase (org-element-type el) + (`src-block + (setq beg (org-element-property :end el) + end beg + next end)) + (`headline + (setq beg (org-element-property :begin el) + end (org-element-property :contents-begin el) + next end)) + (`paragraph + ;; Compute the regions of the paragraph excluding inline + ;; source blocks. + (setq beg nil end nil) + (let ((pbeg (org-element-property :begin el)) + (pend (org-element-property :end el))) + (goto-char pbeg) + (push pbeg 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) + (setq beg (nreverse beg) + end (nreverse end) + next pend))) + (_ + (setq beg (or (org-element-property :contents-begin el) + (org-element-property :begin el)) + end (or (org-element-property :contents-end el) + (org-element-property :end el)) + next (org-element-property :end el)))) + (cl-letf (((symbol-function #'delete-region) + (lambda (beg end) + (add-text-properties beg end '(invisible t)))) + (ansi-color-apply-face-function + (lambda (beg end face) + (font-lock-prepend-text-property beg end 'face face)))) + (if (consp beg) + (while (consp beg) + (ansi-color-apply-on-region (pop beg) (pop end))) + (ansi-color-apply-on-region beg end))) + ;; Reset the context after applying the color to prevent color + ;; settings from propagating to other elements. This also + ;; avoids issues where `ansi-color-apply-on-region' attempts + ;; to use an old starting point that may be from a different + ;; part of the buffer, leading to "wrong side of point" + ;; errors. + (setq ansi-color-context-region nil) + (goto-char next))))) + (defun org-activate-footnote-links (limit) "Add text properties for footnotes." (let ((fn (org-footnote-next-reference-or-definition limit))) @@ -5861,6 +5928,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 @@ -15455,6 +15523,20 @@ (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" + (org-restart-font-lock)) + +(add-hook 'org-mode-hook #'org-ansi-mode) + \f ;;;; CDLaTeX minor mode -- 2.39.1 [-- Attachment #4: Type: text/plain, Size: 15 bytes --] -- Nathaniel ^ permalink raw reply related [flat|nested] 33+ messages in thread
* Re: [PATCH] Highlight ANSI sequences in the whole buffer (was [PATCH] ANSI color on example blocks and fixed width elements) 2023-04-25 20:33 ` Nathaniel Nicandro @ 2023-05-10 10:27 ` Ihor Radchenko 2023-05-15 0:18 ` Nathaniel Nicandro 0 siblings, 1 reply; 33+ messages in thread From: Ihor Radchenko @ 2023-05-10 10:27 UTC (permalink / raw) To: Nathaniel Nicandro; +Cc: emacs-orgmode Nathaniel Nicandro <nathanielnicandro@gmail.com> writes: > The attached patch now uses `org-element-at-point' and > `org-element-context' to query for the bounds of elements. Thanks! > Note, I've also attached an updated example file which shows that the > escape sequences in inline source blocks are now handled similarly to > regular source blocks, i.e. they are not fontified. I do not think that a single exception - source blocks is good enough. When having something like ANSI opening term is =<ANSI>=, and closing term is =<ANSI>= it will be not expected to get things fontified. A better approach will be: 1. Do not allow ANSI sequences to intersect markup boundaries of the same AST depth: *bold <ANSI>* plain text <ANSI> should not trigger fontification *bold <ANSI> /italic/ <ANSI>* should trigger plain text <ANSI> *bold* plain text <ANSI> also should 2. Disallow fontification is certain contexts - 'inline-src-block Further, your current code will do something weird when encountering greater element: :DRAWER: Paragraph <ANSI> Another paragraph <ANSI> :END: You should not consider greater elements when fontifying. > + (cl-letf (((symbol-function #'delete-region) > + (lambda (beg end) > + (add-text-properties beg end '(invisible t)))) This is fragile and relies on internal implementation details of ansi-color.el. Is there another way? -- Ihor Radchenko // yantar92, Org mode contributor, Learn more about Org mode at <https://orgmode.org/>. Support Org development at <https://liberapay.com/org-mode>, or support my work at <https://liberapay.com/yantar92> ^ permalink raw reply [flat|nested] 33+ messages in thread
* Re: [PATCH] Highlight ANSI sequences in the whole buffer (was [PATCH] ANSI color on example blocks and fixed width elements) 2023-05-10 10:27 ` Ihor Radchenko @ 2023-05-15 0:18 ` Nathaniel Nicandro 2023-05-18 19:45 ` Ihor Radchenko 0 siblings, 1 reply; 33+ messages in thread From: Nathaniel Nicandro @ 2023-05-15 0:18 UTC (permalink / raw) To: Ihor Radchenko; +Cc: emacs-orgmode Ihor Radchenko <yantar92@posteo.net> writes: > Nathaniel Nicandro <nathanielnicandro@gmail.com> writes: > >> The attached patch now uses `org-element-at-point' and >> `org-element-context' to query for the bounds of elements. > > Thanks! > >> Note, I've also attached an updated example file which shows that the >> escape sequences in inline source blocks are now handled similarly to >> regular source blocks, i.e. they are not fontified. > > I do not think that a single exception - source blocks is good enough. > When having something like > ANSI opening term is =<ANSI>=, and closing term is =<ANSI>= > it will be not expected to get things fontified. > > A better approach will be: > 1. Do not allow ANSI sequences to intersect markup boundaries of the > same AST depth: > *bold <ANSI>* plain text <ANSI> should not trigger fontification > *bold <ANSI> /italic/ <ANSI>* should trigger > plain text <ANSI> *bold* plain text <ANSI> also should Just to make sure I'm getting you right. You're saying that fontification should trigger if the sequences live in the same org-element-context? What about cases like: *<ANSI>bold* plain text <ANSI> plain <ANSI>text *bold <ANSI>* paragraph end In the first case, should only "bold" be fontified? Since the sequence lives in the bold context. In the second, should only "text"? Since the sequence lives at a higher depth (the paragraph context, compared to the bold context). Or should it be that the fontification should extend to the end of the paragraph because the sequence lives at a higher depth? > 2. Disallow fontification is certain contexts - 'inline-src-block What I will do then is not consider sequences in inline-src-block, code, or verbatim contexts. Are there any other elements or objects that I should not consider (other than the greater elements as you mention below)? For verbatim (and code) contexts, if there are regions like <ANSIx> plain =<ANSIy>= text <ANSIz> ANSIy will not get considered and the region between ANSIx and ANSIz will get highlighted using ANSIx's settings. So the verbatim object gets highlighted as well. For inline source blocks, I'll do what I did in the last patch and decompose a paragraph into regions that exclude inline source blocks and only consider those regions when processing the sequences. That way the highlighting doesn't spill over into the inline source blocks (and not interfere with the syntax highlighting of them). > > Further, your current code will do something weird when encountering > greater element: > > :DRAWER: > Paragraph <ANSI> > > Another paragraph <ANSI> > :END: > > You should not consider greater elements when fontifying. > Thanks. In the case of greater elements, then, I will only consider their contents. For plain-lists and tables I will: 1. (for plain-lists) only consider the contents of the list items 2. (for tables) only consider the table-cells of each table-row >> + (cl-letf (((symbol-function #'delete-region) >> + (lambda (beg end) >> + (add-text-properties beg end '(invisible t)))) > > This is fragile and relies on internal implementation details of > ansi-color.el. Is there another way? Since the context in which the sequences live in need to be considered, it doesn't look like ansi-color-apply-on-region can be used any more since it isn't aware of Org objects. I've come up with a function that calculates the highlightable regions (considering contexts) and fontifies them, but it requires the use of private functions from ansi-color. Specifically ansi-color--face-vec-face, ansi-color--update-face-vec, and ansi-color--code-as-hex (used internally by ansi-color--face-vec-face). Does it make sense to copy over these functions into Org for the purposes of handling ANSI escapes? There would be some backward compatibility issues, e.g. ansi-color only started using faces as colors in Emacs 28. -- Nathaniel ^ permalink raw reply [flat|nested] 33+ messages in thread
* Re: [PATCH] Highlight ANSI sequences in the whole buffer (was [PATCH] ANSI color on example blocks and fixed width elements) 2023-05-15 0:18 ` Nathaniel Nicandro @ 2023-05-18 19:45 ` Ihor Radchenko 2023-05-23 0:55 ` Nathaniel Nicandro 2023-11-17 21:18 ` Nathaniel Nicandro 0 siblings, 2 replies; 33+ messages in thread From: Ihor Radchenko @ 2023-05-18 19:45 UTC (permalink / raw) To: Nathaniel Nicandro; +Cc: emacs-orgmode Nathaniel Nicandro <nathanielnicandro@gmail.com> writes: >> 1. Do not allow ANSI sequences to intersect markup boundaries of the >> same AST depth: >> *bold <ANSI>* plain text <ANSI> should not trigger fontification >> *bold <ANSI> /italic/ <ANSI>* should trigger >> plain text <ANSI> *bold* plain text <ANSI> also should > > Just to make sure I'm getting you right. You're saying that > fontification should trigger if the sequences live in the same > org-element-context? > What about cases like: > > *<ANSI>bold* plain text <ANSI> > plain <ANSI>text *bold <ANSI>* paragraph end > > In the first case, should only "bold" be fontified? Since the sequence > lives in the bold context. > In the second, should only "text"? Since the sequence lives at a higher > depth (the paragraph context, compared to the bold context). Or should > it be that the fontification should extend to the end of the paragraph > because the sequence lives at a higher depth? I completely missed the point that <ANSI> codes are not <open ... close> pairs, but switches; this is completely different from Org syntax. So, let me re-consider where <ANSI> codes are likely to be used in practice: 1. Inside shell code blocks (src-block element) 2. Inside results of evaluation, which are usually fixed-width element, but might also be example-block, export-block, drawer, table, or other element. 3. Inside shell inline code blocks (inline-src-block object) 4. Inside results of evaluation of an inline code block - usually code/verbatim markup. I think that the most reasonable approach to fontify ANSI sequences will be the following: 1. We will consider ANSI within (a) all greater elements and lesser elements that have RESULTS affiliated keyword (indicating that they are result of code block evaluation); (b) otherwise, just lesser elements, like paragraph, src block, example block, export block, etc., but _not_ tables (c) otherwise, within verbatim-like objects, like code, export-snippet, inline-src-block, table-cell, verbatim. The three groups above should be declared via variables, so that users can tweak them as necessary. 2. If ANSI sequence is encountered inside a verbatim-like object and we did not see any ANSI sequences within parent element or greater element, limit ANSI triggers to the current object. Example: #+RESULTS: Lorem upsum =<ANSI>valor=. Some more text. (only "valor" will be affected) 3. If the first ANSI sequence is encountered inside element and outside verbatim-like object, the rest of the element is affected, including all the objects. Example: #+RESULTS: <ANSI>Lorem upsum =<ANSI>valor=. Some more text. (the first ANSI affects everything, including verbatim; the second ANSI also affects everything) 4. If the first ANSI sequence is encountered inside greater element with RESULTS affiliated keyword, all the lesser elements inside will be affected. Example: #+RESULTS: :drawer: <ANSI>Lorem upsum =valor=. Some more text. Another paragraph inside drawer. :end: (everything down to :end: is affected) or #+RESULTS: - <ANSI>list - one - two - three (everything is affected down to the end of the list) Does it make sense? >>> + (cl-letf (((symbol-function #'delete-region) >>> + (lambda (beg end) >>> + (add-text-properties beg end '(invisible t)))) >> >> This is fragile and relies on internal implementation details of >> ansi-color.el. Is there another way? > > Since the context in which the sequences live in need to be considered, > it doesn't look like ansi-color-apply-on-region can be used any more > since it isn't aware of Org objects. > > I've come up with a function that calculates the highlightable regions > (considering contexts) and fontifies them, but it requires the use of > private functions from ansi-color. Specifically > ansi-color--face-vec-face, ansi-color--update-face-vec, and > ansi-color--code-as-hex (used internally by ansi-color--face-vec-face). > Does it make sense to copy over these functions into Org for the > purposes of handling ANSI escapes? There would be some backward > compatibility issues, e.g. ansi-color only started using faces as colors > in Emacs 28. If we really need to, we can propose an extension of ansi-color-apply-on-region upstream for Emacs itself. -- Ihor Radchenko // yantar92, Org mode contributor, Learn more about Org mode at <https://orgmode.org/>. Support Org development at <https://liberapay.com/org-mode>, or support my work at <https://liberapay.com/yantar92> ^ permalink raw reply [flat|nested] 33+ messages in thread
* Re: [PATCH] Highlight ANSI sequences in the whole buffer (was [PATCH] ANSI color on example blocks and fixed width elements) 2023-05-18 19:45 ` Ihor Radchenko @ 2023-05-23 0:55 ` Nathaniel Nicandro 2023-08-08 11:02 ` Ihor Radchenko 2023-11-17 21:18 ` Nathaniel Nicandro 1 sibling, 1 reply; 33+ messages in thread From: Nathaniel Nicandro @ 2023-05-23 0:55 UTC (permalink / raw) To: Ihor Radchenko; +Cc: emacs-orgmode Ihor Radchenko <yantar92@posteo.net> writes: > Nathaniel Nicandro <nathanielnicandro@gmail.com> writes: > >>> 1. Do not allow ANSI sequences to intersect markup boundaries of the >>> same AST depth: >>> *bold <ANSI>* plain text <ANSI> should not trigger fontification >>> *bold <ANSI> /italic/ <ANSI>* should trigger >>> plain text <ANSI> *bold* plain text <ANSI> also should >> >> Just to make sure I'm getting you right. You're saying that >> fontification should trigger if the sequences live in the same >> org-element-context? > >> What about cases like: >> >> *<ANSI>bold* plain text <ANSI> >> plain <ANSI>text *bold <ANSI>* paragraph end >> >> In the first case, should only "bold" be fontified? Since the sequence >> lives in the bold context. > >> In the second, should only "text"? Since the sequence lives at a higher >> depth (the paragraph context, compared to the bold context). Or should >> it be that the fontification should extend to the end of the paragraph >> because the sequence lives at a higher depth? > > I completely missed the point that <ANSI> codes are not <open ... close> > pairs, but switches; this is completely different from Org syntax. > > So, let me re-consider where <ANSI> codes are likely to be used in > practice: > > 1. Inside shell code blocks (src-block element) > 2. Inside results of evaluation, which are usually fixed-width element, > but might also be example-block, export-block, drawer, table, or > other element. > 3. Inside shell inline code blocks (inline-src-block object) > 4. Inside results of evaluation of an inline code block - usually > code/verbatim markup. > > I think that the most reasonable approach to fontify ANSI sequences will > be the following: > > 1. We will consider ANSI within (a) all greater elements and lesser > elements that have RESULTS affiliated keyword (indicating that they > are result of code block evaluation); (b) otherwise, just lesser > elements, like paragraph, src block, example block, export block, > etc., but _not_ tables (c) otherwise, within verbatim-like objects, > like code, export-snippet, inline-src-block, table-cell, verbatim. > > The three groups above should be declared via variables, so that > users can tweak them as necessary. > > 2. If ANSI sequence is encountered inside a verbatim-like object and we > did not see any ANSI sequences within parent element or greater > element, limit ANSI triggers to the current object. > > Example: > > #+RESULTS: > Lorem upsum =<ANSI>valor=. Some more text. > > (only "valor" will be affected) > > 3. If the first ANSI sequence is encountered inside element and outside > verbatim-like object, the rest of the element is affected, including > all the objects. > > Example: > > #+RESULTS: > <ANSI>Lorem upsum =<ANSI>valor=. Some more text. > > (the first ANSI affects everything, including verbatim; the second > ANSI also affects everything) > > 4. If the first ANSI sequence is encountered inside greater element with > RESULTS affiliated keyword, all the lesser elements inside will be > affected. > > Example: > > #+RESULTS: > :drawer: > <ANSI>Lorem upsum =valor=. Some more text. > > Another paragraph inside drawer. > :end: > > (everything down to :end: is affected) > > or > > #+RESULTS: > - <ANSI>list > - one > - two > - three > > (everything is affected down to the end of the list) > > Does it make sense? > Sounds good to me. >>>> + (cl-letf (((symbol-function #'delete-region) >>>> + (lambda (beg end) >>>> + (add-text-properties beg end '(invisible t)))) >>> >>> This is fragile and relies on internal implementation details of >>> ansi-color.el. Is there another way? >> >> Since the context in which the sequences live in need to be considered, >> it doesn't look like ansi-color-apply-on-region can be used any more >> since it isn't aware of Org objects. >> >> I've come up with a function that calculates the highlightable regions >> (considering contexts) and fontifies them, but it requires the use of >> private functions from ansi-color. Specifically >> ansi-color--face-vec-face, ansi-color--update-face-vec, and >> ansi-color--code-as-hex (used internally by ansi-color--face-vec-face). >> Does it make sense to copy over these functions into Org for the >> purposes of handling ANSI escapes? There would be some backward >> compatibility issues, e.g. ansi-color only started using faces as colors >> in Emacs 28. > > If we really need to, we can propose an extension of > ansi-color-apply-on-region upstream for Emacs itself. -- Nathaniel ^ permalink raw reply [flat|nested] 33+ messages in thread
* Re: [PATCH] Highlight ANSI sequences in the whole buffer (was [PATCH] ANSI color on example blocks and fixed width elements) 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 0 siblings, 2 replies; 33+ messages in thread From: Ihor Radchenko @ 2023-08-08 11:02 UTC (permalink / raw) To: Nathaniel Nicandro; +Cc: emacs-orgmode Hi, A few months have passed since the last activity in this thread. May I know if you are still interested in the idea? Should you need any help, feel free to ask. -- Ihor Radchenko // yantar92, Org mode contributor, Learn more about Org mode at <https://orgmode.org/>. Support Org development at <https://liberapay.com/org-mode>, or support my work at <https://liberapay.com/yantar92> ^ permalink raw reply [flat|nested] 33+ messages in thread
* Re: [PATCH] Highlight ANSI sequences in the whole buffer (was [PATCH] ANSI color on example blocks and fixed width elements) 2023-08-08 11:02 ` Ihor Radchenko @ 2023-11-08 9:56 ` Ihor Radchenko 2023-11-08 15:35 ` Nathaniel Nicandro 1 sibling, 0 replies; 33+ messages in thread From: Ihor Radchenko @ 2023-11-08 9:56 UTC (permalink / raw) To: Nathaniel Nicandro; +Cc: emacs-orgmode Ihor Radchenko <yantar92@posteo.net> writes: > A few months have passed since the last activity in this thread. Canceled. -- Ihor Radchenko // yantar92, Org mode contributor, Learn more about Org mode at <https://orgmode.org/>. Support Org development at <https://liberapay.com/org-mode>, or support my work at <https://liberapay.com/yantar92> ^ permalink raw reply [flat|nested] 33+ messages in thread
* Re: [PATCH] Highlight ANSI sequences in the whole buffer (was [PATCH] ANSI color on example blocks and fixed width elements) 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 1 sibling, 1 reply; 33+ messages in thread From: Nathaniel Nicandro @ 2023-11-08 15:35 UTC (permalink / raw) To: Ihor Radchenko; +Cc: Nathaniel Nicandro, emacs-orgmode Ihor Radchenko <yantar92@posteo.net> writes: > Hi, Hi Ihor, > A few months have passed since the last activity in this thread. > May I know if you are still interested in the idea? I apologize for being unresponsive all these months. Yes I'm still interested in this idea, although I have not had time to work on it recently. Life events caused me to have to stop working on it completely a few months back, I'm hoping to be able to put in more time now. I haven't even been able to put that much time into my more popular personal projects recently either! > Should you need any help, feel free to ask. I have been working on some code to satisfy the set of rules you provided in a previous email of this thread. I've made some progress, but the code is a little messy and buggy. I would like to clean it up first before I present it. Where I'm having some trouble is processing the contents of greater elements. My approach for them is basically to define an ansi-context (see `ansi-color-context-region`) for each greater element and process the inner elements using that context. This seems to work except for plain-list elements which can have other plain-list elements within them, e.g. #+RESULTS: - <ANSI1>List item 1 - Sub-list <ANSI2>item 1 - List item 2 - List item 3 Should the sub-list's sequence affect the rest of list elements in the parent list? If that's the case, then I think I can keep with my approach and define an ansi-context for the outermost plain-list which is used by all the other plain-list elements contained within it. Otherwise I think I would have to do something like copy the ansi-context for each inner plain-list and use the copy to process the sequences in the inner-list so that the context of the outer-list is unaffected. WDYT? -- Nathaniel ^ permalink raw reply [flat|nested] 33+ messages in thread
* Re: [PATCH] Highlight ANSI sequences in the whole buffer (was [PATCH] ANSI color on example blocks and fixed width elements) 2023-11-08 15:35 ` Nathaniel Nicandro @ 2023-11-10 10:25 ` Ihor Radchenko 0 siblings, 0 replies; 33+ messages in thread From: Ihor Radchenko @ 2023-11-10 10:25 UTC (permalink / raw) To: Nathaniel Nicandro; +Cc: emacs-orgmode Nathaniel Nicandro <nathanielnicandro@gmail.com> writes: >> A few months have passed since the last activity in this thread. >> May I know if you are still interested in the idea? > > I apologize for being unresponsive all these months. Yes I'm still > interested in this idea, although I have not had time to work on it > recently. Life events caused me to have to stop working on it > completely a few months back, I'm hoping to be able to put in more time > now. No problem. There is no real rush. Just a gentle, infrequent, ping to keep things progressing :) > Where I'm having some trouble is processing the contents of greater > elements. My approach for them is basically to define an ansi-context > (see `ansi-color-context-region`) for each greater element and process > the inner elements using that context. This seems to work except for > plain-list elements which can have other plain-list elements within > them, e.g. > > #+RESULTS: > - <ANSI1>List item 1 > - Sub-list <ANSI2>item 1 > - List item 2 > - List item 3 > > Should the sub-list's sequence affect the rest of list elements in the > parent list? If that's the case, then I think I can keep with my > approach and define an ansi-context for the outermost plain-list which > is used by all the other plain-list elements contained within > it. Otherwise I think I would have to do something like copy the > ansi-context for each inner plain-list and use the copy to process the > sequences in the inner-list so that the context of the outer-list is > unaffected. WDYT? Just go with whatever is simpler implementation-wise. It is a good idea to get things working first, and only then go ahead with tweaking small details as necessary. -- Ihor Radchenko // yantar92, Org mode contributor, Learn more about Org mode at <https://orgmode.org/>. Support Org development at <https://liberapay.com/org-mode>, or support my work at <https://liberapay.com/yantar92> ^ permalink raw reply [flat|nested] 33+ messages in thread
* Re: [PATCH] Highlight ANSI sequences in the whole buffer (was [PATCH] ANSI color on example blocks and fixed width elements) 2023-05-18 19:45 ` Ihor Radchenko 2023-05-23 0:55 ` Nathaniel Nicandro @ 2023-11-17 21:18 ` Nathaniel Nicandro 2023-12-14 14:34 ` Ihor Radchenko 2023-12-14 14:37 ` Ihor Radchenko 1 sibling, 2 replies; 33+ messages in thread From: Nathaniel Nicandro @ 2023-11-17 21:18 UTC (permalink / raw) To: Ihor Radchenko; +Cc: Nathaniel Nicandro, emacs-orgmode [-- Attachment #1: Type: text/plain, Size: 3232 bytes --] Ihor Radchenko <yantar92@posteo.net> writes: > I think that the most reasonable approach to fontify ANSI sequences will > be the following: > > 1. We will consider ANSI within (a) all greater elements and lesser > elements that have RESULTS affiliated keyword (indicating that they > are result of code block evaluation); (b) otherwise, just lesser > elements, like paragraph, src block, example block, export block, > etc., but _not_ tables (c) otherwise, within verbatim-like objects, > like code, export-snippet, inline-src-block, table-cell, verbatim. > > The three groups above should be declared via variables, so that > users can tweak them as necessary. > > 2. If ANSI sequence is encountered inside a verbatim-like object and we > did not see any ANSI sequences within parent element or greater > element, limit ANSI triggers to the current object. > > Example: > > #+RESULTS: > Lorem upsum =<ANSI>valor=. Some more text. > > (only "valor" will be affected) > > 3. If the first ANSI sequence is encountered inside element and outside > verbatim-like object, the rest of the element is affected, including > all the objects. > > Example: > > #+RESULTS: > <ANSI>Lorem upsum =<ANSI>valor=. Some more text. > > (the first ANSI affects everything, including verbatim; the second > ANSI also affects everything) > > 4. If the first ANSI sequence is encountered inside greater element with > RESULTS affiliated keyword, all the lesser elements inside will be > affected. > > Example: > > #+RESULTS: > :drawer: > <ANSI>Lorem upsum =valor=. Some more text. > > Another paragraph inside drawer. > :end: > > (everything down to :end: is affected) > > or > > #+RESULTS: > - <ANSI>list > - one > - two > - three > Hello Ihor, Attached is the updated version of the patch. I've also attached an updated file that I've been using for testing the feature. What I have is essentially a function, org-fontify-ansi-sequences, that scans the buffer for an ANSI sequence and depending on the element-context processes the region that should be affected according to the rules you stated (see above). The org-fontify-ansi-sequences-1 function scans the buffer element-wise and processes the appropriate regions of the elements, even if no sequences appear in those regions, according to an ansi-context. This is to support the fourth rule you mentioned. Note that modifications to highlighted regions hasn't really been considered so if you have a scenario like #+RESULTS: - <ANSI>Paragraph one - Paragraph two Line 3 where the sequence affects everything down to "Line 3" and you make a modification to line three, the fontification due to the sequence disappears on that line. Also note that lesser elements contained in greater elements that don't have a RESULTS keyword are handled at the lesser element level so if you have something like #+begin_center Paragraph <ANSI>one. Paragraph two. #+end_center It would be the same as if you just had the paragraphs without the greater element. Please review the code and let me know what you think and how you think we can move forward on this feature. Thanks in advance. [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: Example Org file --] [-- Type: text/x-org, Size: 2718 bytes --] #+TITLE: Test Section 1 * Greater ^[[42melements^[[0m :PROPERTIES: :CUSTOM_ID: 123 :END: #+begin_center Inner ^[[31mparagraph one Inner paragraph two #+end_center :drawer: Inner ^[[31mparagraph one Inner paragraph two :end: #+BEGIN: dblock1 :scope subtree :maxlevel 2 - Item 1 - ^[[31mItem 2 - Item 3 - ^[[32mItem 4 #+END: [fn:1] Footnote ^[[42mdefinition *************** TODO Inline ^[[42mtask 1^[[0m Inner ^[[31mcontents^[[0m *************** END *************** TODO Inline ^[[42mtask 2^[[0m - Paragraph ^[[31mone^[[0m - Paragraph ^[[31mtwo - Paragraph three - Paragraph four | ^[[31mcell 1 | cell 2 | | cell 3 | cell 4 | #+begin_quote open ^[[43m #+end_quote should not be highlighted #+begin_quote close ^[[0m #+end_quote * Lesser elements :PROPERTIES: :DESCRIPTION: ^[[31mvalue :END: #+CALL: fn(str="^[[31mtext^[[0m") # Line ^[[31mone^[[0m #+begin_comment Line ^[[31mone^[[0m Line ^[[32mtwo^[[0m #+end_comment %%(diary-anniversary 10 31 1948) Arthur's ^[[32mBirthday #+begin_example Line ^[[31mone^[[0m Line ^[[32mtwo^[[0m #+end_example #+begin_export latex Line ^[[31mone^[[0m Line ^[[32ttwo^[[0m #+end_export : Line ^[[31mone^[[0m : Line ^[[32mtwo^[[0m #+AUTHOR: First ^[[31mLast \begin{quote} Line ^[[31mone^[[0m Line ^[[32mtwo^[[0m \end{quote} Paragraph ^[[31mone Line ^[[32mtwo^[[0m #+begin_src python for x in y: print(x + "^[[43mtest^[[0m") #+end_src * Object contexts =ver^[[43mbatim= one ^[[42mLorem upsum =^[[43mvalor=. Some more text. This is a paragraph src_python{return "t^[[43mest^[[0ming"} {{{results(=t^[[43mest^[[0ming=)}}} with multiple inline src_python{return 5*4} {{{results(=20=)}}} source blocks. An inline source block src_python{return 1+ 1 without an end. src_python{return "t^[[43mest^[[0ming"}. ^[[42m Paragraph =^[[43mone= _underlined ^[[43m text *bold ^[[42m text ^[[0m* underlined ^[[0m text_ _underlined ^[[43m text_ plain^[[32m text _underlined ^[[42m text_ _underlined ^[[43m text *bold ^[[42m te /ita^[[31mlic/ xt ^[[0m end* underlined ^[[0m text_ _underlined ^[[43m text *bold ^[[42m te /ita^[[31mlic/ xt* underlined ^[[0m text_ _underlined ^[[43m text_ plain _underlined ^[[0m text_ * Greater elements with RESULTS keyword #+RESULTS: :drawer: ^[[42mLorem upsum =valor=. Some more text. Another paragraph inside drawer. :end: #+RESULTS: :RESULTS: Paragraph ^[[42mone. #+begin_example - ^[[32mtest^[[0m - ^[[31mtest^[[0m #+end_example Paragraph ^[[43mtwo. :END: #+RESULTS: - ^[[42mlist - one - three - two - three #+RESULTS: - [ ] ^[[42mCheckbox - - #+RESULTS: - ^[[42mList item - [@5] List item :drawer: Interior - list inner - one two three four five six :end: - tag :: description #+RESULTS: - ^[[42mItem 1 - Item 2 | cell 1 | cell 2 | | cell 3 | cell 4 | [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #3: Patch --] [-- Type: text/x-patch, Size: 13587 bytes --] From 66baf6e1d435974fb4c51cc47eb5b3ace3feb22c 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. * 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): New customization variables. (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): New functions. (org-set-font-lock-defaults): Add the `org-fontify-ansi-sequences` function to the font-lock keywords. (org-ansi-mode): New minor mode to enable/disable highlighting of the sequences. Enabled in Org buffers by default. --- etc/ORG-NEWS | 12 +++ lisp/org.el | 236 +++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 248 insertions(+) diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS index 1207d6f..76a81e3 100644 --- a/etc/ORG-NEWS +++ b/etc/ORG-NEWS @@ -492,6 +492,18 @@ Currently implemented options are: iCalendar programs support this usage. ** 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. + *** =ob-plantuml.el=: Support tikz file format output =ob-plantuml.el= now output =tikz= :file format via diff --git a/lisp/org.el b/lisp/org.el index d2cd0b9..64a853c 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) @@ -3608,6 +3609,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 @@ -5598,6 +5605,208 @@ (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 + 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) + +(defun org-ansi-new-context (pos) + (list (list (make-bool-vector 8 nil) + nil nil) + (copy-marker pos))) + +(defun org-ansi-process-region (beg end &optional context) + (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) + (font-lock-prepend-text-property beg end 'face face)))) + (ansi-color-apply-on-region beg end t))) + +(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)) + (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 `example-block `export-block) + (org-ansi-process-block ctx)) + (`fixed-width + (org-ansi-process-fixed-width ctx)) + (`paragraph + (org-ansi-process-paragraph 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-activate-footnote-links (limit) "Add text properties for footnotes." (let ((fn (org-footnote-next-reference-or-definition limit))) @@ -5915,6 +6124,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 @@ -15582,6 +15792,32 @@ (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" + (org-restart-font-lock) + (unless org-ansi-mode + (org-with-wide-buffer + (goto-char (point-min)) + (while (re-search-forward ansi-color-control-seq-regexp nil t) + (let ((beg (match-beginning 0)) + (end (point))) + (dolist (ov (overlays-at beg)) + (when (and (= beg (overlay-start ov)) + (= end (overlay-end ov)) + (plist-get (overlay-properties ov) 'invisible)) + ;; Assume this is the overlay added by `ansi-color-apply-on-region' + (delete-overlay ov)))))))) + +(add-hook 'org-mode-hook #'org-ansi-mode) + \f ;;;; CDLaTeX minor mode -- 2.39.1 [-- Attachment #4: Type: text/plain, Size: 15 bytes --] -- Nathaniel ^ permalink raw reply related [flat|nested] 33+ messages in thread
* Re: [PATCH] Highlight ANSI sequences in the whole buffer (was [PATCH] ANSI color on example blocks and fixed width elements) 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 2023-12-14 14:37 ` Ihor Radchenko 1 sibling, 2 replies; 33+ messages in thread From: Ihor Radchenko @ 2023-12-14 14:34 UTC (permalink / raw) To: Nathaniel Nicandro; +Cc: emacs-orgmode Nathaniel Nicandro <nathanielnicandro@gmail.com> writes: > Attached is the updated version of the patch. I've also attached an > updated file that I've been using for testing the feature. Sorry for the late reply, and thanks for the patch! It runs fine on my side, although I am not sure if things are working as expected for all the cases. For example, headlines never got fontified on my side when I tried your patch on top of the latest main branch. Also, it looks like you simply made the ASCII sequences invisible, which causes funky behaviour when trying to edit the text around. What we may need instead is something similar to hidden parts of the links that get revealed when we try to edit the invisible text. See `org-catch-invisible-edits' variable and the functions that examine it. > What I have is essentially a function, org-fontify-ansi-sequences, that > scans the buffer for an ANSI sequence and depending on the > element-context processes the region that should be affected according > to the rules you stated (see above). The org-fontify-ansi-sequences-1 > function scans the buffer element-wise and processes the appropriate > regions of the elements, even if no sequences appear in those regions, > according to an ansi-context. This is to support the fourth rule you > mentioned. > > Note that modifications to highlighted regions hasn't really been > considered so if you have a scenario like > > #+RESULTS: > - <ANSI>Paragraph one > - Paragraph two > Line 3 > > where the sequence affects everything down to "Line 3" and you make a > modification to line three, the fontification due to the sequence > disappears on that line. You may use `org-fontify-extend-region' to handle such scenarios if you mark the ANSI highlights with a special text property. > Also note that lesser elements contained in greater elements that > don't have a RESULTS keyword are handled at the lesser element level > so if you have something like > > #+begin_center > Paragraph <ANSI>one. > > Paragraph two. > #+end_center > > It would be the same as if you just had the paragraphs without the > greater element. Sounds reasonable. P.S. I am not yet commenting on the details in the code. -- Ihor Radchenko // yantar92, Org mode contributor, Learn more about Org mode at <https://orgmode.org/>. Support Org development at <https://liberapay.com/org-mode>, or support my work at <https://liberapay.com/yantar92> ^ permalink raw reply [flat|nested] 33+ messages in thread
* Re: [PATCH] Highlight ANSI sequences in the whole buffer (was [PATCH] ANSI color on example blocks and fixed width elements) 2023-12-14 14:34 ` Ihor Radchenko @ 2023-12-24 12:49 ` Nathaniel Nicandro 2024-01-17 0:02 ` Nathaniel Nicandro 1 sibling, 0 replies; 33+ messages in thread From: Nathaniel Nicandro @ 2023-12-24 12:49 UTC (permalink / raw) To: Ihor Radchenko; +Cc: Nathaniel Nicandro, emacs-orgmode Ihor Radchenko <yantar92@posteo.net> writes: > It runs fine on my side, although I am not sure if things are working as > expected for all the cases. For example, headlines never got fontified > on my side when I tried your patch on top of the latest main branch. Yes, the headlines are currently not fontified since, with this patch, I was mainly looking to satisfy the initial set of rules you laid out which didn't mention headlines as being a fontifiable element for ANSI sequences, or at least I didn't get that from my reading of them. It does make sense, however, to be able to add headlines to the `org-ansi-highlightable-elements` variable so that they are fontified if the user wishes. Although doing so with this patch wouldn't work. > Also, it looks like you simply made the ASCII sequences invisible, which > causes funky behaviour when trying to edit the text around. What we may > need instead is something similar to hidden parts of the links that get > revealed when we try to edit the invisible text. See > `org-catch-invisible-edits' variable and the functions that examine it. I agree that we should reveal the invisible sequence when trying to edit it. Thanks for the tip about `org-catch-invisible-edits', it led me to `org-fold-show-set-visibility' which I think is the appropriate place to reveal a hidden sequence. > You may use `org-fontify-extend-region' to handle such scenarios if you > mark the ANSI highlights with a special text property. Thanks for the tip, I'll look into it. -- Nathaniel ^ permalink raw reply [flat|nested] 33+ messages in thread
* Re: [PATCH] Highlight ANSI sequences in the whole buffer (was [PATCH] ANSI color on example blocks and fixed width elements) 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 1 sibling, 1 reply; 33+ messages in thread From: Nathaniel Nicandro @ 2024-01-17 0:02 UTC (permalink / raw) To: Ihor Radchenko; +Cc: Nathaniel Nicandro, emacs-orgmode [-- Attachment #1: Type: text/plain, Size: 4945 bytes --] Ihor Radchenko <yantar92@posteo.net> writes: Hello, attached is another updated patch with the following changes: - Made it possible to add headlines or inline tasks to `org-ansi-highlightable-elements', these are added by default now. - To tackle the issue discussed previously about highlights spanning multiple lines (or elements) being removed when a line is modified I went ahead and used the font-lock-multiline property (see font-lock-extend-region-multiline and font-lock-extend-region-functions) across those regions so that on any edit of one of the lines, the region including all of the ANSI sequences that affect that line will be re-fontified. This was the easier solution, but the downside is that it can cause large regions to be re-fontified when really all we want to do is apply the highlighting face to a small line change, for example. An alternative solution would, when no ANSI sequences are being edited in the region being fontified and assuming a previous fontification cycle has applied highlights due to ANSI sequences already, only apply the highlighting face to the edited region instead of expanding the region before fontification. The expansion unnecessarily wastes the fontification cycle on a region larger than what it needs to be since the information needed for highlighting the region according to ANSI sequences has already been computed on a previous fontification cycle. In practice I don't think this inefficiency will matter much since I would assume most of these ANSI sequences will be inserted due to the results of code block execution or inserted by users who want to highlight small regions of the document so I would consider this problem solved by using font-lock-multiline for the time being. WDYT? - To tackle the issue of editing around the invisible ANSI sequences I left it up to the font-lock process to catch the invisible edits. Whenever an edit deletes a character of the sequence that renders the sequence invalid, the font-lock process will reveal the partial sequence. But I had to limit what was considered a valid ANSI sequence to get it working in a somewhat acceptable way. The problem that I found was that if the buffer contains something like ^[[43mfoo (where ^[ is the ESC character and can be inserted with "C-q ESC" and the whole sequence ^[[43m is the ANSI sequence) what was happening was that deleting into the hidden sequence would leave the region in the state ^[[43foo and because the end byte of the ANSI sequence can be any character in the ASCII range [@A-Z[\]^_`a–z{|}~], ^[[43f would still be a valid ANSI sequence and would be hidden during the fontification process after the edit. Since `ansi-color-apply-on-region' only really handles the sequences that end in an m byte, just rendering all other ones invisible, I limited the ANSI sequences handled by this patch to be only those sequences that end in m. This way, after deleting into the sequence like in the above example the fontification process would not recognize the region as containing any sequence. The downside to this solution is that sequences that end in any other end byte won't get conveniently hidden and the problem still persists if you have text that starts with an m and you delete into a hidden sequence. An alternative solution that doesn't constrain the end byte could be to add in some extra invisible character like a zero width space and then use something like the `modification-hooks' text property on the character to signify that a deletion at the boundary between the sequence and the text should really delete part of the sequence instead of the zero width space. I haven't really worked out the details of this, for example how would it be detected which direction a deletion is coming from, the front or behind, but I'm throwing it out there to see if there are any other solutions other people might be aware of for a similar problem. - Finally, code has been added to delete the overlays on the hidden sequences in `org-unfontify-region' so that multiple overlays are not created on re-fontifying regions containing those sequences. Other than that, the code is the same as the last patch. > P.S. I am not yet commenting on the details in the code. Please let me know what you think of this patch and where I should be focusing my efforts moving forward to get this submitted to Org. 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? [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: Patch --] [-- Type: text/x-patch, Size: 15586 bytes --] From 506e8c1e5a177b797a541b1541ea98c95668d5e1 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. * 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): New customization variables. (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): New functions. (org-ansi--control-seq-regexp): New variable. (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 | 12 +++ lisp/org.el | 269 +++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 281 insertions(+) diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS index 1207d6f..76a81e3 100644 --- a/etc/ORG-NEWS +++ b/etc/ORG-NEWS @@ -492,6 +492,18 @@ Currently implemented options are: iCalendar programs support this usage. ** 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. + *** =ob-plantuml.el=: Support tikz file format output =ob-plantuml.el= now output =tikz= :file format via diff --git a/lisp/org.el b/lisp/org.el index d2cd0b9..6e4744e 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) @@ -3608,6 +3609,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 @@ -5598,6 +5605,243 @@ (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) + +(defun org-ansi-new-context (pos) + (list (list (make-bool-vector 8 nil) + nil nil) + (copy-marker pos))) + +;; Only match color sequences (escape codes ending with an m). +;; +;; This effectively means that other control sequences won't get +;; conveniently hidden. +(defvar org-ansi--control-seq-regexp "\e\\[[\x30-\x3F]*[\x20-\x2F]*m") + +(defun org-ansi-process-region (beg end &optional context) + (or context (setq context (org-ansi-new-context beg))) + (move-marker (cadr context) beg) + (let ((ansi-color-context-region context) + (ansi-color-control-seq-regexp org-ansi--control-seq-regexp) + (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)) + (save-excursion + (goto-char beg) + (while (re-search-forward org-ansi--control-seq-regexp end 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' + (overlay-put ov 'org-ansi t))))))) + +(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 org-ansi--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-activate-footnote-links (limit) "Add text properties for footnotes." (let ((fn (org-footnote-next-reference-or-definition limit))) @@ -5915,6 +6159,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 @@ -6094,6 +6339,9 @@ (defun org-unfontify-region (beg end &optional _maybe_loudly) '(mouse-face t keymap t org-linked-text t invisible t intangible t org-emphasis t)) + (dolist (ov (overlays-in beg end)) + (when (overlay-get ov 'org-ansi) + (delete-overlay ov))) (org-fold-region beg end nil 'org-link) (org-fold-region beg end nil 'org-link-description) (org-fold-core-update-optimisation beg end) @@ -15582,6 +15830,27 @@ (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" + (org-restart-font-lock) + (unless org-ansi-mode + (org-with-wide-buffer + (goto-char (point-min)) + (while (re-search-forward org-ansi--control-seq-regexp nil t) + (dolist (ov (overlays-at (match-beginning 0))) + (when (overlay-get ov 'org-ansi) + (delete-overlay ov))))))) + +(add-hook 'org-mode-hook #'org-ansi-mode) + \f ;;;; CDLaTeX minor mode -- 2.39.1 [-- Attachment #3: Type: text/plain, Size: 15 bytes --] -- Nathaniel ^ permalink raw reply related [flat|nested] 33+ messages in thread
* Re: [PATCH] Highlight ANSI sequences in the whole buffer (was [PATCH] ANSI color on example blocks and fixed width elements) 2024-01-17 0:02 ` Nathaniel Nicandro @ 2024-01-17 12:36 ` Ihor Radchenko 2024-03-26 14:02 ` Nathaniel Nicandro 0 siblings, 1 reply; 33+ messages in thread From: Ihor Radchenko @ 2024-01-17 12:36 UTC (permalink / raw) To: Nathaniel Nicandro; +Cc: emacs-orgmode Nathaniel Nicandro <nathanielnicandro@gmail.com> writes: > Hello, attached is another updated patch with the following changes: Thanks! > - To tackle the issue discussed previously about highlights spanning > multiple lines (or elements) being removed when a line is modified I > went ahead and used the font-lock-multiline property (see > font-lock-extend-region-multiline and > font-lock-extend-region-functions) across those regions so that on > any edit of one of the lines, the region including all of the ANSI > sequences that affect that line will be re-fontified. This was the > easier solution, but the downside is that it can cause large regions > to be re-fontified when really all we want to do is apply the > highlighting face to a small line change, for example. This is fine. > - To tackle the issue of editing around the invisible ANSI sequences I > left it up to the font-lock process to catch the invisible edits. > Whenever an edit deletes a character of the sequence that renders > the sequence invalid, the font-lock process will reveal the partial > sequence. But I had to limit what was considered a valid ANSI > sequence to get it working in a somewhat acceptable way. > > The problem that I found was that if the buffer contains something > like > > ^[[43mfoo > > (where ^[ is the ESC character and can be inserted with "C-q ESC" and > the whole sequence ^[[43m is the ANSI sequence) what was happening was > that deleting into the hidden sequence would leave the region in the > state > > ^[[43foo > > and because the end byte of the ANSI sequence can be any character > in the ASCII range [@A-Z[\]^_`a–z{|}~], ^[[43f would still be a > valid ANSI sequence and would be hidden during the fontification > process after the edit. Since `ansi-color-apply-on-region' only > really handles the sequences that end in an m byte, just rendering > all other ones invisible, I limited the ANSI sequences handled by > this patch to be only those sequences that end in m. This way, > after deleting into the sequence like in the above example the > fontification process would not recognize the region as containing > any sequence. The downside to this solution is that sequences that > end in any other end byte won't get conveniently hidden and the > problem still persists if you have text that starts with an m and > you delete into a hidden sequence. Makes sense. We may also make hiding ^[[43foo as customization disabled by default. > An alternative solution that doesn't constrain the end byte could be > to add in some extra invisible character like a zero width space and > then use something like the `modification-hooks' text property on > the character to signify that a deletion at the boundary between the > sequence and the text should really delete part of the sequence > instead of the zero width space. I haven't really worked out the > details of this, for example how would it be detected which > direction a deletion is coming from, the front or behind, but I'm > throwing it out there to see if there are any other solutions other > people might be aware of for a similar problem. If you want to go in this direction, check out `org-fold-check-before-invisible-edit'. We can unfontify the escape sequence from there and font-lock will re-apply only during the next editing cycle, making the sequence visible temporarily. Not mandatory though. >> P.S. I am not yet commenting on the details in the code. > > Please let me know what you think of this patch and where I should be > focusing my efforts moving forward to get this submitted to Org. 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. 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. > 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. -- Ihor Radchenko // yantar92, Org mode contributor, Learn more about Org mode at <https://orgmode.org/>. Support Org development at <https://liberapay.com/org-mode>, or support my work at <https://liberapay.com/yantar92> ^ permalink raw reply [flat|nested] 33+ messages in thread
* Re: [PATCH] Highlight ANSI sequences in the whole buffer (was [PATCH] ANSI color on example blocks and fixed width elements) 2024-01-17 12:36 ` Ihor Radchenko @ 2024-03-26 14:02 ` Nathaniel Nicandro 2024-03-28 8:52 ` Ihor Radchenko 0 siblings, 1 reply; 33+ messages in thread From: Nathaniel Nicandro @ 2024-03-26 14:02 UTC (permalink / raw) To: Ihor Radchenko; +Cc: Nathaniel Nicandro, emacs-orgmode [-- 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 ^ permalink raw reply related [flat|nested] 33+ messages in thread
* Re: [PATCH] Highlight ANSI sequences in the whole buffer (was [PATCH] ANSI color on example blocks and fixed width elements) 2024-03-26 14:02 ` Nathaniel Nicandro @ 2024-03-28 8:52 ` Ihor Radchenko 2024-06-29 10:42 ` Ihor Radchenko 0 siblings, 1 reply; 33+ messages in thread From: Ihor Radchenko @ 2024-03-28 8:52 UTC (permalink / raw) To: Nathaniel Nicandro; +Cc: emacs-orgmode Nathaniel Nicandro <nathanielnicandro@gmail.com> writes: > Feedback appreciated! Thanks for the update! > 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 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. This is very fragile. I believe that hooking into `org-fold-check-before-invisible-edit' would lead to simpler implementation. I also do not like the idea that fontification code modifies the buffer. I tried your latest patch with test-ansi.org file you shared earlier: 1. Open the file and move to the end of the headline "Greater elements" 2. <backspace> <space> 3. Observe fontification extending past the title. 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 also observed strange glitches and hangs when I tried to surround an ANSI-colored region like =[42mtask 1[0m= and then edited near the boundaries. -- Ihor Radchenko // yantar92, Org mode contributor, Learn more about Org mode at <https://orgmode.org/>. Support Org development at <https://liberapay.com/org-mode>, or support my work at <https://liberapay.com/yantar92> ^ permalink raw reply [flat|nested] 33+ messages in thread
* Re: [PATCH] Highlight ANSI sequences in the whole buffer (was [PATCH] ANSI color on example blocks and fixed width elements) 2024-03-28 8:52 ` Ihor Radchenko @ 2024-06-29 10:42 ` Ihor Radchenko 2024-07-01 18:39 ` Nathaniel Nicandro 0 siblings, 1 reply; 33+ messages in thread From: Ihor Radchenko @ 2024-06-29 10:42 UTC (permalink / raw) To: Nathaniel Nicandro; +Cc: emacs-orgmode 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? -- Ihor Radchenko // yantar92, Org mode contributor, Learn more about Org mode at <https://orgmode.org/>. Support Org development at <https://liberapay.com/org-mode>, or support my work at <https://liberapay.com/yantar92> ^ permalink raw reply [flat|nested] 33+ messages in thread
* Re: [PATCH] Highlight ANSI sequences in the whole buffer (was [PATCH] ANSI color on example blocks and fixed width elements) 2024-06-29 10:42 ` Ihor Radchenko @ 2024-07-01 18:39 ` Nathaniel Nicandro 2024-07-06 13:28 ` Ihor Radchenko 0 siblings, 1 reply; 33+ messages in thread From: Nathaniel Nicandro @ 2024-07-01 18:39 UTC (permalink / raw) To: Ihor Radchenko; +Cc: emacs-orgmode [-- 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 ^ permalink raw reply related [flat|nested] 33+ messages in thread
* Re: [PATCH] Highlight ANSI sequences in the whole buffer (was [PATCH] ANSI color on example blocks and fixed width elements) 2024-07-01 18:39 ` Nathaniel Nicandro @ 2024-07-06 13:28 ` Ihor Radchenko 2024-07-16 20:53 ` Nathaniel Nicandro 2024-07-17 22:50 ` Nathaniel Nicandro 0 siblings, 2 replies; 33+ messages in thread From: Ihor Radchenko @ 2024-07-06 13:28 UTC (permalink / raw) To: Nathaniel Nicandro; +Cc: emacs-orgmode Nathaniel Nicandro <nathanielnicandro@gmail.com> writes: >> 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. Thanks for the update! And for the resilience working on this difficult 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 do not like the idea of introducing extra global state variables. What about let-binding `org-ansi-hide-sequences' in (let (org-hide-emphasis-markers ... (region (or (org-find-text-property-region (point) 'org-emphasis) ...))) ... (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)))))) > 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. Redisplay is a bit tricky in `org-fold-show-set-visibility' (see "FIXME" comment). Let's leave it be for now, until the patch gets closer to its final state. Just add a "FIXME:" comment somewhere near the relevant code, so that we do not forget about this issue. > 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. We actually discussed a similar problem with links recently: https://list.orgmode.org/orgmode/20240428093320.120843ae@enoush2o/ The general conclusion we came to was that whatever smart behavior we may came up with will confuse users. Probably, the most predictable approach would be either doing the same thing as what https://github.com/awth13/org-appear or some variant of it that also does not rely on fiddling with redisplay and/or fontification. Even what we do in `org-fold-show-set-visibility' is sometimes confusing to the users. TL;DR: Do not worry about this problem - it should be solved in more general context, for the whole Org. > 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. Let's drop the part with modifications/visibility changes. It should not be a job for fontification function, so let's not complicate things (as I mentioned above). I believe that 'org-ansi may no longer be needed once we drop this. > ... > - 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. I believe that `font-lock-extend-region-functions' should be able to tackle this situation. Is there any problem with it? (The rest of logic sounds reasonable, although I did not yet dive into the code) -- Ihor Radchenko // yantar92, Org mode contributor, Learn more about Org mode at <https://orgmode.org/>. Support Org development at <https://liberapay.com/org-mode>, or support my work at <https://liberapay.com/yantar92> ^ permalink raw reply [flat|nested] 33+ messages in thread
* Re: [PATCH] Highlight ANSI sequences in the whole buffer (was [PATCH] ANSI color on example blocks and fixed width elements) 2024-07-06 13:28 ` Ihor Radchenko @ 2024-07-16 20:53 ` Nathaniel Nicandro 2024-07-17 22:50 ` Nathaniel Nicandro 1 sibling, 0 replies; 33+ messages in thread From: Nathaniel Nicandro @ 2024-07-16 20:53 UTC (permalink / raw) To: Ihor Radchenko; +Cc: emacs-orgmode Ihor Radchenko <yantar92@posteo.net> writes: > Thanks for the update! And for the resilience working on this difficult > patch :) It has been giving me some trouble :) > I believe that `font-lock-extend-region-functions' should be able to > tackle this situation. Is there any problem with it? I think I have been able to come up with a solution using it. -- Nathaniel ^ permalink raw reply [flat|nested] 33+ messages in thread
* Re: [PATCH] Highlight ANSI sequences in the whole buffer (was [PATCH] ANSI color on example blocks and fixed width elements) 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 1 sibling, 1 reply; 33+ messages in thread From: Nathaniel Nicandro @ 2024-07-17 22:50 UTC (permalink / raw) To: Ihor Radchenko; +Cc: emacs-orgmode Ihor Radchenko <yantar92@posteo.net> writes: >> 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. > > Let's drop the part with modifications/visibility changes. It should not > be a job for fontification function, so let's not complicate things (as > I mentioned above). I believe that 'org-ansi may no longer be needed > once we drop this. > 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? What should I do instead? If I remove the code for the modification changes, then it would be difficult to edit the sequences when `org-ansi-hide-sequences` is t since they would remain invisible while editing. -- Nathaniel ^ permalink raw reply [flat|nested] 33+ messages in thread
* Re: [PATCH] Highlight ANSI sequences in the whole buffer (was [PATCH] ANSI color on example blocks and fixed width elements) 2024-07-17 22:50 ` Nathaniel Nicandro @ 2024-07-20 17:57 ` Ihor Radchenko 2024-11-17 23:17 ` Nathaniel Nicandro 0 siblings, 1 reply; 33+ messages in thread From: Ihor Radchenko @ 2024-07-20 17:57 UTC (permalink / raw) To: Nathaniel Nicandro; +Cc: emacs-orgmode Nathaniel Nicandro <nathanielnicandro@gmail.com> writes: >> Let's drop the part with modifications/visibility changes. It should not >> be a job for fontification function, so let's not complicate things (as >> I mentioned above). I believe that 'org-ansi may no longer be needed >> once we drop this. >> > > 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. > What should I do instead? If I remove the code for the modification > changes, then it would be difficult to edit the sequences when > `org-ansi-hide-sequences` is t since they would remain invisible while > editing. For now, let's default `org-ansi-hide-sequences' to nil. For the value of t, we should use a more general solution. For example, I can, in the future, implement a clone of hl-line-mode that will reveal markup on the current line. It will be an easy an effective solution to edit hidden markup like convoluted links, emphasis, and ANSI markup. -- Ihor Radchenko // yantar92, Org mode contributor, Learn more about Org mode at <https://orgmode.org/>. Support Org development at <https://liberapay.com/org-mode>, or support my work at <https://liberapay.com/yantar92> ^ permalink raw reply [flat|nested] 33+ messages in thread
* Re: [PATCH] Highlight ANSI sequences in the whole buffer (was [PATCH] ANSI color on example blocks and fixed width elements) 2024-07-20 17:57 ` Ihor Radchenko @ 2024-11-17 23:17 ` Nathaniel Nicandro 2024-11-23 16:21 ` Ihor Radchenko 0 siblings, 1 reply; 33+ messages in thread From: Nathaniel Nicandro @ 2024-11-17 23:17 UTC (permalink / raw) To: Ihor Radchenko; +Cc: emacs-orgmode [-- 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 ^ permalink raw reply related [flat|nested] 33+ messages in thread
* Re: [PATCH] Highlight ANSI sequences in the whole buffer (was [PATCH] ANSI color on example blocks and fixed width elements) 2024-11-17 23:17 ` Nathaniel Nicandro @ 2024-11-23 16:21 ` Ihor Radchenko 2024-12-01 8:01 ` Nathaniel Nicandro 0 siblings, 1 reply; 33+ messages in thread From: Ihor Radchenko @ 2024-11-23 16:21 UTC (permalink / raw) To: Nathaniel Nicandro; +Cc: emacs-orgmode Nathaniel Nicandro <nathanielnicandro@gmail.com> writes: > I've gotten around to working on this again. Sorry for the long > periods between updates. No problem. Thanks for the update! I will need some time to review the patch. It would be helpful for the review if all the functions had a docstring and the data structure for CONTEXT were described in commentary. -- Ihor Radchenko // yantar92, Org mode contributor, Learn more about Org mode at <https://orgmode.org/>. Support Org development at <https://liberapay.com/org-mode>, or support my work at <https://liberapay.com/yantar92> ^ permalink raw reply [flat|nested] 33+ messages in thread
* Re: [PATCH] Highlight ANSI sequences in the whole buffer (was [PATCH] ANSI color on example blocks and fixed width elements) 2024-11-23 16:21 ` Ihor Radchenko @ 2024-12-01 8:01 ` Nathaniel Nicandro 2024-12-16 17:27 ` Ihor Radchenko 0 siblings, 1 reply; 33+ messages in thread From: Nathaniel Nicandro @ 2024-12-01 8:01 UTC (permalink / raw) To: Ihor Radchenko; +Cc: emacs-orgmode [-- Attachment #1: Type: text/plain, Size: 330 bytes --] Ihor Radchenko <yantar92@posteo.net> writes: > I will need some time to review the patch. It would be helpful for the > review if all the functions had a docstring and the data structure for > CONTEXT were described in commentary. Attached is an updated patch with all functions documented and more comments about the CONTEXT. [-- Attachment #2: patch --] [-- Type: text/x-patch, Size: 52474 bytes --] From 23706b527f44e5e36f020919df0717ab6005e055 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, org-ansi-point-context) (org-ansi-result-element) (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 | 743 ++++++++++++++++++++++++++++++++++++++- testing/lisp/test-org.el | 313 +++++++++++++++++ 3 files changed, 1072 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..c833027 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,715 @@ (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 highlighted. +ANSI sequences in elements not in this list will not be highlighted." + :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 highlighted. +ANSI sequences in objects not in this list will not be highlighted." + :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', i.e. a list of the form + + (BASIC-FACES FG BG) + +where BASIC-FACES is a `bool-vector' and FG and BG integers +representing the foreground and background colors of the context +or nil.") +(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) + "Return an integer representing CONTEXT. +CONTEXT is of the form of `org-ansi-context' and its information +is packed into an integer representation so that it can be stored +as the `org-ansi-context' text property of highlighted regions. + +The format is <BASIC-FACES><FG><FG-EMPTY><BG><BG-EMPTY> where +<BASIC-FACES> are the 8 bits of the `bool-vector' representing +the switches that can be turned on for ANSI sequences, +e.g. underline. <FG> (<BG>) are 24 bits for the +foreground (background) color and <FG-EMPTY> (<BG-EMPTY>) is 1 +bit representing whether or not there is a +foreground (background) color present for the context." + ;; NOTE: The alternative to packing the context into an integer + ;; would be storing a copy of the context directly as the + ;; `org-ansi-context' property of the highlighted regions. There + ;; would be a large memory overhead though with that approach since + ;; every highlighted region would have a context list as the + ;; property and there can be many highlighted regions, for example + ;; the ANSI codes in Python backtraces. + (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) + "Return INT in an unpacked form assuming it is a packed `org-ansi-context'. +Return a list in the same format as `org-ansi-context' which see. +See also `org-ansi-pack-context'." + (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) + "Return non-nil if some of the effect of A is contained in B. +A and B are assumed to be integer representations of an +`org-ansi-context', see `org-ansi-pack-context'." + (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))))) + (when-let* ((fg-a (funcall get 'fg a))) + (eq fg-a (funcall get 'fg b))) + (when-let* ((bg-a (funcall get 'bg a))) + (eq bg-a (funcall get 'bg b)))))) + +(defun org-ansi-previous-context (pos limit) + "Return the `org-ansi-context' property before POS. +Search before POS down to LIMIT for the first non-nil +`org-ansi-context' property and return its value. If there is no +non-nil property after LIMIT, return nil." + (let ((pos (save-excursion + (goto-char pos) + ;; Return a position before `point' containing a + ;; non-nil `org-ansi-context' property. + (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))))) + (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-result-element 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-result-element (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-result-element 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) + "Return the `org-ansi-result-element' of EL and its processing end. +Specifically return a list (ELEM END) where ELEM is either the +`org-ansi-result-element' of EL or EL itself if that is nil and +END is the processing limit of ELEM." + (if-let ((parent (org-ansi-result-element 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 () + "A `font-lock-extend-region-functions' function specific for ANSI sequences. +This handles two cases, extending due to deletions or +modifications of ANSI sequences between font-lock cycles and +extending due to splits of elements into multiple other elements +between font-lock cycles. The latter handling takes care of +cases where the bounds of the effects of sequences can be altered +due to the splitting of elements between font-lock cycles, +e.g. one paragraph into two." + (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 with a + ;; RESULTS affiliated keyword.. 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 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 +6687,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 +6876,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 +16667,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 ^ permalink raw reply related [flat|nested] 33+ messages in thread
* Re: [PATCH] Highlight ANSI sequences in the whole buffer (was [PATCH] ANSI color on example blocks and fixed width elements) 2024-12-01 8:01 ` Nathaniel Nicandro @ 2024-12-16 17:27 ` Ihor Radchenko 0 siblings, 0 replies; 33+ messages in thread From: Ihor Radchenko @ 2024-12-16 17:27 UTC (permalink / raw) To: Nathaniel Nicandro; +Cc: emacs-orgmode Nathaniel Nicandro <nathanielnicandro@gmail.com> writes: > Ihor Radchenko <yantar92@posteo.net> writes: > >> I will need some time to review the patch. It would be helpful for the >> review if all the functions had a docstring and the data structure for >> CONTEXT were described in commentary. > > Attached is an updated patch with all functions documented and more > comments about the CONTEXT. Thanks! This is getting really complicated. Looking at your code, I can see that you are basically re-implementing what I have done in https://git.sr.ht/~yantar92/org-mode/tree/feature/org-font-lock-element/item/lisp/org-font-lock-core.el#L220 and in https://git.sr.ht/~yantar92/org-mode/tree/feature/org-font-lock-element/item/lisp/org-element.el#L4580 There are also problems I do see, like unnecessary special cases handling fixed width - affiliated keywords may be present in many more elements, which your code may fail with. There may be more. I feel that the right approach would be implementing generic parser-based fontification first, and then using its APIs for ANSI fontification. But I have no idea when I can have more hours in the day to actually work on that feature branch. What about the following idea: 1. To make use of the working code you provided, let's split it up into an ELPA package. It seems to be possible. 2. When we get the parser-based fontification with finalized APIs, we can come back to merging your code upstream. WDYT? -- Ihor Radchenko // yantar92, Org mode maintainer, Learn more about Org mode at <https://orgmode.org/>. Support Org development at <https://liberapay.com/org-mode>, or support my work at <https://liberapay.com/yantar92> ^ permalink raw reply [flat|nested] 33+ messages in thread
* Re: [PATCH] Highlight ANSI sequences in the whole buffer (was [PATCH] ANSI color on example blocks and fixed width elements) 2023-11-17 21:18 ` Nathaniel Nicandro 2023-12-14 14:34 ` Ihor Radchenko @ 2023-12-14 14:37 ` Ihor Radchenko 2023-12-15 12:50 ` Matt 1 sibling, 1 reply; 33+ messages in thread From: Ihor Radchenko @ 2023-12-14 14:37 UTC (permalink / raw) To: Nathaniel Nicandro, Matt; +Cc: emacs-orgmode Nathaniel Nicandro <nathanielnicandro@gmail.com> writes: > From 66baf6e1d435974fb4c51cc47eb5b3ace3feb22c 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 Matthew, this thread might be of interest for you as the new feature is largely aiming at the shell block output. Feel free to jump in if you have comments on the design of the ASCII fontification for complex shell block output. -- Ihor Radchenko // yantar92, Org mode contributor, Learn more about Org mode at <https://orgmode.org/>. Support Org development at <https://liberapay.com/org-mode>, or support my work at <https://liberapay.com/yantar92> ^ permalink raw reply [flat|nested] 33+ messages in thread
* Re: [PATCH] Highlight ANSI sequences in the whole buffer (was [PATCH] ANSI color on example blocks and fixed width elements) 2023-12-14 14:37 ` Ihor Radchenko @ 2023-12-15 12:50 ` Matt 2023-12-25 2:20 ` Nathaniel Nicandro 0 siblings, 1 reply; 33+ messages in thread From: Matt @ 2023-12-15 12:50 UTC (permalink / raw) To: Ihor Radchenko; +Cc: Nathaniel Nicandro, emacs-orgmode ---- On Thu, 14 Dec 2023 15:35:13 +0100 Ihor Radchenko wrote --- > Matthew, this thread might be of interest for you as the new feature is > largely aiming at the shell block output. > Feel free to jump in if you have comments on the design of the > ASCII fontification for complex shell block output. Thank you for bringing this to my attention and thank you Nathaniel for your work on this. I have no comments on the design presently (my knowledge of Emacs fontification is currently limited) and my current priorities prevent me from dedicating the time this topic deserves. I think the topic is interesting and important. I've had issues with ANSI escape codes (in particular progress bars) in source block results. I made a note to return to this thread in case the escape codes don't bring me back :) Nathaniel, if you and I happen to cross paths in one of Ihor's "office hours," I would enjoy learning more about what you're doing. ^ permalink raw reply [flat|nested] 33+ messages in thread
* Re: [PATCH] Highlight ANSI sequences in the whole buffer (was [PATCH] ANSI color on example blocks and fixed width elements) 2023-12-15 12:50 ` Matt @ 2023-12-25 2:20 ` Nathaniel Nicandro 0 siblings, 0 replies; 33+ messages in thread From: Nathaniel Nicandro @ 2023-12-25 2:20 UTC (permalink / raw) To: Matt; +Cc: Ihor Radchenko, Nathaniel Nicandro, emacs-orgmode Matt <matt@excalamus.com> writes: > Thank you for bringing this to my attention and thank you Nathaniel for your work on this. No problem, I'm glad to contribute to Org :) > Nathaniel, if you and I happen to cross paths in one of Ihor's "office > hours," I would enjoy learning more about what you're doing. Sure. With this patch I'm attempting to fontify the regions bounded by ANSI escape sequences (just the color codes) in an Org buffer using the built-in ansi-color package to do the processing of the sequences. The challenge, for me, seems to be making ansi-color aware of Org element/object boundaries. I am aware of other ANSI escape codes that would be useful to process such as the carriage return and which appear, as you mentioned, when dealing with progress bars in a shell session. Those escape codes are not being handled at the moment. Although, I do have some experience in processing them in an Org buffer when developing my Emacs-Jupyter project. I would be glad to attempt handling these kinds of sequences in Org proper as well. -- Nathaniel ^ permalink raw reply [flat|nested] 33+ messages in thread
end of thread, other threads:[~2024-12-16 17:27 UTC | newest] Thread overview: 33+ messages (download: mbox.gz follow: Atom feed -- links below jump to the message on this page -- 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 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 2024-11-17 23:17 ` Nathaniel Nicandro 2024-11-23 16:21 ` Ihor Radchenko 2024-12-01 8:01 ` Nathaniel Nicandro 2024-12-16 17:27 ` Ihor Radchenko 2023-12-14 14:37 ` Ihor Radchenko 2023-12-15 12:50 ` Matt 2023-12-25 2:20 ` Nathaniel Nicandro
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).