From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp1.migadu.com ([2001:41d0:403:58f0::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms13.migadu.com with LMTPS id 6NXJLBogTGd7wQAA62LTzQ:P1 (envelope-from ) for ; Sun, 01 Dec 2024 08:36:42 +0000 Received: from aspmx1.migadu.com ([2001:41d0:403:58f0::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp1.migadu.com with LMTPS id 6NXJLBogTGd7wQAA62LTzQ (envelope-from ) for ; Sun, 01 Dec 2024 09:36:42 +0100 X-Envelope-To: larch@yhetil.org Authentication-Results: aspmx1.migadu.com; dkim=fail ("body hash did not verify") header.d=gmail.com header.s=20230601 header.b=Bt+blob1; spf=pass (aspmx1.migadu.com: domain of "emacs-orgmode-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="emacs-orgmode-bounces+larch=yhetil.org@gnu.org"; dmarc=fail reason="SPF not aligned (relaxed)" header.from=gmail.com (policy=none) ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=yhetil.org; s=key1; t=1733042202; h=from:from:sender:sender:reply-to:subject:subject:date:date: message-id:message-id:to:to:cc:cc:mime-version:mime-version: content-type:content-type:in-reply-to:in-reply-to: references:references:list-id:list-help:list-unsubscribe: list-subscribe:list-post:dkim-signature; bh=DVob8mQ/xkWEiDNJrEK+w+GPkPaRnZeNYU7YNPC4SaI=; b=n8fv4F+669Hg2oredX9MxwMet3ziINwf0HzTNXlN0fvyrbY9iS0RMj3XzviybNB4LzlWXL 0fm1yPokwzqWMGWZUsIUo1QUdNO6enKY9EduaTAotcScwszm6g6+XavpcFYQomCgd9j2bZ aRl3EXEALgMByOfOgPpRP6TKtr3n94u+TS31pxmpZrR2WgfvoeP7VaQu840+E+SFECo8WX vq3Mm42MYpe4EbKabyFmzLxs41dP4OhVy+asXysZcp1th2Z8GT6trr42+Zzt2zeif8w62w eoL5lVPYFl1icvBJ8ns3OHhoxDWi4Pabt4nu+ChGwn/PMQpUpTpWE8C33L9hwQ== ARC-Authentication-Results: i=1; aspmx1.migadu.com; dkim=fail ("body hash did not verify") header.d=gmail.com header.s=20230601 header.b=Bt+blob1; spf=pass (aspmx1.migadu.com: domain of "emacs-orgmode-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="emacs-orgmode-bounces+larch=yhetil.org@gnu.org"; dmarc=fail reason="SPF not aligned (relaxed)" header.from=gmail.com (policy=none) ARC-Seal: i=1; s=key1; d=yhetil.org; t=1733042202; a=rsa-sha256; cv=none; b=clnEAghis0zRMjgfWYv846c9ReZBFTuREi8F9kzXOk2+SHiorPQy3SChQUd8McAPCPCyEQ friCkj0ZlKIVlDuAa0XDPH/kyDEamwYU5TKdzRrof8YN9vu/AYEI8b5XohxooiZl38sgUA UNdk2tcsJaqXfhnV6oSy27tsKXC6dcqYE0UkzLLoYaPmDnEND6g7diJhWpaunTWCnrCfZB rCYevL80j5gWSJZ4Rwv4SF9oxXaz/nsU8OHRpbUgbSLSnHqryRIWhedHqJ+PpQrKnQjPe5 7+ksKdzXNNRQaQZjCjJG0w1VnZV8Q2jYEa03gXZpB9zwkGAVnNvetiFtSVkLBQ== Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by aspmx1.migadu.com (Postfix) with ESMTPS id 89DD98A606 for ; Sun, 01 Dec 2024 09:36:40 +0100 (CET) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1tHeuD-0007E2-Ft; Sun, 01 Dec 2024 03:02:13 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1tHeuA-0007DS-1t for emacs-orgmode@gnu.org; Sun, 01 Dec 2024 03:02:10 -0500 Received: from mail-qv1-xf2c.google.com ([2607:f8b0:4864:20::f2c]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1tHeu5-0001HL-Bx for emacs-orgmode@gnu.org; Sun, 01 Dec 2024 03:02:09 -0500 Received: by mail-qv1-xf2c.google.com with SMTP id 6a1803df08f44-6d87f7f2f5bso19723396d6.1 for ; Sun, 01 Dec 2024 00:02:04 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20230601; t=1733040123; x=1733644923; darn=gnu.org; h=mime-version:message-id:date:user-agent:references:in-reply-to :subject:cc:to:from:from:to:cc:subject:date:message-id:reply-to; bh=dYzijNqZGfs/51ykGlTXhrf9eihY+G9eJUaG392Qxao=; b=Bt+blob1qKWytUKNpYx2HphiPmD+exe0hW/umH3FvssSxp+xPNowmJGQ94hbpvwjVI m3p//F6CAJ3ktZhgTmGwjOVafl+AYu0vSrVwn0hbYJ6/v0KT8SHDi/nXGUgI8lLbR3tf huHGkJuLZfmK/ClPJEJJMb3vCXgctyGeFv2amUpVi5RaNGBuxSFfC2LfxmXLfCHjYkv0 WjPaspRh2k1y3/9v8Ns/pyvr5gPnYDk+s7jBOd5v5viFOfPjWx65JLK9QhNtbJw7b55K cHhgbVDQbC9NLoxDIObQLyxfXIJ8EXWsFicMf5zBCgzKwi2UZmz+hhkGoaOBScKeHcFd 6Hlw== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1733040123; x=1733644923; h=mime-version:message-id:date:user-agent:references:in-reply-to :subject:cc:to:from:x-gm-message-state:from:to:cc:subject:date :message-id:reply-to; bh=dYzijNqZGfs/51ykGlTXhrf9eihY+G9eJUaG392Qxao=; b=LxnVCvmSUQAqMklOsap9Qv+NUQ5J3qiQTBRYUEtaB5Bs5UrSvG81Qbz87o64MJ5Tx1 uIJd5dZXVRlo+GwIKcOQFTyja0JgzPBAoxf9oxpoW4WgzLLqoFfdPYNZ69KsBSHEb3H7 EDDVsghXvbzaT8Lvo3u6UNel7PNOxwx43Wrn3eRqizFByn9hKEGYBOUdK1qd++Gv79Rq UpxMeIq39lRWZWp78sXwDwpNbhK87i1pW+2G3Aj0CzY/7h9t1yn5yFLnWhkXjW7tpW9W Ww1baFCYdXf3e2mXn/hQleraztS9T8GYhaivdInYyGlz/ktDvW1hPe6YYJ1uIbTvtUSv zPqw== X-Gm-Message-State: AOJu0YxZv3bD6TGo4WulhPnu6U/8ulzr2AYSDkdU9LfYFz+PIcoZip4Z O8rKSEpL1AbIOn3xVADrT3ircrEZTCIl7OfWSUtxFjQLoteLgVcxeDhqyAzM X-Gm-Gg: ASbGncsqFozboVaFDT3JrpmSZHQbhxDJL2qkOqJV5pyH35eV/oT0KCBQxsGBMM47/u1 3w6W47Z72KUlFVcW/foRmCj/gbRwYFUtlwrRNjL4ipxwJLvFzD8LoS48hsXKLJKl9W0hy55nX2k WYJav6O6dFrqbQ4RjARyfToA/63wYtcXXCfDJlT4eUIhtkwmO6CLpaFi8q2S5OUAYQAVm+lK9v9 0R1y6GGf20cSr82GwFzdPibbkPnLKHsjNMC2g== X-Google-Smtp-Source: AGHT+IHjd64evFTuoE/BtAI1faxjA95/9KSqaRqPfS46v/oJg2WcIOPi6roy3bQPz2CcUOt/acTaCQ== X-Received: by 2002:a05:6214:2507:b0:6d4:21ec:94c1 with SMTP id 6a1803df08f44-6d864d49578mr291910076d6.26.1733040122965; Sun, 01 Dec 2024 00:02:02 -0800 (PST) Received: from entropy ([2601:243:282:9490::89de]) by smtp.gmail.com with ESMTPSA id 6a1803df08f44-6d8a3ea8a2csm1072856d6.49.2024.12.01.00.01.59 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Sun, 01 Dec 2024 00:02:01 -0800 (PST) From: Nathaniel Nicandro To: Ihor Radchenko Cc: emacs-orgmode Subject: Re: [PATCH] Highlight ANSI sequences in the whole buffer (was [PATCH] ANSI color on example blocks and fixed width elements) In-Reply-To: <871pz1apky.fsf@localhost> (Ihor Radchenko's message of "Sat, 23 Nov 2024 16:21:17 +0000") References: <874jpuijpc.fsf@gmail.com> <87y1n6igvo.fsf@localhost> <878rev1q0k.fsf@gmail.com> <877cueonkj.fsf@localhost> <87zg6dez93.fsf@gmail.com> <871qjobhwa.fsf@localhost> <877ct5fzt6.fsf@gmail.com> <87a5y1mnj0.fsf@localhost> <87msvcgjgv.fsf@gmail.com> <87le9wq2dg.fsf@localhost> <8734uwhlhj.fsf@gmail.com> <875xzsjfvo.fsf@localhost> <87plvhf5gf.fsf@gmail.com> <87msqid9gi.fsf@localhost> <87bk3kuj20.fsf@localhost> <87wmm5yn1m.fsf@gmail.com> <87jzhy8x9y.fsf@localhost> <87ikx3zl8j.fsf@gmail.com> <877cdgndyj.fsf@localhost> <871pz9zc0d.fsf@gmail.com> <871pz1apky.fsf@localhost> User-Agent: mu4e 1.12.2; emacs 29.3 Date: Sun, 01 Dec 2024 02:01:59 -0600 Message-ID: <87plmbygp4.fsf@gmail.com> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Received-SPF: pass client-ip=2607:f8b0:4864:20::f2c; envelope-from=nathanielnicandro@gmail.com; helo=mail-qv1-xf2c.google.com X-Spam_score_int: -20 X-Spam_score: -2.1 X-Spam_bar: -- X-Spam_report: (-2.1 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, FREEMAIL_FROM=0.001, RCVD_IN_DNSWL_NONE=-0.0001, SPF_HELO_NONE=0.001, SPF_PASS=-0.001 autolearn=ham autolearn_force=no X-Spam_action: no action X-BeenThere: emacs-orgmode@gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: "General discussions about Org-mode." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-orgmode-bounces+larch=yhetil.org@gnu.org Sender: emacs-orgmode-bounces+larch=yhetil.org@gnu.org X-Migadu-Country: US X-Migadu-Flow: FLOW_IN X-Spam: Yes X-Migadu-Spam: Yes X-Migadu-Spam-Score: 9.45 X-Spam-Score: 9.45 X-Migadu-Queue-Id: 89DD98A606 X-Migadu-Scanner: mx11.migadu.com X-TUID: mTb8psM86bfh --=-=-= Content-Type: text/plain Ihor Radchenko 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. --=-=-= Content-Type: text/x-patch; charset=utf-8 Content-Disposition: attachment; filename=0001-Highlight-ANSI-escape-sequences.patch Content-Transfer-Encoding: quoted-printable Content-Description: patch >From 23706b527f44e5e36f020919df0717ab6005e055 Mon Sep 17 00:00:00 2001 From: Nathaniel Nicandro 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. =20 +*** 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 =3DM-x org-mode-restart RET=3D. 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 =3DM-x org-toggle-ansi-display RET=3D. + *** Alignment of image previews can be customized =20 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) =20 (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) =20 +(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)))))) =20 +(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 where + are the 8 bits of the `bool-vector' representing +the switches that can be turned on for ANSI sequences, +e.g. underline. () are 24 bits for the +foreground (background) color and () 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 =3D 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-contex= t'. +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 =3D (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-con= text) + 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 e= nd))) + (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-funct= ion) + "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 (=3D beg (overlay-start ov)) + (=3D 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 sequen= ces. +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-cont= ext) + ;; Handle edge case that a sequence + ;; occurs at the end of the region + ;; being processed. + (org-ansi-pack-context org-ansi-conte= xt))))))) + (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)) + (<=3D (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 a= lready + ;; 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) + (<=3D (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)) + (<=3D (org-element-contents-begin widened-el) (po= int) + (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))) =20 @@ -15950,6 +16667,30 @@ (defun org-agenda-prepare-buffers (files) (when org-agenda-file-menu-enabled (org-install-agenda-files-menu)))) =20 + +;;;; 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) + ;;;; CDLaTeX minor mode =20 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) + =20 ;;; 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"))))))) =20 + +;;; 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=1B[0m\n") + text-faceup (concat text-faceup "\n=1B[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-al= ist)) + (name (or short-name f)) + (prefix (format (if short-name "%s:" "%S:") n= ame))) + (unless short-name + (cl-callf2 concat ":" prefix)) + (cl-callf2 concat "=C2=AB" prefix) + `(concat ,prefix ,@args "=C2=BB"))) + (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 () "=1B[32m") + (bg-start () "=1B[42m") + (clear () "=1B[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 a= fter\n")) + ;; ...except when there were sequences at the element level previo= usly. + (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-tab= le-row "\n"))) + (test + (concat + "| " (fg-start) "5a | b |\n" + "| cell | d |\n") + (concat + (face org-table "| " (fg-start) (fg "5a")" | " (fg "b") " |") (f= ace 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=20 + ;; 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 =3Dverb" (fg-start) "atim=3D\n\n" + "#+begin_src python\n" + "return \"str " (fg-start) "ing\"\n" + "#+end_src\n") + (org + (concat + "6 =3Dverb" (fg-start) "atim=3D\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") " |") (f= ace org-table-row "\n") + (face org-table "|---+---|") (face org-table-row "\n") + (face org-table "| " (fg "a") " | " (fg "b") " |") (face org-tab= le-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 "defini= tion") "\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-en= d-position n)))) + (save-restriction + (narrow-to-region (line-beginning-position) (1+ (line-en= d-position n))) + (test text-faceup)))) + (cl-macrolet ((face (f &rest args) `(concat "=C2=AB" ,(format ":%S:"= f) ,@args "=C2=BB")) + (fg (&rest args) `(face (:foreground "green3") ,@args)) + (fg-start () "=1B[32m") + (clear () "=1B[0m")) + ;; fixed-width regions and font-lock-multiline + (org-test-with-temp-text + (concat "\ +: " (fg-start) "line1 +: line2 +") + (org-ansi-mode) + (font-lock-ensure) + (insert ": line3\n") + (forward-line -1) + ;; Sequence effects spill over to newly inserted fixed-width lin= e. + (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\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\nparagraph2\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\nline3\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))))) + ;;; Fixed-Width Areas =20 --=20 2.41.0 --=-=-= Content-Type: text/plain -- Nathaniel --=-=-=--