From ea2345ab218d3bc9c07452b2171afc1361b74b9d Mon Sep 17 00:00:00 2001 From: Nathaniel Nicandro 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 + "\\