From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp2.migadu.com ([2001:41d0:303:e16b::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms13.migadu.com with LMTPS id sBOuHxn4gmaVawAAe85BDQ:P1 (envelope-from ) for ; Mon, 01 Jul 2024 18:40:25 +0000 Received: from aspmx1.migadu.com ([2001:41d0:303:e16b::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp2.migadu.com with LMTPS id sBOuHxn4gmaVawAAe85BDQ (envelope-from ) for ; Mon, 01 Jul 2024 20:40:25 +0200 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="VPB/99CK"; 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=1719859225; 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=2YuV+PQpVlCAomzaotcTXd54Jmrv+z6RXTqkbe5NUlI=; b=rKCOstyrJTjOxhpALGtWiKAa5LOFEXYTqi5jSKRoVSo7E6cd4CApo1E4AAQelQ7f6w0FMz 7kVZF5dDrsLiVxh0LQK5iWjN7wEeuwfj8y8b7PLpcgUGspfYKkYjl8EVUUdug6JbH6OkvX WgZv/Kq/3Pc9aL4v4BznZq5qLzrWSHhnjcjNCChbBG7Ze1d+WkfVvgLOH5qXmFti4DaUOj 87CbqsgchiWTM9bnjCYPOh9uVSObEEDmFwGxGaITvYEkUZhwTkeAAUuIA/ZzxDPOMuq41Z d4CxNt22KheyZYSYRjSDAwReaXn+ihTlNp17gyHn6NE/742mIYm5eqSzdopWNQ== ARC-Authentication-Results: i=1; aspmx1.migadu.com; dkim=fail ("body hash did not verify") header.d=gmail.com header.s=20230601 header.b="VPB/99CK"; 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=1719859225; a=rsa-sha256; cv=none; b=hquDEC6seisCzI7Qu31oU/TT5oQrxQNWmu0Ev6oU1lxd+/dB2USvGs9oLG+T+GQ/3lMrqk qOmwbyhJSwvWt3stE4zcS+cOi8SRYWP3YvtilJCrzaSWsdkg1U/VbmPNWluK9nTKkshtPI pkagZfFGvIFIF7O+J+Q4ECr35hRn3IrT0ecCzff+JA90V8d9stPpFtxLp9i9LTDDHSHpvj C0BlQb4zvIzaeUr/dIaDJqQTvGWI9nlD9T8bWS0XJb4kRgdmfEANoDTgTIKXGkDInvMSBk cJcvAARocJAQl+PE28Gllr3GKwoMjIPWJa9VTUTzklV3QgZq3xhLPPdzbJb/tw== 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 EDB6762CB7 for ; Mon, 1 Jul 2024 20:40:24 +0200 (CEST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1sOLw9-0003qD-Tk; Mon, 01 Jul 2024 14:39:37 -0400 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 1sOLw8-0003px-Cy for emacs-orgmode@gnu.org; Mon, 01 Jul 2024 14:39:36 -0400 Received: from mail-il1-x12f.google.com ([2607:f8b0:4864:20::12f]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1sOLvt-0000Vh-WF for emacs-orgmode@gnu.org; Mon, 01 Jul 2024 14:39:30 -0400 Received: by mail-il1-x12f.google.com with SMTP id e9e14a558f8ab-375deacb3e1so1677385ab.3 for ; Mon, 01 Jul 2024 11:39:21 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20230601; t=1719859160; x=1720463960; 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=4EXlMgSO34OhyK3scaTuvDwk50hixKdStyWJ0DdFO6A=; b=VPB/99CKuYPBoem/oaMiezEMATor+YVFTGiiWdn6UVGPUQVUEVUdszF/5boqRX1LYT sCP4pgfE6R/r8RL9P6Sxs7qLd9wyi64LpyMVle/5zt+mKCH2En6Ovmh6VsuUEDFvLwfw 1bGQsJrw1IoYlsB9m5i4rVy01VO72FOCuuui4cVbd9WE9lpPP/3pW663PFG/v2AC+TLL z1f5Y57NQsg5VkdSuMhwRzzfvAqEyPd9cDZurv5PY9rt1ISvuq0gTzC6u+CCHQxGXdJL SKQanE6rmB+aJoa2zf+XfKfkSaRyqVfW1CtaiuGFjvVxZqVksKw4rOl/O5AFnsFepkCp 0vCg== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1719859160; x=1720463960; 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=4EXlMgSO34OhyK3scaTuvDwk50hixKdStyWJ0DdFO6A=; b=ZdbTtR835zY+jE1QViSGK4y5VczinnxcQCV9c9ivbZGmKViKR6J3ITfZTUzuUPfqzL ovKU4H9pOu7Vn/U4g1rvnfqxZJsP6TlJlAM6aeMgTaY5OpYjQPJlronewFU+I9OGo533 mV65bMZyxE1KRbMF+B9VxhIZFV1PkRIWX6eCRzwqwKVQXsN8mMtS+b0hJN17lrHJlTN9 SjVsqv+HQPgy5LkY8mRVk6MUFjyq/U7mANB/glMtTWCb03dvGk2S0d7epnlAg5AUwcDe BIftagj+3f+FAN2mRPPeNRXGx7xPl4vMwTzfTNfMKh/T9DuViAmSg+QRUNfnUtls5BjL OtRg== X-Gm-Message-State: AOJu0YyRYoIQqUTryhrtrD+dCgRlbl2G62bujHGkFNDM1XUsI4Y8qZXw NPU5f43zx3xkV14N8sXO5Za11w0/ucgGVL/zBqUByZnO6p1A8v1dvkDpx4/Y X-Google-Smtp-Source: AGHT+IHXTfOPvUuMFjezJMECP2x7kyB54noSR1V4MDURg7IaMgHOtvHtv9B6hWz5ypr1fNnC5eJzCA== X-Received: by 2002:a05:6602:628e:b0:7f6:4dc4:2210 with SMTP id ca18e2360f4ac-7f64dc44f14mr17344039f.2.1719859159746; Mon, 01 Jul 2024 11:39:19 -0700 (PDT) Received: from entropy ([2601:243:283:930::6c53]) by smtp.gmail.com with ESMTPSA id 8926c6da1cb9f-4bb742bc068sm2342551173.142.2024.07.01.11.39.18 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 01 Jul 2024 11:39:19 -0700 (PDT) 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: <87bk3kuj20.fsf@localhost> (Ihor Radchenko's message of "Sat, 29 Jun 2024 10:42:15 +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> User-Agent: mu4e 1.12.2; emacs 29.3 Date: Mon, 01 Jul 2024 13:39:17 -0500 Message-ID: <87wmm5yn1m.fsf@gmail.com> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Received-SPF: pass client-ip=2607:f8b0:4864:20::12f; envelope-from=nathanielnicandro@gmail.com; helo=mail-il1-x12f.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, T_SPF_TEMPERROR=0.01 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-Migadu-Queue-Id: EDB6762CB7 X-Migadu-Scanner: mx13.migadu.com X-Migadu-Spam-Score: -5.18 X-Spam-Score: -5.18 X-TUID: 2Ge78tdiedUe --=-=-= Content-Type: text/plain Ihor Radchenko writes: > Ihor Radchenko writes: > >> Nathaniel Nicandro 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. > 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 line1 line2 line3 line4 all lines being highlighted by the sequence, and the paragraph is split at line3 so it becomes 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. --=-=-= 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 fcdd77870b65639e830475d300e05b35e70a7430 Mon Sep 17 00:00:00 2001 From: Nathaniel Nicandro 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. =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. + *** =3Dol.el=3D: New =3Dshortdoc=3D link type =20 You can now create links to =3Dshortdoc=3D 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)))))) =20 +(defvar org-fold-visibility-detail nil + "Detail setting when `org-fold-show-set-visibility' is called.") =20 (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-emph= asis) - (org-find-text-property-region (point) 'org-macr= o) - (org-find-text-property-region (point) 'invisibl= e)))) - ;; 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-em= phasis) + (org-find-text-property-region (point) 'org-ma= cro) + (org-find-text-property-region (point) 'invisi= ble)))) + ;; 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 regi= on))) (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))))))) =20 (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 drawe= r 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 d= rawer block)) + (eq (get-text-property (point) 'invisib= le) '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 blo= ck)) + (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) =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,585 @@ (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 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 e= l))) + (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 (=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) + (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) + (<=3D (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)) + (<=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)) + ;; 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 'no= error) + (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)))=20 + (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))) =20 @@ -15930,6 +16517,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 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) + =20 ;;; 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"))))))) =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 where sequences at the element level previ= ously. + (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" + "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 =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 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") " |") (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"))))))) + +(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-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")) + ;; Check integration with + ;; `org-fold-check-before-invisible-edit' + (org-test-with-temp-text + (concat (fg-start) "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) "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") + (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 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\nparagraph2\n") + (org-ansi-mode) + (font-lock-ensure) + (test-lines 1 "paragraph2\n") + (delete-char -1) + (test-lines 1 (concat (fg "paragraph2") "\n")))))) + ;;; Fixed-Width Areas =20 --=20 2.41.0 --=-=-= Content-Type: text/plain -- Nathaniel --=-=-=--