* [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers @ 2020-04-24 6:55 Ihor Radchenko 2020-04-24 8:02 ` Nicolas Goaziou 0 siblings, 1 reply; 192+ messages in thread From: Ihor Radchenko @ 2020-04-24 6:55 UTC (permalink / raw) To: emacs-orgmode Emacs becomes very slow when opening and moving around huge org files with many drawers. I have reported this issue last year in bug-gnu-emacs [1] and there have been other reports on the same problem in the internet [2]. You can easily see this problem using the attached file if you try to move down the lines when all the headings are folded. Moving a single line down may take over 10 seconds in the file. According to the reply to my initial emacs bug report [1], the reasons of performance degradation is huge number of overlays created by org in the PROPERTY and LOGBOOK drawers. Emacs must loop over all those overlays every time it calculates where the next visible line is located. So, one way to improve the performance would be reducing the number of overlays. I have been looking into usage of overlays in the org-mode code recently and tried to redefine org-flag-region to use text properties instead of overlays: #+begin_src emacs-lisp (defun org-flag-region (from to flag spec) "Hide or show lines from FROM to TO, according to FLAG. SPEC is the invisibility spec, as a symbol." (pcase spec ;; outlines must still use overlays because they rely on ;; 'reveal-toggle-invisible feature from reveal.el ;; That only works for overlays ('outline (remove-overlays from to 'invisible spec) ;; Use `front-advance' since text right before to the beginning of ;; the overlay belongs to the visible line than to the contents. (when flag (let ((o (make-overlay from to nil 'front-advance))) (overlay-put o 'evaporate t) (overlay-put o 'invisible spec) (overlay-put o 'isearch-open-invisible #'delete-overlay)))) (_ (let ((inhibit-modification-hooks t)) (remove-text-properties from to '(invisible nil)) ;; Use `front-advance' since text right before to the beginning of ;; the overlay belongs to the visible line than to the contents. (when flag (put-text-property from to 'rear-non-sticky t) (put-text-property from to 'front-sticky t) (put-text-property from to 'invisible spec) ;; no idea if 'isearch-open-invisible is needed for text ;; properties ;; (overlay-put o 'isearch-open-invisible #'delete-overlay) ))))) #+end_src To my surprise, the patch did not break org to unusable state and the performance on the sample org file [3] improved drastically. You can try by yourself! However, this did introduce some visual glitches with drawer display. Though drawers can still be folded/unfolded with <tab>, they are not folded on org-mode startup for some reason (can be fixed by running (org-cycle-hide-drawers 'all)). Also, some drawers (or parts of drawers) are unfolded for no apparent reason sometimes. A blind guess is that it is something to do with lack of 'isearch-open-invisible, which I am not sure how to set via text properties. Any thoughts about the use of text properties or about the patch suggestion are welcome. Best, Ihor [1] https://lists.gnu.org/archive/html/bug-gnu-emacs/2019-04/msg01387.html [2] https://www.reddit.com/r/orgmode/comments/e9p84n/scaling_org_better_to_use_more_medsize_files_or/ [3] See the attached org file in my Emacs bug report: https://lists.gnu.org/archive/html/bug-gnu-emacs/2019-04/txte6kQp35VOm.txt -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-04-24 6:55 [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers Ihor Radchenko @ 2020-04-24 8:02 ` Nicolas Goaziou 2020-04-25 0:29 ` stardiviner 2020-04-26 16:04 ` Ihor Radchenko 0 siblings, 2 replies; 192+ messages in thread From: Nicolas Goaziou @ 2020-04-24 8:02 UTC (permalink / raw) To: Ihor Radchenko; +Cc: emacs-orgmode Hello, Ihor Radchenko <yantar92@gmail.com> writes: > To my surprise, the patch did not break org to unusable state and > the performance on the sample org file [3] improved drastically. You can > try by yourself! It is not a surprise, really. Text properties are much faster than overlays, and very close to them features-wise. They are a bit more complex to handle, however. > However, this did introduce some visual glitches with drawer display. > Though drawers can still be folded/unfolded with <tab>, they are not > folded on org-mode startup for some reason (can be fixed by running > (org-cycle-hide-drawers 'all)). Also, some drawers (or parts of drawers) > are unfolded for no apparent reason sometimes. A blind guess is that it > is something to do with lack of 'isearch-open-invisible, which I am not > sure how to set via text properties. You cannot. You may however mimic it with `cursor-sensor-functions' text property. These assume Cursor Sensor minor mode is active, tho. I haven't tested it, but I assume it would slow down text properties a bit, too, but hopefully not as much as overlays. Note there are clear advantages using text properties. For example, when you move contents around, text properties are preserved. So there's no more need for the `org-cycle-hide-drawer' dance, i.e., it is not necessary anymore to re-hide drawers. > Any thoughts about the use of text properties or about the patch > suggestion are welcome. Missing `isearch-open-invisible' is a deal breaker, IMO. It may be worth experimenting with `cursor-sensor-functions'. We could also use text properties for property drawers, and overlays for regular ones. This might give us a reasonable speed-up with an acceptable feature trade-off. Anyway, the real fix should come from Emacs itself. There are ways to make overlays faster. These ways have already been discussed on the Emacs devel mailing list, but no one implemented them. It is a bit sad that we have to find workarounds for that. Regards, -- Nicolas Goaziou ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-04-24 8:02 ` Nicolas Goaziou @ 2020-04-25 0:29 ` stardiviner 2020-04-26 16:04 ` Ihor Radchenko 1 sibling, 0 replies; 192+ messages in thread From: stardiviner @ 2020-04-25 0:29 UTC (permalink / raw) To: Nicolas Goaziou; +Cc: emacs-orgmode, Ihor Radchenko -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA256 Nicolas Goaziou <mail@nicolasgoaziou.fr> writes: > Hello, > > Ihor Radchenko <yantar92@gmail.com> writes: > >> To my surprise, the patch did not break org to unusable state and >> the performance on the sample org file [3] improved drastically. You can >> try by yourself! > > It is not a surprise, really. Text properties are much faster than > overlays, and very close to them features-wise. They are a bit more > complex to handle, however. > >> However, this did introduce some visual glitches with drawer display. >> Though drawers can still be folded/unfolded with <tab>, they are not >> folded on org-mode startup for some reason (can be fixed by running >> (org-cycle-hide-drawers 'all)). Also, some drawers (or parts of drawers) >> are unfolded for no apparent reason sometimes. A blind guess is that it >> is something to do with lack of 'isearch-open-invisible, which I am not >> sure how to set via text properties. > > You cannot. You may however mimic it with `cursor-sensor-functions' text > property. These assume Cursor Sensor minor mode is active, tho. > I haven't tested it, but I assume it would slow down text properties > a bit, too, but hopefully not as much as overlays. > > Note there are clear advantages using text properties. For example, when > you move contents around, text properties are preserved. So there's no > more need for the `org-cycle-hide-drawer' dance, i.e., it is not > necessary anymore to re-hide drawers. > >> Any thoughts about the use of text properties or about the patch >> suggestion are welcome. > > Missing `isearch-open-invisible' is a deal breaker, IMO. It may be worth > experimenting with `cursor-sensor-functions'. > > We could also use text properties for property drawers, and overlays for > regular ones. This might give us a reasonable speed-up with an > acceptable feature trade-off. That's great, making Org Mode faster will be great. (Even thought I have not found big performance problem on Org Mode yet.) I like Thor's try. This indeed is is an acceptable feature trade-off, if only related to `isearch-open-invisible'. > > Anyway, the real fix should come from Emacs itself. There are ways to > make overlays faster. These ways have already been discussed on the > Emacs devel mailing list, but no one implemented them. It is a bit sad > that we have to find workarounds for that. > > Regards, - -- [ stardiviner ] I try to make every word tell the meaning what I want to express. Blog: https://stardiviner.github.io/ IRC(freenode): stardiviner, Matrix: stardiviner GPG: F09F650D7D674819892591401B5DF1C95AE89AC3 -----BEGIN PGP SIGNATURE----- iQFIBAEBCAAyFiEE8J9lDX1nSBmJJZFAG13xyVromsMFAl6jhG0UHG51bWJjaGls ZEBnbWFpbC5jb20ACgkQG13xyVromsPHDAf+OVnhOq5H5MYm1/RK+9xSzwAT6qc8 ajSNVNzI31q6CIesvO65GoiZ3Rpaiq/O31B9JQ1mTyXvyX81tFecKrDpsrqIc/bR Xo3Z4dCXzCbRKD1861t4tcphtPBk+rABpl83YpXafYNDKHnp2MuWSheV0ogF7LYd 6HWCl9D351onGAHGcebXEUTvvDiqLGx5qVnrpjomH00uCj5RoSI4cpdzXydBcIYY B6lDvsat8AHhvbPXqJc4PHOd4hPtNVehWyPfOGaAXhp/pS0y+c4cJMbHjXCwFCkj r8bUfdK+ZyMubNiboNI9xO8EwINvZLl+C5Lt5siYs/v2mrt1+UiVrxYWTw== =dnH4 -----END PGP SIGNATURE----- ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-04-24 8:02 ` Nicolas Goaziou 2020-04-25 0:29 ` stardiviner @ 2020-04-26 16:04 ` Ihor Radchenko 2020-05-04 16:56 ` Karl Voit ` (2 more replies) 1 sibling, 3 replies; 192+ messages in thread From: Ihor Radchenko @ 2020-04-26 16:04 UTC (permalink / raw) To: Nicolas Goaziou; +Cc: emacs-orgmode > You cannot. You may however mimic it with `cursor-sensor-functions' text > property. These assume Cursor Sensor minor mode is active, tho. > I haven't tested it, but I assume it would slow down text properties > a bit, too, but hopefully not as much as overlays. Unfortunately, isearch sets inhibit-point-motion-hooks to non-nil internally. Anyway, I came up with some workaround, which seems to work (see below). Though it would be better if isearch supported hidden text in addition to overlays. > Missing `isearch-open-invisible' is a deal breaker, IMO. It may be worth > experimenting with `cursor-sensor-functions'. So far, I came up with the following partial solution searching and showing hidden text. ;; Unfortunately isearch, sets inhibit-point-motion-hooks and we ;; cannot even use cursor-sensor-functions as a workaround ;; I used a less ideas approach with advice to isearch-search-string as ;; a workaround (defun org-find-text-property-region (pos prop) "Find a region containing PROP text property around point POS." (require 'org-macs) ;; org-with-point-at (org-with-point-at pos (let* ((beg (and (get-text-property pos prop) pos)) (end beg)) (when beg (setq beg (or (previous-single-property-change pos prop) beg)) (setq end (or (next-single-property-change pos prop) end)) (unless (equal beg end) (cons beg end)))))) ;; :FIXME: re-hide properties when point moves away (define-advice isearch-search-string (:after (&rest _) put-overlay) "Reveal hidden text at point." (when-let ((region (org-find-text-property-region (point) 'invisible))) (with-silent-modifications (put-text-property (car region) (cdr region) 'org-invisible (get-text-property (point) 'invisible))) (remove-text-properties (car region) (cdr region) '(invisible nil)))) ;; this seems to be unstable, but I cannot figure out why (defun org-restore-invisibility-specs (&rest _) "" (let ((pos (point-min))) (while (< (setq pos (next-single-property-change pos 'org-invisible nil (point-max))) (point-max)) (when-let ((region (org-find-text-property-region pos 'org-invisible))) (with-silent-modifications (put-text-property (car region) (cdr region) 'invisible (get-text-property pos 'org-invisible)) (remove-text-properties (car region) (cdr region) '(org-invisible nil))))))) (add-hook 'post-command-hook #'org-restore-invisibility-specs) (defun org-flag-region (from to flag spec) "Hide or show lines from FROM to TO, according to FLAG. SPEC is the invisibility spec, as a symbol." (pcase spec ('outline (remove-overlays from to 'invisible spec) ;; Use `front-advance' since text right before to the beginning of ;; the overlay belongs to the visible line than to the contents. (when flag (let ((o (make-overlay from to nil 'front-advance))) (overlay-put o 'evaporate t) (overlay-put o 'invisible spec) (overlay-put o 'isearch-open-invisible #'delete-overlay)))) (_ (with-silent-modifications (remove-text-properties from to '(invisible nil)) (when flag (put-text-property from to 'invisible spec) ))))) ;; This normally deletes invisible text property. We do not want this now. (defun org-unfontify-region (beg end &optional _maybe_loudly) "Remove fontification and activation overlays from links." (font-lock-default-unfontify-region beg end) (let* ((buffer-undo-list t) (inhibit-read-only t) (inhibit-point-motion-hooks t) (inhibit-modification-hooks t) deactivate-mark buffer-file-name buffer-file-truename) (decompose-region beg end) (remove-text-properties beg end '(mouse-face t keymap t org-linked-text t ;; Do not remove invisible during fontification ;; invisible t intangible t org-emphasis t)) (org-remove-font-lock-display-properties beg end))) > Anyway, the real fix should come from Emacs itself. There are ways to > make overlays faster. These ways have already been discussed on the > Emacs devel mailing list, but no one implemented them. It is a bit sad > that we have to find workarounds for that. I guess that it is a very old story starting from the times when XEmacs was a thing [1]. I recently heard about binary tree implementation of overlays (there should be a branch in emacs git repo) [2], but there was no update on that branch for a while. So, I do not have much hope on Emacs implementing efficient overlay access in the near future. (And I have problems with huge org files already). [1] https://www.reddit.com/r/planetemacs/comments/e9lgwn/history_of_lucid_emacs_fsf_emacs_schism/ [2] https://lists.gnu.org/archive/html/emacs-devel/2019-12/msg00323.html Nicolas Goaziou <mail@nicolasgoaziou.fr> writes: > Hello, > > Ihor Radchenko <yantar92@gmail.com> writes: > >> To my surprise, the patch did not break org to unusable state and >> the performance on the sample org file [3] improved drastically. You can >> try by yourself! > > It is not a surprise, really. Text properties are much faster than > overlays, and very close to them features-wise. They are a bit more > complex to handle, however. > >> However, this did introduce some visual glitches with drawer display. >> Though drawers can still be folded/unfolded with <tab>, they are not >> folded on org-mode startup for some reason (can be fixed by running >> (org-cycle-hide-drawers 'all)). Also, some drawers (or parts of drawers) >> are unfolded for no apparent reason sometimes. A blind guess is that it >> is something to do with lack of 'isearch-open-invisible, which I am not >> sure how to set via text properties. > > You cannot. You may however mimic it with `cursor-sensor-functions' text > property. These assume Cursor Sensor minor mode is active, tho. > I haven't tested it, but I assume it would slow down text properties > a bit, too, but hopefully not as much as overlays. > > Note there are clear advantages using text properties. For example, when > you move contents around, text properties are preserved. So there's no > more need for the `org-cycle-hide-drawer' dance, i.e., it is not > necessary anymore to re-hide drawers. > >> Any thoughts about the use of text properties or about the patch >> suggestion are welcome. > > Missing `isearch-open-invisible' is a deal breaker, IMO. It may be worth > experimenting with `cursor-sensor-functions'. > > We could also use text properties for property drawers, and overlays for > regular ones. This might give us a reasonable speed-up with an > acceptable feature trade-off. > > Anyway, the real fix should come from Emacs itself. There are ways to > make overlays faster. These ways have already been discussed on the > Emacs devel mailing list, but no one implemented them. It is a bit sad > that we have to find workarounds for that. > > Regards, > > -- > Nicolas Goaziou -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-04-26 16:04 ` Ihor Radchenko @ 2020-05-04 16:56 ` Karl Voit 2020-05-07 7:18 ` Karl Voit 2020-05-09 15:43 ` Ihor Radchenko 2020-05-07 11:04 ` Christian Heinrich 2020-05-08 16:38 ` Nicolas Goaziou 2 siblings, 2 replies; 192+ messages in thread From: Karl Voit @ 2020-05-04 16:56 UTC (permalink / raw) To: emacs-orgmode Hi Ihor, * Ihor Radchenko <yantar92@gmail.com> wrote: > > So far, I came up with the following partial solution searching and > showing hidden text. > > (defun org-find-text-property-region (pos prop) > (define-advice isearch-search-string (:after (&rest _) put-overlay) > (defun org-restore-invisibility-specs (&rest _) > (add-hook 'post-command-hook #'org-restore-invisibility-specs) > (defun org-flag-region (from to flag spec) > (defun org-unfontify-region (beg end &optional _maybe_loudly) After a couple of hours working with these patches, my feedback is very positive. Besides some visual glitches when creating a new heading with org-expiry-insinuate activated (which automatically adds :CREATED: properties), I could not detect any side-effect so far (will keep testing). The visual glitch looks like that: :PROPERTIES:X:CREATED: [2020-05-04 Mon 18>54] X ... with "X" being my character that symbolizes collapsed content. The way it looked without the patch was a simple collapsed property drawer. To me, this is acceptable considering the huge performance gain I got. THANK YOU VERY MUCH! I can't remember where I had this way of working within my large Org files[3] since ages. >> Anyway, the real fix should come from Emacs itself. There are ways to >> make overlays faster. These ways have already been discussed on the >> Emacs devel mailing list, but no one implemented them. It is a bit sad >> that we have to find workarounds for that. > > I guess that it is a very old story starting from the times when XEmacs > was a thing [1]. I recently heard about binary tree implementation of > overlays (there should be a branch in emacs git repo) [2], but there was > no update on that branch for a while. So, I do not have much hope on > Emacs implementing efficient overlay access in the near future. (And I > have problems with huge org files already). I can not express how this also reflects my personal situation. > [1] https://www.reddit.com/r/planetemacs/comments/e9lgwn/history_of_lucid_emacs_fsf_emacs_schism/ > [2] https://lists.gnu.org/archive/html/emacs-devel/2019-12/msg00323.html [3] https://karl-voit.at/2020/05/03/current-org-files -- get mail|git|SVN|photos|postings|SMS|phonecalls|RSS|CSV|XML into Org-mode: > get Memacs from https://github.com/novoid/Memacs < Personal Information Management > http://Karl-Voit.at/tags/pim/ Emacs-related > http://Karl-Voit.at/tags/emacs/ ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-05-04 16:56 ` Karl Voit @ 2020-05-07 7:18 ` Karl Voit 2020-05-09 15:43 ` Ihor Radchenko 1 sibling, 0 replies; 192+ messages in thread From: Karl Voit @ 2020-05-07 7:18 UTC (permalink / raw) To: emacs-orgmode Hi, * Karl Voit <devnull@Karl-Voit.at> wrote: > Hi Ihor, > > * Ihor Radchenko <yantar92@gmail.com> wrote: >> >> So far, I came up with the following partial solution searching and >> showing hidden text. >> >> (defun org-find-text-property-region (pos prop) >> (define-advice isearch-search-string (:after (&rest _) put-overlay) >> (defun org-restore-invisibility-specs (&rest _) >> (add-hook 'post-command-hook #'org-restore-invisibility-specs) >> (defun org-flag-region (from to flag spec) >> (defun org-unfontify-region (beg end &optional _maybe_loudly) > > After a couple of hours working with these patches, my feedback is > very positive. Besides some visual glitches when creating a new > heading with org-expiry-insinuate activated (which automatically > adds :CREATED: properties), I could not detect any side-effect so > far (will keep testing). > > The visual glitch looks like that: > >:PROPERTIES:X:CREATED: [2020-05-04 Mon 18>54] > X > > ... with "X" being my character that symbolizes collapsed content. > The way it looked without the patch was a simple collapsed property > drawer. Here some hard numbers to demonstrate the impact: my-org-agenda: from 11-16s down to 10 -> not much of a difference helm-org-contacts-refresh-cache: 29-59s down to 2½ -> HUGE Emacs boot time: 50-65s down to 10 -> HUGE Navigating the cursor in large Org files -> HUGE subjective impact >>> Anyway, the real fix should come from Emacs itself. There are ways to >>> make overlays faster. These ways have already been discussed on the >>> Emacs devel mailing list, but no one implemented them. It is a bit sad >>> that we have to find workarounds for that. >> >> I guess that it is a very old story starting from the times when XEmacs >> was a thing [1]. I recently heard about binary tree implementation of >> overlays (there should be a branch in emacs git repo) [2], but there was >> no update on that branch for a while. So, I do not have much hope on >> Emacs implementing efficient overlay access in the near future. (And I >> have problems with huge org files already). > > I can not express how this also reflects my personal situation. > >> [1] https://www.reddit.com/r/planetemacs/comments/e9lgwn/history_of_lucid_emacs_fsf_emacs_schism/ >> [2] https://lists.gnu.org/archive/html/emacs-devel/2019-12/msg00323.html > > [3] https://karl-voit.at/2020/05/03/current-org-files > -- get mail|git|SVN|photos|postings|SMS|phonecalls|RSS|CSV|XML into Org-mode: > get Memacs from https://github.com/novoid/Memacs < Personal Information Management > http://Karl-Voit.at/tags/pim/ Emacs-related > http://Karl-Voit.at/tags/emacs/ ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-05-04 16:56 ` Karl Voit 2020-05-07 7:18 ` Karl Voit @ 2020-05-09 15:43 ` Ihor Radchenko 1 sibling, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2020-05-09 15:43 UTC (permalink / raw) To: Karl Voit, emacs-orgmode > The visual glitch looks like that: > > :PROPERTIES:X:CREATED: [2020-05-04 Mon 18>54] > X Should be partially fixed in the latest patch I just sent. OLD <<< :PROPERTIES:X:CREATED: [2020-05-04 Mon 18>54] NEW >>> :PROPERTIES:X X Best, Ihor Karl Voit <devnull@Karl-Voit.at> writes: > Hi Ihor, > > * Ihor Radchenko <yantar92@gmail.com> wrote: >> >> So far, I came up with the following partial solution searching and >> showing hidden text. >> >> (defun org-find-text-property-region (pos prop) >> (define-advice isearch-search-string (:after (&rest _) put-overlay) >> (defun org-restore-invisibility-specs (&rest _) >> (add-hook 'post-command-hook #'org-restore-invisibility-specs) >> (defun org-flag-region (from to flag spec) >> (defun org-unfontify-region (beg end &optional _maybe_loudly) > > After a couple of hours working with these patches, my feedback is > very positive. Besides some visual glitches when creating a new > heading with org-expiry-insinuate activated (which automatically > adds :CREATED: properties), I could not detect any side-effect so > far (will keep testing). > > The visual glitch looks like that: > > :PROPERTIES:X:CREATED: [2020-05-04 Mon 18>54] > X > > ... with "X" being my character that symbolizes collapsed content. > The way it looked without the patch was a simple collapsed property > drawer. > > To me, this is acceptable considering the huge performance gain I > got. > > THANK YOU VERY MUCH! I can't remember where I had this way of > working within my large Org files[3] since ages. > >>> Anyway, the real fix should come from Emacs itself. There are ways to >>> make overlays faster. These ways have already been discussed on the >>> Emacs devel mailing list, but no one implemented them. It is a bit sad >>> that we have to find workarounds for that. >> >> I guess that it is a very old story starting from the times when XEmacs >> was a thing [1]. I recently heard about binary tree implementation of >> overlays (there should be a branch in emacs git repo) [2], but there was >> no update on that branch for a while. So, I do not have much hope on >> Emacs implementing efficient overlay access in the near future. (And I >> have problems with huge org files already). > > I can not express how this also reflects my personal situation. > >> [1] https://www.reddit.com/r/planetemacs/comments/e9lgwn/history_of_lucid_emacs_fsf_emacs_schism/ >> [2] https://lists.gnu.org/archive/html/emacs-devel/2019-12/msg00323.html > > [3] https://karl-voit.at/2020/05/03/current-org-files > > -- > get mail|git|SVN|photos|postings|SMS|phonecalls|RSS|CSV|XML into Org-mode: > > get Memacs from https://github.com/novoid/Memacs < > Personal Information Management > http://Karl-Voit.at/tags/pim/ > Emacs-related > http://Karl-Voit.at/tags/emacs/ > > -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-04-26 16:04 ` Ihor Radchenko 2020-05-04 16:56 ` Karl Voit @ 2020-05-07 11:04 ` Christian Heinrich 2020-05-09 15:46 ` Ihor Radchenko 2020-05-08 16:38 ` Nicolas Goaziou 2 siblings, 1 reply; 192+ messages in thread From: Christian Heinrich @ 2020-05-07 11:04 UTC (permalink / raw) To: emacs-orgmode [-- Attachment #1: Type: text/plain, Size: 8181 bytes --] Hi, thanks for your (initial) patch! I traced another error down today and found your code by chance. I tested it on an org-drill file that I had (with over 3500 items and hence 3500 drawers) and this patch helps *a lot* already. (Performance broke in 4403d4685e19fb99ba9bfec2bd4ff6781c66981f when outline-flag-region was replaced with org-flag-region, as drawers are no longer opened using outline-show-all which I had to use anyways to deal with my huge file.) I am not sure I understand how your follow-up code (below) needs to be incorporated. Would you mind sending a patch file? I hope that this ends up in the master branch at some point. Thanks again! Christian On Mon, 2020-04-27 at 00:04 +0800, Ihor Radchenko wrote: > > You cannot. You may however mimic it with `cursor-sensor-functions' text > > property. These assume Cursor Sensor minor mode is active, tho. > > I haven't tested it, but I assume it would slow down text properties > > a bit, too, but hopefully not as much as overlays. > > Unfortunately, isearch sets inhibit-point-motion-hooks to non-nil > internally. Anyway, I came up with some workaround, which seems to work > (see below). Though it would be better if isearch supported hidden text > in addition to overlays. > > > Missing `isearch-open-invisible' is a deal breaker, IMO. It may be worth > > experimenting with `cursor-sensor-functions'. > > So far, I came up with the following partial solution searching and > showing hidden text. > > ;; Unfortunately isearch, sets inhibit-point-motion-hooks and we > ;; cannot even use cursor-sensor-functions as a workaround > ;; I used a less ideas approach with advice to isearch-search-string as > ;; a workaround > > (defun org-find-text-property-region (pos prop) > "Find a region containing PROP text property around point POS." > (require 'org-macs) ;; org-with-point-at > (org-with-point-at pos > (let* ((beg (and (get-text-property pos prop) pos)) > (end beg)) > (when beg > (setq beg (or (previous-single-property-change pos prop) > beg)) > (setq end (or (next-single-property-change pos prop) > end)) > (unless (equal beg end) > (cons beg end)))))) > > ;; :FIXME: re-hide properties when point moves away > (define-advice isearch-search-string (:after (&rest _) put-overlay) > "Reveal hidden text at point." > (when-let ((region (org-find-text-property-region (point) 'invisible))) > (with-silent-modifications > (put-text-property (car region) (cdr region) 'org-invisible (get-text-property (point) > 'invisible))) > (remove-text-properties (car region) (cdr region) '(invisible nil)))) > > ;; this seems to be unstable, but I cannot figure out why > (defun org-restore-invisibility-specs (&rest _) > "" > (let ((pos (point-min))) > (while (< (setq pos (next-single-property-change pos 'org-invisible nil (point-max))) (point- > max)) > (when-let ((region (org-find-text-property-region pos 'org-invisible))) > (with-silent-modifications > (put-text-property (car region) (cdr region) 'invisible (get-text-property pos 'org- > invisible)) > (remove-text-properties (car region) (cdr region) '(org-invisible nil))))))) > > (add-hook 'post-command-hook #'org-restore-invisibility-specs) > > (defun org-flag-region (from to flag spec) > "Hide or show lines from FROM to TO, according to FLAG. > SPEC is the invisibility spec, as a symbol." > (pcase spec > ('outline > (remove-overlays from to 'invisible spec) > ;; Use `front-advance' since text right before to the beginning of > ;; the overlay belongs to the visible line than to the contents. > (when flag > (let ((o (make-overlay from to nil 'front-advance))) > (overlay-put o 'evaporate t) > (overlay-put o 'invisible spec) > (overlay-put o 'isearch-open-invisible #'delete-overlay)))) > (_ > (with-silent-modifications > (remove-text-properties from to '(invisible nil)) > (when flag > (put-text-property from to 'invisible spec) > ))))) > > ;; This normally deletes invisible text property. We do not want this now. > (defun org-unfontify-region (beg end &optional _maybe_loudly) > "Remove fontification and activation overlays from links." > (font-lock-default-unfontify-region beg end) > (let* ((buffer-undo-list t) > (inhibit-read-only t) (inhibit-point-motion-hooks t) > (inhibit-modification-hooks t) > deactivate-mark buffer-file-name buffer-file-truename) > (decompose-region beg end) > (remove-text-properties beg end > '(mouse-face t keymap t org-linked-text t > ;; Do not remove invisible during fontification > > ;; invisible t > intangible t > org-emphasis t)) > (org-remove-font-lock-display-properties beg end))) > > > Anyway, the real fix should come from Emacs itself. There are ways to > > make overlays faster. These ways have already been discussed on the > > Emacs devel mailing list, but no one implemented them. It is a bit sad > > that we have to find workarounds for that. > > I guess that it is a very old story starting from the times when XEmacs > was a thing [1]. I recently heard about binary tree implementation of > overlays (there should be a branch in emacs git repo) [2], but there was > no update on that branch for a while. So, I do not have much hope on > Emacs implementing efficient overlay access in the near future. (And I > have problems with huge org files already). > > [1] https://www.reddit.com/r/planetemacs/comments/e9lgwn/history_of_lucid_emacs_fsf_emacs_schism/ > [2] https://lists.gnu.org/archive/html/emacs-devel/2019-12/msg00323.html > > > Nicolas Goaziou <mail@nicolasgoaziou.fr> writes: > > > Hello, > > > > Ihor Radchenko <yantar92@gmail.com> writes: > > > > > To my surprise, the patch did not break org to unusable state and > > > the performance on the sample org file [3] improved drastically. You can > > > try by yourself! > > > > It is not a surprise, really. Text properties are much faster than > > overlays, and very close to them features-wise. They are a bit more > > complex to handle, however. > > > > > However, this did introduce some visual glitches with drawer display. > > > Though drawers can still be folded/unfolded with <tab>, they are not > > > folded on org-mode startup for some reason (can be fixed by running > > > (org-cycle-hide-drawers 'all)). Also, some drawers (or parts of drawers) > > > are unfolded for no apparent reason sometimes. A blind guess is that it > > > is something to do with lack of 'isearch-open-invisible, which I am not > > > sure how to set via text properties. > > > > You cannot. You may however mimic it with `cursor-sensor-functions' text > > property. These assume Cursor Sensor minor mode is active, tho. > > I haven't tested it, but I assume it would slow down text properties > > a bit, too, but hopefully not as much as overlays. > > > > Note there are clear advantages using text properties. For example, when > > you move contents around, text properties are preserved. So there's no > > more need for the `org-cycle-hide-drawer' dance, i.e., it is not > > necessary anymore to re-hide drawers. > > > > > Any thoughts about the use of text properties or about the patch > > > suggestion are welcome. > > > > Missing `isearch-open-invisible' is a deal breaker, IMO. It may be worth > > experimenting with `cursor-sensor-functions'. > > > > We could also use text properties for property drawers, and overlays for > > regular ones. This might give us a reasonable speed-up with an > > acceptable feature trade-off. > > > > Anyway, the real fix should come from Emacs itself. There are ways to > > make overlays faster. These ways have already been discussed on the > > Emacs devel mailing list, but no one implemented them. It is a bit sad > > that we have to find workarounds for that. > > > > Regards, > > > > -- > > Nicolas Goaziou [-- Attachment #2: This is a digitally signed message part --] [-- Type: application/pgp-signature, Size: 833 bytes --] ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-05-07 11:04 ` Christian Heinrich @ 2020-05-09 15:46 ` Ihor Radchenko 0 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2020-05-09 15:46 UTC (permalink / raw) To: Christian Heinrich, emacs-orgmode > I am not sure I understand how your follow-up code (below) needs to be incorporated. Would you mind > sending a patch file? I hope that this ends up in the master branch at some point. I have sent the patch in another email. Will appreciate any feedback. Best, Ihor Christian Heinrich <christian@gladbachcity.de> writes: > Hi, > > thanks for your (initial) patch! I traced another error down today and found your code by chance. I > tested it on an org-drill file that I had (with over 3500 items and hence 3500 drawers) and this > patch helps *a lot* already. (Performance broke in 4403d4685e19fb99ba9bfec2bd4ff6781c66981f when > outline-flag-region was replaced with org-flag-region, as drawers are no longer opened using > outline-show-all which I had to use anyways to deal with my huge file.) > > I am not sure I understand how your follow-up code (below) needs to be incorporated. Would you mind > sending a patch file? I hope that this ends up in the master branch at some point. > > Thanks again! > Christian > > On Mon, 2020-04-27 at 00:04 +0800, Ihor Radchenko wrote: >> > You cannot. You may however mimic it with `cursor-sensor-functions' text >> > property. These assume Cursor Sensor minor mode is active, tho. >> > I haven't tested it, but I assume it would slow down text properties >> > a bit, too, but hopefully not as much as overlays. >> >> Unfortunately, isearch sets inhibit-point-motion-hooks to non-nil >> internally. Anyway, I came up with some workaround, which seems to work >> (see below). Though it would be better if isearch supported hidden text >> in addition to overlays. >> >> > Missing `isearch-open-invisible' is a deal breaker, IMO. It may be worth >> > experimenting with `cursor-sensor-functions'. >> >> So far, I came up with the following partial solution searching and >> showing hidden text. >> >> ;; Unfortunately isearch, sets inhibit-point-motion-hooks and we >> ;; cannot even use cursor-sensor-functions as a workaround >> ;; I used a less ideas approach with advice to isearch-search-string as >> ;; a workaround >> >> (defun org-find-text-property-region (pos prop) >> "Find a region containing PROP text property around point POS." >> (require 'org-macs) ;; org-with-point-at >> (org-with-point-at pos >> (let* ((beg (and (get-text-property pos prop) pos)) >> (end beg)) >> (when beg >> (setq beg (or (previous-single-property-change pos prop) >> beg)) >> (setq end (or (next-single-property-change pos prop) >> end)) >> (unless (equal beg end) >> (cons beg end)))))) >> >> ;; :FIXME: re-hide properties when point moves away >> (define-advice isearch-search-string (:after (&rest _) put-overlay) >> "Reveal hidden text at point." >> (when-let ((region (org-find-text-property-region (point) 'invisible))) >> (with-silent-modifications >> (put-text-property (car region) (cdr region) 'org-invisible (get-text-property (point) >> 'invisible))) >> (remove-text-properties (car region) (cdr region) '(invisible nil)))) >> >> ;; this seems to be unstable, but I cannot figure out why >> (defun org-restore-invisibility-specs (&rest _) >> "" >> (let ((pos (point-min))) >> (while (< (setq pos (next-single-property-change pos 'org-invisible nil (point-max))) (point- >> max)) >> (when-let ((region (org-find-text-property-region pos 'org-invisible))) >> (with-silent-modifications >> (put-text-property (car region) (cdr region) 'invisible (get-text-property pos 'org- >> invisible)) >> (remove-text-properties (car region) (cdr region) '(org-invisible nil))))))) >> >> (add-hook 'post-command-hook #'org-restore-invisibility-specs) >> >> (defun org-flag-region (from to flag spec) >> "Hide or show lines from FROM to TO, according to FLAG. >> SPEC is the invisibility spec, as a symbol." >> (pcase spec >> ('outline >> (remove-overlays from to 'invisible spec) >> ;; Use `front-advance' since text right before to the beginning of >> ;; the overlay belongs to the visible line than to the contents. >> (when flag >> (let ((o (make-overlay from to nil 'front-advance))) >> (overlay-put o 'evaporate t) >> (overlay-put o 'invisible spec) >> (overlay-put o 'isearch-open-invisible #'delete-overlay)))) >> (_ >> (with-silent-modifications >> (remove-text-properties from to '(invisible nil)) >> (when flag >> (put-text-property from to 'invisible spec) >> ))))) >> >> ;; This normally deletes invisible text property. We do not want this now. >> (defun org-unfontify-region (beg end &optional _maybe_loudly) >> "Remove fontification and activation overlays from links." >> (font-lock-default-unfontify-region beg end) >> (let* ((buffer-undo-list t) >> (inhibit-read-only t) (inhibit-point-motion-hooks t) >> (inhibit-modification-hooks t) >> deactivate-mark buffer-file-name buffer-file-truename) >> (decompose-region beg end) >> (remove-text-properties beg end >> '(mouse-face t keymap t org-linked-text t >> ;; Do not remove invisible during fontification >> >> ;; invisible t >> intangible t >> org-emphasis t)) >> (org-remove-font-lock-display-properties beg end))) >> >> > Anyway, the real fix should come from Emacs itself. There are ways to >> > make overlays faster. These ways have already been discussed on the >> > Emacs devel mailing list, but no one implemented them. It is a bit sad >> > that we have to find workarounds for that. >> >> I guess that it is a very old story starting from the times when XEmacs >> was a thing [1]. I recently heard about binary tree implementation of >> overlays (there should be a branch in emacs git repo) [2], but there was >> no update on that branch for a while. So, I do not have much hope on >> Emacs implementing efficient overlay access in the near future. (And I >> have problems with huge org files already). >> >> [1] https://www.reddit.com/r/planetemacs/comments/e9lgwn/history_of_lucid_emacs_fsf_emacs_schism/ >> [2] https://lists.gnu.org/archive/html/emacs-devel/2019-12/msg00323.html >> >> >> Nicolas Goaziou <mail@nicolasgoaziou.fr> writes: >> >> > Hello, >> > >> > Ihor Radchenko <yantar92@gmail.com> writes: >> > >> > > To my surprise, the patch did not break org to unusable state and >> > > the performance on the sample org file [3] improved drastically. You can >> > > try by yourself! >> > >> > It is not a surprise, really. Text properties are much faster than >> > overlays, and very close to them features-wise. They are a bit more >> > complex to handle, however. >> > >> > > However, this did introduce some visual glitches with drawer display. >> > > Though drawers can still be folded/unfolded with <tab>, they are not >> > > folded on org-mode startup for some reason (can be fixed by running >> > > (org-cycle-hide-drawers 'all)). Also, some drawers (or parts of drawers) >> > > are unfolded for no apparent reason sometimes. A blind guess is that it >> > > is something to do with lack of 'isearch-open-invisible, which I am not >> > > sure how to set via text properties. >> > >> > You cannot. You may however mimic it with `cursor-sensor-functions' text >> > property. These assume Cursor Sensor minor mode is active, tho. >> > I haven't tested it, but I assume it would slow down text properties >> > a bit, too, but hopefully not as much as overlays. >> > >> > Note there are clear advantages using text properties. For example, when >> > you move contents around, text properties are preserved. So there's no >> > more need for the `org-cycle-hide-drawer' dance, i.e., it is not >> > necessary anymore to re-hide drawers. >> > >> > > Any thoughts about the use of text properties or about the patch >> > > suggestion are welcome. >> > >> > Missing `isearch-open-invisible' is a deal breaker, IMO. It may be worth >> > experimenting with `cursor-sensor-functions'. >> > >> > We could also use text properties for property drawers, and overlays for >> > regular ones. This might give us a reasonable speed-up with an >> > acceptable feature trade-off. >> > >> > Anyway, the real fix should come from Emacs itself. There are ways to >> > make overlays faster. These ways have already been discussed on the >> > Emacs devel mailing list, but no one implemented them. It is a bit sad >> > that we have to find workarounds for that. >> > >> > Regards, >> > >> > -- >> > Nicolas Goaziou -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-04-26 16:04 ` Ihor Radchenko 2020-05-04 16:56 ` Karl Voit 2020-05-07 11:04 ` Christian Heinrich @ 2020-05-08 16:38 ` Nicolas Goaziou 2020-05-09 13:58 ` Nicolas Goaziou 2020-05-09 15:40 ` Ihor Radchenko 2 siblings, 2 replies; 192+ messages in thread From: Nicolas Goaziou @ 2020-05-08 16:38 UTC (permalink / raw) To: Ihor Radchenko; +Cc: emacs-orgmode Hello, Ihor Radchenko <yantar92@gmail.com> writes: > ;; Unfortunately isearch, sets inhibit-point-motion-hooks and we > ;; cannot even use cursor-sensor-functions as a workaround > ;; I used a less ideas approach with advice to isearch-search-string as > ;; a workaround OK. > (defun org-find-text-property-region (pos prop) > "Find a region containing PROP text property around point POS." > (require 'org-macs) ;; org-with-point-at > (org-with-point-at pos Do we really need that since every function has a POS argument anyway? Is it for the `widen' part? > (let* ((beg (and (get-text-property pos prop) pos)) > (end beg)) > (when beg > (setq beg (or (previous-single-property-change pos prop) > beg)) Shouldn't fall-back be (point-min)? > (setq end (or (next-single-property-change pos prop) > end)) And (point-max) here? > (unless (equal beg end) Nitpick: `equal' -> = > (cons beg end)))))) > ;; :FIXME: re-hide properties when point moves away > (define-advice isearch-search-string (:after (&rest _) put-overlay) > "Reveal hidden text at point." > (when-let ((region (org-find-text-property-region (point) 'invisible))) > (with-silent-modifications > (put-text-property (car region) (cdr region) 'org-invisible (get-text-property (point) 'invisible))) > (remove-text-properties (car region) (cdr region) '(invisible nil)))) Could we use `isearch-update-post-hook' here? Or, it seems nicer to `add-function' around `isearch-filter-predicate' and extend isearch-filter-visible to support (i.e., stop at, and display) invisible text through text properties. > ;; this seems to be unstable, but I cannot figure out why > (defun org-restore-invisibility-specs (&rest _) > "" > (let ((pos (point-min))) > (while (< (setq pos (next-single-property-change pos 'org-invisible nil (point-max))) (point-max)) > (when-let ((region (org-find-text-property-region pos 'org-invisible))) > (with-silent-modifications > (put-text-property (car region) (cdr region) 'invisible (get-text-property pos 'org-invisible)) > (remove-text-properties (car region) (cdr region) '(org-invisible nil))))))) Could you use the hook above to store all visited invisible texts, and re-hide them at the end of the search, e.g., using `isearch-mode-end-hook'? > (add-hook 'post-command-hook #'org-restore-invisibility-specs) Ouch. I hope we can avoid that. I wonder how it compares to drawers using the same invisible spec as headlines, as it was the case before. Could you give it a try? I think hiding all property drawers right after opening a subtree is fast enough. Another option, as I already suggested, would be to use text-properties on property drawers only. Ignoring isearch inside those sounds tolerable, at least. Regards, -- Nicolas Goaziou ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-05-08 16:38 ` Nicolas Goaziou @ 2020-05-09 13:58 ` Nicolas Goaziou 2020-05-09 16:22 ` Ihor Radchenko 2020-05-09 15:40 ` Ihor Radchenko 1 sibling, 1 reply; 192+ messages in thread From: Nicolas Goaziou @ 2020-05-09 13:58 UTC (permalink / raw) To: Ihor Radchenko; +Cc: emacs-orgmode Nicolas Goaziou <mail@nicolasgoaziou.fr> writes: > I wonder how it compares to drawers using the same invisible spec as > headlines, as it was the case before. Could you give it a try? > > I think hiding all property drawers right after opening a subtree is > fast enough. As a follow-up, I switched property drawers (and only those) back to using `outline' invisible spec in master branch. Hopefully, navigating in large folded files should be faster. Of course, this doesn't prevent us to continue exploring text-properties. In particular, the problem is still open for regular drawers (e.g., LOGBOOK). ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-05-09 13:58 ` Nicolas Goaziou @ 2020-05-09 16:22 ` Ihor Radchenko 2020-05-09 17:21 ` Nicolas Goaziou 0 siblings, 1 reply; 192+ messages in thread From: Ihor Radchenko @ 2020-05-09 16:22 UTC (permalink / raw) To: Nicolas Goaziou; +Cc: emacs-orgmode > As a follow-up, I switched property drawers (and only those) back to > using `outline' invisible spec in master branch. Hopefully, navigating > in large folded files should be faster. Just tested the master branch. Three observations on large org file: 1. Next/previous line on folder buffer is still terribly slow 2. Unfolding speed does not seem to be affected by the last commits - it is still much slower than text property version. There might be some improvement if I run Emacs for longer time though (Emacs generally becomes slower over time). 3. <TAB> <TAB> on a headline with several levels of subheadings moves the cursor to the end of subtree, which did not happen in the past. Best, Ihor Nicolas Goaziou <mail@nicolasgoaziou.fr> writes: > Nicolas Goaziou <mail@nicolasgoaziou.fr> writes: > >> I wonder how it compares to drawers using the same invisible spec as >> headlines, as it was the case before. Could you give it a try? >> >> I think hiding all property drawers right after opening a subtree is >> fast enough. > > As a follow-up, I switched property drawers (and only those) back to > using `outline' invisible spec in master branch. Hopefully, navigating > in large folded files should be faster. > > Of course, this doesn't prevent us to continue exploring > text-properties. In particular, the problem is still open for regular > drawers (e.g., LOGBOOK). -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-05-09 16:22 ` Ihor Radchenko @ 2020-05-09 17:21 ` Nicolas Goaziou 2020-05-10 5:25 ` Ihor Radchenko 0 siblings, 1 reply; 192+ messages in thread From: Nicolas Goaziou @ 2020-05-09 17:21 UTC (permalink / raw) To: Ihor Radchenko; +Cc: emacs-orgmode Hello, Ihor Radchenko <yantar92@gmail.com> writes: > Just tested the master branch. > Three observations on large org file: > > 1. Next/previous line on folder buffer is still terribly slow Oops, you are right. I fixed this. It should be way faster. I can navigate in your example file without much trouble. Please let me know how it goes. > 2. Unfolding speed does not seem to be affected by the last commits - it > is still much slower than text property version. There might be some > improvement if I run Emacs for longer time though (Emacs generally > becomes slower over time). The last commits have nothing to do with unfolding. I'm not pretending that overlays are faster than text properties, either. With the current implementation property drawers add no overhead : last commits reduce drastically the number of overlays active in a buffer at a given time. > 3. <TAB> <TAB> on a headline with several levels of subheadings moves > the cursor to the end of subtree, which did not happen in the past. Indeed. I fixed that, too. Thank you! Regards, -- Nicolas Goaziou ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-05-09 17:21 ` Nicolas Goaziou @ 2020-05-10 5:25 ` Ihor Radchenko 2020-05-10 9:47 ` Nicolas Goaziou 0 siblings, 1 reply; 192+ messages in thread From: Ihor Radchenko @ 2020-05-10 5:25 UTC (permalink / raw) To: Nicolas Goaziou; +Cc: emacs-orgmode > Oops, you are right. I fixed this. It should be way faster. I can > navigate in your example file without much trouble. > > Please let me know how it goes. I tested with master + my personal config + native compilation of org, Emacs native-comp branch, commit c984a53b4e198e31d11d7bc493dc9a686c77edae. Did not see much improvement. Vertical motion in the folded buffer is still quite slow. > The last commits have nothing to do with unfolding. Apparently I misunderstood the purpose of: 1027e0256 "Implement `org-cycle-hide-property-drawers'" Best, Ihor Nicolas Goaziou <mail@nicolasgoaziou.fr> writes: > Hello, > > Ihor Radchenko <yantar92@gmail.com> writes: > >> Just tested the master branch. >> Three observations on large org file: >> >> 1. Next/previous line on folder buffer is still terribly slow > > Oops, you are right. I fixed this. It should be way faster. I can > navigate in your example file without much trouble. > > Please let me know how it goes. > >> 2. Unfolding speed does not seem to be affected by the last commits - it >> is still much slower than text property version. There might be some >> improvement if I run Emacs for longer time though (Emacs generally >> becomes slower over time). > > The last commits have nothing to do with unfolding. > > I'm not pretending that overlays are faster than text properties, > either. > > With the current implementation property drawers add no overhead : last > commits reduce drastically the number of overlays active in a buffer at > a given time. > >> 3. <TAB> <TAB> on a headline with several levels of subheadings moves >> the cursor to the end of subtree, which did not happen in the past. > > Indeed. I fixed that, too. Thank you! > > Regards, > > -- > Nicolas Goaziou -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-05-10 5:25 ` Ihor Radchenko @ 2020-05-10 9:47 ` Nicolas Goaziou 2020-05-10 13:29 ` Ihor Radchenko 0 siblings, 1 reply; 192+ messages in thread From: Nicolas Goaziou @ 2020-05-10 9:47 UTC (permalink / raw) To: Ihor Radchenko; +Cc: emacs-orgmode Hello, Ihor Radchenko <yantar92@gmail.com> writes: >> Oops, you are right. I fixed this. It should be way faster. I can >> navigate in your example file without much trouble. >> >> Please let me know how it goes. > > I tested with master + my personal config + native compilation of org, > Emacs native-comp branch, commit c984a53b4e198e31d11d7bc493dc9a686c77edae. > Did not see much improvement. > Vertical motion in the folded buffer is still quite slow. Oh! This is embarrassing. I improved speed, then broke it again in a later commit. Sorry for wasting your time. I think I fixed it again. Thank you for the feedback. Could you have a look again? > Apparently I misunderstood the purpose of: 1027e0256 > "Implement `org-cycle-hide-property-drawers'" The function is meant to re-hide only property drawers after visibility cycling. Its purpose is not to improve /unfolding/ speed. Unfolding is very fast already, faster than using text properties. Folding has roughly the same speed in both cases: most time is spent looking for the next location to fold. However, folding with text properties is more resilient, so you fold less often. As a side note, your file contains 5217 headlines and 5215 property drawers. I'll ignore the 3989 regular drawers for the time being (although they do contribute to the slow navigation). In current master, it means there is at most 5217 overlays in the buffer. With text properties, the worse situation in the same. Of course, that case happens less often with text properties. For example, it happens in "contents" view in both cases. However, in "show all" view, it is only a problem with overlays. Regards, -- Nicolas Goaziou ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-05-10 9:47 ` Nicolas Goaziou @ 2020-05-10 13:29 ` Ihor Radchenko 2020-05-10 14:46 ` Nicolas Goaziou 0 siblings, 1 reply; 192+ messages in thread From: Ihor Radchenko @ 2020-05-10 13:29 UTC (permalink / raw) To: Nicolas Goaziou; +Cc: emacs-orgmode >> I tested with master + my personal config + native compilation of org, >> Emacs native-comp branch, commit c984a53b4e198e31d11d7bc493dc9a686c77edae. >> Did not see much improvement. >> Vertical motion in the folded buffer is still quite slow. > > Oh! This is embarrassing. I improved speed, then broke it again in > a later commit. Sorry for wasting your time. I think I fixed it again. > Thank you for the feedback. > > Could you have a look again? I still do not feel much difference, so I used elp to quantify if there is any difference I cannot notice by myself. I tested the time to move from to bottom of the example file with next-logical-line. org master (7801e9236): 6(#calls) 2.852953989(total time, sec) 0.4754923315(average) org e39365e32: 6 2.991771891 0.4986286485 org feature/drawertextprop: 6 0.149731379 0.0249552298 There is small improvement in speed, but it is not obvious. > ... In current master, > it means there is at most 5217 overlays in the buffer. With text > properties, the worse situation in the same. Do you mean that number of overlays is same with text properties? I feel that I misunderstand what you want to say. > Of course, that case happens less often with text properties. For > example, it happens in "contents" view in both cases. However, in "show > all" view, it is only a problem with overlays. I am completely lost. What do you mean by "that case"? Best, Ihor Nicolas Goaziou <mail@nicolasgoaziou.fr> writes: > Hello, > > Ihor Radchenko <yantar92@gmail.com> writes: > >>> Oops, you are right. I fixed this. It should be way faster. I can >>> navigate in your example file without much trouble. >>> >>> Please let me know how it goes. >> >> I tested with master + my personal config + native compilation of org, >> Emacs native-comp branch, commit c984a53b4e198e31d11d7bc493dc9a686c77edae. >> Did not see much improvement. >> Vertical motion in the folded buffer is still quite slow. > > Oh! This is embarrassing. I improved speed, then broke it again in > a later commit. Sorry for wasting your time. I think I fixed it again. > Thank you for the feedback. > > Could you have a look again? > >> Apparently I misunderstood the purpose of: 1027e0256 >> "Implement `org-cycle-hide-property-drawers'" > > The function is meant to re-hide only property drawers after visibility > cycling. Its purpose is not to improve /unfolding/ speed. Unfolding is > very fast already, faster than using text properties. > > Folding has roughly the same speed in both cases: most time is spent > looking for the next location to fold. However, folding with text > properties is more resilient, so you fold less often. > > As a side note, your file contains 5217 headlines and 5215 property > drawers. I'll ignore the 3989 regular drawers for the time being > (although they do contribute to the slow navigation). In current master, > it means there is at most 5217 overlays in the buffer. With text > properties, the worse situation in the same. > > Of course, that case happens less often with text properties. For > example, it happens in "contents" view in both cases. However, in "show > all" view, it is only a problem with overlays. > > Regards, > > -- > Nicolas Goaziou -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-05-10 13:29 ` Ihor Radchenko @ 2020-05-10 14:46 ` Nicolas Goaziou 2020-05-10 16:21 ` Ihor Radchenko 0 siblings, 1 reply; 192+ messages in thread From: Nicolas Goaziou @ 2020-05-10 14:46 UTC (permalink / raw) To: Ihor Radchenko; +Cc: emacs-orgmode Ihor Radchenko <yantar92@gmail.com> writes: > I still do not feel much difference, so I used elp to quantify if there > is any difference I cannot notice by myself. I tested the time to move > from to bottom of the example file with next-logical-line. > > org master (7801e9236): > 6(#calls) 2.852953989(total time, sec) 0.4754923315(average) > > org e39365e32: > 6 2.991771891 0.4986286485 > > org feature/drawertextprop: > 6 0.149731379 0.0249552298 > > There is small improvement in speed, but it is not obvious. I don't know how you made your test. You probably didn't remove :LOGBOOK: lines. When headlines are fully folded, there are 8 overlays in the buffer, where there used to be 10k. It cannot be a "small improvement". Ah, well. It doesn't matter. At least the situation improved in some cases, and the code is better. >> ... In current master, >> it means there is at most 5217 overlays in the buffer. With text >> properties, the worse situation in the same. > > Do you mean that number of overlays is same with text properties? I feel > that I misunderstand what you want to say. AFAIU, you still use overlays for headlines. If you activate so-called "contents view", all headlines are visible, and are all folded. You get 5217 overlays in the buffer. >> Of course, that case happens less often with text properties. For >> example, it happens in "contents" view in both cases. However, in "show >> all" view, it is only a problem with overlays. > > I am completely lost. What do you mean by "that case"? I am talking about the "worse case" situation just above. I'll comment your patch in another message. Regards, ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-05-10 14:46 ` Nicolas Goaziou @ 2020-05-10 16:21 ` Ihor Radchenko 2020-05-10 16:38 ` Nicolas Goaziou 0 siblings, 1 reply; 192+ messages in thread From: Ihor Radchenko @ 2020-05-10 16:21 UTC (permalink / raw) To: Nicolas Goaziou; +Cc: emacs-orgmode > I don't know how you made your test. You probably didn't > remove :LOGBOOK: lines. When headlines are fully folded, there are > 8 overlays in the buffer, where there used to be 10k. It cannot be > a "small improvement". Ouch. I did not remove :LOGBOOK: lines. I thought you referred to the original file in "I can navigate in your example file without much trouble." If you want, I can test the file without :LOGBOOK: lines tomorrow. >>> ... In current master, >>> it means there is at most 5217 overlays in the buffer. With text >>> properties, the worse situation in the same. >> >> Do you mean that number of overlays is same with text properties? I feel >> that I misunderstand what you want to say. > > AFAIU, you still use overlays for headlines. If you activate so-called > "contents view", all headlines are visible, and are all folded. You get > 5217 overlays in the buffer. No, there are only 9 'outline overlays in the folded buffer if we do not create overlays for drawers. This is because outline-hide-sublevels called by org-overview is calling outline-flag-region on the whole buffer thus removing all the 'outline overlays in buffer (remove-overlays from to 'invisible 'outline) and re-creating a single overlay for each top-level heading. Now, thinking second time about this, using the following for org-flag-region would achieve similar effect: (remove-overlays from to 'invisible 'outline) (remove-overlays from to 'invisible 'org-hide-drawer) Now sure if it is going to break org-cycle though. What do you think? Best, Ihor Nicolas Goaziou <mail@nicolasgoaziou.fr> writes: > Ihor Radchenko <yantar92@gmail.com> writes: > >> I still do not feel much difference, so I used elp to quantify if there >> is any difference I cannot notice by myself. I tested the time to move >> from to bottom of the example file with next-logical-line. >> >> org master (7801e9236): >> 6(#calls) 2.852953989(total time, sec) 0.4754923315(average) >> >> org e39365e32: >> 6 2.991771891 0.4986286485 >> >> org feature/drawertextprop: >> 6 0.149731379 0.0249552298 >> >> There is small improvement in speed, but it is not obvious. > > I don't know how you made your test. You probably didn't > remove :LOGBOOK: lines. When headlines are fully folded, there are > 8 overlays in the buffer, where there used to be 10k. It cannot be > a "small improvement". > > Ah, well. It doesn't matter. At least the situation improved in some > cases, and the code is better. > >>> ... In current master, >>> it means there is at most 5217 overlays in the buffer. With text >>> properties, the worse situation in the same. >> >> Do you mean that number of overlays is same with text properties? I feel >> that I misunderstand what you want to say. > > AFAIU, you still use overlays for headlines. If you activate so-called > "contents view", all headlines are visible, and are all folded. You get > 5217 overlays in the buffer. > >>> Of course, that case happens less often with text properties. For >>> example, it happens in "contents" view in both cases. However, in "show >>> all" view, it is only a problem with overlays. >> >> I am completely lost. What do you mean by "that case"? > > I am talking about the "worse case" situation just above. > > I'll comment your patch in another message. > > Regards, -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-05-10 16:21 ` Ihor Radchenko @ 2020-05-10 16:38 ` Nicolas Goaziou 2020-05-10 17:08 ` Ihor Radchenko 0 siblings, 1 reply; 192+ messages in thread From: Nicolas Goaziou @ 2020-05-10 16:38 UTC (permalink / raw) To: Ihor Radchenko; +Cc: emacs-orgmode Ihor Radchenko <yantar92@gmail.com> writes: > If you want, I can test the file without :LOGBOOK: lines tomorrow. Don't worry, it doesn't matter now. > No, there are only 9 'outline overlays in the folded buffer if we do not > create overlays for drawers. This is because outline-hide-sublevels > called by org-overview is calling outline-flag-region on the whole > buffer thus removing all the 'outline overlays in buffer > (remove-overlays from to 'invisible 'outline) and re-creating a single > overlay for each top-level heading. You're talking about "overview" (org-overview), whereas I'm talking about "contents view" (org-content). They are not the same. In the latter, you show every headline in the buffer, so you have one overlay per headline. > Now, thinking second time about this, using the following for > org-flag-region would achieve similar effect: > > (remove-overlays from to 'invisible 'outline) > (remove-overlays from to 'invisible 'org-hide-drawer) > > Now sure if it is going to break org-cycle though. > What do you think? This is already the case. See first line of `org-flag-region'. Regards, ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-05-10 16:38 ` Nicolas Goaziou @ 2020-05-10 17:08 ` Ihor Radchenko 2020-05-10 19:38 ` Nicolas Goaziou 0 siblings, 1 reply; 192+ messages in thread From: Ihor Radchenko @ 2020-05-10 17:08 UTC (permalink / raw) To: Nicolas Goaziou; +Cc: emacs-orgmode > You're talking about "overview" (org-overview), whereas I'm talking > about "contents view" (org-content). They are not the same. In the > latter, you show every headline in the buffer, so you have one overlay > per headline. Thanks for the explanation. I finally understand you initial note. I was thinking about org-overview mostly because it is the case when next/previous-line was extremely slow with many overlays jammed between two subsequent lines. >> Now, thinking second time about this, using the following for >> org-flag-region would achieve similar effect: >> >> (remove-overlays from to 'invisible 'outline) >> (remove-overlays from to 'invisible 'org-hide-drawer) >> >> Now sure if it is going to break org-cycle though. >> What do you think? > > This is already the case. See first line of `org-flag-region'. Currently, `org-flag-region' only removes one SPEC type of overlays: (remove-overlays from to 'invisible spec) If we change it to (remove-overlays from to 'invisible spec) (when flag (remove-overlays from to 'invisible 'org-hide-drawer) ... ) then all the extra drawer overlays in the flagged region will be removed. It will require re-creating those extra overlays later if the region is revealed again though. Best, Ihor Nicolas Goaziou <mail@nicolasgoaziou.fr> writes: > Ihor Radchenko <yantar92@gmail.com> writes: > >> If you want, I can test the file without :LOGBOOK: lines tomorrow. > > Don't worry, it doesn't matter now. > >> No, there are only 9 'outline overlays in the folded buffer if we do not >> create overlays for drawers. This is because outline-hide-sublevels >> called by org-overview is calling outline-flag-region on the whole >> buffer thus removing all the 'outline overlays in buffer >> (remove-overlays from to 'invisible 'outline) and re-creating a single >> overlay for each top-level heading. > > You're talking about "overview" (org-overview), whereas I'm talking > about "contents view" (org-content). They are not the same. In the > latter, you show every headline in the buffer, so you have one overlay > per headline. > >> Now, thinking second time about this, using the following for >> org-flag-region would achieve similar effect: >> >> (remove-overlays from to 'invisible 'outline) >> (remove-overlays from to 'invisible 'org-hide-drawer) >> >> Now sure if it is going to break org-cycle though. >> What do you think? > > This is already the case. See first line of `org-flag-region'. > > Regards, -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-05-10 17:08 ` Ihor Radchenko @ 2020-05-10 19:38 ` Nicolas Goaziou 0 siblings, 0 replies; 192+ messages in thread From: Nicolas Goaziou @ 2020-05-10 19:38 UTC (permalink / raw) To: Ihor Radchenko; +Cc: emacs-orgmode Ihor Radchenko <yantar92@gmail.com> writes: > Currently, `org-flag-region' only removes one SPEC type of overlays: > > (remove-overlays from to 'invisible spec) > > If we change it to > > (remove-overlays from to 'invisible spec) > (when flag > (remove-overlays from to 'invisible 'org-hide-drawer) > ... > ) > > then all the extra drawer overlays in the flagged region will be > removed. It will require re-creating those extra overlays later if the > region is revealed again though. Exactly. This would be equivalent to drop `org-hide-drawer' altogether, which we did for property drawers. You have to fold again every drawer after each visibility change. For the record, this is the initial bug `org-hide-drawer' was trying to solve. Back to square one. Also, we would have the same problem with blocks. ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-05-08 16:38 ` Nicolas Goaziou 2020-05-09 13:58 ` Nicolas Goaziou @ 2020-05-09 15:40 ` Ihor Radchenko 2020-05-09 16:30 ` Ihor Radchenko 1 sibling, 1 reply; 192+ messages in thread From: Ihor Radchenko @ 2020-05-09 15:40 UTC (permalink / raw) To: Nicolas Goaziou; +Cc: emacs-orgmode [-- Attachment #1: Type: text/plain, Size: 4813 bytes --] I have prepared a patch taking into account your comments and fixing other issues, reported by Karl Voit and found by myself. Summary of what is done in the patch: 1. iSearching in drawers is rewritten using using isearch-filter-predicate and isearch-mode-end-hook. The idea is to create temporary overlays in place of drawers to make isearch work as usual. 2. Change org-show-set-visibility to consider text properties. This makes helm-occur open drawers. 3. Make sure (partially) that text inserted into hidden drawers is also hidden (to avoid glitches reported by Karl Voit). The reason why it was happening was because `insert' does not inherit text properties by default, which means that all the inserted text is visible by default. I have changes some instances of insert and insert-before-markers to thair *-and-inherit versions. Still looking into where else I need to do the replacement. Note that "glitch" might appear in many external packages writing into org drawers. I do not think that insert-and-inherit is often used or even known. Remaining problems: 1. insert-* -> insert-*-and-inherit replacement will at least need to be done in org-table.el and probably other places 2. I found hi-lock re-opening drawers after exiting isearch for some reason. This happens when hi-lock tries to highlight isearch matches. Not sure about the cause. 3. There is still some visual glitch when unnecessary org-ellipsis is shown when text was inserted into hidden property drawer, though the inserted text itself is hidden. >> (defun org-find-text-property-region (pos prop) >> "Find a region containing PROP text property around point POS." >> (require 'org-macs) ;; org-with-point-at >> (org-with-point-at pos > > Do we really need that since every function has a POS argument anyway? > Is it for the `widen' part? Yes, it is not needed. Fixed. >> (let* ((beg (and (get-text-property pos prop) pos)) >> (end beg)) >> (when beg >> (setq beg (or (previous-single-property-change pos prop) >> beg)) > > Shouldn't fall-back be (point-min)? > >> (setq end (or (next-single-property-change pos prop) >> end)) > > And (point-max) here? No, (point-min) and (point-max) may cause problems there. previous/next-single-property-change returns nil when called at the beginning/end of the region with given text property. Falling back to (point-min/max) may wrongly return too large region. > Nitpick: `equal' -> = Fixed. > Or, it seems nicer to `add-function' around `isearch-filter-predicate' > and extend isearch-filter-visible to support (i.e., stop at, and > display) invisible text through text properties. Done. I used (setq-local isearch-filter-predicate #'org--isearch-filter-predicate), which should be even cleaner. > I wonder how it compares to drawers using the same invisible spec as > headlines, as it was the case before. Could you give it a try? > I think hiding all property drawers right after opening a subtree is > fast enough. I am not sure what you refer to. Just saw your relevant commit. Will test ASAP. Without testing, the code does not seem to change the number of overlays. A new overlay is still created for each property drawer. As I mentioned in the first email, the large number of overlays is what makes Emacs slow. Citing Eli Zaretskii's reply to my Bug#354553, explaining why Emacs becomes slow on large org file: "... When C-n calls vertical-motion, the latter needs to find the buffer position displayed directly below the place where you typed C-n. Since much of the text between these places, vertical-motion needs to skip the invisible text as quickly as possible, because from the user's POV that text "doesn't exist": it isn't on the screen. However, Org makes this skipping exceedingly hard, because (1) it uses overlays (as opposed to text properties) to hide text, and (2) it puts an awful lot of overlays on the hidden text: there are 18400 overlays in this file's buffer, 17500 of them between the 3rd and the 4th heading. Because of this, vertical-motion must examine each and every overlay as it moves through the text, because each overlay can potentially change the 'invisible' property of text, or it might have a display string that needs to be displayed. So instead of skipping all that hidden text in one go, vertical-motion loops over those 17.5K overlays examining the properties of each one of them. And that takes time." I imagine that opening subtree will also require cycling over the [many] overlays in the subtree. > Another option, as I already suggested, would be to use text-properties > on property drawers only. Ignoring isearch inside those sounds > tolerable, at least. Hope the patch below is a reasonable solution to isearch problem with 'invisible text properties. Best, Ihor [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: org-mode-drawertextprop.patch --] [-- Type: text/x-diff, Size: 13892 bytes --] diff --git a/lisp/org-clock.el b/lisp/org-clock.el index 34179096d..463b28f47 100644 --- a/lisp/org-clock.el +++ b/lisp/org-clock.el @@ -1359,14 +1359,14 @@ the default behavior." (sit-for 2) (throw 'abort nil)) (t - (insert-before-markers "\n") + (insert-before-markers-and-inherit "\n") (backward-char 1) (when (and (save-excursion (end-of-line 0) (org-in-item-p))) (beginning-of-line 1) (indent-line-to (- (current-indentation) 2))) - (insert org-clock-string " ") + (insert-and-inherit org-clock-string " ") (setq org-clock-effort (org-entry-get (point) org-effort-property)) (setq org-clock-total-time (org-clock-sum-current-item (org-clock-get-sum-start))) @@ -1658,7 +1658,7 @@ to, overriding the existing value of `org-clock-out-switch-to-state'." (if fail-quietly (throw 'exit nil) (error "Clock start time is gone"))) (goto-char (match-end 0)) (delete-region (point) (point-at-eol)) - (insert "--") + (insert-and-inherit "--") (setq te (org-insert-time-stamp (or at-time now) 'with-hm 'inactive)) (setq s (org-time-convert-to-integer (time-subtract @@ -1666,7 +1666,7 @@ to, overriding the existing value of `org-clock-out-switch-to-state'." (org-time-string-to-time ts))) h (floor s 3600) m (floor (mod s 3600) 60)) - (insert " => " (format "%2d:%02d" h m)) + (insert-and-inherit " => " (format "%2d:%02d" h m)) (move-marker org-clock-marker nil) (move-marker org-clock-hd-marker nil) ;; Possibly remove zero time clocks. However, do not add diff --git a/lisp/org-macs.el b/lisp/org-macs.el index a02f713ca..4b0e23f6a 100644 --- a/lisp/org-macs.el +++ b/lisp/org-macs.el @@ -682,7 +682,7 @@ When NEXT is non-nil, check the next line instead." \f -;;; Overlays +;;; Overlays and text properties (defun org-overlay-display (ovl text &optional face evap) "Make overlay OVL display TEXT with face FACE." @@ -705,18 +705,44 @@ If DELETE is non-nil, delete all those overlays." (delete (delete-overlay ov)) (t (push ov found)))))) +(defun org--find-text-property-region (pos prop) + "Find a region containing PROP text property around point POS." + (let* ((beg (and (get-text-property pos prop) pos)) + (end beg)) + (when beg + ;; when beg is the first point in the region, `previous-single-property-change' + ;; will return nil. + (setq beg (or (previous-single-property-change pos prop) + beg)) + ;; when end is the last point in the region, `next-single-property-change' + ;; will return nil. + (setq end (or (next-single-property-change pos prop) + end)) + (unless (= beg end) ; this should not happen + (cons beg end))))) + (defun org-flag-region (from to flag spec) "Hide or show lines from FROM to TO, according to FLAG. SPEC is the invisibility spec, as a symbol." - (remove-overlays from to 'invisible spec) - ;; Use `front-advance' since text right before to the beginning of - ;; the overlay belongs to the visible line than to the contents. - (when flag - (let ((o (make-overlay from to nil 'front-advance))) - (overlay-put o 'evaporate t) - (overlay-put o 'invisible spec) - (overlay-put o 'isearch-open-invisible #'delete-overlay)))) - + (pcase spec + ('outline + (remove-overlays from to 'invisible spec) + ;; Use `front-advance' since text right before to the beginning of + ;; the overlay belongs to the visible line than to the contents. + (when flag + (let ((o (make-overlay from to nil 'front-advance))) + (overlay-put o 'evaporate t) + (overlay-put o 'invisible spec) + (overlay-put o 'isearch-open-invisible #'delete-overlay)))) + (_ + ;; Use text properties instead of overlays for speed. + ;; Overlays are too slow (Emacs Bug#35453). + (with-silent-modifications + (remove-text-properties from to '(invisible nil)) + (when flag + (put-text-property from to 'rear-non-sticky nil) + (put-text-property from to 'front-sticky t) + (put-text-property from to 'invisible spec)))))) \f ;;; Regexp matching diff --git a/lisp/org.el b/lisp/org.el index 287fe30e8..335f68a85 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -114,6 +114,7 @@ Stars are put in group 1 and the trimmed body in group 2.") (declare-function cdlatex-math-symbol "ext:cdlatex") (declare-function Info-goto-node "info" (nodename &optional fork strict-case)) (declare-function isearch-no-upper-case-p "isearch" (string regexp-flag)) +(declare-function isearch-filter-visible "isearch" (beg end)) (declare-function org-add-archive-files "org-archive" (files)) (declare-function org-agenda-entry-get-agenda-timestamp "org-agenda" (pom)) (declare-function org-agenda-list "org-agenda" (&optional arg start-day span with-hour)) @@ -4869,6 +4870,10 @@ The following commands are available: (setq-local outline-isearch-open-invisible-function (lambda (&rest _) (org-show-context 'isearch))) + ;; Make isearch search in blocks hidden via text properties + (setq-local isearch-filter-predicate #'org--isearch-filter-predicate) + (add-hook 'isearch-mode-end-hook #'org--clear-isearch-overlays nil 'local) + ;; Setup the pcomplete hooks (setq-local pcomplete-command-completion-function #'org-pcomplete-initial) (setq-local pcomplete-command-name-function #'org-command-at-point) @@ -5859,9 +5864,26 @@ If TAG is a number, get the corresponding match group." (inhibit-modification-hooks t) deactivate-mark buffer-file-name buffer-file-truename) (decompose-region beg end) + ;; do not remove invisible text properties specified by + ;; 'org-hide-block and 'org-hide-drawer (but remove 'org-link) + ;; this is needed to keep the drawers and blocks hidden unless + ;; they are toggled by user + ;; Note: The below may be too specific and create troubles + ;; if more invisibility specs are added to org in future + (let ((pos beg) + next spec) + (while (< pos end) + (setq next (next-single-property-change pos 'invisible nil end) + spec (get-text-property pos 'invisible)) + (unless (memq spec (list 'org-hide-block + 'org-hide-drawer)) + (remove-text-properties pos next '(invisible t))) + (setq pos next))) (remove-text-properties beg end '(mouse-face t keymap t org-linked-text t - invisible t intangible t + ;; Do not remove all invisible during fontification + ;; invisible t + intangible t org-emphasis t)) (org-remove-font-lock-display-properties beg end))) @@ -6677,8 +6699,13 @@ information." ;; expose it. (dolist (o (overlays-at (point))) (when (memq (overlay-get o 'invisible) - '(org-hide-block org-hide-drawer outline)) + '(outline)) (delete-overlay o))) + (when (memq (get-text-property (point) 'invisible) + '(org-hide-block org-hide-drawer)) + (let ((spec (get-text-property (point) 'invisible)) + (region (org--find-text-property-region (point) 'invisible))) + (org-flag-region (car region) (cdr region) nil spec))) (unless (org-before-first-heading-p) (org-with-limited-levels (cl-case detail @@ -10849,8 +10876,8 @@ EXTRA is additional text that will be inserted into the notes buffer." (unless (eq org-log-note-purpose 'clock-out) (goto-char (org-log-beginning t))) ;; Make sure point is at the beginning of an empty line. - (cond ((not (bolp)) (let ((inhibit-read-only t)) (insert "\n"))) - ((looking-at "[ \t]*\\S-") (save-excursion (insert "\n")))) + (cond ((not (bolp)) (let ((inhibit-read-only t)) (insert-and-inherit "\n"))) + ((looking-at "[ \t]*\\S-") (save-excursion (insert-and-inherit "\n")))) ;; In an existing list, add a new item at the top level. ;; Otherwise, indent line like a regular one. (let ((itemp (org-in-item-p))) @@ -10860,12 +10887,12 @@ EXTRA is additional text that will be inserted into the notes buffer." (goto-char itemp) (org-list-struct)))) (org-list-get-ind (org-list-get-top-point struct) struct))) (org-indent-line))) - (insert (org-list-bullet-string "-") (pop lines)) + (insert-and-inherit (org-list-bullet-string "-") (pop lines)) (let ((ind (org-list-item-body-column (line-beginning-position)))) (dolist (line lines) - (insert "\n") + (insert-and-inherit "\n") (indent-line-to ind) - (insert line))) + (insert-and-inherit line))) (message "Note stored") (org-back-to-heading t)) ;; Fix `buffer-undo-list' when `org-store-log-note' is called @@ -13036,10 +13063,10 @@ decreases scheduled or deadline date by one day." (progn (delete-region (match-beginning 0) (match-end 0)) (goto-char (match-beginning 0))) (goto-char end) - (insert "\n") + (insert-and-inherit "\n") (backward-char)) - (insert ":" property ":") - (when value (insert " " value)) + (insert-and-inherit ":" property ":") + (when value (insert-and-inherit " " value)) (org-indent-line))))) (run-hook-with-args 'org-property-changed-functions property value))) @@ -14177,7 +14204,7 @@ The command returns the inserted time stamp." (let ((fmt (funcall (if with-hm 'cdr 'car) org-time-stamp-formats)) stamp) (when inactive (setq fmt (concat "[" (substring fmt 1 -1) "]"))) - (insert-before-markers (or pre "")) + (insert-before-markers-and-inherit (or pre "")) (when (listp extra) (setq extra (car extra)) (if (and (stringp extra) @@ -14188,8 +14215,8 @@ The command returns the inserted time stamp." (setq extra nil))) (when extra (setq fmt (concat (substring fmt 0 -1) extra (substring fmt -1)))) - (insert-before-markers (setq stamp (format-time-string fmt time))) - (insert-before-markers (or post "")) + (insert-before-markers-and-inherit (setq stamp (format-time-string fmt time))) + (insert-before-markers-and-inherit (or post "")) (setq org-last-inserted-timestamp stamp))) (defun org-toggle-time-stamp-overlays () @@ -20913,6 +20940,79 @@ Started from `gnus-info-find-node'." (t default-org-info-node)))))) \f + +;;; Make isearch search in some text hidden via text propertoes + +(defvar org--isearch-overlays nil + "List of overlays temporarily created during isearch. +This is used to allow searching in regions hidden via text properties. +As for [2020-05-09 Sat], Isearch only has special handling of hidden overlays. +Any text hidden via text properties is not revealed even if `search-invisible' +is set to 't.") + +;; Not sure if it needs to be a user option +;; One might want to reveal hidden text in, for example, hidden parts of the links. +;; Currently, hidden text in links is never revealed by isearch. +(defvar org-isearch-specs '(org-hide-block + org-hide-drawer) + "List of text invisibility specs to be searched by isearch. +By default ([2020-05-09 Sat]), isearch does not search in hidden text, +which was made invisible using text properties. Isearch will be forced +to search in hidden text with any of the listed 'invisible property value.") + +(defun org--create-isearch-overlays (beg end) + "Replace text property invisibility spec by overlays between BEG and END. +All the regions with invisibility text property spec from +`org-isearch-specs' will be changed to use overlays instead +of text properties. The created overlays will be stored in +`org--isearch-overlays'." + (let ((pos beg)) + (while (< pos end) + (when-let* ((spec (get-text-property pos 'invisible)) + (spec (memq spec org-isearch-specs)) + (region (org--find-text-property-region pos 'invisible))) + ;; Changing text properties is considered buffer modification. + ;; We do not want it here. + (with-silent-modifications + ;; The overlay is modelled after `org-flag-region' [2020-05-09 Sat] + ;; overlay for 'outline blocks. + (let ((o (make-overlay (car region) (cdr region) nil 'front-advance))) + (overlay-put o 'evaporate t) + (overlay-put o 'invisible spec) + ;; `delete-overlay' here means that spec information will be lost + ;; for the region. The region will remain visible. + (overlay-put o 'isearch-open-invisible #'delete-overlay) + (push o org--isearch-overlays)) + (remove-text-properties (car region) (cdr region) '(invisible nil)))) + (setq pos (next-single-property-change pos 'invisible nil end))))) + +(defun org--isearch-filter-predicate (beg end) + "Return non-nil if text between BEG and END is deemed visible by Isearch. +This function is intended to be used as `isearch-filter-predicate'. +Unlike `isearch-filter-visible', make text with 'invisible text property +value listed in `org-isearch-specs' visible to Isearch." + (org--create-isearch-overlays beg end) ;; trick isearch by creating overlays in place of invisible text + (isearch-filter-visible beg end)) + +(defun org--clear-isearch-overlay (ov) + "Convert OV region back into using text properties." + (when-let ((spec (overlay-get ov 'invisible))) ;; ignore deleted overlays + ;; Changing text properties is considered buffer modification. + ;; We do not want it here. + (with-silent-modifications + (put-text-property (overlay-start ov) (overlay-end ov) 'invisible spec))) + (when (member ov isearch-opened-overlays) + (setq isearch-opened-overlays (delete ov isearch-opened-overlays))) + (delete-overlay ov)) + +(defun org--clear-isearch-overlays () + "Convert overlays from `org--isearch-overlays' back into using text properties." + (when org--isearch-overlays + (mapc #'org--clear-isearch-overlay org--isearch-overlays) + (setq org--isearch-overlays nil))) + +\f + ;;; Finish up (add-hook 'org-mode-hook ;remove overlays when changing major mode [-- Attachment #3: Type: text/plain, Size: 3286 bytes --] Nicolas Goaziou <mail@nicolasgoaziou.fr> writes: > Hello, > > Ihor Radchenko <yantar92@gmail.com> writes: > >> ;; Unfortunately isearch, sets inhibit-point-motion-hooks and we >> ;; cannot even use cursor-sensor-functions as a workaround >> ;; I used a less ideas approach with advice to isearch-search-string as >> ;; a workaround > > OK. > >> (defun org-find-text-property-region (pos prop) >> "Find a region containing PROP text property around point POS." >> (require 'org-macs) ;; org-with-point-at >> (org-with-point-at pos > > Do we really need that since every function has a POS argument anyway? > Is it for the `widen' part? > >> (let* ((beg (and (get-text-property pos prop) pos)) >> (end beg)) >> (when beg >> (setq beg (or (previous-single-property-change pos prop) >> beg)) > > Shouldn't fall-back be (point-min)? > >> (setq end (or (next-single-property-change pos prop) >> end)) > > And (point-max) here? > >> (unless (equal beg end) > > Nitpick: `equal' -> = > >> (cons beg end)))))) > >> ;; :FIXME: re-hide properties when point moves away >> (define-advice isearch-search-string (:after (&rest _) put-overlay) >> "Reveal hidden text at point." >> (when-let ((region (org-find-text-property-region (point) 'invisible))) >> (with-silent-modifications >> (put-text-property (car region) (cdr region) 'org-invisible (get-text-property (point) 'invisible))) >> (remove-text-properties (car region) (cdr region) '(invisible nil)))) > > Could we use `isearch-update-post-hook' here? > > Or, it seems nicer to `add-function' around `isearch-filter-predicate' > and extend isearch-filter-visible to support (i.e., stop at, and > display) invisible text through text properties. > >> ;; this seems to be unstable, but I cannot figure out why >> (defun org-restore-invisibility-specs (&rest _) >> "" >> (let ((pos (point-min))) >> (while (< (setq pos (next-single-property-change pos 'org-invisible nil (point-max))) (point-max)) >> (when-let ((region (org-find-text-property-region pos 'org-invisible))) >> (with-silent-modifications >> (put-text-property (car region) (cdr region) 'invisible (get-text-property pos 'org-invisible)) >> (remove-text-properties (car region) (cdr region) '(org-invisible nil))))))) > > Could you use the hook above to store all visited invisible texts, and > re-hide them at the end of the search, e.g., using > `isearch-mode-end-hook'? > >> (add-hook 'post-command-hook #'org-restore-invisibility-specs) > > Ouch. I hope we can avoid that. > > I wonder how it compares to drawers using the same invisible spec as > headlines, as it was the case before. Could you give it a try? > > I think hiding all property drawers right after opening a subtree is > fast enough. > > Another option, as I already suggested, would be to use text-properties > on property drawers only. Ignoring isearch inside those sounds > tolerable, at least. > > Regards, > > -- > Nicolas Goaziou -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply related [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-05-09 15:40 ` Ihor Radchenko @ 2020-05-09 16:30 ` Ihor Radchenko 2020-05-09 17:32 ` Nicolas Goaziou 0 siblings, 1 reply; 192+ messages in thread From: Ihor Radchenko @ 2020-05-09 16:30 UTC (permalink / raw) To: emacs-orgmode, Nicolas Goaziou Note that the following commits seems to break my patch: 074ea1629 origin/master master Deprecate `org-cycle-hide-drawers' 1027e0256 Implement `org-cycle-hide-property-drawers' 8b05c06d4 Use `outline' invisibility spec for property drawers The patch should work for commit ed0e75d24 in master. Best, Ihor Ihor Radchenko <yantar92@gmail.com> writes: > I have prepared a patch taking into account your comments and fixing > other issues, reported by Karl Voit and found by myself. > > Summary of what is done in the patch: > > 1. iSearching in drawers is rewritten using using > isearch-filter-predicate and isearch-mode-end-hook. > The idea is to create temporary overlays in place of drawers to make > isearch work as usual. > > 2. Change org-show-set-visibility to consider text properties. This > makes helm-occur open drawers. > > 3. Make sure (partially) that text inserted into hidden drawers is also > hidden (to avoid glitches reported by Karl Voit). > The reason why it was happening was because `insert' does not inherit > text properties by default, which means that all the inserted text is > visible by default. I have changes some instances of insert and > insert-before-markers to thair *-and-inherit versions. Still looking > into where else I need to do the replacement. > > Note that "glitch" might appear in many external packages writing into > org drawers. I do not think that insert-and-inherit is often used or > even known. > > Remaining problems: > > 1. insert-* -> insert-*-and-inherit replacement will at least need to be > done in org-table.el and probably other places > > 2. I found hi-lock re-opening drawers after exiting isearch for some > reason. This happens when hi-lock tries to highlight isearch matches. > Not sure about the cause. > > 3. There is still some visual glitch when unnecessary org-ellipsis is > shown when text was inserted into hidden property drawer, though the > inserted text itself is hidden. > >>> (defun org-find-text-property-region (pos prop) >>> "Find a region containing PROP text property around point POS." >>> (require 'org-macs) ;; org-with-point-at >>> (org-with-point-at pos >> >> Do we really need that since every function has a POS argument anyway? >> Is it for the `widen' part? > > Yes, it is not needed. Fixed. > >>> (let* ((beg (and (get-text-property pos prop) pos)) >>> (end beg)) >>> (when beg >>> (setq beg (or (previous-single-property-change pos prop) >>> beg)) >> >> Shouldn't fall-back be (point-min)? >> >>> (setq end (or (next-single-property-change pos prop) >>> end)) >> >> And (point-max) here? > > No, (point-min) and (point-max) may cause problems there. > previous/next-single-property-change returns nil when called at the > beginning/end of the region with given text property. Falling back to > (point-min/max) may wrongly return too large region. > >> Nitpick: `equal' -> = > > Fixed. > >> Or, it seems nicer to `add-function' around `isearch-filter-predicate' >> and extend isearch-filter-visible to support (i.e., stop at, and >> display) invisible text through text properties. > > Done. I used > (setq-local isearch-filter-predicate #'org--isearch-filter-predicate), > which should be even cleaner. > >> I wonder how it compares to drawers using the same invisible spec as >> headlines, as it was the case before. Could you give it a try? > >> I think hiding all property drawers right after opening a subtree is >> fast enough. > > I am not sure what you refer to. Just saw your relevant commit. Will > test ASAP. > > Without testing, the code does not seem to change the number of > overlays. A new overlay is still created for each property drawer. > As I mentioned in the first email, the large number of overlays is what > makes Emacs slow. Citing Eli Zaretskii's reply to my Bug#354553, > explaining why Emacs becomes slow on large org file: > > "... When C-n calls vertical-motion, the latter needs to find the > buffer position displayed directly below the place where you typed > C-n. Since much of the text between these places, vertical-motion > needs to skip the invisible text as quickly as possible, because from > the user's POV that text "doesn't exist": it isn't on the screen. > However, Org makes this skipping exceedingly hard, because (1) it uses > overlays (as opposed to text properties) to hide text, and (2) it puts > an awful lot of overlays on the hidden text: there are 18400 overlays > in this file's buffer, 17500 of them between the 3rd and the 4th > heading. Because of this, vertical-motion must examine each and every > overlay as it moves through the text, because each overlay can > potentially change the 'invisible' property of text, or it might have > a display string that needs to be displayed. So instead of skipping > all that hidden text in one go, vertical-motion loops over those 17.5K > overlays examining the properties of each one of them. And that takes > time." > > I imagine that opening subtree will also require cycling over the > [many] overlays in the subtree. > >> Another option, as I already suggested, would be to use text-properties >> on property drawers only. Ignoring isearch inside those sounds >> tolerable, at least. > > Hope the patch below is a reasonable solution to isearch problem with > 'invisible text properties. > > Best, > Ihor > > diff --git a/lisp/org-clock.el b/lisp/org-clock.el > index 34179096d..463b28f47 100644 > --- a/lisp/org-clock.el > +++ b/lisp/org-clock.el > @@ -1359,14 +1359,14 @@ the default behavior." > (sit-for 2) > (throw 'abort nil)) > (t > - (insert-before-markers "\n") > + (insert-before-markers-and-inherit "\n") > (backward-char 1) > (when (and (save-excursion > (end-of-line 0) > (org-in-item-p))) > (beginning-of-line 1) > (indent-line-to (- (current-indentation) 2))) > - (insert org-clock-string " ") > + (insert-and-inherit org-clock-string " ") > (setq org-clock-effort (org-entry-get (point) org-effort-property)) > (setq org-clock-total-time (org-clock-sum-current-item > (org-clock-get-sum-start))) > @@ -1658,7 +1658,7 @@ to, overriding the existing value of `org-clock-out-switch-to-state'." > (if fail-quietly (throw 'exit nil) (error "Clock start time is gone"))) > (goto-char (match-end 0)) > (delete-region (point) (point-at-eol)) > - (insert "--") > + (insert-and-inherit "--") > (setq te (org-insert-time-stamp (or at-time now) 'with-hm 'inactive)) > (setq s (org-time-convert-to-integer > (time-subtract > @@ -1666,7 +1666,7 @@ to, overriding the existing value of `org-clock-out-switch-to-state'." > (org-time-string-to-time ts))) > h (floor s 3600) > m (floor (mod s 3600) 60)) > - (insert " => " (format "%2d:%02d" h m)) > + (insert-and-inherit " => " (format "%2d:%02d" h m)) > (move-marker org-clock-marker nil) > (move-marker org-clock-hd-marker nil) > ;; Possibly remove zero time clocks. However, do not add > diff --git a/lisp/org-macs.el b/lisp/org-macs.el > index a02f713ca..4b0e23f6a 100644 > --- a/lisp/org-macs.el > +++ b/lisp/org-macs.el > @@ -682,7 +682,7 @@ When NEXT is non-nil, check the next line instead." > > > \f > -;;; Overlays > +;;; Overlays and text properties > > (defun org-overlay-display (ovl text &optional face evap) > "Make overlay OVL display TEXT with face FACE." > @@ -705,18 +705,44 @@ If DELETE is non-nil, delete all those overlays." > (delete (delete-overlay ov)) > (t (push ov found)))))) > > +(defun org--find-text-property-region (pos prop) > + "Find a region containing PROP text property around point POS." > + (let* ((beg (and (get-text-property pos prop) pos)) > + (end beg)) > + (when beg > + ;; when beg is the first point in the region, `previous-single-property-change' > + ;; will return nil. > + (setq beg (or (previous-single-property-change pos prop) > + beg)) > + ;; when end is the last point in the region, `next-single-property-change' > + ;; will return nil. > + (setq end (or (next-single-property-change pos prop) > + end)) > + (unless (= beg end) ; this should not happen > + (cons beg end))))) > + > (defun org-flag-region (from to flag spec) > "Hide or show lines from FROM to TO, according to FLAG. > SPEC is the invisibility spec, as a symbol." > - (remove-overlays from to 'invisible spec) > - ;; Use `front-advance' since text right before to the beginning of > - ;; the overlay belongs to the visible line than to the contents. > - (when flag > - (let ((o (make-overlay from to nil 'front-advance))) > - (overlay-put o 'evaporate t) > - (overlay-put o 'invisible spec) > - (overlay-put o 'isearch-open-invisible #'delete-overlay)))) > - > + (pcase spec > + ('outline > + (remove-overlays from to 'invisible spec) > + ;; Use `front-advance' since text right before to the beginning of > + ;; the overlay belongs to the visible line than to the contents. > + (when flag > + (let ((o (make-overlay from to nil 'front-advance))) > + (overlay-put o 'evaporate t) > + (overlay-put o 'invisible spec) > + (overlay-put o 'isearch-open-invisible #'delete-overlay)))) > + (_ > + ;; Use text properties instead of overlays for speed. > + ;; Overlays are too slow (Emacs Bug#35453). > + (with-silent-modifications > + (remove-text-properties from to '(invisible nil)) > + (when flag > + (put-text-property from to 'rear-non-sticky nil) > + (put-text-property from to 'front-sticky t) > + (put-text-property from to 'invisible spec)))))) > > \f > ;;; Regexp matching > diff --git a/lisp/org.el b/lisp/org.el > index 287fe30e8..335f68a85 100644 > --- a/lisp/org.el > +++ b/lisp/org.el > @@ -114,6 +114,7 @@ Stars are put in group 1 and the trimmed body in group 2.") > (declare-function cdlatex-math-symbol "ext:cdlatex") > (declare-function Info-goto-node "info" (nodename &optional fork strict-case)) > (declare-function isearch-no-upper-case-p "isearch" (string regexp-flag)) > +(declare-function isearch-filter-visible "isearch" (beg end)) > (declare-function org-add-archive-files "org-archive" (files)) > (declare-function org-agenda-entry-get-agenda-timestamp "org-agenda" (pom)) > (declare-function org-agenda-list "org-agenda" (&optional arg start-day span with-hour)) > @@ -4869,6 +4870,10 @@ The following commands are available: > (setq-local outline-isearch-open-invisible-function > (lambda (&rest _) (org-show-context 'isearch))) > > + ;; Make isearch search in blocks hidden via text properties > + (setq-local isearch-filter-predicate #'org--isearch-filter-predicate) > + (add-hook 'isearch-mode-end-hook #'org--clear-isearch-overlays nil 'local) > + > ;; Setup the pcomplete hooks > (setq-local pcomplete-command-completion-function #'org-pcomplete-initial) > (setq-local pcomplete-command-name-function #'org-command-at-point) > @@ -5859,9 +5864,26 @@ If TAG is a number, get the corresponding match group." > (inhibit-modification-hooks t) > deactivate-mark buffer-file-name buffer-file-truename) > (decompose-region beg end) > + ;; do not remove invisible text properties specified by > + ;; 'org-hide-block and 'org-hide-drawer (but remove 'org-link) > + ;; this is needed to keep the drawers and blocks hidden unless > + ;; they are toggled by user > + ;; Note: The below may be too specific and create troubles > + ;; if more invisibility specs are added to org in future > + (let ((pos beg) > + next spec) > + (while (< pos end) > + (setq next (next-single-property-change pos 'invisible nil end) > + spec (get-text-property pos 'invisible)) > + (unless (memq spec (list 'org-hide-block > + 'org-hide-drawer)) > + (remove-text-properties pos next '(invisible t))) > + (setq pos next))) > (remove-text-properties beg end > '(mouse-face t keymap t org-linked-text t > - invisible t intangible t > + ;; Do not remove all invisible during fontification > + ;; invisible t > + intangible t > org-emphasis t)) > (org-remove-font-lock-display-properties beg end))) > > @@ -6677,8 +6699,13 @@ information." > ;; expose it. > (dolist (o (overlays-at (point))) > (when (memq (overlay-get o 'invisible) > - '(org-hide-block org-hide-drawer outline)) > + '(outline)) > (delete-overlay o))) > + (when (memq (get-text-property (point) 'invisible) > + '(org-hide-block org-hide-drawer)) > + (let ((spec (get-text-property (point) 'invisible)) > + (region (org--find-text-property-region (point) 'invisible))) > + (org-flag-region (car region) (cdr region) nil spec))) > (unless (org-before-first-heading-p) > (org-with-limited-levels > (cl-case detail > @@ -10849,8 +10876,8 @@ EXTRA is additional text that will be inserted into the notes buffer." > (unless (eq org-log-note-purpose 'clock-out) > (goto-char (org-log-beginning t))) > ;; Make sure point is at the beginning of an empty line. > - (cond ((not (bolp)) (let ((inhibit-read-only t)) (insert "\n"))) > - ((looking-at "[ \t]*\\S-") (save-excursion (insert "\n")))) > + (cond ((not (bolp)) (let ((inhibit-read-only t)) (insert-and-inherit "\n"))) > + ((looking-at "[ \t]*\\S-") (save-excursion (insert-and-inherit "\n")))) > ;; In an existing list, add a new item at the top level. > ;; Otherwise, indent line like a regular one. > (let ((itemp (org-in-item-p))) > @@ -10860,12 +10887,12 @@ EXTRA is additional text that will be inserted into the notes buffer." > (goto-char itemp) (org-list-struct)))) > (org-list-get-ind (org-list-get-top-point struct) struct))) > (org-indent-line))) > - (insert (org-list-bullet-string "-") (pop lines)) > + (insert-and-inherit (org-list-bullet-string "-") (pop lines)) > (let ((ind (org-list-item-body-column (line-beginning-position)))) > (dolist (line lines) > - (insert "\n") > + (insert-and-inherit "\n") > (indent-line-to ind) > - (insert line))) > + (insert-and-inherit line))) > (message "Note stored") > (org-back-to-heading t)) > ;; Fix `buffer-undo-list' when `org-store-log-note' is called > @@ -13036,10 +13063,10 @@ decreases scheduled or deadline date by one day." > (progn (delete-region (match-beginning 0) (match-end 0)) > (goto-char (match-beginning 0))) > (goto-char end) > - (insert "\n") > + (insert-and-inherit "\n") > (backward-char)) > - (insert ":" property ":") > - (when value (insert " " value)) > + (insert-and-inherit ":" property ":") > + (when value (insert-and-inherit " " value)) > (org-indent-line))))) > (run-hook-with-args 'org-property-changed-functions property value))) > > @@ -14177,7 +14204,7 @@ The command returns the inserted time stamp." > (let ((fmt (funcall (if with-hm 'cdr 'car) org-time-stamp-formats)) > stamp) > (when inactive (setq fmt (concat "[" (substring fmt 1 -1) "]"))) > - (insert-before-markers (or pre "")) > + (insert-before-markers-and-inherit (or pre "")) > (when (listp extra) > (setq extra (car extra)) > (if (and (stringp extra) > @@ -14188,8 +14215,8 @@ The command returns the inserted time stamp." > (setq extra nil))) > (when extra > (setq fmt (concat (substring fmt 0 -1) extra (substring fmt -1)))) > - (insert-before-markers (setq stamp (format-time-string fmt time))) > - (insert-before-markers (or post "")) > + (insert-before-markers-and-inherit (setq stamp (format-time-string fmt time))) > + (insert-before-markers-and-inherit (or post "")) > (setq org-last-inserted-timestamp stamp))) > > (defun org-toggle-time-stamp-overlays () > @@ -20913,6 +20940,79 @@ Started from `gnus-info-find-node'." > (t default-org-info-node)))))) > > \f > + > +;;; Make isearch search in some text hidden via text propertoes > + > +(defvar org--isearch-overlays nil > + "List of overlays temporarily created during isearch. > +This is used to allow searching in regions hidden via text properties. > +As for [2020-05-09 Sat], Isearch only has special handling of hidden overlays. > +Any text hidden via text properties is not revealed even if `search-invisible' > +is set to 't.") > + > +;; Not sure if it needs to be a user option > +;; One might want to reveal hidden text in, for example, hidden parts of the links. > +;; Currently, hidden text in links is never revealed by isearch. > +(defvar org-isearch-specs '(org-hide-block > + org-hide-drawer) > + "List of text invisibility specs to be searched by isearch. > +By default ([2020-05-09 Sat]), isearch does not search in hidden text, > +which was made invisible using text properties. Isearch will be forced > +to search in hidden text with any of the listed 'invisible property value.") > + > +(defun org--create-isearch-overlays (beg end) > + "Replace text property invisibility spec by overlays between BEG and END. > +All the regions with invisibility text property spec from > +`org-isearch-specs' will be changed to use overlays instead > +of text properties. The created overlays will be stored in > +`org--isearch-overlays'." > + (let ((pos beg)) > + (while (< pos end) > + (when-let* ((spec (get-text-property pos 'invisible)) > + (spec (memq spec org-isearch-specs)) > + (region (org--find-text-property-region pos 'invisible))) > + ;; Changing text properties is considered buffer modification. > + ;; We do not want it here. > + (with-silent-modifications > + ;; The overlay is modelled after `org-flag-region' [2020-05-09 Sat] > + ;; overlay for 'outline blocks. > + (let ((o (make-overlay (car region) (cdr region) nil 'front-advance))) > + (overlay-put o 'evaporate t) > + (overlay-put o 'invisible spec) > + ;; `delete-overlay' here means that spec information will be lost > + ;; for the region. The region will remain visible. > + (overlay-put o 'isearch-open-invisible #'delete-overlay) > + (push o org--isearch-overlays)) > + (remove-text-properties (car region) (cdr region) '(invisible nil)))) > + (setq pos (next-single-property-change pos 'invisible nil end))))) > + > +(defun org--isearch-filter-predicate (beg end) > + "Return non-nil if text between BEG and END is deemed visible by Isearch. > +This function is intended to be used as `isearch-filter-predicate'. > +Unlike `isearch-filter-visible', make text with 'invisible text property > +value listed in `org-isearch-specs' visible to Isearch." > + (org--create-isearch-overlays beg end) ;; trick isearch by creating overlays in place of invisible text > + (isearch-filter-visible beg end)) > + > +(defun org--clear-isearch-overlay (ov) > + "Convert OV region back into using text properties." > + (when-let ((spec (overlay-get ov 'invisible))) ;; ignore deleted overlays > + ;; Changing text properties is considered buffer modification. > + ;; We do not want it here. > + (with-silent-modifications > + (put-text-property (overlay-start ov) (overlay-end ov) 'invisible spec))) > + (when (member ov isearch-opened-overlays) > + (setq isearch-opened-overlays (delete ov isearch-opened-overlays))) > + (delete-overlay ov)) > + > +(defun org--clear-isearch-overlays () > + "Convert overlays from `org--isearch-overlays' back into using text properties." > + (when org--isearch-overlays > + (mapc #'org--clear-isearch-overlay org--isearch-overlays) > + (setq org--isearch-overlays nil))) > + > +\f > + > ;;; Finish up > > (add-hook 'org-mode-hook ;remove overlays when changing major mode > > > > > Nicolas Goaziou <mail@nicolasgoaziou.fr> writes: > >> Hello, >> >> Ihor Radchenko <yantar92@gmail.com> writes: >> >>> ;; Unfortunately isearch, sets inhibit-point-motion-hooks and we >>> ;; cannot even use cursor-sensor-functions as a workaround >>> ;; I used a less ideas approach with advice to isearch-search-string as >>> ;; a workaround >> >> OK. >> >>> (defun org-find-text-property-region (pos prop) >>> "Find a region containing PROP text property around point POS." >>> (require 'org-macs) ;; org-with-point-at >>> (org-with-point-at pos >> >> Do we really need that since every function has a POS argument anyway? >> Is it for the `widen' part? >> >>> (let* ((beg (and (get-text-property pos prop) pos)) >>> (end beg)) >>> (when beg >>> (setq beg (or (previous-single-property-change pos prop) >>> beg)) >> >> Shouldn't fall-back be (point-min)? >> >>> (setq end (or (next-single-property-change pos prop) >>> end)) >> >> And (point-max) here? >> >>> (unless (equal beg end) >> >> Nitpick: `equal' -> = >> >>> (cons beg end)))))) >> >>> ;; :FIXME: re-hide properties when point moves away >>> (define-advice isearch-search-string (:after (&rest _) put-overlay) >>> "Reveal hidden text at point." >>> (when-let ((region (org-find-text-property-region (point) 'invisible))) >>> (with-silent-modifications >>> (put-text-property (car region) (cdr region) 'org-invisible (get-text-property (point) 'invisible))) >>> (remove-text-properties (car region) (cdr region) '(invisible nil)))) >> >> Could we use `isearch-update-post-hook' here? >> >> Or, it seems nicer to `add-function' around `isearch-filter-predicate' >> and extend isearch-filter-visible to support (i.e., stop at, and >> display) invisible text through text properties. >> >>> ;; this seems to be unstable, but I cannot figure out why >>> (defun org-restore-invisibility-specs (&rest _) >>> "" >>> (let ((pos (point-min))) >>> (while (< (setq pos (next-single-property-change pos 'org-invisible nil (point-max))) (point-max)) >>> (when-let ((region (org-find-text-property-region pos 'org-invisible))) >>> (with-silent-modifications >>> (put-text-property (car region) (cdr region) 'invisible (get-text-property pos 'org-invisible)) >>> (remove-text-properties (car region) (cdr region) '(org-invisible nil))))))) >> >> Could you use the hook above to store all visited invisible texts, and >> re-hide them at the end of the search, e.g., using >> `isearch-mode-end-hook'? >> >>> (add-hook 'post-command-hook #'org-restore-invisibility-specs) >> >> Ouch. I hope we can avoid that. >> >> I wonder how it compares to drawers using the same invisible spec as >> headlines, as it was the case before. Could you give it a try? >> >> I think hiding all property drawers right after opening a subtree is >> fast enough. >> >> Another option, as I already suggested, would be to use text-properties >> on property drawers only. Ignoring isearch inside those sounds >> tolerable, at least. >> >> Regards, >> >> -- >> Nicolas Goaziou > > -- > Ihor Radchenko, > PhD, > Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) > State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China > Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-05-09 16:30 ` Ihor Radchenko @ 2020-05-09 17:32 ` Nicolas Goaziou 2020-05-09 18:06 ` Ihor Radchenko 0 siblings, 1 reply; 192+ messages in thread From: Nicolas Goaziou @ 2020-05-09 17:32 UTC (permalink / raw) To: Ihor Radchenko; +Cc: emacs-orgmode Ihor Radchenko <yantar92@gmail.com> writes: > Note that the following commits seems to break my patch: Unfortunately, I don't see your patch. ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-05-09 17:32 ` Nicolas Goaziou @ 2020-05-09 18:06 ` Ihor Radchenko 2020-05-10 14:59 ` Nicolas Goaziou 0 siblings, 1 reply; 192+ messages in thread From: Ihor Radchenko @ 2020-05-09 18:06 UTC (permalink / raw) To: Nicolas Goaziou; +Cc: emacs-orgmode > Unfortunately, I don't see your patch. My response to you was blocked by your mail server: > 550 5.7.1 Reject for policy reason RULE3_2. See > http://postmaster.gandi.net The message landed on the mail list though: https://www.mail-archive.com/emacs-orgmode@gnu.org/msg127972.html Best, Ihor Nicolas Goaziou <mail@nicolasgoaziou.fr> writes: > Ihor Radchenko <yantar92@gmail.com> writes: > >> Note that the following commits seems to break my patch: > > Unfortunately, I don't see your patch. -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-05-09 18:06 ` Ihor Radchenko @ 2020-05-10 14:59 ` Nicolas Goaziou 2020-05-10 15:15 ` Kyle Meyer 2020-05-10 16:30 ` Ihor Radchenko 0 siblings, 2 replies; 192+ messages in thread From: Nicolas Goaziou @ 2020-05-10 14:59 UTC (permalink / raw) To: Ihor Radchenko; +Cc: emacs-orgmode Ihor Radchenko <yantar92@gmail.com> writes: > My response to you was blocked by your mail server: > >> 550 5.7.1 Reject for policy reason RULE3_2. See >> http://postmaster.gandi.net Aka "spam detected". Bah. > The message landed on the mail list though: > https://www.mail-archive.com/emacs-orgmode@gnu.org/msg127972.html Unfortunately, reviewing this way is not nice. The `insert-and-inherit' issue sounds serious. We cannot reasonably expect any library outside Org to use it. We could automatically extend invisible area with `after-change-functions', i.e., if we're inserting something and both side have the same `invisible' property, extend it. Using `after-change-functions' sounds bad, but this kind of check shouldn't cost much. WDYT? Regards, ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-05-10 14:59 ` Nicolas Goaziou @ 2020-05-10 15:15 ` Kyle Meyer 2020-05-10 16:30 ` Ihor Radchenko 1 sibling, 0 replies; 192+ messages in thread From: Kyle Meyer @ 2020-05-10 15:15 UTC (permalink / raw) To: emacs-orgmode; +Cc: Ihor Radchenko Nicolas Goaziou writes: > Ihor Radchenko <yantar92@gmail.com> writes: > >> My response to you was blocked by your mail server: >> >>> 550 5.7.1 Reject for policy reason RULE3_2. See >>> http://postmaster.gandi.net > > Aka "spam detected". Bah. > >> The message landed on the mail list though: >> https://www.mail-archive.com/emacs-orgmode@gnu.org/msg127972.html > > Unfortunately, reviewing this way is not nice. It's probably not helpful at this point, but just in case: you can get that message's mbox with curl -fSs https://yhetil.org/orgmode/87imh5w1zt.fsf@localhost/raw >mbox ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-05-10 14:59 ` Nicolas Goaziou 2020-05-10 15:15 ` Kyle Meyer @ 2020-05-10 16:30 ` Ihor Radchenko 2020-05-10 19:32 ` Nicolas Goaziou 1 sibling, 1 reply; 192+ messages in thread From: Ihor Radchenko @ 2020-05-10 16:30 UTC (permalink / raw) To: Nicolas Goaziou; +Cc: emacs-orgmode > Unfortunately, reviewing this way is not nice. This should be better: https://gist.github.com/yantar92/e37c2830d3bb6db8678b14424286c930 > The `insert-and-inherit' issue sounds serious. We cannot reasonably > expect any library outside Org to use it. > > We could automatically extend invisible area with > `after-change-functions', i.e., if we're inserting something and both > side have the same `invisible' property, extend it. Using > `after-change-functions' sounds bad, but this kind of check shouldn't > cost much. > > WDYT? This might get tricky in the following case: :PROPERTIES: :CREATED: [2020-04-13 Mon 22:31] <region-beginning> :SHOWFROMDATE: 2020-05-11 :ID: e05e3b33-71ba-4bbc-abba-8a92c565ad34 :END: <many subtrees in between> :PROPERTIES: :CREATED: [2020-04-27 Mon 13:50] <region-end> :ID: b2eef49f-1c5c-4ff1-8e10-80423c8d8532 :ATTACH_DIR_INHERIT: t :END: If the text in the region is replaced by something else, <many subtrees in between> should not be fully hidden. We cannot simply look at the 'invisible property before and after the changed region. I think that using fontification (something similar to org-fontify-drawers) instead of after-change-functions should be faster. Best, Ihor Nicolas Goaziou <mail@nicolasgoaziou.fr> writes: > Ihor Radchenko <yantar92@gmail.com> writes: > >> My response to you was blocked by your mail server: >> >>> 550 5.7.1 Reject for policy reason RULE3_2. See >>> http://postmaster.gandi.net > > Aka "spam detected". Bah. > >> The message landed on the mail list though: >> https://www.mail-archive.com/emacs-orgmode@gnu.org/msg127972.html > > Unfortunately, reviewing this way is not nice. > > The `insert-and-inherit' issue sounds serious. We cannot reasonably > expect any library outside Org to use it. > > We could automatically extend invisible area with > `after-change-functions', i.e., if we're inserting something and both > side have the same `invisible' property, extend it. Using > `after-change-functions' sounds bad, but this kind of check shouldn't > cost much. > > WDYT? > > Regards, -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-05-10 16:30 ` Ihor Radchenko @ 2020-05-10 19:32 ` Nicolas Goaziou 2020-05-12 10:03 ` Nicolas Goaziou 2020-05-17 15:00 ` Ihor Radchenko 0 siblings, 2 replies; 192+ messages in thread From: Nicolas Goaziou @ 2020-05-10 19:32 UTC (permalink / raw) To: Ihor Radchenko; +Cc: emacs-orgmode Ihor Radchenko <yantar92@gmail.com> writes: > This should be better: > https://gist.github.com/yantar92/e37c2830d3bb6db8678b14424286c930 Thank you. > This might get tricky in the following case: > > :PROPERTIES: > :CREATED: [2020-04-13 Mon 22:31] > <region-beginning> > :SHOWFROMDATE: 2020-05-11 > :ID: e05e3b33-71ba-4bbc-abba-8a92c565ad34 > :END: > > <many subtrees in between> > > :PROPERTIES: > :CREATED: [2020-04-27 Mon 13:50] > <region-end> > :ID: b2eef49f-1c5c-4ff1-8e10-80423c8d8532 > :ATTACH_DIR_INHERIT: t > :END: > > If the text in the region is replaced by something else, <many subtrees > in between> should not be fully hidden. We cannot simply look at the > 'invisible property before and after the changed region. Be careful: "replaced by something else" is ambiguous. "Replacing" is an unlikely change: you would need to do (setf (buffer-substring x y) "foo") We can safely assume this will not happen. If it does, we can accept the subsequent glitch. Anyway it is less confusing to think in terms of deletion and insertion. In the case above, you probably mean "the region is deleted then something else is inserted", or the other way. So there are two actions going on, i.e., `after-change-functions' are called twice. In particular the situation you foresee /cannot happen/ with an insertion. Text is inserted at a single point. Let's assume this is in the first drawer. Once inserted, both text before and after the new text were part of the same drawer. Insertion introduces other problems, though. More on this below. It is true the deletion can produce the situation above. But in this case, there is nothing to do, you just merged two drawers into a single one, which stays invisible. Problem solved. IOW, big changes like the one you describe are not an issue. I think the "check if previous and next parts match" trick gives us roughly the same functionality, and the same glitches, as overlays. However, I think we can do better than that, and also fix the glitches from overlays. Here are two of them. Write the following drawer: :FOO: bar :END: fold it and delete the ":f". The overlay is still there, and you cannot remove it with TAB any more. Or, with the same initial drawer, from beginning of buffer, evaluate: (progn (re-search-forward ":END:") (replace-match "")) This is no longer a drawer: you just removed its closing line. Yet, the overlay is still there, and TAB is ineffective. Here's an idea to develop that would make folding more robust, and still fast. Each syntactical element has a "sensitive part", a particular area that can change the nature of the element when it is altered. Luckily drawers (and blocks) are sturdy. For a drawer, there are three things to check: 1. the opening line must match org-drawer-regexp 2. the closing line must match org-property-end-re (case ignored) 3. between those, you must not insert text match org-property-end-re or org-outline-regexp-bol Obviously, point 3 needs not be checked during deletion. Instead of `after-change-functions', we may use `modification-hooks' for deletions, and `insert-behind-hooks' for insertions. For example, we might add modification-hooks property to both opening and closing line, and `insert-behind-hooks' on all the drawer. If any of the 3 points above is verified, we remove all properties. Note that if we can implement something robust with text properties, we might use them for headlines too, for another significant speed-up. WDYT? > I think that using fontification (something similar to > org-fontify-drawers) instead of after-change-functions should be > faster. I don't think it would be faster. With `after-change-functions', `modification-hooks' or `insert-behind-hook', we know exactly where the change happened. Fontification is fuzzier. It is not instantaneous either. It is an option only if we cannot do something fast and accurate with `after-change-functions', IMO. ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-05-10 19:32 ` Nicolas Goaziou @ 2020-05-12 10:03 ` Nicolas Goaziou 2020-05-17 15:00 ` Ihor Radchenko 1 sibling, 0 replies; 192+ messages in thread From: Nicolas Goaziou @ 2020-05-12 10:03 UTC (permalink / raw) To: Ihor Radchenko; +Cc: emacs-orgmode Completing myself, Nicolas Goaziou <mail@nicolasgoaziou.fr> writes: > Each syntactical element has a "sensitive part", a particular area that > can change the nature of the element when it is altered. Luckily drawers > (and blocks) are sturdy. For a drawer, there are three things to check: > > 1. the opening line must match org-drawer-regexp > 2. the closing line must match org-property-end-re (case ignored) > 3. between those, you must not insert text match org-property-end-re or > org-outline-regexp-bol > > Obviously, point 3 needs not be checked during deletion. Point 3 above is inaccurate, one also needs to check that "^[ \t]#\\+end[:_]" doesn't match the body, either. > Instead of `after-change-functions', we may use `modification-hooks' for > deletions, and `insert-behind-hooks' for insertions. For example, we > might add modification-hooks property to both opening and closing line, > and `insert-behind-hooks' on all the drawer. If any of the 3 points > above is verified, we remove all properties. > > Note that if we can implement something robust with text properties, we > might use them for headlines too, for another significant speed-up. Another, less ambitious, possibility is to expand the drawer as soon as text is inserted or removed in the invisible part. Callers (e.g., `org-entry-put') are then responsible to fold it again, if necessary. ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-05-10 19:32 ` Nicolas Goaziou 2020-05-12 10:03 ` Nicolas Goaziou @ 2020-05-17 15:00 ` Ihor Radchenko 2020-05-17 15:40 ` Ihor Radchenko 1 sibling, 1 reply; 192+ messages in thread From: Ihor Radchenko @ 2020-05-17 15:00 UTC (permalink / raw) To: Nicolas Goaziou; +Cc: emacs-orgmode [-- Attachment #1: Type: text/plain, Size: 6013 bytes --] Hi, [All the changes below are relative to commit ed0e75d24. Later commits make it hard to distinguish between hidden headlines and drawers. I will need to figure out a way to merge this branch with master. It does not seem to be trivial.] I have finished a seemingly stable implementation of handling changes inside drawer and block elements. For now, I did not bother with 'modification-hooks and 'insert-in-font/behind-hooks, but simply used before/after-change-functions. The basic idea is saving parsed org-elements before the modification (with :begin and :end replaced by markers) and comparing them with the versions of the same elements after the modification. Any valid org element can be examined in such way by an arbitrary function (see org-track-modification-elements) [1]. For now, I have implemented tracking changes in all the drawer and block elements. If the contents of an element is changed and the element is hidden, the contents remains hidden unless the change was done with self-insert-command. If the begin/end line of the element was changed in the way that the element changes the type or extends/shrinks, the element contents is revealed. To illustrate: Case #1 (the element content is hidden): :PROPERTIES: :ID: 279e797c-f4a7-47bb-80f6-e72ac6f3ec55 :END: is changed to :ROPERTIES: :ID: 279e797c-f4a7-47bb-80f6-e72ac6f3ec55 :END: Text is revealed, because we have drawer in place of property-drawer Case #2 (the element content is hidden): :ROPERTIES: :ID: 279e797c-f4a7-47bb-80f6-e72ac6f3ec55 :END: is changed to :OPERTIES: :ID: 279e797c-f4a7-47bb-80f6-e72ac6f3ec55 :END: The text remains hidden since it is still a drawer. Case #3: (the element content is hidden): :FOO: bar tmp :END: is changed to :FOO: bar :END: tmp :END: The text is revealed because the drawer contents shrank. Case #4: (the element content is hidden in both the drawers): :FOO: bar tmp :END: :BAR: jjd :END: is changed to :FOO: bar tmp :BAR: jjd :END: The text is revealed in both the drawers because the drawers are merged into a new drawer. > However, I think we can do better than that, and also fix the glitches > from overlays. Here are two of them. Write the following drawer: > > :FOO: > bar > :END: > > fold it and delete the ":f". The overlay is still there, and you cannot > remove it with TAB any more. Or, with the same initial drawer, from > beginning of buffer, evaluate: > > (progn (re-search-forward ":END:") (replace-match "")) > > This is no longer a drawer: you just removed its closing line. Yet, the > overlay is still there, and TAB is ineffective. I think the above examples cover what you described. Case #5 (the element content is hidden, point at <!>): :FOO:<!> bar tmp :END: is changed (via self-insert-command) to :FOO:a<!> bar tmp :END: The text is revealed. This last case sounds logical and might potentially replace org-catch-invisible-edits. ------------------------------------------------------------------------ Some potential issues with the implementation: 1. org--after-element-change-function can called many times even for trivial operations. For example (insert "\n" ":TEST:") seems to call it two times already. This has two implications: (1) potential performance degradation; (2) org-element library may not be able to parse the changed element because its intermediate modified state may not match the element syntax. Specifically, inserting new property into :PROPERTIES: drawer inserts a newline at some point, which makes org-element-at-point think that it is not a 'property-drawer, but just 'drawer. For (1), I did not really do any workaround for now. One potential way is making use of combine-after-change-calls (info:elisp#Change Hooks). At least, within org source code. For (2), I have introduced org--property-drawer-modified-re to override org-property-drawer-re in relevant *-change-function. This seems to work for property drawers. However, I am not sure if similar problem may happen in some border cases with ordinary drawers or blocks. 2. I have noticed that results of org-element-at-point and org-element-parse-buffer are not always consistent. In my tests, they returned different number of empty lines after drawers (:post-blank and :end properties). I am not sure here if I did something wrong in the code or if it is a real issue in org-element. For now, I simply called org-element-at-point with point at :begin property of all the elements returned by org-element-parse buffer to make things consistent. This indeed introduced overhead, but I do not see other way to solve the inconsistency. 3. This implementation did not directly solve the previously observed issue with two ellipsis displayed in folded drawer after adding hidden text inside: :PROPERTY: ... --> :PROPERTY: ... ... For now, I just did (org-hide-drawer-toggle 'off) (org-hide-drawer-toggle 'hide) to hide the second ellipsis, but I still don't understand why it is happening. Is it some Emacs bug? I am not sure. 4. For some reason, before/after-change-functions do not seem to trigger when adding note after todo state change. ------------------------------------------------------------------------ Further plans: 1. Investigate the issue with log notes. 2. Try to change headings to use text properties as well. The current version of the patch (relative to commit ed0e75d24) is attached. ------------------------------------------------------------------------ P.S. I have noticed an issue with hidden text on master (9bc0cc7fb) with my personal config: For the following .org file: * TODO b :PROPERTIES: :CREATED: [2020-05-17 Sun 22:37] :END: folded to * TODO b... Changing todo to DONE will be shown as * DONE b CLOSED: [2020-05-17 Sun 22:54]...:LOGBOOK:... ------------------------------------------------------------------------ [1] If one wants to track changes in two elements types, where one is always inside the other, it is not possible now. Best, Ihor [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: featuredrawertextprop.patch --] [-- Type: text/x-diff, Size: 17817 bytes --] diff --git a/lisp/org-macs.el b/lisp/org-macs.el index a02f713ca..4b0e23f6a 100644 --- a/lisp/org-macs.el +++ b/lisp/org-macs.el @@ -682,7 +682,7 @@ When NEXT is non-nil, check the next line instead." \f -;;; Overlays +;;; Overlays and text properties (defun org-overlay-display (ovl text &optional face evap) "Make overlay OVL display TEXT with face FACE." @@ -705,18 +705,44 @@ If DELETE is non-nil, delete all those overlays." (delete (delete-overlay ov)) (t (push ov found)))))) +(defun org--find-text-property-region (pos prop) + "Find a region containing PROP text property around point POS." + (let* ((beg (and (get-text-property pos prop) pos)) + (end beg)) + (when beg + ;; when beg is the first point in the region, `previous-single-property-change' + ;; will return nil. + (setq beg (or (previous-single-property-change pos prop) + beg)) + ;; when end is the last point in the region, `next-single-property-change' + ;; will return nil. + (setq end (or (next-single-property-change pos prop) + end)) + (unless (= beg end) ; this should not happen + (cons beg end))))) + (defun org-flag-region (from to flag spec) "Hide or show lines from FROM to TO, according to FLAG. SPEC is the invisibility spec, as a symbol." - (remove-overlays from to 'invisible spec) - ;; Use `front-advance' since text right before to the beginning of - ;; the overlay belongs to the visible line than to the contents. - (when flag - (let ((o (make-overlay from to nil 'front-advance))) - (overlay-put o 'evaporate t) - (overlay-put o 'invisible spec) - (overlay-put o 'isearch-open-invisible #'delete-overlay)))) - + (pcase spec + ('outline + (remove-overlays from to 'invisible spec) + ;; Use `front-advance' since text right before to the beginning of + ;; the overlay belongs to the visible line than to the contents. + (when flag + (let ((o (make-overlay from to nil 'front-advance))) + (overlay-put o 'evaporate t) + (overlay-put o 'invisible spec) + (overlay-put o 'isearch-open-invisible #'delete-overlay)))) + (_ + ;; Use text properties instead of overlays for speed. + ;; Overlays are too slow (Emacs Bug#35453). + (with-silent-modifications + (remove-text-properties from to '(invisible nil)) + (when flag + (put-text-property from to 'rear-non-sticky nil) + (put-text-property from to 'front-sticky t) + (put-text-property from to 'invisible spec)))))) \f ;;; Regexp matching diff --git a/lisp/org.el b/lisp/org.el index 96e7384f3..1bf90edae 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -114,6 +114,7 @@ Stars are put in group 1 and the trimmed body in group 2.") (declare-function cdlatex-math-symbol "ext:cdlatex") (declare-function Info-goto-node "info" (nodename &optional fork strict-case)) (declare-function isearch-no-upper-case-p "isearch" (string regexp-flag)) +(declare-function isearch-filter-visible "isearch" (beg end)) (declare-function org-add-archive-files "org-archive" (files)) (declare-function org-agenda-entry-get-agenda-timestamp "org-agenda" (pom)) (declare-function org-agenda-list "org-agenda" (&optional arg start-day span with-hour)) @@ -192,6 +193,9 @@ Stars are put in group 1 and the trimmed body in group 2.") (defvar ffap-url-regexp) (defvar org-element-paragraph-separate) +(defvar org-element-all-objects) +(defvar org-element-all-elements) +(defvar org-element-greater-elements) (defvar org-indent-indentation-per-level) (defvar org-radio-target-regexp) (defvar org-target-link-regexp) @@ -4737,6 +4741,153 @@ This is for getting out of special buffers like capture.") (defun org-before-change-function (_beg _end) "Every change indicates that a table might need an update." (setq org-table-may-need-update t)) + +(defvar-local org--modified-elements nil + "List of unmodified versions of recently modified elements. + +The :begin and :end element properties contain markers instead of positions.") + +(defvar org--property-drawer-modified-re (concat (replace-regexp-in-string "\\$$" "\n" org-property-start-re) + "\\(?:.*\n\\)*?" + (replace-regexp-in-string "^\\^" "" org-property-end-re)) + "Matches entire property drawer, including its state during modification. + +This should be different from `org-property-drawer-re' because +property drawer may contain empty or incomplete lines in the middle of +modification.") + +(defun org--drawer-or-block-change-function (el) + "Update visibility of changed drawer/block EL. + +If text was added to hidden drawer/block, +make sure that the text is also hidden, unless +the change was done by `self-insert-command'. +If the modification destroyed the drawer/block, +reveal the hidden text in former drawer/block." + (save-match-data + (save-excursion + (save-restriction + (goto-char (org-element-property :begin el)) + (let* ((newel (org-element-at-point)) + (spec (if (string-match-p "block" (symbol-name (org-element-type el))) + 'org-hide-block + (if (string-match-p "drawer" (symbol-name (org-element-type el))) + 'org-hide-drawer + t)))) + (if (and (equal (org-element-type el) (org-element-type newel)) + (equal (marker-position (org-element-property :begin el)) + (org-element-property :begin newel)) + (equal (marker-position (org-element-property :end el)) + (org-element-property :end newel))) + (when (text-property-any (marker-position (org-element-property :begin el)) + (marker-position (org-element-property :end el)) + 'invisible spec) + (if (memq this-command '(self-insert-command)) + ;; reveal if change was made by typing + (org-hide-drawer-toggle 'off) + ;; re-hide the inserted text + ;; FIXME: opening the drawer before hiding should not be needed here + (org-hide-drawer-toggle 'off) ; this is needed to avoid showing double ellipsis + (org-hide-drawer-toggle 'hide))) + ;; The element was destroyed. Reveal everything. + (org-flag-region (marker-position (org-element-property :begin el)) + (marker-position (org-element-property :end el)) + nil spec) + (org-flag-region (org-element-property :begin newel) + (org-element-property :end newel) + nil spec))))))) + +(defvar org-track-modification-elements (list (cons 'center-block #'org--drawer-or-block-change-function) + (cons 'drawer #'org--drawer-or-block-change-function) + (cons 'dynamic-block #'org--drawer-or-block-change-function) + (cons 'property-drawer #'org--drawer-or-block-change-function) + (cons 'quote-block #'org--drawer-or-block-change-function) + (cons 'special-block #'org--drawer-or-block-change-function)) + "Alist of elements to be tracked for modifications. +Each element of the alist is a cons of an element from +`org-element-all-elements' and the function used to handle the +modification. +The function must accept a single argument - parsed element before +modificatin with :begin and :end properties containing markers.") + +(defun org--find-elements-in-region (beg end elements &optional include-partial) + "Find all elements from ELEMENTS list in region BEG . END. +All the listed elements must be resolvable by `org-element-at-point'. +Include elements if they are partially inside region when INCLUDE-PARTIAL is non-nil." + (when include-partial + (org-with-point-at beg + (when-let ((new-beg (org-element-property :begin + (org-element-lineage (org-element-at-point) + elements + 'with-self)))) + (setq beg new-beg)) + (when (memq 'headline elements) + (when-let ((new-beg (ignore-error user-error (org-back-to-heading 'include-invisible)))) + (setq beg new-beg)))) + (org-with-point-at end + (when-let ((new-end (org-element-property :end + (org-element-lineage (org-element-at-point) + elements + 'with-self)))) + (setq end new-end)) + (when (memq 'headline elements) + (when-let ((new-end (org-with-limited-levels (outline-next-heading)))) + (setq end (1- new-end)))))) + (save-excursion + (save-restriction + (narrow-to-region beg end) + (let (has-object has-element has-greater-element granularity) + (dolist (el elements) + (when (memq el org-element-all-objects) (setq has-object t)) + (when (memq el org-element-all-elements) (setq has-element t)) + (when (memq el org-element-greater-elements) (setq has-greater-element t))) + (if has-object + (setq granularity 'object) + (if has-greater-element + (setq granularity 'greater-element) + (if has-element + (setq granularity 'element) + (setq granularity 'headline)))) + (org-element-map (org-element-parse-buffer granularity) elements #'identity))))) + +(defun org--before-element-change-function (beg end) + "Register upcoming element modifications in `org--modified-elements' for all elements interesting with BEG END." + (let ((org-property-drawer-re org--property-drawer-modified-re)) + (save-match-data + (save-excursion + (save-restriction + (dolist (el (org--find-elements-in-region beg + end + (mapcar #'car org-track-modification-elements) + 'include-partial)) + ;; `org-element-at-point' is not consistent with results + ;; of `org-element-parse-buffer' for :post-blank and :end + ;; Using `org-element-at-point to keep consistent + ;; parse results with `org--after-element-change-function' + (let* ((el (org-with-point-at (org-element-property :begin el) + (org-element-at-point))) + (beg-marker (copy-marker (org-element-property :begin el) 't)) + (end-marker (copy-marker (org-element-property :end el) 't))) + (when (and (marker-position beg-marker) (marker-position end-marker)) + (org-element-put-property el :begin beg-marker) + (org-element-put-property el :end end-marker) + (add-to-list 'org--modified-elements el))))))))) + +;; FIXME: this function may be called many times during routine modifications +;; The normal way to avoid this is `combine-after-change-calls' - not +;; the case in most org primitives. +(defun org--after-element-change-function (&rest _) + "Handle changed elements from `org--modified-elements'." + (let ((org-property-drawer-re org--property-drawer-modified-re)) + (dolist (el org--modified-elements) + (save-match-data + (save-excursion + (save-restriction + (let* ((type (org-element-type el)) + (change-func (alist-get type org-track-modification-elements))) + (funcall (symbol-function change-func) el))))))) + (setq org--modified-elements nil)) + (defvar org-mode-map) (defvar org-inhibit-startup-visibility-stuff nil) ; Dynamically-scoped param. (defvar org-agenda-keep-modes nil) ; Dynamically-scoped param. @@ -4818,6 +4969,9 @@ The following commands are available: ;; Activate before-change-function (setq-local org-table-may-need-update t) (add-hook 'before-change-functions 'org-before-change-function nil 'local) + (add-hook 'before-change-functions 'org--before-element-change-function nil 'local) + ;; Activate after-change-function + (add-hook 'after-change-functions 'org--after-element-change-function nil 'local) ;; Check for running clock before killing a buffer (add-hook 'kill-buffer-hook 'org-check-running-clock nil 'local) ;; Initialize macros templates. @@ -4869,6 +5023,10 @@ The following commands are available: (setq-local outline-isearch-open-invisible-function (lambda (&rest _) (org-show-context 'isearch))) + ;; Make isearch search in blocks hidden via text properties + (setq-local isearch-filter-predicate #'org--isearch-filter-predicate) + (add-hook 'isearch-mode-end-hook #'org--clear-isearch-overlays nil 'local) + ;; Setup the pcomplete hooks (setq-local pcomplete-command-completion-function #'org-pcomplete-initial) (setq-local pcomplete-command-name-function #'org-command-at-point) @@ -5859,9 +6017,26 @@ If TAG is a number, get the corresponding match group." (inhibit-modification-hooks t) deactivate-mark buffer-file-name buffer-file-truename) (decompose-region beg end) + ;; do not remove invisible text properties specified by + ;; 'org-hide-block and 'org-hide-drawer (but remove 'org-link) + ;; this is needed to keep the drawers and blocks hidden unless + ;; they are toggled by user + ;; Note: The below may be too specific and create troubles + ;; if more invisibility specs are added to org in future + (let ((pos beg) + next spec) + (while (< pos end) + (setq next (next-single-property-change pos 'invisible nil end) + spec (get-text-property pos 'invisible)) + (unless (memq spec (list 'org-hide-block + 'org-hide-drawer)) + (remove-text-properties pos next '(invisible t))) + (setq pos next))) (remove-text-properties beg end '(mouse-face t keymap t org-linked-text t - invisible t intangible t + ;; Do not remove all invisible during fontification + ;; invisible t + intangible t org-emphasis t)) (org-remove-font-lock-display-properties beg end))) @@ -6666,8 +6841,13 @@ information." ;; expose it. (dolist (o (overlays-at (point))) (when (memq (overlay-get o 'invisible) - '(org-hide-block org-hide-drawer outline)) + '(outline)) (delete-overlay o))) + (when (memq (get-text-property (point) 'invisible) + '(org-hide-block org-hide-drawer)) + (let ((spec (get-text-property (point) 'invisible)) + (region (org--find-text-property-region (point) 'invisible))) + (org-flag-region (car region) (cdr region) nil spec))) (unless (org-before-first-heading-p) (org-with-limited-levels (cl-case detail @@ -20902,6 +21082,79 @@ Started from `gnus-info-find-node'." (t default-org-info-node)))))) \f + +;;; Make isearch search in some text hidden via text propertoes + +(defvar org--isearch-overlays nil + "List of overlays temporarily created during isearch. +This is used to allow searching in regions hidden via text properties. +As for [2020-05-09 Sat], Isearch only has special handling of hidden overlays. +Any text hidden via text properties is not revealed even if `search-invisible' +is set to 't.") + +;; Not sure if it needs to be a user option +;; One might want to reveal hidden text in, for example, hidden parts of the links. +;; Currently, hidden text in links is never revealed by isearch. +(defvar org-isearch-specs '(org-hide-block + org-hide-drawer) + "List of text invisibility specs to be searched by isearch. +By default ([2020-05-09 Sat]), isearch does not search in hidden text, +which was made invisible using text properties. Isearch will be forced +to search in hidden text with any of the listed 'invisible property value.") + +(defun org--create-isearch-overlays (beg end) + "Replace text property invisibility spec by overlays between BEG and END. +All the regions with invisibility text property spec from +`org-isearch-specs' will be changed to use overlays instead +of text properties. The created overlays will be stored in +`org--isearch-overlays'." + (let ((pos beg)) + (while (< pos end) + (when-let* ((spec (get-text-property pos 'invisible)) + (spec (memq spec org-isearch-specs)) + (region (org--find-text-property-region pos 'invisible))) + ;; Changing text properties is considered buffer modification. + ;; We do not want it here. + (with-silent-modifications + ;; The overlay is modelled after `org-flag-region' [2020-05-09 Sat] + ;; overlay for 'outline blocks. + (let ((o (make-overlay (car region) (cdr region) nil 'front-advance))) + (overlay-put o 'evaporate t) + (overlay-put o 'invisible spec) + ;; `delete-overlay' here means that spec information will be lost + ;; for the region. The region will remain visible. + (overlay-put o 'isearch-open-invisible #'delete-overlay) + (push o org--isearch-overlays)) + (remove-text-properties (car region) (cdr region) '(invisible nil)))) + (setq pos (next-single-property-change pos 'invisible nil end))))) + +(defun org--isearch-filter-predicate (beg end) + "Return non-nil if text between BEG and END is deemed visible by Isearch. +This function is intended to be used as `isearch-filter-predicate'. +Unlike `isearch-filter-visible', make text with 'invisible text property +value listed in `org-isearch-specs' visible to Isearch." + (org--create-isearch-overlays beg end) ;; trick isearch by creating overlays in place of invisible text + (isearch-filter-visible beg end)) + +(defun org--clear-isearch-overlay (ov) + "Convert OV region back into using text properties." + (when-let ((spec (overlay-get ov 'invisible))) ;; ignore deleted overlays + ;; Changing text properties is considered buffer modification. + ;; We do not want it here. + (with-silent-modifications + (put-text-property (overlay-start ov) (overlay-end ov) 'invisible spec))) + (when (member ov isearch-opened-overlays) + (setq isearch-opened-overlays (delete ov isearch-opened-overlays))) + (delete-overlay ov)) + +(defun org--clear-isearch-overlays () + "Convert overlays from `org--isearch-overlays' back into using text properties." + (when org--isearch-overlays + (mapc #'org--clear-isearch-overlay org--isearch-overlays) + (setq org--isearch-overlays nil))) + +\f + ;;; Finish up (add-hook 'org-mode-hook ;remove overlays when changing major mode [-- Attachment #3: Type: text/plain, Size: 4435 bytes --] Nicolas Goaziou <mail@nicolasgoaziou.fr> writes: > Ihor Radchenko <yantar92@gmail.com> writes: > >> This should be better: >> https://gist.github.com/yantar92/e37c2830d3bb6db8678b14424286c930 > > Thank you. > >> This might get tricky in the following case: >> >> :PROPERTIES: >> :CREATED: [2020-04-13 Mon 22:31] >> <region-beginning> >> :SHOWFROMDATE: 2020-05-11 >> :ID: e05e3b33-71ba-4bbc-abba-8a92c565ad34 >> :END: >> >> <many subtrees in between> >> >> :PROPERTIES: >> :CREATED: [2020-04-27 Mon 13:50] >> <region-end> >> :ID: b2eef49f-1c5c-4ff1-8e10-80423c8d8532 >> :ATTACH_DIR_INHERIT: t >> :END: >> >> If the text in the region is replaced by something else, <many subtrees >> in between> should not be fully hidden. We cannot simply look at the >> 'invisible property before and after the changed region. > > Be careful: "replaced by something else" is ambiguous. "Replacing" is an > unlikely change: you would need to do > > (setf (buffer-substring x y) "foo") > > We can safely assume this will not happen. If it does, we can accept the > subsequent glitch. > > Anyway it is less confusing to think in terms of deletion and insertion. > In the case above, you probably mean "the region is deleted then > something else is inserted", or the other way. So there are two actions > going on, i.e., `after-change-functions' are called twice. > > In particular the situation you foresee /cannot happen/ with an > insertion. Text is inserted at a single point. Let's assume this is in > the first drawer. Once inserted, both text before and after the new text > were part of the same drawer. Insertion introduces other problems, > though. More on this below. > > It is true the deletion can produce the situation above. But in this > case, there is nothing to do, you just merged two drawers into a single > one, which stays invisible. Problem solved. > > IOW, big changes like the one you describe are not an issue. I think the > "check if previous and next parts match" trick gives us roughly the same > functionality, and the same glitches, as overlays. > > However, I think we can do better than that, and also fix the glitches > from overlays. Here are two of them. Write the following drawer: > > :FOO: > bar > :END: > > fold it and delete the ":f". The overlay is still there, and you cannot > remove it with TAB any more. Or, with the same initial drawer, from > beginning of buffer, evaluate: > > (progn (re-search-forward ":END:") (replace-match "")) > > This is no longer a drawer: you just removed its closing line. Yet, the > overlay is still there, and TAB is ineffective. > > Here's an idea to develop that would make folding more robust, and still > fast. > > Each syntactical element has a "sensitive part", a particular area that > can change the nature of the element when it is altered. Luckily drawers > (and blocks) are sturdy. For a drawer, there are three things to check: > > 1. the opening line must match org-drawer-regexp > 2. the closing line must match org-property-end-re (case ignored) > 3. between those, you must not insert text match org-property-end-re or > org-outline-regexp-bol > > Obviously, point 3 needs not be checked during deletion. > > Instead of `after-change-functions', we may use `modification-hooks' for > deletions, and `insert-behind-hooks' for insertions. For example, we > might add modification-hooks property to both opening and closing line, > and `insert-behind-hooks' on all the drawer. If any of the 3 points > above is verified, we remove all properties. > > Note that if we can implement something robust with text properties, we > might use them for headlines too, for another significant speed-up. > > WDYT? > >> I think that using fontification (something similar to >> org-fontify-drawers) instead of after-change-functions should be >> faster. > > I don't think it would be faster. With `after-change-functions', > `modification-hooks' or `insert-behind-hook', we know exactly where the > change happened. Fontification is fuzzier. It is not instantaneous > either. > > It is an option only if we cannot do something fast and accurate with > `after-change-functions', IMO. > -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply related [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-05-17 15:00 ` Ihor Radchenko @ 2020-05-17 15:40 ` Ihor Radchenko 2020-05-18 14:35 ` Nicolas Goaziou 0 siblings, 1 reply; 192+ messages in thread From: Ihor Radchenko @ 2020-05-17 15:40 UTC (permalink / raw) To: Nicolas Goaziou; +Cc: emacs-orgmode Dear Nicolas Goaziou, Apparently my previous email was again refused by your mail server (I tried to add patch as attachment this time). The patch is in https://gist.github.com/yantar92/6447754415457927293acda43a7fcaef This patch is actually one commit ahead of the patch in the email, fixing an issue when change function throws an error. I wrapped the call into with-demoted-errors to avoid potential data loss on error in future. Best, Ihor Ihor Radchenko <yantar92@gmail.com> writes: > Hi, > > [All the changes below are relative to commit ed0e75d24. Later commits > make it hard to distinguish between hidden headlines and drawers. I will > need to figure out a way to merge this branch with master. It does not > seem to be trivial.] > > I have finished a seemingly stable implementation of handling changes > inside drawer and block elements. For now, I did not bother with > 'modification-hooks and 'insert-in-font/behind-hooks, but simply used > before/after-change-functions. > > The basic idea is saving parsed org-elements before the modification > (with :begin and :end replaced by markers) and comparing them with the > versions of the same elements after the modification. > Any valid org element can be examined in such way by an arbitrary > function (see org-track-modification-elements) [1]. > > For now, I have implemented tracking changes in all the drawer and block > elements. If the contents of an element is changed and the element is > hidden, the contents remains hidden unless the change was done with > self-insert-command. If the begin/end line of the element was changed in > the way that the element changes the type or extends/shrinks, the > element contents is revealed. To illustrate: > > Case #1 (the element content is hidden): > > :PROPERTIES: > :ID: 279e797c-f4a7-47bb-80f6-e72ac6f3ec55 > :END: > > is changed to > > :ROPERTIES: > :ID: 279e797c-f4a7-47bb-80f6-e72ac6f3ec55 > :END: > > Text is revealed, because we have drawer in place of property-drawer > > Case #2 (the element content is hidden): > > :ROPERTIES: > :ID: 279e797c-f4a7-47bb-80f6-e72ac6f3ec55 > :END: > > is changed to > > :OPERTIES: > :ID: 279e797c-f4a7-47bb-80f6-e72ac6f3ec55 > :END: > > The text remains hidden since it is still a drawer. > > Case #3: (the element content is hidden): > > :FOO: > bar > tmp > :END: > > is changed to > > :FOO: > bar > :END: > tmp > :END: > > The text is revealed because the drawer contents shrank. > > Case #4: (the element content is hidden in both the drawers): > > :FOO: > bar > tmp > :END: > :BAR: > jjd > :END: > > is changed to > > :FOO: > bar > tmp > :BAR: > jjd > :END: > > The text is revealed in both the drawers because the drawers are merged > into a new drawer. > >> However, I think we can do better than that, and also fix the glitches >> from overlays. Here are two of them. Write the following drawer: >> >> :FOO: >> bar >> :END: >> >> fold it and delete the ":f". The overlay is still there, and you cannot >> remove it with TAB any more. Or, with the same initial drawer, from >> beginning of buffer, evaluate: >> >> (progn (re-search-forward ":END:") (replace-match "")) >> >> This is no longer a drawer: you just removed its closing line. Yet, the >> overlay is still there, and TAB is ineffective. > > I think the above examples cover what you described. > > Case #5 (the element content is hidden, point at <!>): > > :FOO:<!> > bar > tmp > :END: > > is changed (via self-insert-command) to > > :FOO:a<!> > bar > tmp > :END: > > The text is revealed. > > This last case sounds logical and might potentially replace > org-catch-invisible-edits. > > ------------------------------------------------------------------------ > > Some potential issues with the implementation: > > 1. org--after-element-change-function can called many times even for > trivial operations. For example (insert "\n" ":TEST:") seems to call it > two times already. This has two implications: (1) potential performance > degradation; (2) org-element library may not be able to parse the > changed element because its intermediate modified state may not match > the element syntax. Specifically, inserting new property into > :PROPERTIES: drawer inserts a newline at some point, which makes > org-element-at-point think that it is not a 'property-drawer, but just > 'drawer. > > For (1), I did not really do any workaround for now. One potential way > is making use of combine-after-change-calls (info:elisp#Change Hooks). > At least, within org source code. > > For (2), I have introduced org--property-drawer-modified-re to override > org-property-drawer-re in relevant *-change-function. This seems to work > for property drawers. However, I am not sure if similar problem may > happen in some border cases with ordinary drawers or blocks. > > 2. I have noticed that results of org-element-at-point and > org-element-parse-buffer are not always consistent. > In my tests, they returned different number of empty lines after drawers > (:post-blank and :end properties). I am not sure here if I did something > wrong in the code or if it is a real issue in org-element. > > For now, I simply called org-element-at-point with point at :begin > property of all the elements returned by org-element-parse buffer to > make things consistent. This indeed introduced overhead, but I do not > see other way to solve the inconsistency. > > 3. This implementation did not directly solve the previously observed > issue with two ellipsis displayed in folded drawer after adding hidden > text inside: > > :PROPERTY: ... --> :PROPERTY: ... ... > > For now, I just did > > (org-hide-drawer-toggle 'off) > (org-hide-drawer-toggle 'hide) > > to hide the second ellipsis, but I still don't understand why it is > happening. Is it some Emacs bug? I am not sure. > > 4. For some reason, before/after-change-functions do not seem to trigger > when adding note after todo state change. > > ------------------------------------------------------------------------ > > Further plans: > > 1. Investigate the issue with log notes. > 2. Try to change headings to use text properties as well. > > The current version of the patch (relative to commit ed0e75d24) is > attached. > > ------------------------------------------------------------------------ > > P.S. I have noticed an issue with hidden text on master (9bc0cc7fb) with > my personal config: > > For the following .org file: > > * TODO b > :PROPERTIES: > :CREATED: [2020-05-17 Sun 22:37] > :END: > > folded to > > * TODO b... > > Changing todo to DONE will be shown as > > * DONE b > CLOSED: [2020-05-17 Sun 22:54]...:LOGBOOK:... > > ------------------------------------------------------------------------ > > [1] If one wants to track changes in two elements types, where one is > always inside the other, it is not possible now. > > Best, > Ihor > > diff --git a/lisp/org-macs.el b/lisp/org-macs.el > index a02f713ca..4b0e23f6a 100644 > --- a/lisp/org-macs.el > +++ b/lisp/org-macs.el > @@ -682,7 +682,7 @@ When NEXT is non-nil, check the next line instead." > > > \f > -;;; Overlays > +;;; Overlays and text properties > > (defun org-overlay-display (ovl text &optional face evap) > "Make overlay OVL display TEXT with face FACE." > @@ -705,18 +705,44 @@ If DELETE is non-nil, delete all those overlays." > (delete (delete-overlay ov)) > (t (push ov found)))))) > > +(defun org--find-text-property-region (pos prop) > + "Find a region containing PROP text property around point POS." > + (let* ((beg (and (get-text-property pos prop) pos)) > + (end beg)) > + (when beg > + ;; when beg is the first point in the region, `previous-single-property-change' > + ;; will return nil. > + (setq beg (or (previous-single-property-change pos prop) > + beg)) > + ;; when end is the last point in the region, `next-single-property-change' > + ;; will return nil. > + (setq end (or (next-single-property-change pos prop) > + end)) > + (unless (= beg end) ; this should not happen > + (cons beg end))))) > + > (defun org-flag-region (from to flag spec) > "Hide or show lines from FROM to TO, according to FLAG. > SPEC is the invisibility spec, as a symbol." > - (remove-overlays from to 'invisible spec) > - ;; Use `front-advance' since text right before to the beginning of > - ;; the overlay belongs to the visible line than to the contents. > - (when flag > - (let ((o (make-overlay from to nil 'front-advance))) > - (overlay-put o 'evaporate t) > - (overlay-put o 'invisible spec) > - (overlay-put o 'isearch-open-invisible #'delete-overlay)))) > - > + (pcase spec > + ('outline > + (remove-overlays from to 'invisible spec) > + ;; Use `front-advance' since text right before to the beginning of > + ;; the overlay belongs to the visible line than to the contents. > + (when flag > + (let ((o (make-overlay from to nil 'front-advance))) > + (overlay-put o 'evaporate t) > + (overlay-put o 'invisible spec) > + (overlay-put o 'isearch-open-invisible #'delete-overlay)))) > + (_ > + ;; Use text properties instead of overlays for speed. > + ;; Overlays are too slow (Emacs Bug#35453). > + (with-silent-modifications > + (remove-text-properties from to '(invisible nil)) > + (when flag > + (put-text-property from to 'rear-non-sticky nil) > + (put-text-property from to 'front-sticky t) > + (put-text-property from to 'invisible spec)))))) > > \f > ;;; Regexp matching > diff --git a/lisp/org.el b/lisp/org.el > index 96e7384f3..1bf90edae 100644 > --- a/lisp/org.el > +++ b/lisp/org.el > @@ -114,6 +114,7 @@ Stars are put in group 1 and the trimmed body in group 2.") > (declare-function cdlatex-math-symbol "ext:cdlatex") > (declare-function Info-goto-node "info" (nodename &optional fork strict-case)) > (declare-function isearch-no-upper-case-p "isearch" (string regexp-flag)) > +(declare-function isearch-filter-visible "isearch" (beg end)) > (declare-function org-add-archive-files "org-archive" (files)) > (declare-function org-agenda-entry-get-agenda-timestamp "org-agenda" (pom)) > (declare-function org-agenda-list "org-agenda" (&optional arg start-day span with-hour)) > @@ -192,6 +193,9 @@ Stars are put in group 1 and the trimmed body in group 2.") > > (defvar ffap-url-regexp) > (defvar org-element-paragraph-separate) > +(defvar org-element-all-objects) > +(defvar org-element-all-elements) > +(defvar org-element-greater-elements) > (defvar org-indent-indentation-per-level) > (defvar org-radio-target-regexp) > (defvar org-target-link-regexp) > @@ -4737,6 +4741,153 @@ This is for getting out of special buffers like capture.") > (defun org-before-change-function (_beg _end) > "Every change indicates that a table might need an update." > (setq org-table-may-need-update t)) > + > +(defvar-local org--modified-elements nil > + "List of unmodified versions of recently modified elements. > + > +The :begin and :end element properties contain markers instead of positions.") > + > +(defvar org--property-drawer-modified-re (concat (replace-regexp-in-string "\\$$" "\n" org-property-start-re) > + "\\(?:.*\n\\)*?" > + (replace-regexp-in-string "^\\^" "" org-property-end-re)) > + "Matches entire property drawer, including its state during modification. > + > +This should be different from `org-property-drawer-re' because > +property drawer may contain empty or incomplete lines in the middle of > +modification.") > + > +(defun org--drawer-or-block-change-function (el) > + "Update visibility of changed drawer/block EL. > + > +If text was added to hidden drawer/block, > +make sure that the text is also hidden, unless > +the change was done by `self-insert-command'. > +If the modification destroyed the drawer/block, > +reveal the hidden text in former drawer/block." > + (save-match-data > + (save-excursion > + (save-restriction > + (goto-char (org-element-property :begin el)) > + (let* ((newel (org-element-at-point)) > + (spec (if (string-match-p "block" (symbol-name (org-element-type el))) > + 'org-hide-block > + (if (string-match-p "drawer" (symbol-name (org-element-type el))) > + 'org-hide-drawer > + t)))) > + (if (and (equal (org-element-type el) (org-element-type newel)) > + (equal (marker-position (org-element-property :begin el)) > + (org-element-property :begin newel)) > + (equal (marker-position (org-element-property :end el)) > + (org-element-property :end newel))) > + (when (text-property-any (marker-position (org-element-property :begin el)) > + (marker-position (org-element-property :end el)) > + 'invisible spec) > + (if (memq this-command '(self-insert-command)) > + ;; reveal if change was made by typing > + (org-hide-drawer-toggle 'off) > + ;; re-hide the inserted text > + ;; FIXME: opening the drawer before hiding should not be needed here > + (org-hide-drawer-toggle 'off) ; this is needed to avoid showing double ellipsis > + (org-hide-drawer-toggle 'hide))) > + ;; The element was destroyed. Reveal everything. > + (org-flag-region (marker-position (org-element-property :begin el)) > + (marker-position (org-element-property :end el)) > + nil spec) > + (org-flag-region (org-element-property :begin newel) > + (org-element-property :end newel) > + nil spec))))))) > + > +(defvar org-track-modification-elements (list (cons 'center-block #'org--drawer-or-block-change-function) > + (cons 'drawer #'org--drawer-or-block-change-function) > + (cons 'dynamic-block #'org--drawer-or-block-change-function) > + (cons 'property-drawer #'org--drawer-or-block-change-function) > + (cons 'quote-block #'org--drawer-or-block-change-function) > + (cons 'special-block #'org--drawer-or-block-change-function)) > + "Alist of elements to be tracked for modifications. > +Each element of the alist is a cons of an element from > +`org-element-all-elements' and the function used to handle the > +modification. > +The function must accept a single argument - parsed element before > +modificatin with :begin and :end properties containing markers.") > + > +(defun org--find-elements-in-region (beg end elements &optional include-partial) > + "Find all elements from ELEMENTS list in region BEG . END. > +All the listed elements must be resolvable by `org-element-at-point'. > +Include elements if they are partially inside region when INCLUDE-PARTIAL is non-nil." > + (when include-partial > + (org-with-point-at beg > + (when-let ((new-beg (org-element-property :begin > + (org-element-lineage (org-element-at-point) > + elements > + 'with-self)))) > + (setq beg new-beg)) > + (when (memq 'headline elements) > + (when-let ((new-beg (ignore-error user-error (org-back-to-heading 'include-invisible)))) > + (setq beg new-beg)))) > + (org-with-point-at end > + (when-let ((new-end (org-element-property :end > + (org-element-lineage (org-element-at-point) > + elements > + 'with-self)))) > + (setq end new-end)) > + (when (memq 'headline elements) > + (when-let ((new-end (org-with-limited-levels (outline-next-heading)))) > + (setq end (1- new-end)))))) > + (save-excursion > + (save-restriction > + (narrow-to-region beg end) > + (let (has-object has-element has-greater-element granularity) > + (dolist (el elements) > + (when (memq el org-element-all-objects) (setq has-object t)) > + (when (memq el org-element-all-elements) (setq has-element t)) > + (when (memq el org-element-greater-elements) (setq has-greater-element t))) > + (if has-object > + (setq granularity 'object) > + (if has-greater-element > + (setq granularity 'greater-element) > + (if has-element > + (setq granularity 'element) > + (setq granularity 'headline)))) > + (org-element-map (org-element-parse-buffer granularity) elements #'identity))))) > + > +(defun org--before-element-change-function (beg end) > + "Register upcoming element modifications in `org--modified-elements' for all elements interesting with BEG END." > + (let ((org-property-drawer-re org--property-drawer-modified-re)) > + (save-match-data > + (save-excursion > + (save-restriction > + (dolist (el (org--find-elements-in-region beg > + end > + (mapcar #'car org-track-modification-elements) > + 'include-partial)) > + ;; `org-element-at-point' is not consistent with results > + ;; of `org-element-parse-buffer' for :post-blank and :end > + ;; Using `org-element-at-point to keep consistent > + ;; parse results with `org--after-element-change-function' > + (let* ((el (org-with-point-at (org-element-property :begin el) > + (org-element-at-point))) > + (beg-marker (copy-marker (org-element-property :begin el) 't)) > + (end-marker (copy-marker (org-element-property :end el) 't))) > + (when (and (marker-position beg-marker) (marker-position end-marker)) > + (org-element-put-property el :begin beg-marker) > + (org-element-put-property el :end end-marker) > + (add-to-list 'org--modified-elements el))))))))) > + > +;; FIXME: this function may be called many times during routine modifications > +;; The normal way to avoid this is `combine-after-change-calls' - not > +;; the case in most org primitives. > +(defun org--after-element-change-function (&rest _) > + "Handle changed elements from `org--modified-elements'." > + (let ((org-property-drawer-re org--property-drawer-modified-re)) > + (dolist (el org--modified-elements) > + (save-match-data > + (save-excursion > + (save-restriction > + (let* ((type (org-element-type el)) > + (change-func (alist-get type org-track-modification-elements))) > + (funcall (symbol-function change-func) el))))))) > + (setq org--modified-elements nil)) > + > (defvar org-mode-map) > (defvar org-inhibit-startup-visibility-stuff nil) ; Dynamically-scoped param. > (defvar org-agenda-keep-modes nil) ; Dynamically-scoped param. > @@ -4818,6 +4969,9 @@ The following commands are available: > ;; Activate before-change-function > (setq-local org-table-may-need-update t) > (add-hook 'before-change-functions 'org-before-change-function nil 'local) > + (add-hook 'before-change-functions 'org--before-element-change-function nil 'local) > + ;; Activate after-change-function > + (add-hook 'after-change-functions 'org--after-element-change-function nil 'local) > ;; Check for running clock before killing a buffer > (add-hook 'kill-buffer-hook 'org-check-running-clock nil 'local) > ;; Initialize macros templates. > @@ -4869,6 +5023,10 @@ The following commands are available: > (setq-local outline-isearch-open-invisible-function > (lambda (&rest _) (org-show-context 'isearch))) > > + ;; Make isearch search in blocks hidden via text properties > + (setq-local isearch-filter-predicate #'org--isearch-filter-predicate) > + (add-hook 'isearch-mode-end-hook #'org--clear-isearch-overlays nil 'local) > + > ;; Setup the pcomplete hooks > (setq-local pcomplete-command-completion-function #'org-pcomplete-initial) > (setq-local pcomplete-command-name-function #'org-command-at-point) > @@ -5859,9 +6017,26 @@ If TAG is a number, get the corresponding match group." > (inhibit-modification-hooks t) > deactivate-mark buffer-file-name buffer-file-truename) > (decompose-region beg end) > + ;; do not remove invisible text properties specified by > + ;; 'org-hide-block and 'org-hide-drawer (but remove 'org-link) > + ;; this is needed to keep the drawers and blocks hidden unless > + ;; they are toggled by user > + ;; Note: The below may be too specific and create troubles > + ;; if more invisibility specs are added to org in future > + (let ((pos beg) > + next spec) > + (while (< pos end) > + (setq next (next-single-property-change pos 'invisible nil end) > + spec (get-text-property pos 'invisible)) > + (unless (memq spec (list 'org-hide-block > + 'org-hide-drawer)) > + (remove-text-properties pos next '(invisible t))) > + (setq pos next))) > (remove-text-properties beg end > '(mouse-face t keymap t org-linked-text t > - invisible t intangible t > + ;; Do not remove all invisible during fontification > + ;; invisible t > + intangible t > org-emphasis t)) > (org-remove-font-lock-display-properties beg end))) > > @@ -6666,8 +6841,13 @@ information." > ;; expose it. > (dolist (o (overlays-at (point))) > (when (memq (overlay-get o 'invisible) > - '(org-hide-block org-hide-drawer outline)) > + '(outline)) > (delete-overlay o))) > + (when (memq (get-text-property (point) 'invisible) > + '(org-hide-block org-hide-drawer)) > + (let ((spec (get-text-property (point) 'invisible)) > + (region (org--find-text-property-region (point) 'invisible))) > + (org-flag-region (car region) (cdr region) nil spec))) > (unless (org-before-first-heading-p) > (org-with-limited-levels > (cl-case detail > @@ -20902,6 +21082,79 @@ Started from `gnus-info-find-node'." > (t default-org-info-node)))))) > > \f > + > +;;; Make isearch search in some text hidden via text propertoes > + > +(defvar org--isearch-overlays nil > + "List of overlays temporarily created during isearch. > +This is used to allow searching in regions hidden via text properties. > +As for [2020-05-09 Sat], Isearch only has special handling of hidden overlays. > +Any text hidden via text properties is not revealed even if `search-invisible' > +is set to 't.") > + > +;; Not sure if it needs to be a user option > +;; One might want to reveal hidden text in, for example, hidden parts of the links. > +;; Currently, hidden text in links is never revealed by isearch. > +(defvar org-isearch-specs '(org-hide-block > + org-hide-drawer) > + "List of text invisibility specs to be searched by isearch. > +By default ([2020-05-09 Sat]), isearch does not search in hidden text, > +which was made invisible using text properties. Isearch will be forced > +to search in hidden text with any of the listed 'invisible property value.") > + > +(defun org--create-isearch-overlays (beg end) > + "Replace text property invisibility spec by overlays between BEG and END. > +All the regions with invisibility text property spec from > +`org-isearch-specs' will be changed to use overlays instead > +of text properties. The created overlays will be stored in > +`org--isearch-overlays'." > + (let ((pos beg)) > + (while (< pos end) > + (when-let* ((spec (get-text-property pos 'invisible)) > + (spec (memq spec org-isearch-specs)) > + (region (org--find-text-property-region pos 'invisible))) > + ;; Changing text properties is considered buffer modification. > + ;; We do not want it here. > + (with-silent-modifications > + ;; The overlay is modelled after `org-flag-region' [2020-05-09 Sat] > + ;; overlay for 'outline blocks. > + (let ((o (make-overlay (car region) (cdr region) nil 'front-advance))) > + (overlay-put o 'evaporate t) > + (overlay-put o 'invisible spec) > + ;; `delete-overlay' here means that spec information will be lost > + ;; for the region. The region will remain visible. > + (overlay-put o 'isearch-open-invisible #'delete-overlay) > + (push o org--isearch-overlays)) > + (remove-text-properties (car region) (cdr region) '(invisible nil)))) > + (setq pos (next-single-property-change pos 'invisible nil end))))) > + > +(defun org--isearch-filter-predicate (beg end) > + "Return non-nil if text between BEG and END is deemed visible by Isearch. > +This function is intended to be used as `isearch-filter-predicate'. > +Unlike `isearch-filter-visible', make text with 'invisible text property > +value listed in `org-isearch-specs' visible to Isearch." > + (org--create-isearch-overlays beg end) ;; trick isearch by creating overlays in place of invisible text > + (isearch-filter-visible beg end)) > + > +(defun org--clear-isearch-overlay (ov) > + "Convert OV region back into using text properties." > + (when-let ((spec (overlay-get ov 'invisible))) ;; ignore deleted overlays > + ;; Changing text properties is considered buffer modification. > + ;; We do not want it here. > + (with-silent-modifications > + (put-text-property (overlay-start ov) (overlay-end ov) 'invisible spec))) > + (when (member ov isearch-opened-overlays) > + (setq isearch-opened-overlays (delete ov isearch-opened-overlays))) > + (delete-overlay ov)) > + > +(defun org--clear-isearch-overlays () > + "Convert overlays from `org--isearch-overlays' back into using text properties." > + (when org--isearch-overlays > + (mapc #'org--clear-isearch-overlay org--isearch-overlays) > + (setq org--isearch-overlays nil))) > + > +\f > + > ;;; Finish up > > (add-hook 'org-mode-hook ;remove overlays when changing major mode > > > Nicolas Goaziou <mail@nicolasgoaziou.fr> writes: > >> Ihor Radchenko <yantar92@gmail.com> writes: >> >>> This should be better: >>> https://gist.github.com/yantar92/e37c2830d3bb6db8678b14424286c930 >> >> Thank you. >> >>> This might get tricky in the following case: >>> >>> :PROPERTIES: >>> :CREATED: [2020-04-13 Mon 22:31] >>> <region-beginning> >>> :SHOWFROMDATE: 2020-05-11 >>> :ID: e05e3b33-71ba-4bbc-abba-8a92c565ad34 >>> :END: >>> >>> <many subtrees in between> >>> >>> :PROPERTIES: >>> :CREATED: [2020-04-27 Mon 13:50] >>> <region-end> >>> :ID: b2eef49f-1c5c-4ff1-8e10-80423c8d8532 >>> :ATTACH_DIR_INHERIT: t >>> :END: >>> >>> If the text in the region is replaced by something else, <many subtrees >>> in between> should not be fully hidden. We cannot simply look at the >>> 'invisible property before and after the changed region. >> >> Be careful: "replaced by something else" is ambiguous. "Replacing" is an >> unlikely change: you would need to do >> >> (setf (buffer-substring x y) "foo") >> >> We can safely assume this will not happen. If it does, we can accept the >> subsequent glitch. >> >> Anyway it is less confusing to think in terms of deletion and insertion. >> In the case above, you probably mean "the region is deleted then >> something else is inserted", or the other way. So there are two actions >> going on, i.e., `after-change-functions' are called twice. >> >> In particular the situation you foresee /cannot happen/ with an >> insertion. Text is inserted at a single point. Let's assume this is in >> the first drawer. Once inserted, both text before and after the new text >> were part of the same drawer. Insertion introduces other problems, >> though. More on this below. >> >> It is true the deletion can produce the situation above. But in this >> case, there is nothing to do, you just merged two drawers into a single >> one, which stays invisible. Problem solved. >> >> IOW, big changes like the one you describe are not an issue. I think the >> "check if previous and next parts match" trick gives us roughly the same >> functionality, and the same glitches, as overlays. >> >> However, I think we can do better than that, and also fix the glitches >> from overlays. Here are two of them. Write the following drawer: >> >> :FOO: >> bar >> :END: >> >> fold it and delete the ":f". The overlay is still there, and you cannot >> remove it with TAB any more. Or, with the same initial drawer, from >> beginning of buffer, evaluate: >> >> (progn (re-search-forward ":END:") (replace-match "")) >> >> This is no longer a drawer: you just removed its closing line. Yet, the >> overlay is still there, and TAB is ineffective. >> >> Here's an idea to develop that would make folding more robust, and still >> fast. >> >> Each syntactical element has a "sensitive part", a particular area that >> can change the nature of the element when it is altered. Luckily drawers >> (and blocks) are sturdy. For a drawer, there are three things to check: >> >> 1. the opening line must match org-drawer-regexp >> 2. the closing line must match org-property-end-re (case ignored) >> 3. between those, you must not insert text match org-property-end-re or >> org-outline-regexp-bol >> >> Obviously, point 3 needs not be checked during deletion. >> >> Instead of `after-change-functions', we may use `modification-hooks' for >> deletions, and `insert-behind-hooks' for insertions. For example, we >> might add modification-hooks property to both opening and closing line, >> and `insert-behind-hooks' on all the drawer. If any of the 3 points >> above is verified, we remove all properties. >> >> Note that if we can implement something robust with text properties, we >> might use them for headlines too, for another significant speed-up. >> >> WDYT? >> >>> I think that using fontification (something similar to >>> org-fontify-drawers) instead of after-change-functions should be >>> faster. >> >> I don't think it would be faster. With `after-change-functions', >> `modification-hooks' or `insert-behind-hook', we know exactly where the >> change happened. Fontification is fuzzier. It is not instantaneous >> either. >> >> It is an option only if we cannot do something fast and accurate with >> `after-change-functions', IMO. >> > > -- > Ihor Radchenko, > PhD, > Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) > State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China > Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-05-17 15:40 ` Ihor Radchenko @ 2020-05-18 14:35 ` Nicolas Goaziou 2020-05-18 16:52 ` Ihor Radchenko 0 siblings, 1 reply; 192+ messages in thread From: Nicolas Goaziou @ 2020-05-18 14:35 UTC (permalink / raw) To: Ihor Radchenko; +Cc: emacs-orgmode Hello, Ihor Radchenko <yantar92@gmail.com> writes: > Apparently my previous email was again refused by your mail server (I > tried to add patch as attachment this time). Ah. This is annoying, for you and for me. > The patch is in > https://gist.github.com/yantar92/6447754415457927293acda43a7fcaef Thank you. >> I have finished a seemingly stable implementation of handling changes >> inside drawer and block elements. For now, I did not bother with >> 'modification-hooks and 'insert-in-font/behind-hooks, but simply used >> before/after-change-functions. >> >> The basic idea is saving parsed org-elements before the modification >> (with :begin and :end replaced by markers) and comparing them with the >> versions of the same elements after the modification. >> Any valid org element can be examined in such way by an arbitrary >> function (see org-track-modification-elements) [1]. As you noticed, using Org Element is a no-go, unfortunately. Parsing an element is a O(N) operation by the number of elements before it in a section. In particular, it is not bounded, and not mitigated by a cache. For large documents, it is going to be unbearably slow, too. I don't think the solution is to use combine-after-change-calls either, because even a single call to `org-element-at-point' can be noticeable in a very large section. Such low-level code should avoid using the Element library altogether, except for the initial folding part, which is interactive. If you use modification-hooks and al., you don't need to parse anything, because you can store information as text properties. Therefore, once the modification happens, you already know where you are (or, at least where you were before the change). The ideas I suggested about sensitive parts of elements are worth exploring, IMO. Do you have any issue with them? >> For (2), I have introduced org--property-drawer-modified-re to override >> org-property-drawer-re in relevant *-change-function. This seems to work >> for property drawers. However, I am not sure if similar problem may >> happen in some border cases with ordinary drawers or blocks. I already specified what parts were "sensitive" in a previous message. >> 2. I have noticed that results of org-element-at-point and >> org-element-parse-buffer are not always consistent. `org-element-at-point' is local, `org-element-parse-buffer' is global. They are not equivalent, but is it an issue? Regards, -- Nicolas Goaziou ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-05-18 14:35 ` Nicolas Goaziou @ 2020-05-18 16:52 ` Ihor Radchenko 2020-05-19 13:07 ` Nicolas Goaziou 0 siblings, 1 reply; 192+ messages in thread From: Ihor Radchenko @ 2020-05-18 16:52 UTC (permalink / raw) To: Nicolas Goaziou; +Cc: emacs-orgmode > As you noticed, using Org Element is a no-go, unfortunately. Parsing an > element is a O(N) operation by the number of elements before it in > a section. In particular, it is not bounded, and not mitigated by > a cache. For large documents, it is going to be unbearably slow, too. Ouch. I thought it is faster. What do you mean by "not mitigated by a cache"? The reason I would like to utilise org-element parser to make tracking modifications more robust. Using details of the syntax would make the code fragile if any modifications are made to syntax in future. Debugging bugs in modification functions is not easy, according to my experience. One possible way to avoid performance issues during modification is running parser in advance. For example, folding an element may as well add information about the element to its text properties. This will not degrade performance of folding since we are already parsing the element during folding (at least, in org-hide-drawer-toggle). The problem with parsing an element during folding is that we cannot easily detect changes like below without re-parsing. :PROPERTIES: <folded> :CREATED: [2020-05-18 Mon] :END: <- added line :ID: test :END: or even :PROPERTIES: :CREATED: [2020-05-18 Mon] :ID: test :END: <- delete this line :DRAWER: <folded, cannot be unfolded if we don't re-parse after deletion> test :END: The re-parsing can be done via regexp, as you suggested, but I don't like this idea, because it will end up re-implementing org-element-*-parser. Would it be acceptable to run org-element-*-parser in after-change-functions? > If you use modification-hooks and al., you don't need to parse anything, > because you can store information as text properties. Therefore, once > the modification happens, you already know where you are (or, at least > where you were before the change). > The ideas I suggested about sensitive parts of elements are worth > exploring, IMO. Do you have any issue with them? If I understand correctly, it is not as easy. Consider the following example: :PROPERTIES: :CREATED: [2020-05-18 Mon] <region-beginning> :ID: example :END: <... a lot of text, maybe containing other drawers ...> Nullam rutrum. Pellentesque dapibus suscipit ligula. <region-end> Proin quam nisl, tincidunt et, mattis eget, convallis nec, purus. If the region gets deleted, the modification hooks from chars inside drawer will be called as (hook-function <region-beginning> <region-end>). So, there is still a need to find the drawer somehow to mark it as about to be modified (modification hooks are ran before actual modification). The only difference between using modification hooks and before-change-functions is that modification hooks will trigger less frequently. Considering the performance of org-element-at-point, it is probably worth doing. Initially, I wanted to avoid it because setting a single before-change-functions hook sounded cleaner than setting modification-hooks, insert-behind-hooks, and insert-in-front-hooks. Moreover, these text properties would be copied by default if one uses buffer-substring. Then, the hooks will also trigger later in the yanked text, which may cause all kinds of bugs. > `org-element-at-point' is local, `org-element-parse-buffer' is global. > They are not equivalent, but is it an issue? It was mostly an annoyance, because they returned different results on the same element. Specifically, they returned different :post-blank and :end properties, which does not sound right. Best, Ihor Nicolas Goaziou <mail@nicolasgoaziou.fr> writes: > Hello, > > Ihor Radchenko <yantar92@gmail.com> writes: > >> Apparently my previous email was again refused by your mail server (I >> tried to add patch as attachment this time). > > Ah. This is annoying, for you and for me. > >> The patch is in >> https://gist.github.com/yantar92/6447754415457927293acda43a7fcaef > > Thank you. > >>> I have finished a seemingly stable implementation of handling changes >>> inside drawer and block elements. For now, I did not bother with >>> 'modification-hooks and 'insert-in-font/behind-hooks, but simply used >>> before/after-change-functions. >>> >>> The basic idea is saving parsed org-elements before the modification >>> (with :begin and :end replaced by markers) and comparing them with the >>> versions of the same elements after the modification. >>> Any valid org element can be examined in such way by an arbitrary >>> function (see org-track-modification-elements) [1]. > > As you noticed, using Org Element is a no-go, unfortunately. Parsing an > element is a O(N) operation by the number of elements before it in > a section. In particular, it is not bounded, and not mitigated by > a cache. For large documents, it is going to be unbearably slow, too. > > I don't think the solution is to use combine-after-change-calls either, > because even a single call to `org-element-at-point' can be noticeable > in a very large section. Such low-level code should avoid using the > Element library altogether, except for the initial folding part, which > is interactive. > > If you use modification-hooks and al., you don't need to parse anything, > because you can store information as text properties. Therefore, once > the modification happens, you already know where you are (or, at least > where you were before the change). > > The ideas I suggested about sensitive parts of elements are worth > exploring, IMO. Do you have any issue with them? > >>> For (2), I have introduced org--property-drawer-modified-re to override >>> org-property-drawer-re in relevant *-change-function. This seems to work >>> for property drawers. However, I am not sure if similar problem may >>> happen in some border cases with ordinary drawers or blocks. > > I already specified what parts were "sensitive" in a previous message. > >>> 2. I have noticed that results of org-element-at-point and >>> org-element-parse-buffer are not always consistent. > > `org-element-at-point' is local, `org-element-parse-buffer' is global. > They are not equivalent, but is it an issue? > > > Regards, > > -- > Nicolas Goaziou -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-05-18 16:52 ` Ihor Radchenko @ 2020-05-19 13:07 ` Nicolas Goaziou 2020-05-23 13:52 ` Ihor Radchenko 0 siblings, 1 reply; 192+ messages in thread From: Nicolas Goaziou @ 2020-05-19 13:07 UTC (permalink / raw) To: Ihor Radchenko; +Cc: emacs-orgmode Hello, Ihor Radchenko <yantar92@gmail.com> writes: >> As you noticed, using Org Element is a no-go, unfortunately. Parsing an >> element is a O(N) operation by the number of elements before it in >> a section. In particular, it is not bounded, and not mitigated by >> a cache. For large documents, it is going to be unbearably slow, too. > > Ouch. I thought it is faster. > What do you mean by "not mitigated by a cache"? Parsing starts from the closest headline, every time. So, if Org parses the Nth element in the entry two times, it really parses 2N elements. With a cache, assuming the buffer wasn't modified, Org would parse N elements only. With a smarter cache, with fine grained cache invalidation, it could also reduce the number of subsequent parsed elements. > The reason I would like to utilise org-element parser to make tracking > modifications more robust. Using details of the syntax would make the > code fragile if any modifications are made to syntax in future. I don't think the code would be more fragile. Also, the syntax we're talking about is not going to be modified anytime soon. Moreover, if folding breaks, it is usually visible, so the bug will not be unnoticed. This code is going to be as low-level as it can be. > Debugging bugs in modification functions is not easy, according to my > experience. No, it's not. But this is not really related to whether you use Element or not. > One possible way to avoid performance issues during modification is > running parser in advance. For example, folding an element may > as well add information about the element to its text properties. > This will not degrade performance of folding since we are already > parsing the element during folding (at least, in > org-hide-drawer-toggle). We can use this information stored at fold time. But I'm not even sure we need it. > The problem with parsing an element during folding is that we cannot > easily detect changes like below without re-parsing. Of course we can. It is only necessary to focus on changes that would break the structure of the element. This does not entail a full parsing. > :PROPERTIES: <folded> > :CREATED: [2020-05-18 Mon] > :END: <- added line > :ID: test > :END: > > or even > > :PROPERTIES: > :CREATED: [2020-05-18 Mon] > :ID: test > :END: <- delete this line > > :DRAWER: <folded, cannot be unfolded if we don't re-parse after deletion> > test > :END: Please have a look at the "sensitive parts" I wrote about. This takes care of this kind of breakage. > The re-parsing can be done via regexp, as you suggested, but I don't > like this idea, because it will end up re-implementing > org-element-*-parser. You may have misunderstood my suggestion. See below. > Would it be acceptable to run org-element-*-parser > in after-change-functions? I'd rather not do that. This is unnecessary consing, and matching, etc. > If I understand correctly, it is not as easy. > Consider the following example: > > :PROPERTIES: > :CREATED: [2020-05-18 Mon] > <region-beginning> > :ID: example > :END: > > <... a lot of text, maybe containing other drawers ...> > > Nullam rutrum. > Pellentesque dapibus suscipit ligula. > <region-end> > Proin quam nisl, tincidunt et, mattis eget, convallis nec, purus. > > If the region gets deleted, the modification hooks from chars inside > drawer will be called as (hook-function <region-beginning> > <region-end>). So, there is still a need to find the drawer somehow to > mark it as about to be modified (modification hooks are ran before > actual modification). If we can stick with `after-change-functions' (or local equivalent), that's better. It is more predictable than `before-change-functions' and alike. If it is a deletion, here is the kind of checks we could do, depending on when they are performed. Before actual changes : 1. The deletion is happening within a folded drawer (unnecessary step in local functions). 2. The change deleted the sensitive line ":END:". 3. Conclusion : unfold. Or, after actual changes : 1. The deletion involves a drawer. 2. Text properties indicate that the beginning of the propertized part of the buffer start with org-drawer-regexp, but doesn't end with `org-property-end-re'. A "sensitive part" disappeared! 3. Conclusion : unfold This is far away from parsing. IMO, a few checks cover all cases. Let me know if you have questions about it. Also, note that the kind of change you describe will happen perhaps 0.01% of the time. Most change are about one character, or a single line, long. > The only difference between using modification hooks and > before-change-functions is that modification hooks will trigger less > frequently. Exactly. Much less frequently. But extra care is required, as you noted already. > Considering the performance of org-element-at-point, it is > probably worth doing. Initially, I wanted to avoid it because setting a > single before-change-functions hook sounded cleaner than setting > modification-hooks, insert-behind-hooks, and insert-in-front-hooks. Well, `before-change-fuctions' and `after-change-functions' are not clean at all: you modify an unrelated part of the buffer, but still call those to check if a drawer needs to be unfolded somewhere. And, more importantly, they are not meant to be used together, i.e., you cannot assume that a single call to `before-change-functions' always happens before calling `after-change-functions'. This can be tricky if you want to use the former to pass information to the latter. But I understand that they are easier to use than their local counterparts. If you stick with (before|after)-change-functions, the function being called needs to drop the ball very quickly if the modification is not about folding changes. Also, I very much suggest to stick to only `after-change-functions', if feasible (I think it is), per above. > Moreover, these text properties would be copied by default if one uses > buffer-substring. Then, the hooks will also trigger later in the yanked > text, which may cause all kinds of bugs. Indeed, that would be something to handle specifically. I.e., destructive modifications (i.e., those that unfold) could clear such properties. It is more work. I don't know if it is worth the trouble if we can get out quickly of `after-change-functions' for unrelated changes. > It was mostly an annoyance, because they returned different results on > the same element. Specifically, they returned different :post-blank and > :end properties, which does not sound right. OK. If you have a reproducible recipe, I can look into it and see what can be done. Regards, -- Nicolas Goaziou ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-05-19 13:07 ` Nicolas Goaziou @ 2020-05-23 13:52 ` Ihor Radchenko 2020-05-23 13:53 ` Ihor Radchenko 2020-05-26 8:33 ` Nicolas Goaziou 0 siblings, 2 replies; 192+ messages in thread From: Ihor Radchenko @ 2020-05-23 13:52 UTC (permalink / raw) To: Nicolas Goaziou; +Cc: emacs-orgmode Hello, [The patch itself will be provided in the following email] I have five updates from the previous version of the patch: 1. I implemented a simplified version of element parsing to detect changes in folded drawers or blocks. No computationally expensive calls of org-element-at-point or org-element-parse-buffer are needed now. 2. The patch is now compatible with master (commit 2e96dc639). I reverted the earlier change in folding drawers and blocks. Now, they are back to using 'org-hide-block and 'org-hide-drawer. Using 'outline would achieve nothing when we use text properties. 3. 'invisible text property can now be nested. This is important, for example, when text inside drawers contains fontified links (which also use 'invisible text property to hide parts of the link). Now, the old 'invisible spec is recovered after unfolding. 4. Some outline-* function calls in org referred to outline-flag-region implementation, which is not in sync with org-flag-region in this patch. I have implemented their org-* versions and replaced the calls throughout .el files. Actually, some org-* versions were already implemented in org, but not used for some reason (or not mentioned in the manual). I have updated the relevant sections of manual. These changes might be relevant to org independently of this feature branch. 5. I have managed to get a working version of outline folding via text properties. However, that approach has a big downside - folding state cannot be different in indirect buffer when we use text properties. I have seen packages relying on this feature of org and I do not see any obvious way to achieve different folding state in indirect buffer while using text properties for outline folding. ----------------------------------------------------------------------- ----------------------------------------------------------------------- More details on the new implementation for tracking changes: > Of course we can. It is only necessary to focus on changes that would > break the structure of the element. This does not entail a full parsing. I have limited parsing to matching beginning and end of a drawer/block. The basic functions are org--get-element-region-at-point, org--get-next-element-region-at-point, and org--find-elements-in-region. They are simplified versions of org-element-* parsers and do not require parsing everything from the beginning of the section. For now, I keep everything in org.el, but those simplified parsers probably belong to org-element.el. > If we can stick with `after-change-functions' (or local equivalent), > that's better. It is more predictable than `before-change-functions' and > alike. For now, I still used before/after-change-functions combination. I see the following problems with using only after-change-functions: 1. They are not guaranteed to be called after every single change: From (elisp) Change Hooks: "... some complex primitives call ‘before-change-functions’ once before making changes, and then call ‘after-change-functions’ zero or more times" The consequence of it is a possibility that region passed to the after-change-functions is quite big (including all the singular changes, even if they are distant). This region may contain changed drawers as well and unchanged drawers and needs to be parsed to determine which drawers need to be re-folded. > And, more importantly, they are not meant to be used together, i.e., you > cannot assume that a single call to `before-change-functions' always > happens before calling `after-change-functions'. This can be tricky if > you want to use the former to pass information to the latter. The fact that before-change-functions can be called multiple times before after-change-functions, is trivially solved by using buffer-local changes register (see org--modified-elements). The register is populated by before-change-functions and cleared by after-change-functions. > Well, `before-change-fuctions' and `after-change-functions' are not > clean at all: you modify an unrelated part of the buffer, but still call > those to check if a drawer needs to be unfolded somewhere. 2. As you pointed, instead of global before-change-functions, we can use modification-hooks text property on sensitive parts of the drawers/blocks. This would work, but I am concerned about one annoying special case: ------------------------------------------------------------------------- :BLAH: <inserted outside any of the existing drawers> <some text> :DRAWER: <folded> Donec at pede. :END: ------------------------------------------------------------------------- In this example, the user would not be able to unfold the folder DRAWER because it will technically become a part of a new giant BLAH drawer. This may be especially annoying if <some text> is more than one screen long and there is no easy way to identify why unfolding does not work (with point at :DRAWER:). Because of this scenario, limiting before-change-functions to folded drawers is not sufficient. Any change in text may need to trigger unfolding. In the patch, I always register possible modifications in the blocks/drawers intersecting with the modified region + a drawer/block right next to the region. ----------------------------------------------------------------------- ----------------------------------------------------------------------- More details on the nested 'invisible text property implementation. The idea is to keep 'invisible property stack push and popping from it as we add/remove 'invisible text property. All the work is done in org-flag-region. This was originally intended for folding outlines via text properties. Since using text properties for folding outlines is not a good idea, nested text properties have much less use. As I mentioned, they do preserve link fontification, but I am not sure if it worth it for the overhead to org-flag-region. Keeping this here mostly in the case if someone has any ideas how it can be useful. ----------------------------------------------------------------------- ----------------------------------------------------------------------- More details on replaced outline-* -> org-* function calls. I have implemented org-* versions of the following functions: - outline-hide-entry - outline-hide-subtree - outline-hide-sublevels - outline-show-heading - outline-show-branches The org-* versions trivially use org-flag-region instead of outline-flag-region. Replaced outline-* calls where org- versions were already available: - outline-show-entry - outline-show-all - outline-show-subtree I reflected the new (including already available) functions in the manual and removed some defalias from org-compat.el where they are not needed. ----------------------------------------------------------------------- ----------------------------------------------------------------------- Further work: 1. after-change-functions use org-hide-drawer/block-toggle to fold/unfold after modification. However, I just found that they call org-element-at-point, which slows down modifications in folded drawers/blocks. For example, realigning a long table inside folded drawer takes >1sec, while it is instant in the unfolded drawer. 2. org-toggle-custom-properties is terribly slow on large org documents, similarly to folded drawers on master. It should be relatively easy to use text properties there instead of overlays. 3. Multiple calls to before/after-change-functions is still a problem. I am looking into following ways to reduce this number: - reduce the number of elements registered as potentially modified + do not add duplicates to org--modified-elements + do not add unfolded elements to org--modified-elements + register after-change-function as post-command hook and remove it from global after-change-functions. This way, it will be called twice per command only. - determine common region containing org--modified-elements. if change is happening within that region, there is no need to parse drawers/blocks there again. P.S. >> It was mostly an annoyance, because they returned different results on >> the same element. Specifically, they returned different :post-blank and >> :end properties, which does not sound right. > > OK. If you have a reproducible recipe, I can look into it and see what > can be done. Recipe to have different (org-element-at-point) and (org-element-parse-buffer 'element) ------------------------------------------------------------------------- <point-min> :PROPERTIES: :CREATED: [2020-05-23 Sat 02:32] :END: <point-max> ------------------------------------------------------------------------- Best, Ihor Nicolas Goaziou <mail@nicolasgoaziou.fr> writes: > Hello, > > Ihor Radchenko <yantar92@gmail.com> writes: > >>> As you noticed, using Org Element is a no-go, unfortunately. Parsing an >>> element is a O(N) operation by the number of elements before it in >>> a section. In particular, it is not bounded, and not mitigated by >>> a cache. For large documents, it is going to be unbearably slow, too. >> >> Ouch. I thought it is faster. >> What do you mean by "not mitigated by a cache"? > > Parsing starts from the closest headline, every time. So, if Org parses > the Nth element in the entry two times, it really parses 2N elements. > > With a cache, assuming the buffer wasn't modified, Org would parse > N elements only. With a smarter cache, with fine grained cache > invalidation, it could also reduce the number of subsequent parsed > elements. > >> The reason I would like to utilise org-element parser to make tracking >> modifications more robust. Using details of the syntax would make the >> code fragile if any modifications are made to syntax in future. > > I don't think the code would be more fragile. Also, the syntax we're > talking about is not going to be modified anytime soon. Moreover, if > folding breaks, it is usually visible, so the bug will not be unnoticed. > > This code is going to be as low-level as it can be. > >> Debugging bugs in modification functions is not easy, according to my >> experience. > > No, it's not. > > But this is not really related to whether you use Element or not. > >> One possible way to avoid performance issues during modification is >> running parser in advance. For example, folding an element may >> as well add information about the element to its text properties. >> This will not degrade performance of folding since we are already >> parsing the element during folding (at least, in >> org-hide-drawer-toggle). > > We can use this information stored at fold time. But I'm not even sure > we need it. > >> The problem with parsing an element during folding is that we cannot >> easily detect changes like below without re-parsing. > > Of course we can. It is only necessary to focus on changes that would > break the structure of the element. This does not entail a full parsing. > >> :PROPERTIES: <folded> >> :CREATED: [2020-05-18 Mon] >> :END: <- added line >> :ID: test >> :END: >> >> or even >> >> :PROPERTIES: >> :CREATED: [2020-05-18 Mon] >> :ID: test >> :END: <- delete this line >> >> :DRAWER: <folded, cannot be unfolded if we don't re-parse after deletion> >> test >> :END: > > Please have a look at the "sensitive parts" I wrote about. This takes > care of this kind of breakage. > >> The re-parsing can be done via regexp, as you suggested, but I don't >> like this idea, because it will end up re-implementing >> org-element-*-parser. > > You may have misunderstood my suggestion. See below. > >> Would it be acceptable to run org-element-*-parser >> in after-change-functions? > > I'd rather not do that. This is unnecessary consing, and matching, etc. > >> If I understand correctly, it is not as easy. >> Consider the following example: >> >> :PROPERTIES: >> :CREATED: [2020-05-18 Mon] >> <region-beginning> >> :ID: example >> :END: >> >> <... a lot of text, maybe containing other drawers ...> >> >> Nullam rutrum. >> Pellentesque dapibus suscipit ligula. >> <region-end> >> Proin quam nisl, tincidunt et, mattis eget, convallis nec, purus. >> >> If the region gets deleted, the modification hooks from chars inside >> drawer will be called as (hook-function <region-beginning> >> <region-end>). So, there is still a need to find the drawer somehow to >> mark it as about to be modified (modification hooks are ran before >> actual modification). > > If we can stick with `after-change-functions' (or local equivalent), > that's better. It is more predictable than `before-change-functions' and > alike. > > If it is a deletion, here is the kind of checks we could do, depending > on when they are performed. > > Before actual changes : > > 1. The deletion is happening within a folded drawer (unnecessary step > in local functions). > 2. The change deleted the sensitive line ":END:". > 3. Conclusion : unfold. > > Or, after actual changes : > > 1. The deletion involves a drawer. > 2. Text properties indicate that the beginning of the propertized part > of the buffer start with org-drawer-regexp, but doesn't end with > `org-property-end-re'. A "sensitive part" disappeared! > 3. Conclusion : unfold > > This is far away from parsing. IMO, a few checks cover all cases. Let me > know if you have questions about it. > > Also, note that the kind of change you describe will happen perhaps > 0.01% of the time. Most change are about one character, or a single > line, long. > >> The only difference between using modification hooks and >> before-change-functions is that modification hooks will trigger less >> frequently. > > Exactly. Much less frequently. But extra care is required, as you noted > already. > >> Considering the performance of org-element-at-point, it is >> probably worth doing. Initially, I wanted to avoid it because setting a >> single before-change-functions hook sounded cleaner than setting >> modification-hooks, insert-behind-hooks, and insert-in-front-hooks. > > Well, `before-change-fuctions' and `after-change-functions' are not > clean at all: you modify an unrelated part of the buffer, but still call > those to check if a drawer needs to be unfolded somewhere. > > And, more importantly, they are not meant to be used together, i.e., you > cannot assume that a single call to `before-change-functions' always > happens before calling `after-change-functions'. This can be tricky if > you want to use the former to pass information to the latter. > > But I understand that they are easier to use than their local > counterparts. If you stick with (before|after)-change-functions, the > function being called needs to drop the ball very quickly if the > modification is not about folding changes. Also, I very much suggest to > stick to only `after-change-functions', if feasible (I think it is), per > above. > >> Moreover, these text properties would be copied by default if one uses >> buffer-substring. Then, the hooks will also trigger later in the yanked >> text, which may cause all kinds of bugs. > > Indeed, that would be something to handle specifically. I.e., > destructive modifications (i.e., those that unfold) could clear such > properties. > > It is more work. I don't know if it is worth the trouble if we can get > out quickly of `after-change-functions' for unrelated changes. > >> It was mostly an annoyance, because they returned different results on >> the same element. Specifically, they returned different :post-blank and >> :end properties, which does not sound right. > > OK. If you have a reproducible recipe, I can look into it and see what > can be done. > > Regards, > > -- > Nicolas Goaziou -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-05-23 13:52 ` Ihor Radchenko @ 2020-05-23 13:53 ` Ihor Radchenko 2020-05-23 15:26 ` Ihor Radchenko 2020-05-26 8:33 ` Nicolas Goaziou 1 sibling, 1 reply; 192+ messages in thread From: Ihor Radchenko @ 2020-05-23 13:53 UTC (permalink / raw) To: Nicolas Goaziou; +Cc: emacs-orgmode [-- Attachment #1: Type: text/plain, Size: 23 bytes --] The patch is attached [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: featuredrawertextprop-20200523.patch --] [-- Type: text/x-diff, Size: 45706 bytes --] diff --git a/contrib/lisp/org-notify.el b/contrib/lisp/org-notify.el index 9f8677871..ab470ea9b 100644 --- a/contrib/lisp/org-notify.el +++ b/contrib/lisp/org-notify.el @@ -246,7 +246,7 @@ seconds. The default value for SECS is 20." (switch-to-buffer (find-file-noselect file)) (org-with-wide-buffer (goto-char begin) - (outline-show-entry)) + (org-show-entry)) (goto-char begin) (search-forward "DEADLINE: <") (search-forward ":") diff --git a/contrib/lisp/org-velocity.el b/contrib/lisp/org-velocity.el index bfc4d6c3e..2312b235c 100644 --- a/contrib/lisp/org-velocity.el +++ b/contrib/lisp/org-velocity.el @@ -325,7 +325,7 @@ use it." (save-excursion (when narrow (org-narrow-to-subtree)) - (outline-show-all))) + (org-show-all))) (defun org-velocity-edit-entry/inline (heading) "Edit entry at HEADING in the original buffer." diff --git a/doc/org-manual.org b/doc/org-manual.org index 96b160175..2ebe94538 100644 --- a/doc/org-manual.org +++ b/doc/org-manual.org @@ -509,11 +509,11 @@ Org uses just two commands, bound to {{{kbd(TAB)}}} and Switch back to the startup visibility of the buffer (see [[*Initial visibility]]). -- {{{kbd(C-u C-u C-u TAB)}}} (~outline-show-all~) :: +- {{{kbd(C-u C-u C-u TAB)}}} (~org-show-all~) :: #+cindex: show all, command #+kindex: C-u C-u C-u TAB - #+findex: outline-show-all + #+findex: org-show-all Show all, including drawers. - {{{kbd(C-c C-r)}}} (~org-reveal~) :: @@ -529,18 +529,18 @@ Org uses just two commands, bound to {{{kbd(TAB)}}} and headings. With a double prefix argument, also show the entire subtree of the parent. -- {{{kbd(C-c C-k)}}} (~outline-show-branches~) :: +- {{{kbd(C-c C-k)}}} (~org-show-branches~) :: #+cindex: show branches, command #+kindex: C-c C-k - #+findex: outline-show-branches + #+findex: org-show-branches Expose all the headings of the subtree, but not their bodies. -- {{{kbd(C-c TAB)}}} (~outline-show-children~) :: +- {{{kbd(C-c TAB)}}} (~org-show-children~) :: #+cindex: show children, command #+kindex: C-c TAB - #+findex: outline-show-children + #+findex: org-show-children Expose all direct children of the subtree. With a numeric prefix argument {{{var(N)}}}, expose all children down to level {{{var(N)}}}. @@ -7294,7 +7294,7 @@ its location in the outline tree, but behaves in the following way: command (see [[*Visibility Cycling]]). You can force cycling archived subtrees with {{{kbd(C-TAB)}}}, or by setting the option ~org-cycle-open-archived-trees~. Also normal outline commands, like - ~outline-show-all~, open archived subtrees. + ~org-show-all~, open archived subtrees. - #+vindex: org-sparse-tree-open-archived-trees diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index ab13f926c..ad9244940 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -6826,7 +6826,7 @@ and stored in the variable `org-prefix-format-compiled'." (t " %-12:c%?-12t% s"))) (start 0) varform vars var e c f opt) - (while (string-match "%\\(\\?\\)?\\([-+]?[0-9.]*\\)\\([ .;,:!?=|/<>]?\\)\\([cltseib]\\|(.+)\\)" + (while (string-match "%\\(\\?\\)?\\([-+]?[0-9.]*\\)\\([ .;,:!?=|/<>]?\\)\\([cltseib]\\|(.+?)\\)" s start) (setq var (or (cdr (assoc (match-string 4 s) '(("c" . category) ("t" . time) ("l" . level) ("s" . extra) @@ -9138,20 +9138,20 @@ if it was hidden in the outline." ((and (called-interactively-p 'any) (= more 1)) (message "Remote: show with default settings")) ((= more 2) - (outline-show-entry) + (org-show-entry) (org-show-children) (save-excursion (org-back-to-heading) (run-hook-with-args 'org-cycle-hook 'children)) (message "Remote: CHILDREN")) ((= more 3) - (outline-show-subtree) + (org-show-subtree) (save-excursion (org-back-to-heading) (run-hook-with-args 'org-cycle-hook 'subtree)) (message "Remote: SUBTREE")) ((> more 3) - (outline-show-subtree) + (org-show-subtree) (message "Remote: SUBTREE AND ALL DRAWERS"))) (select-window win))) diff --git a/lisp/org-archive.el b/lisp/org-archive.el index d3e12d17b..d864dad8a 100644 --- a/lisp/org-archive.el +++ b/lisp/org-archive.el @@ -330,7 +330,7 @@ direct children of this heading." (insert (if datetree-date "" "\n") heading "\n") (end-of-line 0)) ;; Make the subtree visible - (outline-show-subtree) + (org-show-subtree) (if org-archive-reversed-order (progn (org-back-to-heading t) diff --git a/lisp/org-colview.el b/lisp/org-colview.el index e50a4d7c8..e656df555 100644 --- a/lisp/org-colview.el +++ b/lisp/org-colview.el @@ -699,7 +699,7 @@ FUN is a function called with no argument." (move-beginning-of-line 2) (org-at-heading-p t))))) (unwind-protect (funcall fun) - (when hide-body (outline-hide-entry))))) + (when hide-body (org-hide-entry))))) (defun org-columns-previous-allowed-value () "Switch to the previous allowed value for this column." diff --git a/lisp/org-compat.el b/lisp/org-compat.el index 635a38dcd..8fe271896 100644 --- a/lisp/org-compat.el +++ b/lisp/org-compat.el @@ -139,12 +139,8 @@ This is a floating point number if the size is too large for an integer." ;;; Emacs < 25.1 compatibility (when (< emacs-major-version 25) - (defalias 'outline-hide-entry 'hide-entry) - (defalias 'outline-hide-sublevels 'hide-sublevels) - (defalias 'outline-hide-subtree 'hide-subtree) (defalias 'outline-show-branches 'show-branches) (defalias 'outline-show-children 'show-children) - (defalias 'outline-show-entry 'show-entry) (defalias 'outline-show-subtree 'show-subtree) (defalias 'xref-find-definitions 'find-tag) (defalias 'format-message 'format) diff --git a/lisp/org-element.el b/lisp/org-element.el index ac41b7650..2d5c8d771 100644 --- a/lisp/org-element.el +++ b/lisp/org-element.el @@ -4320,7 +4320,7 @@ element or object. Meaningful values are `first-section', TYPE is the type of the current element or object. If PARENT? is non-nil, assume the next element or object will be -located inside the current one. " +located inside the current one." (if parent? (pcase type (`headline 'section) diff --git a/lisp/org-keys.el b/lisp/org-keys.el index c006e9c12..deb5d7b90 100644 --- a/lisp/org-keys.el +++ b/lisp/org-keys.el @@ -437,7 +437,7 @@ COMMANDS is a list of alternating OLDDEF NEWDEF command names." #'org-next-visible-heading) (define-key org-mode-map [remap outline-previous-visible-heading] #'org-previous-visible-heading) -(define-key org-mode-map [remap show-children] #'org-show-children) +(define-key org-mode-map [remap outline-show-children] #'org-show-children) ;;;; Make `C-c C-x' a prefix key (org-defkey org-mode-map (kbd "C-c C-x") (make-sparse-keymap)) diff --git a/lisp/org-macs.el b/lisp/org-macs.el index a02f713ca..fa0a658f0 100644 --- a/lisp/org-macs.el +++ b/lisp/org-macs.el @@ -682,7 +682,7 @@ When NEXT is non-nil, check the next line instead." \f -;;; Overlays +;;; Overlays and text properties (defun org-overlay-display (ovl text &optional face evap) "Make overlay OVL display TEXT with face FACE." @@ -705,18 +705,99 @@ If DELETE is non-nil, delete all those overlays." (delete (delete-overlay ov)) (t (push ov found)))))) +(defun org-remove-text-properties (start end properties &optional object) + "Remove text properties as in `remove-text-properties', but keep 'invisibility specs for folded regions. +Do not remove invisible text properties specified by 'outline, +'org-hide-block, and 'org-hide-drawer (but remove i.e. 'org-link) this +is needed to keep outlines, drawers, and blocks hidden unless they are +toggled by user. +Note: The below may be too specific and create troubles if more +invisibility specs are added to org in future" + (when (plist-member properties 'invisible) + (let ((pos start) + next spec) + (while (< pos end) + (setq next (next-single-property-change pos 'invisible nil end) + spec (get-text-property pos 'invisible)) + (unless (memq spec (list 'org-hide-block + 'org-hide-drawer + 'outline)) + (remove-text-properties pos next '(invisible nil) object)) + (setq pos next)))) + (when-let ((properties-stripped (org-plist-delete properties 'invisible))) + (remove-text-properties start end properties-stripped object))) + +(defun org--find-text-property-region (pos prop) + "Find a region containing PROP text property around point POS." + (let* ((beg (and (get-text-property pos prop) pos)) + (end beg)) + (when beg + ;; when beg is the first point in the region, `previous-single-property-change' + ;; will return nil. + (setq beg (or (previous-single-property-change pos prop) + beg)) + ;; when end is the last point in the region, `next-single-property-change' + ;; will return nil. + (setq end (or (next-single-property-change pos prop) + end)) + (unless (= beg end) ; this should not happen + (cons beg end))))) + (defun org-flag-region (from to flag spec) "Hide or show lines from FROM to TO, according to FLAG. SPEC is the invisibility spec, as a symbol." - (remove-overlays from to 'invisible spec) - ;; Use `front-advance' since text right before to the beginning of - ;; the overlay belongs to the visible line than to the contents. - (when flag - (let ((o (make-overlay from to nil 'front-advance))) - (overlay-put o 'evaporate t) - (overlay-put o 'invisible spec) - (overlay-put o 'isearch-open-invisible #'delete-overlay)))) - + (pcase spec + ('outline + (remove-overlays from to 'invisible spec) + ;; Use `front-advance' since text right before to the beginning of + ;; the overlay belongs to the visible line than to the contents. + (when flag + (let ((o (make-overlay from to nil 'front-advance))) + (overlay-put o 'evaporate t) + (overlay-put o 'invisible spec) + (overlay-put o 'isearch-open-invisible #'delete-overlay)))) + (_ + ;; Use text properties instead of overlays for speed. + ;; Overlays are too slow (Emacs Bug#35453). + (with-silent-modifications + ;; keep a backup stack of old text properties + (save-excursion + (goto-char from) + (while (< (point) to) + (let ((old-spec (get-text-property (point) 'invisible)) + (end (next-single-property-change (point) 'invisible nil to))) + (when old-spec + (alter-text-property (point) end 'org-property-stack-invisible + (lambda (stack) + (if (or (eq old-spec (car stack)) + (eq spec old-spec) + (eq old-spec 'outline)) + stack + (cons old-spec stack))))) + (goto-char end)))) + + ;; cleanup everything + (remove-text-properties from to '(invisible nil)) + + ;; Recover properties from the backup stack + (unless flag + (save-excursion + (goto-char from) + (while (< (point) to) + (let ((stack (get-text-property (point) 'org-property-stack-invisible)) + (end (next-single-property-change (point) 'org-property-stack-invisible nil to))) + (if (not stack) + (remove-text-properties (point) end '(org-property-stack-invisible nil)) + (put-text-property (point) end 'invisible (car stack)) + (alter-text-property (point) end 'org-property-stack-invisible + (lambda (stack) + (cdr stack)))) + (goto-char end))))) + + (when flag + (put-text-property from to 'rear-non-sticky nil) + (put-text-property from to 'front-sticky t) + (put-text-property from to 'invisible spec)))))) \f ;;; Regexp matching diff --git a/lisp/org-src.el b/lisp/org-src.el index c9eef744e..e89a1c580 100644 --- a/lisp/org-src.el +++ b/lisp/org-src.el @@ -523,8 +523,8 @@ Leave point in edit buffer." (org-src-switch-to-buffer buffer 'edit) ;; Insert contents. (insert contents) - (remove-text-properties (point-min) (point-max) - '(display nil invisible nil intangible nil)) + (org-remove-text-properties (point-min) (point-max) + '(display nil invisible nil intangible nil)) (unless preserve-ind (org-do-remove-indentation)) (set-buffer-modified-p nil) (setq buffer-file-name nil) diff --git a/lisp/org-table.el b/lisp/org-table.el index 6462b99c4..75801161b 100644 --- a/lisp/org-table.el +++ b/lisp/org-table.el @@ -2001,7 +2001,7 @@ toggle `org-table-follow-field-mode'." (arg (let ((b (save-excursion (skip-chars-backward "^|") (point))) (e (save-excursion (skip-chars-forward "^|\r\n") (point)))) - (remove-text-properties b e '(invisible t intangible t)) + (org-remove-text-properties b e '(invisible t intangible t)) (if (and (boundp 'font-lock-mode) font-lock-mode) (font-lock-fontify-block)))) (t @@ -2028,7 +2028,7 @@ toggle `org-table-follow-field-mode'." (setq word-wrap t) (goto-char (setq p (point-max))) (insert (org-trim field)) - (remove-text-properties p (point-max) '(invisible t intangible t)) + (org-remove-text-properties p (point-max) '(invisible t intangible t)) (goto-char p) (setq-local org-finish-function 'org-table-finish-edit-field) (setq-local org-window-configuration cw) diff --git a/lisp/org.el b/lisp/org.el index e577dc661..360974135 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -114,6 +114,7 @@ Stars are put in group 1 and the trimmed body in group 2.") (declare-function cdlatex-math-symbol "ext:cdlatex") (declare-function Info-goto-node "info" (nodename &optional fork strict-case)) (declare-function isearch-no-upper-case-p "isearch" (string regexp-flag)) +(declare-function isearch-filter-visible "isearch" (beg end)) (declare-function org-add-archive-files "org-archive" (files)) (declare-function org-agenda-entry-get-agenda-timestamp "org-agenda" (pom)) (declare-function org-agenda-list "org-agenda" (&optional arg start-day span with-hour)) @@ -192,6 +193,9 @@ Stars are put in group 1 and the trimmed body in group 2.") (defvar ffap-url-regexp) (defvar org-element-paragraph-separate) +(defvar org-element-all-objects) +(defvar org-element-all-elements) +(defvar org-element-greater-elements) (defvar org-indent-indentation-per-level) (defvar org-radio-target-regexp) (defvar org-target-link-regexp) @@ -4734,9 +4738,381 @@ This is for getting out of special buffers like capture.") ;;;; Define the Org mode +;;; Handling buffer modifications + (defun org-before-change-function (_beg _end) "Every change indicates that a table might need an update." (setq org-table-may-need-update t)) + +(defvar-local org--modified-elements nil + "List of elements, marked as recently modified. +There is no guarantee that the elements in this list are fully parsed. +Only the element type, :begin and :end properties of the elements are +guaranteed to be available. The :begin and :end element properties +contain markers instead of positions.") + +(defvar org-track-element-modification-default-sensitive-commands '(self-insert-command) + "List of commands triggerring element modifications unconditionally.") + +(defvar org--element-beginning-re-alist `((center-block . "^[ \t]*#\\+begin_center[ \t]*$") + (property-drawer . ,org-property-start-re) + (drawer . ,org-drawer-regexp) + (quote-block . "^[ \t]*#\\+begin_quote[ \t]*$") + (special-block . "^[ \t]*#\\+begin_\\([^ ]+\\).*$")) + "Alist of regexps matching beginning of elements. +Group 1 in the regexps (if any) contains the element type.") + +(defvar org--element-end-re-alist `((center-block . "^[ \t]*#\\+end_center[ \t]*$") + (property-drawer . ,org-property-end-re) + (drawer . ,org-property-end-re) + (quote-block . "^[ \t]*#\\+end_quote[ \t]*$") + (special-block . "^[ \t]*#\\+end_\\([^ ]+\\).*$")) + "Alist of regexps matching end of elements. +Group 1 in the regexps (if any) contains the element type or END.") + +(defvar org-track-element-modifications + `((property-drawer . (:after-change-function + org--drawer-or-block-unfold-maybe)) + (drawer . (:after-change-function + org--drawer-or-block-unfold-maybe)) + (center-block . (:after-change-function + org--drawer-or-block-unfold-maybe)) + (quote-block . (:after-change-function + org--drawer-or-block-unfold-maybe)) + (special-block . (:after-change-function + org--drawer-or-block-unfold-maybe))) + "Alist of elements to be tracked for modifications. +The modification is only triggered according to :sensitive-re-list and +:sensitive-command-list (see below). +Each element of the alist is a cons of an element symbol and plist +defining how and when the modifications are handled. +In case of recursive elements/duplicates, the first element from the +list is considered. +The plist can have the following properties: +- :element-beginning-re :: regex matching beginning of the element + (default) :: (alist-get element org--element-beginning-re-alist) +- :element-end-re :: regex matching end of the element + (default) :: (alist-get element org--element-end-re-alist) +- :after-change-function :: function called after the modification +The function must accept a single argument - element from +`org--modified-elements'.") + +(defun org--get-element-region-at-point (types) + "Return TYPES element at point or nil. +If TYPES is a list, return first element at point from the list. The +returned value is partially parsed element only containing :begin and +:end properties. Only elements listed in +org--element-beginning-re-alist and org--element-end-re-alist can be +parsed here." + (catch 'exit + (dolist (type (if (listp types) types (list types))) + (let ((begin-re (alist-get type org--element-beginning-re-alist)) + (end-re (alist-get type org--element-end-re-alist)) + (begin-limit (save-excursion (org-with-limited-levels + (org-back-to-heading-or-point-min 'invisible-ok)) + (point))) + (end-limit (or (save-excursion (outline-next-heading)) + (point-max))) + (point (point)) + begin end closest-begin) + (when (and begin-re end-re) + (save-excursion + (end-of-line) + (when (re-search-backward begin-re begin-limit 'noerror) (setq begin (point))) + (when (re-search-forward end-re end-limit 'noerror) (setq end (point))) + (setq closest-begin begin) + ;; slurp unmatched begin-re + (when (and begin end) + (goto-char begin) + (while (and (re-search-backward begin-re begin-limit 'noerror) + (= end (save-excursion (re-search-forward end-re end-limit 'noerror)))) + (setq begin (point))) + (when (and (>= point begin) (<= point end)) + (throw 'exit + (list type + (list + :begin begin + :end end))))))))))) + +(defun org--get-next-element-region-at-point (types &optional limit previous) + "Return TYPES element after point or nil. +If TYPES is a list, return first element after point from the list. +If PREVIOUS is non-nil, return first TYPES element before point. +Limit search by LIMIT or previous/next heading. +The returned value is partially parsed element only containing :begin +and :end properties. Only elements listed in +org--element-beginning-re-alist and org--element-end-re-alist can be +parsed here." + (catch 'exit + (dolist (type (if (listp types) types (list types))) + (let* ((begin-re (alist-get type org--element-beginning-re-alist)) + (end-re (alist-get type org--element-end-re-alist)) + (limit (or limit (if previous + (save-excursion + (org-with-limited-levels + (org-back-to-heading-or-point-min 'invisible-ok) + (point))) + (or (save-excursion (outline-next-heading)) + (point-max))))) + begin end) + (when (and begin-re end-re) + (save-excursion + (if previous + (when (re-search-backward begin-re limit 'noerror) + (when-let ((el (org--get-element-region-at-point type))) + (setq begin (org-element-property :begin el)) + (setq end (org-element-property :end el)))) + (when (re-search-forward begin-re limit 'noerror) + (when-let ((el (org--get-element-region-at-point type))) + (setq begin (org-element-property :begin el)) + (setq end (org-element-property :end el)))))) + (when (and begin end) + (throw 'exit + (list type + (list + :begin begin + :end end))))))))) + +(defun org--find-elements-in-region (beg end elements &optional include-partial include-neighbours) + "Find all elements from ELEMENTS in region BEG . END. +All the listed elements must be resolvable by +`org--get-element-region-at-point'. +Include elements if they are partially inside region when +INCLUDE-PARTIAL is non-nil. +Include preceding/subsequent neighbouring elements when no partial +element is found at the beginning/end of the region and +INCLUDE-NEIGHBOURS is non-nil." + (when include-partial + (org-with-point-at beg + (let ((new-beg (org-element-property :begin (org--get-element-region-at-point elements)))) + (if new-beg + (setq beg new-beg) + (when (and include-neighbours + (setq new-beg (org-element-property :begin + (org--get-next-element-region-at-point elements + (point-min) + 'previous)))) + (setq beg new-beg)))) + (when (memq 'headline elements) + (when-let ((new-beg (save-excursion + (org-with-limited-levels (outline-previous-heading))))) + (setq beg new-beg)))) + (org-with-point-at end + (let ((new-end (org-element-property :end (org--get-element-region-at-point elements)))) + (if new-end + (setq end new-end) + (when (and include-neighbours + (setq new-end (org-element-property :end + (org--get-next-element-region-at-point elements (point-max))))) + (setq end new-end)))) + (when (memq 'headline elements) + (when-let ((new-end (org-with-limited-levels (outline-next-heading)))) + (setq end (1- new-end)))))) + (save-excursion + (save-restriction + (narrow-to-region beg end) + (goto-char (point-min)) + (let (result el) + (while (setq el (org--get-next-element-region-at-point elements end)) + (push el result) + (goto-char (org-element-property :end el))) + result)))) + +(defun org--drawer-or-block-unfold-maybe (el) + "Update visibility of modified folded drawer/block EL. +If text was added to hidden drawer/block, make sure that the text is +also hidden, unless the change was done by a command listed in +`org-track-element-modification-default-sensitive-commands'. If the +modification destroyed the drawer/block, reveal the hidden text in +former drawer/block. If the modification shrinked/expanded the +drawer/block beyond the hidden text, reveal the affected +drawers/blocks as well. +Examples: +---------------------------------------------- +---------------------------------------------- +Case #1 (the element content is hidden): +---------------------------------------------- +:PROPERTIES: +:ID: 279e797c-f4a7-47bb-80f6-e72ac6f3ec55 +:END: +---------------------------------------------- +is changed to +---------------------------------------------- +:ROPERTIES: +:ID: 279e797c-f4a7-47bb-80f6-e72ac6f3ec55 +:END: +---------------------------------------------- +Text is revealed, because we have drawer in place of property-drawer +---------------------------------------------- +---------------------------------------------- +Case #2 (the element content is hidden): +---------------------------------------------- +:ROPERTIES: +:ID: 279e797c-f4a7-47bb-80f6-e72ac6f3ec55 +:END: +---------------------------------------------- +is changed to +---------------------------------------------- +:OPERTIES: +:ID: 279e797c-f4a7-47bb-80f6-e72ac6f3ec55 +:END: +---------------------------------------------- +The text remains hidden since it is still a drawer. +---------------------------------------------- +---------------------------------------------- +Case #3: (the element content is hidden): +---------------------------------------------- +:FOO: +bar +tmp +:END: +---------------------------------------------- +is changed to +---------------------------------------------- +:FOO: +bar +:END: +tmp +:END: +---------------------------------------------- +The text is revealed because the drawer contents shrank. +---------------------------------------------- +---------------------------------------------- +Case #4: (the element content is hidden in both the drawers): +---------------------------------------------- +:FOO: +bar +tmp +:END: +:BAR: +jjd +:END: +---------------------------------------------- +is changed to +---------------------------------------------- +:FOO: +bar +tmp +:BAR: +jjd +:END: +---------------------------------------------- +The text is revealed in both the drawers because the drawers are merged +into a new drawer. +---------------------------------------------- +---------------------------------------------- +Case #5: (the element content is hidden) +---------------------------------------------- +:test: +Vivamus id enim. +:end: +---------------------------------------------- +is changed to +---------------------------------------------- +:drawer: +:test: +Vivamus id enim. +:end: +---------------------------------------------- +The text is revealed in the drawer because the drawer expended. +---------------------------------------------- +---------------------------------------------- +Case #6: (the element content is hidden): +---------------------------------------------- +:test: +Vivamus id enim. +:end: +---------------------------------------------- +is changed to +---------------------------------------------- +:test: +Vivamus id enim. +:end: +Nam a sapien. +:end: +---------------------------------------------- +The text remains hidden because drawer contents is always before the +first :end:." + (save-match-data + (save-excursion + (save-restriction + (goto-char (org-element-property :begin el)) + (let* ((newel (org--get-element-region-at-point + (mapcar (lambda (el) + (when (string-match-p (regexp-opt '("block" "drawer")) + (symbol-name (car el))) + (car el))) + org-track-element-modifications))) + (spec (if (string-match-p "block" (symbol-name (org-element-type el))) + 'org-hide-block + (if (string-match-p "drawer" (symbol-name (org-element-type el))) + 'org-hide-drawer + t))) + (toggle-func (if (eq spec 'org-hide-drawer) + #'org-hide-drawer-toggle + (if (eq spec 'org-hide-block) + #'org-hide-block-toggle + #'ignore)))) ; this should not happen + (if (and (equal (org-element-type el) (org-element-type newel)) + (equal (marker-position (org-element-property :begin el)) + (org-element-property :begin newel)) + (equal (marker-position (org-element-property :end el)) + (org-element-property :end newel))) + (when (text-property-any (marker-position (org-element-property :begin el)) + (marker-position (org-element-property :end el)) + 'invisible spec) + (goto-char (org-element-property :begin newel)) + (if (memq this-command org-track-element-modification-default-sensitive-commands) + ;; reveal if change was made by typing + (funcall toggle-func 'off) + ;; re-hide the inserted text + ;; FIXME: opening the drawer before hiding should not be needed here + (funcall toggle-func 'off) ; this is needed to avoid showing double ellipsis + (funcall toggle-func 'hide))) + ;; The element was destroyed. Reveal everything. + (org-flag-region (marker-position (org-element-property :begin el)) + (marker-position (org-element-property :end el)) + nil spec) + (when newel + (org-flag-region (org-element-property :begin newel) + (org-element-property :end newel) + nil spec)))))))) + +(defun org--before-element-change-function (beg end) + "Register upcoming element modifications in `org--modified-elements' for all elements interesting with BEG END." + (save-match-data + (save-excursion + (save-restriction + (widen) + (dolist (el (org--find-elements-in-region beg + end + (mapcar #'car org-track-element-modifications) + 'include-partial + 'include-neighbours)) + (let* ((beg-marker (copy-marker (org-element-property :begin el) 't)) + (end-marker (copy-marker (org-element-property :end el) 't))) + (when (and (marker-position beg-marker) (marker-position end-marker)) + (org-element-put-property el :begin beg-marker) + (org-element-put-property el :end end-marker) + (add-to-list 'org--modified-elements el)))))))) + +;; FIXME: this function may be called many times during routine modifications +;; The normal way to avoid this is `combine-after-change-calls' - not +;; the case in most org primitives. +(defun org--after-element-change-function (&rest _) + "Handle changed elements from `org--modified-elements'." + (dolist (el org--modified-elements) + (save-match-data + (save-excursion + (save-restriction + (widen) + (when-let* ((type (org-element-type el)) + (change-func (plist-get (alist-get type org-track-element-modifications) + :after-change-function))) + (with-demoted-errors + (funcall (symbol-function change-func) el))))))) + (setq org--modified-elements nil)) + (defvar org-mode-map) (defvar org-inhibit-startup-visibility-stuff nil) ; Dynamically-scoped param. (defvar org-agenda-keep-modes nil) ; Dynamically-scoped param. @@ -4818,6 +5194,9 @@ The following commands are available: ;; Activate before-change-function (setq-local org-table-may-need-update t) (add-hook 'before-change-functions 'org-before-change-function nil 'local) + (add-hook 'before-change-functions 'org--before-element-change-function nil 'local) + ;; Activate after-change-function + (add-hook 'after-change-functions 'org--after-element-change-function nil 'local) ;; Check for running clock before killing a buffer (add-hook 'kill-buffer-hook 'org-check-running-clock nil 'local) ;; Initialize macros templates. @@ -4869,6 +5248,10 @@ The following commands are available: (setq-local outline-isearch-open-invisible-function (lambda (&rest _) (org-show-context 'isearch))) + ;; Make isearch search in blocks hidden via text properties + (setq-local isearch-filter-predicate #'org--isearch-filter-predicate) + (add-hook 'isearch-mode-end-hook #'org--clear-isearch-overlays nil 'local) + ;; Setup the pcomplete hooks (setq-local pcomplete-command-completion-function #'org-pcomplete-initial) (setq-local pcomplete-command-name-function #'org-command-at-point) @@ -5050,8 +5433,8 @@ stacked delimiters is N. Escaping delimiters is not possible." (when verbatim? (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) - (remove-text-properties (match-beginning 2) (match-end 2) - '(display t invisible t intangible t))) + (org-remove-text-properties (match-beginning 2) (match-end 2) + '(display t invisible t intangible t))) (add-text-properties (match-beginning 2) (match-end 2) '(font-lock-multiline t org-emphasis t)) (when (and org-hide-emphasis-markers @@ -5166,7 +5549,7 @@ This includes angle, plain, and bracket links." (if (not (eq 'bracket style)) (add-text-properties start end properties) ;; Handle invisible parts in bracket links. - (remove-text-properties start end '(invisible nil)) + (org-remove-text-properties start end '(invisible nil)) (let ((hidden (append `(invisible ,(or (org-link-get-parameter type :display) @@ -5186,8 +5569,8 @@ This includes angle, plain, and bracket links." (defun org-activate-code (limit) (when (re-search-forward "^[ \t]*\\(:\\(?: .*\\|$\\)\n?\\)" limit t) (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) - (remove-text-properties (match-beginning 0) (match-end 0) - '(display t invisible t intangible t)) + (org-remove-text-properties (match-beginning 0) (match-end 0) + '(display t invisible t intangible t)) t)) (defcustom org-src-fontify-natively t @@ -5258,8 +5641,8 @@ by a #." (setq block-end (match-beginning 0)) ; includes the final newline. (when quoting (org-remove-flyspell-overlays-in bol-after-beginline nl-before-endline) - (remove-text-properties beg end-of-endline - '(display t invisible t intangible t))) + (org-remove-text-properties beg end-of-endline + '(display t invisible t intangible t))) (add-text-properties beg end-of-endline '(font-lock-fontified t font-lock-multiline t)) (org-remove-flyspell-overlays-in beg bol-after-beginline) @@ -5313,8 +5696,8 @@ by a #." '(font-lock-fontified t face org-document-info)))) ((string-prefix-p "+caption" dc1) (org-remove-flyspell-overlays-in (match-end 2) (match-end 0)) - (remove-text-properties (match-beginning 0) (match-end 0) - '(display t invisible t intangible t)) + (org-remove-text-properties (match-beginning 0) (match-end 0) + '(display t invisible t intangible t)) ;; Handle short captions. (save-excursion (beginning-of-line) @@ -5336,8 +5719,8 @@ by a #." '(font-lock-fontified t face font-lock-comment-face))) (t ;; just any other in-buffer setting, but not indented (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) - (remove-text-properties (match-beginning 0) (match-end 0) - '(display t invisible t intangible t)) + (org-remove-text-properties (match-beginning 0) (match-end 0) + '(display t invisible t intangible t)) (add-text-properties beg (match-end 0) '(font-lock-fontified t face org-meta-line)) t)))))) @@ -5859,10 +6242,11 @@ If TAG is a number, get the corresponding match group." (inhibit-modification-hooks t) deactivate-mark buffer-file-name buffer-file-truename) (decompose-region beg end) - (remove-text-properties beg end - '(mouse-face t keymap t org-linked-text t - invisible t intangible t - org-emphasis t)) + (org-remove-text-properties beg end + '(mouse-face t keymap t org-linked-text t + invisible t + intangible t + org-emphasis t)) (org-remove-font-lock-display-properties beg end))) (defconst org-script-display '(((raise -0.3) (height 0.7)) @@ -5970,6 +6354,29 @@ open and agenda-wise Org files." ;;;; Headlines visibility +(defun org-hide-entry () + "Hide the body directly following this heading." + (interactive) + (save-excursion + (outline-back-to-heading) + (outline-end-of-heading) + (org-flag-region (point) (progn (outline-next-preface) (point)) t 'outline))) + +(defun org-hide-subtree () + "Hide everything after this heading at deeper levels." + (interactive) + (org-flag-subtree t)) + +(defun org-hide-sublevels (levels) + "Hide everything but the top LEVELS levels of headers, in whole buffer. +This also unhides the top heading-less body, if any. + +Interactively, the prefix argument supplies the value of LEVELS. +When invoked without a prefix argument, LEVELS defaults to the level +of the current heading, or to 1 if the current line is not a heading." + (cl-letf (((symbol-function 'outline-flag-region) #'org-flag-region)) + (org-hide-sublevels levels))) + (defun org-show-entry () "Show the body directly following this heading. Show the heading too, if it is currently invisible." @@ -5988,6 +6395,16 @@ Show the heading too, if it is currently invisible." 'outline) (org-cycle-hide-property-drawers 'children)))) +(defun org-show-heading () + "Show the current heading and move to its end." + (org-flag-region (- (point) + (if (bobp) 0 + (if (and outline-blank-line + (eq (char-before (1- (point))) ?\n)) + 2 1))) + (progn (outline-end-of-heading) (point)) + nil)) + (defun org-show-children (&optional level) "Show all direct subheadings of this heading. Prefix arg LEVEL is how many levels below the current level @@ -6031,6 +6448,11 @@ heading to appear." (org-flag-region (point) (save-excursion (org-end-of-subtree t t)) nil 'outline)) +(defun org-show-branches () + "Show all subheadings of this heading, but not their bodies." + (interactive) + (org-show-children 1000)) + ;;;; Blocks and drawers visibility (defun org--hide-wrapper-toggle (element category force no-error) @@ -6064,8 +6486,8 @@ Return a non-nil value when toggling is successful." (unless (let ((eol (line-end-position))) (and (> eol start) (/= eol end))) (let* ((spec (cond ((eq category 'block) 'org-hide-block) - ((eq type 'property-drawer) 'outline) - (t 'org-hide-drawer))) + ((eq category 'drawer) 'org-hide-drawer) + (t 'outline))) (flag (cond ((eq force 'off) nil) (force t) @@ -6158,10 +6580,7 @@ STATE should be one of the symbols listed in the docstring of (when (org-at-property-drawer-p) (let* ((case-fold-search t) (end (re-search-forward org-property-end-re))) - ;; Property drawers use `outline' invisibility spec - ;; so they can be swallowed once we hide the - ;; outline. - (org-flag-region start end t 'outline))))))))))) + (org-flag-region start end t 'org-hide-drawer))))))))))) ;;;; Visibility cycling @@ -6536,7 +6955,7 @@ With a numeric prefix, show all headlines up to that level." (org-narrow-to-subtree) (org-content)))) ((or "all" "showall") - (outline-show-subtree)) + (org-show-subtree)) (_ nil))) (org-end-of-subtree))))))) @@ -6609,7 +7028,7 @@ This function is the default value of the hook `org-cycle-hook'." (while (re-search-forward re nil t) (when (and (not (org-invisible-p)) (org-invisible-p (line-end-position))) - (outline-hide-entry)))) + (org-hide-entry)))) (org-cycle-hide-property-drawers 'all) (org-cycle-show-empty-lines 'overview))))) @@ -6683,8 +7102,13 @@ information." ;; expose it. (dolist (o (overlays-at (point))) (when (memq (overlay-get o 'invisible) - '(org-hide-block org-hide-drawer outline)) + '(outline)) (delete-overlay o))) + (when (memq (get-text-property (point) 'invisible) + '(org-hide-block org-hide-drawer)) + (let ((spec (get-text-property (point) 'invisible)) + (region (org--find-text-property-region (point) 'invisible))) + (org-flag-region (car region) (cdr region) nil spec))) (unless (org-before-first-heading-p) (org-with-limited-levels (cl-case detail @@ -7661,7 +8085,7 @@ When REMOVE is non-nil, remove the subtree from the clipboard." (skip-chars-forward " \t\n\r") (setq beg (point)) (when (and (org-invisible-p) visp) - (save-excursion (outline-show-heading))) + (save-excursion (org-show-heading))) ;; Shift if necessary. (unless (= shift 0) (save-restriction @@ -8103,7 +8527,7 @@ function is being called interactively." (point)) what "children") (goto-char start) - (outline-show-subtree) + (org-show-subtree) (outline-next-heading)) (t ;; we will sort the top-level entries in this file @@ -13150,7 +13574,7 @@ drawer is immediately hidden." (inhibit-read-only t)) (unless (bobp) (insert "\n")) (insert ":PROPERTIES:\n:END:") - (org-flag-region (line-end-position 0) (point) t 'outline) + (org-flag-region (line-end-position 0) (point) t 'org-hide-drawer) (when (or (eobp) (= begin (point-min))) (insert "\n")) (org-indent-region begin (point)))))) @@ -17612,11 +18036,11 @@ Move point to the beginning of first heading or end of buffer." (defun org-show-branches-buffer () "Show all branches in the buffer." (org-flag-above-first-heading) - (outline-hide-sublevels 1) + (org-hide-sublevels 1) (unless (eobp) - (outline-show-branches) + (org-show-branches) (while (outline-get-next-sibling) - (outline-show-branches))) + (org-show-branches))) (goto-char (point-min))) (defun org-kill-note-or-show-branches () @@ -17630,8 +18054,8 @@ Move point to the beginning of first heading or end of buffer." (t (let ((beg (progn (org-back-to-heading) (point))) (end (save-excursion (org-end-of-subtree t t) (point)))) - (outline-hide-subtree) - (outline-show-branches) + (org-hide-subtree) + (org-show-branches) (org-hide-archived-subtrees beg end))))) (defun org-delete-indentation (&optional arg) @@ -17787,9 +18211,9 @@ Otherwise, call `org-show-children'. ARG is the level to hide." (if (org-before-first-heading-p) (progn (org-flag-above-first-heading) - (outline-hide-sublevels (or arg 1)) + (org-hide-sublevels (or arg 1)) (goto-char (point-min))) - (outline-hide-subtree) + (org-hide-subtree) (org-show-children arg)))) (defun org-ctrl-c-star () @@ -20933,6 +21357,80 @@ Started from `gnus-info-find-node'." (t default-org-info-node)))))) \f + +;;; Make isearch search in some text hidden via text propertoes + +(defvar org--isearch-overlays nil + "List of overlays temporarily created during isearch. +This is used to allow searching in regions hidden via text properties. +As for [2020-05-09 Sat], Isearch only has special handling of hidden overlays. +Any text hidden via text properties is not revealed even if `search-invisible' +is set to 't.") + +;; Not sure if it needs to be a user option +;; One might want to reveal hidden text in, for example, hidden parts of the links. +;; Currently, hidden text in links is never revealed by isearch. +(defvar org-isearch-specs '(org-hide-block + org-hide-drawer) + "List of text invisibility specs to be searched by isearch. +By default ([2020-05-09 Sat]), isearch does not search in hidden text, +which was made invisible using text properties. Isearch will be forced +to search in hidden text with any of the listed 'invisible property value.") + +(defun org--create-isearch-overlays (beg end) + "Replace text property invisibility spec by overlays between BEG and END. +All the regions with invisibility text property spec from +`org-isearch-specs' will be changed to use overlays instead +of text properties. The created overlays will be stored in +`org--isearch-overlays'." + (let ((pos beg)) + (while (< pos end) + (when-let* ((spec (get-text-property pos 'invisible)) + (spec (memq spec org-isearch-specs)) + (region (org--find-text-property-region pos 'invisible))) + (setq spec (get-text-property pos 'invisible)) + ;; Changing text properties is considered buffer modification. + ;; We do not want it here. + (with-silent-modifications + ;; The overlay is modelled after `org-flag-region' [2020-05-09 Sat] + ;; overlay for 'outline blocks. + (let ((o (make-overlay (car region) (cdr region) nil 'front-advance))) + (overlay-put o 'evaporate t) + (overlay-put o 'invisible spec) + ;; `delete-overlay' here means that spec information will be lost + ;; for the region. The region will remain visible. + (overlay-put o 'isearch-open-invisible #'delete-overlay) + (push o org--isearch-overlays)) + (org-flag-region (car region) (cdr region) nil spec))) + (setq pos (next-single-property-change pos 'invisible nil end))))) + +(defun org--isearch-filter-predicate (beg end) + "Return non-nil if text between BEG and END is deemed visible by Isearch. +This function is intended to be used as `isearch-filter-predicate'. +Unlike `isearch-filter-visible', make text with 'invisible text property +value listed in `org-isearch-specs' visible to Isearch." + (org--create-isearch-overlays beg end) ;; trick isearch by creating overlays in place of invisible text + (isearch-filter-visible beg end)) + +(defun org--clear-isearch-overlay (ov) + "Convert OV region back into using text properties." + (when-let ((spec (overlay-get ov 'invisible))) ;; ignore deleted overlays + ;; Changing text properties is considered buffer modification. + ;; We do not want it here. + (with-silent-modifications + (org-flag-region (overlay-start ov) (overlay-end ov) t spec))) + (when (member ov isearch-opened-overlays) + (setq isearch-opened-overlays (delete ov isearch-opened-overlays))) + (delete-overlay ov)) + +(defun org--clear-isearch-overlays () + "Convert overlays from `org--isearch-overlays' back into using text properties." + (when org--isearch-overlays + (mapc #'org--clear-isearch-overlay org--isearch-overlays) + (setq org--isearch-overlays nil))) + +\f + ;;; Finish up (add-hook 'org-mode-hook ;remove overlays when changing major mode [-- Attachment #3: Type: text/plain, Size: 17187 bytes --] Ihor Radchenko <yantar92@gmail.com> writes: > Hello, > > [The patch itself will be provided in the following email] > > I have five updates from the previous version of the patch: > > 1. I implemented a simplified version of element parsing to detect > changes in folded drawers or blocks. No computationally expensive calls > of org-element-at-point or org-element-parse-buffer are needed now. > > 2. The patch is now compatible with master (commit 2e96dc639). I > reverted the earlier change in folding drawers and blocks. Now, they are > back to using 'org-hide-block and 'org-hide-drawer. Using 'outline would > achieve nothing when we use text properties. > > 3. 'invisible text property can now be nested. This is important, for > example, when text inside drawers contains fontified links (which also > use 'invisible text property to hide parts of the link). Now, the old > 'invisible spec is recovered after unfolding. > > 4. Some outline-* function calls in org referred to outline-flag-region > implementation, which is not in sync with org-flag-region in this patch. > I have implemented their org-* versions and replaced the calls > throughout .el files. Actually, some org-* versions were already > implemented in org, but not used for some reason (or not mentioned in > the manual). I have updated the relevant sections of manual. These > changes might be relevant to org independently of this feature branch. > > 5. I have managed to get a working version of outline folding via text > properties. However, that approach has a big downside - folding state > cannot be different in indirect buffer when we use text properties. I > have seen packages relying on this feature of org and I do not see any > obvious way to achieve different folding state in indirect buffer while > using text properties for outline folding. > > ----------------------------------------------------------------------- > ----------------------------------------------------------------------- > > More details on the new implementation for tracking changes: > >> Of course we can. It is only necessary to focus on changes that would >> break the structure of the element. This does not entail a full parsing. > > I have limited parsing to matching beginning and end of a drawer/block. > The basic functions are org--get-element-region-at-point, > org--get-next-element-region-at-point, and org--find-elements-in-region. > They are simplified versions of org-element-* parsers and do not require > parsing everything from the beginning of the section. > > For now, I keep everything in org.el, but those simplified parsers > probably belong to org-element.el. > >> If we can stick with `after-change-functions' (or local equivalent), >> that's better. It is more predictable than `before-change-functions' and >> alike. > > For now, I still used before/after-change-functions combination. > I see the following problems with using only after-change-functions: > > 1. They are not guaranteed to be called after every single change: > > From (elisp) Change Hooks: > "... some complex primitives call ‘before-change-functions’ once before > making changes, and then call ‘after-change-functions’ zero or more > times" > > The consequence of it is a possibility that region passed to the > after-change-functions is quite big (including all the singular changes, > even if they are distant). This region may contain changed drawers as > well and unchanged drawers and needs to be parsed to determine which > drawers need to be re-folded. > >> And, more importantly, they are not meant to be used together, i.e., you >> cannot assume that a single call to `before-change-functions' always >> happens before calling `after-change-functions'. This can be tricky if >> you want to use the former to pass information to the latter. > > The fact that before-change-functions can be called multiple times > before after-change-functions, is trivially solved by using buffer-local > changes register (see org--modified-elements). The register is populated > by before-change-functions and cleared by after-change-functions. > >> Well, `before-change-fuctions' and `after-change-functions' are not >> clean at all: you modify an unrelated part of the buffer, but still call >> those to check if a drawer needs to be unfolded somewhere. > > 2. As you pointed, instead of global before-change-functions, we can use > modification-hooks text property on sensitive parts of the > drawers/blocks. This would work, but I am concerned about one annoying > special case: > > ------------------------------------------------------------------------- > :BLAH: <inserted outside any of the existing drawers> > > <some text> > > :DRAWER: <folded> > Donec at pede. > :END: > ------------------------------------------------------------------------- > In this example, the user would not be able to unfold the folder DRAWER > because it will technically become a part of a new giant BLAH drawer. > This may be especially annoying if <some text> is more than one screen > long and there is no easy way to identify why unfolding does not work > (with point at :DRAWER:). > > Because of this scenario, limiting before-change-functions to folded > drawers is not sufficient. Any change in text may need to trigger > unfolding. > > In the patch, I always register possible modifications in the > blocks/drawers intersecting with the modified region + a drawer/block > right next to the region. > > ----------------------------------------------------------------------- > ----------------------------------------------------------------------- > > More details on the nested 'invisible text property implementation. > > The idea is to keep 'invisible property stack push and popping from it > as we add/remove 'invisible text property. All the work is done in > org-flag-region. > > This was originally intended for folding outlines via text properties. > Since using text properties for folding outlines is not a good idea, > nested text properties have much less use. As I mentioned, they do > preserve link fontification, but I am not sure if it worth it for the > overhead to org-flag-region. Keeping this here mostly in the case if > someone has any ideas how it can be useful. > > ----------------------------------------------------------------------- > ----------------------------------------------------------------------- > > More details on replaced outline-* -> org-* function calls. > > I have implemented org-* versions of the following functions: > > - outline-hide-entry > - outline-hide-subtree > - outline-hide-sublevels > - outline-show-heading > - outline-show-branches > > The org-* versions trivially use org-flag-region instead of > outline-flag-region. > > Replaced outline-* calls where org- versions were already available: > > - outline-show-entry > - outline-show-all > - outline-show-subtree > > I reflected the new (including already available) functions in the > manual and removed some defalias from org-compat.el where they are not > needed. > > ----------------------------------------------------------------------- > ----------------------------------------------------------------------- > > Further work: > > 1. after-change-functions use org-hide-drawer/block-toggle to > fold/unfold after modification. However, I just found that they call > org-element-at-point, which slows down modifications in folded > drawers/blocks. For example, realigning a long table inside folded > drawer takes >1sec, while it is instant in the unfolded drawer. > > 2. org-toggle-custom-properties is terribly slow on large org documents, > similarly to folded drawers on master. It should be relatively easy to > use text properties there instead of overlays. > > 3. Multiple calls to before/after-change-functions is still a problem. I > am looking into following ways to reduce this number: > - reduce the number of elements registered as potentially modified > + do not add duplicates to org--modified-elements > + do not add unfolded elements to org--modified-elements > + register after-change-function as post-command hook and remove it > from global after-change-functions. This way, it will be called > twice per command only. > - determine common region containing org--modified-elements. if change > is happening within that region, there is no need to parse > drawers/blocks there again. > > P.S. > >>> It was mostly an annoyance, because they returned different results on >>> the same element. Specifically, they returned different :post-blank and >>> :end properties, which does not sound right. >> >> OK. If you have a reproducible recipe, I can look into it and see what >> can be done. > > Recipe to have different (org-element-at-point) and > (org-element-parse-buffer 'element) > ------------------------------------------------------------------------- > <point-min> > :PROPERTIES: > :CREATED: [2020-05-23 Sat 02:32] > :END: > > > <point-max> > ------------------------------------------------------------------------- > > > Best, > Ihor > > Nicolas Goaziou <mail@nicolasgoaziou.fr> writes: > >> Hello, >> >> Ihor Radchenko <yantar92@gmail.com> writes: >> >>>> As you noticed, using Org Element is a no-go, unfortunately. Parsing an >>>> element is a O(N) operation by the number of elements before it in >>>> a section. In particular, it is not bounded, and not mitigated by >>>> a cache. For large documents, it is going to be unbearably slow, too. >>> >>> Ouch. I thought it is faster. >>> What do you mean by "not mitigated by a cache"? >> >> Parsing starts from the closest headline, every time. So, if Org parses >> the Nth element in the entry two times, it really parses 2N elements. >> >> With a cache, assuming the buffer wasn't modified, Org would parse >> N elements only. With a smarter cache, with fine grained cache >> invalidation, it could also reduce the number of subsequent parsed >> elements. >> >>> The reason I would like to utilise org-element parser to make tracking >>> modifications more robust. Using details of the syntax would make the >>> code fragile if any modifications are made to syntax in future. >> >> I don't think the code would be more fragile. Also, the syntax we're >> talking about is not going to be modified anytime soon. Moreover, if >> folding breaks, it is usually visible, so the bug will not be unnoticed. >> >> This code is going to be as low-level as it can be. >> >>> Debugging bugs in modification functions is not easy, according to my >>> experience. >> >> No, it's not. >> >> But this is not really related to whether you use Element or not. >> >>> One possible way to avoid performance issues during modification is >>> running parser in advance. For example, folding an element may >>> as well add information about the element to its text properties. >>> This will not degrade performance of folding since we are already >>> parsing the element during folding (at least, in >>> org-hide-drawer-toggle). >> >> We can use this information stored at fold time. But I'm not even sure >> we need it. >> >>> The problem with parsing an element during folding is that we cannot >>> easily detect changes like below without re-parsing. >> >> Of course we can. It is only necessary to focus on changes that would >> break the structure of the element. This does not entail a full parsing. >> >>> :PROPERTIES: <folded> >>> :CREATED: [2020-05-18 Mon] >>> :END: <- added line >>> :ID: test >>> :END: >>> >>> or even >>> >>> :PROPERTIES: >>> :CREATED: [2020-05-18 Mon] >>> :ID: test >>> :END: <- delete this line >>> >>> :DRAWER: <folded, cannot be unfolded if we don't re-parse after deletion> >>> test >>> :END: >> >> Please have a look at the "sensitive parts" I wrote about. This takes >> care of this kind of breakage. >> >>> The re-parsing can be done via regexp, as you suggested, but I don't >>> like this idea, because it will end up re-implementing >>> org-element-*-parser. >> >> You may have misunderstood my suggestion. See below. >> >>> Would it be acceptable to run org-element-*-parser >>> in after-change-functions? >> >> I'd rather not do that. This is unnecessary consing, and matching, etc. >> >>> If I understand correctly, it is not as easy. >>> Consider the following example: >>> >>> :PROPERTIES: >>> :CREATED: [2020-05-18 Mon] >>> <region-beginning> >>> :ID: example >>> :END: >>> >>> <... a lot of text, maybe containing other drawers ...> >>> >>> Nullam rutrum. >>> Pellentesque dapibus suscipit ligula. >>> <region-end> >>> Proin quam nisl, tincidunt et, mattis eget, convallis nec, purus. >>> >>> If the region gets deleted, the modification hooks from chars inside >>> drawer will be called as (hook-function <region-beginning> >>> <region-end>). So, there is still a need to find the drawer somehow to >>> mark it as about to be modified (modification hooks are ran before >>> actual modification). >> >> If we can stick with `after-change-functions' (or local equivalent), >> that's better. It is more predictable than `before-change-functions' and >> alike. >> >> If it is a deletion, here is the kind of checks we could do, depending >> on when they are performed. >> >> Before actual changes : >> >> 1. The deletion is happening within a folded drawer (unnecessary step >> in local functions). >> 2. The change deleted the sensitive line ":END:". >> 3. Conclusion : unfold. >> >> Or, after actual changes : >> >> 1. The deletion involves a drawer. >> 2. Text properties indicate that the beginning of the propertized part >> of the buffer start with org-drawer-regexp, but doesn't end with >> `org-property-end-re'. A "sensitive part" disappeared! >> 3. Conclusion : unfold >> >> This is far away from parsing. IMO, a few checks cover all cases. Let me >> know if you have questions about it. >> >> Also, note that the kind of change you describe will happen perhaps >> 0.01% of the time. Most change are about one character, or a single >> line, long. >> >>> The only difference between using modification hooks and >>> before-change-functions is that modification hooks will trigger less >>> frequently. >> >> Exactly. Much less frequently. But extra care is required, as you noted >> already. >> >>> Considering the performance of org-element-at-point, it is >>> probably worth doing. Initially, I wanted to avoid it because setting a >>> single before-change-functions hook sounded cleaner than setting >>> modification-hooks, insert-behind-hooks, and insert-in-front-hooks. >> >> Well, `before-change-fuctions' and `after-change-functions' are not >> clean at all: you modify an unrelated part of the buffer, but still call >> those to check if a drawer needs to be unfolded somewhere. >> >> And, more importantly, they are not meant to be used together, i.e., you >> cannot assume that a single call to `before-change-functions' always >> happens before calling `after-change-functions'. This can be tricky if >> you want to use the former to pass information to the latter. >> >> But I understand that they are easier to use than their local >> counterparts. If you stick with (before|after)-change-functions, the >> function being called needs to drop the ball very quickly if the >> modification is not about folding changes. Also, I very much suggest to >> stick to only `after-change-functions', if feasible (I think it is), per >> above. >> >>> Moreover, these text properties would be copied by default if one uses >>> buffer-substring. Then, the hooks will also trigger later in the yanked >>> text, which may cause all kinds of bugs. >> >> Indeed, that would be something to handle specifically. I.e., >> destructive modifications (i.e., those that unfold) could clear such >> properties. >> >> It is more work. I don't know if it is worth the trouble if we can get >> out quickly of `after-change-functions' for unrelated changes. >> >>> It was mostly an annoyance, because they returned different results on >>> the same element. Specifically, they returned different :post-blank and >>> :end properties, which does not sound right. >> >> OK. If you have a reproducible recipe, I can look into it and see what >> can be done. >> >> Regards, >> >> -- >> Nicolas Goaziou > > -- > Ihor Radchenko, > PhD, > Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) > State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China > Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply related [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-05-23 13:53 ` Ihor Radchenko @ 2020-05-23 15:26 ` Ihor Radchenko 0 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2020-05-23 15:26 UTC (permalink / raw) To: Nicolas Goaziou; +Cc: emacs-orgmode Github link to the patch: https://gist.github.com/yantar92/6447754415457927293acda43a7fcaef Ihor Radchenko <yantar92@gmail.com> writes: > The patch is attached > > diff --git a/contrib/lisp/org-notify.el b/contrib/lisp/org-notify.el > index 9f8677871..ab470ea9b 100644 > --- a/contrib/lisp/org-notify.el > +++ b/contrib/lisp/org-notify.el > @@ -246,7 +246,7 @@ seconds. The default value for SECS is 20." > (switch-to-buffer (find-file-noselect file)) > (org-with-wide-buffer > (goto-char begin) > - (outline-show-entry)) > + (org-show-entry)) > (goto-char begin) > (search-forward "DEADLINE: <") > (search-forward ":") > diff --git a/contrib/lisp/org-velocity.el b/contrib/lisp/org-velocity.el > index bfc4d6c3e..2312b235c 100644 > --- a/contrib/lisp/org-velocity.el > +++ b/contrib/lisp/org-velocity.el > @@ -325,7 +325,7 @@ use it." > (save-excursion > (when narrow > (org-narrow-to-subtree)) > - (outline-show-all))) > + (org-show-all))) > > (defun org-velocity-edit-entry/inline (heading) > "Edit entry at HEADING in the original buffer." > diff --git a/doc/org-manual.org b/doc/org-manual.org > index 96b160175..2ebe94538 100644 > --- a/doc/org-manual.org > +++ b/doc/org-manual.org > @@ -509,11 +509,11 @@ Org uses just two commands, bound to {{{kbd(TAB)}}} and > Switch back to the startup visibility of the buffer (see [[*Initial > visibility]]). > > -- {{{kbd(C-u C-u C-u TAB)}}} (~outline-show-all~) :: > +- {{{kbd(C-u C-u C-u TAB)}}} (~org-show-all~) :: > > #+cindex: show all, command > #+kindex: C-u C-u C-u TAB > - #+findex: outline-show-all > + #+findex: org-show-all > Show all, including drawers. > > - {{{kbd(C-c C-r)}}} (~org-reveal~) :: > @@ -529,18 +529,18 @@ Org uses just two commands, bound to {{{kbd(TAB)}}} and > headings. With a double prefix argument, also show the entire > subtree of the parent. > > -- {{{kbd(C-c C-k)}}} (~outline-show-branches~) :: > +- {{{kbd(C-c C-k)}}} (~org-show-branches~) :: > > #+cindex: show branches, command > #+kindex: C-c C-k > - #+findex: outline-show-branches > + #+findex: org-show-branches > Expose all the headings of the subtree, but not their bodies. > > -- {{{kbd(C-c TAB)}}} (~outline-show-children~) :: > +- {{{kbd(C-c TAB)}}} (~org-show-children~) :: > > #+cindex: show children, command > #+kindex: C-c TAB > - #+findex: outline-show-children > + #+findex: org-show-children > Expose all direct children of the subtree. With a numeric prefix > argument {{{var(N)}}}, expose all children down to level > {{{var(N)}}}. > @@ -7294,7 +7294,7 @@ its location in the outline tree, but behaves in the following way: > command (see [[*Visibility Cycling]]). You can force cycling archived > subtrees with {{{kbd(C-TAB)}}}, or by setting the option > ~org-cycle-open-archived-trees~. Also normal outline commands, like > - ~outline-show-all~, open archived subtrees. > + ~org-show-all~, open archived subtrees. > > - > #+vindex: org-sparse-tree-open-archived-trees > diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el > index ab13f926c..ad9244940 100644 > --- a/lisp/org-agenda.el > +++ b/lisp/org-agenda.el > @@ -6826,7 +6826,7 @@ and stored in the variable `org-prefix-format-compiled'." > (t " %-12:c%?-12t% s"))) > (start 0) > varform vars var e c f opt) > - (while (string-match "%\\(\\?\\)?\\([-+]?[0-9.]*\\)\\([ .;,:!?=|/<>]?\\)\\([cltseib]\\|(.+)\\)" > + (while (string-match "%\\(\\?\\)?\\([-+]?[0-9.]*\\)\\([ .;,:!?=|/<>]?\\)\\([cltseib]\\|(.+?)\\)" > s start) > (setq var (or (cdr (assoc (match-string 4 s) > '(("c" . category) ("t" . time) ("l" . level) ("s" . extra) > @@ -9138,20 +9138,20 @@ if it was hidden in the outline." > ((and (called-interactively-p 'any) (= more 1)) > (message "Remote: show with default settings")) > ((= more 2) > - (outline-show-entry) > + (org-show-entry) > (org-show-children) > (save-excursion > (org-back-to-heading) > (run-hook-with-args 'org-cycle-hook 'children)) > (message "Remote: CHILDREN")) > ((= more 3) > - (outline-show-subtree) > + (org-show-subtree) > (save-excursion > (org-back-to-heading) > (run-hook-with-args 'org-cycle-hook 'subtree)) > (message "Remote: SUBTREE")) > ((> more 3) > - (outline-show-subtree) > + (org-show-subtree) > (message "Remote: SUBTREE AND ALL DRAWERS"))) > (select-window win))) > > diff --git a/lisp/org-archive.el b/lisp/org-archive.el > index d3e12d17b..d864dad8a 100644 > --- a/lisp/org-archive.el > +++ b/lisp/org-archive.el > @@ -330,7 +330,7 @@ direct children of this heading." > (insert (if datetree-date "" "\n") heading "\n") > (end-of-line 0)) > ;; Make the subtree visible > - (outline-show-subtree) > + (org-show-subtree) > (if org-archive-reversed-order > (progn > (org-back-to-heading t) > diff --git a/lisp/org-colview.el b/lisp/org-colview.el > index e50a4d7c8..e656df555 100644 > --- a/lisp/org-colview.el > +++ b/lisp/org-colview.el > @@ -699,7 +699,7 @@ FUN is a function called with no argument." > (move-beginning-of-line 2) > (org-at-heading-p t))))) > (unwind-protect (funcall fun) > - (when hide-body (outline-hide-entry))))) > + (when hide-body (org-hide-entry))))) > > (defun org-columns-previous-allowed-value () > "Switch to the previous allowed value for this column." > diff --git a/lisp/org-compat.el b/lisp/org-compat.el > index 635a38dcd..8fe271896 100644 > --- a/lisp/org-compat.el > +++ b/lisp/org-compat.el > @@ -139,12 +139,8 @@ This is a floating point number if the size is too large for an integer." > ;;; Emacs < 25.1 compatibility > > (when (< emacs-major-version 25) > - (defalias 'outline-hide-entry 'hide-entry) > - (defalias 'outline-hide-sublevels 'hide-sublevels) > - (defalias 'outline-hide-subtree 'hide-subtree) > (defalias 'outline-show-branches 'show-branches) > (defalias 'outline-show-children 'show-children) > - (defalias 'outline-show-entry 'show-entry) > (defalias 'outline-show-subtree 'show-subtree) > (defalias 'xref-find-definitions 'find-tag) > (defalias 'format-message 'format) > diff --git a/lisp/org-element.el b/lisp/org-element.el > index ac41b7650..2d5c8d771 100644 > --- a/lisp/org-element.el > +++ b/lisp/org-element.el > @@ -4320,7 +4320,7 @@ element or object. Meaningful values are `first-section', > TYPE is the type of the current element or object. > > If PARENT? is non-nil, assume the next element or object will be > -located inside the current one. " > +located inside the current one." > (if parent? > (pcase type > (`headline 'section) > diff --git a/lisp/org-keys.el b/lisp/org-keys.el > index c006e9c12..deb5d7b90 100644 > --- a/lisp/org-keys.el > +++ b/lisp/org-keys.el > @@ -437,7 +437,7 @@ COMMANDS is a list of alternating OLDDEF NEWDEF command names." > #'org-next-visible-heading) > (define-key org-mode-map [remap outline-previous-visible-heading] > #'org-previous-visible-heading) > -(define-key org-mode-map [remap show-children] #'org-show-children) > +(define-key org-mode-map [remap outline-show-children] #'org-show-children) > > ;;;; Make `C-c C-x' a prefix key > (org-defkey org-mode-map (kbd "C-c C-x") (make-sparse-keymap)) > diff --git a/lisp/org-macs.el b/lisp/org-macs.el > index a02f713ca..fa0a658f0 100644 > --- a/lisp/org-macs.el > +++ b/lisp/org-macs.el > @@ -682,7 +682,7 @@ When NEXT is non-nil, check the next line instead." > > > \f > -;;; Overlays > +;;; Overlays and text properties > > (defun org-overlay-display (ovl text &optional face evap) > "Make overlay OVL display TEXT with face FACE." > @@ -705,18 +705,99 @@ If DELETE is non-nil, delete all those overlays." > (delete (delete-overlay ov)) > (t (push ov found)))))) > > +(defun org-remove-text-properties (start end properties &optional object) > + "Remove text properties as in `remove-text-properties', but keep 'invisibility specs for folded regions. > +Do not remove invisible text properties specified by 'outline, > +'org-hide-block, and 'org-hide-drawer (but remove i.e. 'org-link) this > +is needed to keep outlines, drawers, and blocks hidden unless they are > +toggled by user. > +Note: The below may be too specific and create troubles if more > +invisibility specs are added to org in future" > + (when (plist-member properties 'invisible) > + (let ((pos start) > + next spec) > + (while (< pos end) > + (setq next (next-single-property-change pos 'invisible nil end) > + spec (get-text-property pos 'invisible)) > + (unless (memq spec (list 'org-hide-block > + 'org-hide-drawer > + 'outline)) > + (remove-text-properties pos next '(invisible nil) object)) > + (setq pos next)))) > + (when-let ((properties-stripped (org-plist-delete properties 'invisible))) > + (remove-text-properties start end properties-stripped object))) > + > +(defun org--find-text-property-region (pos prop) > + "Find a region containing PROP text property around point POS." > + (let* ((beg (and (get-text-property pos prop) pos)) > + (end beg)) > + (when beg > + ;; when beg is the first point in the region, `previous-single-property-change' > + ;; will return nil. > + (setq beg (or (previous-single-property-change pos prop) > + beg)) > + ;; when end is the last point in the region, `next-single-property-change' > + ;; will return nil. > + (setq end (or (next-single-property-change pos prop) > + end)) > + (unless (= beg end) ; this should not happen > + (cons beg end))))) > + > (defun org-flag-region (from to flag spec) > "Hide or show lines from FROM to TO, according to FLAG. > SPEC is the invisibility spec, as a symbol." > - (remove-overlays from to 'invisible spec) > - ;; Use `front-advance' since text right before to the beginning of > - ;; the overlay belongs to the visible line than to the contents. > - (when flag > - (let ((o (make-overlay from to nil 'front-advance))) > - (overlay-put o 'evaporate t) > - (overlay-put o 'invisible spec) > - (overlay-put o 'isearch-open-invisible #'delete-overlay)))) > - > + (pcase spec > + ('outline > + (remove-overlays from to 'invisible spec) > + ;; Use `front-advance' since text right before to the beginning of > + ;; the overlay belongs to the visible line than to the contents. > + (when flag > + (let ((o (make-overlay from to nil 'front-advance))) > + (overlay-put o 'evaporate t) > + (overlay-put o 'invisible spec) > + (overlay-put o 'isearch-open-invisible #'delete-overlay)))) > + (_ > + ;; Use text properties instead of overlays for speed. > + ;; Overlays are too slow (Emacs Bug#35453). > + (with-silent-modifications > + ;; keep a backup stack of old text properties > + (save-excursion > + (goto-char from) > + (while (< (point) to) > + (let ((old-spec (get-text-property (point) 'invisible)) > + (end (next-single-property-change (point) 'invisible nil to))) > + (when old-spec > + (alter-text-property (point) end 'org-property-stack-invisible > + (lambda (stack) > + (if (or (eq old-spec (car stack)) > + (eq spec old-spec) > + (eq old-spec 'outline)) > + stack > + (cons old-spec stack))))) > + (goto-char end)))) > + > + ;; cleanup everything > + (remove-text-properties from to '(invisible nil)) > + > + ;; Recover properties from the backup stack > + (unless flag > + (save-excursion > + (goto-char from) > + (while (< (point) to) > + (let ((stack (get-text-property (point) 'org-property-stack-invisible)) > + (end (next-single-property-change (point) 'org-property-stack-invisible nil to))) > + (if (not stack) > + (remove-text-properties (point) end '(org-property-stack-invisible nil)) > + (put-text-property (point) end 'invisible (car stack)) > + (alter-text-property (point) end 'org-property-stack-invisible > + (lambda (stack) > + (cdr stack)))) > + (goto-char end))))) > + > + (when flag > + (put-text-property from to 'rear-non-sticky nil) > + (put-text-property from to 'front-sticky t) > + (put-text-property from to 'invisible spec)))))) > > \f > ;;; Regexp matching > diff --git a/lisp/org-src.el b/lisp/org-src.el > index c9eef744e..e89a1c580 100644 > --- a/lisp/org-src.el > +++ b/lisp/org-src.el > @@ -523,8 +523,8 @@ Leave point in edit buffer." > (org-src-switch-to-buffer buffer 'edit) > ;; Insert contents. > (insert contents) > - (remove-text-properties (point-min) (point-max) > - '(display nil invisible nil intangible nil)) > + (org-remove-text-properties (point-min) (point-max) > + '(display nil invisible nil intangible nil)) > (unless preserve-ind (org-do-remove-indentation)) > (set-buffer-modified-p nil) > (setq buffer-file-name nil) > diff --git a/lisp/org-table.el b/lisp/org-table.el > index 6462b99c4..75801161b 100644 > --- a/lisp/org-table.el > +++ b/lisp/org-table.el > @@ -2001,7 +2001,7 @@ toggle `org-table-follow-field-mode'." > (arg > (let ((b (save-excursion (skip-chars-backward "^|") (point))) > (e (save-excursion (skip-chars-forward "^|\r\n") (point)))) > - (remove-text-properties b e '(invisible t intangible t)) > + (org-remove-text-properties b e '(invisible t intangible t)) > (if (and (boundp 'font-lock-mode) font-lock-mode) > (font-lock-fontify-block)))) > (t > @@ -2028,7 +2028,7 @@ toggle `org-table-follow-field-mode'." > (setq word-wrap t) > (goto-char (setq p (point-max))) > (insert (org-trim field)) > - (remove-text-properties p (point-max) '(invisible t intangible t)) > + (org-remove-text-properties p (point-max) '(invisible t intangible t)) > (goto-char p) > (setq-local org-finish-function 'org-table-finish-edit-field) > (setq-local org-window-configuration cw) > diff --git a/lisp/org.el b/lisp/org.el > index e577dc661..360974135 100644 > --- a/lisp/org.el > +++ b/lisp/org.el > @@ -114,6 +114,7 @@ Stars are put in group 1 and the trimmed body in group 2.") > (declare-function cdlatex-math-symbol "ext:cdlatex") > (declare-function Info-goto-node "info" (nodename &optional fork strict-case)) > (declare-function isearch-no-upper-case-p "isearch" (string regexp-flag)) > +(declare-function isearch-filter-visible "isearch" (beg end)) > (declare-function org-add-archive-files "org-archive" (files)) > (declare-function org-agenda-entry-get-agenda-timestamp "org-agenda" (pom)) > (declare-function org-agenda-list "org-agenda" (&optional arg start-day span with-hour)) > @@ -192,6 +193,9 @@ Stars are put in group 1 and the trimmed body in group 2.") > > (defvar ffap-url-regexp) > (defvar org-element-paragraph-separate) > +(defvar org-element-all-objects) > +(defvar org-element-all-elements) > +(defvar org-element-greater-elements) > (defvar org-indent-indentation-per-level) > (defvar org-radio-target-regexp) > (defvar org-target-link-regexp) > @@ -4734,9 +4738,381 @@ This is for getting out of special buffers like capture.") > > ;;;; Define the Org mode > > +;;; Handling buffer modifications > + > (defun org-before-change-function (_beg _end) > "Every change indicates that a table might need an update." > (setq org-table-may-need-update t)) > + > +(defvar-local org--modified-elements nil > + "List of elements, marked as recently modified. > +There is no guarantee that the elements in this list are fully parsed. > +Only the element type, :begin and :end properties of the elements are > +guaranteed to be available. The :begin and :end element properties > +contain markers instead of positions.") > + > +(defvar org-track-element-modification-default-sensitive-commands '(self-insert-command) > + "List of commands triggerring element modifications unconditionally.") > + > +(defvar org--element-beginning-re-alist `((center-block . "^[ \t]*#\\+begin_center[ \t]*$") > + (property-drawer . ,org-property-start-re) > + (drawer . ,org-drawer-regexp) > + (quote-block . "^[ \t]*#\\+begin_quote[ \t]*$") > + (special-block . "^[ \t]*#\\+begin_\\([^ ]+\\).*$")) > + "Alist of regexps matching beginning of elements. > +Group 1 in the regexps (if any) contains the element type.") > + > +(defvar org--element-end-re-alist `((center-block . "^[ \t]*#\\+end_center[ \t]*$") > + (property-drawer . ,org-property-end-re) > + (drawer . ,org-property-end-re) > + (quote-block . "^[ \t]*#\\+end_quote[ \t]*$") > + (special-block . "^[ \t]*#\\+end_\\([^ ]+\\).*$")) > + "Alist of regexps matching end of elements. > +Group 1 in the regexps (if any) contains the element type or END.") > + > +(defvar org-track-element-modifications > + `((property-drawer . (:after-change-function > + org--drawer-or-block-unfold-maybe)) > + (drawer . (:after-change-function > + org--drawer-or-block-unfold-maybe)) > + (center-block . (:after-change-function > + org--drawer-or-block-unfold-maybe)) > + (quote-block . (:after-change-function > + org--drawer-or-block-unfold-maybe)) > + (special-block . (:after-change-function > + org--drawer-or-block-unfold-maybe))) > + "Alist of elements to be tracked for modifications. > +The modification is only triggered according to :sensitive-re-list and > +:sensitive-command-list (see below). > +Each element of the alist is a cons of an element symbol and plist > +defining how and when the modifications are handled. > +In case of recursive elements/duplicates, the first element from the > +list is considered. > +The plist can have the following properties: > +- :element-beginning-re :: regex matching beginning of the element > + (default) :: (alist-get element org--element-beginning-re-alist) > +- :element-end-re :: regex matching end of the element > + (default) :: (alist-get element org--element-end-re-alist) > +- :after-change-function :: function called after the modification > +The function must accept a single argument - element from > +`org--modified-elements'.") > + > +(defun org--get-element-region-at-point (types) > + "Return TYPES element at point or nil. > +If TYPES is a list, return first element at point from the list. The > +returned value is partially parsed element only containing :begin and > +:end properties. Only elements listed in > +org--element-beginning-re-alist and org--element-end-re-alist can be > +parsed here." > + (catch 'exit > + (dolist (type (if (listp types) types (list types))) > + (let ((begin-re (alist-get type org--element-beginning-re-alist)) > + (end-re (alist-get type org--element-end-re-alist)) > + (begin-limit (save-excursion (org-with-limited-levels > + (org-back-to-heading-or-point-min 'invisible-ok)) > + (point))) > + (end-limit (or (save-excursion (outline-next-heading)) > + (point-max))) > + (point (point)) > + begin end closest-begin) > + (when (and begin-re end-re) > + (save-excursion > + (end-of-line) > + (when (re-search-backward begin-re begin-limit 'noerror) (setq begin (point))) > + (when (re-search-forward end-re end-limit 'noerror) (setq end (point))) > + (setq closest-begin begin) > + ;; slurp unmatched begin-re > + (when (and begin end) > + (goto-char begin) > + (while (and (re-search-backward begin-re begin-limit 'noerror) > + (= end (save-excursion (re-search-forward end-re end-limit 'noerror)))) > + (setq begin (point))) > + (when (and (>= point begin) (<= point end)) > + (throw 'exit > + (list type > + (list > + :begin begin > + :end end))))))))))) > + > +(defun org--get-next-element-region-at-point (types &optional limit previous) > + "Return TYPES element after point or nil. > +If TYPES is a list, return first element after point from the list. > +If PREVIOUS is non-nil, return first TYPES element before point. > +Limit search by LIMIT or previous/next heading. > +The returned value is partially parsed element only containing :begin > +and :end properties. Only elements listed in > +org--element-beginning-re-alist and org--element-end-re-alist can be > +parsed here." > + (catch 'exit > + (dolist (type (if (listp types) types (list types))) > + (let* ((begin-re (alist-get type org--element-beginning-re-alist)) > + (end-re (alist-get type org--element-end-re-alist)) > + (limit (or limit (if previous > + (save-excursion > + (org-with-limited-levels > + (org-back-to-heading-or-point-min 'invisible-ok) > + (point))) > + (or (save-excursion (outline-next-heading)) > + (point-max))))) > + begin end) > + (when (and begin-re end-re) > + (save-excursion > + (if previous > + (when (re-search-backward begin-re limit 'noerror) > + (when-let ((el (org--get-element-region-at-point type))) > + (setq begin (org-element-property :begin el)) > + (setq end (org-element-property :end el)))) > + (when (re-search-forward begin-re limit 'noerror) > + (when-let ((el (org--get-element-region-at-point type))) > + (setq begin (org-element-property :begin el)) > + (setq end (org-element-property :end el)))))) > + (when (and begin end) > + (throw 'exit > + (list type > + (list > + :begin begin > + :end end))))))))) > + > +(defun org--find-elements-in-region (beg end elements &optional include-partial include-neighbours) > + "Find all elements from ELEMENTS in region BEG . END. > +All the listed elements must be resolvable by > +`org--get-element-region-at-point'. > +Include elements if they are partially inside region when > +INCLUDE-PARTIAL is non-nil. > +Include preceding/subsequent neighbouring elements when no partial > +element is found at the beginning/end of the region and > +INCLUDE-NEIGHBOURS is non-nil." > + (when include-partial > + (org-with-point-at beg > + (let ((new-beg (org-element-property :begin (org--get-element-region-at-point elements)))) > + (if new-beg > + (setq beg new-beg) > + (when (and include-neighbours > + (setq new-beg (org-element-property :begin > + (org--get-next-element-region-at-point elements > + (point-min) > + 'previous)))) > + (setq beg new-beg)))) > + (when (memq 'headline elements) > + (when-let ((new-beg (save-excursion > + (org-with-limited-levels (outline-previous-heading))))) > + (setq beg new-beg)))) > + (org-with-point-at end > + (let ((new-end (org-element-property :end (org--get-element-region-at-point elements)))) > + (if new-end > + (setq end new-end) > + (when (and include-neighbours > + (setq new-end (org-element-property :end > + (org--get-next-element-region-at-point elements (point-max))))) > + (setq end new-end)))) > + (when (memq 'headline elements) > + (when-let ((new-end (org-with-limited-levels (outline-next-heading)))) > + (setq end (1- new-end)))))) > + (save-excursion > + (save-restriction > + (narrow-to-region beg end) > + (goto-char (point-min)) > + (let (result el) > + (while (setq el (org--get-next-element-region-at-point elements end)) > + (push el result) > + (goto-char (org-element-property :end el))) > + result)))) > + > +(defun org--drawer-or-block-unfold-maybe (el) > + "Update visibility of modified folded drawer/block EL. > +If text was added to hidden drawer/block, make sure that the text is > +also hidden, unless the change was done by a command listed in > +`org-track-element-modification-default-sensitive-commands'. If the > +modification destroyed the drawer/block, reveal the hidden text in > +former drawer/block. If the modification shrinked/expanded the > +drawer/block beyond the hidden text, reveal the affected > +drawers/blocks as well. > +Examples: > +---------------------------------------------- > +---------------------------------------------- > +Case #1 (the element content is hidden): > +---------------------------------------------- > +:PROPERTIES: > +:ID: 279e797c-f4a7-47bb-80f6-e72ac6f3ec55 > +:END: > +---------------------------------------------- > +is changed to > +---------------------------------------------- > +:ROPERTIES: > +:ID: 279e797c-f4a7-47bb-80f6-e72ac6f3ec55 > +:END: > +---------------------------------------------- > +Text is revealed, because we have drawer in place of property-drawer > +---------------------------------------------- > +---------------------------------------------- > +Case #2 (the element content is hidden): > +---------------------------------------------- > +:ROPERTIES: > +:ID: 279e797c-f4a7-47bb-80f6-e72ac6f3ec55 > +:END: > +---------------------------------------------- > +is changed to > +---------------------------------------------- > +:OPERTIES: > +:ID: 279e797c-f4a7-47bb-80f6-e72ac6f3ec55 > +:END: > +---------------------------------------------- > +The text remains hidden since it is still a drawer. > +---------------------------------------------- > +---------------------------------------------- > +Case #3: (the element content is hidden): > +---------------------------------------------- > +:FOO: > +bar > +tmp > +:END: > +---------------------------------------------- > +is changed to > +---------------------------------------------- > +:FOO: > +bar > +:END: > +tmp > +:END: > +---------------------------------------------- > +The text is revealed because the drawer contents shrank. > +---------------------------------------------- > +---------------------------------------------- > +Case #4: (the element content is hidden in both the drawers): > +---------------------------------------------- > +:FOO: > +bar > +tmp > +:END: > +:BAR: > +jjd > +:END: > +---------------------------------------------- > +is changed to > +---------------------------------------------- > +:FOO: > +bar > +tmp > +:BAR: > +jjd > +:END: > +---------------------------------------------- > +The text is revealed in both the drawers because the drawers are merged > +into a new drawer. > +---------------------------------------------- > +---------------------------------------------- > +Case #5: (the element content is hidden) > +---------------------------------------------- > +:test: > +Vivamus id enim. > +:end: > +---------------------------------------------- > +is changed to > +---------------------------------------------- > +:drawer: > +:test: > +Vivamus id enim. > +:end: > +---------------------------------------------- > +The text is revealed in the drawer because the drawer expended. > +---------------------------------------------- > +---------------------------------------------- > +Case #6: (the element content is hidden): > +---------------------------------------------- > +:test: > +Vivamus id enim. > +:end: > +---------------------------------------------- > +is changed to > +---------------------------------------------- > +:test: > +Vivamus id enim. > +:end: > +Nam a sapien. > +:end: > +---------------------------------------------- > +The text remains hidden because drawer contents is always before the > +first :end:." > + (save-match-data > + (save-excursion > + (save-restriction > + (goto-char (org-element-property :begin el)) > + (let* ((newel (org--get-element-region-at-point > + (mapcar (lambda (el) > + (when (string-match-p (regexp-opt '("block" "drawer")) > + (symbol-name (car el))) > + (car el))) > + org-track-element-modifications))) > + (spec (if (string-match-p "block" (symbol-name (org-element-type el))) > + 'org-hide-block > + (if (string-match-p "drawer" (symbol-name (org-element-type el))) > + 'org-hide-drawer > + t))) > + (toggle-func (if (eq spec 'org-hide-drawer) > + #'org-hide-drawer-toggle > + (if (eq spec 'org-hide-block) > + #'org-hide-block-toggle > + #'ignore)))) ; this should not happen > + (if (and (equal (org-element-type el) (org-element-type newel)) > + (equal (marker-position (org-element-property :begin el)) > + (org-element-property :begin newel)) > + (equal (marker-position (org-element-property :end el)) > + (org-element-property :end newel))) > + (when (text-property-any (marker-position (org-element-property :begin el)) > + (marker-position (org-element-property :end el)) > + 'invisible spec) > + (goto-char (org-element-property :begin newel)) > + (if (memq this-command org-track-element-modification-default-sensitive-commands) > + ;; reveal if change was made by typing > + (funcall toggle-func 'off) > + ;; re-hide the inserted text > + ;; FIXME: opening the drawer before hiding should not be needed here > + (funcall toggle-func 'off) ; this is needed to avoid showing double ellipsis > + (funcall toggle-func 'hide))) > + ;; The element was destroyed. Reveal everything. > + (org-flag-region (marker-position (org-element-property :begin el)) > + (marker-position (org-element-property :end el)) > + nil spec) > + (when newel > + (org-flag-region (org-element-property :begin newel) > + (org-element-property :end newel) > + nil spec)))))))) > + > +(defun org--before-element-change-function (beg end) > + "Register upcoming element modifications in `org--modified-elements' for all elements interesting with BEG END." > + (save-match-data > + (save-excursion > + (save-restriction > + (widen) > + (dolist (el (org--find-elements-in-region beg > + end > + (mapcar #'car org-track-element-modifications) > + 'include-partial > + 'include-neighbours)) > + (let* ((beg-marker (copy-marker (org-element-property :begin el) 't)) > + (end-marker (copy-marker (org-element-property :end el) 't))) > + (when (and (marker-position beg-marker) (marker-position end-marker)) > + (org-element-put-property el :begin beg-marker) > + (org-element-put-property el :end end-marker) > + (add-to-list 'org--modified-elements el)))))))) > + > +;; FIXME: this function may be called many times during routine modifications > +;; The normal way to avoid this is `combine-after-change-calls' - not > +;; the case in most org primitives. > +(defun org--after-element-change-function (&rest _) > + "Handle changed elements from `org--modified-elements'." > + (dolist (el org--modified-elements) > + (save-match-data > + (save-excursion > + (save-restriction > + (widen) > + (when-let* ((type (org-element-type el)) > + (change-func (plist-get (alist-get type org-track-element-modifications) > + :after-change-function))) > + (with-demoted-errors > + (funcall (symbol-function change-func) el))))))) > + (setq org--modified-elements nil)) > + > (defvar org-mode-map) > (defvar org-inhibit-startup-visibility-stuff nil) ; Dynamically-scoped param. > (defvar org-agenda-keep-modes nil) ; Dynamically-scoped param. > @@ -4818,6 +5194,9 @@ The following commands are available: > ;; Activate before-change-function > (setq-local org-table-may-need-update t) > (add-hook 'before-change-functions 'org-before-change-function nil 'local) > + (add-hook 'before-change-functions 'org--before-element-change-function nil 'local) > + ;; Activate after-change-function > + (add-hook 'after-change-functions 'org--after-element-change-function nil 'local) > ;; Check for running clock before killing a buffer > (add-hook 'kill-buffer-hook 'org-check-running-clock nil 'local) > ;; Initialize macros templates. > @@ -4869,6 +5248,10 @@ The following commands are available: > (setq-local outline-isearch-open-invisible-function > (lambda (&rest _) (org-show-context 'isearch))) > > + ;; Make isearch search in blocks hidden via text properties > + (setq-local isearch-filter-predicate #'org--isearch-filter-predicate) > + (add-hook 'isearch-mode-end-hook #'org--clear-isearch-overlays nil 'local) > + > ;; Setup the pcomplete hooks > (setq-local pcomplete-command-completion-function #'org-pcomplete-initial) > (setq-local pcomplete-command-name-function #'org-command-at-point) > @@ -5050,8 +5433,8 @@ stacked delimiters is N. Escaping delimiters is not possible." > (when verbatim? > (org-remove-flyspell-overlays-in > (match-beginning 0) (match-end 0)) > - (remove-text-properties (match-beginning 2) (match-end 2) > - '(display t invisible t intangible t))) > + (org-remove-text-properties (match-beginning 2) (match-end 2) > + '(display t invisible t intangible t))) > (add-text-properties (match-beginning 2) (match-end 2) > '(font-lock-multiline t org-emphasis t)) > (when (and org-hide-emphasis-markers > @@ -5166,7 +5549,7 @@ This includes angle, plain, and bracket links." > (if (not (eq 'bracket style)) > (add-text-properties start end properties) > ;; Handle invisible parts in bracket links. > - (remove-text-properties start end '(invisible nil)) > + (org-remove-text-properties start end '(invisible nil)) > (let ((hidden > (append `(invisible > ,(or (org-link-get-parameter type :display) > @@ -5186,8 +5569,8 @@ This includes angle, plain, and bracket links." > (defun org-activate-code (limit) > (when (re-search-forward "^[ \t]*\\(:\\(?: .*\\|$\\)\n?\\)" limit t) > (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) > - (remove-text-properties (match-beginning 0) (match-end 0) > - '(display t invisible t intangible t)) > + (org-remove-text-properties (match-beginning 0) (match-end 0) > + '(display t invisible t intangible t)) > t)) > > (defcustom org-src-fontify-natively t > @@ -5258,8 +5641,8 @@ by a #." > (setq block-end (match-beginning 0)) ; includes the final newline. > (when quoting > (org-remove-flyspell-overlays-in bol-after-beginline nl-before-endline) > - (remove-text-properties beg end-of-endline > - '(display t invisible t intangible t))) > + (org-remove-text-properties beg end-of-endline > + '(display t invisible t intangible t))) > (add-text-properties > beg end-of-endline '(font-lock-fontified t font-lock-multiline t)) > (org-remove-flyspell-overlays-in beg bol-after-beginline) > @@ -5313,8 +5696,8 @@ by a #." > '(font-lock-fontified t face org-document-info)))) > ((string-prefix-p "+caption" dc1) > (org-remove-flyspell-overlays-in (match-end 2) (match-end 0)) > - (remove-text-properties (match-beginning 0) (match-end 0) > - '(display t invisible t intangible t)) > + (org-remove-text-properties (match-beginning 0) (match-end 0) > + '(display t invisible t intangible t)) > ;; Handle short captions. > (save-excursion > (beginning-of-line) > @@ -5336,8 +5719,8 @@ by a #." > '(font-lock-fontified t face font-lock-comment-face))) > (t ;; just any other in-buffer setting, but not indented > (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) > - (remove-text-properties (match-beginning 0) (match-end 0) > - '(display t invisible t intangible t)) > + (org-remove-text-properties (match-beginning 0) (match-end 0) > + '(display t invisible t intangible t)) > (add-text-properties beg (match-end 0) > '(font-lock-fontified t face org-meta-line)) > t)))))) > @@ -5859,10 +6242,11 @@ If TAG is a number, get the corresponding match group." > (inhibit-modification-hooks t) > deactivate-mark buffer-file-name buffer-file-truename) > (decompose-region beg end) > - (remove-text-properties beg end > - '(mouse-face t keymap t org-linked-text t > - invisible t intangible t > - org-emphasis t)) > + (org-remove-text-properties beg end > + '(mouse-face t keymap t org-linked-text t > + invisible t > + intangible t > + org-emphasis t)) > (org-remove-font-lock-display-properties beg end))) > > (defconst org-script-display '(((raise -0.3) (height 0.7)) > @@ -5970,6 +6354,29 @@ open and agenda-wise Org files." > > ;;;; Headlines visibility > > +(defun org-hide-entry () > + "Hide the body directly following this heading." > + (interactive) > + (save-excursion > + (outline-back-to-heading) > + (outline-end-of-heading) > + (org-flag-region (point) (progn (outline-next-preface) (point)) t 'outline))) > + > +(defun org-hide-subtree () > + "Hide everything after this heading at deeper levels." > + (interactive) > + (org-flag-subtree t)) > + > +(defun org-hide-sublevels (levels) > + "Hide everything but the top LEVELS levels of headers, in whole buffer. > +This also unhides the top heading-less body, if any. > + > +Interactively, the prefix argument supplies the value of LEVELS. > +When invoked without a prefix argument, LEVELS defaults to the level > +of the current heading, or to 1 if the current line is not a heading." > + (cl-letf (((symbol-function 'outline-flag-region) #'org-flag-region)) > + (org-hide-sublevels levels))) > + > (defun org-show-entry () > "Show the body directly following this heading. > Show the heading too, if it is currently invisible." > @@ -5988,6 +6395,16 @@ Show the heading too, if it is currently invisible." > 'outline) > (org-cycle-hide-property-drawers 'children)))) > > +(defun org-show-heading () > + "Show the current heading and move to its end." > + (org-flag-region (- (point) > + (if (bobp) 0 > + (if (and outline-blank-line > + (eq (char-before (1- (point))) ?\n)) > + 2 1))) > + (progn (outline-end-of-heading) (point)) > + nil)) > + > (defun org-show-children (&optional level) > "Show all direct subheadings of this heading. > Prefix arg LEVEL is how many levels below the current level > @@ -6031,6 +6448,11 @@ heading to appear." > (org-flag-region > (point) (save-excursion (org-end-of-subtree t t)) nil 'outline)) > > +(defun org-show-branches () > + "Show all subheadings of this heading, but not their bodies." > + (interactive) > + (org-show-children 1000)) > + > ;;;; Blocks and drawers visibility > > (defun org--hide-wrapper-toggle (element category force no-error) > @@ -6064,8 +6486,8 @@ Return a non-nil value when toggling is successful." > (unless (let ((eol (line-end-position))) > (and (> eol start) (/= eol end))) > (let* ((spec (cond ((eq category 'block) 'org-hide-block) > - ((eq type 'property-drawer) 'outline) > - (t 'org-hide-drawer))) > + ((eq category 'drawer) 'org-hide-drawer) > + (t 'outline))) > (flag > (cond ((eq force 'off) nil) > (force t) > @@ -6158,10 +6580,7 @@ STATE should be one of the symbols listed in the docstring of > (when (org-at-property-drawer-p) > (let* ((case-fold-search t) > (end (re-search-forward org-property-end-re))) > - ;; Property drawers use `outline' invisibility spec > - ;; so they can be swallowed once we hide the > - ;; outline. > - (org-flag-region start end t 'outline))))))))))) > + (org-flag-region start end t 'org-hide-drawer))))))))))) > > ;;;; Visibility cycling > > @@ -6536,7 +6955,7 @@ With a numeric prefix, show all headlines up to that level." > (org-narrow-to-subtree) > (org-content)))) > ((or "all" "showall") > - (outline-show-subtree)) > + (org-show-subtree)) > (_ nil))) > (org-end-of-subtree))))))) > > @@ -6609,7 +7028,7 @@ This function is the default value of the hook `org-cycle-hook'." > (while (re-search-forward re nil t) > (when (and (not (org-invisible-p)) > (org-invisible-p (line-end-position))) > - (outline-hide-entry)))) > + (org-hide-entry)))) > (org-cycle-hide-property-drawers 'all) > (org-cycle-show-empty-lines 'overview))))) > > @@ -6683,8 +7102,13 @@ information." > ;; expose it. > (dolist (o (overlays-at (point))) > (when (memq (overlay-get o 'invisible) > - '(org-hide-block org-hide-drawer outline)) > + '(outline)) > (delete-overlay o))) > + (when (memq (get-text-property (point) 'invisible) > + '(org-hide-block org-hide-drawer)) > + (let ((spec (get-text-property (point) 'invisible)) > + (region (org--find-text-property-region (point) 'invisible))) > + (org-flag-region (car region) (cdr region) nil spec))) > (unless (org-before-first-heading-p) > (org-with-limited-levels > (cl-case detail > @@ -7661,7 +8085,7 @@ When REMOVE is non-nil, remove the subtree from the clipboard." > (skip-chars-forward " \t\n\r") > (setq beg (point)) > (when (and (org-invisible-p) visp) > - (save-excursion (outline-show-heading))) > + (save-excursion (org-show-heading))) > ;; Shift if necessary. > (unless (= shift 0) > (save-restriction > @@ -8103,7 +8527,7 @@ function is being called interactively." > (point)) > what "children") > (goto-char start) > - (outline-show-subtree) > + (org-show-subtree) > (outline-next-heading)) > (t > ;; we will sort the top-level entries in this file > @@ -13150,7 +13574,7 @@ drawer is immediately hidden." > (inhibit-read-only t)) > (unless (bobp) (insert "\n")) > (insert ":PROPERTIES:\n:END:") > - (org-flag-region (line-end-position 0) (point) t 'outline) > + (org-flag-region (line-end-position 0) (point) t 'org-hide-drawer) > (when (or (eobp) (= begin (point-min))) (insert "\n")) > (org-indent-region begin (point)))))) > > @@ -17612,11 +18036,11 @@ Move point to the beginning of first heading or end of buffer." > (defun org-show-branches-buffer () > "Show all branches in the buffer." > (org-flag-above-first-heading) > - (outline-hide-sublevels 1) > + (org-hide-sublevels 1) > (unless (eobp) > - (outline-show-branches) > + (org-show-branches) > (while (outline-get-next-sibling) > - (outline-show-branches))) > + (org-show-branches))) > (goto-char (point-min))) > > (defun org-kill-note-or-show-branches () > @@ -17630,8 +18054,8 @@ Move point to the beginning of first heading or end of buffer." > (t > (let ((beg (progn (org-back-to-heading) (point))) > (end (save-excursion (org-end-of-subtree t t) (point)))) > - (outline-hide-subtree) > - (outline-show-branches) > + (org-hide-subtree) > + (org-show-branches) > (org-hide-archived-subtrees beg end))))) > > (defun org-delete-indentation (&optional arg) > @@ -17787,9 +18211,9 @@ Otherwise, call `org-show-children'. ARG is the level to hide." > (if (org-before-first-heading-p) > (progn > (org-flag-above-first-heading) > - (outline-hide-sublevels (or arg 1)) > + (org-hide-sublevels (or arg 1)) > (goto-char (point-min))) > - (outline-hide-subtree) > + (org-hide-subtree) > (org-show-children arg)))) > > (defun org-ctrl-c-star () > @@ -20933,6 +21357,80 @@ Started from `gnus-info-find-node'." > (t default-org-info-node)))))) > > \f > + > +;;; Make isearch search in some text hidden via text propertoes > + > +(defvar org--isearch-overlays nil > + "List of overlays temporarily created during isearch. > +This is used to allow searching in regions hidden via text properties. > +As for [2020-05-09 Sat], Isearch only has special handling of hidden overlays. > +Any text hidden via text properties is not revealed even if `search-invisible' > +is set to 't.") > + > +;; Not sure if it needs to be a user option > +;; One might want to reveal hidden text in, for example, hidden parts of the links. > +;; Currently, hidden text in links is never revealed by isearch. > +(defvar org-isearch-specs '(org-hide-block > + org-hide-drawer) > + "List of text invisibility specs to be searched by isearch. > +By default ([2020-05-09 Sat]), isearch does not search in hidden text, > +which was made invisible using text properties. Isearch will be forced > +to search in hidden text with any of the listed 'invisible property value.") > + > +(defun org--create-isearch-overlays (beg end) > + "Replace text property invisibility spec by overlays between BEG and END. > +All the regions with invisibility text property spec from > +`org-isearch-specs' will be changed to use overlays instead > +of text properties. The created overlays will be stored in > +`org--isearch-overlays'." > + (let ((pos beg)) > + (while (< pos end) > + (when-let* ((spec (get-text-property pos 'invisible)) > + (spec (memq spec org-isearch-specs)) > + (region (org--find-text-property-region pos 'invisible))) > + (setq spec (get-text-property pos 'invisible)) > + ;; Changing text properties is considered buffer modification. > + ;; We do not want it here. > + (with-silent-modifications > + ;; The overlay is modelled after `org-flag-region' [2020-05-09 Sat] > + ;; overlay for 'outline blocks. > + (let ((o (make-overlay (car region) (cdr region) nil 'front-advance))) > + (overlay-put o 'evaporate t) > + (overlay-put o 'invisible spec) > + ;; `delete-overlay' here means that spec information will be lost > + ;; for the region. The region will remain visible. > + (overlay-put o 'isearch-open-invisible #'delete-overlay) > + (push o org--isearch-overlays)) > + (org-flag-region (car region) (cdr region) nil spec))) > + (setq pos (next-single-property-change pos 'invisible nil end))))) > + > +(defun org--isearch-filter-predicate (beg end) > + "Return non-nil if text between BEG and END is deemed visible by Isearch. > +This function is intended to be used as `isearch-filter-predicate'. > +Unlike `isearch-filter-visible', make text with 'invisible text property > +value listed in `org-isearch-specs' visible to Isearch." > + (org--create-isearch-overlays beg end) ;; trick isearch by creating overlays in place of invisible text > + (isearch-filter-visible beg end)) > + > +(defun org--clear-isearch-overlay (ov) > + "Convert OV region back into using text properties." > + (when-let ((spec (overlay-get ov 'invisible))) ;; ignore deleted overlays > + ;; Changing text properties is considered buffer modification. > + ;; We do not want it here. > + (with-silent-modifications > + (org-flag-region (overlay-start ov) (overlay-end ov) t spec))) > + (when (member ov isearch-opened-overlays) > + (setq isearch-opened-overlays (delete ov isearch-opened-overlays))) > + (delete-overlay ov)) > + > +(defun org--clear-isearch-overlays () > + "Convert overlays from `org--isearch-overlays' back into using text properties." > + (when org--isearch-overlays > + (mapc #'org--clear-isearch-overlay org--isearch-overlays) > + (setq org--isearch-overlays nil))) > + > +\f > + > ;;; Finish up > > (add-hook 'org-mode-hook ;remove overlays when changing major mode > > > Ihor Radchenko <yantar92@gmail.com> writes: > >> Hello, >> >> [The patch itself will be provided in the following email] >> >> I have five updates from the previous version of the patch: >> >> 1. I implemented a simplified version of element parsing to detect >> changes in folded drawers or blocks. No computationally expensive calls >> of org-element-at-point or org-element-parse-buffer are needed now. >> >> 2. The patch is now compatible with master (commit 2e96dc639). I >> reverted the earlier change in folding drawers and blocks. Now, they are >> back to using 'org-hide-block and 'org-hide-drawer. Using 'outline would >> achieve nothing when we use text properties. >> >> 3. 'invisible text property can now be nested. This is important, for >> example, when text inside drawers contains fontified links (which also >> use 'invisible text property to hide parts of the link). Now, the old >> 'invisible spec is recovered after unfolding. >> >> 4. Some outline-* function calls in org referred to outline-flag-region >> implementation, which is not in sync with org-flag-region in this patch. >> I have implemented their org-* versions and replaced the calls >> throughout .el files. Actually, some org-* versions were already >> implemented in org, but not used for some reason (or not mentioned in >> the manual). I have updated the relevant sections of manual. These >> changes might be relevant to org independently of this feature branch. >> >> 5. I have managed to get a working version of outline folding via text >> properties. However, that approach has a big downside - folding state >> cannot be different in indirect buffer when we use text properties. I >> have seen packages relying on this feature of org and I do not see any >> obvious way to achieve different folding state in indirect buffer while >> using text properties for outline folding. >> >> ----------------------------------------------------------------------- >> ----------------------------------------------------------------------- >> >> More details on the new implementation for tracking changes: >> >>> Of course we can. It is only necessary to focus on changes that would >>> break the structure of the element. This does not entail a full parsing. >> >> I have limited parsing to matching beginning and end of a drawer/block. >> The basic functions are org--get-element-region-at-point, >> org--get-next-element-region-at-point, and org--find-elements-in-region. >> They are simplified versions of org-element-* parsers and do not require >> parsing everything from the beginning of the section. >> >> For now, I keep everything in org.el, but those simplified parsers >> probably belong to org-element.el. >> >>> If we can stick with `after-change-functions' (or local equivalent), >>> that's better. It is more predictable than `before-change-functions' and >>> alike. >> >> For now, I still used before/after-change-functions combination. >> I see the following problems with using only after-change-functions: >> >> 1. They are not guaranteed to be called after every single change: >> >> From (elisp) Change Hooks: >> "... some complex primitives call ‘before-change-functions’ once before >> making changes, and then call ‘after-change-functions’ zero or more >> times" >> >> The consequence of it is a possibility that region passed to the >> after-change-functions is quite big (including all the singular changes, >> even if they are distant). This region may contain changed drawers as >> well and unchanged drawers and needs to be parsed to determine which >> drawers need to be re-folded. >> >>> And, more importantly, they are not meant to be used together, i.e., you >>> cannot assume that a single call to `before-change-functions' always >>> happens before calling `after-change-functions'. This can be tricky if >>> you want to use the former to pass information to the latter. >> >> The fact that before-change-functions can be called multiple times >> before after-change-functions, is trivially solved by using buffer-local >> changes register (see org--modified-elements). The register is populated >> by before-change-functions and cleared by after-change-functions. >> >>> Well, `before-change-fuctions' and `after-change-functions' are not >>> clean at all: you modify an unrelated part of the buffer, but still call >>> those to check if a drawer needs to be unfolded somewhere. >> >> 2. As you pointed, instead of global before-change-functions, we can use >> modification-hooks text property on sensitive parts of the >> drawers/blocks. This would work, but I am concerned about one annoying >> special case: >> >> ------------------------------------------------------------------------- >> :BLAH: <inserted outside any of the existing drawers> >> >> <some text> >> >> :DRAWER: <folded> >> Donec at pede. >> :END: >> ------------------------------------------------------------------------- >> In this example, the user would not be able to unfold the folder DRAWER >> because it will technically become a part of a new giant BLAH drawer. >> This may be especially annoying if <some text> is more than one screen >> long and there is no easy way to identify why unfolding does not work >> (with point at :DRAWER:). >> >> Because of this scenario, limiting before-change-functions to folded >> drawers is not sufficient. Any change in text may need to trigger >> unfolding. >> >> In the patch, I always register possible modifications in the >> blocks/drawers intersecting with the modified region + a drawer/block >> right next to the region. >> >> ----------------------------------------------------------------------- >> ----------------------------------------------------------------------- >> >> More details on the nested 'invisible text property implementation. >> >> The idea is to keep 'invisible property stack push and popping from it >> as we add/remove 'invisible text property. All the work is done in >> org-flag-region. >> >> This was originally intended for folding outlines via text properties. >> Since using text properties for folding outlines is not a good idea, >> nested text properties have much less use. As I mentioned, they do >> preserve link fontification, but I am not sure if it worth it for the >> overhead to org-flag-region. Keeping this here mostly in the case if >> someone has any ideas how it can be useful. >> >> ----------------------------------------------------------------------- >> ----------------------------------------------------------------------- >> >> More details on replaced outline-* -> org-* function calls. >> >> I have implemented org-* versions of the following functions: >> >> - outline-hide-entry >> - outline-hide-subtree >> - outline-hide-sublevels >> - outline-show-heading >> - outline-show-branches >> >> The org-* versions trivially use org-flag-region instead of >> outline-flag-region. >> >> Replaced outline-* calls where org- versions were already available: >> >> - outline-show-entry >> - outline-show-all >> - outline-show-subtree >> >> I reflected the new (including already available) functions in the >> manual and removed some defalias from org-compat.el where they are not >> needed. >> >> ----------------------------------------------------------------------- >> ----------------------------------------------------------------------- >> >> Further work: >> >> 1. after-change-functions use org-hide-drawer/block-toggle to >> fold/unfold after modification. However, I just found that they call >> org-element-at-point, which slows down modifications in folded >> drawers/blocks. For example, realigning a long table inside folded >> drawer takes >1sec, while it is instant in the unfolded drawer. >> >> 2. org-toggle-custom-properties is terribly slow on large org documents, >> similarly to folded drawers on master. It should be relatively easy to >> use text properties there instead of overlays. >> >> 3. Multiple calls to before/after-change-functions is still a problem. I >> am looking into following ways to reduce this number: >> - reduce the number of elements registered as potentially modified >> + do not add duplicates to org--modified-elements >> + do not add unfolded elements to org--modified-elements >> + register after-change-function as post-command hook and remove it >> from global after-change-functions. This way, it will be called >> twice per command only. >> - determine common region containing org--modified-elements. if change >> is happening within that region, there is no need to parse >> drawers/blocks there again. >> >> P.S. >> >>>> It was mostly an annoyance, because they returned different results on >>>> the same element. Specifically, they returned different :post-blank and >>>> :end properties, which does not sound right. >>> >>> OK. If you have a reproducible recipe, I can look into it and see what >>> can be done. >> >> Recipe to have different (org-element-at-point) and >> (org-element-parse-buffer 'element) >> ------------------------------------------------------------------------- >> <point-min> >> :PROPERTIES: >> :CREATED: [2020-05-23 Sat 02:32] >> :END: >> >> >> <point-max> >> ------------------------------------------------------------------------- >> >> >> Best, >> Ihor >> >> Nicolas Goaziou <mail@nicolasgoaziou.fr> writes: >> >>> Hello, >>> >>> Ihor Radchenko <yantar92@gmail.com> writes: >>> >>>>> As you noticed, using Org Element is a no-go, unfortunately. Parsing an >>>>> element is a O(N) operation by the number of elements before it in >>>>> a section. In particular, it is not bounded, and not mitigated by >>>>> a cache. For large documents, it is going to be unbearably slow, too. >>>> >>>> Ouch. I thought it is faster. >>>> What do you mean by "not mitigated by a cache"? >>> >>> Parsing starts from the closest headline, every time. So, if Org parses >>> the Nth element in the entry two times, it really parses 2N elements. >>> >>> With a cache, assuming the buffer wasn't modified, Org would parse >>> N elements only. With a smarter cache, with fine grained cache >>> invalidation, it could also reduce the number of subsequent parsed >>> elements. >>> >>>> The reason I would like to utilise org-element parser to make tracking >>>> modifications more robust. Using details of the syntax would make the >>>> code fragile if any modifications are made to syntax in future. >>> >>> I don't think the code would be more fragile. Also, the syntax we're >>> talking about is not going to be modified anytime soon. Moreover, if >>> folding breaks, it is usually visible, so the bug will not be unnoticed. >>> >>> This code is going to be as low-level as it can be. >>> >>>> Debugging bugs in modification functions is not easy, according to my >>>> experience. >>> >>> No, it's not. >>> >>> But this is not really related to whether you use Element or not. >>> >>>> One possible way to avoid performance issues during modification is >>>> running parser in advance. For example, folding an element may >>>> as well add information about the element to its text properties. >>>> This will not degrade performance of folding since we are already >>>> parsing the element during folding (at least, in >>>> org-hide-drawer-toggle). >>> >>> We can use this information stored at fold time. But I'm not even sure >>> we need it. >>> >>>> The problem with parsing an element during folding is that we cannot >>>> easily detect changes like below without re-parsing. >>> >>> Of course we can. It is only necessary to focus on changes that would >>> break the structure of the element. This does not entail a full parsing. >>> >>>> :PROPERTIES: <folded> >>>> :CREATED: [2020-05-18 Mon] >>>> :END: <- added line >>>> :ID: test >>>> :END: >>>> >>>> or even >>>> >>>> :PROPERTIES: >>>> :CREATED: [2020-05-18 Mon] >>>> :ID: test >>>> :END: <- delete this line >>>> >>>> :DRAWER: <folded, cannot be unfolded if we don't re-parse after deletion> >>>> test >>>> :END: >>> >>> Please have a look at the "sensitive parts" I wrote about. This takes >>> care of this kind of breakage. >>> >>>> The re-parsing can be done via regexp, as you suggested, but I don't >>>> like this idea, because it will end up re-implementing >>>> org-element-*-parser. >>> >>> You may have misunderstood my suggestion. See below. >>> >>>> Would it be acceptable to run org-element-*-parser >>>> in after-change-functions? >>> >>> I'd rather not do that. This is unnecessary consing, and matching, etc. >>> >>>> If I understand correctly, it is not as easy. >>>> Consider the following example: >>>> >>>> :PROPERTIES: >>>> :CREATED: [2020-05-18 Mon] >>>> <region-beginning> >>>> :ID: example >>>> :END: >>>> >>>> <... a lot of text, maybe containing other drawers ...> >>>> >>>> Nullam rutrum. >>>> Pellentesque dapibus suscipit ligula. >>>> <region-end> >>>> Proin quam nisl, tincidunt et, mattis eget, convallis nec, purus. >>>> >>>> If the region gets deleted, the modification hooks from chars inside >>>> drawer will be called as (hook-function <region-beginning> >>>> <region-end>). So, there is still a need to find the drawer somehow to >>>> mark it as about to be modified (modification hooks are ran before >>>> actual modification). >>> >>> If we can stick with `after-change-functions' (or local equivalent), >>> that's better. It is more predictable than `before-change-functions' and >>> alike. >>> >>> If it is a deletion, here is the kind of checks we could do, depending >>> on when they are performed. >>> >>> Before actual changes : >>> >>> 1. The deletion is happening within a folded drawer (unnecessary step >>> in local functions). >>> 2. The change deleted the sensitive line ":END:". >>> 3. Conclusion : unfold. >>> >>> Or, after actual changes : >>> >>> 1. The deletion involves a drawer. >>> 2. Text properties indicate that the beginning of the propertized part >>> of the buffer start with org-drawer-regexp, but doesn't end with >>> `org-property-end-re'. A "sensitive part" disappeared! >>> 3. Conclusion : unfold >>> >>> This is far away from parsing. IMO, a few checks cover all cases. Let me >>> know if you have questions about it. >>> >>> Also, note that the kind of change you describe will happen perhaps >>> 0.01% of the time. Most change are about one character, or a single >>> line, long. >>> >>>> The only difference between using modification hooks and >>>> before-change-functions is that modification hooks will trigger less >>>> frequently. >>> >>> Exactly. Much less frequently. But extra care is required, as you noted >>> already. >>> >>>> Considering the performance of org-element-at-point, it is >>>> probably worth doing. Initially, I wanted to avoid it because setting a >>>> single before-change-functions hook sounded cleaner than setting >>>> modification-hooks, insert-behind-hooks, and insert-in-front-hooks. >>> >>> Well, `before-change-fuctions' and `after-change-functions' are not >>> clean at all: you modify an unrelated part of the buffer, but still call >>> those to check if a drawer needs to be unfolded somewhere. >>> >>> And, more importantly, they are not meant to be used together, i.e., you >>> cannot assume that a single call to `before-change-functions' always >>> happens before calling `after-change-functions'. This can be tricky if >>> you want to use the former to pass information to the latter. >>> >>> But I understand that they are easier to use than their local >>> counterparts. If you stick with (before|after)-change-functions, the >>> function being called needs to drop the ball very quickly if the >>> modification is not about folding changes. Also, I very much suggest to >>> stick to only `after-change-functions', if feasible (I think it is), per >>> above. >>> >>>> Moreover, these text properties would be copied by default if one uses >>>> buffer-substring. Then, the hooks will also trigger later in the yanked >>>> text, which may cause all kinds of bugs. >>> >>> Indeed, that would be something to handle specifically. I.e., >>> destructive modifications (i.e., those that unfold) could clear such >>> properties. >>> >>> It is more work. I don't know if it is worth the trouble if we can get >>> out quickly of `after-change-functions' for unrelated changes. >>> >>>> It was mostly an annoyance, because they returned different results on >>>> the same element. Specifically, they returned different :post-blank and >>>> :end properties, which does not sound right. >>> >>> OK. If you have a reproducible recipe, I can look into it and see what >>> can be done. >>> >>> Regards, >>> >>> -- >>> Nicolas Goaziou >> >> -- >> Ihor Radchenko, >> PhD, >> Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) >> State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China >> Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg > > -- > Ihor Radchenko, > PhD, > Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) > State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China > Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-05-23 13:52 ` Ihor Radchenko 2020-05-23 13:53 ` Ihor Radchenko @ 2020-05-26 8:33 ` Nicolas Goaziou 2020-06-02 9:21 ` Ihor Radchenko 1 sibling, 1 reply; 192+ messages in thread From: Nicolas Goaziou @ 2020-05-26 8:33 UTC (permalink / raw) To: Ihor Radchenko; +Cc: emacs-orgmode Hello, Ihor Radchenko <yantar92@gmail.com> writes: > I have five updates from the previous version of the patch: Thank you. > 1. I implemented a simplified version of element parsing to detect > changes in folded drawers or blocks. No computationally expensive calls > of org-element-at-point or org-element-parse-buffer are needed now. > > 2. The patch is now compatible with master (commit 2e96dc639). I > reverted the earlier change in folding drawers and blocks. Now, they are > back to using 'org-hide-block and 'org-hide-drawer. Using 'outline would > achieve nothing when we use text properties. > > 3. 'invisible text property can now be nested. This is important, for > example, when text inside drawers contains fontified links (which also > use 'invisible text property to hide parts of the link). Now, the old > 'invisible spec is recovered after unfolding. Interesting. I'm running out of time, so I cannot properly inspect the code right now. I'll try to do that before the end of the week. > 4. Some outline-* function calls in org referred to outline-flag-region > implementation, which is not in sync with org-flag-region in this patch. > I have implemented their org-* versions and replaced the calls > throughout .el files. Actually, some org-* versions were already > implemented in org, but not used for some reason (or not mentioned in > the manual). I have updated the relevant sections of manual. These > changes might be relevant to org independently of this feature branch. Yes, we certainly want to move to org-specific versions in all cases. > 5. I have managed to get a working version of outline folding via text > properties. However, that approach has a big downside - folding state > cannot be different in indirect buffer when we use text properties. I > have seen packages relying on this feature of org and I do not see any > obvious way to achieve different folding state in indirect buffer while > using text properties for outline folding. Hmm. Good point. This is a serious issue to consider. Even if we don't use text properties for outline, this also affects drawers and blocks. > For now, I still used before/after-change-functions combination. You shouldn't. > I see the following problems with using only after-change-functions: > > 1. They are not guaranteed to be called after every single change: Of course they are! See below. > From (elisp) Change Hooks: > "... some complex primitives call ‘before-change-functions’ once before > making changes, and then call ‘after-change-functions’ zero or more > times" "zero" means there are no changes at all, so, `after-change-functions' are not called, which is expected. > The consequence of it is a possibility that region passed to the > after-change-functions is quite big (including all the singular changes, > even if they are distant). This region may contain changed drawers as > well and unchanged drawers and needs to be parsed to determine which > drawers need to be re-folded. It seems you're getting it backwards. `before-change-functions' are the functions being called with a possibly wide, imprecise, region to handle: When that happens, the arguments to ‘before-change-functions’ will enclose a region in which the individual changes are made, but won’t necessarily be the minimal such region however, after-change-functions calls are always minimal: and the arguments to each successive call of ‘after-change-functions’ will then delimit the part of text being changed exactly. If you stick to `after-change-functions', there will be no such thing as you describe. >> And, more importantly, they are not meant to be used together, i.e., you >> cannot assume that a single call to `before-change-functions' always >> happens before calling `after-change-functions'. This can be tricky if >> you want to use the former to pass information to the latter. > > The fact that before-change-functions can be called multiple times > before after-change-functions, is trivially solved by using buffer-local > changes register (see org--modified-elements). Famous last words. Been there, done that, and it failed. Let me quote the manual: In general, we advise to use either before- or the after-change hooks, but not both. So, let me insist: don't do that. If you don't agree with me, let's at least agree with Emacs developers. > The register is populated by before-change-functions and cleared by > after-change-functions. You cannot expect `after-change-functions' to clear what `before-change-functions' did. This is likely to introduce pernicious bugs. Sorry if it sounds like FUD, but bugs in those areas are just horrible to squash. >> Well, `before-change-fuctions' and `after-change-functions' are not >> clean at all: you modify an unrelated part of the buffer, but still call >> those to check if a drawer needs to be unfolded somewhere. > > 2. As you pointed, instead of global before-change-functions, we can use > modification-hooks text property on sensitive parts of the > drawers/blocks. This would work, but I am concerned about one annoying > special case: > > ------------------------------------------------------------------------- > :BLAH: <inserted outside any of the existing drawers> > > <some text> > > :DRAWER: <folded> > Donec at pede. > :END: > ------------------------------------------------------------------------- > In this example, the user would not be able to unfold the folder DRAWER > because it will technically become a part of a new giant BLAH drawer. > This may be especially annoying if <some text> is more than one screen > long and there is no easy way to identify why unfolding does not work > (with point at :DRAWER:). You shouldn't be bothered by the case you're describing here, for multiple reasons. First, this issue already arises in the current implementation. No one bothered so far: this change is very unlikely to happen. If it becomes an issue, we could make sure that `org-reveal' handles this. But, more importantly, we actually /want it/ as a feature. Indeed, if DRAWER is expanded every time ":BLAH:" is inserted above, then inserting a drawer manually would unfold /all/ drawers in the section. The user is more likely to write first ":BLAH:" (everything is unfolded) then ":END:" than ":END:", then ":BLAH:". > Because of this scenario, limiting before-change-functions to folded > drawers is not sufficient. Any change in text may need to trigger > unfolding. after-change-functions is more appropriate than before-change-functions, and local parsing, as explained in this thread, is more efficient than re-inventing the parser. > In the patch, I always register possible modifications in the > blocks/drawers intersecting with the modified region + a drawer/block > right next to the region. > > ----------------------------------------------------------------------- > ----------------------------------------------------------------------- > > More details on the nested 'invisible text property implementation. > > The idea is to keep 'invisible property stack push and popping from it > as we add/remove 'invisible text property. All the work is done in > org-flag-region. This sounds like a good idea. > This was originally intended for folding outlines via text properties. > Since using text properties for folding outlines is not a good idea, > nested text properties have much less use. AFAIU, they have. You mention link fontification, but there are other pieces that we could switch to text properties instead of overlays, e.g., Babel hashes, narrowed table columns… > 3. Multiple calls to before/after-change-functions is still a problem. I > am looking into following ways to reduce this number: > - reduce the number of elements registered as potentially modified > + do not add duplicates to org--modified-elements > + do not add unfolded elements to org--modified-elements > + register after-change-function as post-command hook and remove it > from global after-change-functions. This way, it will be called > twice per command only. > - determine common region containing org--modified-elements. if change > is happening within that region, there is no need to parse > drawers/blocks there again. This is over-engineering. Again, please focus on local changes, as discussed before. > Recipe to have different (org-element-at-point) and > (org-element-parse-buffer 'element) > ------------------------------------------------------------------------- > <point-min> > :PROPERTIES: > :CREATED: [2020-05-23 Sat 02:32] > :END: > > > <point-max> > ------------------------------------------------------------------------- I didn't look at this situation in particular, but there are cases where different :post-blank values are inevitable, for example at the end of a section. Regards, -- Nicolas Goaziou ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-05-26 8:33 ` Nicolas Goaziou @ 2020-06-02 9:21 ` Ihor Radchenko 2020-06-02 9:23 ` Ihor Radchenko ` (2 more replies) 0 siblings, 3 replies; 192+ messages in thread From: Ihor Radchenko @ 2020-06-02 9:21 UTC (permalink / raw) To: Nicolas Goaziou; +Cc: emacs-orgmode Hello, [The patch itself will be provided in the following email] I have three updates from the previous version of the patch: 1. I managed to implement buffer-local text properties. Now, outline folding also uses text properties without a need to give up independent folding in indirect buffers. 2. The code handling modifications in folded drawers/blocks was rewritten. The new code uses after-change-functions to re-hide text inserted in the middle of folded regions; and text properties to unfold folded drawers/blocks if one changes BEGIN/END line. 3. [experimental] Started working on improving memory and cpu footprint of the old code related to folding/unfolding. org-hide-drawer-all now works significantly faster because I can utilise simplified drawer parser, which require a lot less memory. Overall, I managed to reduce Emacs memory footprint after loading all my agenda_files twice. The loading is also noticeably faster. ----------------------------------------------------------------------- ----------------------------------------------------------------------- More details on the buffer-local text properties: I have found char-property-alias-alist variable that controls how Emacs calculates text property value if the property is not set. This variable can be buffer-local, which allows independent 'invisible states in different buffers. All the implementation stays in org--get-buffer-local-text-property-symbol, which takes care about generating unique property name and mapping it to 'invisible (or any other) text property. ----------------------------------------------------------------------- ----------------------------------------------------------------------- More details on the new implementation for tracking changes: I simplified the code as suggested, without using pairs of before- and after-change-functions. Handling text inserted into folded/invisible region is handled by a simple after-change function. After testing, it turned out that simple re-hiding text based on 'invisible property of the text before/after the inserted region works pretty well. Modifications to BEGIN/END line of the drawers and blocks is handled via 'modification-hooks + 'insert-behind-hooks text properties (there is no after-change-functions analogue for text properties in Emacs). The property is applied during folding and the modification-hook function is made aware about the drawer/block boundaries (via apply-partially passing element containing :begin :end markers for the current drawer/block). Passing the element boundary is important because the 'modification-hook will not directly know where it belongs to. Only the modified region (which can be larger than the drawer) is passed to the function. In the worst case, the region can be the whole buffer (if one runs revert-buffer). It turned out that adding 'modification-hook text property takes a significant cpu time (partially, because we need to take care about possible existing 'modification-hook value, see org--add-to-list-text-property). For now, I decided to not clear the modification hooks during unfolding because of poor performance. However, this approach would lead to partial unfolding in the following case: :asd: :drawer: lksjdfksdfjl sdfsdfsdf :end: If :asd: was inserted in front of folded :drawer:, changes in :drawer: line of the new folded :asd: drawer would reveal the text between :drawer: and :end:. Let me know what you think on this. > You shouldn't be bothered by the case you're describing here, for > multiple reasons. > > First, this issue already arises in the current implementation. No one > bothered so far: this change is very unlikely to happen. If it becomes > an issue, we could make sure that `org-reveal' handles this. > > But, more importantly, we actually /want it/ as a feature. Indeed, if > DRAWER is expanded every time ":BLAH:" is inserted above, then inserting > a drawer manually would unfold /all/ drawers in the section. The user is > more likely to write first ":BLAH:" (everything is unfolded) then > ":END:" than ":END:", then ":BLAH:". Agree. This allowed me to simplify the code significantly. > It seems you're getting it backwards. `before-change-functions' are the > functions being called with a possibly wide, imprecise, region to > handle: > > When that happens, the arguments to ‘before-change-functions’ will > enclose a region in which the individual changes are made, but won’t > necessarily be the minimal such region > > however, after-change-functions calls are always minimal: > > and the arguments to each successive call of > ‘after-change-functions’ will then delimit the part of text being > changed exactly. > > If you stick to `after-change-functions', there will be no such thing as > you describe. You are right here, I missed that before-change-functions are likely to be called on large regions. I thought that the regions are same for before/after-change-functions, but after-change-functions could be called more than 1 time. After second thought, your vision that it is mostly 0 or 1 times should be the majority of cases in practice. ----------------------------------------------------------------------- ----------------------------------------------------------------------- More details on reducing cpu and memory footprint of org buffers: My simplified implementation of element boundary parser (org--get-element-region-at-point) appears to be much faster and also uses much less memory in comparison with org-element-at-point. Moreover, not all the places where org-element-at-point is called actually need the full parsed element. For example, org-hide-drawer-all, org-hide-drawer-toggle, org-hide-block-toggle, and org--hide-wrapper-toggle only need element type and some information about the element boundaries - the information we can get from org--get-element-region-at-point. The following version of org-hide-drawer-all seems to work much faster in comparison with original: (defun org-hide-drawer-all () "Fold all drawers in the current buffer." (save-excursion (goto-char (point-min)) (while (re-search-forward org-drawer-regexp nil t) (when-let* ((drawer (org--get-element-region-at-point '(property-drawer drawer))) (type (org-element-type drawer))) (org-hide-drawer-toggle t nil drawer) ;; Make sure to skip drawer entirely or we might flag it ;; another time when matching its ending line with ;; `org-drawer-regexp'. (goto-char (org-element-property :end drawer)))))) What do you think about the idea of making use of org--get-element-region-at-point in org code base? ----------------------------------------------------------------------- ----------------------------------------------------------------------- Further work: 1. Look into other code using overlays. Specifically, org-toggle-custom-properties, Babel hashes, and narrowed table columns. Best, Ihor Nicolas Goaziou <mail@nicolasgoaziou.fr> writes: > Hello, > > Ihor Radchenko <yantar92@gmail.com> writes: > >> I have five updates from the previous version of the patch: > > Thank you. > >> 1. I implemented a simplified version of element parsing to detect >> changes in folded drawers or blocks. No computationally expensive calls >> of org-element-at-point or org-element-parse-buffer are needed now. >> >> 2. The patch is now compatible with master (commit 2e96dc639). I >> reverted the earlier change in folding drawers and blocks. Now, they are >> back to using 'org-hide-block and 'org-hide-drawer. Using 'outline would >> achieve nothing when we use text properties. >> >> 3. 'invisible text property can now be nested. This is important, for >> example, when text inside drawers contains fontified links (which also >> use 'invisible text property to hide parts of the link). Now, the old >> 'invisible spec is recovered after unfolding. > > Interesting. I'm running out of time, so I cannot properly inspect the > code right now. I'll try to do that before the end of the week. > >> 4. Some outline-* function calls in org referred to outline-flag-region >> implementation, which is not in sync with org-flag-region in this patch. >> I have implemented their org-* versions and replaced the calls >> throughout .el files. Actually, some org-* versions were already >> implemented in org, but not used for some reason (or not mentioned in >> the manual). I have updated the relevant sections of manual. These >> changes might be relevant to org independently of this feature branch. > > Yes, we certainly want to move to org-specific versions in all cases. > >> 5. I have managed to get a working version of outline folding via text >> properties. However, that approach has a big downside - folding state >> cannot be different in indirect buffer when we use text properties. I >> have seen packages relying on this feature of org and I do not see any >> obvious way to achieve different folding state in indirect buffer while >> using text properties for outline folding. > > Hmm. Good point. This is a serious issue to consider. Even if we don't > use text properties for outline, this also affects drawers and blocks. > >> For now, I still used before/after-change-functions combination. > > You shouldn't. > >> I see the following problems with using only after-change-functions: >> >> 1. They are not guaranteed to be called after every single change: > > Of course they are! See below. > >> From (elisp) Change Hooks: >> "... some complex primitives call ‘before-change-functions’ once before >> making changes, and then call ‘after-change-functions’ zero or more >> times" > > "zero" means there are no changes at all, so, `after-change-functions' > are not called, which is expected. > >> The consequence of it is a possibility that region passed to the >> after-change-functions is quite big (including all the singular changes, >> even if they are distant). This region may contain changed drawers as >> well and unchanged drawers and needs to be parsed to determine which >> drawers need to be re-folded. > > It seems you're getting it backwards. `before-change-functions' are the > functions being called with a possibly wide, imprecise, region to > handle: > > When that happens, the arguments to ‘before-change-functions’ will > enclose a region in which the individual changes are made, but won’t > necessarily be the minimal such region > > however, after-change-functions calls are always minimal: > > and the arguments to each successive call of > ‘after-change-functions’ will then delimit the part of text being > changed exactly. > > If you stick to `after-change-functions', there will be no such thing as > you describe. > >>> And, more importantly, they are not meant to be used together, i.e., you >>> cannot assume that a single call to `before-change-functions' always >>> happens before calling `after-change-functions'. This can be tricky if >>> you want to use the former to pass information to the latter. >> >> The fact that before-change-functions can be called multiple times >> before after-change-functions, is trivially solved by using buffer-local >> changes register (see org--modified-elements). > > Famous last words. Been there, done that, and it failed. > > Let me quote the manual: > > In general, we advise to use either before- or the after-change > hooks, but not both. > > So, let me insist: don't do that. If you don't agree with me, let's at > least agree with Emacs developers. > >> The register is populated by before-change-functions and cleared by >> after-change-functions. > > You cannot expect `after-change-functions' to clear what > `before-change-functions' did. This is likely to introduce pernicious > bugs. Sorry if it sounds like FUD, but bugs in those areas are just > horrible to squash. > >>> Well, `before-change-fuctions' and `after-change-functions' are not >>> clean at all: you modify an unrelated part of the buffer, but still call >>> those to check if a drawer needs to be unfolded somewhere. >> >> 2. As you pointed, instead of global before-change-functions, we can use >> modification-hooks text property on sensitive parts of the >> drawers/blocks. This would work, but I am concerned about one annoying >> special case: >> >> ------------------------------------------------------------------------- >> :BLAH: <inserted outside any of the existing drawers> >> >> <some text> >> >> :DRAWER: <folded> >> Donec at pede. >> :END: >> ------------------------------------------------------------------------- >> In this example, the user would not be able to unfold the folder DRAWER >> because it will technically become a part of a new giant BLAH drawer. >> This may be especially annoying if <some text> is more than one screen >> long and there is no easy way to identify why unfolding does not work >> (with point at :DRAWER:). > > You shouldn't be bothered by the case you're describing here, for > multiple reasons. > > First, this issue already arises in the current implementation. No one > bothered so far: this change is very unlikely to happen. If it becomes > an issue, we could make sure that `org-reveal' handles this. > > But, more importantly, we actually /want it/ as a feature. Indeed, if > DRAWER is expanded every time ":BLAH:" is inserted above, then inserting > a drawer manually would unfold /all/ drawers in the section. The user is > more likely to write first ":BLAH:" (everything is unfolded) then > ":END:" than ":END:", then ":BLAH:". > >> Because of this scenario, limiting before-change-functions to folded >> drawers is not sufficient. Any change in text may need to trigger >> unfolding. > > after-change-functions is more appropriate than before-change-functions, > and local parsing, as explained in this thread, is more efficient than > re-inventing the parser. > >> In the patch, I always register possible modifications in the >> blocks/drawers intersecting with the modified region + a drawer/block >> right next to the region. >> >> ----------------------------------------------------------------------- >> ----------------------------------------------------------------------- >> >> More details on the nested 'invisible text property implementation. >> >> The idea is to keep 'invisible property stack push and popping from it >> as we add/remove 'invisible text property. All the work is done in >> org-flag-region. > > This sounds like a good idea. > >> This was originally intended for folding outlines via text properties. >> Since using text properties for folding outlines is not a good idea, >> nested text properties have much less use. > > AFAIU, they have. You mention link fontification, but there are other > pieces that we could switch to text properties instead of overlays, > e.g., Babel hashes, narrowed table columns… > >> 3. Multiple calls to before/after-change-functions is still a problem. I >> am looking into following ways to reduce this number: >> - reduce the number of elements registered as potentially modified >> + do not add duplicates to org--modified-elements >> + do not add unfolded elements to org--modified-elements >> + register after-change-function as post-command hook and remove it >> from global after-change-functions. This way, it will be called >> twice per command only. >> - determine common region containing org--modified-elements. if change >> is happening within that region, there is no need to parse >> drawers/blocks there again. > > This is over-engineering. Again, please focus on local changes, as > discussed before. > >> Recipe to have different (org-element-at-point) and >> (org-element-parse-buffer 'element) >> ------------------------------------------------------------------------- >> <point-min> >> :PROPERTIES: >> :CREATED: [2020-05-23 Sat 02:32] >> :END: >> >> >> <point-max> >> ------------------------------------------------------------------------- > > I didn't look at this situation in particular, but there are cases where > different :post-blank values are inevitable, for example at the end of > a section. > > Regards, > > -- > Nicolas Goaziou -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-06-02 9:21 ` Ihor Radchenko @ 2020-06-02 9:23 ` Ihor Radchenko 2020-06-02 12:10 ` Bastien 2020-06-02 9:25 ` Ihor Radchenko 2020-06-05 7:26 ` Nicolas Goaziou 2 siblings, 1 reply; 192+ messages in thread From: Ihor Radchenko @ 2020-06-02 9:23 UTC (permalink / raw) To: Nicolas Goaziou; +Cc: emacs-orgmode [-- Attachment #1: Type: text/plain, Size: 44 bytes --] The patch (against 758b039c0) is attached. [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: featuredrawertextprop-20200602.patch --] [-- Type: text/x-diff, Size: 45456 bytes --] diff --git a/contrib/lisp/org-notify.el b/contrib/lisp/org-notify.el index 9f8677871..ab470ea9b 100644 --- a/contrib/lisp/org-notify.el +++ b/contrib/lisp/org-notify.el @@ -246,7 +246,7 @@ seconds. The default value for SECS is 20." (switch-to-buffer (find-file-noselect file)) (org-with-wide-buffer (goto-char begin) - (outline-show-entry)) + (org-show-entry)) (goto-char begin) (search-forward "DEADLINE: <") (search-forward ":") diff --git a/contrib/lisp/org-velocity.el b/contrib/lisp/org-velocity.el index bfc4d6c3e..2312b235c 100644 --- a/contrib/lisp/org-velocity.el +++ b/contrib/lisp/org-velocity.el @@ -325,7 +325,7 @@ use it." (save-excursion (when narrow (org-narrow-to-subtree)) - (outline-show-all))) + (org-show-all))) (defun org-velocity-edit-entry/inline (heading) "Edit entry at HEADING in the original buffer." diff --git a/doc/org-manual.org b/doc/org-manual.org index 92252179b..ff3e31abe 100644 --- a/doc/org-manual.org +++ b/doc/org-manual.org @@ -509,11 +509,11 @@ Org uses just two commands, bound to {{{kbd(TAB)}}} and Switch back to the startup visibility of the buffer (see [[*Initial visibility]]). -- {{{kbd(C-u C-u C-u TAB)}}} (~outline-show-all~) :: +- {{{kbd(C-u C-u C-u TAB)}}} (~org-show-all~) :: #+cindex: show all, command #+kindex: C-u C-u C-u TAB - #+findex: outline-show-all + #+findex: org-show-all Show all, including drawers. - {{{kbd(C-c C-r)}}} (~org-reveal~) :: @@ -529,18 +529,18 @@ Org uses just two commands, bound to {{{kbd(TAB)}}} and headings. With a double prefix argument, also show the entire subtree of the parent. -- {{{kbd(C-c C-k)}}} (~outline-show-branches~) :: +- {{{kbd(C-c C-k)}}} (~org-show-branches~) :: #+cindex: show branches, command #+kindex: C-c C-k - #+findex: outline-show-branches + #+findex: org-show-branches Expose all the headings of the subtree, but not their bodies. -- {{{kbd(C-c TAB)}}} (~outline-show-children~) :: +- {{{kbd(C-c TAB)}}} (~org-show-children~) :: #+cindex: show children, command #+kindex: C-c TAB - #+findex: outline-show-children + #+findex: org-show-children Expose all direct children of the subtree. With a numeric prefix argument {{{var(N)}}}, expose all children down to level {{{var(N)}}}. @@ -7294,7 +7294,7 @@ its location in the outline tree, but behaves in the following way: command (see [[*Visibility Cycling]]). You can force cycling archived subtrees with {{{kbd(C-TAB)}}}, or by setting the option ~org-cycle-open-archived-trees~. Also normal outline commands, like - ~outline-show-all~, open archived subtrees. + ~org-show-all~, open archived subtrees. - #+vindex: org-sparse-tree-open-archived-trees diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index f07c3b801..a9c4d9eb2 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -6824,7 +6824,7 @@ and stored in the variable `org-prefix-format-compiled'." (t " %-12:c%?-12t% s"))) (start 0) varform vars var e c f opt) - (while (string-match "%\\(\\?\\)?\\([-+]?[0-9.]*\\)\\([ .;,:!?=|/<>]?\\)\\([cltseib]\\|(.+)\\)" + (while (string-match "%\\(\\?\\)?\\([-+]?[0-9.]*\\)\\([ .;,:!?=|/<>]?\\)\\([cltseib]\\|(.+?)\\)" s start) (setq var (or (cdr (assoc (match-string 4 s) '(("c" . category) ("t" . time) ("l" . level) ("s" . extra) @@ -9136,20 +9136,20 @@ if it was hidden in the outline." ((and (called-interactively-p 'any) (= more 1)) (message "Remote: show with default settings")) ((= more 2) - (outline-show-entry) + (org-show-entry) (org-show-children) (save-excursion (org-back-to-heading) (run-hook-with-args 'org-cycle-hook 'children)) (message "Remote: CHILDREN")) ((= more 3) - (outline-show-subtree) + (org-show-subtree) (save-excursion (org-back-to-heading) (run-hook-with-args 'org-cycle-hook 'subtree)) (message "Remote: SUBTREE")) ((> more 3) - (outline-show-subtree) + (org-show-subtree) (message "Remote: SUBTREE AND ALL DRAWERS"))) (select-window win))) diff --git a/lisp/org-archive.el b/lisp/org-archive.el index d3e12d17b..d864dad8a 100644 --- a/lisp/org-archive.el +++ b/lisp/org-archive.el @@ -330,7 +330,7 @@ direct children of this heading." (insert (if datetree-date "" "\n") heading "\n") (end-of-line 0)) ;; Make the subtree visible - (outline-show-subtree) + (org-show-subtree) (if org-archive-reversed-order (progn (org-back-to-heading t) diff --git a/lisp/org-colview.el b/lisp/org-colview.el index e50a4d7c8..e656df555 100644 --- a/lisp/org-colview.el +++ b/lisp/org-colview.el @@ -699,7 +699,7 @@ FUN is a function called with no argument." (move-beginning-of-line 2) (org-at-heading-p t))))) (unwind-protect (funcall fun) - (when hide-body (outline-hide-entry))))) + (when hide-body (org-hide-entry))))) (defun org-columns-previous-allowed-value () "Switch to the previous allowed value for this column." diff --git a/lisp/org-compat.el b/lisp/org-compat.el index 635a38dcd..8fe271896 100644 --- a/lisp/org-compat.el +++ b/lisp/org-compat.el @@ -139,12 +139,8 @@ This is a floating point number if the size is too large for an integer." ;;; Emacs < 25.1 compatibility (when (< emacs-major-version 25) - (defalias 'outline-hide-entry 'hide-entry) - (defalias 'outline-hide-sublevels 'hide-sublevels) - (defalias 'outline-hide-subtree 'hide-subtree) (defalias 'outline-show-branches 'show-branches) (defalias 'outline-show-children 'show-children) - (defalias 'outline-show-entry 'show-entry) (defalias 'outline-show-subtree 'show-subtree) (defalias 'xref-find-definitions 'find-tag) (defalias 'format-message 'format) diff --git a/lisp/org-element.el b/lisp/org-element.el index ac41b7650..2d5c8d771 100644 --- a/lisp/org-element.el +++ b/lisp/org-element.el @@ -4320,7 +4320,7 @@ element or object. Meaningful values are `first-section', TYPE is the type of the current element or object. If PARENT? is non-nil, assume the next element or object will be -located inside the current one. " +located inside the current one." (if parent? (pcase type (`headline 'section) diff --git a/lisp/org-keys.el b/lisp/org-keys.el index 37df29983..a714dec0f 100644 --- a/lisp/org-keys.el +++ b/lisp/org-keys.el @@ -437,7 +437,7 @@ COMMANDS is a list of alternating OLDDEF NEWDEF command names." #'org-next-visible-heading) (define-key org-mode-map [remap outline-previous-visible-heading] #'org-previous-visible-heading) -(define-key org-mode-map [remap show-children] #'org-show-children) +(define-key org-mode-map [remap outline-show-children] #'org-show-children) ;;;; Make `C-c C-x' a prefix key (org-defkey org-mode-map (kbd "C-c C-x") (make-sparse-keymap)) diff --git a/lisp/org-macs.el b/lisp/org-macs.el index a02f713ca..681b5a404 100644 --- a/lisp/org-macs.el +++ b/lisp/org-macs.el @@ -682,7 +682,7 @@ When NEXT is non-nil, check the next line instead." \f -;;; Overlays +;;; Overlays and text properties (defun org-overlay-display (ovl text &optional face evap) "Make overlay OVL display TEXT with face FACE." @@ -705,26 +705,138 @@ If DELETE is non-nil, delete all those overlays." (delete (delete-overlay ov)) (t (push ov found)))))) +(defun org-remove-text-properties (start end properties &optional object) + "Remove text properties as in `remove-text-properties', but keep 'invisibility specs for folded regions. +Do not remove invisible text properties specified by 'outline, +'org-hide-block, and 'org-hide-drawer (but remove i.e. 'org-link) this +is needed to keep outlines, drawers, and blocks hidden unless they are +toggled by user. +Note: The below may be too specific and create troubles if more +invisibility specs are added to org in future" + (when (plist-member properties 'invisible) + (let ((pos start) + next spec) + (while (< pos end) + (setq next (next-single-property-change pos 'invisible nil end) + spec (get-text-property pos 'invisible)) + (unless (memq spec (list 'org-hide-block + 'org-hide-drawer + 'outline)) + (remove-text-properties pos next '(invisible nil) object)) + (setq pos next)))) + (when-let ((properties-stripped (org-plist-delete properties 'invisible))) + (remove-text-properties start end properties-stripped object))) + +(defun org--find-text-property-region (pos prop) + "Find a region containing PROP text property around point POS." + (let* ((beg (and (get-text-property pos prop) pos)) + (end beg)) + (when beg + ;; when beg is the first point in the region, `previous-single-property-change' + ;; will return nil. + (setq beg (or (previous-single-property-change pos prop) + beg)) + ;; when end is the last point in the region, `next-single-property-change' + ;; will return nil. + (setq end (or (next-single-property-change pos prop) + end)) + (unless (= beg end) ; this should not happen + (cons beg end))))) + +(defun org--add-to-list-text-property (from to prop element) + "Add element to text property PROP, whos value should be a list." + (add-text-properties from to `(,prop ,(list element))) ; create if none + ;; add to existing + (alter-text-property from to + prop + (lambda (val) + (if (member element val) + val + (cons element val))))) + +(defun org--remove-from-list-text-property (from to prop element) + "Remove ELEMENT from text propery PROP, whos value should be a list." + (let ((pos from)) + (while (< pos to) + (when-let ((val (get-text-property pos prop))) + (if (equal val (list element)) + (remove-text-properties pos (next-single-char-property-change pos prop nil to) (list prop nil)) + (put-text-property pos (next-single-char-property-change pos prop nil to) + prop (remove element (get-text-property pos prop))))) + (setq pos (next-single-char-property-change pos prop nil to))))) + +(defun org--get-buffer-local-text-property-symbol (prop &optional buffer) + "Compute unique symbol suitable to be used as buffer-local in BUFFER for PROP." + (let* ((buf (or buffer (current-buffer)))) + (let ((local-prop-string (format "org--%s-buffer-local-%S" (symbol-name prop) (sxhash buf)))) + (with-current-buffer buf + (unless (string-equal (symbol-name (car (alist-get prop char-property-alias-alist))) + local-prop-string) + (let ((local-prop (make-symbol local-prop-string))) + ;; copy old property + (when-let ((old-prop (car (alist-get prop char-property-alias-alist)))) + (org-with-wide-buffer + (let ((pos (point-min))) + (while (< pos (point-max)) + (when-let (val (get-text-property pos old-prop)) + (put-text-property pos (next-single-char-property-change pos old-prop) local-prop val)) + (setq pos (next-single-char-property-change pos old-prop)))))) + (setq-local char-property-alias-alist + (cons (list prop local-prop) + (remove (assq prop char-property-alias-alist) + char-property-alias-alist))))) + (car (alist-get prop char-property-alias-alist)))))) + (defun org-flag-region (from to flag spec) "Hide or show lines from FROM to TO, according to FLAG. SPEC is the invisibility spec, as a symbol." - (remove-overlays from to 'invisible spec) - ;; Use `front-advance' since text right before to the beginning of - ;; the overlay belongs to the visible line than to the contents. - (when flag - (let ((o (make-overlay from to nil 'front-advance))) - (overlay-put o 'evaporate t) - (overlay-put o 'invisible spec) - (overlay-put o 'isearch-open-invisible #'delete-overlay)))) - + ;; Use text properties instead of overlays for speed. + ;; Overlays are too slow (Emacs Bug#35453). + (with-silent-modifications + ;; keep a backup stack of old text properties + (save-excursion + (goto-char from) + (while (< (point) to) + (let ((old-spec (get-text-property (point) (org--get-buffer-local-text-property-symbol 'invisible))) + (end (next-single-property-change (point) (org--get-buffer-local-text-property-symbol 'invisible) nil to))) + (when old-spec + (alter-text-property (point) end (org--get-buffer-local-text-property-symbol 'org-property-stack-invisible) + (lambda (stack) + (if (or (eq old-spec (car stack)) + (eq spec old-spec) + (eq old-spec 'outline)) + stack + (cons old-spec stack))))) + (goto-char end)))) + + ;; cleanup everything + (remove-text-properties from to (list (org--get-buffer-local-text-property-symbol 'invisible) nil)) + + ;; Recover properties from the backup stack + (unless flag + (save-excursion + (goto-char from) + (while (< (point) to) + (let ((stack (get-text-property (point) (org--get-buffer-local-text-property-symbol 'org-property-stack-invisible))) + (end (next-single-property-change (point) (org--get-buffer-local-text-property-symbol 'org-property-stack-invisible) nil to))) + (if (not stack) + (remove-text-properties (point) end '(org-property-stack-invisible nil)) + (put-text-property (point) end (org--get-buffer-local-text-property-symbol 'invisible) (car stack)) + (alter-text-property (point) end (org--get-buffer-local-text-property-symbol 'org-property-stack-invisible) + (lambda (stack) + (cdr stack)))) + (goto-char end))))) + + (when flag + (put-text-property from to (org--get-buffer-local-text-property-symbol 'invisible) spec)))) \f ;;; Regexp matching (defsubst org-pos-in-match-range (pos n) - (and (match-beginning n) - (<= (match-beginning n) pos) - (>= (match-end n) pos))) +(and (match-beginning n) + (<= (match-beginning n) pos) + (>= (match-end n) pos))) (defun org-skip-whitespace () "Skip over space, tabs and newline characters." diff --git a/lisp/org-src.el b/lisp/org-src.el index 6f6c544dc..9e8a50044 100644 --- a/lisp/org-src.el +++ b/lisp/org-src.el @@ -529,8 +529,8 @@ Leave point in edit buffer." (org-src-switch-to-buffer buffer 'edit) ;; Insert contents. (insert contents) - (remove-text-properties (point-min) (point-max) - '(display nil invisible nil intangible nil)) + (org-remove-text-properties (point-min) (point-max) + '(display nil invisible nil intangible nil)) (unless preserve-ind (org-do-remove-indentation)) (set-buffer-modified-p nil) (setq buffer-file-name nil) diff --git a/lisp/org-table.el b/lisp/org-table.el index 6462b99c4..75801161b 100644 --- a/lisp/org-table.el +++ b/lisp/org-table.el @@ -2001,7 +2001,7 @@ toggle `org-table-follow-field-mode'." (arg (let ((b (save-excursion (skip-chars-backward "^|") (point))) (e (save-excursion (skip-chars-forward "^|\r\n") (point)))) - (remove-text-properties b e '(invisible t intangible t)) + (org-remove-text-properties b e '(invisible t intangible t)) (if (and (boundp 'font-lock-mode) font-lock-mode) (font-lock-fontify-block)))) (t @@ -2028,7 +2028,7 @@ toggle `org-table-follow-field-mode'." (setq word-wrap t) (goto-char (setq p (point-max))) (insert (org-trim field)) - (remove-text-properties p (point-max) '(invisible t intangible t)) + (org-remove-text-properties p (point-max) '(invisible t intangible t)) (goto-char p) (setq-local org-finish-function 'org-table-finish-edit-field) (setq-local org-window-configuration cw) diff --git a/lisp/org.el b/lisp/org.el index f201138f1..6f5aa4b7e 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -114,6 +114,7 @@ Stars are put in group 1 and the trimmed body in group 2.") (declare-function cdlatex-math-symbol "ext:cdlatex") (declare-function Info-goto-node "info" (nodename &optional fork strict-case)) (declare-function isearch-no-upper-case-p "isearch" (string regexp-flag)) +(declare-function isearch-filter-visible "isearch" (beg end)) (declare-function org-add-archive-files "org-archive" (files)) (declare-function org-agenda-entry-get-agenda-timestamp "org-agenda" (pom)) (declare-function org-agenda-list "org-agenda" (&optional arg start-day span with-hour)) @@ -192,6 +193,9 @@ Stars are put in group 1 and the trimmed body in group 2.") (defvar ffap-url-regexp) (defvar org-element-paragraph-separate) +(defvar org-element-all-objects) +(defvar org-element-all-elements) +(defvar org-element-greater-elements) (defvar org-indent-indentation-per-level) (defvar org-radio-target-regexp) (defvar org-target-link-regexp) @@ -4734,9 +4738,174 @@ This is for getting out of special buffers like capture.") ;;;; Define the Org mode +;;; Handling buffer modifications + (defun org-before-change-function (_beg _end) "Every change indicates that a table might need an update." (setq org-table-may-need-update t)) + +(defun org-after-change-function (from to len) + "Hide text in region if it follows and is followedby invisible text." + (when-let ((spec-to (get-text-property to 'invisible)) + (spec-from (get-text-property (max (point-min) (1- from)) 'invisible))) + (when (eq spec-to spec-from) + (org-flag-region from to 't spec-to)))) + + +(defvar org--element-beginning-re-alist `((center-block . "^[ \t]*#\\+begin_center[ \t]*$") + (property-drawer . ,org-property-start-re) + (drawer . ,org-drawer-regexp) + (quote-block . "^[ \t]*#\\+begin_quote[ \t]*$") + (special-block . "^[ \t]*#\\+begin_\\([^ ]+\\).*$")) + "Alist of regexps matching beginning of elements. +Group 1 in the regexps (if any) contains the element type.") + +(defvar org--element-end-re-alist `((center-block . "^[ \t]*#\\+end_center[ \t]*$") + (property-drawer . ,org-property-end-re) + (drawer . ,org-property-end-re) + (quote-block . "^[ \t]*#\\+end_quote[ \t]*$") + (special-block . "^[ \t]*#\\+end_\\([^ ]+\\).*$")) + "Alist of regexps matching end of elements. +Group 1 in the regexps (if any) contains the element type or END.") + +(defvar org-track-element-modifications + `(property-drawer + drawer + center-block + quote-block + special-block) + "Alist of elements to be tracked for modifications. +The modification is only triggered when beginning/end line of the element is modified.") + +(defun org--get-element-region-at-point (types) + "Return TYPES element at point or nil. +If TYPES is a list, return first element at point from the list. The +returned value is partially parsed element only containing :begin and +:end properties. Only elements listed in +org--element-beginning-re-alist and org--element-end-re-alist can be +parsed here." + (catch 'exit + (dolist (type (if (listp types) types (list types))) + (let ((begin-re (alist-get type org--element-beginning-re-alist)) + (end-re (alist-get type org--element-end-re-alist)) + (begin-limit (save-excursion (org-with-limited-levels + (org-back-to-heading-or-point-min 'invisible-ok)) + (point))) + (end-limit (or (save-excursion (outline-next-heading)) + (point-max))) + (point (point)) + begin end) + (when (and begin-re end-re) + (save-excursion + (end-of-line) + (when (re-search-backward begin-re begin-limit 'noerror) (setq begin (point))) + (when (re-search-forward end-re end-limit 'noerror) (setq end (point))) + ;; slurp unmatched begin-re + (when (and begin end) + (goto-char begin) + (while (and (re-search-backward begin-re begin-limit 'noerror) + (= end (save-excursion (re-search-forward end-re end-limit 'noerror)))) + (setq begin (point))) + (when (and (>= point begin) (<= point end)) + (throw 'exit + (let ((begin (copy-marker begin 't)) + (end (copy-marker end nil))) + (list type + (list + :begin begin + :post-affiliated begin + :contents-begin (save-excursion (goto-char begin) (copy-marker (1+ (line-end-position)) + 't)) + :contents-end (save-excursion (goto-char end) (copy-marker (1- (line-beginning-position)) + nil)) + :end end)))))))))))) + +(defun org--get-next-element-region-at-point (types &optional limit previous) + "Return TYPES element after point or nil. +If TYPES is a list, return first element after point from the list. +If PREVIOUS is non-nil, return first TYPES element before point. +Limit search by LIMIT or previous/next heading. +The returned value is partially parsed element only containing :begin +and :end properties. Only elements listed in +org--element-beginning-re-alist and org--element-end-re-alist can be +parsed here." + (catch 'exit + (dolist (type (if (listp types) types (list types))) + (let* ((begin-re (alist-get type org--element-beginning-re-alist)) + (end-re (alist-get type org--element-end-re-alist)) + (limit (or limit (if previous + (save-excursion + (org-with-limited-levels + (org-back-to-heading-or-point-min 'invisible-ok) + (point))) + (or (save-excursion (outline-next-heading)) + (point-max))))) + el) + (when (and begin-re end-re) + (save-excursion + (if previous + (when (re-search-backward begin-re limit 'noerror) + (setq el (org--get-element-region-at-point type))) + (when (re-search-forward begin-re limit 'noerror) + (setq el (org--get-element-region-at-point type))))) + (when el + (throw 'exit + el))))))) + +(defun org--find-elements-in-region (beg end elements &optional include-partial include-neighbours) + "Find all elements from ELEMENTS in region BEG . END. +All the listed elements must be resolvable by +`org--get-element-region-at-point'. +Include elements if they are partially inside region when +INCLUDE-PARTIAL is non-nil. +Include preceding/subsequent neighbouring elements when no partial +element is found at the beginning/end of the region and +INCLUDE-NEIGHBOURS is non-nil." + (when include-partial + (org-with-point-at beg + (let ((new-beg (org-element-property :begin (org--get-element-region-at-point elements)))) + (if new-beg + (setq beg new-beg) + (when (and include-neighbours + (setq new-beg (org-element-property :begin + (org--get-next-element-region-at-point elements + (point-min) + 'previous)))) + (setq beg new-beg)))) + (when (memq 'headline elements) + (when-let ((new-beg (save-excursion + (org-with-limited-levels (outline-previous-heading))))) + (setq beg new-beg)))) + (org-with-point-at end + (let ((new-end (org-element-property :end (org--get-element-region-at-point elements)))) + (if new-end + (setq end new-end) + (when (and include-neighbours + (setq new-end (org-element-property :end + (org--get-next-element-region-at-point elements (point-max))))) + (setq end new-end)))) + (when (memq 'headline elements) + (when-let ((new-end (org-with-limited-levels (outline-next-heading)))) + (setq end (1- new-end)))))) + (save-excursion + (save-restriction + (narrow-to-region beg end) + (goto-char (point-min)) + (let (result el) + (while (setq el (org--get-next-element-region-at-point elements end)) + (push el result) + (goto-char (org-element-property :end el))) + result)))) + +(defun org--unfold-elements-in-region (el &rest _) + "Unfold EL element." + (when-let ((category (if (string-match-p "block" (symbol-name (org-element-type el))) + 'block + (when (string-match-p "drawer" (symbol-name (org-element-type el))) + 'drawer)))) + (org-with-point-at (org-element-property :begin el) + (org--hide-wrapper-toggle el category 'off nil)))) + (defvar org-mode-map) (defvar org-inhibit-startup-visibility-stuff nil) ; Dynamically-scoped param. (defvar org-agenda-keep-modes nil) ; Dynamically-scoped param. @@ -4818,6 +4987,8 @@ The following commands are available: ;; Activate before-change-function (setq-local org-table-may-need-update t) (add-hook 'before-change-functions 'org-before-change-function nil 'local) + ;; Activate after-change-function + (add-hook 'after-change-functions 'org-after-change-function nil 'local) ;; Check for running clock before killing a buffer (add-hook 'kill-buffer-hook 'org-check-running-clock nil 'local) ;; Initialize macros templates. @@ -4869,6 +5040,10 @@ The following commands are available: (setq-local outline-isearch-open-invisible-function (lambda (&rest _) (org-show-context 'isearch))) + ;; Make isearch search in blocks hidden via text properties + (setq-local isearch-filter-predicate #'org--isearch-filter-predicate) + (add-hook 'isearch-mode-end-hook #'org--clear-isearch-overlays nil 'local) + ;; Setup the pcomplete hooks (setq-local pcomplete-command-completion-function #'org-pcomplete-initial) (setq-local pcomplete-command-name-function #'org-command-at-point) @@ -5050,8 +5225,8 @@ stacked delimiters is N. Escaping delimiters is not possible." (when verbatim? (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) - (remove-text-properties (match-beginning 2) (match-end 2) - '(display t invisible t intangible t))) + (org-remove-text-properties (match-beginning 2) (match-end 2) + '(display t invisible t intangible t))) (add-text-properties (match-beginning 2) (match-end 2) '(font-lock-multiline t org-emphasis t)) (when (and org-hide-emphasis-markers @@ -5166,7 +5341,7 @@ This includes angle, plain, and bracket links." (if (not (eq 'bracket style)) (add-text-properties start end properties) ;; Handle invisible parts in bracket links. - (remove-text-properties start end '(invisible nil)) + (org-remove-text-properties start end '(invisible nil)) (let ((hidden (append `(invisible ,(or (org-link-get-parameter type :display) @@ -5186,8 +5361,8 @@ This includes angle, plain, and bracket links." (defun org-activate-code (limit) (when (re-search-forward "^[ \t]*\\(:\\(?: .*\\|$\\)\n?\\)" limit t) (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) - (remove-text-properties (match-beginning 0) (match-end 0) - '(display t invisible t intangible t)) + (org-remove-text-properties (match-beginning 0) (match-end 0) + '(display t invisible t intangible t)) t)) (defcustom org-src-fontify-natively t @@ -5258,8 +5433,8 @@ by a #." (setq block-end (match-beginning 0)) ; includes the final newline. (when quoting (org-remove-flyspell-overlays-in bol-after-beginline nl-before-endline) - (remove-text-properties beg end-of-endline - '(display t invisible t intangible t))) + (org-remove-text-properties beg end-of-endline + '(display t invisible t intangible t))) (add-text-properties beg end-of-endline '(font-lock-fontified t font-lock-multiline t)) (org-remove-flyspell-overlays-in beg bol-after-beginline) @@ -5313,9 +5488,9 @@ by a #." '(font-lock-fontified t face org-document-info)))) ((string-prefix-p "+caption" dc1) (org-remove-flyspell-overlays-in (match-end 2) (match-end 0)) - (remove-text-properties (match-beginning 0) (match-end 0) - '(display t invisible t intangible t)) - ;; Handle short captions + (org-remove-text-properties (match-beginning 0) (match-end 0) + '(display t invisible t intangible t)) + ;; Handle short captions. (save-excursion (beginning-of-line) (looking-at (rx (group (zero-or-more blank) @@ -5336,8 +5511,8 @@ by a #." '(font-lock-fontified t face font-lock-comment-face))) (t ;; Just any other in-buffer setting, but not indented (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) - (remove-text-properties (match-beginning 0) (match-end 0) - '(display t invisible t intangible t)) + (org-remove-text-properties (match-beginning 0) (match-end 0) + '(display t invisible t intangible t)) (add-text-properties beg (match-end 0) '(font-lock-fontified t face org-meta-line)) t)))))) @@ -5859,10 +6034,11 @@ If TAG is a number, get the corresponding match group." (inhibit-modification-hooks t) deactivate-mark buffer-file-name buffer-file-truename) (decompose-region beg end) - (remove-text-properties beg end - '(mouse-face t keymap t org-linked-text t - invisible t intangible t - org-emphasis t)) + (org-remove-text-properties beg end + '(mouse-face t keymap t org-linked-text t + invisible t + intangible t + org-emphasis t)) (org-remove-font-lock-display-properties beg end))) (defconst org-script-display '(((raise -0.3) (height 0.7)) @@ -5970,6 +6146,29 @@ open and agenda-wise Org files." ;;;; Headlines visibility +(defun org-hide-entry () + "Hide the body directly following this heading." + (interactive) + (save-excursion + (outline-back-to-heading) + (outline-end-of-heading) + (org-flag-region (point) (progn (outline-next-preface) (point)) t 'outline))) + +(defun org-hide-subtree () + "Hide everything after this heading at deeper levels." + (interactive) + (org-flag-subtree t)) + +(defun org-hide-sublevels (levels) + "Hide everything but the top LEVELS levels of headers, in whole buffer. +This also unhides the top heading-less body, if any. + +Interactively, the prefix argument supplies the value of LEVELS. +When invoked without a prefix argument, LEVELS defaults to the level +of the current heading, or to 1 if the current line is not a heading." + (cl-letf (((symbol-function 'outline-flag-region) #'org-flag-region)) + (org-hide-sublevels levels))) + (defun org-show-entry () "Show the body directly following this heading. Show the heading too, if it is currently invisible." @@ -5988,6 +6187,17 @@ Show the heading too, if it is currently invisible." 'outline) (org-cycle-hide-property-drawers 'children)))) +(defun org-show-heading () + "Show the current heading and move to its end." + (org-flag-region (- (point) + (if (bobp) 0 + (if (and outline-blank-line + (eq (char-before (1- (point))) ?\n)) + 2 1))) + (progn (outline-end-of-heading) (point)) + nil + 'outline)) + (defun org-show-children (&optional level) "Show all direct subheadings of this heading. Prefix arg LEVEL is how many levels below the current level @@ -6031,6 +6241,11 @@ heading to appear." (org-flag-region (point) (save-excursion (org-end-of-subtree t t)) nil 'outline)) +(defun org-show-branches () + "Show all subheadings of this heading, but not their bodies." + (interactive) + (org-show-children 1000)) + ;;;; Blocks and drawers visibility (defun org--hide-wrapper-toggle (element category force no-error) @@ -6064,13 +6279,39 @@ Return a non-nil value when toggling is successful." (unless (let ((eol (line-end-position))) (and (> eol start) (/= eol end))) (let* ((spec (cond ((eq category 'block) 'org-hide-block) - ((eq type 'property-drawer) 'outline) - (t 'org-hide-drawer))) + ((eq category 'drawer) 'org-hide-drawer) + (t 'outline))) (flag (cond ((eq force 'off) nil) (force t) ((eq (get-char-property start 'invisible) spec) nil) (t t)))) + ;; Make beginning/end of blocks sensitive to modifications + ;; we never remove the hooks because modification of parts + ;; of blocks is practically more rare in comparison with + ;; folding/unfolding. Removing modification hooks would + ;; cost more CPU time. + (when flag + (with-silent-modifications + (let ((el (org--get-element-region-at-point + (org-element-type element)))) + (unless (member (apply-partially #'org--unfold-elements-in-region el) + (get-text-property (org-element-property :begin element) + 'modification-hooks)) + ;; first line + (org--add-to-list-text-property (org-element-property :begin element) start + 'modification-hooks + (apply-partially #'org--unfold-elements-in-region el)) + (org--add-to-list-text-property (org-element-property :begin element) start + 'insert-behind-hooks + (apply-partially #'org--unfold-elements-in-region el)) + ;; last line + (org--add-to-list-text-property (save-excursion (goto-char end) (line-beginning-position)) end + 'modification-hooks + (apply-partially #'org--unfold-elements-in-region el)) + (org--add-to-list-text-property (save-excursion (goto-char end) (line-beginning-position)) end + 'insert-behind-hooks + (apply-partially #'org--unfold-elements-in-region el)))))) (org-flag-region start end flag spec)) ;; When the block is hidden away, make sure point is left in ;; a visible part of the buffer. @@ -6118,24 +6359,16 @@ Return a non-nil value when toggling is successful." (defun org-hide-drawer-all () "Fold all drawers in the current buffer." - (org-show-all '(drawers)) (save-excursion (goto-char (point-min)) (while (re-search-forward org-drawer-regexp nil t) - (let* ((drawer (org-element-at-point)) - (type (org-element-type drawer))) - (when (memq type '(drawer property-drawer)) - ;; We are sure regular drawers are unfolded because of - ;; `org-show-all' call above. However, property drawers may - ;; be folded, or in a folded headline. In that case, do not - ;; re-hide it. - (unless (and (eq type 'property-drawer) - (eq 'outline (get-char-property (point) 'invisible))) - (org-hide-drawer-toggle t nil drawer)) - ;; Make sure to skip drawer entirely or we might flag it - ;; another time when matching its ending line with - ;; `org-drawer-regexp'. - (goto-char (org-element-property :end drawer))))))) + (when-let* ((drawer (org--get-element-region-at-point '(property-drawer drawer))) + (type (org-element-type drawer))) + (org-hide-drawer-toggle t nil drawer) + ;; Make sure to skip drawer entirely or we might flag it + ;; another time when matching its ending line with + ;; `org-drawer-regexp'. + (goto-char (org-element-property :end drawer)))))) (defun org-cycle-hide-property-drawers (state) "Re-hide all drawers after a visibility state change. @@ -6150,18 +6383,16 @@ STATE should be one of the symbols listed in the docstring of (t (save-excursion (org-end-of-subtree t)))))) (org-with-point-at beg (while (re-search-forward org-property-start-re end t) - (pcase (get-char-property-and-overlay (point) 'invisible) + (pcase (get-char-property (point) 'invisible) ;; Do not fold already folded drawers. - (`(outline . ,o) (goto-char (overlay-end o))) + ('outline + (goto-char (min end (next-single-char-property-change (point) 'invisible)))) (_ (let ((start (match-end 0))) (when (org-at-property-drawer-p) (let* ((case-fold-search t) (end (re-search-forward org-property-end-re))) - ;; Property drawers use `outline' invisibility spec - ;; so they can be swallowed once we hide the - ;; outline. - (org-flag-region start end t 'outline))))))))))) + (org-flag-region start end t 'org-hide-drawer))))))))))) ;;;; Visibility cycling @@ -6536,7 +6767,7 @@ With a numeric prefix, show all headlines up to that level." (org-narrow-to-subtree) (org-content)))) ((or "all" "showall") - (outline-show-subtree)) + (org-show-subtree)) (_ nil))) (org-end-of-subtree))))))) @@ -6609,7 +6840,7 @@ This function is the default value of the hook `org-cycle-hook'." (while (re-search-forward re nil t) (when (and (not (org-invisible-p)) (org-invisible-p (line-end-position))) - (outline-hide-entry)))) + (org-hide-entry)))) (org-cycle-hide-property-drawers 'all) (org-cycle-show-empty-lines 'overview))))) @@ -6681,10 +6912,11 @@ information." (org-show-entry) ;; If point is hidden within a drawer or a block, make sure to ;; expose it. - (dolist (o (overlays-at (point))) - (when (memq (overlay-get o 'invisible) - '(org-hide-block org-hide-drawer outline)) - (delete-overlay o))) + (when (memq (get-text-property (point) 'invisible) + '(org-hide-block org-hide-drawer)) + (let ((spec (get-text-property (point) 'invisible)) + (region (org--find-text-property-region (point) 'invisible))) + (org-flag-region (car region) (cdr region) nil spec))) (unless (org-before-first-heading-p) (org-with-limited-levels (cl-case detail @@ -6900,9 +7132,10 @@ unconditionally." ;; When INVISIBLE-OK is non-nil, ensure newly created headline ;; is visible. (unless invisible-ok - (pcase (get-char-property-and-overlay (point) 'invisible) - (`(outline . ,o) - (move-overlay o (overlay-start o) (line-end-position 0))) + (pcase (get-char-property (point) 'invisible) + ('outline + (let ((region (org--find-text-property-region (point) 'invisible))) + (org-flag-region (line-end-position 0) (cdr region) nil 'outline))) (_ nil)))) ;; At a headline... ((org-at-heading-p) @@ -7499,7 +7732,6 @@ case." (setq txt (buffer-substring beg end)) (org-save-markers-in-region beg end) (delete-region beg end) - (org-remove-empty-overlays-at beg) (unless (= beg (point-min)) (org-flag-region (1- beg) beg nil 'outline)) (unless (bobp) (org-flag-region (1- (point)) (point) nil 'outline)) (and (not (bolp)) (looking-at "\n") (forward-char 1)) @@ -7661,7 +7893,7 @@ When REMOVE is non-nil, remove the subtree from the clipboard." (skip-chars-forward " \t\n\r") (setq beg (point)) (when (and (org-invisible-p) visp) - (save-excursion (outline-show-heading))) + (save-excursion (org-show-heading))) ;; Shift if necessary. (unless (= shift 0) (save-restriction @@ -8103,7 +8335,7 @@ function is being called interactively." (point)) what "children") (goto-char start) - (outline-show-subtree) + (org-show-subtree) (outline-next-heading)) (t ;; we will sort the top-level entries in this file @@ -13158,7 +13390,7 @@ drawer is immediately hidden." (inhibit-read-only t)) (unless (bobp) (insert "\n")) (insert ":PROPERTIES:\n:END:") - (org-flag-region (line-end-position 0) (point) t 'outline) + (org-flag-region (line-end-position 0) (point) t 'org-hide-drawer) (when (or (eobp) (= begin (point-min))) (insert "\n")) (org-indent-region begin (point)))))) @@ -17621,11 +17853,11 @@ Move point to the beginning of first heading or end of buffer." (defun org-show-branches-buffer () "Show all branches in the buffer." (org-flag-above-first-heading) - (outline-hide-sublevels 1) + (org-hide-sublevels 1) (unless (eobp) - (outline-show-branches) + (org-show-branches) (while (outline-get-next-sibling) - (outline-show-branches))) + (org-show-branches))) (goto-char (point-min))) (defun org-kill-note-or-show-branches () @@ -17639,8 +17871,8 @@ Move point to the beginning of first heading or end of buffer." (t (let ((beg (progn (org-back-to-heading) (point))) (end (save-excursion (org-end-of-subtree t t) (point)))) - (outline-hide-subtree) - (outline-show-branches) + (org-hide-subtree) + (org-show-branches) (org-hide-archived-subtrees beg end))))) (defun org-delete-indentation (&optional arg) @@ -17796,9 +18028,9 @@ Otherwise, call `org-show-children'. ARG is the level to hide." (if (org-before-first-heading-p) (progn (org-flag-above-first-heading) - (outline-hide-sublevels (or arg 1)) + (org-hide-sublevels (or arg 1)) (goto-char (point-min))) - (outline-hide-subtree) + (org-hide-subtree) (org-show-children arg)))) (defun org-ctrl-c-star () @@ -20475,17 +20707,17 @@ With ARG, repeats or can move backward if negative." (end-of-line)) (while (and (< arg 0) (re-search-backward regexp nil :move)) (unless (bobp) - (pcase (get-char-property-and-overlay (point) 'invisible) - (`(outline . ,o) - (goto-char (overlay-start o)) + (pcase (get-char-property (point) 'invisible) + ('outline + (goto-char (car (org--find-text-property-region (point) 'invisible))) (beginning-of-line)) (_ nil))) (cl-incf arg)) - (while (and (> arg 0) (re-search-forward regexp nil t)) - (pcase (get-char-property-and-overlay (point) 'invisible) - (`(outline . ,o) - (goto-char (overlay-end o)) - (skip-chars-forward " \t\n") + (while (and (> arg 0) (re-search-forward regexp nil :move)) + (pcase (get-char-property (point) 'invisible) + ('outline + (goto-char (cdr (org--find-text-property-region (point) 'invisible))) + (skip-chars-forward " \t\n") (end-of-line)) (_ (end-of-line))) @@ -20943,6 +21175,80 @@ Started from `gnus-info-find-node'." (t default-org-info-node)))))) \f + +;;; Make isearch search in some text hidden via text propertoes + +(defvar org--isearch-overlays nil + "List of overlays temporarily created during isearch. +This is used to allow searching in regions hidden via text properties. +As for [2020-05-09 Sat], Isearch only has special handling of hidden overlays. +Any text hidden via text properties is not revealed even if `search-invisible' +is set to 't.") + +;; Not sure if it needs to be a user option +;; One might want to reveal hidden text in, for example, hidden parts of the links. +;; Currently, hidden text in links is never revealed by isearch. +(defvar org-isearch-specs '(org-hide-block + org-hide-drawer) + "List of text invisibility specs to be searched by isearch. +By default ([2020-05-09 Sat]), isearch does not search in hidden text, +which was made invisible using text properties. Isearch will be forced +to search in hidden text with any of the listed 'invisible property value.") + +(defun org--create-isearch-overlays (beg end) + "Replace text property invisibility spec by overlays between BEG and END. +All the regions with invisibility text property spec from +`org-isearch-specs' will be changed to use overlays instead +of text properties. The created overlays will be stored in +`org--isearch-overlays'." + (let ((pos beg)) + (while (< pos end) + (when-let* ((spec (get-text-property pos 'invisible)) + (spec (memq spec org-isearch-specs)) + (region (org--find-text-property-region pos 'invisible))) + (setq spec (get-text-property pos 'invisible)) + ;; Changing text properties is considered buffer modification. + ;; We do not want it here. + (with-silent-modifications + ;; The overlay is modelled after `org-flag-region' [2020-05-09 Sat] + ;; overlay for 'outline blocks. + (let ((o (make-overlay (car region) (cdr region) nil 'front-advance))) + (overlay-put o 'evaporate t) + (overlay-put o 'invisible spec) + ;; `delete-overlay' here means that spec information will be lost + ;; for the region. The region will remain visible. + (overlay-put o 'isearch-open-invisible #'delete-overlay) + (push o org--isearch-overlays)) + (org-flag-region (car region) (cdr region) nil spec))) + (setq pos (next-single-property-change pos 'invisible nil end))))) + +(defun org--isearch-filter-predicate (beg end) + "Return non-nil if text between BEG and END is deemed visible by Isearch. +This function is intended to be used as `isearch-filter-predicate'. +Unlike `isearch-filter-visible', make text with 'invisible text property +value listed in `org-isearch-specs' visible to Isearch." + (org--create-isearch-overlays beg end) ;; trick isearch by creating overlays in place of invisible text + (isearch-filter-visible beg end)) + +(defun org--clear-isearch-overlay (ov) + "Convert OV region back into using text properties." + (when-let ((spec (overlay-get ov 'invisible))) ;; ignore deleted overlays + ;; Changing text properties is considered buffer modification. + ;; We do not want it here. + (with-silent-modifications + (org-flag-region (overlay-start ov) (overlay-end ov) t spec))) + (when (member ov isearch-opened-overlays) + (setq isearch-opened-overlays (delete ov isearch-opened-overlays))) + (delete-overlay ov)) + +(defun org--clear-isearch-overlays () + "Convert overlays from `org--isearch-overlays' back into using text properties." + (when org--isearch-overlays + (mapc #'org--clear-isearch-overlay org--isearch-overlays) + (setq org--isearch-overlays nil))) + +\f + ;;; Finish up (add-hook 'org-mode-hook ;remove overlays when changing major mode [-- Attachment #3: Type: text/plain, Size: 17692 bytes --] Ihor Radchenko <yantar92@gmail.com> writes: > Hello, > > [The patch itself will be provided in the following email] > > I have three updates from the previous version of the patch: > > 1. I managed to implement buffer-local text properties. > Now, outline folding also uses text properties without a need to give > up independent folding in indirect buffers. > > 2. The code handling modifications in folded drawers/blocks was > rewritten. The new code uses after-change-functions to re-hide text > inserted in the middle of folded regions; and text properties to > unfold folded drawers/blocks if one changes BEGIN/END line. > > 3. [experimental] Started working on improving memory and cpu footprint > of the old code related to folding/unfolding. org-hide-drawer-all now > works significantly faster because I can utilise simplified drawer > parser, which require a lot less memory. Overall, I managed to reduce > Emacs memory footprint after loading all my agenda_files twice. The > loading is also noticeably faster. > > ----------------------------------------------------------------------- > ----------------------------------------------------------------------- > > More details on the buffer-local text properties: > > I have found char-property-alias-alist variable that controls how Emacs > calculates text property value if the property is not set. This variable > can be buffer-local, which allows independent 'invisible states in > different buffers. > > All the implementation stays in > org--get-buffer-local-text-property-symbol, which takes care about > generating unique property name and mapping it to 'invisible (or any > other) text property. > > ----------------------------------------------------------------------- > ----------------------------------------------------------------------- > > More details on the new implementation for tracking changes: > > I simplified the code as suggested, without using pairs of before- and > after-change-functions. > > Handling text inserted into folded/invisible region is handled by a > simple after-change function. After testing, it turned out that simple > re-hiding text based on 'invisible property of the text before/after the > inserted region works pretty well. > > Modifications to BEGIN/END line of the drawers and blocks is handled via > 'modification-hooks + 'insert-behind-hooks text properties (there is no > after-change-functions analogue for text properties in Emacs). The > property is applied during folding and the modification-hook function is > made aware about the drawer/block boundaries (via apply-partially > passing element containing :begin :end markers for the current > drawer/block). Passing the element boundary is important because the > 'modification-hook will not directly know where it belongs to. Only the > modified region (which can be larger than the drawer) is passed to the > function. In the worst case, the region can be the whole buffer (if one > runs revert-buffer). > > It turned out that adding 'modification-hook text property takes a > significant cpu time (partially, because we need to take care about > possible existing 'modification-hook value, see > org--add-to-list-text-property). For now, I decided to not clear the > modification hooks during unfolding because of poor performance. > However, this approach would lead to partial unfolding in the following > case: > > :asd: > :drawer: > lksjdfksdfjl > sdfsdfsdf > :end: > > If :asd: was inserted in front of folded :drawer:, changes in :drawer: > line of the new folded :asd: drawer would reveal the text between > :drawer: and :end:. > > Let me know what you think on this. > >> You shouldn't be bothered by the case you're describing here, for >> multiple reasons. >> >> First, this issue already arises in the current implementation. No one >> bothered so far: this change is very unlikely to happen. If it becomes >> an issue, we could make sure that `org-reveal' handles this. >> >> But, more importantly, we actually /want it/ as a feature. Indeed, if >> DRAWER is expanded every time ":BLAH:" is inserted above, then inserting >> a drawer manually would unfold /all/ drawers in the section. The user is >> more likely to write first ":BLAH:" (everything is unfolded) then >> ":END:" than ":END:", then ":BLAH:". > > Agree. This allowed me to simplify the code significantly. > >> It seems you're getting it backwards. `before-change-functions' are the >> functions being called with a possibly wide, imprecise, region to >> handle: >> >> When that happens, the arguments to ‘before-change-functions’ will >> enclose a region in which the individual changes are made, but won’t >> necessarily be the minimal such region >> >> however, after-change-functions calls are always minimal: >> >> and the arguments to each successive call of >> ‘after-change-functions’ will then delimit the part of text being >> changed exactly. >> >> If you stick to `after-change-functions', there will be no such thing as >> you describe. > > You are right here, I missed that before-change-functions are likely to > be called on large regions. I thought that the regions are same for > before/after-change-functions, but after-change-functions could be > called more than 1 time. After second thought, your vision that it is > mostly 0 or 1 times should be the majority of cases in practice. > > ----------------------------------------------------------------------- > ----------------------------------------------------------------------- > > More details on reducing cpu and memory footprint of org buffers: > > My simplified implementation of element boundary parser > (org--get-element-region-at-point) appears to be much faster and also > uses much less memory in comparison with org-element-at-point. > Moreover, not all the places where org-element-at-point is called > actually need the full parsed element. For example, org-hide-drawer-all, > org-hide-drawer-toggle, org-hide-block-toggle, and > org--hide-wrapper-toggle only need element type and some information > about the element boundaries - the information we can get from > org--get-element-region-at-point. > > The following version of org-hide-drawer-all seems to work much faster > in comparison with original: > > (defun org-hide-drawer-all () > "Fold all drawers in the current buffer." > (save-excursion > (goto-char (point-min)) > (while (re-search-forward org-drawer-regexp nil t) > (when-let* ((drawer (org--get-element-region-at-point '(property-drawer drawer))) > (type (org-element-type drawer))) > (org-hide-drawer-toggle t nil drawer) > ;; Make sure to skip drawer entirely or we might flag it > ;; another time when matching its ending line with > ;; `org-drawer-regexp'. > (goto-char (org-element-property :end drawer)))))) > > What do you think about the idea of making use of > org--get-element-region-at-point in org code base? > > ----------------------------------------------------------------------- > ----------------------------------------------------------------------- > > Further work: > > 1. Look into other code using overlays. Specifically, > org-toggle-custom-properties, Babel hashes, and narrowed table columns. > > Best, > Ihor > > Nicolas Goaziou <mail@nicolasgoaziou.fr> writes: > >> Hello, >> >> Ihor Radchenko <yantar92@gmail.com> writes: >> >>> I have five updates from the previous version of the patch: >> >> Thank you. >> >>> 1. I implemented a simplified version of element parsing to detect >>> changes in folded drawers or blocks. No computationally expensive calls >>> of org-element-at-point or org-element-parse-buffer are needed now. >>> >>> 2. The patch is now compatible with master (commit 2e96dc639). I >>> reverted the earlier change in folding drawers and blocks. Now, they are >>> back to using 'org-hide-block and 'org-hide-drawer. Using 'outline would >>> achieve nothing when we use text properties. >>> >>> 3. 'invisible text property can now be nested. This is important, for >>> example, when text inside drawers contains fontified links (which also >>> use 'invisible text property to hide parts of the link). Now, the old >>> 'invisible spec is recovered after unfolding. >> >> Interesting. I'm running out of time, so I cannot properly inspect the >> code right now. I'll try to do that before the end of the week. >> >>> 4. Some outline-* function calls in org referred to outline-flag-region >>> implementation, which is not in sync with org-flag-region in this patch. >>> I have implemented their org-* versions and replaced the calls >>> throughout .el files. Actually, some org-* versions were already >>> implemented in org, but not used for some reason (or not mentioned in >>> the manual). I have updated the relevant sections of manual. These >>> changes might be relevant to org independently of this feature branch. >> >> Yes, we certainly want to move to org-specific versions in all cases. >> >>> 5. I have managed to get a working version of outline folding via text >>> properties. However, that approach has a big downside - folding state >>> cannot be different in indirect buffer when we use text properties. I >>> have seen packages relying on this feature of org and I do not see any >>> obvious way to achieve different folding state in indirect buffer while >>> using text properties for outline folding. >> >> Hmm. Good point. This is a serious issue to consider. Even if we don't >> use text properties for outline, this also affects drawers and blocks. >> >>> For now, I still used before/after-change-functions combination. >> >> You shouldn't. >> >>> I see the following problems with using only after-change-functions: >>> >>> 1. They are not guaranteed to be called after every single change: >> >> Of course they are! See below. >> >>> From (elisp) Change Hooks: >>> "... some complex primitives call ‘before-change-functions’ once before >>> making changes, and then call ‘after-change-functions’ zero or more >>> times" >> >> "zero" means there are no changes at all, so, `after-change-functions' >> are not called, which is expected. >> >>> The consequence of it is a possibility that region passed to the >>> after-change-functions is quite big (including all the singular changes, >>> even if they are distant). This region may contain changed drawers as >>> well and unchanged drawers and needs to be parsed to determine which >>> drawers need to be re-folded. >> >> It seems you're getting it backwards. `before-change-functions' are the >> functions being called with a possibly wide, imprecise, region to >> handle: >> >> When that happens, the arguments to ‘before-change-functions’ will >> enclose a region in which the individual changes are made, but won’t >> necessarily be the minimal such region >> >> however, after-change-functions calls are always minimal: >> >> and the arguments to each successive call of >> ‘after-change-functions’ will then delimit the part of text being >> changed exactly. >> >> If you stick to `after-change-functions', there will be no such thing as >> you describe. >> >>>> And, more importantly, they are not meant to be used together, i.e., you >>>> cannot assume that a single call to `before-change-functions' always >>>> happens before calling `after-change-functions'. This can be tricky if >>>> you want to use the former to pass information to the latter. >>> >>> The fact that before-change-functions can be called multiple times >>> before after-change-functions, is trivially solved by using buffer-local >>> changes register (see org--modified-elements). >> >> Famous last words. Been there, done that, and it failed. >> >> Let me quote the manual: >> >> In general, we advise to use either before- or the after-change >> hooks, but not both. >> >> So, let me insist: don't do that. If you don't agree with me, let's at >> least agree with Emacs developers. >> >>> The register is populated by before-change-functions and cleared by >>> after-change-functions. >> >> You cannot expect `after-change-functions' to clear what >> `before-change-functions' did. This is likely to introduce pernicious >> bugs. Sorry if it sounds like FUD, but bugs in those areas are just >> horrible to squash. >> >>>> Well, `before-change-fuctions' and `after-change-functions' are not >>>> clean at all: you modify an unrelated part of the buffer, but still call >>>> those to check if a drawer needs to be unfolded somewhere. >>> >>> 2. As you pointed, instead of global before-change-functions, we can use >>> modification-hooks text property on sensitive parts of the >>> drawers/blocks. This would work, but I am concerned about one annoying >>> special case: >>> >>> ------------------------------------------------------------------------- >>> :BLAH: <inserted outside any of the existing drawers> >>> >>> <some text> >>> >>> :DRAWER: <folded> >>> Donec at pede. >>> :END: >>> ------------------------------------------------------------------------- >>> In this example, the user would not be able to unfold the folder DRAWER >>> because it will technically become a part of a new giant BLAH drawer. >>> This may be especially annoying if <some text> is more than one screen >>> long and there is no easy way to identify why unfolding does not work >>> (with point at :DRAWER:). >> >> You shouldn't be bothered by the case you're describing here, for >> multiple reasons. >> >> First, this issue already arises in the current implementation. No one >> bothered so far: this change is very unlikely to happen. If it becomes >> an issue, we could make sure that `org-reveal' handles this. >> >> But, more importantly, we actually /want it/ as a feature. Indeed, if >> DRAWER is expanded every time ":BLAH:" is inserted above, then inserting >> a drawer manually would unfold /all/ drawers in the section. The user is >> more likely to write first ":BLAH:" (everything is unfolded) then >> ":END:" than ":END:", then ":BLAH:". >> >>> Because of this scenario, limiting before-change-functions to folded >>> drawers is not sufficient. Any change in text may need to trigger >>> unfolding. >> >> after-change-functions is more appropriate than before-change-functions, >> and local parsing, as explained in this thread, is more efficient than >> re-inventing the parser. >> >>> In the patch, I always register possible modifications in the >>> blocks/drawers intersecting with the modified region + a drawer/block >>> right next to the region. >>> >>> ----------------------------------------------------------------------- >>> ----------------------------------------------------------------------- >>> >>> More details on the nested 'invisible text property implementation. >>> >>> The idea is to keep 'invisible property stack push and popping from it >>> as we add/remove 'invisible text property. All the work is done in >>> org-flag-region. >> >> This sounds like a good idea. >> >>> This was originally intended for folding outlines via text properties. >>> Since using text properties for folding outlines is not a good idea, >>> nested text properties have much less use. >> >> AFAIU, they have. You mention link fontification, but there are other >> pieces that we could switch to text properties instead of overlays, >> e.g., Babel hashes, narrowed table columns… >> >>> 3. Multiple calls to before/after-change-functions is still a problem. I >>> am looking into following ways to reduce this number: >>> - reduce the number of elements registered as potentially modified >>> + do not add duplicates to org--modified-elements >>> + do not add unfolded elements to org--modified-elements >>> + register after-change-function as post-command hook and remove it >>> from global after-change-functions. This way, it will be called >>> twice per command only. >>> - determine common region containing org--modified-elements. if change >>> is happening within that region, there is no need to parse >>> drawers/blocks there again. >> >> This is over-engineering. Again, please focus on local changes, as >> discussed before. >> >>> Recipe to have different (org-element-at-point) and >>> (org-element-parse-buffer 'element) >>> ------------------------------------------------------------------------- >>> <point-min> >>> :PROPERTIES: >>> :CREATED: [2020-05-23 Sat 02:32] >>> :END: >>> >>> >>> <point-max> >>> ------------------------------------------------------------------------- >> >> I didn't look at this situation in particular, but there are cases where >> different :post-blank values are inevitable, for example at the end of >> a section. >> >> Regards, >> >> -- >> Nicolas Goaziou > > -- > Ihor Radchenko, > PhD, > Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) > State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China > Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply related [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-06-02 9:23 ` Ihor Radchenko @ 2020-06-02 12:10 ` Bastien 2020-06-02 13:12 ` Ihor Radchenko 0 siblings, 1 reply; 192+ messages in thread From: Bastien @ 2020-06-02 12:10 UTC (permalink / raw) To: Ihor Radchenko; +Cc: emacs-orgmode, Nicolas Goaziou Hi Ihor, Ihor Radchenko <yantar92@gmail.com> writes: > The patch (against 758b039c0) is attached. Thanks -- just a quick note, in case you missed the message: we are in feature free for core functionalities, so we have time to work on this welcome enhancement for Org 9.5, which will give us time to properly test it too. -- Bastien ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-06-02 12:10 ` Bastien @ 2020-06-02 13:12 ` Ihor Radchenko 2020-06-02 13:23 ` Bastien 0 siblings, 1 reply; 192+ messages in thread From: Ihor Radchenko @ 2020-06-02 13:12 UTC (permalink / raw) To: Bastien; +Cc: emacs-orgmode, Nicolas Goaziou > Thanks -- just a quick note, in case you missed the message: we are in > feature free for core functionalities, so we have time to work on this > welcome enhancement for Org 9.5, which will give us time to properly > test it too. I do not expect it to be merged any time soon. The patch is modifying low-level internals. It certainly needs a careful testing under various user configs. Not to mention that so big patch will require FSF paperwork, unless I miss something. Best, Ihor Bastien <bzg@gnu.org> writes: > Hi Ihor, > > Ihor Radchenko <yantar92@gmail.com> writes: > >> The patch (against 758b039c0) is attached. > > Thanks -- just a quick note, in case you missed the message: we are in > feature free for core functionalities, so we have time to work on this > welcome enhancement for Org 9.5, which will give us time to properly > test it too. > > -- > Bastien -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-06-02 13:12 ` Ihor Radchenko @ 2020-06-02 13:23 ` Bastien 2020-06-02 13:30 ` Ihor Radchenko 0 siblings, 1 reply; 192+ messages in thread From: Bastien @ 2020-06-02 13:23 UTC (permalink / raw) To: Ihor Radchenko; +Cc: emacs-orgmode, Nicolas Goaziou Hi Ihor, Ihor Radchenko <yantar92@gmail.com> writes: >> Thanks -- just a quick note, in case you missed the message: we are in >> feature free for core functionalities, so we have time to work on this >> welcome enhancement for Org 9.5, which will give us time to properly >> test it too. > > I do not expect it to be merged any time soon. The patch is modifying > low-level internals. It certainly needs a careful testing under various > user configs. Indeed, thanks for your patience. > Not to mention that so big patch will require FSF > paperwork, unless I miss something. Oh, I thought this was already done. Do you need to submit the form or do you wait for the FSF confirmation? -- Bastien ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-06-02 13:23 ` Bastien @ 2020-06-02 13:30 ` Ihor Radchenko 0 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2020-06-02 13:30 UTC (permalink / raw) To: Bastien; +Cc: emacs-orgmode, Nicolas Goaziou > Oh, I thought this was already done. Do you need to submit the form > or do you wait for the FSF confirmation? Need to submit. Bastien <bzg@gnu.org> writes: > Hi Ihor, > > Ihor Radchenko <yantar92@gmail.com> writes: > >>> Thanks -- just a quick note, in case you missed the message: we are in >>> feature free for core functionalities, so we have time to work on this >>> welcome enhancement for Org 9.5, which will give us time to properly >>> test it too. >> >> I do not expect it to be merged any time soon. The patch is modifying >> low-level internals. It certainly needs a careful testing under various >> user configs. > > Indeed, thanks for your patience. > >> Not to mention that so big patch will require FSF >> paperwork, unless I miss something. > > Oh, I thought this was already done. Do you need to submit the form > or do you wait for the FSF confirmation? > > -- > Bastien -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-06-02 9:21 ` Ihor Radchenko 2020-06-02 9:23 ` Ihor Radchenko @ 2020-06-02 9:25 ` Ihor Radchenko 2020-06-05 7:26 ` Nicolas Goaziou 2 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2020-06-02 9:25 UTC (permalink / raw) To: Nicolas Goaziou; +Cc: emacs-orgmode Github link to the patch: https://gist.github.com/yantar92/6447754415457927293acda43a7fcaef Ihor Radchenko <yantar92@gmail.com> writes: > Hello, > > [The patch itself will be provided in the following email] > > I have three updates from the previous version of the patch: > > 1. I managed to implement buffer-local text properties. > Now, outline folding also uses text properties without a need to give > up independent folding in indirect buffers. > > 2. The code handling modifications in folded drawers/blocks was > rewritten. The new code uses after-change-functions to re-hide text > inserted in the middle of folded regions; and text properties to > unfold folded drawers/blocks if one changes BEGIN/END line. > > 3. [experimental] Started working on improving memory and cpu footprint > of the old code related to folding/unfolding. org-hide-drawer-all now > works significantly faster because I can utilise simplified drawer > parser, which require a lot less memory. Overall, I managed to reduce > Emacs memory footprint after loading all my agenda_files twice. The > loading is also noticeably faster. > > ----------------------------------------------------------------------- > ----------------------------------------------------------------------- > > More details on the buffer-local text properties: > > I have found char-property-alias-alist variable that controls how Emacs > calculates text property value if the property is not set. This variable > can be buffer-local, which allows independent 'invisible states in > different buffers. > > All the implementation stays in > org--get-buffer-local-text-property-symbol, which takes care about > generating unique property name and mapping it to 'invisible (or any > other) text property. > > ----------------------------------------------------------------------- > ----------------------------------------------------------------------- > > More details on the new implementation for tracking changes: > > I simplified the code as suggested, without using pairs of before- and > after-change-functions. > > Handling text inserted into folded/invisible region is handled by a > simple after-change function. After testing, it turned out that simple > re-hiding text based on 'invisible property of the text before/after the > inserted region works pretty well. > > Modifications to BEGIN/END line of the drawers and blocks is handled via > 'modification-hooks + 'insert-behind-hooks text properties (there is no > after-change-functions analogue for text properties in Emacs). The > property is applied during folding and the modification-hook function is > made aware about the drawer/block boundaries (via apply-partially > passing element containing :begin :end markers for the current > drawer/block). Passing the element boundary is important because the > 'modification-hook will not directly know where it belongs to. Only the > modified region (which can be larger than the drawer) is passed to the > function. In the worst case, the region can be the whole buffer (if one > runs revert-buffer). > > It turned out that adding 'modification-hook text property takes a > significant cpu time (partially, because we need to take care about > possible existing 'modification-hook value, see > org--add-to-list-text-property). For now, I decided to not clear the > modification hooks during unfolding because of poor performance. > However, this approach would lead to partial unfolding in the following > case: > > :asd: > :drawer: > lksjdfksdfjl > sdfsdfsdf > :end: > > If :asd: was inserted in front of folded :drawer:, changes in :drawer: > line of the new folded :asd: drawer would reveal the text between > :drawer: and :end:. > > Let me know what you think on this. > >> You shouldn't be bothered by the case you're describing here, for >> multiple reasons. >> >> First, this issue already arises in the current implementation. No one >> bothered so far: this change is very unlikely to happen. If it becomes >> an issue, we could make sure that `org-reveal' handles this. >> >> But, more importantly, we actually /want it/ as a feature. Indeed, if >> DRAWER is expanded every time ":BLAH:" is inserted above, then inserting >> a drawer manually would unfold /all/ drawers in the section. The user is >> more likely to write first ":BLAH:" (everything is unfolded) then >> ":END:" than ":END:", then ":BLAH:". > > Agree. This allowed me to simplify the code significantly. > >> It seems you're getting it backwards. `before-change-functions' are the >> functions being called with a possibly wide, imprecise, region to >> handle: >> >> When that happens, the arguments to ‘before-change-functions’ will >> enclose a region in which the individual changes are made, but won’t >> necessarily be the minimal such region >> >> however, after-change-functions calls are always minimal: >> >> and the arguments to each successive call of >> ‘after-change-functions’ will then delimit the part of text being >> changed exactly. >> >> If you stick to `after-change-functions', there will be no such thing as >> you describe. > > You are right here, I missed that before-change-functions are likely to > be called on large regions. I thought that the regions are same for > before/after-change-functions, but after-change-functions could be > called more than 1 time. After second thought, your vision that it is > mostly 0 or 1 times should be the majority of cases in practice. > > ----------------------------------------------------------------------- > ----------------------------------------------------------------------- > > More details on reducing cpu and memory footprint of org buffers: > > My simplified implementation of element boundary parser > (org--get-element-region-at-point) appears to be much faster and also > uses much less memory in comparison with org-element-at-point. > Moreover, not all the places where org-element-at-point is called > actually need the full parsed element. For example, org-hide-drawer-all, > org-hide-drawer-toggle, org-hide-block-toggle, and > org--hide-wrapper-toggle only need element type and some information > about the element boundaries - the information we can get from > org--get-element-region-at-point. > > The following version of org-hide-drawer-all seems to work much faster > in comparison with original: > > (defun org-hide-drawer-all () > "Fold all drawers in the current buffer." > (save-excursion > (goto-char (point-min)) > (while (re-search-forward org-drawer-regexp nil t) > (when-let* ((drawer (org--get-element-region-at-point '(property-drawer drawer))) > (type (org-element-type drawer))) > (org-hide-drawer-toggle t nil drawer) > ;; Make sure to skip drawer entirely or we might flag it > ;; another time when matching its ending line with > ;; `org-drawer-regexp'. > (goto-char (org-element-property :end drawer)))))) > > What do you think about the idea of making use of > org--get-element-region-at-point in org code base? > > ----------------------------------------------------------------------- > ----------------------------------------------------------------------- > > Further work: > > 1. Look into other code using overlays. Specifically, > org-toggle-custom-properties, Babel hashes, and narrowed table columns. > > Best, > Ihor > > Nicolas Goaziou <mail@nicolasgoaziou.fr> writes: > >> Hello, >> >> Ihor Radchenko <yantar92@gmail.com> writes: >> >>> I have five updates from the previous version of the patch: >> >> Thank you. >> >>> 1. I implemented a simplified version of element parsing to detect >>> changes in folded drawers or blocks. No computationally expensive calls >>> of org-element-at-point or org-element-parse-buffer are needed now. >>> >>> 2. The patch is now compatible with master (commit 2e96dc639). I >>> reverted the earlier change in folding drawers and blocks. Now, they are >>> back to using 'org-hide-block and 'org-hide-drawer. Using 'outline would >>> achieve nothing when we use text properties. >>> >>> 3. 'invisible text property can now be nested. This is important, for >>> example, when text inside drawers contains fontified links (which also >>> use 'invisible text property to hide parts of the link). Now, the old >>> 'invisible spec is recovered after unfolding. >> >> Interesting. I'm running out of time, so I cannot properly inspect the >> code right now. I'll try to do that before the end of the week. >> >>> 4. Some outline-* function calls in org referred to outline-flag-region >>> implementation, which is not in sync with org-flag-region in this patch. >>> I have implemented their org-* versions and replaced the calls >>> throughout .el files. Actually, some org-* versions were already >>> implemented in org, but not used for some reason (or not mentioned in >>> the manual). I have updated the relevant sections of manual. These >>> changes might be relevant to org independently of this feature branch. >> >> Yes, we certainly want to move to org-specific versions in all cases. >> >>> 5. I have managed to get a working version of outline folding via text >>> properties. However, that approach has a big downside - folding state >>> cannot be different in indirect buffer when we use text properties. I >>> have seen packages relying on this feature of org and I do not see any >>> obvious way to achieve different folding state in indirect buffer while >>> using text properties for outline folding. >> >> Hmm. Good point. This is a serious issue to consider. Even if we don't >> use text properties for outline, this also affects drawers and blocks. >> >>> For now, I still used before/after-change-functions combination. >> >> You shouldn't. >> >>> I see the following problems with using only after-change-functions: >>> >>> 1. They are not guaranteed to be called after every single change: >> >> Of course they are! See below. >> >>> From (elisp) Change Hooks: >>> "... some complex primitives call ‘before-change-functions’ once before >>> making changes, and then call ‘after-change-functions’ zero or more >>> times" >> >> "zero" means there are no changes at all, so, `after-change-functions' >> are not called, which is expected. >> >>> The consequence of it is a possibility that region passed to the >>> after-change-functions is quite big (including all the singular changes, >>> even if they are distant). This region may contain changed drawers as >>> well and unchanged drawers and needs to be parsed to determine which >>> drawers need to be re-folded. >> >> It seems you're getting it backwards. `before-change-functions' are the >> functions being called with a possibly wide, imprecise, region to >> handle: >> >> When that happens, the arguments to ‘before-change-functions’ will >> enclose a region in which the individual changes are made, but won’t >> necessarily be the minimal such region >> >> however, after-change-functions calls are always minimal: >> >> and the arguments to each successive call of >> ‘after-change-functions’ will then delimit the part of text being >> changed exactly. >> >> If you stick to `after-change-functions', there will be no such thing as >> you describe. >> >>>> And, more importantly, they are not meant to be used together, i.e., you >>>> cannot assume that a single call to `before-change-functions' always >>>> happens before calling `after-change-functions'. This can be tricky if >>>> you want to use the former to pass information to the latter. >>> >>> The fact that before-change-functions can be called multiple times >>> before after-change-functions, is trivially solved by using buffer-local >>> changes register (see org--modified-elements). >> >> Famous last words. Been there, done that, and it failed. >> >> Let me quote the manual: >> >> In general, we advise to use either before- or the after-change >> hooks, but not both. >> >> So, let me insist: don't do that. If you don't agree with me, let's at >> least agree with Emacs developers. >> >>> The register is populated by before-change-functions and cleared by >>> after-change-functions. >> >> You cannot expect `after-change-functions' to clear what >> `before-change-functions' did. This is likely to introduce pernicious >> bugs. Sorry if it sounds like FUD, but bugs in those areas are just >> horrible to squash. >> >>>> Well, `before-change-fuctions' and `after-change-functions' are not >>>> clean at all: you modify an unrelated part of the buffer, but still call >>>> those to check if a drawer needs to be unfolded somewhere. >>> >>> 2. As you pointed, instead of global before-change-functions, we can use >>> modification-hooks text property on sensitive parts of the >>> drawers/blocks. This would work, but I am concerned about one annoying >>> special case: >>> >>> ------------------------------------------------------------------------- >>> :BLAH: <inserted outside any of the existing drawers> >>> >>> <some text> >>> >>> :DRAWER: <folded> >>> Donec at pede. >>> :END: >>> ------------------------------------------------------------------------- >>> In this example, the user would not be able to unfold the folder DRAWER >>> because it will technically become a part of a new giant BLAH drawer. >>> This may be especially annoying if <some text> is more than one screen >>> long and there is no easy way to identify why unfolding does not work >>> (with point at :DRAWER:). >> >> You shouldn't be bothered by the case you're describing here, for >> multiple reasons. >> >> First, this issue already arises in the current implementation. No one >> bothered so far: this change is very unlikely to happen. If it becomes >> an issue, we could make sure that `org-reveal' handles this. >> >> But, more importantly, we actually /want it/ as a feature. Indeed, if >> DRAWER is expanded every time ":BLAH:" is inserted above, then inserting >> a drawer manually would unfold /all/ drawers in the section. The user is >> more likely to write first ":BLAH:" (everything is unfolded) then >> ":END:" than ":END:", then ":BLAH:". >> >>> Because of this scenario, limiting before-change-functions to folded >>> drawers is not sufficient. Any change in text may need to trigger >>> unfolding. >> >> after-change-functions is more appropriate than before-change-functions, >> and local parsing, as explained in this thread, is more efficient than >> re-inventing the parser. >> >>> In the patch, I always register possible modifications in the >>> blocks/drawers intersecting with the modified region + a drawer/block >>> right next to the region. >>> >>> ----------------------------------------------------------------------- >>> ----------------------------------------------------------------------- >>> >>> More details on the nested 'invisible text property implementation. >>> >>> The idea is to keep 'invisible property stack push and popping from it >>> as we add/remove 'invisible text property. All the work is done in >>> org-flag-region. >> >> This sounds like a good idea. >> >>> This was originally intended for folding outlines via text properties. >>> Since using text properties for folding outlines is not a good idea, >>> nested text properties have much less use. >> >> AFAIU, they have. You mention link fontification, but there are other >> pieces that we could switch to text properties instead of overlays, >> e.g., Babel hashes, narrowed table columns… >> >>> 3. Multiple calls to before/after-change-functions is still a problem. I >>> am looking into following ways to reduce this number: >>> - reduce the number of elements registered as potentially modified >>> + do not add duplicates to org--modified-elements >>> + do not add unfolded elements to org--modified-elements >>> + register after-change-function as post-command hook and remove it >>> from global after-change-functions. This way, it will be called >>> twice per command only. >>> - determine common region containing org--modified-elements. if change >>> is happening within that region, there is no need to parse >>> drawers/blocks there again. >> >> This is over-engineering. Again, please focus on local changes, as >> discussed before. >> >>> Recipe to have different (org-element-at-point) and >>> (org-element-parse-buffer 'element) >>> ------------------------------------------------------------------------- >>> <point-min> >>> :PROPERTIES: >>> :CREATED: [2020-05-23 Sat 02:32] >>> :END: >>> >>> >>> <point-max> >>> ------------------------------------------------------------------------- >> >> I didn't look at this situation in particular, but there are cases where >> different :post-blank values are inevitable, for example at the end of >> a section. >> >> Regards, >> >> -- >> Nicolas Goaziou > > -- > Ihor Radchenko, > PhD, > Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) > State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China > Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-06-02 9:21 ` Ihor Radchenko 2020-06-02 9:23 ` Ihor Radchenko 2020-06-02 9:25 ` Ihor Radchenko @ 2020-06-05 7:26 ` Nicolas Goaziou 2020-06-05 8:18 ` Ihor Radchenko 2 siblings, 1 reply; 192+ messages in thread From: Nicolas Goaziou @ 2020-06-05 7:26 UTC (permalink / raw) To: Ihor Radchenko; +Cc: emacs-orgmode Hello, Ihor Radchenko <yantar92@gmail.com> writes: > [The patch itself will be provided in the following email] Thank you. > I have found char-property-alias-alist variable that controls how Emacs > calculates text property value if the property is not set. This variable > can be buffer-local, which allows independent 'invisible states in > different buffers. Great. I didn't know about this variable! > All the implementation stays in > org--get-buffer-local-text-property-symbol, which takes care about > generating unique property name and mapping it to 'invisible (or any > other) text property. See also `gensym'. Do we really need to use it for something else than `invisible'? If not, the tool doesn't need to be generic. > I simplified the code as suggested, without using pairs of before- and > after-change-functions. Great! > Handling text inserted into folded/invisible region is handled by a > simple after-change function. After testing, it turned out that simple > re-hiding text based on 'invisible property of the text before/after the > inserted region works pretty well. OK, but this may not be sufficient if we want to do slightly better than overlays in that area. This is not mandatory, though. > Modifications to BEGIN/END line of the drawers and blocks is handled via > 'modification-hooks + 'insert-behind-hooks text properties (there is no > after-change-functions analogue for text properties in Emacs). The > property is applied during folding and the modification-hook function is > made aware about the drawer/block boundaries (via apply-partially > passing element containing :begin :end markers for the current > drawer/block). Passing the element boundary is important because the > 'modification-hook will not directly know where it belongs to. Only the > modified region (which can be larger than the drawer) is passed to the > function. In the worst case, the region can be the whole buffer (if one > runs revert-buffer). As discussed before, I don't think you need to use `modification-hooks' or `insert-behind-hooks' if you already use `after-change-functions'. `after-change-functions' are also triggered upon text properties changes. So, what is the use case for the other hooks? > It turned out that adding 'modification-hook text property takes a > significant cpu time (partially, because we need to take care about > possible existing 'modification-hook value, see > org--add-to-list-text-property). For now, I decided to not clear the > modification hooks during unfolding because of poor performance. > However, this approach would lead to partial unfolding in the following > case: > > :asd: > :drawer: > lksjdfksdfjl > sdfsdfsdf > :end: > > If :asd: was inserted in front of folded :drawer:, changes in :drawer: > line of the new folded :asd: drawer would reveal the text between > :drawer: and :end:. > > Let me know what you think on this. I have first to understand the use case for `modification-hook'. But I think unfolding is the right thing to do in this situation, isn't it? > My simplified implementation of element boundary parser > (org--get-element-region-at-point) appears to be much faster and also > uses much less memory in comparison with org-element-at-point. > Moreover, not all the places where org-element-at-point is called > actually need the full parsed element. For example, org-hide-drawer-all, > org-hide-drawer-toggle, org-hide-block-toggle, and > org--hide-wrapper-toggle only need element type and some information > about the element boundaries - the information we can get from > org--get-element-region-at-point. [...] > What do you think about the idea of making use of > org--get-element-region-at-point in org code base? `org--get-element-region-at-point' is certainly faster, but it is also wrong, unfortunately. Org syntax is not context-free grammar. If you try to parse it locally, starting from anywhere, it will fail at some point. For example, your function would choke in the following case: [fn:1] Def1 #+begin_something [fn:2] Def2 #+end_something AFAIK, the only proper way to parse it is to start from a known position in the buffer. If you have no information about the buffer, the headline above is the position you want. With cache could help to start below. Anyway, in this particular case, you should not use `org--get-element-region-at-point'. Hopefully, we don't need to parse anything. In an earlier message, I suggested a few checks to make on the modified text in order to decide if something should be unfolded, or not. I suggest to start from there, and fix any shortcomings we might encounter. We're replacing overlays: low-level is good in this area. WDYT? Regards, -- Nicolas Goaziou ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-06-05 7:26 ` Nicolas Goaziou @ 2020-06-05 8:18 ` Ihor Radchenko 2020-06-05 13:50 ` Nicolas Goaziou 0 siblings, 1 reply; 192+ messages in thread From: Ihor Radchenko @ 2020-06-05 8:18 UTC (permalink / raw) To: Nicolas Goaziou; +Cc: emacs-orgmode > See also `gensym'. Do we really need to use it for something else than > `invisible'? If not, the tool doesn't need to be generic. For now, I also use it for buffer-local 'invisible stack. The stack is needed to preserve folding state of drawers/blocks inside folded outline. Though I am thinking about replacing the stack with separate text properties, like 'invisible-outline-buffer-local + 'invisible-drawer-buffer-local + 'invisible-block-buffer-local. Maintaining stack takes a noticeable percentage of CPU time in profiler. org--get-buffer-local-text-property-symbol must take care about situation with indirect buffers. When an indirect buffer is created from some org buffer, the old value of char-property-alias-alist is carried over. We need to detect this case and create new buffer-local symbol, which is unique to the newly created buffer (but not create it if the buffer-local property is already there). Then, the new symbol must replace the old alias in char-property-alias-alist + old folding state must be preserved (via copying the old invisibility specs into the new buffer-local text property). I do not see how gensym can benefit this logic. > OK, but this may not be sufficient if we want to do slightly better than > overlays in that area. This is not mandatory, though. Could you elaborate on what can be "slightly better"? > As discussed before, I don't think you need to use `modification-hooks' > or `insert-behind-hooks' if you already use `after-change-functions'. > > `after-change-functions' are also triggered upon text properties > changes. So, what is the use case for the other hooks? The problem is that `after-change-functions' cannot be a text property. Only `modification-hooks' and `insert-in-front/behind-hooks' can be a valid text property. If we use `after-change-functions', they will always be triggered, regardless if the change was made inside or outside folded region. >> :asd: >> :drawer: >> lksjdfksdfjl >> sdfsdfsdf >> :end: >> >> If :asd: was inserted in front of folded :drawer:, changes in :drawer: >> line of the new folded :asd: drawer would reveal the text between >> :drawer: and :end:. >> >> Let me know what you think on this. > I have first to understand the use case for `modification-hook'. But > I think unfolding is the right thing to do in this situation, isn't it? That situation arises because the modification-hooks from ":drawer:" (they are set via text properties) only have information about the :drawer:...:end: drawer before the modifications (they were set when :drawer: was folded last time). So, they will only unfold a part of the new :asd: drawer. I do not see a simple way to unfold everything without re-parsing the drawer around the changed text. Actually, I am quite unhappy with the performance of modification-hooks set via text properties (I am using this patch on my Emacs during this week). It appears that setting the text properties costs a significant CPU time in practice, even though running the hooks is pretty fast. I will think about a way to handle modifications using global after-change-functions. > `org--get-element-region-at-point' is certainly faster, but it is also > wrong, unfortunately. > > Org syntax is not context-free grammar. If you try to parse it locally, > starting from anywhere, it will fail at some point. For example, your > function would choke in the following case: > > [fn:1] Def1 > #+begin_something > > [fn:2] Def2 > #+end_something I see. > AFAIK, the only proper way to parse it is to start from a known position > in the buffer. If you have no information about the buffer, the headline > above is the position you want. With cache could help to start below. > Anyway, in this particular case, you should not use > `org--get-element-region-at-point'. OK Best, Ihor Nicolas Goaziou <mail@nicolasgoaziou.fr> writes: > Hello, > > Ihor Radchenko <yantar92@gmail.com> writes: > >> [The patch itself will be provided in the following email] > > Thank you. > >> I have found char-property-alias-alist variable that controls how Emacs >> calculates text property value if the property is not set. This variable >> can be buffer-local, which allows independent 'invisible states in >> different buffers. > > Great. I didn't know about this variable! > >> All the implementation stays in >> org--get-buffer-local-text-property-symbol, which takes care about >> generating unique property name and mapping it to 'invisible (or any >> other) text property. > > See also `gensym'. Do we really need to use it for something else than > `invisible'? If not, the tool doesn't need to be generic. > >> I simplified the code as suggested, without using pairs of before- and >> after-change-functions. > > Great! > >> Handling text inserted into folded/invisible region is handled by a >> simple after-change function. After testing, it turned out that simple >> re-hiding text based on 'invisible property of the text before/after the >> inserted region works pretty well. > > OK, but this may not be sufficient if we want to do slightly better than > overlays in that area. This is not mandatory, though. > >> Modifications to BEGIN/END line of the drawers and blocks is handled via >> 'modification-hooks + 'insert-behind-hooks text properties (there is no >> after-change-functions analogue for text properties in Emacs). The >> property is applied during folding and the modification-hook function is >> made aware about the drawer/block boundaries (via apply-partially >> passing element containing :begin :end markers for the current >> drawer/block). Passing the element boundary is important because the >> 'modification-hook will not directly know where it belongs to. Only the >> modified region (which can be larger than the drawer) is passed to the >> function. In the worst case, the region can be the whole buffer (if one >> runs revert-buffer). > > As discussed before, I don't think you need to use `modification-hooks' > or `insert-behind-hooks' if you already use `after-change-functions'. > > `after-change-functions' are also triggered upon text properties > changes. So, what is the use case for the other hooks? > >> It turned out that adding 'modification-hook text property takes a >> significant cpu time (partially, because we need to take care about >> possible existing 'modification-hook value, see >> org--add-to-list-text-property). For now, I decided to not clear the >> modification hooks during unfolding because of poor performance. >> However, this approach would lead to partial unfolding in the following >> case: >> >> :asd: >> :drawer: >> lksjdfksdfjl >> sdfsdfsdf >> :end: >> >> If :asd: was inserted in front of folded :drawer:, changes in :drawer: >> line of the new folded :asd: drawer would reveal the text between >> :drawer: and :end:. >> >> Let me know what you think on this. > > I have first to understand the use case for `modification-hook'. But > I think unfolding is the right thing to do in this situation, isn't it? > >> My simplified implementation of element boundary parser >> (org--get-element-region-at-point) appears to be much faster and also >> uses much less memory in comparison with org-element-at-point. >> Moreover, not all the places where org-element-at-point is called >> actually need the full parsed element. For example, org-hide-drawer-all, >> org-hide-drawer-toggle, org-hide-block-toggle, and >> org--hide-wrapper-toggle only need element type and some information >> about the element boundaries - the information we can get from >> org--get-element-region-at-point. > > [...] > >> What do you think about the idea of making use of >> org--get-element-region-at-point in org code base? > > `org--get-element-region-at-point' is certainly faster, but it is also > wrong, unfortunately. > > Org syntax is not context-free grammar. If you try to parse it locally, > starting from anywhere, it will fail at some point. For example, your > function would choke in the following case: > > [fn:1] Def1 > #+begin_something > > [fn:2] Def2 > #+end_something > > AFAIK, the only proper way to parse it is to start from a known position > in the buffer. If you have no information about the buffer, the headline > above is the position you want. With cache could help to start below. > Anyway, in this particular case, you should not use > `org--get-element-region-at-point'. > > Hopefully, we don't need to parse anything. In an earlier message, > I suggested a few checks to make on the modified text in order to decide > if something should be unfolded, or not. I suggest to start from there, > and fix any shortcomings we might encounter. We're replacing overlays: > low-level is good in this area. > > WDYT? > > > Regards, > > -- > Nicolas Goaziou -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-06-05 8:18 ` Ihor Radchenko @ 2020-06-05 13:50 ` Nicolas Goaziou 2020-06-08 5:05 ` Ihor Radchenko 0 siblings, 1 reply; 192+ messages in thread From: Nicolas Goaziou @ 2020-06-05 13:50 UTC (permalink / raw) To: Ihor Radchenko; +Cc: emacs-orgmode Ihor Radchenko <yantar92@gmail.com> writes: >> See also `gensym'. Do we really need to use it for something else than >> `invisible'? If not, the tool doesn't need to be generic. > > For now, I also use it for buffer-local 'invisible stack. The stack is > needed to preserve folding state of drawers/blocks inside folded > outline. Though I am thinking about replacing the stack with separate > text properties, like 'invisible-outline-buffer-local + > 'invisible-drawer-buffer-local + 'invisible-block-buffer-local. > Maintaining stack takes a noticeable percentage of CPU time in profiler. > > org--get-buffer-local-text-property-symbol must take care about > situation with indirect buffers. When an indirect buffer is created from > some org buffer, the old value of char-property-alias-alist is carried > over. We need to detect this case and create new buffer-local symbol, > which is unique to the newly created buffer (but not create it if the > buffer-local property is already there). Then, the new symbol must > replace the old alias in char-property-alias-alist + old folding state > must be preserved (via copying the old invisibility specs into the new > buffer-local text property). I do not see how gensym can benefit this > logic. `gensym' is just a shorter, and somewhat standard way, to create a new uninterned symbol with a given prefix. You seem to re-invent it. What you do with that new symbol is orthogonal to that suggestion, of course. >> OK, but this may not be sufficient if we want to do slightly better than >> overlays in that area. This is not mandatory, though. > > Could you elaborate on what can be "slightly better"? IIRC, I gave examples of finer control of folding state after a change. Consider this _folded_ drawer: :BEGIN: Foo :END: Inserting ":END" in it should not unfold it, as it is currently the case with overlays, :BEGIN Foo :END :END: but a soon as the last ":" is inserted, the initial drawer could be expanded. :BEGIN Foo :END: :END: The latter case is not currently handled by overlays. This is what I call "slightly better". Also, note that this change is not related to opening and closing lines of the initial drawer, so sticking text properties on them would not help here. Another case is modifying those borders, e.g., :BEGIN: :BEGIN: Foo ------> Foo :END: :ND: which should expand the drawer. Your implementation catches this, but I'm pointing out that current implementation with overlays does not. Even though that's not strictly required for compatibility with overlays, it is a welcome slight improvement. >> As discussed before, I don't think you need to use `modification-hooks' >> or `insert-behind-hooks' if you already use `after-change-functions'. >> >> `after-change-functions' are also triggered upon text properties >> changes. So, what is the use case for the other hooks? > > The problem is that `after-change-functions' cannot be a text property. > Only `modification-hooks' and `insert-in-front/behind-hooks' can be a > valid text property. If we use `after-change-functions', they will > always be triggered, regardless if the change was made inside or outside > folded region. As discussed, text properties are local to the change, but require extra care when moving text around. You also observed serious overhead when using them. OTOH, even if `a-c-f' is not local, you can quickly determine if the change altered a folded element, so the overhead is limited, i.e., mostly checking for a text property at a given buffer position. To be clear, I initially thought that text properties were a superior choice, but I changed my mind a while ago, and I thought you had, too. IOW, `after-change-functions' is the way to go, since you have no strong reason to stick to text properties for this kind of function. >>> :asd: >>> :drawer: >>> lksjdfksdfjl >>> sdfsdfsdf >>> :end: >>> >>> If :asd: was inserted in front of folded :drawer:, changes in :drawer: >>> line of the new folded :asd: drawer would reveal the text between >>> :drawer: and :end:. >>> >>> Let me know what you think on this. > >> I have first to understand the use case for `modification-hook'. But >> I think unfolding is the right thing to do in this situation, isn't it? > > That situation arises because the modification-hooks from ":drawer:" > (they are set via text properties) only have information about the > :drawer:...:end: drawer before the modifications (they were set when > :drawer: was folded last time). So, they will only unfold a part of the > new :asd: drawer. I do not see a simple way to unfold everything without > re-parsing the drawer around the changed text. Oh! I misread your message. I withdraw what I wrote. In this case, we don't want to unfold anything. The situation is not worse than what we have now, and trying to fix it would have repercussions down in the buffer, e.g., expanding drawers screen below. As a rule of thumb, I think we can pay attention to changes in the folded text, and its immediate surroundings (e.g., the opening line, which is not folded), but no further. As written above, slight changes are welcome, but let's not go overboard and parse a whole section just to know if we can expand a drawer. > Actually, I am quite unhappy with the performance of modification-hooks > set via text properties (I am using this patch on my Emacs during this > week). It appears that setting the text properties costs a significant > CPU time in practice, even though running the hooks is pretty fast. > I will think about a way to handle modifications using global > after-change-functions. That's better, IMO. I gave you a few ideas to quickly check if a change requires expansion, in an earlier mail. I suggest to start out from that. Let me know if you have questions about it. ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-06-05 13:50 ` Nicolas Goaziou @ 2020-06-08 5:05 ` Ihor Radchenko 2020-06-08 5:06 ` Ihor Radchenko ` (2 more replies) 0 siblings, 3 replies; 192+ messages in thread From: Ihor Radchenko @ 2020-06-08 5:05 UTC (permalink / raw) To: Nicolas Goaziou; +Cc: emacs-orgmode Hello, [The patch itself will be provided in the following email] I have four more updates from the previous version of the patch: 1. All the code handling modifications in folded drawers/blocks is moved to after-change-function. It works as follows: - if any text is inserted in the middle of hidden region, that text is also hidden; - if BEGIN/END line of a folded drawer do not match org-drawer-regexp and org-property-end-re, unfold it; - if org-property-end-re or new org-outline-regexp-bol is inserted in the middle of the drawer, unfold it; - the same logic for blocks. 2. The text property stack is rewritten using char-property-alias-alist. This is faster in comparison with previous approach, which involved modifying all the text properties every timer org-flag-region was called. 3. org-toggle-custom-properties-visibility is rewritten using text properties. I also took a freedom to implement a new feature here. Now, setting new `org-custom-properties-hide-emptied-drawers' to non-nil will result in hiding the whole property drawer if it contains only org-custom-properties. 4. This patch should work against 1aa095ccf. However, the merge was not trivial here. Recent commits actively used the fact that drawers and outlines are hidden via 'outline invisibility spec, which is not the case in this branch. I am not confident that I did not break anything during the merge, especially 1aa095ccf. ----------------------------------------------------------------------- ----------------------------------------------------------------------- More details on the new implementation for tracking changes: > I gave you a few ideas to quickly check if a change requires expansion, > in an earlier mail. I suggest to start out from that. Let me know if you > have questions about it. All the code lives in org-after-change-function. I tried to incorporate the earlier Nicholas' suggestions, except the parts related to intersecting blocks and drawers. I am not sure if I understand the parsing priority of blocks vs. drawers. ----------------------------------------------------------------------- ----------------------------------------------------------------------- More details on the text property stack: The earlier version of the code literally used stack to save pre-existing 'invisibility specs in org-flag-region. This was done on every invocation of org-flag-region, which made org-flag-region significantly slower. I re-implemented the same feature using char-property-alias-alist. Now, different invisibility specs live in separate text properties and can be safely modified independently. The specs are applied according to org--invisible-spec-priority-list. A side effect of current implementation is that char-property-alias-alist is fully controlled by org. All the pre-existing settings for 'invisible text property will be overwritten by org. > `gensym' is just a shorter, and somewhat standard way, to create a new > uninterned symbol with a given prefix. You seem to re-invent it. What > you do with that new symbol is orthogonal to that suggestion, of course. I do not think that `gensym' is suitable here. We don't want a new symbol every time org--get-buffer-local-invisible-property-symbol is called. It should return the same symbol if it is called from the same buffer multiple times. ----------------------------------------------------------------------- ----------------------------------------------------------------------- More details on the org-toggle-custom-properties-visibility: The implementation showcases how to introduce new invisibility specs to org. Apart from expected (add-to-invisibility-spec 'org-hide-custom-property) one also needs to add the spec into org--invisible-spec-priority-list: (add-to-list 'org--invisible-spec-priority-list 'org-hide-custom-property) Searching for text with the given invisibility spec is done as follows: (text-property-search-forward (org--get-buffer-local-invisible-property-symbol 'org-hide-custom-property) 'org-hide-custom-property t) This last piece of code is probably not the most elegant. I am thinking if creating some higher-level interface would be more reasonable here. What do you think? The new customisation `org-custom-properties-hide-emptied-drawers' sounds logical for me since empty property drawers left after invoking org-toggle-custom-properties-visibility are rather useless according to my experience. If one already wants to hide parts of property drawers, I do not see a reason to show leftover :PROPERTIES: :END: ----------------------------------------------------------------------- ----------------------------------------------------------------------- More details on the merge with the latest master: I tried my best to not break anything. However, I am not sure if I understand all the recent commits. Could someone take a look if there is anything suspicious in org-next-visible-heading? Also, I have seen some optimisations making use of the fact that drawers and headlines both use 'outline invisibility spec. This change in the implementation details supposed to improve performance and should not be necessary if this patch is going to be merged. Would it be possible to refrain from abusing this particular implementation detail in the nearest commits on master (unless really necessary)? ----------------------------------------------------------------------- ----------------------------------------------------------------------- Further work: I would like to finalise the current patch and work on other code using overlays separately. This patch is already quite complicated as is. I do not want to introduce even more potential bugs by working on things not directly affected by this version of the patch. Best, Ihor Nicolas Goaziou <mail@nicolasgoaziou.fr> writes: > Ihor Radchenko <yantar92@gmail.com> writes: > >>> See also `gensym'. Do we really need to use it for something else than >>> `invisible'? If not, the tool doesn't need to be generic. >> >> For now, I also use it for buffer-local 'invisible stack. The stack is >> needed to preserve folding state of drawers/blocks inside folded >> outline. Though I am thinking about replacing the stack with separate >> text properties, like 'invisible-outline-buffer-local + >> 'invisible-drawer-buffer-local + 'invisible-block-buffer-local. >> Maintaining stack takes a noticeable percentage of CPU time in profiler. >> >> org--get-buffer-local-text-property-symbol must take care about >> situation with indirect buffers. When an indirect buffer is created from >> some org buffer, the old value of char-property-alias-alist is carried >> over. We need to detect this case and create new buffer-local symbol, >> which is unique to the newly created buffer (but not create it if the >> buffer-local property is already there). Then, the new symbol must >> replace the old alias in char-property-alias-alist + old folding state >> must be preserved (via copying the old invisibility specs into the new >> buffer-local text property). I do not see how gensym can benefit this >> logic. > > `gensym' is just a shorter, and somewhat standard way, to create a new > uninterned symbol with a given prefix. You seem to re-invent it. What > you do with that new symbol is orthogonal to that suggestion, of course. > >>> OK, but this may not be sufficient if we want to do slightly better than >>> overlays in that area. This is not mandatory, though. >> >> Could you elaborate on what can be "slightly better"? > > IIRC, I gave examples of finer control of folding state after a change. > Consider this _folded_ drawer: > > :BEGIN: > Foo > :END: > > Inserting ":END" in it should not unfold it, as it is currently the case > with overlays, > > :BEGIN > Foo > :END > :END: > > but a soon as the last ":" is inserted, the initial drawer could be > expanded. > > :BEGIN > Foo > :END: > :END: > > The latter case is not currently handled by overlays. This is what > I call "slightly better". > > Also, note that this change is not related to opening and closing lines > of the initial drawer, so sticking text properties on them would not > help here. > > Another case is modifying those borders, e.g., > > > :BEGIN: :BEGIN: > Foo ------> Foo > :END: :ND: > > which should expand the drawer. Your implementation catches this, but > I'm pointing out that current implementation with overlays does not. > Even though that's not strictly required for compatibility with > overlays, it is a welcome slight improvement. > >>> As discussed before, I don't think you need to use `modification-hooks' >>> or `insert-behind-hooks' if you already use `after-change-functions'. >>> >>> `after-change-functions' are also triggered upon text properties >>> changes. So, what is the use case for the other hooks? >> >> The problem is that `after-change-functions' cannot be a text property. >> Only `modification-hooks' and `insert-in-front/behind-hooks' can be a >> valid text property. If we use `after-change-functions', they will >> always be triggered, regardless if the change was made inside or outside >> folded region. > > As discussed, text properties are local to the change, but require extra > care when moving text around. You also observed serious overhead when > using them. > > OTOH, even if `a-c-f' is not local, you can quickly determine if the > change altered a folded element, so the overhead is limited, i.e., > mostly checking for a text property at a given buffer position. > > To be clear, I initially thought that text properties were a superior > choice, but I changed my mind a while ago, and I thought you had, too. > IOW, `after-change-functions' is the way to go, since you have no strong > reason to stick to text properties for this kind of function. > >>>> :asd: >>>> :drawer: >>>> lksjdfksdfjl >>>> sdfsdfsdf >>>> :end: >>>> >>>> If :asd: was inserted in front of folded :drawer:, changes in :drawer: >>>> line of the new folded :asd: drawer would reveal the text between >>>> :drawer: and :end:. >>>> >>>> Let me know what you think on this. >> >>> I have first to understand the use case for `modification-hook'. But >>> I think unfolding is the right thing to do in this situation, isn't it? >> >> That situation arises because the modification-hooks from ":drawer:" >> (they are set via text properties) only have information about the >> :drawer:...:end: drawer before the modifications (they were set when >> :drawer: was folded last time). So, they will only unfold a part of the >> new :asd: drawer. I do not see a simple way to unfold everything without >> re-parsing the drawer around the changed text. > > Oh! I misread your message. I withdraw what I wrote. In this case, we > don't want to unfold anything. The situation is not worse than what we > have now, and trying to fix it would have repercussions down in the > buffer, e.g., expanding drawers screen below. > > As a rule of thumb, I think we can pay attention to changes in the > folded text, and its immediate surroundings (e.g., the opening line, > which is not folded), but no further. > > As written above, slight changes are welcome, but let's not go overboard > and parse a whole section just to know if we can expand a drawer. > >> Actually, I am quite unhappy with the performance of modification-hooks >> set via text properties (I am using this patch on my Emacs during this >> week). It appears that setting the text properties costs a significant >> CPU time in practice, even though running the hooks is pretty fast. >> I will think about a way to handle modifications using global >> after-change-functions. > > That's better, IMO. > > I gave you a few ideas to quickly check if a change requires expansion, > in an earlier mail. I suggest to start out from that. Let me know if you > have questions about it. -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-06-08 5:05 ` Ihor Radchenko @ 2020-06-08 5:06 ` Ihor Radchenko 2020-06-08 5:08 ` Ihor Radchenko 2020-06-10 17:14 ` Nicolas Goaziou 2 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2020-06-08 5:06 UTC (permalink / raw) To: Nicolas Goaziou; +Cc: emacs-orgmode [-- Attachment #1: Type: text/plain, Size: 44 bytes --] The patch (against 1aa095ccf) is attached. [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: featuredrawertextprop-20200608.patch --] [-- Type: text/x-diff, Size: 50930 bytes --] diff --git a/contrib/lisp/org-notify.el b/contrib/lisp/org-notify.el index 9f8677871..ab470ea9b 100644 --- a/contrib/lisp/org-notify.el +++ b/contrib/lisp/org-notify.el @@ -246,7 +246,7 @@ seconds. The default value for SECS is 20." (switch-to-buffer (find-file-noselect file)) (org-with-wide-buffer (goto-char begin) - (outline-show-entry)) + (org-show-entry)) (goto-char begin) (search-forward "DEADLINE: <") (search-forward ":") diff --git a/contrib/lisp/org-velocity.el b/contrib/lisp/org-velocity.el index bfc4d6c3e..2312b235c 100644 --- a/contrib/lisp/org-velocity.el +++ b/contrib/lisp/org-velocity.el @@ -325,7 +325,7 @@ use it." (save-excursion (when narrow (org-narrow-to-subtree)) - (outline-show-all))) + (org-show-all))) (defun org-velocity-edit-entry/inline (heading) "Edit entry at HEADING in the original buffer." diff --git a/doc/org-manual.org b/doc/org-manual.org index efad195e1..c6f167eac 100644 --- a/doc/org-manual.org +++ b/doc/org-manual.org @@ -509,11 +509,11 @@ Org uses just two commands, bound to {{{kbd(TAB)}}} and Switch back to the startup visibility of the buffer (see [[*Initial visibility]]). -- {{{kbd(C-u C-u C-u TAB)}}} (~outline-show-all~) :: +- {{{kbd(C-u C-u C-u TAB)}}} (~org-show-all~) :: #+cindex: show all, command #+kindex: C-u C-u C-u TAB - #+findex: outline-show-all + #+findex: org-show-all Show all, including drawers. - {{{kbd(C-c C-r)}}} (~org-reveal~) :: @@ -529,18 +529,18 @@ Org uses just two commands, bound to {{{kbd(TAB)}}} and headings. With a double prefix argument, also show the entire subtree of the parent. -- {{{kbd(C-c C-k)}}} (~outline-show-branches~) :: +- {{{kbd(C-c C-k)}}} (~org-show-branches~) :: #+cindex: show branches, command #+kindex: C-c C-k - #+findex: outline-show-branches + #+findex: org-show-branches Expose all the headings of the subtree, but not their bodies. -- {{{kbd(C-c TAB)}}} (~outline-show-children~) :: +- {{{kbd(C-c TAB)}}} (~org-show-children~) :: #+cindex: show children, command #+kindex: C-c TAB - #+findex: outline-show-children + #+findex: org-show-children Expose all direct children of the subtree. With a numeric prefix argument {{{var(N)}}}, expose all children down to level {{{var(N)}}}. @@ -7294,7 +7294,7 @@ its location in the outline tree, but behaves in the following way: command (see [[*Visibility Cycling]]). You can force cycling archived subtrees with {{{kbd(C-TAB)}}}, or by setting the option ~org-cycle-open-archived-trees~. Also normal outline commands, like - ~outline-show-all~, open archived subtrees. + ~org-show-all~, open archived subtrees. - #+vindex: org-sparse-tree-open-archived-trees diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index 9fbeb2a1e..2f121f743 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -6824,7 +6824,7 @@ and stored in the variable `org-prefix-format-compiled'." (t " %-12:c%?-12t% s"))) (start 0) varform vars var e c f opt) - (while (string-match "%\\(\\?\\)?\\([-+]?[0-9.]*\\)\\([ .;,:!?=|/<>]?\\)\\([cltseib]\\|(.+)\\)" + (while (string-match "%\\(\\?\\)?\\([-+]?[0-9.]*\\)\\([ .;,:!?=|/<>]?\\)\\([cltseib]\\|(.+?)\\)" s start) (setq var (or (cdr (assoc (match-string 4 s) '(("c" . category) ("t" . time) ("l" . level) ("s" . extra) @@ -9136,20 +9136,20 @@ if it was hidden in the outline." ((and (called-interactively-p 'any) (= more 1)) (message "Remote: show with default settings")) ((= more 2) - (outline-show-entry) + (org-show-entry) (org-show-children) (save-excursion (org-back-to-heading) (run-hook-with-args 'org-cycle-hook 'children)) (message "Remote: CHILDREN")) ((= more 3) - (outline-show-subtree) + (org-show-subtree) (save-excursion (org-back-to-heading) (run-hook-with-args 'org-cycle-hook 'subtree)) (message "Remote: SUBTREE")) ((> more 3) - (outline-show-subtree) + (org-show-subtree) (message "Remote: SUBTREE AND ALL DRAWERS"))) (select-window win))) diff --git a/lisp/org-archive.el b/lisp/org-archive.el index d3e12d17b..d864dad8a 100644 --- a/lisp/org-archive.el +++ b/lisp/org-archive.el @@ -330,7 +330,7 @@ direct children of this heading." (insert (if datetree-date "" "\n") heading "\n") (end-of-line 0)) ;; Make the subtree visible - (outline-show-subtree) + (org-show-subtree) (if org-archive-reversed-order (progn (org-back-to-heading t) diff --git a/lisp/org-colview.el b/lisp/org-colview.el index e50a4d7c8..e656df555 100644 --- a/lisp/org-colview.el +++ b/lisp/org-colview.el @@ -699,7 +699,7 @@ FUN is a function called with no argument." (move-beginning-of-line 2) (org-at-heading-p t))))) (unwind-protect (funcall fun) - (when hide-body (outline-hide-entry))))) + (when hide-body (org-hide-entry))))) (defun org-columns-previous-allowed-value () "Switch to the previous allowed value for this column." diff --git a/lisp/org-compat.el b/lisp/org-compat.el index 5953f89d2..09a09472a 100644 --- a/lisp/org-compat.el +++ b/lisp/org-compat.el @@ -138,12 +138,8 @@ This is a floating point number if the size is too large for an integer." ;;; Emacs < 25.1 compatibility (when (< emacs-major-version 25) - (defalias 'outline-hide-entry 'hide-entry) - (defalias 'outline-hide-sublevels 'hide-sublevels) - (defalias 'outline-hide-subtree 'hide-subtree) (defalias 'outline-show-branches 'show-branches) (defalias 'outline-show-children 'show-children) - (defalias 'outline-show-entry 'show-entry) (defalias 'outline-show-subtree 'show-subtree) (defalias 'xref-find-definitions 'find-tag) (defalias 'format-message 'format) @@ -644,7 +640,7 @@ When optional argument ELEMENT is a parsed drawer, as returned by When buffer positions BEG and END are provided, hide or show that region as a drawer without further ado." (declare (obsolete "use `org-hide-drawer-toggle' instead." "Org 9.4")) - (if (and beg end) (org-flag-region beg end flag 'outline) + (if (and beg end) (org-flag-region beg end flag 'org-hide-drawer) (let ((drawer (or element (and (save-excursion @@ -658,7 +654,7 @@ region as a drawer without further ado." (save-excursion (goto-char (org-element-property :end drawer)) (skip-chars-backward " \t\n") (line-end-position)) - flag 'outline) + flag 'org-hide-drawer) ;; When the drawer is hidden away, make sure point lies in ;; a visible part of the buffer. (when (invisible-p (max (1- (point)) (point-min))) diff --git a/lisp/org-element.el b/lisp/org-element.el index ac41b7650..2d5c8d771 100644 --- a/lisp/org-element.el +++ b/lisp/org-element.el @@ -4320,7 +4320,7 @@ element or object. Meaningful values are `first-section', TYPE is the type of the current element or object. If PARENT? is non-nil, assume the next element or object will be -located inside the current one. " +located inside the current one." (if parent? (pcase type (`headline 'section) diff --git a/lisp/org-keys.el b/lisp/org-keys.el index 37df29983..a714dec0f 100644 --- a/lisp/org-keys.el +++ b/lisp/org-keys.el @@ -437,7 +437,7 @@ COMMANDS is a list of alternating OLDDEF NEWDEF command names." #'org-next-visible-heading) (define-key org-mode-map [remap outline-previous-visible-heading] #'org-previous-visible-heading) -(define-key org-mode-map [remap show-children] #'org-show-children) +(define-key org-mode-map [remap outline-show-children] #'org-show-children) ;;;; Make `C-c C-x' a prefix key (org-defkey org-mode-map (kbd "C-c C-x") (make-sparse-keymap)) diff --git a/lisp/org-macs.el b/lisp/org-macs.el index a02f713ca..b17c0cb4d 100644 --- a/lisp/org-macs.el +++ b/lisp/org-macs.el @@ -682,7 +682,7 @@ When NEXT is non-nil, check the next line instead." \f -;;; Overlays +;;; Overlays and text properties (defun org-overlay-display (ovl text &optional face evap) "Make overlay OVL display TEXT with face FACE." @@ -705,26 +705,126 @@ If DELETE is non-nil, delete all those overlays." (delete (delete-overlay ov)) (t (push ov found)))))) +(defun org-remove-text-properties (start end properties &optional object) + "Remove text properties as in `remove-text-properties', but keep 'invisibility specs for folded regions. +Do not remove invisible text properties specified by 'outline, +'org-hide-block, and 'org-hide-drawer (but remove i.e. 'org-link) this +is needed to keep outlines, drawers, and blocks hidden unless they are +toggled by user. +Note: The below may be too specific and create troubles if more +invisibility specs are added to org in future" + (when (plist-member properties 'invisible) + (let ((pos start) + next spec) + (while (< pos end) + (setq next (next-single-property-change pos 'invisible nil end) + spec (get-text-property pos 'invisible)) + (unless (memq spec (list 'org-hide-block + 'org-hide-drawer + 'outline)) + (remove-text-properties pos next '(invisible nil) object)) + (setq pos next)))) + (when-let ((properties-stripped (org-plist-delete properties 'invisible))) + (remove-text-properties start end properties-stripped object))) + +(defun org--find-text-property-region (pos prop) + "Find a region containing PROP text property around point POS." + (let* ((beg (and (get-text-property pos prop) pos)) + (end beg)) + (when beg + ;; when beg is the first point in the region, `previous-single-property-change' + ;; will return nil. + (setq beg (or (previous-single-property-change pos prop) + beg)) + ;; when end is the last point in the region, `next-single-property-change' + ;; will return nil. + (setq end (or (next-single-property-change pos prop) + end)) + (unless (= beg end) ; this should not happen + (cons beg end))))) + +(defun org--add-to-list-text-property (from to prop element) + "Add element to text property PROP, whos value should be a list." + (add-text-properties from to `(,prop ,(list element))) ; create if none + ;; add to existing + (alter-text-property from to + prop + (lambda (val) + (if (member element val) + val + (cons element val))))) + +(defun org--remove-from-list-text-property (from to prop element) + "Remove ELEMENT from text propery PROP, whos value should be a list." + (let ((pos from)) + (while (< pos to) + (when-let ((val (get-text-property pos prop))) + (if (equal val (list element)) + (remove-text-properties pos (next-single-char-property-change pos prop nil to) (list prop nil)) + (put-text-property pos (next-single-char-property-change pos prop nil to) + prop (remove element (get-text-property pos prop))))) + (setq pos (next-single-char-property-change pos prop nil to))))) + +(defvar org--invisible-spec-priority-list '(outline org-hide-drawer org-hide-block) + "Priority of invisibility specs.") + +(defun org--get-buffer-local-invisible-property-symbol (spec &optional buffer return-only) + "Return unique symbol suitable to be used as buffer-local in BUFFER for 'invisible SPEC. +If the buffer already have buffer-local setup in `char-property-alias-alist' +and the setup appears to be created for different buffer, +copy the old invisibility state into new buffer-local text properties, +unless RETURN-ONLY is non-nil." + (if (not (member spec org--invisible-spec-priority-list)) + (user-error "%s should be a valid invisibility spec" spec) + (let* ((buf (or buffer (current-buffer)))) + (let ((local-prop (intern (format "org--invisible-%s-buffer-local-%S" + (symbol-name spec) + ;; (sxhash buf) appears to be not constant over time. + ;; Using buffer-name is safe, since the only place where + ;; buffer-local text property actually matters is an indirect + ;; buffer, where the name cannot be same anyway. + (sxhash (buffer-name buf)))))) + (prog1 + local-prop + (unless return-only + (with-current-buffer buf + (unless (member local-prop (alist-get 'invisible char-property-alias-alist)) + ;; copy old property + (dolist (old-prop (alist-get 'invisible char-property-alias-alist)) + (org-with-wide-buffer + (let* ((pos (point-min)) + (spec (seq-find (lambda (spec) + (string-match-p (symbol-name spec) + (symbol-name old-prop))) + org--invisible-spec-priority-list)) + (new-prop (org--get-buffer-local-invisible-property-symbol spec nil 'return-only))) + (while (< pos (point-max)) + (when-let (val (get-text-property pos old-prop)) + (put-text-property pos (next-single-char-property-change pos old-prop) new-prop val)) + (setq pos (next-single-char-property-change pos old-prop)))))) + (setq-local char-property-alias-alist + (cons (cons 'invisible + (mapcar (lambda (spec) + (org--get-buffer-local-invisible-property-symbol spec nil 'return-only)) + org--invisible-spec-priority-list)) + (remove (assq 'invisible char-property-alias-alist) + char-property-alias-alist))))))))))) + (defun org-flag-region (from to flag spec) "Hide or show lines from FROM to TO, according to FLAG. SPEC is the invisibility spec, as a symbol." - (remove-overlays from to 'invisible spec) - ;; Use `front-advance' since text right before to the beginning of - ;; the overlay belongs to the visible line than to the contents. - (when flag - (let ((o (make-overlay from to nil 'front-advance))) - (overlay-put o 'evaporate t) - (overlay-put o 'invisible spec) - (overlay-put o 'isearch-open-invisible #'delete-overlay)))) - + (with-silent-modifications + (remove-text-properties from to (list (org--get-buffer-local-invisible-property-symbol spec) nil)) + (when flag + (put-text-property from to (org--get-buffer-local-invisible-property-symbol spec) spec)))) \f ;;; Regexp matching (defsubst org-pos-in-match-range (pos n) - (and (match-beginning n) - (<= (match-beginning n) pos) - (>= (match-end n) pos))) +(and (match-beginning n) + (<= (match-beginning n) pos) + (>= (match-end n) pos))) (defun org-skip-whitespace () "Skip over space, tabs and newline characters." diff --git a/lisp/org-src.el b/lisp/org-src.el index 6f6c544dc..9e8a50044 100644 --- a/lisp/org-src.el +++ b/lisp/org-src.el @@ -529,8 +529,8 @@ Leave point in edit buffer." (org-src-switch-to-buffer buffer 'edit) ;; Insert contents. (insert contents) - (remove-text-properties (point-min) (point-max) - '(display nil invisible nil intangible nil)) + (org-remove-text-properties (point-min) (point-max) + '(display nil invisible nil intangible nil)) (unless preserve-ind (org-do-remove-indentation)) (set-buffer-modified-p nil) (setq buffer-file-name nil) diff --git a/lisp/org-table.el b/lisp/org-table.el index 6462b99c4..75801161b 100644 --- a/lisp/org-table.el +++ b/lisp/org-table.el @@ -2001,7 +2001,7 @@ toggle `org-table-follow-field-mode'." (arg (let ((b (save-excursion (skip-chars-backward "^|") (point))) (e (save-excursion (skip-chars-forward "^|\r\n") (point)))) - (remove-text-properties b e '(invisible t intangible t)) + (org-remove-text-properties b e '(invisible t intangible t)) (if (and (boundp 'font-lock-mode) font-lock-mode) (font-lock-fontify-block)))) (t @@ -2028,7 +2028,7 @@ toggle `org-table-follow-field-mode'." (setq word-wrap t) (goto-char (setq p (point-max))) (insert (org-trim field)) - (remove-text-properties p (point-max) '(invisible t intangible t)) + (org-remove-text-properties p (point-max) '(invisible t intangible t)) (goto-char p) (setq-local org-finish-function 'org-table-finish-edit-field) (setq-local org-window-configuration cw) diff --git a/lisp/org.el b/lisp/org.el index e5cea04c6..3d4a7b072 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -114,6 +114,7 @@ Stars are put in group 1 and the trimmed body in group 2.") (declare-function cdlatex-math-symbol "ext:cdlatex") (declare-function Info-goto-node "info" (nodename &optional fork strict-case)) (declare-function isearch-no-upper-case-p "isearch" (string regexp-flag)) +(declare-function isearch-filter-visible "isearch" (beg end)) (declare-function org-add-archive-files "org-archive" (files)) (declare-function org-agenda-entry-get-agenda-timestamp "org-agenda" (pom)) (declare-function org-agenda-list "org-agenda" (&optional arg start-day span with-hour)) @@ -192,6 +193,9 @@ Stars are put in group 1 and the trimmed body in group 2.") (defvar ffap-url-regexp) (defvar org-element-paragraph-separate) +(defvar org-element-all-objects) +(defvar org-element-all-elements) +(defvar org-element-greater-elements) (defvar org-indent-indentation-per-level) (defvar org-radio-target-regexp) (defvar org-target-link-regexp) @@ -4734,9 +4738,153 @@ This is for getting out of special buffers like capture.") ;;;; Define the Org mode +;;; Handling buffer modifications + (defun org-before-change-function (_beg _end) "Every change indicates that a table might need an update." (setq org-table-may-need-update t)) + +(defun org-after-change-function (from to len) + "Process changes in folded elements. +If a text was inserted into invisible region, hide the inserted text. +If the beginning/end line of a folded drawer/block was changed, unfold it. +If a valid end line was inserted in the middle of the folded drawer/block, unfold it." + + ;; re-hide text inserted in the middle of a folded region + (dolist (spec org--invisible-spec-priority-list) + (when-let ((spec-to (get-text-property to (org--get-buffer-local-invisible-property-symbol spec))) + (spec-from (get-text-property (max (point-min) (1- from)) (org--get-buffer-local-invisible-property-symbol spec)))) + (when (eq spec-to spec-from) + (org-flag-region from to 't spec-to)))) + + ;; Process all the folded text between `from' and `to' + (org-with-wide-buffer + + (if (< to from) + (let ((tmp from)) + (setq from to) + (setq to tmp))) + + ;; Include next/previous line into the changed region. + ;; This is needed to catch edits in beginning line of a folded + ;; element. + (setq to (save-excursion (goto-char to) (forward-line) (point))) + (setq from (save-excursion (goto-char from) (forward-line -1) (point))) + + ;; Expand the considered region to include partially present folded + ;; drawer/block. + (when (get-text-property from (org--get-buffer-local-invisible-property-symbol 'org-hide-drawer)) + (setq from (previous-single-char-property-change from (org--get-buffer-local-invisible-property-symbol 'org-hide-drawer)))) + (when (get-text-property from (org--get-buffer-local-invisible-property-symbol 'org-hide-block)) + (setq from (previous-single-char-property-change from (org--get-buffer-local-invisible-property-symbol 'org-hide-block)))) + + ;; check folded drawers + (let ((pos from)) + (unless (get-text-property pos (org--get-buffer-local-invisible-property-symbol 'org-hide-drawer)) + (setq pos (next-single-char-property-change pos + (org--get-buffer-local-invisible-property-symbol 'org-hide-drawer)))) + (while (< pos to) + (when-let ((drawer-begin (and (get-text-property pos (org--get-buffer-local-invisible-property-symbol 'org-hide-drawer)) + pos)) + (drawer-end (next-single-char-property-change pos (org--get-buffer-local-invisible-property-symbol 'org-hide-drawer)))) + + (let (unfold?) + ;; the line before folded text should be beginning of the drawer + (save-excursion + (goto-char drawer-begin) + (backward-char) + (beginning-of-line) + (unless (looking-at-p org-drawer-regexp) + (setq unfold? t))) + ;; the last line of the folded text should be :END: + (save-excursion + (goto-char drawer-end) + (beginning-of-line) + (unless (let ((case-fold-search t)) (looking-at-p org-property-end-re)) + (setq unfold? t))) + ;; there should be no :END: anywhere in the drawer body + (save-excursion + (goto-char drawer-begin) + (when (save-excursion + (let ((case-fold-search t)) + (re-search-forward org-property-end-re + (max (point) + (1- (save-excursion + (goto-char drawer-end) + (line-beginning-position)))) + 't))) + (setq unfold? t))) + ;; there should be no new entry anywhere in the drawer body + (save-excursion + (goto-char drawer-begin) + (when (save-excursion + (let ((case-fold-search t)) + (re-search-forward org-outline-regexp-bol + (max (point) + (1- (save-excursion + (goto-char drawer-end) + (line-beginning-position)))) + 't))) + (setq unfold? t))) + + (when unfold? (org-flag-region drawer-begin drawer-end nil 'org-hide-drawer)))) + + (setq pos (next-single-char-property-change pos (org--get-buffer-local-invisible-property-symbol 'org-hide-drawer))))) + + ;; check folded blocks + (let ((pos from)) + (unless (get-text-property pos (org--get-buffer-local-invisible-property-symbol 'org-hide-block)) + (setq pos (next-single-char-property-change pos + (org--get-buffer-local-invisible-property-symbol 'org-hide-block)))) + (while (< pos to) + (when-let ((block-begin (and (get-text-property pos (org--get-buffer-local-invisible-property-symbol 'org-hide-block)) + pos)) + (block-end (next-single-char-property-change pos (org--get-buffer-local-invisible-property-symbol 'org-hide-block)))) + + (let (unfold?) + ;; the line before folded text should be beginning of the block + (save-excursion + (goto-char block-begin) + (backward-char) + (beginning-of-line) + (unless (looking-at-p org-dblock-start-re) + (setq unfold? t))) + ;; the last line of the folded text should be end of the block + (save-excursion + (goto-char block-end) + (beginning-of-line) + (unless (looking-at-p org-dblock-end-re) + (setq unfold? t))) + ;; there should be no #+end anywhere in the block body + (save-excursion + (goto-char block-begin) + (when (save-excursion + (re-search-forward org-dblock-end-re + (max (point) + (1- (save-excursion + (goto-char block-end) + (line-beginning-position)))) + 't)) + (setq unfold? t))) + ;; there should be no new entry anywhere in the block body + (save-excursion + (goto-char block-begin) + (when (save-excursion + (let ((case-fold-search t)) + (re-search-forward org-outline-regexp-bol + (max (point) + (1- (save-excursion + (goto-char block-end) + (line-beginning-position)))) + 't))) + (setq unfold? t))) + + (when unfold? (org-flag-region block-begin block-end nil 'org-hide-block)))) + + (setq pos + (next-single-char-property-change pos + (org--get-buffer-local-invisible-property-symbol 'org-hide-block))))))) + (defvar org-mode-map) (defvar org-inhibit-startup-visibility-stuff nil) ; Dynamically-scoped param. (defvar org-agenda-keep-modes nil) ; Dynamically-scoped param. @@ -4789,6 +4937,7 @@ The following commands are available: (org-install-agenda-files-menu) (when org-link-descriptive (add-to-invisibility-spec '(org-link))) (add-to-invisibility-spec '(org-hide-block . t)) + (add-to-invisibility-spec '(org-hide-drawer . t)) (setq-local outline-regexp org-outline-regexp) (setq-local outline-level 'org-outline-level) (setq bidi-paragraph-direction 'left-to-right) @@ -4817,6 +4966,8 @@ The following commands are available: ;; Activate before-change-function (setq-local org-table-may-need-update t) (add-hook 'before-change-functions 'org-before-change-function nil 'local) + ;; Activate after-change-function + (add-hook 'after-change-functions 'org-after-change-function nil 'local) ;; Check for running clock before killing a buffer (add-hook 'kill-buffer-hook 'org-check-running-clock nil 'local) ;; Initialize macros templates. @@ -4868,6 +5019,10 @@ The following commands are available: (setq-local outline-isearch-open-invisible-function (lambda (&rest _) (org-show-context 'isearch))) + ;; Make isearch search in blocks hidden via text properties + (setq-local isearch-filter-predicate #'org--isearch-filter-predicate) + (add-hook 'isearch-mode-end-hook #'org--clear-isearch-overlays nil 'local) + ;; Setup the pcomplete hooks (setq-local pcomplete-command-completion-function #'org-pcomplete-initial) (setq-local pcomplete-command-name-function #'org-command-at-point) @@ -5049,8 +5204,8 @@ stacked delimiters is N. Escaping delimiters is not possible." (when verbatim? (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) - (remove-text-properties (match-beginning 2) (match-end 2) - '(display t invisible t intangible t))) + (org-remove-text-properties (match-beginning 2) (match-end 2) + '(display t invisible t intangible t))) (add-text-properties (match-beginning 2) (match-end 2) '(font-lock-multiline t org-emphasis t)) (when (and org-hide-emphasis-markers @@ -5165,7 +5320,7 @@ This includes angle, plain, and bracket links." (if (not (eq 'bracket style)) (add-text-properties start end properties) ;; Handle invisible parts in bracket links. - (remove-text-properties start end '(invisible nil)) + (org-remove-text-properties start end '(invisible nil)) (let ((hidden (append `(invisible ,(or (org-link-get-parameter type :display) @@ -5185,8 +5340,8 @@ This includes angle, plain, and bracket links." (defun org-activate-code (limit) (when (re-search-forward "^[ \t]*\\(:\\(?: .*\\|$\\)\n?\\)" limit t) (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) - (remove-text-properties (match-beginning 0) (match-end 0) - '(display t invisible t intangible t)) + (org-remove-text-properties (match-beginning 0) (match-end 0) + '(display t invisible t intangible t)) t)) (defcustom org-src-fontify-natively t @@ -5257,8 +5412,8 @@ by a #." (setq block-end (match-beginning 0)) ; includes the final newline. (when quoting (org-remove-flyspell-overlays-in bol-after-beginline nl-before-endline) - (remove-text-properties beg end-of-endline - '(display t invisible t intangible t))) + (org-remove-text-properties beg end-of-endline + '(display t invisible t intangible t))) (add-text-properties beg end-of-endline '(font-lock-fontified t font-lock-multiline t)) (org-remove-flyspell-overlays-in beg bol-after-beginline) @@ -5312,9 +5467,9 @@ by a #." '(font-lock-fontified t face org-document-info)))) ((string-prefix-p "+caption" dc1) (org-remove-flyspell-overlays-in (match-end 2) (match-end 0)) - (remove-text-properties (match-beginning 0) (match-end 0) - '(display t invisible t intangible t)) - ;; Handle short captions + (org-remove-text-properties (match-beginning 0) (match-end 0) + '(display t invisible t intangible t)) + ;; Handle short captions. (save-excursion (beginning-of-line) (looking-at (rx (group (zero-or-more blank) @@ -5335,8 +5490,8 @@ by a #." '(font-lock-fontified t face font-lock-comment-face))) (t ;; Just any other in-buffer setting, but not indented (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) - (remove-text-properties (match-beginning 0) (match-end 0) - '(display t invisible t intangible t)) + (org-remove-text-properties (match-beginning 0) (match-end 0) + '(display t invisible t intangible t)) (add-text-properties beg (match-end 0) '(font-lock-fontified t face org-meta-line)) t)))))) @@ -5721,35 +5876,59 @@ needs to be inserted at a specific position in the font-lock sequence.") (decompose-region (point-min) (point-max)) (message "Entities are now displayed as plain text")))) -(defvar-local org-custom-properties-overlays nil - "List of overlays used for custom properties.") +(defvar-local org-custom-properties-hidden-p nil + "Non-nil when custom properties are hidden.") + +(defcustom org-custom-properties-hide-emptied-drawers nil + "Non-nil means that drawers containing only `org-custom-properties' will be hidden together with the properties." + :group 'org + :type '(choice + (const :tag "Don't hide emptied drawers" nil) + (const :tag "Hide emptied drawers" t))) (defun org-toggle-custom-properties-visibility () "Display or hide properties in `org-custom-properties'." (interactive) - (if org-custom-properties-overlays - (progn (mapc #'delete-overlay org-custom-properties-overlays) - (setq org-custom-properties-overlays nil)) + (require 'org-macs) + (add-to-invisibility-spec 'org-hide-custom-property) + (add-to-list 'org--invisible-spec-priority-list 'org-hide-custom-property) + (if org-custom-properties-hidden-p + (let (match) + (setq org-custom-properties-hidden-p nil) + (org-with-wide-buffer + (goto-char (point-min)) + (with-silent-modifications + (while (setq match (text-property-search-forward (org--get-buffer-local-invisible-property-symbol 'org-hide-custom-property) 'org-hide-custom-property t)) + (org-flag-region (prop-match-beginning match) + (prop-match-end match) + nil 'org-hide-custom-property))))) (when org-custom-properties + (setq org-custom-properties-hidden-p t) (org-with-wide-buffer - (goto-char (point-min)) - (let ((regexp (org-re-property (regexp-opt org-custom-properties) t t))) + (let* ((regexp (org-re-property (regexp-opt org-custom-properties) t t)) + (regexp-drawer (format "%s\n\\(?:%s\\)+\n%s" + (replace-regexp-in-string "\\$$" "" org-drawer-regexp) + (replace-regexp-in-string "\\(^\\^\\|\\$$\\)" "" regexp) + (replace-regexp-in-string "^\\^" "" org-property-end-re)))) + + (when org-custom-properties-hide-emptied-drawers + (goto-char (point-min)) + (while (re-search-forward regexp-drawer nil t) + (with-silent-modifications + (org-flag-region (1- (match-beginning 0)) (match-end 0) t 'org-hide-custom-property)))) + + (goto-char (point-min)) (while (re-search-forward regexp nil t) (let ((end (cdr (save-match-data (org-get-property-block))))) (when (and end (< (point) end)) ;; Hide first custom property in current drawer. - (let ((o (make-overlay (match-beginning 0) (1+ (match-end 0))))) - (overlay-put o 'invisible t) - (overlay-put o 'org-custom-property t) - (push o org-custom-properties-overlays)) - ;; Hide additional custom properties in the same drawer. - (while (re-search-forward regexp end t) - (let ((o (make-overlay (match-beginning 0) (1+ (match-end 0))))) - (overlay-put o 'invisible t) - (overlay-put o 'org-custom-property t) - (push o org-custom-properties-overlays))))) - ;; Each entry is limited to a single property drawer. - (outline-next-heading))))))) + (with-silent-modifications + (org-flag-region (match-beginning 0) (1+ (match-end 0)) t 'org-hide-custom-property) + ;; Hide additional custom properties in the same drawer. + (while (re-search-forward regexp end t) + (org-flag-region (match-beginning 0) (1+ (match-end 0)) t 'org-hide-custom-property)))))) + ;; Each entry is limited to a single property drawer. + (outline-next-heading)))))) (defun org-fontify-entities (limit) "Find an entity to fontify." @@ -5858,10 +6037,11 @@ If TAG is a number, get the corresponding match group." (inhibit-modification-hooks t) deactivate-mark buffer-file-name buffer-file-truename) (decompose-region beg end) - (remove-text-properties beg end - '(mouse-face t keymap t org-linked-text t - invisible t intangible t - org-emphasis t)) + (org-remove-text-properties beg end + '(mouse-face t keymap t org-linked-text t + invisible t + intangible t + org-emphasis t)) (org-remove-font-lock-display-properties beg end))) (defconst org-script-display '(((raise -0.3) (height 0.7)) @@ -5969,6 +6149,29 @@ open and agenda-wise Org files." ;;;; Headlines visibility +(defun org-hide-entry () + "Hide the body directly following this heading." + (interactive) + (save-excursion + (outline-back-to-heading) + (outline-end-of-heading) + (org-flag-region (point) (progn (outline-next-preface) (point)) t 'outline))) + +(defun org-hide-subtree () + "Hide everything after this heading at deeper levels." + (interactive) + (org-flag-subtree t)) + +(defun org-hide-sublevels (levels) + "Hide everything but the top LEVELS levels of headers, in whole buffer. +This also unhides the top heading-less body, if any. + +Interactively, the prefix argument supplies the value of LEVELS. +When invoked without a prefix argument, LEVELS defaults to the level +of the current heading, or to 1 if the current line is not a heading." + (cl-letf (((symbol-function 'outline-flag-region) #'org-flag-region)) + (org-hide-sublevels levels))) + (defun org-show-entry () "Show the body directly following this heading. Show the heading too, if it is currently invisible." @@ -5980,13 +6183,24 @@ Show the heading too, if it is currently invisible." (line-end-position 0) (save-excursion (if (re-search-forward - (concat "[\r\n]\\(" org-outline-regexp "\\)") nil t) + (concat "[\r\n]\\(" (org-get-limited-outline-regexp) "\\)") nil t) (match-beginning 1) (point-max))) nil 'outline) (org-cycle-hide-drawers 'children)))) +(defun org-show-heading () + "Show the current heading and move to its end." + (org-flag-region (- (point) + (if (bobp) 0 + (if (and outline-blank-line + (eq (char-before (1- (point))) ?\n)) + 2 1))) + (progn (outline-end-of-heading) (point)) + nil + 'outline)) + (defun org-show-children (&optional level) "Show all direct subheadings of this heading. Prefix arg LEVEL is how many levels below the current level @@ -6030,6 +6244,11 @@ heading to appear." (org-flag-region (point) (save-excursion (org-end-of-subtree t t)) nil 'outline)) +(defun org-show-branches () + "Show all subheadings of this heading, but not their bodies." + (interactive) + (org-show-children 1000)) + ;;;; Blocks and drawers visibility (defun org--hide-wrapper-toggle (element category force no-error) @@ -6062,7 +6281,9 @@ Return a non-nil value when toggling is successful." ;; at the block closing line. (unless (let ((eol (line-end-position))) (and (> eol start) (/= eol end))) - (let* ((spec (if (eq category 'block) 'org-hide-block 'outline)) + (let* ((spec (cond ((eq category 'block) 'org-hide-block) + ((eq category 'drawer) 'org-hide-drawer) + (t 'outline))) (flag (cond ((eq force 'off) nil) (force t) @@ -6115,24 +6336,24 @@ Return a non-nil value when toggling is successful." (defun org-hide-drawer-all () "Fold all drawers in the current buffer." + (org-show-all '(drawers)) (save-excursion (goto-char (point-min)) (while (re-search-forward org-drawer-regexp nil t) - (let* ((pair (get-char-property-and-overlay (line-beginning-position) - 'invisible)) - (o (cdr-safe pair))) - (if (overlayp o) (goto-char (overlay-end o)) ;invisible drawer - (pcase (get-char-property-and-overlay (point) 'invisible) - (`(outline . ,o) (goto-char (overlay-end o))) ;already folded - (_ - (let* ((drawer (org-element-at-point)) - (type (org-element-type drawer))) - (when (memq type '(drawer property-drawer)) - (org-hide-drawer-toggle t nil drawer) - ;; Make sure to skip drawer entirely or we might flag it - ;; another time when matching its ending line with - ;; `org-drawer-regexp'. - (goto-char (org-element-property :end drawer))))))))))) + (let* ((drawer (org-element-at-point)) + (type (org-element-type drawer))) + (when (memq type '(drawer property-drawer)) + ;; We are sure regular drawers are unfolded because of + ;; `org-show-all' call above. However, property drawers may + ;; be folded, or in a folded headline. In that case, do not + ;; re-hide it. + (unless (and (eq type 'property-drawer) + (eq 'org-hide-drawer (get-char-property (point) 'invisible))) + (org-hide-drawer-toggle t nil drawer)) + ;; Make sure to skip drawer entirely or we might flag it + ;; another time when matching its ending line with + ;; `org-drawer-regexp'. + (goto-char (org-element-property :end drawer))))))) (defun org-cycle-hide-drawers (state) "Re-hide all drawers after a visibility state change. @@ -6147,9 +6368,10 @@ STATE should be one of the symbols listed in the docstring of (t (save-excursion (org-end-of-subtree t t)))))) (org-with-point-at beg (while (re-search-forward org-drawer-regexp end t) - (pcase (get-char-property-and-overlay (point) 'invisible) + (pcase (get-char-property (point) 'invisible) ;; Do not fold already folded drawers. - (`(outline . ,o) (goto-char (overlay-end o))) + ('outline + (goto-char (min end (next-single-char-property-change (point) 'invisible)))) (_ (let ((drawer (org-element-at-point))) (when (memq (org-element-type drawer) '(drawer property-drawer)) @@ -6172,31 +6394,13 @@ By default, the function expands headings, blocks and drawers. When optional argument TYPE is a list of symbols among `blocks', `drawers' and `headings', to only expand one specific type." (interactive) - (let ((types (or types '(blocks drawers headings)))) - (when (memq 'blocks types) - (org-flag-region (point-min) (point-max) nil 'org-hide-block)) - (cond - ;; Fast path. Since headings and drawers share the same - ;; invisible spec, clear everything in one go. - ((and (memq 'headings types) - (memq 'drawers types)) - (org-flag-region (point-min) (point-max) nil 'outline)) - ((memq 'headings types) - (org-flag-region (point-min) (point-max) nil 'outline) - (org-cycle-hide-drawers 'all)) - ((memq 'drawers types) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward org-drawer-regexp nil t) - (let* ((pair (get-char-property-and-overlay (line-beginning-position) - 'invisible)) - (o (cdr-safe pair))) - (if (overlayp o) (goto-char (overlay-end o)) - (pcase (get-char-property-and-overlay (point) 'invisible) - (`(outline . ,o) - (goto-char (overlay-end o)) - (delete-overlay o)) - (_ nil)))))))))) + (dolist (type (or types '(blocks drawers headings))) + (org-flag-region (point-min) (point-max) nil + (pcase type + (`blocks 'org-hide-block) + (`drawers 'org-hide-drawer) + (`headings 'outline) + (_ (error "Invalid type: %S" type)))))) ;;;###autoload (defun org-cycle (&optional arg) @@ -6552,7 +6756,7 @@ With a numeric prefix, show all headlines up to that level." (org-narrow-to-subtree) (org-content)))) ((or "all" "showall") - (outline-show-subtree)) + (org-show-subtree)) (_ nil))) (org-end-of-subtree))))))) @@ -6625,7 +6829,7 @@ This function is the default value of the hook `org-cycle-hook'." (while (re-search-forward re nil t) (when (and (not (org-invisible-p)) (org-invisible-p (line-end-position))) - (outline-hide-entry)))) + (org-hide-entry)))) (org-cycle-hide-drawers 'all) (org-cycle-show-empty-lines 'overview))))) @@ -6697,10 +6901,11 @@ information." (org-show-entry) ;; If point is hidden within a drawer or a block, make sure to ;; expose it. - (dolist (o (overlays-at (point))) - (when (memq (overlay-get o 'invisible) - '(org-hide-block org-hide-drawer outline)) - (delete-overlay o))) + (when (memq (get-text-property (point) 'invisible) + '(org-hide-block org-hide-drawer)) + (let ((spec (get-text-property (point) 'invisible)) + (region (org--find-text-property-region (point) 'invisible))) + (org-flag-region (car region) (cdr region) nil spec))) (unless (org-before-first-heading-p) (org-with-limited-levels (cl-case detail @@ -6916,9 +7121,10 @@ unconditionally." ;; When INVISIBLE-OK is non-nil, ensure newly created headline ;; is visible. (unless invisible-ok - (pcase (get-char-property-and-overlay (point) 'invisible) - (`(outline . ,o) - (move-overlay o (overlay-start o) (line-end-position 0))) + (pcase (get-char-property (point) 'invisible) + ('outline + (let ((region (org--find-text-property-region (point) 'invisible))) + (org-flag-region (line-end-position 0) (cdr region) nil 'outline))) (_ nil)))) ;; At a headline... ((org-at-heading-p) @@ -7515,7 +7721,6 @@ case." (setq txt (buffer-substring beg end)) (org-save-markers-in-region beg end) (delete-region beg end) - (org-remove-empty-overlays-at beg) (unless (= beg (point-min)) (org-flag-region (1- beg) beg nil 'outline)) (unless (bobp) (org-flag-region (1- (point)) (point) nil 'outline)) (and (not (bolp)) (looking-at "\n") (forward-char 1)) @@ -7677,7 +7882,7 @@ When REMOVE is non-nil, remove the subtree from the clipboard." (skip-chars-forward " \t\n\r") (setq beg (point)) (when (and (org-invisible-p) visp) - (save-excursion (outline-show-heading))) + (save-excursion (org-show-heading))) ;; Shift if necessary. (unless (= shift 0) (save-restriction @@ -8119,7 +8324,7 @@ function is being called interactively." (point)) what "children") (goto-char start) - (outline-show-subtree) + (org-show-subtree) (outline-next-heading)) (t ;; we will sort the top-level entries in this file @@ -10736,7 +10941,8 @@ narrowing." (let ((beg (point))) (insert ":" drawer ":\n:END:\n") (org-indent-region beg (point)) - (org-flag-region (line-end-position -1) (1- (point)) t 'outline)) + (org-flag-region + (line-end-position -1) (1- (point)) t 'org-hide-drawer)) (end-of-line -1))))) (t (org-end-of-meta-data org-log-state-notes-insert-after-drawers) @@ -13173,7 +13379,7 @@ drawer is immediately hidden." (inhibit-read-only t)) (unless (bobp) (insert "\n")) (insert ":PROPERTIES:\n:END:") - (org-flag-region (line-end-position 0) (point) t 'outline) + (org-flag-region (line-end-position 0) (point) t 'org-hide-drawer) (when (or (eobp) (= begin (point-min))) (insert "\n")) (org-indent-region begin (point)))))) @@ -16553,7 +16759,7 @@ The detailed reaction depends on the user option `org-catch-invisible-edits'." (when (or invisible-at-point invisible-before-point) (when (eq org-catch-invisible-edits 'error) (user-error "Editing in invisible areas is prohibited, make them visible first")) - (if (and org-custom-properties-overlays + (if (and org-custom-properties-hidden-p (y-or-n-p "Display invisible properties in this buffer? ")) (org-toggle-custom-properties-visibility) ;; Make the area visible @@ -17636,11 +17842,11 @@ Move point to the beginning of first heading or end of buffer." (defun org-show-branches-buffer () "Show all branches in the buffer." (org-flag-above-first-heading) - (outline-hide-sublevels 1) + (org-hide-sublevels 1) (unless (eobp) - (outline-show-branches) + (org-show-branches) (while (outline-get-next-sibling) - (outline-show-branches))) + (org-show-branches))) (goto-char (point-min))) (defun org-kill-note-or-show-branches () @@ -17654,8 +17860,8 @@ Move point to the beginning of first heading or end of buffer." (t (let ((beg (progn (org-back-to-heading) (point))) (end (save-excursion (org-end-of-subtree t t) (point)))) - (outline-hide-subtree) - (outline-show-branches) + (org-hide-subtree) + (org-show-branches) (org-hide-archived-subtrees beg end))))) (defun org-delete-indentation (&optional arg) @@ -17811,9 +18017,9 @@ Otherwise, call `org-show-children'. ARG is the level to hide." (if (org-before-first-heading-p) (progn (org-flag-above-first-heading) - (outline-hide-sublevels (or arg 1)) + (org-hide-sublevels (or arg 1)) (goto-char (point-min))) - (outline-hide-subtree) + (org-hide-subtree) (org-show-children arg)))) (defun org-ctrl-c-star () @@ -20489,20 +20695,20 @@ With ARG, repeats or can move backward if negative." (end-of-line)) (while (and (< arg 0) (re-search-backward regexp nil :move)) (unless (bobp) - (while (pcase (get-char-property-and-overlay (point) 'invisible) - (`(outline . ,o) - (goto-char (overlay-start o)) - (re-search-backward regexp nil :move)) - (_ nil)))) + (pcase (get-char-property (point) 'invisible) + ('outline + (goto-char (car (org--find-text-property-region (point) 'invisible))) + (beginning-of-line)) + (_ nil))) (cl-incf arg)) - (while (and (> arg 0) (re-search-forward regexp nil t)) - (while (pcase (get-char-property-and-overlay (point) 'invisible) - (`(outline . ,o) - (goto-char (overlay-end o)) - (re-search-forward regexp nil :move)) - (_ - (end-of-line) - nil))) ;leave the loop + (while (and (> arg 0) (re-search-forward regexp nil :move)) + (pcase (get-char-property (point) 'invisible) + ('outline + (goto-char (cdr (org--find-text-property-region (point) 'invisible))) + (skip-chars-forward " \t\n") + (end-of-line)) + (_ + (end-of-line))) (cl-decf arg)) (if (> arg 0) (goto-char (point-max)) (beginning-of-line)))) @@ -20957,6 +21163,80 @@ Started from `gnus-info-find-node'." (t default-org-info-node)))))) \f + +;;; Make isearch search in some text hidden via text propertoes + +(defvar org--isearch-overlays nil + "List of overlays temporarily created during isearch. +This is used to allow searching in regions hidden via text properties. +As for [2020-05-09 Sat], Isearch only has special handling of hidden overlays. +Any text hidden via text properties is not revealed even if `search-invisible' +is set to 't.") + +;; Not sure if it needs to be a user option +;; One might want to reveal hidden text in, for example, hidden parts of the links. +;; Currently, hidden text in links is never revealed by isearch. +(defvar org-isearch-specs '(org-hide-block + org-hide-drawer) + "List of text invisibility specs to be searched by isearch. +By default ([2020-05-09 Sat]), isearch does not search in hidden text, +which was made invisible using text properties. Isearch will be forced +to search in hidden text with any of the listed 'invisible property value.") + +(defun org--create-isearch-overlays (beg end) + "Replace text property invisibility spec by overlays between BEG and END. +All the regions with invisibility text property spec from +`org-isearch-specs' will be changed to use overlays instead +of text properties. The created overlays will be stored in +`org--isearch-overlays'." + (let ((pos beg)) + (while (< pos end) + (when-let* ((spec (get-text-property pos 'invisible)) + (spec (memq spec org-isearch-specs)) + (region (org--find-text-property-region pos 'invisible))) + (setq spec (get-text-property pos 'invisible)) + ;; Changing text properties is considered buffer modification. + ;; We do not want it here. + (with-silent-modifications + ;; The overlay is modelled after `org-flag-region' [2020-05-09 Sat] + ;; overlay for 'outline blocks. + (let ((o (make-overlay (car region) (cdr region) nil 'front-advance))) + (overlay-put o 'evaporate t) + (overlay-put o 'invisible spec) + ;; `delete-overlay' here means that spec information will be lost + ;; for the region. The region will remain visible. + (overlay-put o 'isearch-open-invisible #'delete-overlay) + (push o org--isearch-overlays)) + (org-flag-region (car region) (cdr region) nil spec))) + (setq pos (next-single-property-change pos 'invisible nil end))))) + +(defun org--isearch-filter-predicate (beg end) + "Return non-nil if text between BEG and END is deemed visible by Isearch. +This function is intended to be used as `isearch-filter-predicate'. +Unlike `isearch-filter-visible', make text with 'invisible text property +value listed in `org-isearch-specs' visible to Isearch." + (org--create-isearch-overlays beg end) ;; trick isearch by creating overlays in place of invisible text + (isearch-filter-visible beg end)) + +(defun org--clear-isearch-overlay (ov) + "Convert OV region back into using text properties." + (when-let ((spec (overlay-get ov 'invisible))) ;; ignore deleted overlays + ;; Changing text properties is considered buffer modification. + ;; We do not want it here. + (with-silent-modifications + (org-flag-region (overlay-start ov) (overlay-end ov) t spec))) + (when (member ov isearch-opened-overlays) + (setq isearch-opened-overlays (delete ov isearch-opened-overlays))) + (delete-overlay ov)) + +(defun org--clear-isearch-overlays () + "Convert overlays from `org--isearch-overlays' back into using text properties." + (when org--isearch-overlays + (mapc #'org--clear-isearch-overlay org--isearch-overlays) + (setq org--isearch-overlays nil))) + +\f + ;;; Finish up (add-hook 'org-mode-hook ;remove overlays when changing major mode [-- Attachment #3: Type: text/plain, Size: 12921 bytes --] Ihor Radchenko <yantar92@gmail.com> writes: > Hello, > > [The patch itself will be provided in the following email] > > I have four more updates from the previous version of the patch: > > 1. All the code handling modifications in folded drawers/blocks is moved > to after-change-function. It works as follows: > - if any text is inserted in the middle of hidden region, that text > is also hidden; > - if BEGIN/END line of a folded drawer do not match org-drawer-regexp > and org-property-end-re, unfold it; > - if org-property-end-re or new org-outline-regexp-bol is inserted in > the middle of the drawer, unfold it; > - the same logic for blocks. > > 2. The text property stack is rewritten using char-property-alias-alist. > This is faster in comparison with previous approach, which involved > modifying all the text properties every timer org-flag-region was > called. > > 3. org-toggle-custom-properties-visibility is rewritten using text > properties. I also took a freedom to implement a new feature here. > Now, setting new `org-custom-properties-hide-emptied-drawers' to > non-nil will result in hiding the whole property drawer if it > contains only org-custom-properties. > > 4. This patch should work against 1aa095ccf. However, the merge was not > trivial here. Recent commits actively used the fact that drawers and > outlines are hidden via 'outline invisibility spec, which is not the > case in this branch. I am not confident that I did not break anything > during the merge, especially 1aa095ccf. > > ----------------------------------------------------------------------- > ----------------------------------------------------------------------- > > More details on the new implementation for tracking changes: > >> I gave you a few ideas to quickly check if a change requires expansion, >> in an earlier mail. I suggest to start out from that. Let me know if you >> have questions about it. > > All the code lives in org-after-change-function. I tried to incorporate > the earlier Nicholas' suggestions, except the parts related to > intersecting blocks and drawers. I am not sure if I understand the > parsing priority of blocks vs. drawers. > > ----------------------------------------------------------------------- > ----------------------------------------------------------------------- > > More details on the text property stack: > > The earlier version of the code literally used stack to save > pre-existing 'invisibility specs in org-flag-region. This was done on > every invocation of org-flag-region, which made org-flag-region > significantly slower. I re-implemented the same feature using > char-property-alias-alist. Now, different invisibility specs live in > separate text properties and can be safely modified independently. The > specs are applied according to org--invisible-spec-priority-list. A side > effect of current implementation is that char-property-alias-alist is > fully controlled by org. All the pre-existing settings for 'invisible > text property will be overwritten by org. > >> `gensym' is just a shorter, and somewhat standard way, to create a new >> uninterned symbol with a given prefix. You seem to re-invent it. What >> you do with that new symbol is orthogonal to that suggestion, of course. > > I do not think that `gensym' is suitable here. We don't want a new > symbol every time org--get-buffer-local-invisible-property-symbol is > called. It should return the same symbol if it is called from the same > buffer multiple times. > > ----------------------------------------------------------------------- > ----------------------------------------------------------------------- > > More details on the org-toggle-custom-properties-visibility: > > The implementation showcases how to introduce new invisibility specs to > org. Apart from expected (add-to-invisibility-spec 'org-hide-custom-property) > one also needs to add the spec into org--invisible-spec-priority-list: > > (add-to-list 'org--invisible-spec-priority-list 'org-hide-custom-property) > > Searching for text with the given invisibility spec is done as > follows: > > (text-property-search-forward (org--get-buffer-local-invisible-property-symbol 'org-hide-custom-property) 'org-hide-custom-property t) > > This last piece of code is probably not the most elegant. I am thinking > if creating some higher-level interface would be more reasonable here. > What do you think? > > > The new customisation `org-custom-properties-hide-emptied-drawers' > sounds logical for me since empty property drawers left after invoking > org-toggle-custom-properties-visibility are rather useless according to > my experience. If one already wants to hide parts of property drawers, I > do not see a reason to show leftover > > :PROPERTIES: > :END: > > ----------------------------------------------------------------------- > ----------------------------------------------------------------------- > > More details on the merge with the latest master: > > I tried my best to not break anything. However, I am not sure if I > understand all the recent commits. Could someone take a look if there is > anything suspicious in org-next-visible-heading? > > Also, I have seen some optimisations making use of the fact that drawers > and headlines both use 'outline invisibility spec. This change in the > implementation details supposed to improve performance and should not be > necessary if this patch is going to be merged. Would it be possible to > refrain from abusing this particular implementation detail in the > nearest commits on master (unless really necessary)? > > ----------------------------------------------------------------------- > ----------------------------------------------------------------------- > > Further work: > > I would like to finalise the current patch and work on other code using > overlays separately. This patch is already quite complicated as is. I do > not want to introduce even more potential bugs by working on things not > directly affected by this version of the patch. > > Best, > Ihor > > > Nicolas Goaziou <mail@nicolasgoaziou.fr> writes: > >> Ihor Radchenko <yantar92@gmail.com> writes: >> >>>> See also `gensym'. Do we really need to use it for something else than >>>> `invisible'? If not, the tool doesn't need to be generic. >>> >>> For now, I also use it for buffer-local 'invisible stack. The stack is >>> needed to preserve folding state of drawers/blocks inside folded >>> outline. Though I am thinking about replacing the stack with separate >>> text properties, like 'invisible-outline-buffer-local + >>> 'invisible-drawer-buffer-local + 'invisible-block-buffer-local. >>> Maintaining stack takes a noticeable percentage of CPU time in profiler. >>> >>> org--get-buffer-local-text-property-symbol must take care about >>> situation with indirect buffers. When an indirect buffer is created from >>> some org buffer, the old value of char-property-alias-alist is carried >>> over. We need to detect this case and create new buffer-local symbol, >>> which is unique to the newly created buffer (but not create it if the >>> buffer-local property is already there). Then, the new symbol must >>> replace the old alias in char-property-alias-alist + old folding state >>> must be preserved (via copying the old invisibility specs into the new >>> buffer-local text property). I do not see how gensym can benefit this >>> logic. >> >> `gensym' is just a shorter, and somewhat standard way, to create a new >> uninterned symbol with a given prefix. You seem to re-invent it. What >> you do with that new symbol is orthogonal to that suggestion, of course. >> >>>> OK, but this may not be sufficient if we want to do slightly better than >>>> overlays in that area. This is not mandatory, though. >>> >>> Could you elaborate on what can be "slightly better"? >> >> IIRC, I gave examples of finer control of folding state after a change. >> Consider this _folded_ drawer: >> >> :BEGIN: >> Foo >> :END: >> >> Inserting ":END" in it should not unfold it, as it is currently the case >> with overlays, >> >> :BEGIN >> Foo >> :END >> :END: >> >> but a soon as the last ":" is inserted, the initial drawer could be >> expanded. >> >> :BEGIN >> Foo >> :END: >> :END: >> >> The latter case is not currently handled by overlays. This is what >> I call "slightly better". >> >> Also, note that this change is not related to opening and closing lines >> of the initial drawer, so sticking text properties on them would not >> help here. >> >> Another case is modifying those borders, e.g., >> >> >> :BEGIN: :BEGIN: >> Foo ------> Foo >> :END: :ND: >> >> which should expand the drawer. Your implementation catches this, but >> I'm pointing out that current implementation with overlays does not. >> Even though that's not strictly required for compatibility with >> overlays, it is a welcome slight improvement. >> >>>> As discussed before, I don't think you need to use `modification-hooks' >>>> or `insert-behind-hooks' if you already use `after-change-functions'. >>>> >>>> `after-change-functions' are also triggered upon text properties >>>> changes. So, what is the use case for the other hooks? >>> >>> The problem is that `after-change-functions' cannot be a text property. >>> Only `modification-hooks' and `insert-in-front/behind-hooks' can be a >>> valid text property. If we use `after-change-functions', they will >>> always be triggered, regardless if the change was made inside or outside >>> folded region. >> >> As discussed, text properties are local to the change, but require extra >> care when moving text around. You also observed serious overhead when >> using them. >> >> OTOH, even if `a-c-f' is not local, you can quickly determine if the >> change altered a folded element, so the overhead is limited, i.e., >> mostly checking for a text property at a given buffer position. >> >> To be clear, I initially thought that text properties were a superior >> choice, but I changed my mind a while ago, and I thought you had, too. >> IOW, `after-change-functions' is the way to go, since you have no strong >> reason to stick to text properties for this kind of function. >> >>>>> :asd: >>>>> :drawer: >>>>> lksjdfksdfjl >>>>> sdfsdfsdf >>>>> :end: >>>>> >>>>> If :asd: was inserted in front of folded :drawer:, changes in :drawer: >>>>> line of the new folded :asd: drawer would reveal the text between >>>>> :drawer: and :end:. >>>>> >>>>> Let me know what you think on this. >>> >>>> I have first to understand the use case for `modification-hook'. But >>>> I think unfolding is the right thing to do in this situation, isn't it? >>> >>> That situation arises because the modification-hooks from ":drawer:" >>> (they are set via text properties) only have information about the >>> :drawer:...:end: drawer before the modifications (they were set when >>> :drawer: was folded last time). So, they will only unfold a part of the >>> new :asd: drawer. I do not see a simple way to unfold everything without >>> re-parsing the drawer around the changed text. >> >> Oh! I misread your message. I withdraw what I wrote. In this case, we >> don't want to unfold anything. The situation is not worse than what we >> have now, and trying to fix it would have repercussions down in the >> buffer, e.g., expanding drawers screen below. >> >> As a rule of thumb, I think we can pay attention to changes in the >> folded text, and its immediate surroundings (e.g., the opening line, >> which is not folded), but no further. >> >> As written above, slight changes are welcome, but let's not go overboard >> and parse a whole section just to know if we can expand a drawer. >> >>> Actually, I am quite unhappy with the performance of modification-hooks >>> set via text properties (I am using this patch on my Emacs during this >>> week). It appears that setting the text properties costs a significant >>> CPU time in practice, even though running the hooks is pretty fast. >>> I will think about a way to handle modifications using global >>> after-change-functions. >> >> That's better, IMO. >> >> I gave you a few ideas to quickly check if a change requires expansion, >> in an earlier mail. I suggest to start out from that. Let me know if you >> have questions about it. > > -- > Ihor Radchenko, > PhD, > Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) > State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China > Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply related [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-06-08 5:05 ` Ihor Radchenko 2020-06-08 5:06 ` Ihor Radchenko @ 2020-06-08 5:08 ` Ihor Radchenko 2020-06-10 17:14 ` Nicolas Goaziou 2 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2020-06-08 5:08 UTC (permalink / raw) To: Nicolas Goaziou; +Cc: emacs-orgmode Github link to the patch: https://gist.github.com/yantar92/6447754415457927293acda43a7fcaef Ihor Radchenko <yantar92@gmail.com> writes: > Hello, > > [The patch itself will be provided in the following email] > > I have four more updates from the previous version of the patch: > > 1. All the code handling modifications in folded drawers/blocks is moved > to after-change-function. It works as follows: > - if any text is inserted in the middle of hidden region, that text > is also hidden; > - if BEGIN/END line of a folded drawer do not match org-drawer-regexp > and org-property-end-re, unfold it; > - if org-property-end-re or new org-outline-regexp-bol is inserted in > the middle of the drawer, unfold it; > - the same logic for blocks. > > 2. The text property stack is rewritten using char-property-alias-alist. > This is faster in comparison with previous approach, which involved > modifying all the text properties every timer org-flag-region was > called. > > 3. org-toggle-custom-properties-visibility is rewritten using text > properties. I also took a freedom to implement a new feature here. > Now, setting new `org-custom-properties-hide-emptied-drawers' to > non-nil will result in hiding the whole property drawer if it > contains only org-custom-properties. > > 4. This patch should work against 1aa095ccf. However, the merge was not > trivial here. Recent commits actively used the fact that drawers and > outlines are hidden via 'outline invisibility spec, which is not the > case in this branch. I am not confident that I did not break anything > during the merge, especially 1aa095ccf. > > ----------------------------------------------------------------------- > ----------------------------------------------------------------------- > > More details on the new implementation for tracking changes: > >> I gave you a few ideas to quickly check if a change requires expansion, >> in an earlier mail. I suggest to start out from that. Let me know if you >> have questions about it. > > All the code lives in org-after-change-function. I tried to incorporate > the earlier Nicholas' suggestions, except the parts related to > intersecting blocks and drawers. I am not sure if I understand the > parsing priority of blocks vs. drawers. > > ----------------------------------------------------------------------- > ----------------------------------------------------------------------- > > More details on the text property stack: > > The earlier version of the code literally used stack to save > pre-existing 'invisibility specs in org-flag-region. This was done on > every invocation of org-flag-region, which made org-flag-region > significantly slower. I re-implemented the same feature using > char-property-alias-alist. Now, different invisibility specs live in > separate text properties and can be safely modified independently. The > specs are applied according to org--invisible-spec-priority-list. A side > effect of current implementation is that char-property-alias-alist is > fully controlled by org. All the pre-existing settings for 'invisible > text property will be overwritten by org. > >> `gensym' is just a shorter, and somewhat standard way, to create a new >> uninterned symbol with a given prefix. You seem to re-invent it. What >> you do with that new symbol is orthogonal to that suggestion, of course. > > I do not think that `gensym' is suitable here. We don't want a new > symbol every time org--get-buffer-local-invisible-property-symbol is > called. It should return the same symbol if it is called from the same > buffer multiple times. > > ----------------------------------------------------------------------- > ----------------------------------------------------------------------- > > More details on the org-toggle-custom-properties-visibility: > > The implementation showcases how to introduce new invisibility specs to > org. Apart from expected (add-to-invisibility-spec 'org-hide-custom-property) > one also needs to add the spec into org--invisible-spec-priority-list: > > (add-to-list 'org--invisible-spec-priority-list 'org-hide-custom-property) > > Searching for text with the given invisibility spec is done as > follows: > > (text-property-search-forward (org--get-buffer-local-invisible-property-symbol 'org-hide-custom-property) 'org-hide-custom-property t) > > This last piece of code is probably not the most elegant. I am thinking > if creating some higher-level interface would be more reasonable here. > What do you think? > > > The new customisation `org-custom-properties-hide-emptied-drawers' > sounds logical for me since empty property drawers left after invoking > org-toggle-custom-properties-visibility are rather useless according to > my experience. If one already wants to hide parts of property drawers, I > do not see a reason to show leftover > > :PROPERTIES: > :END: > > ----------------------------------------------------------------------- > ----------------------------------------------------------------------- > > More details on the merge with the latest master: > > I tried my best to not break anything. However, I am not sure if I > understand all the recent commits. Could someone take a look if there is > anything suspicious in org-next-visible-heading? > > Also, I have seen some optimisations making use of the fact that drawers > and headlines both use 'outline invisibility spec. This change in the > implementation details supposed to improve performance and should not be > necessary if this patch is going to be merged. Would it be possible to > refrain from abusing this particular implementation detail in the > nearest commits on master (unless really necessary)? > > ----------------------------------------------------------------------- > ----------------------------------------------------------------------- > > Further work: > > I would like to finalise the current patch and work on other code using > overlays separately. This patch is already quite complicated as is. I do > not want to introduce even more potential bugs by working on things not > directly affected by this version of the patch. > > Best, > Ihor > > > Nicolas Goaziou <mail@nicolasgoaziou.fr> writes: > >> Ihor Radchenko <yantar92@gmail.com> writes: >> >>>> See also `gensym'. Do we really need to use it for something else than >>>> `invisible'? If not, the tool doesn't need to be generic. >>> >>> For now, I also use it for buffer-local 'invisible stack. The stack is >>> needed to preserve folding state of drawers/blocks inside folded >>> outline. Though I am thinking about replacing the stack with separate >>> text properties, like 'invisible-outline-buffer-local + >>> 'invisible-drawer-buffer-local + 'invisible-block-buffer-local. >>> Maintaining stack takes a noticeable percentage of CPU time in profiler. >>> >>> org--get-buffer-local-text-property-symbol must take care about >>> situation with indirect buffers. When an indirect buffer is created from >>> some org buffer, the old value of char-property-alias-alist is carried >>> over. We need to detect this case and create new buffer-local symbol, >>> which is unique to the newly created buffer (but not create it if the >>> buffer-local property is already there). Then, the new symbol must >>> replace the old alias in char-property-alias-alist + old folding state >>> must be preserved (via copying the old invisibility specs into the new >>> buffer-local text property). I do not see how gensym can benefit this >>> logic. >> >> `gensym' is just a shorter, and somewhat standard way, to create a new >> uninterned symbol with a given prefix. You seem to re-invent it. What >> you do with that new symbol is orthogonal to that suggestion, of course. >> >>>> OK, but this may not be sufficient if we want to do slightly better than >>>> overlays in that area. This is not mandatory, though. >>> >>> Could you elaborate on what can be "slightly better"? >> >> IIRC, I gave examples of finer control of folding state after a change. >> Consider this _folded_ drawer: >> >> :BEGIN: >> Foo >> :END: >> >> Inserting ":END" in it should not unfold it, as it is currently the case >> with overlays, >> >> :BEGIN >> Foo >> :END >> :END: >> >> but a soon as the last ":" is inserted, the initial drawer could be >> expanded. >> >> :BEGIN >> Foo >> :END: >> :END: >> >> The latter case is not currently handled by overlays. This is what >> I call "slightly better". >> >> Also, note that this change is not related to opening and closing lines >> of the initial drawer, so sticking text properties on them would not >> help here. >> >> Another case is modifying those borders, e.g., >> >> >> :BEGIN: :BEGIN: >> Foo ------> Foo >> :END: :ND: >> >> which should expand the drawer. Your implementation catches this, but >> I'm pointing out that current implementation with overlays does not. >> Even though that's not strictly required for compatibility with >> overlays, it is a welcome slight improvement. >> >>>> As discussed before, I don't think you need to use `modification-hooks' >>>> or `insert-behind-hooks' if you already use `after-change-functions'. >>>> >>>> `after-change-functions' are also triggered upon text properties >>>> changes. So, what is the use case for the other hooks? >>> >>> The problem is that `after-change-functions' cannot be a text property. >>> Only `modification-hooks' and `insert-in-front/behind-hooks' can be a >>> valid text property. If we use `after-change-functions', they will >>> always be triggered, regardless if the change was made inside or outside >>> folded region. >> >> As discussed, text properties are local to the change, but require extra >> care when moving text around. You also observed serious overhead when >> using them. >> >> OTOH, even if `a-c-f' is not local, you can quickly determine if the >> change altered a folded element, so the overhead is limited, i.e., >> mostly checking for a text property at a given buffer position. >> >> To be clear, I initially thought that text properties were a superior >> choice, but I changed my mind a while ago, and I thought you had, too. >> IOW, `after-change-functions' is the way to go, since you have no strong >> reason to stick to text properties for this kind of function. >> >>>>> :asd: >>>>> :drawer: >>>>> lksjdfksdfjl >>>>> sdfsdfsdf >>>>> :end: >>>>> >>>>> If :asd: was inserted in front of folded :drawer:, changes in :drawer: >>>>> line of the new folded :asd: drawer would reveal the text between >>>>> :drawer: and :end:. >>>>> >>>>> Let me know what you think on this. >>> >>>> I have first to understand the use case for `modification-hook'. But >>>> I think unfolding is the right thing to do in this situation, isn't it? >>> >>> That situation arises because the modification-hooks from ":drawer:" >>> (they are set via text properties) only have information about the >>> :drawer:...:end: drawer before the modifications (they were set when >>> :drawer: was folded last time). So, they will only unfold a part of the >>> new :asd: drawer. I do not see a simple way to unfold everything without >>> re-parsing the drawer around the changed text. >> >> Oh! I misread your message. I withdraw what I wrote. In this case, we >> don't want to unfold anything. The situation is not worse than what we >> have now, and trying to fix it would have repercussions down in the >> buffer, e.g., expanding drawers screen below. >> >> As a rule of thumb, I think we can pay attention to changes in the >> folded text, and its immediate surroundings (e.g., the opening line, >> which is not folded), but no further. >> >> As written above, slight changes are welcome, but let's not go overboard >> and parse a whole section just to know if we can expand a drawer. >> >>> Actually, I am quite unhappy with the performance of modification-hooks >>> set via text properties (I am using this patch on my Emacs during this >>> week). It appears that setting the text properties costs a significant >>> CPU time in practice, even though running the hooks is pretty fast. >>> I will think about a way to handle modifications using global >>> after-change-functions. >> >> That's better, IMO. >> >> I gave you a few ideas to quickly check if a change requires expansion, >> in an earlier mail. I suggest to start out from that. Let me know if you >> have questions about it. > > -- > Ihor Radchenko, > PhD, > Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) > State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China > Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-06-08 5:05 ` Ihor Radchenko 2020-06-08 5:06 ` Ihor Radchenko 2020-06-08 5:08 ` Ihor Radchenko @ 2020-06-10 17:14 ` Nicolas Goaziou 2020-06-21 9:52 ` Ihor Radchenko 2020-08-11 6:45 ` Ihor Radchenko 2 siblings, 2 replies; 192+ messages in thread From: Nicolas Goaziou @ 2020-06-10 17:14 UTC (permalink / raw) To: Ihor Radchenko; +Cc: emacs-orgmode Hello, Ihor Radchenko <yantar92@gmail.com> writes: > [The patch itself will be provided in the following email] Thank you! I'll first make some generic remarks, then comment the diff in more details. > I have four more updates from the previous version of the patch: > > 1. All the code handling modifications in folded drawers/blocks is moved > to after-change-function. It works as follows: > - if any text is inserted in the middle of hidden region, that text > is also hidden; > - if BEGIN/END line of a folded drawer do not match org-drawer-regexp > and org-property-end-re, unfold it; > - if org-property-end-re or new org-outline-regexp-bol is inserted in > the middle of the drawer, unfold it; > - the same logic for blocks. This sounds good, barring a minor error in the regexp for blocks, and missing optimizations. More on this in the detailed comments. > 2. The text property stack is rewritten using char-property-alias-alist. > This is faster in comparison with previous approach, which involved > modifying all the text properties every timer org-flag-region was > called. I'll need information about this, as I'm not sure to fully understand all the consequences of this. But more importantly, this needs to be copiously documented somewhere for future hackers. > 3. org-toggle-custom-properties-visibility is rewritten using text > properties. I also took a freedom to implement a new feature here. > Now, setting new `org-custom-properties-hide-emptied-drawers' to > non-nil will result in hiding the whole property drawer if it > contains only org-custom-properties. I don't think this is a good idea. AFAIR, we always refused to hide completely anything, including empty drawers. The reason is that if the drawer is completely hidden, you cannot expand it easily, or even know there is one. In any case, this change shouldn't belong to this patch set, and should be discussed separately. > 4. This patch should work against 1aa095ccf. However, the merge was not > trivial here. Recent commits actively used the fact that drawers and > outlines are hidden via 'outline invisibility spec, which is not the > case in this branch. I am not confident that I did not break anything > during the merge, especially 1aa095ccf. [...] > Also, I have seen some optimisations making use of the fact that drawers > and headlines both use 'outline invisibility spec. This change in the > implementation details supposed to improve performance and should not be > necessary if this patch is going to be merged. Would it be possible to > refrain from abusing this particular implementation detail in the > nearest commits on master (unless really necessary)? To be clear, I didn't intend to make your life miserable. However, I had to fix regression on drawers visibility before Org 9.4 release. Also, merging invisibility properties for drawers and outline was easier for me. So, I had the opportunity to kill two birds with one stone. As a reminder, Org 9.4 is about to be released, but Org 9.5 will take months to go out. So, even though I hope your changes will land into Org, there is no reason for us to refrain from improving (actually fixing a regression in) 9.4 release. Hopefully, once 9.4 is out, such changes are not expected to happen anymore. I hope you understand. > I would like to finalise the current patch and work on other code using > overlays separately. This patch is already quite complicated as is. I do > not want to introduce even more potential bugs by working on things not > directly affected by this version of the patch. The patch is technically mostly good, but needs more work for integration into Org. First, it includes a few unrelated changes that should be removed (e.g., white space fixes in unrelated parts of the code). Also, as written above, the changes about `org-custom-properties-hide-emptied-drawers' should be removed for the time being. Once done, I think we should move (or copy, first) _all_ folding-related functions into a new "org-fold.el" library. Functions and variables included there should have a proper "org-fold-" prefix. More on this in the detailed report. The functions `org-find-text-property-region', `org-add-to-list-text-property', and `org-remove-from-list-text-property' can be left in "org-macs.el", since they do not directly depend on the `invisible' property. Note the last two functions I mentioned are not used throughout your patch. They might be removed. This first patch can coexist with overlay folding since functions in both mechanisms are named differently. Then, another patch can integrate "org-fold.el" into Org folding. I also suggest to move the Outline -> Org transition to yet another patch. I think there's more work to do on this part. Now, into the details of your patch. The first remarks are: 1. we still support Emacs 24.4 (and probably Emacs 24.3, but I'm not sure), so some functions cannot be used. 2. we don't use "subr-x.el" in the code base. In particular, it would be nice to replace `when-let' with `when' + `let'. This change costs only one loc. 3. Some docstrings need more work. In particular, Emacs documentation expects all arguments to be explained in the docstring, if possible in the order in which they appear. There are exceptions, though. For example, in a function like `org-remove-text-properties', you can mention arguments are simply the same as in `remove-text-properties'. 4. Some refactorization is needed in some places. I mentioned them in the report below. 5. I didn't dive much into the Isearch code so far. I tested it a bit and seems to work nicely. I noticed one bug though. In the following document: #+begin: foo :FOO: bar :END: #+end bar when both the drawer and the block are folded (i.e., you fold the drawer first, then the block), searching for "bar" first find the last one, then overwraps and find the first one. 6. Since we're rewriting folding code, we might as well rename folding properties: org-hide-drawer -> org-fold-drawer, outline -> org-fold-headline… Now, here are more comments about the code. ----- > +(defun org-remove-text-properties (start end properties &optional object) IMO, this generic name doesn't match the specialized nature of the function. It doesn't belong to "org-macs.el", but to the new "Org Fold" library. > + "Remove text properties as in `remove-text-properties', but keep 'invisibility specs for folded regions. Line is too long. Suggestion: Remove text properties except folding-related ones. > +Do not remove invisible text properties specified by 'outline, > +'org-hide-block, and 'org-hide-drawer (but remove i.e. 'org-link) this > +is needed to keep outlines, drawers, and blocks hidden unless they are > +toggled by user. Said properties should be moved into a defconst, e.g., `org-fold-properties', then: Remove text properties as in `remove-text-properties'. See the function for the description of the arguments. However, do not remove invisible text properties defined in `org-fold-properties'. Those are required to keep headlines, drawers and blocks folded. > +Note: The below may be too specific and create troubles if more > +invisibility specs are added to org in future" You can remove the note. If you think the note is important, it should put a comment in the code instead. > + (when (plist-member properties 'invisible) > + (let ((pos start) > + next spec) > + (while (< pos end) > + (setq next (next-single-property-change pos 'invisible nil end) > + spec (get-text-property pos 'invisible)) > + (unless (memq spec (list 'org-hide-block > + 'org-hide-drawer > + 'outline)) The (list ...) should be moved outside the `while' loop. Better, this should be a constant defined somewhere. I also suggest to move `outline' to `org-outline' since we differ from Outline mode. > + (remove-text-properties pos next '(invisible nil) object)) > + (setq pos next)))) > + (when-let ((properties-stripped (org-plist-delete properties 'invisible))) Typo here. There should a single pair of parenthesis, but see above about `when-let'. > + (remove-text-properties start end properties-stripped object))) > + > +(defun org--find-text-property-region (pos prop) I think this is a function useful enough to have a name without double dashes. It can be left in "org-macs.el". It would be nice to have a wrapper for `invisible' property in "org-fold.el", tho. > + "Find a region containing PROP text property around point POS." Reverse the order of arguments in the docstring: Find a region around POS containing PROP text property. > + (let* ((beg (and (get-text-property pos prop) pos)) > + (end beg)) > + (when beg BEG can only be nil if arguments are wrong. In this case, you can throw an error (assuming this is no longer an internal function): (unless beg (user-error "...")) > + ;; when beg is the first point in the region, `previous-single-property-change' > + ;; will return nil. when -> When > + (setq beg (or (previous-single-property-change pos prop) > + beg)) > + ;; when end is the last point in the region, `next-single-property-change' > + ;; will return nil. Ditto. > + (setq end (or (next-single-property-change pos prop) > + end)) > + (unless (= beg end) ; this should not happen I assume this will be the case in an empty buffer. Anyway, (1 . 1) sounds more regular than a nil return value, not specified in the docstring. IOW, I suggest to remove this check. > + (cons beg end))))) > + > +(defun org--add-to-list-text-property (from to prop element) > + "Add element to text property PROP, whos value should be a list." The docstring is incomplete. All arguments need to be described. Also, I suggest: Append ELEMENT to the value of text property PROP. > + (add-text-properties from to `(,prop ,(list element))) ; create if none Here, you are resetting all the properties before adding anything, aren't you? IOW, there might be a bug there. > + ;; add to existing > + (alter-text-property from to > + prop > + (lambda (val) > + (if (member element val) > + val > + (cons element val))))) > +(defun org--remove-from-list-text-property (from to prop element) > + "Remove ELEMENT from text propery PROP, whos value should be a list." The docstring needs to be improved. > + (let ((pos from)) > + (while (< pos to) > + (when-let ((val (get-text-property pos prop))) > + (if (equal val (list element)) (list element) needs to be moved out of the `while' loop. > + (remove-text-properties pos (next-single-char-property-change pos prop nil to) (list prop nil)) > + (put-text-property pos (next-single-char-property-change pos prop nil to) > + prop (remove element (get-text-property pos prop))))) If we specialize the function, `remove' -> `remq' > + (setq pos (next-single-char-property-change pos prop nil to))))) Please factor out `next-single-char-property-change'. Note that `org--remove-from-list-text-property' and `org--add-to-list-text-property' do not seem to be used throughout your patch. > +(defvar org--invisible-spec-priority-list '(outline org-hide-drawer org-hide-block) > + "Priority of invisibility specs.") This should be the constant I wrote about earlier. Note that those are not "specs", just properties. I suggest to rename it. > +(defun org--get-buffer-local-invisible-property-symbol (spec &optional buffer return-only) This name is waaaaaaay too long. > + "Return unique symbol suitable to be used as buffer-local in BUFFER for 'invisible SPEC. Maybe: Return a unique symbol suitable for `invisible' property. Then: Return value is meant to be used as a buffer-local variable in current buffer, or BUFFER if this is non-nil. > +If the buffer already have buffer-local setup in `char-property-alias-alist' > +and the setup appears to be created for different buffer, > +copy the old invisibility state into new buffer-local text properties, > +unless RETURN-ONLY is non-nil." > + (if (not (member spec org--invisible-spec-priority-list)) > + (user-error "%s should be a valid invisibility spec" spec) No need to waste an indentation level for that: (unless (member …) (user-error "%S should be …" spec)) Also, this is a property, not a "spec". > + (let* ((buf (or buffer (current-buffer)))) > + (let ((local-prop (intern (format "org--invisible-%s-buffer-local-%S" This clearly needs a shorter name. In particular, "buffer-local" can be removed. > + (symbol-name spec) > + ;; (sxhash buf) appears to be not constant over time. > + ;; Using buffer-name is safe, since the only place where > + ;; buffer-local text property actually matters is an indirect > + ;; buffer, where the name cannot be same anyway. > + (sxhash (buffer-name buf)))))) > + (prog1 > + local-prop Please move LOCAL-PROP after the (unless return-only ...) sexp. > + (unless return-only > + (with-current-buffer buf > + (unless (member local-prop (alist-get 'invisible char-property-alias-alist)) > + ;; copy old property "Copy old property." > + (dolist (old-prop (alist-get 'invisible char-property-alias-alist)) We cannot use `alist-get', which was added in Emacs 25.3 only. > + (org-with-wide-buffer > + (let* ((pos (point-min)) > + (spec (seq-find (lambda (spec) > + (string-match-p (symbol-name spec) > + (symbol-name old-prop))) > + org--invisible-spec-priority-list)) Likewise, we cannot use `seq-find'. > + (new-prop (org--get-buffer-local-invisible-property-symbol spec nil 'return-only))) > + (while (< pos (point-max)) > + (when-let (val (get-text-property pos old-prop)) > + (put-text-property pos (next-single-char-property-change pos old-prop) new-prop val)) > + (setq pos (next-single-char-property-change pos old-prop)))))) > + (setq-local char-property-alias-alist > + (cons (cons 'invisible > + (mapcar (lambda (spec) > + (org--get-buffer-local-invisible-property-symbol spec nil 'return-only)) > + org--invisible-spec-priority-list)) > + (remove (assq 'invisible char-property-alias-alist) > + char-property-alias-alist))))))))))) This begs for explainations in the docstring or as comments. In particular, just by reading the code, I have no clue about how this is going to be used, how it is going to solve issues with indirect buffers, with invisibility stacking, etc. I don't mind if there are more comment lines than lines of code in that area. > - (remove-overlays from to 'invisible spec) > - ;; Use `front-advance' since text right before to the beginning of > - ;; the overlay belongs to the visible line than to the contents. > - (when flag > - (let ((o (make-overlay from to nil 'front-advance))) > - (overlay-put o 'evaporate t) > - (overlay-put o 'invisible spec) > - (overlay-put o 'isearch-open-invisible #'delete-overlay)))) > - > + (with-silent-modifications > + (remove-text-properties from to (list (org--get-buffer-local-invisible-property-symbol spec) nil)) > + (when flag > + (put-text-property from to (org--get-buffer-local-invisible-property-symbol spec) spec)))) I don't think there is a need for `remove-text-properties' in every case. Also, (org--get-buffer-local-invisible-property-symbol spec) should be factored out. I suggest: (with-silent-modifications (let ((property (org--get-buffer-local-invisible-property-symbol spec))) (if flag (put-text-property from to property spec) (remove-text-properties from to (list property nil))))) > +(defun org-after-change-function (from to len) This is a terrible name. Org may add different functions in a-c-f, they cannot all be called like this. Assuming the "org-fold" prefix, it could be: org-fold--fix-folded-region > + "Process changes in folded elements. > +If a text was inserted into invisible region, hide the inserted text. > +If the beginning/end line of a folded drawer/block was changed, unfold it. > +If a valid end line was inserted in the middle of the folded drawer/block, unfold it." Nitpick: please do not skip lines amidst a function. Empty lines are used to separate functions, so this is distracting. If a part of the function should stand out, a comment explaining what the part is doing is enough. > + ;; re-hide text inserted in the middle of a folded region Re-hide … folded region. > + (dolist (spec org--invisible-spec-priority-list) > + (when-let ((spec-to (get-text-property to (org--get-buffer-local-invisible-property-symbol spec))) > + (spec-from (get-text-property (max (point-min) (1- from)) (org--get-buffer-local-invisible-property-symbol spec)))) > + (when (eq spec-to spec-from) > + (org-flag-region from to 't spec-to)))) This part should first check if we're really after an insertion, e.g., if FROM is different from TO, and exit early if that's not the case. Also, no need to quote t. > + ;; Process all the folded text between `from' and `to' > + (org-with-wide-buffer > + > + (if (< to from) > + (let ((tmp from)) > + (setq from to) > + (setq to tmp))) I'm surprised you need to do that. Did you encounter a case where a-c-f was called with boundaries in reverse order? > + ;; Include next/previous line into the changed region. > + ;; This is needed to catch edits in beginning line of a folded > + ;; element. > + (setq to (save-excursion (goto-char to) (forward-line) (point))) (forward-line) (point) ---> (line-beginning-position 2) > + (setq from (save-excursion (goto-char from) (forward-line -1) (point))) (forward-line -1) (point) ---> (line-beginning-position 0) Anyway, I have the feeling this is not a good idea to extend it now, without first checking that we are in a folded drawer or block. It may also catch unwanted parts, e.g., a folded drawer ending on the line above. What about first finding the whole region with property (org--get-buffer-local-invisible-property-symbol 'org-hide-drawer) then extending the initial part to include the drawer opening? I don't think we need to extend past the ending part, because drawer closing line is always included in the invisible part of the drawer. > + ;; Expand the considered region to include partially present folded > + ;; drawer/block. > + (when (get-text-property from (org--get-buffer-local-invisible-property-symbol 'org-hide-drawer)) > + (setq from (previous-single-char-property-change from (org--get-buffer-local-invisible-property-symbol 'org-hide-drawer)))) > + (when (get-text-property from (org--get-buffer-local-invisible-property-symbol 'org-hide-block)) > + (setq from (previous-single-char-property-change from (org--get-buffer-local-invisible-property-symbol 'org-hide-block)))) Please factor out (org--get-buffer-local-invisible-property-symbol XXX), this is difficult to read. > + ;; check folded drawers Check folded drawers. > + (let ((pos from)) > + (unless (get-text-property pos (org--get-buffer-local-invisible-property-symbol 'org-hide-drawer)) > + (setq pos (next-single-char-property-change pos > + (org--get-buffer-local-invisible-property-symbol 'org-hide-drawer)))) > + (while (< pos to) > + (when-let ((drawer-begin (and (get-text-property pos (org--get-buffer-local-invisible-property-symbol 'org-hide-drawer)) > + pos)) > + (drawer-end (next-single-char-property-change pos (org--get-buffer-local-invisible-property-symbol 'org-hide-drawer)))) > + > + (let (unfold?) > + ;; the line before folded text should be beginning of the drawer > + (save-excursion > + (goto-char drawer-begin) > + (backward-char) Why `backward-char'? > + (beginning-of-line) > + (unless (looking-at-p org-drawer-regexp) looking-at-p ---> looking-at However, you must wrap this function within `save-match-data'. > + (setq unfold? t))) > + ;; the last line of the folded text should be :END: > + (save-excursion > + (goto-char drawer-end) > + (beginning-of-line) > + (unless (let ((case-fold-search t)) (looking-at-p org-property-end-re)) > + (setq unfold? t))) > + ;; there should be no :END: anywhere in the drawer body > + (save-excursion > + (goto-char drawer-begin) > + (when (save-excursion > + (let ((case-fold-search t)) > + (re-search-forward org-property-end-re > + (max (point) > + (1- (save-excursion > + (goto-char drawer-end) > + (line-beginning-position)))) > + 't))) > (max (point) > (save-excursion (goto-char drawer-end) (line-end-position 0)) > + (setq unfold? t))) > + ;; there should be no new entry anywhere in the drawer body > + (save-excursion > + (goto-char drawer-begin) > + (when (save-excursion > + (let ((case-fold-search t)) > + (re-search-forward org-outline-regexp-bol > + (max (point) > + (1- (save-excursion > + (goto-char drawer-end) > + (line-beginning-position)))) > + 't))) > + (setq unfold? t))) In the phase above, you need to bail out as soon as unfold? is non-nil: (catch :exit ... (throw :exit (setq unfold? t)) ...) Also last two checks should be lumped together, with an appropriate regexp. Finally, I have the feeling we're missing out some early exits when nothing is folded around point (e.g., most of the case). > + > + (when unfold? (org-flag-region drawer-begin drawer-end nil 'org-hide-drawer)))) > + > + (setq pos (next-single-char-property-change pos (org--get-buffer-local-invisible-property-symbol 'org-hide-drawer))))) > + > + ;; check folded blocks > + (let ((pos from)) > + (unless (get-text-property pos (org--get-buffer-local-invisible-property-symbol 'org-hide-block)) > + (setq pos (next-single-char-property-change pos > + (org--get-buffer-local-invisible-property-symbol 'org-hide-block)))) > + (while (< pos to) > + (when-let ((block-begin (and (get-text-property pos (org--get-buffer-local-invisible-property-symbol 'org-hide-block)) > + pos)) > + (block-end (next-single-char-property-change pos (org--get-buffer-local-invisible-property-symbol 'org-hide-block)))) > + > + (let (unfold?) > + ;; the line before folded text should be beginning of the block > + (save-excursion > + (goto-char block-begin) > + (backward-char) > + (beginning-of-line) > + (unless (looking-at-p org-dblock-start-re) > + (setq unfold? t))) > + ;; the last line of the folded text should be end of the block > + (save-excursion > + (goto-char block-end) > + (beginning-of-line) > + (unless (looking-at-p org-dblock-end-re) > + (setq unfold? t))) > + ;; there should be no #+end anywhere in the block body > + (save-excursion > + (goto-char block-begin) > + (when (save-excursion > + (re-search-forward org-dblock-end-re > + (max (point) > + (1- (save-excursion > + (goto-char block-end) > + (line-beginning-position)))) > + 't)) > + (setq unfold? t))) > + ;; there should be no new entry anywhere in the block body > + (save-excursion > + (goto-char block-begin) > + (when (save-excursion > + (let ((case-fold-search t)) > + (re-search-forward org-outline-regexp-bol > + (max (point) > + (1- (save-excursion > + (goto-char block-end) > + (line-beginning-position)))) > + 't))) > + (setq unfold? t))) > + > + (when unfold? (org-flag-region block-begin block-end nil 'org-hide-block)))) > + > + (setq pos > + (next-single-char-property-change pos > + (org--get-buffer-local-invisible-property-symbol 'org-hide-block))))))) See remarks above. The parts related to drawers and blocks are so similar they should be factorized out. Also `org-dblock-start-re' and `org-dblock-end-re' are not regexps we want here. The correct regexps would be: (rx bol (zero-or-more (any " " "\t")) "#+begin" (or ":" (seq "_" (group (one-or-more (not (syntax whitespace))))))) and closing line should match match-group 1 from the regexp above, e.g.: (concat (rx bol (zero-or-more (any " " "\t")) "#+end") (if block-type (concat "_" (regexp-quote block-type) (rx (zero-or-more (any " " "\t")) eol)) (rx (opt ":") (zero-or-more (any " " "\t")) eol))) assuming `block-type' is the type of the block, or nil, i.e., (match-string 1) in the previous regexp. > - (pcase (get-char-property-and-overlay (point) 'invisible) > + (pcase (get-char-property (point) 'invisible) > ;; Do not fold already folded drawers. > - (`(outline . ,o) (goto-char (overlay-end o))) > + ('outline 'outline --> `outline > (end-of-line)) > (while (and (< arg 0) (re-search-backward regexp nil :move)) > (unless (bobp) > - (while (pcase (get-char-property-and-overlay (point) 'invisible) > - (`(outline . ,o) > - (goto-char (overlay-start o)) > - (re-search-backward regexp nil :move)) > - (_ nil)))) > + (pcase (get-char-property (point) 'invisible) > + ('outline > + (goto-char (car (org--find-text-property-region (point) 'invisible))) > + (beginning-of-line)) > + (_ nil))) Does this move to the beginning of the widest invisible part around point? If that's not the case, we need a function in "org-fold.el" doing just that. Or we need to nest `while' loops as it was the case in the code you reverted. ----- Regards, -- Nicolas Goaziou ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-06-10 17:14 ` Nicolas Goaziou @ 2020-06-21 9:52 ` Ihor Radchenko 2020-06-21 15:01 ` Nicolas Goaziou 2020-08-11 6:45 ` Ihor Radchenko 1 sibling, 1 reply; 192+ messages in thread From: Ihor Radchenko @ 2020-06-21 9:52 UTC (permalink / raw) To: Nicolas Goaziou; +Cc: emacs-orgmode > Once done, I think we should move (or copy, first) _all_ folding-related > functions into a new "org-fold.el" library. Functions and variables > included there should have a proper "org-fold-" prefix. More on this in > the detailed report. I am currently working on org-fold.el. However, I am not sure if it is acceptable to move some of the existing functions from org.el to org-fold.el. Specifically, functions from the following sections of org.el might be moved to org-fold.el: > ;;; Visibility (headlines, blocks, drawers) > ;;;; Reveal point location > ;;;; Visibility cycling Should I do it? Best, Ihor Nicolas Goaziou <mail@nicolasgoaziou.fr> writes: > Hello, > > Ihor Radchenko <yantar92@gmail.com> writes: > >> [The patch itself will be provided in the following email] > > Thank you! I'll first make some generic remarks, then comment the diff > in more details. > >> I have four more updates from the previous version of the patch: >> >> 1. All the code handling modifications in folded drawers/blocks is moved >> to after-change-function. It works as follows: >> - if any text is inserted in the middle of hidden region, that text >> is also hidden; >> - if BEGIN/END line of a folded drawer do not match org-drawer-regexp >> and org-property-end-re, unfold it; >> - if org-property-end-re or new org-outline-regexp-bol is inserted in >> the middle of the drawer, unfold it; >> - the same logic for blocks. > > This sounds good, barring a minor error in the regexp for blocks, and > missing optimizations. More on this in the detailed comments. > >> 2. The text property stack is rewritten using char-property-alias-alist. >> This is faster in comparison with previous approach, which involved >> modifying all the text properties every timer org-flag-region was >> called. > > I'll need information about this, as I'm not sure to fully understand > all the consequences of this. But more importantly, this needs to be > copiously documented somewhere for future hackers. > >> 3. org-toggle-custom-properties-visibility is rewritten using text >> properties. I also took a freedom to implement a new feature here. >> Now, setting new `org-custom-properties-hide-emptied-drawers' to >> non-nil will result in hiding the whole property drawer if it >> contains only org-custom-properties. > > I don't think this is a good idea. AFAIR, we always refused to hide > completely anything, including empty drawers. The reason is that if the > drawer is completely hidden, you cannot expand it easily, or even know > there is one. > > In any case, this change shouldn't belong to this patch set, and should > be discussed separately. > >> 4. This patch should work against 1aa095ccf. However, the merge was not >> trivial here. Recent commits actively used the fact that drawers and >> outlines are hidden via 'outline invisibility spec, which is not the >> case in this branch. I am not confident that I did not break anything >> during the merge, especially 1aa095ccf. > > [...] > >> Also, I have seen some optimisations making use of the fact that drawers >> and headlines both use 'outline invisibility spec. This change in the >> implementation details supposed to improve performance and should not be >> necessary if this patch is going to be merged. Would it be possible to >> refrain from abusing this particular implementation detail in the >> nearest commits on master (unless really necessary)? > > To be clear, I didn't intend to make your life miserable. > > However, I had to fix regression on drawers visibility before Org 9.4 > release. Also, merging invisibility properties for drawers and outline > was easier for me. So, I had the opportunity to kill two birds with one > stone. > > As a reminder, Org 9.4 is about to be released, but Org 9.5 will take > months to go out. So, even though I hope your changes will land into > Org, there is no reason for us to refrain from improving (actually > fixing a regression in) 9.4 release. Hopefully, once 9.4 is out, such > changes are not expected to happen anymore. > > I hope you understand. > >> I would like to finalise the current patch and work on other code using >> overlays separately. This patch is already quite complicated as is. I do >> not want to introduce even more potential bugs by working on things not >> directly affected by this version of the patch. > > The patch is technically mostly good, but needs more work for > integration into Org. > > First, it includes a few unrelated changes that should be removed (e.g., > white space fixes in unrelated parts of the code). Also, as written > above, the changes about `org-custom-properties-hide-emptied-drawers' > should be removed for the time being. > > Once done, I think we should move (or copy, first) _all_ folding-related > functions into a new "org-fold.el" library. Functions and variables > included there should have a proper "org-fold-" prefix. More on this in > the detailed report. > > The functions `org-find-text-property-region', > `org-add-to-list-text-property', and > `org-remove-from-list-text-property' can be left in "org-macs.el", since > they do not directly depend on the `invisible' property. Note the last > two functions I mentioned are not used throughout your patch. They might > be removed. > > This first patch can coexist with overlay folding since functions in > both mechanisms are named differently. > > Then, another patch can integrate "org-fold.el" into Org folding. I also > suggest to move the Outline -> Org transition to yet another patch. > I think there's more work to do on this part. > > Now, into the details of your patch. The first remarks are: > > 1. we still support Emacs 24.4 (and probably Emacs 24.3, but I'm not > sure), so some functions cannot be used. > > 2. we don't use "subr-x.el" in the code base. In particular, it would be > nice to replace `when-let' with `when' + `let'. This change costs > only one loc. > > 3. Some docstrings need more work. In particular, Emacs documentation > expects all arguments to be explained in the docstring, if possible > in the order in which they appear. There are exceptions, though. For > example, in a function like `org-remove-text-properties', you can > mention arguments are simply the same as in `remove-text-properties'. > > 4. Some refactorization is needed in some places. I mentioned them in > the report below. > > 5. I didn't dive much into the Isearch code so far. I tested it a bit > and seems to work nicely. I noticed one bug though. In the following > document: > > #+begin: foo > :FOO: > bar > :END: > #+end > bar > > when both the drawer and the block are folded (i.e., you fold the > drawer first, then the block), searching for "bar" first find the > last one, then overwraps and find the first one. > > 6. Since we're rewriting folding code, we might as well rename folding > properties: org-hide-drawer -> org-fold-drawer, outline -> > org-fold-headline… > > Now, here are more comments about the code. > > ----- > >> +(defun org-remove-text-properties (start end properties &optional object) > > IMO, this generic name doesn't match the specialized nature of the > function. It doesn't belong to "org-macs.el", but to the new "Org Fold" library. > >> + "Remove text properties as in `remove-text-properties', but keep 'invisibility specs for folded regions. > > Line is too long. Suggestion: > > Remove text properties except folding-related ones. > >> +Do not remove invisible text properties specified by 'outline, >> +'org-hide-block, and 'org-hide-drawer (but remove i.e. 'org-link) this >> +is needed to keep outlines, drawers, and blocks hidden unless they are >> +toggled by user. > > Said properties should be moved into a defconst, e.g., > `org-fold-properties', then: > > Remove text properties as in `remove-text-properties'. See the > function for the description of the arguments. > > However, do not remove invisible text properties defined in > `org-fold-properties'. Those are required to keep headlines, drawers > and blocks folded. > >> +Note: The below may be too specific and create troubles if more >> +invisibility specs are added to org in future" > > You can remove the note. If you think the note is important, it should > put a comment in the code instead. > >> + (when (plist-member properties 'invisible) >> + (let ((pos start) >> + next spec) >> + (while (< pos end) >> + (setq next (next-single-property-change pos 'invisible nil end) >> + spec (get-text-property pos 'invisible)) >> + (unless (memq spec (list 'org-hide-block >> + 'org-hide-drawer >> + 'outline)) > > The (list ...) should be moved outside the `while' loop. Better, this > should be a constant defined somewhere. I also suggest to move > `outline' to `org-outline' since we differ from Outline mode. > >> + (remove-text-properties pos next '(invisible nil) object)) >> + (setq pos next)))) >> + (when-let ((properties-stripped (org-plist-delete properties 'invisible))) > > Typo here. There should a single pair of parenthesis, but see above > about `when-let'. > >> + (remove-text-properties start end properties-stripped object))) >> + >> +(defun org--find-text-property-region (pos prop) > > I think this is a function useful enough to have a name without double > dashes. It can be left in "org-macs.el". It would be nice to have > a wrapper for `invisible' property in "org-fold.el", tho. > >> + "Find a region containing PROP text property around point POS." > > Reverse the order of arguments in the docstring: > > Find a region around POS containing PROP text property. > >> + (let* ((beg (and (get-text-property pos prop) pos)) >> + (end beg)) >> + (when beg > > BEG can only be nil if arguments are wrong. In this case, you can > throw an error (assuming this is no longer an internal function): > > (unless beg (user-error "...")) > >> + ;; when beg is the first point in the region, `previous-single-property-change' >> + ;; will return nil. > > when -> When > >> + (setq beg (or (previous-single-property-change pos prop) >> + beg)) >> + ;; when end is the last point in the region, `next-single-property-change' >> + ;; will return nil. > > Ditto. > >> + (setq end (or (next-single-property-change pos prop) >> + end)) >> + (unless (= beg end) ; this should not happen > > I assume this will be the case in an empty buffer. Anyway, (1 . 1) > sounds more regular than a nil return value, not specified in the > docstring. IOW, I suggest to remove this check. > >> + (cons beg end))))) >> + >> +(defun org--add-to-list-text-property (from to prop element) >> + "Add element to text property PROP, whos value should be a list." > > The docstring is incomplete. All arguments need to be described. Also, > I suggest: > > Append ELEMENT to the value of text property PROP. > >> + (add-text-properties from to `(,prop ,(list element))) ; create if none > > Here, you are resetting all the properties before adding anything, > aren't you? IOW, there might be a bug there. > >> + ;; add to existing >> + (alter-text-property from to >> + prop >> + (lambda (val) >> + (if (member element val) >> + val >> + (cons element val))))) > >> +(defun org--remove-from-list-text-property (from to prop element) >> + "Remove ELEMENT from text propery PROP, whos value should be a list." > > The docstring needs to be improved. > >> + (let ((pos from)) >> + (while (< pos to) >> + (when-let ((val (get-text-property pos prop))) >> + (if (equal val (list element)) > > (list element) needs to be moved out of the `while' loop. > >> + (remove-text-properties pos (next-single-char-property-change pos prop nil to) (list prop nil)) >> + (put-text-property pos (next-single-char-property-change pos prop nil to) >> + prop (remove element (get-text-property pos prop))))) > > If we specialize the function, `remove' -> `remq' > >> + (setq pos (next-single-char-property-change pos prop nil to))))) > > Please factor out `next-single-char-property-change'. > > Note that `org--remove-from-list-text-property' and > `org--add-to-list-text-property' do not seem to be used throughout > your patch. > >> +(defvar org--invisible-spec-priority-list '(outline org-hide-drawer org-hide-block) >> + "Priority of invisibility specs.") > > This should be the constant I wrote about earlier. Note that those are > not "specs", just properties. I suggest to rename it. > >> +(defun org--get-buffer-local-invisible-property-symbol (spec &optional buffer return-only) > > This name is waaaaaaay too long. > >> + "Return unique symbol suitable to be used as buffer-local in BUFFER for 'invisible SPEC. > > Maybe: > > > Return a unique symbol suitable for `invisible' property. > > Then: > > Return value is meant to be used as a buffer-local variable in > current buffer, or BUFFER if this is non-nil. > >> +If the buffer already have buffer-local setup in `char-property-alias-alist' >> +and the setup appears to be created for different buffer, >> +copy the old invisibility state into new buffer-local text properties, >> +unless RETURN-ONLY is non-nil." >> + (if (not (member spec org--invisible-spec-priority-list)) >> + (user-error "%s should be a valid invisibility spec" spec) > > No need to waste an indentation level for that: > > (unless (member …) > (user-error "%S should be …" spec)) > > Also, this is a property, not a "spec". > >> + (let* ((buf (or buffer (current-buffer)))) >> + (let ((local-prop (intern (format "org--invisible-%s-buffer-local-%S" > > This clearly needs a shorter name. In particular, "buffer-local" can be removed. > >> + (symbol-name spec) >> + ;; (sxhash buf) appears to be not constant over time. >> + ;; Using buffer-name is safe, since the only place where >> + ;; buffer-local text property actually matters is an indirect >> + ;; buffer, where the name cannot be same anyway. >> + (sxhash (buffer-name buf)))))) > > >> + (prog1 >> + local-prop > > Please move LOCAL-PROP after the (unless return-only ...) sexp. > >> + (unless return-only >> + (with-current-buffer buf >> + (unless (member local-prop (alist-get 'invisible char-property-alias-alist)) >> + ;; copy old property > > "Copy old property." > >> + (dolist (old-prop (alist-get 'invisible char-property-alias-alist)) > > We cannot use `alist-get', which was added in Emacs 25.3 only. > >> + (org-with-wide-buffer >> + (let* ((pos (point-min)) >> + (spec (seq-find (lambda (spec) >> + (string-match-p (symbol-name spec) >> + (symbol-name old-prop))) >> + org--invisible-spec-priority-list)) > > Likewise, we cannot use `seq-find'. > >> + (new-prop (org--get-buffer-local-invisible-property-symbol spec nil 'return-only))) >> + (while (< pos (point-max)) >> + (when-let (val (get-text-property pos old-prop)) >> + (put-text-property pos (next-single-char-property-change pos old-prop) new-prop val)) >> + (setq pos (next-single-char-property-change pos old-prop)))))) >> + (setq-local char-property-alias-alist >> + (cons (cons 'invisible >> + (mapcar (lambda (spec) >> + (org--get-buffer-local-invisible-property-symbol spec nil 'return-only)) >> + org--invisible-spec-priority-list)) >> + (remove (assq 'invisible char-property-alias-alist) >> + char-property-alias-alist))))))))))) > > This begs for explainations in the docstring or as comments. In > particular, just by reading the code, I have no clue about how this is > going to be used, how it is going to solve issues with indirect > buffers, with invisibility stacking, etc. > > I don't mind if there are more comment lines than lines of code in > that area. > >> - (remove-overlays from to 'invisible spec) >> - ;; Use `front-advance' since text right before to the beginning of >> - ;; the overlay belongs to the visible line than to the contents. >> - (when flag >> - (let ((o (make-overlay from to nil 'front-advance))) >> - (overlay-put o 'evaporate t) >> - (overlay-put o 'invisible spec) >> - (overlay-put o 'isearch-open-invisible #'delete-overlay)))) >> - >> + (with-silent-modifications >> + (remove-text-properties from to (list (org--get-buffer-local-invisible-property-symbol spec) nil)) >> + (when flag >> + (put-text-property from to (org--get-buffer-local-invisible-property-symbol spec) spec)))) > > I don't think there is a need for `remove-text-properties' in every > case. Also, (org--get-buffer-local-invisible-property-symbol spec) > should be factored out. > > I suggest: > > (with-silent-modifications > (let ((property (org--get-buffer-local-invisible-property-symbol spec))) > (if flag > (put-text-property from to property spec) > (remove-text-properties from to (list property nil))))) > >> +(defun org-after-change-function (from to len) > > This is a terrible name. Org may add different functions in a-c-f, > they cannot all be called like this. Assuming the "org-fold" prefix, > it could be: > > org-fold--fix-folded-region > >> + "Process changes in folded elements. >> +If a text was inserted into invisible region, hide the inserted text. >> +If the beginning/end line of a folded drawer/block was changed, unfold it. >> +If a valid end line was inserted in the middle of the folded drawer/block, unfold it." > > Nitpick: please do not skip lines amidst a function. Empty lines are > used to separate functions, so this is distracting. > > If a part of the function should stand out, a comment explaining what > the part is doing is enough. > >> + ;; re-hide text inserted in the middle of a folded region > > Re-hide … folded region. > >> + (dolist (spec org--invisible-spec-priority-list) >> + (when-let ((spec-to (get-text-property to (org--get-buffer-local-invisible-property-symbol spec))) >> + (spec-from (get-text-property (max (point-min) (1- from)) (org--get-buffer-local-invisible-property-symbol spec)))) >> + (when (eq spec-to spec-from) >> + (org-flag-region from to 't spec-to)))) > > This part should first check if we're really after an insertion, e.g., > if FROM is different from TO, and exit early if that's not the case. > > Also, no need to quote t. > >> + ;; Process all the folded text between `from' and `to' >> + (org-with-wide-buffer >> + >> + (if (< to from) >> + (let ((tmp from)) >> + (setq from to) >> + (setq to tmp))) > > I'm surprised you need to do that. Did you encounter a case where > a-c-f was called with boundaries in reverse order? > >> + ;; Include next/previous line into the changed region. >> + ;; This is needed to catch edits in beginning line of a folded >> + ;; element. >> + (setq to (save-excursion (goto-char to) (forward-line) (point))) > > (forward-line) (point) ---> (line-beginning-position 2) > >> + (setq from (save-excursion (goto-char from) (forward-line -1) (point))) > > (forward-line -1) (point) ---> (line-beginning-position 0) > > Anyway, I have the feeling this is not a good idea to extend it now, > without first checking that we are in a folded drawer or block. It may > also catch unwanted parts, e.g., a folded drawer ending on the line > above. > > What about first finding the whole region with property > > (org--get-buffer-local-invisible-property-symbol 'org-hide-drawer) > > then extending the initial part to include the drawer opening? I don't > think we need to extend past the ending part, because drawer closing > line is always included in the invisible part of the drawer. > >> + ;; Expand the considered region to include partially present folded >> + ;; drawer/block. >> + (when (get-text-property from (org--get-buffer-local-invisible-property-symbol 'org-hide-drawer)) >> + (setq from (previous-single-char-property-change from (org--get-buffer-local-invisible-property-symbol 'org-hide-drawer)))) >> + (when (get-text-property from (org--get-buffer-local-invisible-property-symbol 'org-hide-block)) >> + (setq from (previous-single-char-property-change from (org--get-buffer-local-invisible-property-symbol 'org-hide-block)))) > > Please factor out (org--get-buffer-local-invisible-property-symbol > XXX), this is difficult to read. > >> + ;; check folded drawers > > Check folded drawers. > >> + (let ((pos from)) >> + (unless (get-text-property pos (org--get-buffer-local-invisible-property-symbol 'org-hide-drawer)) >> + (setq pos (next-single-char-property-change pos >> + (org--get-buffer-local-invisible-property-symbol 'org-hide-drawer)))) >> + (while (< pos to) >> + (when-let ((drawer-begin (and (get-text-property pos (org--get-buffer-local-invisible-property-symbol 'org-hide-drawer)) >> + pos)) >> + (drawer-end (next-single-char-property-change pos (org--get-buffer-local-invisible-property-symbol 'org-hide-drawer)))) >> + >> + (let (unfold?) >> + ;; the line before folded text should be beginning of the drawer >> + (save-excursion >> + (goto-char drawer-begin) >> + (backward-char) > > Why `backward-char'? > >> + (beginning-of-line) >> + (unless (looking-at-p org-drawer-regexp) > > looking-at-p ---> looking-at > > However, you must wrap this function within `save-match-data'. > >> + (setq unfold? t))) >> + ;; the last line of the folded text should be :END: >> + (save-excursion >> + (goto-char drawer-end) >> + (beginning-of-line) >> + (unless (let ((case-fold-search t)) (looking-at-p org-property-end-re)) >> + (setq unfold? t))) >> + ;; there should be no :END: anywhere in the drawer body >> + (save-excursion >> + (goto-char drawer-begin) >> + (when (save-excursion >> + (let ((case-fold-search t)) >> + (re-search-forward org-property-end-re >> + (max (point) >> + (1- (save-excursion >> + (goto-char drawer-end) >> + (line-beginning-position)))) >> + 't))) > >> (max (point) >> (save-excursion (goto-char drawer-end) (line-end-position 0)) > >> + (setq unfold? t))) >> + ;; there should be no new entry anywhere in the drawer body >> + (save-excursion >> + (goto-char drawer-begin) >> + (when (save-excursion >> + (let ((case-fold-search t)) >> + (re-search-forward org-outline-regexp-bol >> + (max (point) >> + (1- (save-excursion >> + (goto-char drawer-end) >> + (line-beginning-position)))) >> + 't))) >> + (setq unfold? t))) > > In the phase above, you need to bail out as soon as unfold? is non-nil: > > (catch :exit > ... > (throw :exit (setq unfold? t)) > ...) > > Also last two checks should be lumped together, with an appropriate > regexp. > > Finally, I have the feeling we're missing out some early exits when > nothing is folded around point (e.g., most of the case). > >> + >> + (when unfold? (org-flag-region drawer-begin drawer-end nil 'org-hide-drawer)))) >> + >> + (setq pos (next-single-char-property-change pos (org--get-buffer-local-invisible-property-symbol 'org-hide-drawer))))) >> + >> + ;; check folded blocks >> + (let ((pos from)) >> + (unless (get-text-property pos (org--get-buffer-local-invisible-property-symbol 'org-hide-block)) >> + (setq pos (next-single-char-property-change pos >> + (org--get-buffer-local-invisible-property-symbol 'org-hide-block)))) >> + (while (< pos to) >> + (when-let ((block-begin (and (get-text-property pos (org--get-buffer-local-invisible-property-symbol 'org-hide-block)) >> + pos)) >> + (block-end (next-single-char-property-change pos (org--get-buffer-local-invisible-property-symbol 'org-hide-block)))) >> + >> + (let (unfold?) >> + ;; the line before folded text should be beginning of the block >> + (save-excursion >> + (goto-char block-begin) >> + (backward-char) >> + (beginning-of-line) >> + (unless (looking-at-p org-dblock-start-re) >> + (setq unfold? t))) >> + ;; the last line of the folded text should be end of the block >> + (save-excursion >> + (goto-char block-end) >> + (beginning-of-line) >> + (unless (looking-at-p org-dblock-end-re) >> + (setq unfold? t))) >> + ;; there should be no #+end anywhere in the block body >> + (save-excursion >> + (goto-char block-begin) >> + (when (save-excursion >> + (re-search-forward org-dblock-end-re >> + (max (point) >> + (1- (save-excursion >> + (goto-char block-end) >> + (line-beginning-position)))) >> + 't)) >> + (setq unfold? t))) >> + ;; there should be no new entry anywhere in the block body >> + (save-excursion >> + (goto-char block-begin) >> + (when (save-excursion >> + (let ((case-fold-search t)) >> + (re-search-forward org-outline-regexp-bol >> + (max (point) >> + (1- (save-excursion >> + (goto-char block-end) >> + (line-beginning-position)))) >> + 't))) >> + (setq unfold? t))) >> + >> + (when unfold? (org-flag-region block-begin block-end nil 'org-hide-block)))) >> + >> + (setq pos >> + (next-single-char-property-change pos >> + (org--get-buffer-local-invisible-property-symbol 'org-hide-block))))))) > > See remarks above. The parts related to drawers and blocks are so > similar they should be factorized out. > > Also `org-dblock-start-re' and `org-dblock-end-re' are not regexps we > want here. The correct regexps would be: > > (rx bol > (zero-or-more (any " " "\t")) > "#+begin" > (or ":" > (seq "_" > (group (one-or-more (not (syntax whitespace))))))) > > and closing line should match match-group 1 from the regexp above, e.g.: > > (concat (rx bol (zero-or-more (any " " "\t")) "#+end") > (if block-type > (concat "_" > (regexp-quote block-type) > (rx (zero-or-more (any " " "\t")) eol)) > (rx (opt ":") (zero-or-more (any " " "\t")) eol))) > > assuming `block-type' is the type of the block, or nil, i.e., > (match-string 1) in the previous regexp. > >> - (pcase (get-char-property-and-overlay (point) 'invisible) >> + (pcase (get-char-property (point) 'invisible) >> ;; Do not fold already folded drawers. >> - (`(outline . ,o) (goto-char (overlay-end o))) >> + ('outline > > 'outline --> `outline > >> (end-of-line)) >> (while (and (< arg 0) (re-search-backward regexp nil :move)) >> (unless (bobp) >> - (while (pcase (get-char-property-and-overlay (point) 'invisible) >> - (`(outline . ,o) >> - (goto-char (overlay-start o)) >> - (re-search-backward regexp nil :move)) >> - (_ nil)))) >> + (pcase (get-char-property (point) 'invisible) >> + ('outline >> + (goto-char (car (org--find-text-property-region (point) 'invisible))) >> + (beginning-of-line)) >> + (_ nil))) > > Does this move to the beginning of the widest invisible part around > point? If that's not the case, we need a function in "org-fold.el" > doing just that. Or we need to nest `while' loops as it was the case > in the code you reverted. > > ----- > > Regards, > > -- > Nicolas Goaziou -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-06-21 9:52 ` Ihor Radchenko @ 2020-06-21 15:01 ` Nicolas Goaziou 0 siblings, 0 replies; 192+ messages in thread From: Nicolas Goaziou @ 2020-06-21 15:01 UTC (permalink / raw) To: Ihor Radchenko; +Cc: emacs-orgmode Hello, Ihor Radchenko <yantar92@gmail.com> writes: > I am currently working on org-fold.el. However, I am not sure if it is > acceptable to move some of the existing functions from org.el to > org-fold.el. > > Specifically, functions from the following sections of org.el might be > moved to org-fold.el: >> ;;; Visibility (headlines, blocks, drawers) >> ;;;; Reveal point location >> ;;;; Visibility cycling > > Should I do it? That makes sense, yes. Note that you can first copy and rename most functions to make the transition easier. As a second step, we can plug new functions into the main system. Regards, -- Nicolas Goaziou ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-06-10 17:14 ` Nicolas Goaziou 2020-06-21 9:52 ` Ihor Radchenko @ 2020-08-11 6:45 ` Ihor Radchenko 2020-08-11 23:07 ` Kyle Meyer 1 sibling, 1 reply; 192+ messages in thread From: Ihor Radchenko @ 2020-08-11 6:45 UTC (permalink / raw) To: Nicolas Goaziou; +Cc: emacs-orgmode Hello, [The patch itself will be provided in the following email or can be accessed via Github [1]] I have finally finished the suggested edits. Most importantly: - All the folding-related code lives in =org-fold.el= and =org-cycle.el= now. - =org-fold.el= have commentary section explaining how folding works and exposing API for external code using folding. - I wrote a patch for =isearch.el= adding support searching inside text hidden via text properties [2] and the relevant support of the patch in the =org-fold.el=. The current =isearch= behaviour is also supported. Hope the patch will go through eventually. The patch is fairly stable on my system. Any feedback or bug reports are welcome. There are still known problems though. The patch currently breaks many org-mode tests when running =make test=. It is partially because some tests assume overlays to be used for folding and partially because the patch appears to break certain folding conventions. I am still investigating this (and learning =ert=). More details: >> 2. The text property stack is rewritten using char-property-alias-alist. >> This is faster in comparison with previous approach, which involved >> modifying all the text properties every timer org-flag-region was >> called. > I'll need information about this, as I'm not sure to fully understand > all the consequences of this. But more importantly, this needs to be > copiously documented somewhere for future hackers. See commentary section in =org-fold.el= and comments in =org-fold--property-symbol-get-create=. > As a reminder, Org 9.4 is about to be released, but Org 9.5 will take > months to go out. So, even though I hope your changes will land into > Org, there is no reason for us to refrain from improving (actually > fixing a regression in) 9.4 release. Hopefully, once 9.4 is out, such > changes are not expected to happen anymore. > > I hope you understand. Probably my message sounded harsher than it should. I totally understand why such changes are needed, but wanted to make people aware that old folding implementation will be likely changed. > First, it includes a few unrelated changes that should be removed (e.g., > white space fixes in unrelated parts of the code). Also, as written > above, the changes about `org-custom-properties-hide-emptied-drawers' > should be removed for the time being. Let's leave this until the patch is ready to be pushed. I want to focus on handling bugs first without a need to check for the whitespace changes. > Once done, I think we should move (or copy, first) _all_ folding-related > functions into a new "org-fold.el" library. Functions and variables > included there should have a proper "org-fold-" prefix. More on this in > the detailed report. I decided to create =org-fold.el= and =org-cycle.el= and move all the relevant functions there. The org-cycle code seems to be so frequently used that I did not want to break the org-fold prefix to org-fold-cycle and decided to separate the cycle code into standalone file. > Then, another patch can integrate "org-fold.el" into Org folding. I also > suggest to move the Outline -> Org transition to yet another patch. > I think there's more work to do on this part. Agree. For the time being, I will still provide the full patch if anyone wants to test the whole thing on their system. > 1. we still support Emacs 24.4 (and probably Emacs 24.3, but I'm not > sure), so some functions cannot be used. I tried my best to cleanup the functions as you suggested, but I do not know a good way to check which functions are not supported by old Emacs versions. > 2. we don't use "subr-x.el" in the code base. In particular, it would be > nice to replace `when-let' with `when' + `let'. This change costs > only one loc. Done. > 3. Some docstrings need more work. In particular, Emacs documentation > expects all arguments to be explained in the docstring, if possible > in the order in which they appear. There are exceptions, though. For > example, in a function like `org-remove-text-properties', you can > mention arguments are simply the same as in `remove-text-properties'. Done. > 5. I didn't dive much into the Isearch code so far. I tested it a bit > and seems to work nicely. I noticed one bug though. In the following > document: > > #+begin: foo > :FOO: > bar > :END: > #+end > bar > > when both the drawer and the block are folded (i.e., you fold the > drawer first, then the block), searching for "bar" first find the > last one, then overwraps and find the first one. Fixed now. > 6. Since we're rewriting folding code, we might as well rename folding > properties: org-hide-drawer -> org-fold-drawer, outline -> > org-fold-headline… Done. See =org-fold-get-folding-spec-for-element=. >> +(defun org-remove-text-properties (start end properties &optional object) > > IMO, this generic name doesn't match the specialized nature of the > function. It doesn't belong to "org-macs.el", but to the new "Org Fold" library. This function is unused. I simply removed the function altogether. >> +(defun org--find-text-property-region (pos prop) > > I think this is a function useful enough to have a name without double > dashes. It can be left in "org-macs.el". It would be nice to have > a wrapper for `invisible' property in "org-fold.el", tho. Done. See org-find-text-property-region and org-fold-get-region-at-point. >> + "Find a region containing PROP text property around point POS." > > Reverse the order of arguments in the docstring: Done >> + (let* ((beg (and (get-text-property pos prop) pos)) >> + (end beg)) >> + (when beg > > BEG can only be nil if arguments are wrong. In this case, you can > throw an error (assuming this is no longer an internal function): I added "Return nil when PROP is not set at POS." to the docstring. I believe it is better not to force the user to check the property at point before calling this function or catch errors in the code. > I assume this will be the case in an empty buffer. Anyway, (1 . 1) > sounds more regular than a nil return value, not specified in the > docstring. IOW, I suggest to remove this check. Removed. >> +(defun org--add-to-list-text-property (from to prop element) >> + "Add element to text property PROP, whos value should be a list." > > The docstring is incomplete. All arguments need to be described. Also, This functions is unused. I removed it completely. >> +(defvar org--invisible-spec-priority-list '(outline org-hide-drawer org-hide-block) >> + "Priority of invisibility specs.") > > This should be the constant I wrote about earlier. Note that those are > not "specs", just properties. I suggest to rename it. Please note that 'outline, 'out-hide-drawer, and 'org-hide-block (now renamed to 'org-fold-outline, 'org-fold-drawer, and 'org-fold-block) are not text property names. They are values stored in text properties used to fold the text. That's why I call them "folding specs", similarly to =buffer-invisibility-spec= in Emacs. Internally, they are exactly used as members of =buffer-invisibility-spec=. >> +(defun org--get-buffer-local-invisible-property-symbol (spec &optional buffer return-only) > > This name is waaaaaaay too long. Changed to org-fold--property-symbol-get-create. It is still long, but it don't need to (and should not) be used outside org-fold.el from now. > Maybe: > > > Return a unique symbol suitable for `invisible' property. > > Then: > > Return value is meant to be used as a buffer-local variable in > current buffer, or BUFFER if this is non-nil. Changed the docstring in similar manner. > No need to waste an indentation level for that: > > (unless (member …) > (user-error "%S should be …" spec)) Done >> + (let* ((buf (or buffer (current-buffer)))) >> + (let ((local-prop (intern (format "org--invisible-%s-buffer-local-%S" > > This clearly needs a shorter name. In particular, "buffer-local" can be removed. Changed to "org-fold--spec-%s-%S". >> + (prog1 >> + local-prop > > Please move LOCAL-PROP after the (unless return-only ...) sexp. I am not sure I understand why this needs to be changed. I feel that listing the return value will be more clear while reading the code. The remaining part of the =prog1= is optional logic. Moving =local-prop= to the end may reduce readability. > We cannot use `alist-get', which was added in Emacs 25.3 only. Changed to =assq=. > Likewise, we cannot use `seq-find'. Changed to =dolist=. > This begs for explainations in the docstring or as comments. In > particular, just by reading the code, I have no clue about how this is > going to be used, how it is going to solve issues with indirect > buffers, with invisibility stacking, etc. > > I don't mind if there are more comment lines than lines of code in > that area. Done. > I don't think there is a need for `remove-text-properties' in every > case. Also, (org--get-buffer-local-invisible-property-symbol spec) > should be factored out. Done. >> +(defun org-after-change-function (from to len) > > This is a terrible name. Org may add different functions in a-c-f, > they cannot all be called like this. Assuming the "org-fold" prefix, > it could be: > > org-fold--fix-folded-region Changed as you suggested. > Nitpick: please do not skip lines amidst a function. Empty lines are > used to separate functions, so this is distracting. > > If a part of the function should stand out, a comment explaining what > the part is doing is enough. Done. Though many docstrings in org have empty lines creating the same problem. > This part should first check if we're really after an insertion, e.g., > if FROM is different from TO, and exit early if that's not the case. Done. >> + (if (< to from) >> + (let ((tmp from)) >> + (setq from to) >> + (setq to tmp))) > > I'm surprised you need to do that. Did you encounter a case where > a-c-f was called with boundaries in reverse order? I removed it and saw no issues. You are right, it does not seem to happen at all. > (forward-line) (point) ---> (line-beginning-position 2) > (forward-line -1) (point) ---> (line-beginning-position 0) Done. > Anyway, I have the feeling this is not a good idea to extend it now, > without first checking that we are in a folded drawer or block. It may > also catch unwanted parts, e.g., a folded drawer ending on the line > above. This code is specifically written for cases when we are outside folded text, but the edit can still affect folded text right before/after the edited region. Consider two examples: 1. We can change the first visible line of a folded drawer :DRAWER:<begin fold> text inside folded drawer :END:<end-fold> <deleted first : in drawer header> ---- DRAWER:<begin fold, which should be unfolded> text inside folded drawer :END:<end-fold> The edited text was not folded, but must affected the following drawer. 2. We modify :END: of a folded drawer :DRAWER:<begin fold> text inside folded drawer :END:<end-fold> <deleted : in :END:> --- :DRAWER:<begin fold> text inside folded drawer :END<end-fold><changed text region is after the fold> Again, the effected region is not folded, anymore, but it should affect the preceding drawer. > What about first finding the whole region with property > > (org--get-buffer-local-invisible-property-symbol 'org-hide-drawer) > > then extending the initial part to include the drawer opening? I don't > think we need to extend past the ending part, because drawer closing > line is always included in the invisible part of the drawer. As I just showed, we may not really have any folded text in the modified region and thus cannot know if we need to update nearby drawers without looking at them. This code allow handling the described cases and also correctly keep folded drawers folded if they were not really modified. >> + (let (unfold?) >> + ;; the line before folded text should be beginning of the drawer >> + (save-excursion >> + (goto-char drawer-begin) >> + (backward-char) > > Why `backward-char'? =drawer-begin= is pointing to the beginning of folded part of the drawer, so we need to move the line containing the :drawer: > looking-at-p ---> looking-at > > However, you must wrap this function within `save-match-data'. Is there any particular reason to use looking-at in favour of looking-at-p? I have seen looking-at-p many times in org-mode code. > In the phase above, you need to bail out as soon as unfold? is non-nil: > > (catch :exit > ... > (throw :exit (setq unfold? t)) > ...) > > Also last two checks should be lumped together, with an appropriate > regexp. > > Finally, I have the feeling we're missing out some early exits when > nothing is folded around point (e.g., most of the case). Done. > Also `org-dblock-start-re' and `org-dblock-end-re' are not regexps we > want here. The correct regexps would be: > > (rx bol > (zero-or-more (any " " "\t")) > "#+begin" > (or ":" > (seq "_" > (group (one-or-more (not (syntax whitespace))))))) > > and closing line should match match-group 1 from the regexp above, e.g.: > > (concat (rx bol (zero-or-more (any " " "\t")) "#+end") > (if block-type > (concat "_" > (regexp-quote block-type) > (rx (zero-or-more (any " " "\t")) eol)) > (rx (opt ":") (zero-or-more (any " " "\t")) eol))) > > assuming `block-type' is the type of the block, or nil, i.e., > (match-string 1) in the previous regexp. Fixed. > 'outline --> `outline Could you explain why? > Does this move to the beginning of the widest invisible part around > point? If that's not the case, we need a function in "org-fold.el" > doing just that. Or we need to nest `while' loops as it was the case > in the code you reverted. See org-fold-next-visibility-change. Best, Ihor [1] Full patch: https://gist.github.com/yantar92/6447754415457927293acda43a7fcaef org-fold.el: https://gist.github.com/yantar92/ffc1fc11550c58dae71de06700e7e4c1 org-cycle.el: https://gist.github.com/yantar92/2be75c0e11968c0bbacc0d22dbca97fd [2] https://lists.gnu.org/archive/html/emacs-devel/2020-07/msg00679.html Nicolas Goaziou <mail@nicolasgoaziou.fr> writes: > Hello, > > Ihor Radchenko <yantar92@gmail.com> writes: > >> [The patch itself will be provided in the following email] > > Thank you! I'll first make some generic remarks, then comment the diff > in more details. > >> I have four more updates from the previous version of the patch: >> >> 1. All the code handling modifications in folded drawers/blocks is moved >> to after-change-function. It works as follows: >> - if any text is inserted in the middle of hidden region, that text >> is also hidden; >> - if BEGIN/END line of a folded drawer do not match org-drawer-regexp >> and org-property-end-re, unfold it; >> - if org-property-end-re or new org-outline-regexp-bol is inserted in >> the middle of the drawer, unfold it; >> - the same logic for blocks. > > This sounds good, barring a minor error in the regexp for blocks, and > missing optimizations. More on this in the detailed comments. > >> 2. The text property stack is rewritten using char-property-alias-alist. >> This is faster in comparison with previous approach, which involved >> modifying all the text properties every timer org-flag-region was >> called. > > I'll need information about this, as I'm not sure to fully understand > all the consequences of this. But more importantly, this needs to be > copiously documented somewhere for future hackers. > >> 3. org-toggle-custom-properties-visibility is rewritten using text >> properties. I also took a freedom to implement a new feature here. >> Now, setting new `org-custom-properties-hide-emptied-drawers' to >> non-nil will result in hiding the whole property drawer if it >> contains only org-custom-properties. > > I don't think this is a good idea. AFAIR, we always refused to hide > completely anything, including empty drawers. The reason is that if the > drawer is completely hidden, you cannot expand it easily, or even know > there is one. > > In any case, this change shouldn't belong to this patch set, and should > be discussed separately. > >> 4. This patch should work against 1aa095ccf. However, the merge was not >> trivial here. Recent commits actively used the fact that drawers and >> outlines are hidden via 'outline invisibility spec, which is not the >> case in this branch. I am not confident that I did not break anything >> during the merge, especially 1aa095ccf. > > [...] > >> Also, I have seen some optimisations making use of the fact that drawers >> and headlines both use 'outline invisibility spec. This change in the >> implementation details supposed to improve performance and should not be >> necessary if this patch is going to be merged. Would it be possible to >> refrain from abusing this particular implementation detail in the >> nearest commits on master (unless really necessary)? > > To be clear, I didn't intend to make your life miserable. > > However, I had to fix regression on drawers visibility before Org 9.4 > release. Also, merging invisibility properties for drawers and outline > was easier for me. So, I had the opportunity to kill two birds with one > stone. > > As a reminder, Org 9.4 is about to be released, but Org 9.5 will take > months to go out. So, even though I hope your changes will land into > Org, there is no reason for us to refrain from improving (actually > fixing a regression in) 9.4 release. Hopefully, once 9.4 is out, such > changes are not expected to happen anymore. > > I hope you understand. > >> I would like to finalise the current patch and work on other code using >> overlays separately. This patch is already quite complicated as is. I do >> not want to introduce even more potential bugs by working on things not >> directly affected by this version of the patch. > > The patch is technically mostly good, but needs more work for > integration into Org. > > First, it includes a few unrelated changes that should be removed (e.g., > white space fixes in unrelated parts of the code). Also, as written > above, the changes about `org-custom-properties-hide-emptied-drawers' > should be removed for the time being. > > Once done, I think we should move (or copy, first) _all_ folding-related > functions into a new "org-fold.el" library. Functions and variables > included there should have a proper "org-fold-" prefix. More on this in > the detailed report. > > The functions `org-find-text-property-region', > `org-add-to-list-text-property', and > `org-remove-from-list-text-property' can be left in "org-macs.el", since > they do not directly depend on the `invisible' property. Note the last > two functions I mentioned are not used throughout your patch. They might > be removed. > > This first patch can coexist with overlay folding since functions in > both mechanisms are named differently. > > Then, another patch can integrate "org-fold.el" into Org folding. I also > suggest to move the Outline -> Org transition to yet another patch. > I think there's more work to do on this part. > > Now, into the details of your patch. The first remarks are: > > 1. we still support Emacs 24.4 (and probably Emacs 24.3, but I'm not > sure), so some functions cannot be used. > > 2. we don't use "subr-x.el" in the code base. In particular, it would be > nice to replace `when-let' with `when' + `let'. This change costs > only one loc. > > 3. Some docstrings need more work. In particular, Emacs documentation > expects all arguments to be explained in the docstring, if possible > in the order in which they appear. There are exceptions, though. For > example, in a function like `org-remove-text-properties', you can > mention arguments are simply the same as in `remove-text-properties'. > > 4. Some refactorization is needed in some places. I mentioned them in > the report below. > > 5. I didn't dive much into the Isearch code so far. I tested it a bit > and seems to work nicely. I noticed one bug though. In the following > document: > > #+begin: foo > :FOO: > bar > :END: > #+end > bar > > when both the drawer and the block are folded (i.e., you fold the > drawer first, then the block), searching for "bar" first find the > last one, then overwraps and find the first one. > > 6. Since we're rewriting folding code, we might as well rename folding > properties: org-hide-drawer -> org-fold-drawer, outline -> > org-fold-headline… > > Now, here are more comments about the code. > > ----- > >> +(defun org-remove-text-properties (start end properties &optional object) > > IMO, this generic name doesn't match the specialized nature of the > function. It doesn't belong to "org-macs.el", but to the new "Org Fold" library. > >> + "Remove text properties as in `remove-text-properties', but keep 'invisibility specs for folded regions. > > Line is too long. Suggestion: > > Remove text properties except folding-related ones. > >> +Do not remove invisible text properties specified by 'outline, >> +'org-hide-block, and 'org-hide-drawer (but remove i.e. 'org-link) this >> +is needed to keep outlines, drawers, and blocks hidden unless they are >> +toggled by user. > > Said properties should be moved into a defconst, e.g., > `org-fold-properties', then: > > Remove text properties as in `remove-text-properties'. See the > function for the description of the arguments. > > However, do not remove invisible text properties defined in > `org-fold-properties'. Those are required to keep headlines, drawers > and blocks folded. > >> +Note: The below may be too specific and create troubles if more >> +invisibility specs are added to org in future" > > You can remove the note. If you think the note is important, it should > put a comment in the code instead. > >> + (when (plist-member properties 'invisible) >> + (let ((pos start) >> + next spec) >> + (while (< pos end) >> + (setq next (next-single-property-change pos 'invisible nil end) >> + spec (get-text-property pos 'invisible)) >> + (unless (memq spec (list 'org-hide-block >> + 'org-hide-drawer >> + 'outline)) > > The (list ...) should be moved outside the `while' loop. Better, this > should be a constant defined somewhere. I also suggest to move > `outline' to `org-outline' since we differ from Outline mode. > >> + (remove-text-properties pos next '(invisible nil) object)) >> + (setq pos next)))) >> + (when-let ((properties-stripped (org-plist-delete properties 'invisible))) > > Typo here. There should a single pair of parenthesis, but see above > about `when-let'. > >> + (remove-text-properties start end properties-stripped object))) >> + >> +(defun org--find-text-property-region (pos prop) > > I think this is a function useful enough to have a name without double > dashes. It can be left in "org-macs.el". It would be nice to have > a wrapper for `invisible' property in "org-fold.el", tho. > >> + "Find a region containing PROP text property around point POS." > > Reverse the order of arguments in the docstring: > > Find a region around POS containing PROP text property. > >> + (let* ((beg (and (get-text-property pos prop) pos)) >> + (end beg)) >> + (when beg > > BEG can only be nil if arguments are wrong. In this case, you can > throw an error (assuming this is no longer an internal function): > > (unless beg (user-error "...")) > >> + ;; when beg is the first point in the region, `previous-single-property-change' >> + ;; will return nil. > > when -> When > >> + (setq beg (or (previous-single-property-change pos prop) >> + beg)) >> + ;; when end is the last point in the region, `next-single-property-change' >> + ;; will return nil. > > Ditto. > >> + (setq end (or (next-single-property-change pos prop) >> + end)) >> + (unless (= beg end) ; this should not happen > > I assume this will be the case in an empty buffer. Anyway, (1 . 1) > sounds more regular than a nil return value, not specified in the > docstring. IOW, I suggest to remove this check. > >> + (cons beg end))))) >> + >> +(defun org--add-to-list-text-property (from to prop element) >> + "Add element to text property PROP, whos value should be a list." > > The docstring is incomplete. All arguments need to be described. Also, > I suggest: > > Append ELEMENT to the value of text property PROP. > >> + (add-text-properties from to `(,prop ,(list element))) ; create if none > > Here, you are resetting all the properties before adding anything, > aren't you? IOW, there might be a bug there. > >> + ;; add to existing >> + (alter-text-property from to >> + prop >> + (lambda (val) >> + (if (member element val) >> + val >> + (cons element val))))) > >> +(defun org--remove-from-list-text-property (from to prop element) >> + "Remove ELEMENT from text propery PROP, whos value should be a list." > > The docstring needs to be improved. > >> + (let ((pos from)) >> + (while (< pos to) >> + (when-let ((val (get-text-property pos prop))) >> + (if (equal val (list element)) > > (list element) needs to be moved out of the `while' loop. > >> + (remove-text-properties pos (next-single-char-property-change pos prop nil to) (list prop nil)) >> + (put-text-property pos (next-single-char-property-change pos prop nil to) >> + prop (remove element (get-text-property pos prop))))) > > If we specialize the function, `remove' -> `remq' > >> + (setq pos (next-single-char-property-change pos prop nil to))))) > > Please factor out `next-single-char-property-change'. > > Note that `org--remove-from-list-text-property' and > `org--add-to-list-text-property' do not seem to be used throughout > your patch. > >> +(defvar org--invisible-spec-priority-list '(outline org-hide-drawer org-hide-block) >> + "Priority of invisibility specs.") > > This should be the constant I wrote about earlier. Note that those are > not "specs", just properties. I suggest to rename it. > >> +(defun org--get-buffer-local-invisible-property-symbol (spec &optional buffer return-only) > > This name is waaaaaaay too long. > >> + "Return unique symbol suitable to be used as buffer-local in BUFFER for 'invisible SPEC. > > Maybe: > > > Return a unique symbol suitable for `invisible' property. > > Then: > > Return value is meant to be used as a buffer-local variable in > current buffer, or BUFFER if this is non-nil. > >> +If the buffer already have buffer-local setup in `char-property-alias-alist' >> +and the setup appears to be created for different buffer, >> +copy the old invisibility state into new buffer-local text properties, >> +unless RETURN-ONLY is non-nil." >> + (if (not (member spec org--invisible-spec-priority-list)) >> + (user-error "%s should be a valid invisibility spec" spec) > > No need to waste an indentation level for that: > > (unless (member …) > (user-error "%S should be …" spec)) > > Also, this is a property, not a "spec". > >> + (let* ((buf (or buffer (current-buffer)))) >> + (let ((local-prop (intern (format "org--invisible-%s-buffer-local-%S" > > This clearly needs a shorter name. In particular, "buffer-local" can be removed. > >> + (symbol-name spec) >> + ;; (sxhash buf) appears to be not constant over time. >> + ;; Using buffer-name is safe, since the only place where >> + ;; buffer-local text property actually matters is an indirect >> + ;; buffer, where the name cannot be same anyway. >> + (sxhash (buffer-name buf)))))) > > >> + (prog1 >> + local-prop > > Please move LOCAL-PROP after the (unless return-only ...) sexp. > >> + (unless return-only >> + (with-current-buffer buf >> + (unless (member local-prop (alist-get 'invisible char-property-alias-alist)) >> + ;; copy old property > > "Copy old property." > >> + (dolist (old-prop (alist-get 'invisible char-property-alias-alist)) > > We cannot use `alist-get', which was added in Emacs 25.3 only. > >> + (org-with-wide-buffer >> + (let* ((pos (point-min)) >> + (spec (seq-find (lambda (spec) >> + (string-match-p (symbol-name spec) >> + (symbol-name old-prop))) >> + org--invisible-spec-priority-list)) > > Likewise, we cannot use `seq-find'. > >> + (new-prop (org--get-buffer-local-invisible-property-symbol spec nil 'return-only))) >> + (while (< pos (point-max)) >> + (when-let (val (get-text-property pos old-prop)) >> + (put-text-property pos (next-single-char-property-change pos old-prop) new-prop val)) >> + (setq pos (next-single-char-property-change pos old-prop)))))) >> + (setq-local char-property-alias-alist >> + (cons (cons 'invisible >> + (mapcar (lambda (spec) >> + (org--get-buffer-local-invisible-property-symbol spec nil 'return-only)) >> + org--invisible-spec-priority-list)) >> + (remove (assq 'invisible char-property-alias-alist) >> + char-property-alias-alist))))))))))) > > This begs for explainations in the docstring or as comments. In > particular, just by reading the code, I have no clue about how this is > going to be used, how it is going to solve issues with indirect > buffers, with invisibility stacking, etc. > > I don't mind if there are more comment lines than lines of code in > that area. > >> - (remove-overlays from to 'invisible spec) >> - ;; Use `front-advance' since text right before to the beginning of >> - ;; the overlay belongs to the visible line than to the contents. >> - (when flag >> - (let ((o (make-overlay from to nil 'front-advance))) >> - (overlay-put o 'evaporate t) >> - (overlay-put o 'invisible spec) >> - (overlay-put o 'isearch-open-invisible #'delete-overlay)))) >> - >> + (with-silent-modifications >> + (remove-text-properties from to (list (org--get-buffer-local-invisible-property-symbol spec) nil)) >> + (when flag >> + (put-text-property from to (org--get-buffer-local-invisible-property-symbol spec) spec)))) > > I don't think there is a need for `remove-text-properties' in every > case. Also, (org--get-buffer-local-invisible-property-symbol spec) > should be factored out. > > I suggest: > > (with-silent-modifications > (let ((property (org--get-buffer-local-invisible-property-symbol spec))) > (if flag > (put-text-property from to property spec) > (remove-text-properties from to (list property nil))))) > >> +(defun org-after-change-function (from to len) > > This is a terrible name. Org may add different functions in a-c-f, > they cannot all be called like this. Assuming the "org-fold" prefix, > it could be: > > org-fold--fix-folded-region > >> + "Process changes in folded elements. >> +If a text was inserted into invisible region, hide the inserted text. >> +If the beginning/end line of a folded drawer/block was changed, unfold it. >> +If a valid end line was inserted in the middle of the folded drawer/block, unfold it." > > Nitpick: please do not skip lines amidst a function. Empty lines are > used to separate functions, so this is distracting. > > If a part of the function should stand out, a comment explaining what > the part is doing is enough. > >> + ;; re-hide text inserted in the middle of a folded region > > Re-hide … folded region. > >> + (dolist (spec org--invisible-spec-priority-list) >> + (when-let ((spec-to (get-text-property to (org--get-buffer-local-invisible-property-symbol spec))) >> + (spec-from (get-text-property (max (point-min) (1- from)) (org--get-buffer-local-invisible-property-symbol spec)))) >> + (when (eq spec-to spec-from) >> + (org-flag-region from to 't spec-to)))) > > This part should first check if we're really after an insertion, e.g., > if FROM is different from TO, and exit early if that's not the case. > > Also, no need to quote t. > >> + ;; Process all the folded text between `from' and `to' >> + (org-with-wide-buffer >> + >> + (if (< to from) >> + (let ((tmp from)) >> + (setq from to) >> + (setq to tmp))) > > I'm surprised you need to do that. Did you encounter a case where > a-c-f was called with boundaries in reverse order? > >> + ;; Include next/previous line into the changed region. >> + ;; This is needed to catch edits in beginning line of a folded >> + ;; element. >> + (setq to (save-excursion (goto-char to) (forward-line) (point))) > > (forward-line) (point) ---> (line-beginning-position 2) > >> + (setq from (save-excursion (goto-char from) (forward-line -1) (point))) > > (forward-line -1) (point) ---> (line-beginning-position 0) > > Anyway, I have the feeling this is not a good idea to extend it now, > without first checking that we are in a folded drawer or block. It may > also catch unwanted parts, e.g., a folded drawer ending on the line > above. > > What about first finding the whole region with property > > (org--get-buffer-local-invisible-property-symbol 'org-hide-drawer) > > then extending the initial part to include the drawer opening? I don't > think we need to extend past the ending part, because drawer closing > line is always included in the invisible part of the drawer. > >> + ;; Expand the considered region to include partially present folded >> + ;; drawer/block. >> + (when (get-text-property from (org--get-buffer-local-invisible-property-symbol 'org-hide-drawer)) >> + (setq from (previous-single-char-property-change from (org--get-buffer-local-invisible-property-symbol 'org-hide-drawer)))) >> + (when (get-text-property from (org--get-buffer-local-invisible-property-symbol 'org-hide-block)) >> + (setq from (previous-single-char-property-change from (org--get-buffer-local-invisible-property-symbol 'org-hide-block)))) > > Please factor out (org--get-buffer-local-invisible-property-symbol > XXX), this is difficult to read. > >> + ;; check folded drawers > > Check folded drawers. > >> + (let ((pos from)) >> + (unless (get-text-property pos (org--get-buffer-local-invisible-property-symbol 'org-hide-drawer)) >> + (setq pos (next-single-char-property-change pos >> + (org--get-buffer-local-invisible-property-symbol 'org-hide-drawer)))) >> + (while (< pos to) >> + (when-let ((drawer-begin (and (get-text-property pos (org--get-buffer-local-invisible-property-symbol 'org-hide-drawer)) >> + pos)) >> + (drawer-end (next-single-char-property-change pos (org--get-buffer-local-invisible-property-symbol 'org-hide-drawer)))) >> + >> + (let (unfold?) >> + ;; the line before folded text should be beginning of the drawer >> + (save-excursion >> + (goto-char drawer-begin) >> + (backward-char) > > Why `backward-char'? > >> + (beginning-of-line) >> + (unless (looking-at-p org-drawer-regexp) > > looking-at-p ---> looking-at > > However, you must wrap this function within `save-match-data'. > >> + (setq unfold? t))) >> + ;; the last line of the folded text should be :END: >> + (save-excursion >> + (goto-char drawer-end) >> + (beginning-of-line) >> + (unless (let ((case-fold-search t)) (looking-at-p org-property-end-re)) >> + (setq unfold? t))) >> + ;; there should be no :END: anywhere in the drawer body >> + (save-excursion >> + (goto-char drawer-begin) >> + (when (save-excursion >> + (let ((case-fold-search t)) >> + (re-search-forward org-property-end-re >> + (max (point) >> + (1- (save-excursion >> + (goto-char drawer-end) >> + (line-beginning-position)))) >> + 't))) > >> (max (point) >> (save-excursion (goto-char drawer-end) (line-end-position 0)) > >> + (setq unfold? t))) >> + ;; there should be no new entry anywhere in the drawer body >> + (save-excursion >> + (goto-char drawer-begin) >> + (when (save-excursion >> + (let ((case-fold-search t)) >> + (re-search-forward org-outline-regexp-bol >> + (max (point) >> + (1- (save-excursion >> + (goto-char drawer-end) >> + (line-beginning-position)))) >> + 't))) >> + (setq unfold? t))) > > In the phase above, you need to bail out as soon as unfold? is non-nil: > > (catch :exit > ... > (throw :exit (setq unfold? t)) > ...) > > Also last two checks should be lumped together, with an appropriate > regexp. > > Finally, I have the feeling we're missing out some early exits when > nothing is folded around point (e.g., most of the case). > >> + >> + (when unfold? (org-flag-region drawer-begin drawer-end nil 'org-hide-drawer)))) >> + >> + (setq pos (next-single-char-property-change pos (org--get-buffer-local-invisible-property-symbol 'org-hide-drawer))))) >> + >> + ;; check folded blocks >> + (let ((pos from)) >> + (unless (get-text-property pos (org--get-buffer-local-invisible-property-symbol 'org-hide-block)) >> + (setq pos (next-single-char-property-change pos >> + (org--get-buffer-local-invisible-property-symbol 'org-hide-block)))) >> + (while (< pos to) >> + (when-let ((block-begin (and (get-text-property pos (org--get-buffer-local-invisible-property-symbol 'org-hide-block)) >> + pos)) >> + (block-end (next-single-char-property-change pos (org--get-buffer-local-invisible-property-symbol 'org-hide-block)))) >> + >> + (let (unfold?) >> + ;; the line before folded text should be beginning of the block >> + (save-excursion >> + (goto-char block-begin) >> + (backward-char) >> + (beginning-of-line) >> + (unless (looking-at-p org-dblock-start-re) >> + (setq unfold? t))) >> + ;; the last line of the folded text should be end of the block >> + (save-excursion >> + (goto-char block-end) >> + (beginning-of-line) >> + (unless (looking-at-p org-dblock-end-re) >> + (setq unfold? t))) >> + ;; there should be no #+end anywhere in the block body >> + (save-excursion >> + (goto-char block-begin) >> + (when (save-excursion >> + (re-search-forward org-dblock-end-re >> + (max (point) >> + (1- (save-excursion >> + (goto-char block-end) >> + (line-beginning-position)))) >> + 't)) >> + (setq unfold? t))) >> + ;; there should be no new entry anywhere in the block body >> + (save-excursion >> + (goto-char block-begin) >> + (when (save-excursion >> + (let ((case-fold-search t)) >> + (re-search-forward org-outline-regexp-bol >> + (max (point) >> + (1- (save-excursion >> + (goto-char block-end) >> + (line-beginning-position)))) >> + 't))) >> + (setq unfold? t))) >> + >> + (when unfold? (org-flag-region block-begin block-end nil 'org-hide-block)))) >> + >> + (setq pos >> + (next-single-char-property-change pos >> + (org--get-buffer-local-invisible-property-symbol 'org-hide-block))))))) > > See remarks above. The parts related to drawers and blocks are so > similar they should be factorized out. > > Also `org-dblock-start-re' and `org-dblock-end-re' are not regexps we > want here. The correct regexps would be: > > (rx bol > (zero-or-more (any " " "\t")) > "#+begin" > (or ":" > (seq "_" > (group (one-or-more (not (syntax whitespace))))))) > > and closing line should match match-group 1 from the regexp above, e.g.: > > (concat (rx bol (zero-or-more (any " " "\t")) "#+end") > (if block-type > (concat "_" > (regexp-quote block-type) > (rx (zero-or-more (any " " "\t")) eol)) > (rx (opt ":") (zero-or-more (any " " "\t")) eol))) > > assuming `block-type' is the type of the block, or nil, i.e., > (match-string 1) in the previous regexp. > >> - (pcase (get-char-property-and-overlay (point) 'invisible) >> + (pcase (get-char-property (point) 'invisible) >> ;; Do not fold already folded drawers. >> - (`(outline . ,o) (goto-char (overlay-end o))) >> + ('outline > > 'outline --> `outline > >> (end-of-line)) >> (while (and (< arg 0) (re-search-backward regexp nil :move)) >> (unless (bobp) >> - (while (pcase (get-char-property-and-overlay (point) 'invisible) >> - (`(outline . ,o) >> - (goto-char (overlay-start o)) >> - (re-search-backward regexp nil :move)) >> - (_ nil)))) >> + (pcase (get-char-property (point) 'invisible) >> + ('outline >> + (goto-char (car (org--find-text-property-region (point) 'invisible))) >> + (beginning-of-line)) >> + (_ nil))) > > Does this move to the beginning of the widest invisible part around > point? If that's not the case, we need a function in "org-fold.el" > doing just that. Or we need to nest `while' loops as it was the case > in the code you reverted. > > ----- > > Regards, > > -- > Nicolas Goaziou ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-08-11 6:45 ` Ihor Radchenko @ 2020-08-11 23:07 ` Kyle Meyer 2020-08-12 6:29 ` Ihor Radchenko 0 siblings, 1 reply; 192+ messages in thread From: Kyle Meyer @ 2020-08-11 23:07 UTC (permalink / raw) To: Ihor Radchenko; +Cc: emacs-orgmode Ihor Radchenko writes: >> 'outline --> `outline > > Could you explain why? Compatibility. pcase learned that in Emacs 25, IIRC. ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-08-11 23:07 ` Kyle Meyer @ 2020-08-12 6:29 ` Ihor Radchenko 2020-09-20 5:53 ` Ihor Radchenko 0 siblings, 1 reply; 192+ messages in thread From: Ihor Radchenko @ 2020-08-12 6:29 UTC (permalink / raw) To: Kyle Meyer; +Cc: emacs-orgmode >>> 'outline --> `outline >> >> Could you explain why? > > Compatibility. pcase learned that in Emacs 25, IIRC. Thanks for the explanation. Fixed now in my local branch. I will send the updated version of the patch after more edits unless someone specifically need to fix this change to make patch work on their system. Best, Ihor Kyle Meyer <kyle@kyleam.com> writes: > Ihor Radchenko writes: > >>> 'outline --> `outline >> >> Could you explain why? > > Compatibility. pcase learned that in Emacs 25, IIRC. ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-08-12 6:29 ` Ihor Radchenko @ 2020-09-20 5:53 ` Ihor Radchenko 2020-09-20 11:45 ` Kévin Le Gouguec 2020-12-04 5:58 ` [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers Ihor Radchenko 0 siblings, 2 replies; 192+ messages in thread From: Ihor Radchenko @ 2020-09-20 5:53 UTC (permalink / raw) To: Kyle Meyer, Nicolas Goaziou, Karl Voit, Christian Heinrich, Bastien Cc: emacs-orgmode Hello, > There are still known problems though. The patch currently breaks many > org-mode tests when running =make test=. It is partially because some > tests assume overlays to be used for folding and partially because the > patch appears to break certain folding conventions. I am still > investigating this (and learning =ert=). All the tests are passing now. The current version of the patch (against master) is in https://gist.github.com/yantar92/6447754415457927293acda43a7fcaef The patch is stable on my system for last several months. There are still some minor issues here and there, but it is getting harder for me to find any problems by myself. I need help from interested users to review and/or test the patch. Best, Ihor Ihor Radchenko <yantar92@gmail.com> writes: >>>> 'outline --> `outline >>> >>> Could you explain why? >> >> Compatibility. pcase learned that in Emacs 25, IIRC. > > Thanks for the explanation. Fixed now in my local branch. > > I will send the updated version of the patch after more edits unless > someone specifically need to fix this change to make patch work on their > system. > > Best, > Ihor > > > Kyle Meyer <kyle@kyleam.com> writes: > >> Ihor Radchenko writes: >> >>>> 'outline --> `outline >>> >>> Could you explain why? >> >> Compatibility. pcase learned that in Emacs 25, IIRC. ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-09-20 5:53 ` Ihor Radchenko @ 2020-09-20 11:45 ` Kévin Le Gouguec 2020-09-22 9:05 ` Ihor Radchenko 2020-12-04 5:58 ` [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers Ihor Radchenko 1 sibling, 1 reply; 192+ messages in thread From: Kévin Le Gouguec @ 2020-09-20 11:45 UTC (permalink / raw) To: emacs-orgmode Hi! Ihor Radchenko <yantar92@gmail.com> writes: > The current version of the patch (against master) is in > https://gist.github.com/yantar92/6447754415457927293acda43a7fcaef I'm probably missing something obvious, but when applying your patch on top of master[1], make fails when generating manuals: > emacs -Q -batch --eval '(setq vc-handled-backends nil org-startup-folded nil)' \ > --eval '(add-to-list '"'"'load-path "../lisp")' \ > --eval '(load "../mk/org-fixup.el")' \ > --eval '(org-make-manuals)' > Loading /home/peniblec/Downloads/sources/emacs-meta/org-mode/mk/org-fixup.el (source)... > Before first headline at position 760959 in buffer org-manual.org<2> > make[1]: *** [Makefile:31: org.texi] Error 255 I've tried going to doc/, running emacs -Q --eval '(setq vc-handled-backends nil org-startup-folded nil)' \ --eval '(add-to-list '"'"'load-path "../lisp")' \ --eval '(load "../mk/org-fixup.el")' then M-x toggle-debug-on-error and M-: (org-make-manuals), but I can't get a stacktrace. I'm guessing this is because this error (which IIUC originates from org-back-to-heading in org.el) is a user-error; however, if I change the function to raise a "regular error", then everything compiles fine… 😕 [1] git apply --3way, on top of commit b64ba64fe. I get a conflict in org.el, on the hunk where org-reveal-location and org-show-context-detail are defined; since your patch just deletes them, I resolve this with: git checkout --theirs -- lisp/org.el ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-09-20 11:45 ` Kévin Le Gouguec @ 2020-09-22 9:05 ` Ihor Radchenko 2020-09-22 10:00 ` Ihor Radchenko 0 siblings, 1 reply; 192+ messages in thread From: Ihor Radchenko @ 2020-09-22 9:05 UTC (permalink / raw) To: Kévin Le Gouguec, emacs-orgmode > I get a conflict in org.el, on the hunk where org-reveal-location > and org-show-context-detail are defined; since your patch just > deletes them, I resolve this with: That's because the patch was against 0afef17e1. The new version of the patch (same URL) is against aea1109ef now. > I've tried going to doc/, running > > emacs -Q --eval '(setq vc-handled-backends nil org-startup-folded nil)' \ > --eval '(add-to-list '"'"'load-path "../lisp")' \ > --eval '(load "../mk/org-fixup.el")' > > then M-x toggle-debug-on-error and M-: (org-make-manuals), but I can't > get a stacktrace. I'm guessing this is because this error (which IIUC > originates from org-back-to-heading in org.el) is a user-error; however, > if I change the function to raise a "regular error", then everything > compiles fine… 😕 I suspect that you forgot to run =make clean= (to remove old untracked .elc files). Best, Ihor Kévin Le Gouguec <kevin.legouguec@gmail.com> writes: > Hi! > > Ihor Radchenko <yantar92@gmail.com> writes: > >> The current version of the patch (against master) is in >> https://gist.github.com/yantar92/6447754415457927293acda43a7fcaef > > I'm probably missing something obvious, but when applying your patch on > top of master[1], make fails when generating manuals: > >> emacs -Q -batch --eval '(setq vc-handled-backends nil org-startup-folded nil)' \ >> --eval '(add-to-list '"'"'load-path "../lisp")' \ >> --eval '(load "../mk/org-fixup.el")' \ >> --eval '(org-make-manuals)' >> Loading /home/peniblec/Downloads/sources/emacs-meta/org-mode/mk/org-fixup.el (source)... >> Before first headline at position 760959 in buffer org-manual.org<2> >> make[1]: *** [Makefile:31: org.texi] Error 255 > > I've tried going to doc/, running > > emacs -Q --eval '(setq vc-handled-backends nil org-startup-folded nil)' \ > --eval '(add-to-list '"'"'load-path "../lisp")' \ > --eval '(load "../mk/org-fixup.el")' > > then M-x toggle-debug-on-error and M-: (org-make-manuals), but I can't > get a stacktrace. I'm guessing this is because this error (which IIUC > originates from org-back-to-heading in org.el) is a user-error; however, > if I change the function to raise a "regular error", then everything > compiles fine… 😕 > > > [1] git apply --3way, on top of commit b64ba64fe. > > I get a conflict in org.el, on the hunk where org-reveal-location > and org-show-context-detail are defined; since your patch just > deletes them, I resolve this with: > > git checkout --theirs -- lisp/org.el ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-09-22 9:05 ` Ihor Radchenko @ 2020-09-22 10:00 ` Ihor Radchenko 2020-09-23 6:16 ` Kévin Le Gouguec 0 siblings, 1 reply; 192+ messages in thread From: Ihor Radchenko @ 2020-09-22 10:00 UTC (permalink / raw) To: Kévin Le Gouguec, emacs-orgmode >> then M-x toggle-debug-on-error and M-: (org-make-manuals), but I can't >> get a stacktrace. I'm guessing this is because this error (which IIUC >> originates from org-back-to-heading in org.el) is a user-error; however, >> if I change the function to raise a "regular error", then everything >> compiles fine… 😕 > > I suspect that you forgot to run =make clean= (to remove old untracked > .elc files). I was wrong. It was actually a problem with org-back-to-heading. Should be fixed now. Best, Ihor Ihor Radchenko <yantar92@gmail.com> writes: >> I get a conflict in org.el, on the hunk where org-reveal-location >> and org-show-context-detail are defined; since your patch just >> deletes them, I resolve this with: > > That's because the patch was against 0afef17e1. The new version of the > patch (same URL) is against aea1109ef now. > >> I've tried going to doc/, running >> >> emacs -Q --eval '(setq vc-handled-backends nil org-startup-folded nil)' \ >> --eval '(add-to-list '"'"'load-path "../lisp")' \ >> --eval '(load "../mk/org-fixup.el")' >> >> then M-x toggle-debug-on-error and M-: (org-make-manuals), but I can't >> get a stacktrace. I'm guessing this is because this error (which IIUC >> originates from org-back-to-heading in org.el) is a user-error; however, >> if I change the function to raise a "regular error", then everything >> compiles fine… 😕 > > I suspect that you forgot to run =make clean= (to remove old untracked > .elc files). > > Best, > Ihor > > Kévin Le Gouguec <kevin.legouguec@gmail.com> writes: > >> Hi! >> >> Ihor Radchenko <yantar92@gmail.com> writes: >> >>> The current version of the patch (against master) is in >>> https://gist.github.com/yantar92/6447754415457927293acda43a7fcaef >> >> I'm probably missing something obvious, but when applying your patch on >> top of master[1], make fails when generating manuals: >> >>> emacs -Q -batch --eval '(setq vc-handled-backends nil org-startup-folded nil)' \ >>> --eval '(add-to-list '"'"'load-path "../lisp")' \ >>> --eval '(load "../mk/org-fixup.el")' \ >>> --eval '(org-make-manuals)' >>> Loading /home/peniblec/Downloads/sources/emacs-meta/org-mode/mk/org-fixup.el (source)... >>> Before first headline at position 760959 in buffer org-manual.org<2> >>> make[1]: *** [Makefile:31: org.texi] Error 255 >> >> I've tried going to doc/, running >> >> emacs -Q --eval '(setq vc-handled-backends nil org-startup-folded nil)' \ >> --eval '(add-to-list '"'"'load-path "../lisp")' \ >> --eval '(load "../mk/org-fixup.el")' >> >> then M-x toggle-debug-on-error and M-: (org-make-manuals), but I can't >> get a stacktrace. I'm guessing this is because this error (which IIUC >> originates from org-back-to-heading in org.el) is a user-error; however, >> if I change the function to raise a "regular error", then everything >> compiles fine… 😕 >> >> >> [1] git apply --3way, on top of commit b64ba64fe. >> >> I get a conflict in org.el, on the hunk where org-reveal-location >> and org-show-context-detail are defined; since your patch just >> deletes them, I resolve this with: >> >> git checkout --theirs -- lisp/org.el ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-09-22 10:00 ` Ihor Radchenko @ 2020-09-23 6:16 ` Kévin Le Gouguec 2020-09-23 6:48 ` Ihor Radchenko 0 siblings, 1 reply; 192+ messages in thread From: Kévin Le Gouguec @ 2020-09-23 6:16 UTC (permalink / raw) To: emacs-orgmode Ihor Radchenko <yantar92@gmail.com> writes: >>> then M-x toggle-debug-on-error and M-: (org-make-manuals), but I can't >>> get a stacktrace. I'm guessing this is because this error (which IIUC >>> originates from org-back-to-heading in org.el) is a user-error; however, >>> if I change the function to raise a "regular error", then everything >>> compiles fine… 😕 >> >> I suspect that you forgot to run =make clean= (to remove old untracked >> .elc files). > > I was wrong. It was actually a problem with org-back-to-heading. Should > be fixed now. Thanks! The new patch applies cleanly (to aea1109ef), and "make" runs to completion. I have seen no obvious breakage so far; I'll make sure to report if anything funny shows up. Apologies for maybe changing the subject, but earlier this summer you mentioned[1] you were working on a patch to the folding system that would fix an issue I have[2] with LOGBOOKs since 9.4. AFAICT the patch you are sharing now does not fix that; is this issue still on your radar? At any rate, thank you for your work! [1] https://orgmode.org/list/87r1ts3s8r.fsf@localhost/ [2] https://orgmode.org/list/87eepuz0bj.fsf@gmail.com/ tl;dr even with #+STARTUP: overview, isearching opens all logbooks near search results, even though there are no matches inside logbooks themselves. ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-09-23 6:16 ` Kévin Le Gouguec @ 2020-09-23 6:48 ` Ihor Radchenko 2020-09-23 7:09 ` Bastien 2020-09-24 18:07 ` Kévin Le Gouguec 0 siblings, 2 replies; 192+ messages in thread From: Ihor Radchenko @ 2020-09-23 6:48 UTC (permalink / raw) To: Kévin Le Gouguec, emacs-orgmode > Apologies for maybe changing the subject, but earlier this summer you > mentioned[1] you were working on a patch to the folding system that > would fix an issue I have[2] with LOGBOOKs since 9.4. AFAICT the patch > you are sharing now does not fix that; is this issue still on your > radar? Thanks for reporting! I accidentally reintroduced the bug because of mistake when converting org-hide-drawers to new folding library. (:facepalm:). Should be fixed in the gist now. Best, Ihor Kévin Le Gouguec <kevin.legouguec@gmail.com> writes: > Ihor Radchenko <yantar92@gmail.com> writes: > >>>> then M-x toggle-debug-on-error and M-: (org-make-manuals), but I can't >>>> get a stacktrace. I'm guessing this is because this error (which IIUC >>>> originates from org-back-to-heading in org.el) is a user-error; however, >>>> if I change the function to raise a "regular error", then everything >>>> compiles fine… 😕 >>> >>> I suspect that you forgot to run =make clean= (to remove old untracked >>> .elc files). >> >> I was wrong. It was actually a problem with org-back-to-heading. Should >> be fixed now. > > Thanks! The new patch applies cleanly (to aea1109ef), and "make" runs > to completion. > > I have seen no obvious breakage so far; I'll make sure to report if > anything funny shows up. > > > Apologies for maybe changing the subject, but earlier this summer you > mentioned[1] you were working on a patch to the folding system that > would fix an issue I have[2] with LOGBOOKs since 9.4. AFAICT the patch > you are sharing now does not fix that; is this issue still on your > radar? > > > At any rate, thank you for your work! > > > [1] https://orgmode.org/list/87r1ts3s8r.fsf@localhost/ > [2] https://orgmode.org/list/87eepuz0bj.fsf@gmail.com/ > > tl;dr even with #+STARTUP: overview, isearching opens all logbooks > near search results, even though there are no matches inside > logbooks themselves. ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-09-23 6:48 ` Ihor Radchenko @ 2020-09-23 7:09 ` Bastien 2020-09-23 7:30 ` Ihor Radchenko 2020-09-24 18:07 ` Kévin Le Gouguec 1 sibling, 1 reply; 192+ messages in thread From: Bastien @ 2020-09-23 7:09 UTC (permalink / raw) To: Ihor Radchenko; +Cc: emacs-orgmode, Kévin Le Gouguec Hi Ihor, Ihor Radchenko <yantar92@gmail.com> writes: > Thanks for reporting! I accidentally reintroduced the bug because of > mistake when converting org-hide-drawers to new folding library. > (:facepalm:). > > Should be fixed in the gist now. Can you share this gist as a patch against Org's current master? -- Bastien ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-09-23 7:09 ` Bastien @ 2020-09-23 7:30 ` Ihor Radchenko 0 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2020-09-23 7:30 UTC (permalink / raw) To: Bastien; +Cc: emacs-orgmode, Kévin Le Gouguec > Can you share this gist as a patch against Org's current master? That is not possible. The underlying reason of the bug in the patch is different from master. On master, the overlays for folded drawers and headlines are merged together - when folded headline is opened by isearch, everything is revealed. The fix would involve special logic re-hiding drawers when necessary. On the org-fold feature branch, the drawers and headlines are folded independently. The reason why the bug persisted was my mistake in org-hide-drawers - I skipped drawers inside folded headlines, even when the drawers themselves were not folded. In my case the fix was trivial - I replaced condition when to skip drawer at point: [any fold is present at point] -> [drawer fold is present at point] (org-fold-get-folding-spec) -> (org-fold-get-folding-spec (org-fold-get-folding-spec-for-element 'drawer)) So, the fix is only relevant to the whole org-fold branch. Best, Ihor Bastien <bzg@gnu.org> writes: > Hi Ihor, > > Ihor Radchenko <yantar92@gmail.com> writes: > >> Thanks for reporting! I accidentally reintroduced the bug because of >> mistake when converting org-hide-drawers to new folding library. >> (:facepalm:). >> >> Should be fixed in the gist now. > > Can you share this gist as a patch against Org's current master? > > -- > Bastien ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-09-23 6:48 ` Ihor Radchenko 2020-09-23 7:09 ` Bastien @ 2020-09-24 18:07 ` Kévin Le Gouguec 2020-09-25 2:16 ` Ihor Radchenko 1 sibling, 1 reply; 192+ messages in thread From: Kévin Le Gouguec @ 2020-09-24 18:07 UTC (permalink / raw) To: Ihor Radchenko; +Cc: emacs-orgmode Ihor Radchenko <yantar92@gmail.com> writes: > Thanks for reporting! I accidentally reintroduced the bug because of > mistake when converting org-hide-drawers to new folding library. > (:facepalm:). > > Should be fixed in the gist now. Can confirm, thanks! I understand from your answer to Bastien's query that this fix is specific to your branch; would it be hard to backport it to Org's maint branch? Otherwise IIUC Org 9.4 will keep this regression, and users will have to wait until Org 9.5 for a fix. Also, just in case there's been a misunderstanding: Bastien <bzg@gnu.org> writes: > Can you share this gist as a patch against Org's current master? Bastien asked for the /gist/ as a patch against master, whereas your answer explained why you couldn't share the /fix/ as a patch against master. If Bastien did mean the whole gist, here is the corresponding patch against master: https://gist.githubusercontent.com/yantar92/6447754415457927293acda43a7fcaef/raw/7e43948e6c21220661534b79770bc1a6784b7893/featuredrawertextprop.patch Apologies if I'm the one misunderstanding, and thank you for all your efforts! ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-09-24 18:07 ` Kévin Le Gouguec @ 2020-09-25 2:16 ` Ihor Radchenko 2020-12-15 17:38 ` [9.4] Fixing logbook visibility during isearch Kévin Le Gouguec 0 siblings, 1 reply; 192+ messages in thread From: Ihor Radchenko @ 2020-09-25 2:16 UTC (permalink / raw) To: Kévin Le Gouguec; +Cc: emacs-orgmode > I understand from your answer to Bastien's query that this fix is > specific to your branch; would it be hard to backport it to Org's maint > branch? Otherwise IIUC Org 9.4 will keep this regression, and users > will have to wait until Org 9.5 for a fix. The problem is that fix in my branch has nothing to do with main branch. The bugs were inherently different even though looked same from user point of view. If one wants to make the fix work on master, the whole branch must be applied. However, I can try to suggest a way to fix the issue on master. The way isearch handles folded text in org is set from org-flag-region (org-macs.el): (overlay-put o 'isearch-open-invisible (lambda (&rest _) (org-show-context 'isearch))) It means that isearch calls org-show-context (org.el) to reveal hidden text. Then, it calls org-show-set-visibility with argument defined in org-show-context-detail (now, it is 'lineage). With current defaults, the searched text is revealed using org-flag-heading, which reveals both heading body and drawers. The easiest way to write the fix would be changing org-flag-heading directly, but there might be unforeseen consequences on other folding commands. Another way would be changing the way org-show-set-visibility handles 'lineage argument. Again, it may affect other things. Finally, one can add an extra possible argument to org-show-set-visibility and alter default value of org-show-context-detail accordingly. The last way will have least risk to break something else. I guess, patches welcome ;) > Bastien asked for the /gist/ as a patch against master, whereas your > answer explained why you couldn't share the /fix/ as a patch against > master. If Bastien did mean the whole gist, here is the corresponding > patch against master: Well. The gist is a patch applying the whole feature/org-fold branch to master. That's not yet something we can do. The plan is to apply the org-fold feature in several steps, as discussed in earlier messages. So, I thought that it would just create confusion if I share the gist as is. Sorry if I was not clear. Best, Ihor Kévin Le Gouguec <kevin.legouguec@gmail.com> writes: > Ihor Radchenko <yantar92@gmail.com> writes: > >> Thanks for reporting! I accidentally reintroduced the bug because of >> mistake when converting org-hide-drawers to new folding library. >> (:facepalm:). >> >> Should be fixed in the gist now. > > Can confirm, thanks! > > I understand from your answer to Bastien's query that this fix is > specific to your branch; would it be hard to backport it to Org's maint > branch? Otherwise IIUC Org 9.4 will keep this regression, and users > will have to wait until Org 9.5 for a fix. > > Also, just in case there's been a misunderstanding: > > Bastien <bzg@gnu.org> writes: > >> Can you share this gist as a patch against Org's current master? > > Bastien asked for the /gist/ as a patch against master, whereas your > answer explained why you couldn't share the /fix/ as a patch against > master. If Bastien did mean the whole gist, here is the corresponding > patch against master: > > https://gist.githubusercontent.com/yantar92/6447754415457927293acda43a7fcaef/raw/7e43948e6c21220661534b79770bc1a6784b7893/featuredrawertextprop.patch > > Apologies if I'm the one misunderstanding, and thank you for all your > efforts! ^ permalink raw reply [flat|nested] 192+ messages in thread
* [9.4] Fixing logbook visibility during isearch 2020-09-25 2:16 ` Ihor Radchenko @ 2020-12-15 17:38 ` Kévin Le Gouguec 2020-12-16 3:15 ` Ihor Radchenko 0 siblings, 1 reply; 192+ messages in thread From: Kévin Le Gouguec @ 2020-12-15 17:38 UTC (permalink / raw) To: Ihor Radchenko; +Cc: emacs-orgmode Ihor Radchenko <yantar92@gmail.com> writes: > However, I can try to suggest a way to fix the issue on master. The way > isearch handles folded text in org is set from org-flag-region > (org-macs.el): > > (overlay-put o > 'isearch-open-invisible > (lambda (&rest _) (org-show-context 'isearch))) > > It means that isearch calls org-show-context (org.el) to reveal hidden > text. Then, it calls org-show-set-visibility with argument defined in > org-show-context-detail (now, it is 'lineage). With current defaults, > the searched text is revealed using org-flag-heading, which reveals both > heading body and drawers. > > The easiest way to write the fix would be changing org-flag-heading > directly, but there might be unforeseen consequences on other folding > commands. > > Another way would be changing the way org-show-set-visibility handles > 'lineage argument. Again, it may affect other things. > > Finally, one can add an extra possible argument to > org-show-set-visibility and alter default value of > org-show-context-detail accordingly. > > The last way will have least risk to break something else. > > I guess, patches welcome ;) Since Org 9.4 has landed in the emacs-27 branch, I have renewed interest in finding a fix for this before 27.2 is released (… and more selfishly, before emacs-27 is merged into master 😉). I'm a bit confused, because AFAICT org-show-context is called *after* exiting isearch, so IIUC by the time org-show-set-visibility is called it's too late to undo the damage. Recipe using my repro file[1]: - C-x C-f logbooks.org - M-x toggle-debug-on-entry org-show-context - C-s bug The debugger only fires *after* we exit isearch, and by that time it's too late: my issue comes from all those logbooks cluttering the screen while I'm mashing C-s to iterate through matches. I can try to dig deeper into this, but before doing so: would you have any insight as to what's going on here? [1] wget https://orgmode.org/list/87eepuz0bj.fsf@gmail.com/2-logbooks.org -O tmp/logbooks.org ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [9.4] Fixing logbook visibility during isearch 2020-12-15 17:38 ` [9.4] Fixing logbook visibility during isearch Kévin Le Gouguec @ 2020-12-16 3:15 ` Ihor Radchenko 2020-12-16 18:05 ` Kévin Le Gouguec 0 siblings, 1 reply; 192+ messages in thread From: Ihor Radchenko @ 2020-12-16 3:15 UTC (permalink / raw) To: Kévin Le Gouguec; +Cc: emacs-orgmode Kévin Le Gouguec <kevin.legouguec@gmail.com> writes: > The debugger only fires *after* we exit isearch, and by that time it's > too late: my issue comes from all those logbooks cluttering the screen > while I'm mashing C-s to iterate through matches. > > I can try to dig deeper into this, but before doing so: would you have > any insight as to what's going on here? org-mode is relying on default isearch behaviour during interactive C-s session. By default, isearch simply makes all the overlays at match visible and re-hide them once we move to the next match. In case of org-mode, this reveals drawers as well, since they are in the same overlay with the rest of the folded heading. The way to change default isearch behaviour *during* isearch session is setting undocumented 'isearch-open-invisible-temporary property of the overlay (see isearch-open-overlay-temporary). The function must accept two arguments: overlay and flag. If flag is non-nil, the function should re-hide the overlay text and it should reveal the overlay when flag is nil. Best, Ihor ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [9.4] Fixing logbook visibility during isearch 2020-12-16 3:15 ` Ihor Radchenko @ 2020-12-16 18:05 ` Kévin Le Gouguec 2020-12-17 3:18 ` Ihor Radchenko 0 siblings, 1 reply; 192+ messages in thread From: Kévin Le Gouguec @ 2020-12-16 18:05 UTC (permalink / raw) To: Ihor Radchenko; +Cc: emacs-orgmode Ihor Radchenko <yantar92@gmail.com> writes: > Kévin Le Gouguec <kevin.legouguec@gmail.com> writes: > >> The debugger only fires *after* we exit isearch, and by that time it's >> too late: my issue comes from all those logbooks cluttering the screen >> while I'm mashing C-s to iterate through matches. >> >> I can try to dig deeper into this, but before doing so: would you have >> any insight as to what's going on here? > > org-mode is relying on default isearch behaviour during interactive C-s > session. By default, isearch simply makes all the overlays at match > visible and re-hide them once we move to the next match. In case of > org-mode, this reveals drawers as well, since they are in the same > overlay with the rest of the folded heading. > > The way to change default isearch behaviour *during* isearch session is > setting undocumented 'isearch-open-invisible-temporary property of the > overlay (see isearch-open-overlay-temporary). Thanks for taking the time to explain this. I can't find any reference to this property in Org <9.4 (e.g. 9.3 as shipped in 27.1, where the bug does not happen) so do I understand correctly that the root cause ("since [drawers] are in the same overlay with the rest of the folded heading") dates from Org 9.4? (Just trying to understand if I should keep looking at Org 9.3 for inspiration, or if your proposed solution based on isearch-open-invisible-temporary should be implemented from scratch) ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [9.4] Fixing logbook visibility during isearch 2020-12-16 18:05 ` Kévin Le Gouguec @ 2020-12-17 3:18 ` Ihor Radchenko 2020-12-17 14:50 ` Kévin Le Gouguec 0 siblings, 1 reply; 192+ messages in thread From: Ihor Radchenko @ 2020-12-17 3:18 UTC (permalink / raw) To: Kévin Le Gouguec; +Cc: emacs-orgmode Kévin Le Gouguec <kevin.legouguec@gmail.com> writes: > I can't find any reference to this property in Org <9.4 (e.g. 9.3 as > shipped in 27.1, where the bug does not happen) so do I understand > correctly that the root cause ("since [drawers] are in the same overlay > with the rest of the folded heading") dates from Org 9.4? Yes, the root cause is that overlays used to hide drawers now automatically merge with outline overlays. This was introduced in Org 9.4 to improve performance (too many overlays are handled badly by Emacs). > (Just trying to understand if I should keep looking at Org 9.3 for > inspiration, or if your proposed solution based on > isearch-open-invisible-temporary should be implemented from scratch) You will probably need to implement this from scratch (or use the feature/org-fold branch from github.com/yantar92/org). In Org 9.3 the folded headline looked like the following: * Headline <begin hidden outline overlay> :PROPERTIES:<begin hidden drawer overlay> :PROPERTY1: value1 :PROPERTY2: value2 :END:<end hidden drawer overlay> headline text another line <end hidden outline overlay> When using isearch with "text" search string, the overlay containing "text" is temporarily revealed by isearch (via setting 'invisible property of the overlay to nil): * Headline <begin *visible* outline overlay> :PROPERTES:<begin hidden drawer overlay> :PROPERTY1: value1 :PROPERTY2: value2 :END:<end hidden drawer overlay> headline text another line <end *visible* outline overlay> As you can see, the drawer overlay remains unchanged and hidden. In Org 9.4, drawer overlay does not exist when we fold the headline text and isearch reveals everything. To work around this issue, you need to hook into the way isearch reveals hidden match by setting 'isearch-open-invisible-temporary property of the overlays to custom function (you can set the property inside org-flag-region). The function should re-hide the drawers when matching text is not inside the drawer. Best, Ihor ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [9.4] Fixing logbook visibility during isearch 2020-12-17 3:18 ` Ihor Radchenko @ 2020-12-17 14:50 ` Kévin Le Gouguec 2020-12-18 2:23 ` Ihor Radchenko 0 siblings, 1 reply; 192+ messages in thread From: Kévin Le Gouguec @ 2020-12-17 14:50 UTC (permalink / raw) To: Ihor Radchenko; +Cc: emacs-orgmode Ihor Radchenko <yantar92@gmail.com> writes: > You will probably need to implement this from scratch (or use the > feature/org-fold branch from github.com/yantar92/org). Gotcha. TBH I don't know if I'll have the time to cook up a patch before 27.2 is released; all the same, I appreciate you taking the time to explain all this. Since the changes in Org 9.4 aimed at improving performance, is there a test case somewhere in the "Mitigating the poor Emacs performance on huge org files" thread that could help ensure that a tentative fix will not degrade performance? ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [9.4] Fixing logbook visibility during isearch 2020-12-17 14:50 ` Kévin Le Gouguec @ 2020-12-18 2:23 ` Ihor Radchenko 2020-12-24 23:37 ` Kévin Le Gouguec 0 siblings, 1 reply; 192+ messages in thread From: Ihor Radchenko @ 2020-12-18 2:23 UTC (permalink / raw) To: Kévin Le Gouguec; +Cc: emacs-orgmode Kévin Le Gouguec <kevin.legouguec@gmail.com> writes: > Since the changes in Org 9.4 aimed at improving performance, is there a > test case somewhere in the "Mitigating the poor Emacs performance on > huge org files" thread that could help ensure that a tentative fix will > not degrade performance? The first message in the thread ;) I believe it was also used to benchmark the change in 9.4. >> [3] See the attached org file in my Emacs bug report: https://lists.gnu.org/archive/html/bug-gnu-emacs/2019-04/txte6kQp35VOm.txt Or you can ask me to test. That example file is my stripped someday list, which grew to much larger size since the time I created that example. Best, Ihor ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [9.4] Fixing logbook visibility during isearch 2020-12-18 2:23 ` Ihor Radchenko @ 2020-12-24 23:37 ` Kévin Le Gouguec 2020-12-25 2:51 ` Ihor Radchenko 0 siblings, 1 reply; 192+ messages in thread From: Kévin Le Gouguec @ 2020-12-24 23:37 UTC (permalink / raw) To: Ihor Radchenko; +Cc: emacs-orgmode Ihor Radchenko <yantar92@gmail.com> writes: > Kévin Le Gouguec <kevin.legouguec@gmail.com> writes: > >> Since the changes in Org 9.4 aimed at improving performance, is there a >> test case somewhere in the "Mitigating the poor Emacs performance on >> huge org files" thread that could help ensure that a tentative fix will >> not degrade performance? > > The first message in the thread ;) I believe it was also used to > benchmark the change in 9.4. Thanks for the pointer! I've looked at your branch for inspiration, and my takeaway is that the isearch-open-invisible-temporary route might be too involved for a bugfix, especially if it's going to be reverted wholesale when your branch gets merged. Then again, maybe I'm not smart enough to devise a solution. I wonder if the path of least resistance couldn't be found in org-cycle-hide-drawers: right now this function just skips over drawers which are covered with an invisible overlay, but maybe it should not skip a drawer if the overlay starts before it (i.e. the overlay is not specific to this drawer but covers a whole containing section). ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [9.4] Fixing logbook visibility during isearch 2020-12-24 23:37 ` Kévin Le Gouguec @ 2020-12-25 2:51 ` Ihor Radchenko 2020-12-25 10:59 ` Kévin Le Gouguec 2020-12-25 21:35 ` Kévin Le Gouguec 0 siblings, 2 replies; 192+ messages in thread From: Ihor Radchenko @ 2020-12-25 2:51 UTC (permalink / raw) To: Kévin Le Gouguec; +Cc: emacs-orgmode Kévin Le Gouguec <kevin.legouguec@gmail.com> writes: > I've looked at your branch for inspiration, and my takeaway is that the > isearch-open-invisible-temporary route might be too involved for a > bugfix, especially if it's going to be reverted wholesale when your > branch gets merged. Then again, maybe I'm not smart enough to devise a > solution. My current plan is supporting the overlay-based approach even after merging the branch (by default). So, overlays should be around for a while and the issue with drawer visibility will be around as well, unless you fix it. I will probably work on this in distant future, but that's not the priority now. > I wonder if the path of least resistance couldn't be found in > org-cycle-hide-drawers: right now this function just skips over drawers > which are covered with an invisible overlay, but maybe it should not > skip a drawer if the overlay starts before it (i.e. the overlay is not > specific to this drawer but covers a whole containing section). That would defeat the purpose why the number of overlays was reduced in Org 9.4. However, org-cycle-hide-drawers might be called in isearch-open-invisible-temporary. Best, Ihor ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [9.4] Fixing logbook visibility during isearch 2020-12-25 2:51 ` Ihor Radchenko @ 2020-12-25 10:59 ` Kévin Le Gouguec 2020-12-25 12:32 ` Ihor Radchenko 2020-12-25 21:35 ` Kévin Le Gouguec 1 sibling, 1 reply; 192+ messages in thread From: Kévin Le Gouguec @ 2020-12-25 10:59 UTC (permalink / raw) To: Ihor Radchenko; +Cc: emacs-orgmode Ihor Radchenko <yantar92@gmail.com> writes: > My current plan is supporting the overlay-based approach even after > merging the branch (by default). So, overlays should be around for a > while and the issue with drawer visibility will be around as well, > unless you fix it. I will probably work on this in distant future, but > that's not the priority now. Mmm; is the current state of your branch representative of your plan? If I compile it and run emacs -Q -L $yourbranch/lisp --eval '(setq org-startup-folded t)' $someorgfile Then isearching does not reveal logbook drawers unless matches are found inside, which as far as I am concerned fixes my issue with 9.4. >> I wonder if the path of least resistance couldn't be found in >> org-cycle-hide-drawers: right now this function just skips over drawers >> which are covered with an invisible overlay, but maybe it should not >> skip a drawer if the overlay starts before it (i.e. the overlay is not >> specific to this drawer but covers a whole containing section). > > That would defeat the purpose why the number of overlays was reduced in > Org 9.4. However, org-cycle-hide-drawers might be called in > isearch-open-invisible-temporary. Thanks for the tip. ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [9.4] Fixing logbook visibility during isearch 2020-12-25 10:59 ` Kévin Le Gouguec @ 2020-12-25 12:32 ` Ihor Radchenko 0 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2020-12-25 12:32 UTC (permalink / raw) To: Kévin Le Gouguec; +Cc: emacs-orgmode Kévin Le Gouguec <kevin.legouguec@gmail.com> writes: > Ihor Radchenko <yantar92@gmail.com> writes: > >> My current plan is supporting the overlay-based approach even after >> merging the branch (by default). So, overlays should be around for a >> while and the issue with drawer visibility will be around as well, >> unless you fix it. I will probably work on this in distant future, but >> that's not the priority now. > > Mmm; is the current state of your branch representative of your plan? Not yet. That's rather a big change and I am currently generalising the core org-fold API to support both text properties and overlays. You can see WIP in org-fold-core.el from org-fold-universal-core branch. That branch is not usable yet. Best, Ihor ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [9.4] Fixing logbook visibility during isearch 2020-12-25 2:51 ` Ihor Radchenko 2020-12-25 10:59 ` Kévin Le Gouguec @ 2020-12-25 21:35 ` Kévin Le Gouguec 2020-12-26 4:14 ` Ihor Radchenko 1 sibling, 1 reply; 192+ messages in thread From: Kévin Le Gouguec @ 2020-12-25 21:35 UTC (permalink / raw) To: Ihor Radchenko; +Cc: emacs-orgmode Ihor Radchenko <yantar92@gmail.com> writes: > However, org-cycle-hide-drawers might be called in > isearch-open-invisible-temporary. This callback receives two arguments: - the overlay which contains a match, - whether we are un-hiding the overlay's span or hiding it back. To get the same behaviour as Org≤9.3, IIUC we want to do the following: 1. When isearch asks us to un-hide, 1. go over all drawers within the overlay, 2. hide those that do not contain a match, by adding an invisible overlay. 2. When isearch asks us to hide back, 1. remove the invisible overlays we have put on these drawers. 1.1. is straightforward: overlay-start and overlay-end tell us where to look for drawers. 1.2. stumps me: is there an isearch API I can use while in the callback to know where the matches are located? For 2.1, I guess we will need to cache the temporary invisible overlays we add during step 1. in a global list; that way when it's time to destroy them, we can simply iterate on the list? (Sorry for being so slow 😕 I never seem to be able to spend more than 10 minutes on this issue before having to switch to something else…) ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [9.4] Fixing logbook visibility during isearch 2020-12-25 21:35 ` Kévin Le Gouguec @ 2020-12-26 4:14 ` Ihor Radchenko 2020-12-26 11:44 ` Kévin Le Gouguec 0 siblings, 1 reply; 192+ messages in thread From: Ihor Radchenko @ 2020-12-26 4:14 UTC (permalink / raw) To: Kévin Le Gouguec; +Cc: emacs-orgmode Kévin Le Gouguec <kevin.legouguec@gmail.com> writes: > 1.2. stumps me: is there an isearch API I can use while in the callback > to know where the matches are located? I do not think that there is direct API for this, but the match should be accessible through match-beginning/match-end, as I can see from the isearch.el code. > For 2.1, I guess we will need to cache the temporary invisible overlays > we add during step 1. in a global list; that way when it's time to > destroy them, we can simply iterate on the list? That's what I do in org-fold--isearch-show-temporary. Best, Ihor ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [9.4] Fixing logbook visibility during isearch 2020-12-26 4:14 ` Ihor Radchenko @ 2020-12-26 11:44 ` Kévin Le Gouguec 2020-12-26 12:22 ` Ihor Radchenko 0 siblings, 1 reply; 192+ messages in thread From: Kévin Le Gouguec @ 2020-12-26 11:44 UTC (permalink / raw) To: Ihor Radchenko; +Cc: emacs-orgmode Ihor Radchenko <yantar92@gmail.com> writes: > Kévin Le Gouguec <kevin.legouguec@gmail.com> writes: > >> 1.2. stumps me: is there an isearch API I can use while in the callback >> to know where the matches are located? > > I do not think that there is direct API for this, but the match should > be accessible through match-beginning/match-end, as I can see from the > isearch.el code. Right, I've seen this too; I wonder if it's a hard guarantee or an implementation detail. I might page help-gnu-emacs about this. ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [9.4] Fixing logbook visibility during isearch 2020-12-26 11:44 ` Kévin Le Gouguec @ 2020-12-26 12:22 ` Ihor Radchenko 0 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2020-12-26 12:22 UTC (permalink / raw) To: Kévin Le Gouguec; +Cc: emacs-orgmode Kévin Le Gouguec <kevin.legouguec@gmail.com> writes: > Ihor Radchenko <yantar92@gmail.com> writes: > >> Kévin Le Gouguec <kevin.legouguec@gmail.com> writes: >> >>> 1.2. stumps me: is there an isearch API I can use while in the callback >>> to know where the matches are located? >> >> I do not think that there is direct API for this, but the match should >> be accessible through match-beginning/match-end, as I can see from the >> isearch.el code. > > Right, I've seen this too; I wonder if it's a hard guarantee or an > implementation detail. I might page help-gnu-emacs about this. Another way could by using isearch-filter-predicate. It is given the search region directly. ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-09-20 5:53 ` Ihor Radchenko 2020-09-20 11:45 ` Kévin Le Gouguec @ 2020-12-04 5:58 ` Ihor Radchenko 2021-03-21 9:09 ` Ihor Radchenko 1 sibling, 1 reply; 192+ messages in thread From: Ihor Radchenko @ 2020-12-04 5:58 UTC (permalink / raw) To: Kyle Meyer, Nicolas Goaziou, Karl Voit, Christian Heinrich, Bastien Cc: emacs-orgmode Hello, This is an update about the current status of the patch. Since there was not much feedback, I decided to share the up-to-date branch on github, so that people can directly download/clone the whole thing and load it to Emacs without a need to install the patch manually. The github repo is https://github.com/yantar92/org ---- On the progress with the code, I have found many more bugs, which are not critical for me, but should be fixed anyway. I will keep working on them and keep the github repo up to date. One more important thing I wanted to mention is about the way org-fold should be merged on master. I plan to support using overlays within org-fold depending on custom variable. If the variable is set to 'overlay, org fold will use overlays without all the complexity of text property approach. The 'overlay value will be set by default. If a user wants to use text properties, the variable can be customised. The described approach will allow all the users test the text property-based folding as experimental feature (similar to org-element-use-cache). Once we are confident enough that the code is stable, we can just change the default. What do you think? Best, Ihor Ihor Radchenko <yantar92@gmail.com> writes: > Hello, > >> There are still known problems though. The patch currently breaks many >> org-mode tests when running =make test=. It is partially because some >> tests assume overlays to be used for folding and partially because the >> patch appears to break certain folding conventions. I am still >> investigating this (and learning =ert=). > > All the tests are passing now. > The current version of the patch (against master) is in > https://gist.github.com/yantar92/6447754415457927293acda43a7fcaef > > The patch is stable on my system for last several months. There are > still some minor issues here and there, but it is getting harder for me > to find any problems by myself. I need help from interested users to > review and/or test the patch. > > Best, > Ihor ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2020-12-04 5:58 ` [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers Ihor Radchenko @ 2021-03-21 9:09 ` Ihor Radchenko 2021-05-03 17:28 ` Bastien 0 siblings, 1 reply; 192+ messages in thread From: Ihor Radchenko @ 2021-03-21 9:09 UTC (permalink / raw) To: Kyle Meyer, Nicolas Goaziou, Karl Voit, Christian Heinrich, Bastien Cc: emacs-orgmode [-- Attachment #1: Type: text/plain, Size: 749 bytes --] Hello, This is another update about the status of the patch. I am mostly happy with the current state of the code, got rid of most of the bugs, and did not get any new bug reports in github for a while. I would like to start the process of applying the patch on master. As a first step, I would like to submit the core folding library (org-fold-core) for review. org-fold-core is pretty much independent from org-mode code base and does not affect anything if applied as is. It will be used by org-specific org-fold.el I will finalise and send later. For now, I would like to hear any suggestions about API and implementation of org-fold-core.el. I tried to document all the details in the code. Looking forward for the feedback. Best, Ihor [-- Attachment #2: org-fold-core.el --] [-- Type: application/emacs-lisp, Size: 62759 bytes --] ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2021-03-21 9:09 ` Ihor Radchenko @ 2021-05-03 17:28 ` Bastien 2021-09-21 13:32 ` Timothy 2022-01-29 11:37 ` [PATCH 00/35] Merge org-fold feature branch Ihor Radchenko 0 siblings, 2 replies; 192+ messages in thread From: Bastien @ 2021-05-03 17:28 UTC (permalink / raw) To: Ihor Radchenko Cc: Karl Voit, emacs-orgmode, Kyle Meyer, Christian Heinrich, Nicolas Goaziou Hi Ihor, Ihor Radchenko <yantar92@gmail.com> writes: > This is another update about the status of the patch. Thank you *very much* for this work and sorry for the slow reply. I urge everyone to test this change, as I'd like to include it in Org 9.5 if it's ready. I will test this myself this week and report. Thanks! -- Bastien ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2021-05-03 17:28 ` Bastien @ 2021-09-21 13:32 ` Timothy 2021-10-26 17:25 ` Matt Price 2022-01-29 11:37 ` [PATCH 00/35] Merge org-fold feature branch Ihor Radchenko 1 sibling, 1 reply; 192+ messages in thread From: Timothy @ 2021-09-21 13:32 UTC (permalink / raw) To: Bastien Cc: Karl Voit, Ihor Radchenko, emacs-orgmode, Nicolas Goaziou, Christian Heinrich, Kyle Meyer [-- Attachment #1: Type: text/plain, Size: 445 bytes --] I’m suspect it too short notice for such a large change to make its way into Org 9.5, but Bastien’s release email is certainly a good prompt to bump this. Bastien <bzg@gnu.org> writes: > Thank you *very much* for this work and sorry for the slow reply. > > I urge everyone to test this change, as I’d like to include it in > Org 9.5 if it’s ready. > > I will test this myself this week and report. All the best, Timothy ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2021-09-21 13:32 ` Timothy @ 2021-10-26 17:25 ` Matt Price 2021-10-27 6:27 ` Ihor Radchenko 0 siblings, 1 reply; 192+ messages in thread From: Matt Price @ 2021-10-26 17:25 UTC (permalink / raw) To: Timothy Cc: Karl Voit, Ihor Radchenko, Bastien, Christian Heinrich, Nicolas Goaziou, Org Mode, Kyle Meyer [-- Attachment #1: Type: text/plain, Size: 630 bytes --] On Tue, Sep 21, 2021 at 9:36 AM Timothy <tecosaur@gmail.com> wrote: > I’m suspect it too short notice for such a large change to make its way > into Org > 9.5, but Bastien’s release email is certainly a good prompt to bump this. > > Bastien <bzg@gnu.org> writes: > > > Thank you *very much* for this work and sorry for the slow reply. > > > > I urge everyone to test this change, as I’d like to include it in > > Org 9.5 if it’s ready. > > > > I will test this myself this week and report. > > All the best, > Timothy > Is this code in main now, and do I have to do anything special to test it out? [-- Attachment #2: Type: text/html, Size: 1055 bytes --] ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers 2021-10-26 17:25 ` Matt Price @ 2021-10-27 6:27 ` Ihor Radchenko 0 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2021-10-27 6:27 UTC (permalink / raw) To: Matt Price Cc: Karl Voit, Bastien, Christian Heinrich, Nicolas Goaziou, Org Mode, Kyle Meyer, Timothy Matt Price <moptop99@gmail.com> writes: > Is this code in main now, and do I have to do anything special to test it > out? Not on main yet. I need maintainers to agree about the merge. It is a major change. I plan to prepare a proper patchset and bump the thread again a few weeks later, when the dust settles on the recent org-persist/org-element merge. If you want to test the code, it is available at https://github.com/yantar92/org You can simply clone the github repo and load Org from there. Best, Ihor ^ permalink raw reply [flat|nested] 192+ messages in thread
* [PATCH 00/35] Merge org-fold feature branch 2021-05-03 17:28 ` Bastien 2021-09-21 13:32 ` Timothy @ 2022-01-29 11:37 ` Ihor Radchenko 2022-01-29 11:37 ` [PATCH 01/35] Add org-fold-core: new folding engine Ihor Radchenko ` (35 more replies) 1 sibling, 36 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-01-29 11:37 UTC (permalink / raw) To: Bastien, Kyle Meyer, Nicolas Goaziou, Karl Voit, Christian Heinrich, emacs-orgmode Cc: Ihor Radchenko It took a while, but I am finally done with rebasing the org-fold branch code onto current main. This branch has been tested by me and other volunteers for over a year. Things are basically stable using recent Emacs versions. There were a couple of back-compatibility issues with older Emacs, which I fixed during the cleanup. Those may need to be tested more carefully after merging to main. I would like to thank all the people who helped with bug reporting and provided bugfixes over the testing time. Thank you all - arkhan, HyunggyuJang, Robert Irelan, Alois Janíček, Anders Johansson, Daniel Kraus, Ypot, ntharim, Colin McLear, Yiming Chen, tpeacock19, and Karl Voit. After the cleanup, some patches are not included for the merge. Apart from my patches, 3 patches by Anders Johansson are included here. He has signed FSF copyright paperwork and appears on the Org mode contributor list (https://orgmode.org/worg/contributors.html). Unless there are comments on the patches below, I plan to merge the branch in the coming weeks. Please, let me know if I still need to wait for comments. Anders Johansson (3): Fix typo: delete-duplicates → delete-dups Fix bug in org-get-heading Rename remaining org-force-cycle-archived → org-cycle-force-archived Ihor Radchenko (32): Add org-fold-core: new folding engine Separate folding functions from org.el into new library: org-fold Separate cycling functions from org.el into new library: org-cycle Remove functions from org.el that are now moved elsewhere Disable native-comp in agenda org-macs: New function org-find-text-property-region org-at-heading-p: Accept optional argument org-string-width: Reimplement to work with new folding Rename old function call to use org-fold Implement link folding Implement overlay- and text-property-based versions of some functions org-fold: Handle indirect buffer visibility Fix subtle differences between overlays and invisible text properties Support extra org-fold optimisations for huge buffers Alias new org-fold functions to their old shorter names Obsolete old function names that are now in org-fold org-compat: Work around some third-party packages using outline-* functions Move `org-buffer-list' to org-macs.el Restore old visibility behaviour of org-refile Add org-fold-related tests org-manual: Update to new org-fold function names ORG-NEWS: Add list of changes Backport contributed commits Fix org-fold--hide-drawers--overlays org-string-width: Handle undefined behaviour in older Emacs org-string-width: Work around `window-pixel-width' bug in old Emacs org-fold-show-set-visibility: Fix edge case when folded region is at BOB org-fold-core: Fix fontification inside folded regions test-org/string-width: Add tests for strings with prefix properties org--string-from-props: Fix handling folds in Emacs <28 org-link-make-string: Throw error when both LINK and DESCRIPTION are empty test-ol/org-toggle-link-display: Fix compatibility with old Emacs doc/org-manual.org | 14 +- etc/ORG-NEWS | 104 ++ lisp/ob-core.el | 14 +- lisp/ob-lilypond.el | 4 +- lisp/ob-ref.el | 4 +- lisp/ol.el | 59 +- lisp/org-agenda.el | 50 +- lisp/org-archive.el | 12 +- lisp/org-capture.el | 7 +- lisp/org-clock.el | 126 +- lisp/org-colview.el | 10 +- lisp/org-compat.el | 189 ++- lisp/org-crypt.el | 8 +- lisp/org-cycle.el | 818 +++++++++++ lisp/org-element.el | 55 +- lisp/org-feed.el | 4 +- lisp/org-fold-core.el | 1503 +++++++++++++++++++ lisp/org-fold.el | 1132 +++++++++++++++ lisp/org-footnote.el | 6 +- lisp/org-goto.el | 6 +- lisp/org-id.el | 4 +- lisp/org-inlinetask.el | 26 +- lisp/org-keys.el | 26 +- lisp/org-lint.el | 3 +- lisp/org-list.el | 84 +- lisp/org-macs.el | 290 +++- lisp/org-mobile.el | 2 +- lisp/org-mouse.el | 4 +- lisp/org-refile.el | 3 +- lisp/org-src.el | 6 +- lisp/org-timer.el | 2 +- lisp/org.el | 2552 +++++++++++---------------------- lisp/ox-org.el | 2 +- lisp/ox.el | 4 +- testing/lisp/test-ob.el | 12 +- testing/lisp/test-ol.el | 24 + testing/lisp/test-org-list.el | 75 +- testing/lisp/test-org-macs.el | 6 +- testing/lisp/test-org.el | 258 +++- 39 files changed, 5475 insertions(+), 2033 deletions(-) create mode 100644 lisp/org-cycle.el create mode 100644 lisp/org-fold-core.el create mode 100644 lisp/org-fold.el -- 2.34.1 ^ permalink raw reply [flat|nested] 192+ messages in thread
* [PATCH 01/35] Add org-fold-core: new folding engine 2022-01-29 11:37 ` [PATCH 00/35] Merge org-fold feature branch Ihor Radchenko @ 2022-01-29 11:37 ` Ihor Radchenko 2022-01-29 11:37 ` [PATCH 02/35] Separate folding functions from org.el into new library: org-fold Ihor Radchenko ` (34 subsequent siblings) 35 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-01-29 11:37 UTC (permalink / raw) To: Bastien, Kyle Meyer, Nicolas Goaziou, Karl Voit, Christian Heinrich, emacs-orgmode Cc: Ihor Radchenko [-- Attachment #1: Type: text/plain, Size: 155 bytes --] --- lisp/org-fold-core.el | 1490 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 1490 insertions(+) create mode 100644 lisp/org-fold-core.el [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0001-Add-org-fold-core-new-folding-engine.patch --] [-- Type: text/x-patch; name="0001-Add-org-fold-core-new-folding-engine.patch", Size: 78656 bytes --] diff --git a/lisp/org-fold-core.el b/lisp/org-fold-core.el new file mode 100644 index 000000000..121c6b5c4 --- /dev/null +++ b/lisp/org-fold-core.el @@ -0,0 +1,1490 @@ +;;; org-fold-core.el --- Folding buffer text -*- lexical-binding: t; -*- +;; +;; Copyright (C) 2020-2020 Free Software Foundation, Inc. +;; +;; Author: Ihor Radchenko <yantar92 at gmail dot com> +;; Keywords: folding, invisible text +;; Homepage: https://orgmode.org +;; +;; This file is part of GNU Emacs. +;; +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Commentary: + +;; This file contains library to control temporary invisibility +;; (folding and unfolding) of text in buffers. + +;; The file implements the following functionality: +;; +;; - Folding/unfolding regions of text +;; - Searching and examining boundaries of folded text +;; - Interactive searching in folded text (via isearch) +;; - Handling edits in folded text +;; - Killing/yanking (copying/pasting) of the folded text +;; - Fontification of the folded text + +;; To setup folding in an arbitrary buffer, one must call +;; `org-fold-core-initialize', optionally providing the list of folding specs to be +;; used in the buffer. The specs can be added, removed, or +;; re-configured later. Read below for more details. + +;;; Folding/unfolding regions of text + +;; User can temporarily hide/reveal (fold/unfold) arbitrary regions or +;; text. The folds can be nested. + +;; Internally, nested folds are marked with different folding specs +;; Overlapping folds marked with the same folding spec are +;; automatically merged, while folds with different folding specs can +;; coexist and be folded/unfolded independently. + +;; When multiple folding specs are applied to the same region of text, +;; text visibility is decided according to the folding spec with +;; topmost priority. + +;; By default, we define two types of folding specs: +;; - 'org-fold-visible :: the folded text is not hidden +;; - 'org-fold-hidden :: the folded text is completely hidden +;; +;; The 'org-fold-visible spec has highest priority allowing parts of +;; text folded with 'org-fold-hidden to be shown unconditionally. + +;; Consider the following Org mode link: +;; [[file:/path/to/file/file.ext][description]] +;; Only the word "description" is normally visible in this link. +;; +;; The way this partial visibility is achieved is combining the two +;; folding specs. The whole link is folded using 'org-fold-hidden +;; folding spec, but the visible part is additionally folded using +;; 'org-fold-visible: +;; +;; <begin org-fold-hidden>[[file:/path/to/file/file.ext][<begin org-fold-visible>description<end org-fold-visible>]]<end org-fold-hidden> +;; +;; Because 'org-fold-visible has higher priority than +;; 'org-fold-hidden, it suppresses the 'org-fold-hidden effect and +;; thus reveals the description part of the link. + +;; Similar to 'org-fold-visible, display of any arbitrary folding spec +;; can be configured using folding spec properties. In particular, +;; `:visible' folding spec proprety controls whether the folded text +;; is visible or not. If the `:visible' folding spec property is nil, +;; folded text is hidden or displayed as a constant string (ellipsis) +;; according to the value of `:ellipsis' folding spec property. See +;; docstring of `org-fold-core--specs' for the description of all the available +;; folding spec properties. + +;; Folding spec properties of any valid folding spec can be changed +;; any time using `org-fold-core-set-folding-spec-property'. + +;; If necessary, one can add or remove folding specs using +;; `org-fold-core-add-folding-spec' and `org-fold-core-remove-folding-spec'. + +;; If a buffer initialised with `org-fold-core-initialize' is cloned into indirect +;; buffers, it's folding state is copied to that indirect buffer. +;; The folding states are independent. + +;; When working with indirect buffers that are handled by this +;; library, one has to keep in mind that folding state is preserved on +;; copy when using non-interactive functions. Moreover, the folding +;; states of all the indirect buffers will be copied together. +;; +;; Example of the implications: +;; Consider a base buffer and indirect buffer with the following state: +;; ----- base buffer -------- +;; * Heading<begin fold> +;; Some text folded in the base buffer, but unfolded in the indirect buffer<end fold> +;; * Other heading +;; Heading unfolded in both the buffers. +;; --------------------------- +;; ------ indirect buffer ---- +;; * Heading +;; Some text folded in the base buffer, but unfolded in the indirect buffer +;; * Other heading +;; Heading unfolded in both the buffers. +;; ---------------------------- +;; If some Elisp code copies the whole "Heading" from the indirect +;; buffer with `buffer-substring' or match data and inserts it into +;; the base buffer, the inserted heading will be folded since the +;; internal setting for the folding state is shared between the base +;; and indirect buffers. It's just that the indirect buffer ignores +;; the base buffer folding settings. However, as soon as the text is +;; copied back to the base buffer, the folding state will become +;; respected again. + +;; If the described situation is undesired, Elisp code can use +;; `filter-buffer-substring' instead of `buffer-substring'. All the +;; folding states that do not belong to the currently active buffer +;; will be cleared in the copied text then. See +;; `org-fold-core--buffer-substring-filter' for more details. + +;; Because of details of implementation of the folding, it is also not +;; recommended to set text visibility in buffer directly by setting +;; `invisible' text property to anything other than t. While this +;; should usually work just fine, normal folding can be broken if one +;; sets `invisible' text property to a value not listed in +;; `buffer-invisibility-spec'. + +;;; Searching and examining boundaries of folded text + +;; It is possible to examine folding specs (there may be several) of +;; text at point or search for regions with the same folding spec. +;; See functions defined under ";;;; Searching and examining folded +;; text" below for details. + +;; All the folding specs can be specified by symbol representing their +;; name. However, this is not always convenient, especially if the +;; same spec can be used for fold different syntaxical structures. +;; Any folding spec can be additionally referenced by a symbol listed +;; in the spec's `:alias' folding spec property. For example, Org +;; mode's `org-fold-outline' folding spec can be referened as any +;; symbol from the following list: '(headline heading outline +;; inlinetask plain-list) The list is the value of the spec's `:alias' +;; property. + +;; Most of the functions defined below that require a folding spec +;; symbol as their argument, can also accept any symbol from the +;; `:alias' spec property to reference that folding spec. + +;; If one wants to search invisible text without using the provided +;; functions, it is important to keep in mind that 'invisible text +;; property may have multiple possible values (not just nil and +;; t). Hence, (next-single-char-property-change pos 'invisible) is not +;; guarantied to return the boundary of invisible/visible text. + +;;; Interactive searching inside folded text (via isearch) + +;; The library provides a way to control if the folded text can be +;; searchable using isearch. If the text is searchable, it is also +;; possible to control to unfold it temporarily during interactive +;; isearch session. + +;; The isearch behaviour is controlled on per-folding-spec basis by +;; setting `isearch-open' and `isearch-ignore' folding spec +;; properties. The the docstring of `org-fold-core--specs' for more details. + +;;; Handling edits inside folded text + +;; The visibility of the text inserted in front, rear, or in the +;; middle of a folded region is managed according to `:front-sticky' +;; and `:rear-sticky' folding properties of the corresponding folding +;; spec. The rules are the same with stickyness of text properties in +;; Elisp. + +;; If a text being inserted into the buffer is already folded and +;; invisible (before applying the stickyness rules), then it is +;; revealed. This behaviour can be changed by wrapping the insertion +;; code into `org-fold-core-ignore-modifications' macro. The macro will disable +;; all the processing related to buffer modifications. + +;; The library also provides a way to unfold the text after some +;; destructive changes breaking syntaxical structure of the buffer. +;; For example, Org mode automatically reveals folded drawers when the +;; drawer becomes syntaxically incorrect: +;; ------- before modification ------- +;; :DRAWER:<begin fold> +;; Some folded text inside drawer +;; :END:<end fold> +;; ----------------------------------- +;; If the ":END:" is edited, drawer syntax is not correct anymore and +;; the folded text is automatically unfolded. +;; ------- after modification -------- +;; :DRAWER: +;; Some folded text inside drawer +;; :EN: +;; ----------------------------------- + +;; The described automatic unfolding is controlled by `:fragile' +;; folding spec property. It's value can be a function checking if +;; changes inside (or around) the fold should drigger the unfold. By +;; default, only changes that directly involve folded regions will +;; trigger the check. In addition, `org-fold-core-extend-changed-region-functions' +;; can be set to extend the checks to all folded regions intersecting +;; with the region returned by the functions listed in the variable. + +;; The fragility checks can be bypassed if the code doing +;; modifications is wrapped into `org-fold-core-ignore-fragility-checks' macro. + +;;; Fontification of the folded text + +;; When working with huge buffers, `font-lock' may take a lot of time +;; to fontify all the buffer text during startup. This library +;; provides a way to delay fontification of initially folded text to +;; the time when the text is unfolded. The fontification is +;; controlled on per-folding-spec basis according to `:font-lock-skip' +;; folding spec property. + +;; This library replaces `font-lock-fontify-region-function' to implement the +;; delayed fontification. However, it only does so when +;; `font-lock-fontify-region-function' is not modified at the initialisation +;; time. If one needs to use both delayed fontification and custom +;; `font-lock-fontify-region-function', it is recommended to consult the +;; source code of `org-fold-core-fontify-region'. + +;;; Performance considerations + +;; This library is using text properties to hide text. Text +;; properties are much faster than overlays, that could be used for +;; the same purpose. Overlays are implemented with O(n) complexity in +;; Emacs (as for 2021-03-11). It means that any attempt to move +;; through hidden text in a file with many invisible overlays will +;; require time scaling with the number of folded regions (the problem +;; Overlays note of the manual warns about). For curious, historical +;; reasons why overlays are not efficient can be found in +;; https://www.jwz.org/doc/lemacs.html. + +;; Despite using text properties, the performance is still limited by +;; Emacs display engine. For example, >7Mb of text hidden within +;; visible part of a buffer may cause noticeable lags (which is still +;; orders of magnitude better in comparison with overlays). If the +;; performance issues become critical while using this library, it is +;; recommended to minimise the number of folding specs used in the +;; same buffer at a time. + +;; Alternatively, the library provides `org-fold-core--optimise-for-huge-buffers' +;; for additional speedup. This can be used as a file-local variable +;; in huge buffers. The variable can be set to enable various levels +;; of extra optimisation. See the docstring for detailed information. + +;; It is worth noting that when using `org-fold-core--optimise-for-huge-buffers' +;; with `grab-invisible' option, folded regions copied to other +;; buffers (including buffers that do not use this library) will +;; remain invisible. org-fold-core provides functions to work around +;; this issue: `org-fold-core-remove-optimisation' and `org-fold-core-update-optimisation', but +;; it is unlikely that a random external package will use them. + +;; Another possible bottleneck is the fragility check after the change +;; related to the folded text. The functions used in `:fragile' +;; folding properties must be optimised. Also, +;; `org-fold-core-ignore-fragility-checks' or even `org-fold-core-ignore-modifications' may be +;; used when appropriate in the performance-critical code. When +;; inserting text from within `org-fold-core-ignore-modifications' macro, it is +;; recommended to use `insert-and-inherit' instead of `insert' and +;; `insert-before-markers-and-inherit' instead of +;; `insert-before-markers' to avoid revealing inserted text in the +;; middle of a folded region. + +;; Performance of isearch is currently limited by Emacs isearch +;; implementation. For now, Emacs isearch only supports searching +;; through text hidden using overlays. This library handles isearch +;; by converting folds with matching text to overlays, which may +;; affect performance in case of large number of matches. In the +;; future, Emacs will hopefully accept the relevant patch allowing +;; isearch to work with text hidden via text properties, but the +;; performance hit has to be accepted meanwhile. + +;;; Code: + +(require 'org-macs) +(require 'org-compat) + +(declare-function isearch-filter-visible "isearch" (beg end)) + +;;; Customization + +(defcustom org-fold-core-style 'text-properties + "Internal implementation detail used to hide folded text. +Can be either `text-properties' or `overlays'. +The former is faster on large files, while the latter is generally +less error-prone." + :group 'org + :package-version '(Org . "9.6") + :type '(choice + (const :tag "Overlays" 'overlays) + (const :tag "Text properties" 'text-properties))) + +(defcustom org-fold-core-first-unfold-functions nil + "Functions executed after first unfolding during fontification. +Each function is exectured with two arguments: begin and end points of +the unfolded region." + :group 'org + :package-version '(Org . "9.6") + :type 'hook) + +(defvar-local org-fold-core-isearch-open-function #'org-fold-core--isearch-reveal + "Function used to reveal hidden text found by isearch. +The function is called with a single argument - point where text is to +be revealed.") + +(defvar-local org-fold-core--optimise-for-huge-buffers nil + "Non-nil turns on extra speedup on huge buffers (Mbs of folded text). + +This setting is risky and may cause various artefacts and degraded +functionality, especially when using external packages. It is +recommended to enable it on per-buffer basis as file-local variable. + +When set to non-nil, must be a list containing one or multiple the +following symbols: + +- `grab-invisible': Use `invisible' text property to hide text. This + will reduce the load on Emacs display engine and one may use it if + moving point across folded regions becomes slow. However, as a side + effect, some external packages extracting i.e. headlings from folded + parts of buffer may keep the text invisible. + +- `ignore-fragility-checks': Do not try to detect when user edits + break structure of the folded elements. This will speed up + modifying the folded regions at the cost that some higher-level + functions relying on this package might not be able to unfold the + edited text. For example, removed leading stars from a folded + headline in Org mode will break visibility cycling since Org mode + will not be avare that the following folded text belonged to + headline. + +- `ignore-modification-checks': Do not try to detect insertions in the + middle of the folded regions. This will speed up non-interactive + edits of the folded regions. However, text inserted in the middle + of the folded regions may become visible for some external packages + inserting text using `insert' instead of `insert-and-inherit' (the + latter is rarely used in practice). + +- `ignore-indirect': Do not decouple folding state in the indirect + buffers. This can speed up Emacs display engine (and thus motion of + point), especially when large number of indirect buffers is being + used. + +- `merge-folds': Do not distinguish between different types of folding + specs. This is the most aggressive optimisation with unforseen and + potentially drastic effects.") +(put 'org-fold-core--optimise-for-huge-buffers 'safe-local-variable 'listp) + +;;; Core functionality + +;;;; Folding specs + +(defvar-local org-fold-core--specs '((org-fold-visible + (:visible . t) + (:alias . (visible))) + (org-fold-hidden + (:ellipsis . "...") + (:isearch-open . t) + (:alias . (hidden)))) + "Folding specs defined in current buffer. + +Each spec is a list (SPEC-SYMBOL SPEC-PROPERTIES). +SPEC-SYMBOL is the symbol respresenting the folding spec. +SPEC-PROPERTIES is an alist defining folding spec properties. + +If a text region is folded using multiple specs, only the folding spec +listed earlier is used. + +The following properties are known: +- :ellipsis :: must be nil or string to show when text is folded + using this spec. +- :global :: non-nil means that folding state will be preserved + when copying folded text between buffers. +- :isearch-ignore :: non-nil means that folded text is not searchable + using isearch. +- :isearch-open :: non-nil means that isearch can reveal text hidden + using this spec. This property does nothing + when 'isearch-ignore property is non-nil. +- :front-sticky :: non-nil means that text prepended to the folded text + is automatically folded. +- :rear-sticky :: non-nil means that text appended to the folded text + is folded. +- :visible :: non-nil means that folding spec visibility is not + managed. Instead, visibility settings in + `buffer-invisibility-spec' will be used as is. + Note that changing this property from nil to t may + clear the setting in `buffer-invisibility-spec'. +- :alias :: a list of aliases for the SPEC-SYMBOL. +- :font-lock-skip :: Suppress font-locking in folded text. +- :fragile :: Must be a function accepting two arguments. + Non-nil means that changes in region may cause + the region to be revealed. The region is + revealed after changes if the function returns + non-nil. + The function called after changes are made with + two arguments: cons (beg . end) representing the + folded region and spec symbol.") +(defvar-local org-fold-core--spec-symbols nil + "Alist holding buffer spec symbols and aliases. + +This variable is defined to reduce load on Emacs garbage collector +reducing the number of transiently allocated variables.") +(defvar-local org-fold-core--spec-list nil + "List holding buffer spec symbols, but not aliases. + +This variable is defined to reduce load on Emacs garbage collector +reducing the number of transiently allocated variables.") + +(defvar-local org-fold-core-extend-changed-region-functions nil + "Special hook run just before handling changes in buffer. + +This is used to account changes outside folded regions that still +affect the folded region visibility. For example, removing all stars +at the beginning of a folded Org mode heading should trigger the +folded text to be revealed. Each function is called with two +arguments: beginning and the end of the changed region.") + +;;; Utility functions + +(defsubst org-fold-core-folding-spec-list (&optional buffer) + "Return list of all the folding spec symbols in BUFFER." + (or (buffer-local-value 'org-fold-core--spec-list (or buffer (current-buffer))) + (with-current-buffer (or buffer (current-buffer)) + (setq org-fold-core--spec-list (mapcar #'car org-fold-core--specs))))) + +(defun org-fold-core-get-folding-spec-from-alias (spec-or-alias) + "Return the folding spec symbol for SPEC-OR-ALIAS. +Return nil when there is no matching folding spec." + (when spec-or-alias + (unless org-fold-core--spec-symbols + (dolist (spec (org-fold-core-folding-spec-list)) + (push (cons spec spec) org-fold-core--spec-symbols) + (dolist (alias (assq :alias (assq spec org-fold-core--specs))) + (push (cons alias spec) org-fold-core--spec-symbols)))) + (alist-get spec-or-alias org-fold-core--spec-symbols))) + +(defsubst org-fold-core-folding-spec-p (spec-or-alias) + "Check if SPEC-OR-ALIAS is a registered folding spec." + (org-fold-core-get-folding-spec-from-alias spec-or-alias)) + +(defsubst org-fold-core--check-spec (spec-or-alias) + "Throw an error if SPEC-OR-ALIAS is not in `org-fold-core--spec-priority-list'." + (unless (org-fold-core-folding-spec-p spec-or-alias) + (error "%s is not a valid folding spec" spec-or-alias))) + +(defsubst org-fold-core-get-folding-spec-property (spec-or-alias property) + "Get PROPERTY of a folding SPEC-OR-ALIAS. +Possible properties can be found in `org-fold-core--specs' docstring." + (org-fold-core--check-spec spec-or-alias) + (if (and (memql 'ignore-indirect org-fold-core--optimise-for-huge-buffers) + (eq property :global)) + t + (if (and (memql 'merge-folds org-fold-core--optimise-for-huge-buffers) + (eq property :visible)) + nil + (cdr (assq property (assq (org-fold-core-get-folding-spec-from-alias spec-or-alias) org-fold-core--specs)))))) + +(defconst org-fold-core--spec-property-prefix "org-fold--spec-" + "Prefix used to create property symbol.") + +(defsubst org-fold-core-get-folding-property-symbol (spec &optional buffer global) + "Get folding text property using to store SPEC in current buffer or BUFFER. +If GLOBAL is non-nil, do not make the property unique in the BUFFER." + (if (memql 'merge-folds org-fold-core--optimise-for-huge-buffers) + (intern (format "%s-global" org-fold-core--spec-property-prefix)) + (intern (format (concat org-fold-core--spec-property-prefix "%s-%S") + (symbol-name spec) + ;; (sxhash buf) appears to be not constant over time. + ;; Using buffer-name is safe, since the only place where + ;; buffer-local text property actually matters is an indirect + ;; buffer, where the name cannot be same anyway. + (if global 'global + (sxhash (buffer-name (or buffer (current-buffer))))))))) + +(defsubst org-fold-core-get-folding-spec-from-folding-prop (folding-prop) + "Return folding spec symbol used for folding property with name FOLDING-PROP." + (catch :exit + (dolist (spec (org-fold-core-folding-spec-list)) + ;; We know that folding properties have + ;; folding spec in their name. + (when (string-match-p (symbol-name spec) + (symbol-name folding-prop)) + (throw :exit spec))))) + +(defvar org-fold-core--property-symbol-cache (make-hash-table :test 'equal) + "Saved values of folding properties for (buffer . spec) conses.") +(defvar-local org-fold-core--indirect-buffers nil + "List of indirect buffers created from current buffer. + +The first element of the list is always the current buffer. + +This variable is needed to work around Emacs bug#46982, while Emacs +does not provide a way `after-change-functions' in any other buffer +than the buffer where the change was actually made.") + +(defmacro org-fold-core-cycle-over-indirect-buffers (&rest body) + "Execute BODY in current buffer and all its indirect buffers. + +Also, make sure that folding properties from killed buffers are not +hanging around." + (declare (debug (form body)) (indent 1)) + `(let (buffers dead-properties) + (if (and (not (buffer-base-buffer)) + (not (eq (current-buffer) (car org-fold-core--indirect-buffers)))) + ;; We are in base buffer with `org-fold-core--indirect-buffers' value from + ;; different buffer. This can happen, for example, when + ;; org-capture copies local variables into *Capture* buffer. + (setq buffers (list (current-buffer))) + (dolist (buf (cons (or (buffer-base-buffer) (current-buffer)) + (buffer-local-value 'org-fold-core--indirect-buffers (or (buffer-base-buffer) (current-buffer))))) + (if (buffer-live-p buf) + (push buf buffers) + (dolist (spec (org-fold-core-folding-spec-list)) + (when (and (not (org-fold-core-get-folding-spec-property spec :global)) + (gethash (cons buf spec) org-fold-core--property-symbol-cache)) + ;; Make sure that dead-properties variable can be passed + ;; as argument to `remove-text-properties'. + (push t dead-properties) + (push (gethash (cons buf spec) org-fold-core--property-symbol-cache) + dead-properties)))))) + (dolist (buf buffers) + (with-current-buffer buf + (with-silent-modifications + (save-restriction + (widen) + (remove-text-properties + (point-min) (point-max) + dead-properties))) + ,@body)))) + +;; This is the core function used to fold text in buffers. We use +;; text properties to hide folded text, however 'invisible property is +;; not directly used (unless risky `org-fold-core--optimise-for-huge-buffers' is +;; enabled). Instead, we define unique text property (folding +;; property) for every possible folding spec and add the resulting +;; text properties into `char-property-alias-alist', so that +;; 'invisible text property is automatically defined if any of the +;; folding properties is non-nil. This approach lets us maintain +;; multiple folds for the same text region - poor man's overlays (but +;; much faster). Additionally, folding properties are ensured to be +;; unique for different buffers (especially for indirect +;; buffers). This is done to allow different folding states in +;; indirect buffers. +(defun org-fold-core--property-symbol-get-create (spec &optional buffer return-only) + "Return a unique symbol suitable as folding text property. +Return value is unique for folding SPEC in BUFFER. +If the buffer already have buffer-local setup in `char-property-alias-alist' +and the setup appears to be created for different buffer, +copy the old invisibility state into new buffer-local text properties, +unless RETURN-ONLY is non-nil." + (if (eq org-fold-core-style 'overlays) + (org-fold-core-get-folding-property-symbol spec nil 'global) + (let* ((buf (or buffer (current-buffer)))) + ;; Create unique property symbol for SPEC in BUFFER + (let ((local-prop (or (gethash (cons buf spec) org-fold-core--property-symbol-cache) + (puthash (cons buf spec) + (org-fold-core-get-folding-property-symbol + spec buf + (org-fold-core-get-folding-spec-property spec :global)) + org-fold-core--property-symbol-cache)))) + (prog1 + local-prop + (unless return-only + (with-current-buffer buf + ;; Update folding properties carried over from other + ;; buffer (implying that current buffer is indirect + ;; buffer). Normally, `char-property-alias-alist' in new + ;; indirect buffer is a copy of the same variable from + ;; the base buffer. Then, `char-property-alias-alist' + ;; would contain folding properties, which are not + ;; matching the generated `local-prop'. + (unless (member local-prop (cdr (assq 'invisible char-property-alias-alist))) + ;; Add current buffer to the list of indirect buffers in the base buffer. + (when (buffer-base-buffer) + (with-current-buffer (buffer-base-buffer) + (setq-local org-fold-core--indirect-buffers + (let (bufs) + (org-fold-core-cycle-over-indirect-buffers + (push (current-buffer) bufs)) + (push buf bufs) + (delete-dups bufs))))) + ;; Copy all the old folding properties to preserve the folding state + (with-silent-modifications + (dolist (old-prop (cdr (assq 'invisible char-property-alias-alist))) + (org-with-wide-buffer + (let* ((pos (point-min)) + (spec (org-fold-core-get-folding-spec-from-folding-prop old-prop)) + ;; Generate new buffer-unique folding property + (new-prop (when spec (org-fold-core--property-symbol-get-create spec nil 'return-only)))) + ;; Copy the visibility state for `spec' from `old-prop' to `new-prop' + (unless (eq old-prop new-prop) + (while (< pos (point-max)) + (let ((val (get-text-property pos old-prop)) + (next (next-single-char-property-change pos old-prop))) + (when val + (put-text-property pos next new-prop val)) + (setq pos next))))))) + ;; Update `char-property-alias-alist' with folding + ;; properties unique for the current buffer. + (setq-local char-property-alias-alist + (cons (cons 'invisible + (mapcar (lambda (spec) + (org-fold-core--property-symbol-get-create spec nil 'return-only)) + (org-fold-core-folding-spec-list))) + (remove (assq 'invisible char-property-alias-alist) + char-property-alias-alist))) + ;; Set folding property stickyness according to + ;; their `:font-sticky' and `:rear-sticky' + ;; parameters. + (let (full-prop-list) + (org-fold-core-cycle-over-indirect-buffers + (setq full-prop-list + (append full-prop-list + (delq nil + (mapcar (lambda (spec) + (cond + ((org-fold-core-get-folding-spec-property spec :front-sticky) + (cons (org-fold-core--property-symbol-get-create spec nil 'return-only) + nil)) + ((org-fold-core-get-folding-spec-property spec :rear-sticky) + nil) + (t + (cons (org-fold-core--property-symbol-get-create spec nil 'return-only) + t)))) + (org-fold-core-folding-spec-list)))))) + (org-fold-core-cycle-over-indirect-buffers + (setq-local text-property-default-nonsticky + (delete-dups (append + text-property-default-nonsticky + full-prop-list)))))))))))))) + +(defun org-fold-core-decouple-indirect-buffer-folds () + "Copy and decouple folding state in a newly created indirect buffer. +This function is mostly indented to be used in `clone-indirect-buffer-hook'." + (when (and (buffer-base-buffer) + (eq org-fold-core-style 'text-properties)) + (org-fold-core--property-symbol-get-create (car (org-fold-core-folding-spec-list))))) + +;;; API + +;;;; Modifying folding specs + +(defun org-fold-core-set-folding-spec-property (spec property value &optional force) + "Set PROPERTY of a folding SPEC to VALUE. +Possible properties and values can be found in `org-fold-core--specs' docstring. +Do not check previous value when FORCE is non-nil." + (pcase property + (:ellipsis + (unless (and (not force) (equal value (org-fold-core-get-folding-spec-property spec :ellipsis))) + (remove-from-invisibility-spec (cons spec (org-fold-core-get-folding-spec-property spec :ellipsis))) + (unless (org-fold-core-get-folding-spec-property spec :visible) + (add-to-invisibility-spec (cons spec value))))) + (:visible + (unless (or (memql 'merge-folds org-fold-core--optimise-for-huge-buffers) + (and (not force) (equal value (org-fold-core-get-folding-spec-property spec :visible)))) + (if value + (remove-from-invisibility-spec (cons spec (org-fold-core-get-folding-spec-property spec :ellipsis))) + (add-to-invisibility-spec (cons spec (org-fold-core-get-folding-spec-property spec :ellipsis)))))) + (:alias + ;; Clear symbol cache. + (setq org-fold-core--spec-symbols nil)) + (:isearch-open nil) + (:isearch-ignore nil) + (:front-sticky nil) + (:rear-sticky nil) + (_ nil)) + (setf (cdr (assq property (assq spec org-fold-core--specs))) value)) + +(defun org-fold-core-add-folding-spec (spec &optional properties buffer append) + "Add a new folding SPEC with PROPERTIES in BUFFER. + +SPEC must be a symbol. BUFFER can be a buffer to set SPEC in or nil to +set SPEC in current buffer. + +By default, the added SPEC will have highest priority among the +previously defined specs. When optional APPEND argument is non-nil, +SPEC will have the lowest priority instead. If SPEC was already +defined earlier, it will be redefined according to provided optional +arguments. +` +The folding spec properties will be set to PROPERTIES (see +`org-fold-core--specs' for details)." + (when (eq spec 'all) (error "Cannot use reserved folding spec symbol 'all")) + (with-current-buffer (or buffer (current-buffer)) + ;; Clear the cache. + (setq org-fold-core--spec-list nil + org-fold-core--spec-symbols nil) + (let* ((full-properties (mapcar (lambda (prop) (cons prop (cdr (assq prop properties)))) + '( :visible :ellipsis :isearch-ignore + :global :isearch-open :front-sticky + :rear-sticky :fragile :alias + :font-lock-skip))) + (full-spec (cons spec full-properties))) + (add-to-list 'org-fold-core--specs full-spec append) + (mapc (lambda (prop-cons) (org-fold-core-set-folding-spec-property spec (car prop-cons) (cdr prop-cons) 'force)) full-properties) + ;; Update buffer inivisibility specs. + (org-fold-core--property-symbol-get-create spec)))) + +(defun org-fold-core-remove-folding-spec (spec &optional buffer) + "Remove a folding SPEC in BUFFER. + +SPEC must be a symbol. + +BUFFER can be a buffer to remove SPEC in, nil to remove SPEC in current +buffer, or 'all to remove SPEC in all open `org-mode' buffers and all +future org buffers." + (org-fold-core--check-spec spec) + (when (eq buffer 'all) + (setq-default org-fold-core--specs (delete (cdr (assq spec org-fold-core--specs)) org-fold-core--specs)) + (mapc (lambda (buf) + (org-fold-core-remove-folding-spec spec buf)) + (buffer-list))) + (let ((buffer (or buffer (current-buffer)))) + (with-current-buffer buffer + ;; Clear the cache. + (setq org-fold-core--spec-list nil + org-fold-core--spec-symbols nil) + (org-fold-core-set-folding-spec-property spec :visible t) + (setq org-fold-core--specs (delete (cdr (assq spec org-fold-core--specs)) org-fold-core--specs))))) + +(defun org-fold-core-initialize (&optional specs) + "Setup folding in current buffer using SPECS as value of `org-fold-core--specs'." + ;; Preserve the priorities. + (when specs (setq specs (nreverse specs))) + (unless specs (setq specs org-fold-core--specs)) + (setq org-fold-core--specs nil + org-fold-core--spec-list nil + org-fold-core--spec-symbols nil) + (dolist (spec specs) + (org-fold-core-add-folding-spec (car spec) (cdr spec))) + (add-hook 'after-change-functions 'org-fold-core--fix-folded-region nil 'local) + (add-hook 'clone-indirect-buffer-hook #'org-fold-core-decouple-indirect-buffer-folds nil 'local) + ;; Optimise buffer fontification to not fontify folded text. + (when (eq font-lock-fontify-region-function #'font-lock-default-fontify-region) + (setq-local font-lock-fontify-region-function 'org-fold-core-fontify-region)) + ;; Setup killing text + (setq-local filter-buffer-substring-function #'org-fold-core--buffer-substring-filter) + (if (and (boundp 'isearch-opened-regions) + (eq org-fold-core-style 'text-properties)) + ;; Use new implementation of isearch allowing to search inside text + ;; hidden via text properties. + (org-fold-core--isearch-setup 'text-properties) + (org-fold-core--isearch-setup 'overlays))) + +;;;; Searching and examining folded text + +(defsubst org-fold-core-folded-p (&optional pos spec-or-alias) + "Non-nil if the character after POS is folded. +If POS is nil, use `point' instead. +If SPEC-OR-ALIAS is a folding spec, only check the given folding spec." + (org-fold-core-get-folding-spec spec-or-alias pos)) + +(defun org-fold-core-region-folded-p (beg end &optional spec-or-alias) + "Non-nil if the region between BEG and END is folded. +If SPEC-OR-ALIAS is a folding spec, only check the given folding spec." + (org-with-point-at beg + (catch :visible + (while (< (point) end) + (unless (org-fold-core-get-folding-spec spec-or-alias) (throw :visible nil)) + (goto-char (org-fold-core-next-folding-state-change spec-or-alias nil end))) + t))) + +(defun org-fold-core-get-folding-spec (&optional spec-or-alias pom) + "Get folding state at `point' or POM. +Return nil if there is no folding at point or POM. +If SPEC-OR-ALIAS is nil, return a folding spec with highest priority +among present at `point' or POM. +If SPEC-OR-ALIAS is 'all, return the list of all present folding +specs. +If SPEC-OR-ALIAS is a valid folding spec or a spec alias, return the +corresponding folding spec (if the text is folded using that spec)." + (let ((spec (if (eq spec-or-alias 'all) + 'all + (org-fold-core-get-folding-spec-from-alias spec-or-alias)))) + (when (and spec (not (eq spec 'all))) (org-fold-core--check-spec spec)) + (org-with-point-at pom + (cond + ((eq spec 'all) + (let ((result)) + (dolist (spec (org-fold-core-folding-spec-list)) + (let ((val (get-char-property (point) (org-fold-core--property-symbol-get-create spec nil t)))) + (when val (push val result)))) + (reverse result))) + ((null spec) + (let ((result (get-char-property (point) 'invisible))) + (when (org-fold-core-folding-spec-p result) result))) + (t (get-char-property (point) (org-fold-core--property-symbol-get-create spec nil t))))))) + +(defun org-fold-core-get-folding-specs-in-region (beg end) + "Get all folding specs in region from BEG to END." + (let ((pos beg) + all-specs) + (while (< pos end) + (setq all-specs (append all-specs (org-fold-core-get-folding-spec nil pos))) + (setq pos (org-fold-core-next-folding-state-change nil pos end))) + (unless (listp all-specs) (setq all-specs (list all-specs))) + (delete-dups all-specs))) + +(defun org-fold-core-get-region-at-point (&optional spec-or-alias pom) + "Return region folded using SPEC-OR-ALIAS at POM. +If SPEC is nil, return the largest possible folded region. +The return value is a cons of beginning and the end of the region. +Return nil when no fold is present at point of POM." + (let ((spec (org-fold-core-get-folding-spec-from-alias spec-or-alias))) + (org-with-point-at (or pom (point)) + (if spec + (if (eq org-fold-core-style 'text-properties) + (org-find-text-property-region (point) (org-fold-core--property-symbol-get-create spec nil t)) + (let ((ov (cdr (get-char-property-and-overlay (point) (org-fold-core--property-symbol-get-create spec nil t))))) + (when ov (cons (overlay-start ov) (overlay-end ov))))) + (let ((region (cons (point) (point)))) + (dolist (spec (org-fold-core-get-folding-spec 'all)) + (let ((local-region (org-fold-core-get-region-at-point spec))) + (when (< (car local-region) (car region)) + (setcar region (car local-region))) + (when (> (cdr local-region) (cdr region)) + (setcdr region (cdr local-region))))) + (unless (eq (car region) (cdr region)) region)))))) + +(defun org-fold-core-next-visibility-change (&optional pos limit ignore-hidden-p previous-p) + "Return next point from POS up to LIMIT where text becomes visible/invisible. +By default, text hidden by any means (i.e. not only by folding, but +also via fontification) will be considered. +If IGNORE-HIDDEN-P is non-nil, consider only folded text. +If PREVIOUS-P is non-nil, search backwards." + (let* ((pos (or pos (point))) + (invisible-p (if ignore-hidden-p + #'org-fold-core-folded-p + #'invisible-p)) + (invisible-initially? (funcall invisible-p pos)) + (limit (or limit (if previous-p + (point-min) + (point-max)))) + (cmp (if previous-p #'> #'<)) + (next-change (if previous-p + (if ignore-hidden-p + (lambda (p) (org-fold-core-previous-folding-state-change (org-fold-core-get-folding-spec nil p) p limit)) + (lambda (p) (max limit (1- (previous-single-char-property-change p 'invisible nil limit))))) + (if ignore-hidden-p + (lambda (p) (org-fold-core-next-folding-state-change (org-fold-core-get-folding-spec nil p) p limit)) + (lambda (p) (next-single-char-property-change p 'invisible nil limit))))) + (next pos)) + (while (and (funcall cmp next limit) + (not (org-xor invisible-initially? (funcall invisible-p next)))) + (setq next (funcall next-change next))) + next)) + +(defun org-fold-core-previous-visibility-change (&optional pos limit ignore-hidden-p) + "Call `org-fold-core-next-visibility-change' searching backwards." + (org-fold-core-next-visibility-change pos limit ignore-hidden-p 'previous)) + +(defun org-fold-core-next-folding-state-change (&optional spec-or-alias pos limit previous-p) + "Return point after POS where folding state changes up to LIMIT. +If SPEC-OR-ALIAS is nil, return next point where _any_ single folding +spec changes. +For example, (org-fold-core-next-folding-state-change nil) with point +somewhere in the below structure will return the nearest <...> point. + +* Headline <begin outline fold> +:PROPERTIES:<begin drawer fold> +:ID: test +:END:<end drawer fold> + +Fusce suscipit, wisi nec facilisis facilisis, est dui fermentum leo, +quis tempor ligula erat quis odio. + +** Another headline +:DRAWER:<begin drawer fold> +:END:<end drawer fold> +** Yet another headline +<end of outline fold> + +If SPEC-OR-ALIAS is a folding spec symbol, only consider that folding +spec. + +If SPEC-OR-ALIAS is a list, only consider changes of folding specs +from the list. + +Search backwards when PREVIOUS-P is non-nil." + (when (and spec-or-alias (symbolp spec-or-alias)) + (setq spec-or-alias (list spec-or-alias))) + (when spec-or-alias + (setq spec-or-alias + (mapcar (lambda (spec-or-alias) + (or (org-fold-core-get-folding-spec-from-alias spec-or-alias) + spec-or-alias)) + spec-or-alias)) + (mapc #'org-fold-core--check-spec spec-or-alias)) + (unless spec-or-alias + (setq spec-or-alias (org-fold-core-folding-spec-list))) + (setq pos (or pos (point))) + (apply (if previous-p + #'max + #'min) + (mapcar (if previous-p + (lambda (prop) (max (or limit (point-min)) (previous-single-property-change pos prop nil (or limit (point-min))))) + (lambda (prop) (next-single-property-change pos prop nil (or limit (point-max))))) + (mapcar (lambda (el) (org-fold-core--property-symbol-get-create el nil t)) + spec-or-alias)))) + +(defun org-fold-core-previous-folding-state-change (&optional spec-or-alias pos limit) + "Call `org-fold-core-next-folding-state-change' searching backwards." + (org-fold-core-next-folding-state-change spec-or-alias pos limit 'previous)) + +(defun org-fold-core-search-forward (spec-or-alias &optional limit) + "Search next region folded via folding SPEC-OR-ALIAS up to LIMIT. +Move point right after the end of the region, to LIMIT, or +`point-max'. The `match-data' will contain the region." + (let ((spec (org-fold-core-get-folding-spec-from-alias spec-or-alias))) + (let ((prop-symbol (org-fold-core--property-symbol-get-create spec nil t))) + (goto-char (or (next-single-char-property-change (point) prop-symbol nil limit) limit (point-max))) + (when (and (< (point) (or limit (point-max))) + (not (org-fold-core-get-folding-spec spec))) + (goto-char (next-single-char-property-change (point) prop-symbol nil limit))) + (when (org-fold-core-get-folding-spec spec) + (let ((region (org-fold-core-get-region-at-point spec))) + (when (< (cdr region) (or limit (point-max))) + (goto-char (1+ (cdr region))) + (set-match-data (list (set-marker (make-marker) (car region) (current-buffer)) + (set-marker (make-marker) (cdr region) (current-buffer)))))))))) + +;;;; Changing visibility + +;;;;; Region visibility + +(defvar org-fold-core--fontifying nil + "Flag used to avoid font-lock recursion.") + +;; This is the core function performing actual folding/unfolding. The +;; folding state is stored in text property (folding property) +;; returned by `org-fold-core--property-symbol-get-create'. The value of the +;; folding property is folding spec symbol. +(defun org-fold-core-region (from to flag &optional spec-or-alias) + "Hide or show lines from FROM to TO, according to FLAG. +SPEC-OR-ALIAS is the folding spec or foldable element, as a symbol. +If SPEC-OR-ALIAS is omitted and FLAG is nil, unfold everything in the region." + (let ((spec (org-fold-core-get-folding-spec-from-alias spec-or-alias))) + (when spec (org-fold-core--check-spec spec)) + (with-silent-modifications + (org-with-wide-buffer + (when (eq org-fold-core-style 'overlays) (remove-overlays from to 'invisible spec)) + (if flag + (if (not spec) + (error "Calling `org-fold-core-region' with missing SPEC") + (if (eq org-fold-core-style 'overlays) + ;; Use `front-advance' since text right before to the beginning of + ;; the overlay belongs to the visible line than to the contents. + (let ((o (make-overlay from to nil + (org-fold-core-get-folding-spec-property spec :front-sticky) + (org-fold-core-get-folding-spec-property spec :rear-sticky)))) + (overlay-put o 'evaporate t) + (overlay-put o (org-fold-core--property-symbol-get-create spec) spec) + (overlay-put o 'invisible spec) + (overlay-put o 'isearch-open-invisible #'org-fold-core--isearch-show) + (overlay-put o 'isearch-open-invisible-temporary #'org-fold-core--isearch-show-temporary)) + (put-text-property from to (org-fold-core--property-symbol-get-create spec) spec) + (put-text-property from to 'isearch-open-invisible #'org-fold-core--isearch-show) + (put-text-property from to 'isearch-open-invisible-temporary #'org-fold-core--isearch-show-temporary) + (when (memql 'grab-invisible org-fold-core--optimise-for-huge-buffers) + ;; If the SPEC has highest priority, assign it directly + ;; to 'invisible property as well. This is done to speed + ;; up Emacs redisplay on huge (Mbs) folded regions where + ;; we don't even want Emacs to spend time cycling over + ;; `char-property-alias-alist'. + (when (eq spec (caar org-fold-core--specs)) (put-text-property from to 'invisible spec))))) + (if (not spec) + (mapc (lambda (spec) (org-fold-core-region from to nil spec)) (org-fold-core-folding-spec-list)) + (when (and (memql 'grab-invisible org-fold-core--optimise-for-huge-buffers) + (eq org-fold-core-style 'text-properties)) + (when (eq spec (caar org-fold-core--specs)) + (let ((pos from)) + (while (< pos to) + (if (eq spec (get-text-property pos 'invisible)) + (let ((next (org-fold-core-next-folding-state-change spec pos to))) + (remove-text-properties pos next '(invisible t)) + (setq pos next)) + (setq pos (next-single-char-property-change pos 'invisible nil to))))))) + (when (eq org-fold-core-style 'text-properties) + (remove-text-properties from to (list (org-fold-core--property-symbol-get-create spec) nil))) + ;; Fontify unfolded text. + (unless (or (not font-lock-mode) + org-fold-core--fontifying + (not (org-fold-core-get-folding-spec-property spec :font-lock-skip)) + (not (text-property-not-all from to 'org-fold-core-fontified t))) + (let ((org-fold-core--fontifying t)) + (if jit-lock-mode + (jit-lock-refontify from to) + (save-match-data (font-lock-fontify-region from to))))))))))) + +;;; Make isearch search in some text hidden via text propertoes + +(defvar org-fold-core--isearch-overlays nil + "List of overlays temporarily created during isearch. +This is used to allow searching in regions hidden via text properties. +As for [2020-05-09 Sat], Isearch only has special handling of hidden overlays. +Any text hidden via text properties is not revealed even if `search-invisible' +is set to 't.") + +(defvar-local org-fold-core--isearch-local-regions (make-hash-table :test 'equal) + "Hash table storing temporarily shown folds from isearch matches.") + +(defun org-fold-core--isearch-setup (type) + "Initialize isearch in org buffer. +TYPE can be either `text-properties' or `overlays'." + (pcase type + (`text-properties + (setq-local search-invisible 'open-all) + (add-hook 'isearch-mode-end-hook #'org-fold-core--clear-isearch-state nil 'local) + (add-hook 'isearch-mode-hook #'org-fold-core--clear-isearch-state nil 'local) + (setq-local isearch-filter-predicate #'org-fold-core--isearch-filter-predicate-text-properties)) + (`overlays + (when (eq org-fold-core-style 'text-properties) + (setq-local isearch-filter-predicate #'org-fold-core--isearch-filter-predicate-overlays) + (add-hook 'isearch-mode-end-hook #'org-fold-core--clear-isearch-overlays nil 'local))) + (_ (error "%s: Unknown type of setup for `org-fold-core--isearch-setup'" type)))) + +(defun org-fold-core--isearch-reveal (pos) + "Default function used to reveal hidden text at POS for isearch." + (let ((region (org-fold-core-get-region-at-point pos))) + (org-fold-core-region (car region) (cdr region) nil))) + +(defun org-fold-core--isearch-filter-predicate-text-properties (beg end) + "Make sure that folded text is searchable when user whant so. +This function is intended to be used as `isearch-filter-predicate'." + (and + ;; Check folding specs that cannot be searched + (not (memq nil (mapcar (lambda (spec) (not (org-fold-core-get-folding-spec-property spec :isearch-ignore))) + (org-fold-core-get-folding-specs-in-region beg end)))) + ;; Check 'invisible properties that are not folding specs. + (or (eq search-invisible t) ; User wants to search anyway, allow it. + (let ((pos beg) + unknown-invisible-property) + (while (and (< pos end) + (not unknown-invisible-property)) + (when (and (get-text-property pos 'invisible) + (not (org-fold-core-folding-spec-p (get-text-property pos 'invisible)))) + (setq unknown-invisible-property t)) + (setq pos (next-single-char-property-change pos 'invisible))) + (not unknown-invisible-property))) + (or (and (eq search-invisible t) + ;; FIXME: this opens regions permanenly for now. + ;; I also tried to force search-invisible 'open-all around + ;; `isearch-range-invisible', but that somehow causes + ;; infinite loop in `isearch-lazy-highlight'. + (prog1 t + ;; We still need to reveal the folded location + (org-fold-core--isearch-show-temporary (cons beg end) nil))) + (not (isearch-range-invisible beg end))))) + +(defun org-fold-core--clear-isearch-state () + "Clear `org-fold-core--isearch-local-regions'." + (clrhash org-fold-core--isearch-local-regions)) + +(defun org-fold-core--isearch-show (region) + "Reveal text in REGION found by isearch." + (org-with-point-at (car region) + (while (< (point) (cdr region)) + (funcall org-fold-core-isearch-open-function (car region)) + (goto-char (org-fold-core-next-visibility-change (point) (cdr region) 'ignore-hidden))))) + +(defun org-fold-core--isearch-show-temporary (region hide-p) + "Temporarily reveal text in REGION. +Hide text instead if HIDE-P is non-nil." + (if (not hide-p) + (let ((pos (car region))) + (while (< pos (cdr region)) + (let ((spec-no-open + (catch :found + (dolist (spec (org-fold-core-get-folding-spec 'all pos)) + (unless (org-fold-core-get-folding-spec-property spec :isearch-open) + (throw :found spec)))))) + (if spec-no-open + ;; Skip regions folded with folding specs that cannot be opened. + (setq pos (org-fold-core-next-folding-state-change spec-no-open pos (cdr region))) + (dolist (spec (org-fold-core-get-folding-spec 'all pos)) + (push (cons spec (org-fold-core-get-region-at-point spec pos)) (gethash region org-fold-core--isearch-local-regions))) + (org-fold-core--isearch-show region) + (setq pos (org-fold-core-next-folding-state-change nil pos (cdr region))))))) + (mapc (lambda (val) (org-fold-core-region (cadr val) (cddr val) t (car val))) (gethash region org-fold-core--isearch-local-regions)) + (remhash region org-fold-core--isearch-local-regions))) + +(defvar-local org-fold-core--isearch-special-specs nil + "List of specs that can break visibility state when converted to overlays. +This is a hack, but I do not see a better way around until isearch +gets support of text properties.") +(defun org-fold-core--create-isearch-overlays (beg end) + "Replace text property invisibility spec by overlays between BEG and END. +All the searcheable folded regions will be changed to use overlays +instead of text properties. The created overlays will be stored in +`org-fold-core--isearch-overlays'." + (let ((pos beg)) + (while (< pos end) + ;; We need loop below to make sure that we clean all invisible + ;; properties, which may be nested. + (dolist (spec (org-fold-core-get-folding-spec 'all pos)) + (unless (org-fold-core-get-folding-spec-property spec :isearch-ignore) + (let* ((region (org-fold-core-get-region-at-point spec pos))) + (when (memq spec org-fold-core--isearch-special-specs) + (setq pos (min pos (car region))) + (setq end (max end (cdr region)))) + ;; Changing text properties is considered buffer modification. + ;; We do not want it here. + (with-silent-modifications + (org-fold-core-region (car region) (cdr region) nil spec) + ;; The overlay is modelled after `outline-flag-region' + ;; [2020-05-09 Sat] overlay for 'outline blocks. + (let ((o (make-overlay (car region) (cdr region) nil 'front-advance))) + (overlay-put o 'evaporate t) + (overlay-put o 'invisible spec) + (overlay-put o 'org-invisible spec) + ;; Make sure that overlays are applied in the same order + ;; with the folding specs. + ;; Note: `memq` returns cdr with car equal to the first + ;; found matching element. + (overlay-put o 'priority (length (memq spec (org-fold-core-folding-spec-list)))) + ;; `delete-overlay' here means that spec information will be lost + ;; for the region. The region will remain visible. + (if (org-fold-core-get-folding-spec-property spec :isearch-open) + (overlay-put o 'isearch-open-invisible #'delete-overlay) + (overlay-put o 'isearch-open-invisible #'ignore) + (overlay-put o 'isearch-open-invisible-temporary #'ignore)) + (push o org-fold-core--isearch-overlays)))))) + (setq pos (org-fold-core-next-folding-state-change nil pos end))))) + +(defun org-fold-core--isearch-filter-predicate-overlays (beg end) + "Return non-nil if text between BEG and END is deemed visible by isearch. +This function is intended to be used as `isearch-filter-predicate'." + (org-fold-core--create-isearch-overlays beg end) ;; trick isearch by creating overlays in place of invisible text + (isearch-filter-visible beg end)) + +(defun org-fold-core--clear-isearch-overlay (ov) + "Convert OV region back into using text properties." + (let ((spec (if isearch-mode-end-hook-quit + ;; Restore all folds. + (overlay-get ov 'org-invisible) + ;; Leave opened folds open. + (overlay-get ov 'invisible)))) + ;; Ignore deleted overlays. + (when (and spec + (overlay-buffer ov)) + ;; Changing text properties is considered buffer modification. + ;; We do not want it here. + (with-silent-modifications + (when (<= (overlay-end ov) (point-max)) + (org-fold-core-region (overlay-start ov) (overlay-end ov) t spec))))) + (when (member ov isearch-opened-overlays) + (setq isearch-opened-overlays (delete ov isearch-opened-overlays))) + (delete-overlay ov)) + +(defun org-fold-core--clear-isearch-overlays () + "Convert overlays from `org-fold-core--isearch-overlays' back to text properties." + (when org-fold-core--isearch-overlays + (mapc #'org-fold-core--clear-isearch-overlay org-fold-core--isearch-overlays) + (setq org-fold-core--isearch-overlays nil))) + +;;; Handling changes in folded elements + +(defvar org-fold-core--ignore-modifications nil + "Non-nil: skip processing modifications in `org-fold-core--fix-folded-region'.") +(defvar org-fold-core--ignore-fragility-checks nil + "Non-nil: skip fragility checks in `org-fold-core--fix-folded-region'.") + +(defmacro org-fold-core-ignore-modifications (&rest body) + "Run BODY ignoring buffer modifications in `org-fold-core--fix-folded-region'." + (declare (debug (form body)) (indent 1)) + `(let ((org-fold-core--ignore-modifications t)) + (unwind-protect (progn ,@body) + (setq org-fold-core--last-buffer-chars-modified-tick (buffer-chars-modified-tick))))) + +(defmacro org-fold-core-ignore-fragility-checks (&rest body) + "Run BODY skipping :fragility checks in `org-fold-core--fix-folded-region'." + (declare (debug (form body)) (indent 1)) + `(let ((org-fold-core--ignore-fragility-checks t)) + (progn ,@body))) + +(defvar-local org-fold-core--last-buffer-chars-modified-tick nil + "Variable storing the last return value of `buffer-chars-modified-tick'.") + +(defun org-fold-core--fix-folded-region (from to _) + "Process modifications in folded elements within FROM . TO region. +This function intended to be used as one of `after-change-functions'. + +This function does nothing if text the only modification was changing +text properties (for the sake of reducing overheads). + +If a text was inserted into invisible region, hide the inserted text. +If a text was inserted in front/back of the region, hide it according +to :font-sticky/:rear-sticky folding spec property. + +If the folded region is folded with a spec with non-nil :fragile +property, unfold the region if the :fragile function returns non-nil." + ;; If no insertions or deletions in buffer, skip all the checks. + (unless (or (eq org-fold-core--last-buffer-chars-modified-tick (buffer-chars-modified-tick)) + org-fold-core--ignore-modifications + (memql 'ignore-modification-checks org-fold-core--optimise-for-huge-buffers)) + ;; Store the new buffer modification state. + (setq org-fold-core--last-buffer-chars-modified-tick (buffer-chars-modified-tick)) + (save-match-data + ;; Handle changes in all the indirect buffers and in the base + ;; buffer. Work around Emacs bug#46982. + (when (eq org-fold-core-style 'text-properties) + (org-fold-core-cycle-over-indirect-buffers + ;; Re-hide text inserted in the middle/font/back of a folded + ;; region. + (unless (equal from to) ; Ignore deletions. + (dolist (spec (org-fold-core-folding-spec-list)) + ;; Reveal fully invisible text inserted in the middle + ;; of visible portion of the buffer. This is needed, + ;; for example, when there was a deletion in a folded + ;; heading, the heading was unfolded, end `undo' was + ;; called. The `undo' would insert the folded text. + (when (and (or (eq from (point-min)) + (not (org-fold-core-folded-p (1- from) spec))) + (or (eq to (point-max)) + (not (org-fold-core-folded-p to spec))) + (org-fold-core-region-folded-p from to spec)) + (org-fold-core-region from to nil spec)) + ;; Look around and fold the new text if the nearby folds are + ;; sticky. + (unless (org-fold-core-region-folded-p from to spec) + (let ((spec-to (org-fold-core-get-folding-spec spec (min to (1- (point-max))))) + (spec-from (org-fold-core-get-folding-spec spec (max (point-min) (1- from))))) + ;; Reveal folds around undoed deletion. + (when undo-in-progress + (let ((lregion (org-fold-core-get-region-at-point spec (max (point-min) (1- from)))) + (rregion (org-fold-core-get-region-at-point spec (min to (1- (point-max)))))) + (if (and lregion rregion) + (org-fold-core-region (car lregion) (cdr rregion) nil spec) + (when lregion + (org-fold-core-region (car lregion) (cdr lregion) nil spec)) + (when rregion + (org-fold-core-region (car rregion) (cdr rregion) nil spec))))) + ;; Hide text inserted in the middle of a fold. + (when (and (or spec-from (eq from (point-min))) + (or spec-to (eq to (point-max))) + (or spec-from spec-to) + (eq spec-to spec-from) + (or (org-fold-core-get-folding-spec-property spec :front-sticky) + (org-fold-core-get-folding-spec-property spec :rear-sticky))) + (unless (and (eq from (point-min)) (eq to (point-max))) ; Buffer content replaced. + (org-fold-core-region from to t (or spec-from spec-to)))) + ;; Hide text inserted at the end of a fold. + (when (and spec-from (org-fold-core-get-folding-spec-property spec-from :rear-sticky)) + (org-fold-core-region from to t spec-from)) + ;; Hide text inserted in front of a fold. + (when (and spec-to + (not (eq to (point-max))) ; Text inserted at the end of buffer is not prepended anywhere. + (org-fold-core-get-folding-spec-property spec-to :front-sticky)) + (org-fold-core-region from to t spec-to)))))))) + ;; Process all the folded text between `from' and `to'. Do it + ;; only in current buffer to avoid verifying semantic structure + ;; multiple times in indirect buffers that have exactly same + ;; text anyway. + (unless (or org-fold-core--ignore-fragility-checks + (memql 'ignore-fragility-checks org-fold-core--optimise-for-huge-buffers)) + (dolist (func org-fold-core-extend-changed-region-functions) + (let ((new-region (funcall func from to))) + (setq from (car new-region)) + (setq to (cdr new-region)))) + (dolist (spec (org-fold-core-folding-spec-list)) + ;; No action is needed when :fragile is nil for the spec. + (when (org-fold-core-get-folding-spec-property spec :fragile) + (org-with-wide-buffer + ;; Expand the considered region to include partially present fold. + ;; Note: It is important to do this inside loop over all + ;; specs. Otherwise, the region may be expanded to huge + ;; outline fold, potentially involving majority of the + ;; buffer. That would cause the below code to loop over + ;; almost all the folds in buffer, which would be too slow. + (let ((local-from from) + (local-to to) + (region-from (org-fold-core-get-region-at-point spec (max (point-min) (1- from)))) + (region-to (org-fold-core-get-region-at-point spec (min to (1- (point-max)))))) + (when region-from (setq local-from (car region-from))) + (when region-to (setq local-to (cdr region-to))) + (let ((pos local-from)) + ;; Move to the first hidden region. + (unless (org-fold-core-get-folding-spec spec pos) + (setq pos (org-fold-core-next-folding-state-change spec pos local-to))) + ;; Cycle over all the folds. + (while (< pos local-to) + (save-match-data ; we should not clobber match-data in after-change-functions + (let ((fold-begin (and (org-fold-core-get-folding-spec spec pos) + pos)) + (fold-end (org-fold-core-next-folding-state-change spec pos local-to))) + (when (and fold-begin fold-end) + (when (save-excursion + (funcall (org-fold-core-get-folding-spec-property spec :fragile) + (cons fold-begin fold-end) + spec)) + ;; Reveal completely, not just from the SPEC. + (org-fold-core-region fold-begin fold-end nil))))) + ;; Move to next fold. + (setq pos (org-fold-core-next-folding-state-change spec pos local-to)))))))))))) + +;;; Hanlding killing/yanking of folded text + +;; Backward compatibility with Emacs 24. +(defun org-fold-core--seq-partition (list n) + "Return list of elements of LIST grouped into sub-sequences of length N. +The last list may contain less than N elements. If N is a +negative integer or 0, nil is returned." + (if (fboundp 'seq-partition) + (seq-partition list n) + (unless (< n 1) + (let ((result '())) + (while list + (let (part) + (dotimes (_ n) + (when list (push (car list) part))) + (push part result)) + (dotimes (_ n) + (setq list (cdr list)))) + (nreverse result))))) + +;; By default, all the text properties of the killed text are +;; preserved, including the folding text properties. This can be +;; awkward when we copy a text from an indirect buffer to another +;; indirect buffer (or the base buffer). The copied text might be +;; visible in the source buffer, but might disappear if we yank it in +;; another buffer. This happens in the following situation: +;; ---- base buffer ---- +;; * Headline<begin fold> +;; Some text hidden in the base buffer, but revealed in the indirect +;; buffer.<end fold> +;; * Another headline +;; +;; ---- end of base buffer ---- +;; ---- indirect buffer ---- +;; * Headline +;; Some text hidden in the base buffer, but revealed in the indirect +;; buffer. +;; * Another headline +;; +;; ---- end of indirect buffer ---- +;; If we copy the text under "Headline" from the indirect buffer and +;; insert it under "Another headline" in the base buffer, the inserted +;; text will be hidden since it's folding text properties are copyed. +;; Basically, the copied text would have two sets of folding text +;; properties: (1) Properties for base buffer telling that the text is +;; hidden; (2) Properties for the indirect buffer telling that the +;; text is visible. The first set of the text properties in inactive +;; in the indirect buffer, but will become active once we yank the +;; text back into the base buffer. +;; +;; To avoid the above situation, we simply clear all the properties, +;; unrealated to current buffer when a text is copied. +;; FIXME: Ideally, we may want to carry the folding state of copied +;; text between buffer (probably via user customisation). +(defun org-fold-core--buffer-substring-filter (beg end &optional delete) + "Clear folding state in killed text. +This function is intended to be used as `filter-buffer-substring-function'. +The arguments and return value are as specified for `filter-buffer-substring'." + (let ((return-string (buffer-substring--filter beg end delete)) + ;; The list will be used as an argument to `remove-text-properties'. + props-list) + ;; There is no easy way to examine all the text properties of a + ;; string, so we utilise the fact that printed string + ;; representation lists all its properties. + ;; Loop over the elements of string representation. + (unless (or (string= "" return-string) + (<= end beg) + (eq org-fold-core-style 'overlays)) + ;; Collect all the text properties the string is completely + ;; hidden with. + (dolist (spec (org-fold-core-folding-spec-list)) + (when (and (org-fold-core-region-folded-p beg end spec) + (org-region-invisible-p beg end)) + (push (org-fold-core--property-symbol-get-create spec nil t) props-list))) + (dolist (plist + (if (fboundp 'object-intervals) + (object-intervals return-string) + ;; Backward compatibility with Emacs <28. + ;; FIXME: Is there any better way to do it? + ;; Yes, it is a hack. + ;; The below gives us string representation as a list. + ;; Note that we need to remove unreadable values, like markers (#<...>). + (org-fold-core--seq-partition + (cdr (let ((data (read (replace-regexp-in-string + "^#(" "(" + (replace-regexp-in-string + " #(" " (" + (replace-regexp-in-string + "#<[^>]+>" "dummy" + ;; Get text representation of the string object. + ;; Make sure to print everything (see `prin1' docstring). + ;; `prin1' is used to print "%S" format. + (let (print-level print-length) + (format "%S" return-string)))))))) + (if (listp data) data (list data)))) + 3))) + (let* ((start (car plist)) + (fin (cadr plist)) + (plist (car (cddr plist)))) + ;; Only lists contain text properties. + (when (listp plist) + ;; Collect all the relevant text properties. + (while plist + (let* ((prop (car plist)) + (prop-name (symbol-name prop))) + ;; Reveal hard-hidden text. See + ;; `org-fold-core--optimise-for-huge-buffers'. + (when (and (eq prop 'invisible) + (member (cadr plist) (org-fold-core-folding-spec-list))) + (remove-text-properties start fin '(invisible t) return-string)) + ;; We do not care about values now. + (setq plist (cddr plist)) + (when (string-match-p org-fold-core--spec-property-prefix prop-name) + ;; Leave folding specs from current buffer. See + ;; comments in `org-fold-core--property-symbol-get-create' to + ;; understand why it works. + (unless (member prop (cdr (assq 'invisible char-property-alias-alist))) + (push prop props-list)))))))) + (remove-text-properties 0 (length return-string) props-list return-string)) + return-string)) + +;;; Do not fontify folded text until needed. + +(defun org-fold-core-fontify-region (beg end loudly &optional force) + "Run `font-lock-default-fontify-region' in visible regions." + (let ((pos beg) next + (org-fold-core--fontifying t)) + (while (< pos end) + (setq next (org-fold-core-next-folding-state-change + (if force nil + (let (result) + (dolist (spec (org-fold-core-folding-spec-list)) + (when (and (not (org-fold-core-get-folding-spec-property spec :visible)) + (org-fold-core-get-folding-spec-property spec :font-lock-skip)) + (push spec result))) + result)) + pos + end)) + (while (and (not (catch :found + (dolist (spec (org-fold-core-get-folding-spec 'all next)) + (when (org-fold-core-get-folding-spec-property spec :font-lock-skip) + (throw :found spec))))) + (< next end)) + (setq next (org-fold-core-next-folding-state-change nil next end))) + (save-excursion + (font-lock-default-fontify-region pos next loudly) + (save-match-data + (unless (<= pos (point) next) + (run-hook-with-args 'org-fold-core-first-unfold-functions pos next)))) + (put-text-property pos next 'org-fold-core-fontified t) + (setq pos next)))) + +(defun org-fold-core-update-optimisation (beg end) + "Update huge buffer optimisation between BEG and END. +See `org-fold-core--optimise-for-huge-buffers'." + (when (and (memql 'grab-invisible org-fold-core--optimise-for-huge-buffers) + (eq org-fold-core-style 'text-properties)) + (let ((pos beg)) + (while (< pos end) + (when (and (org-fold-core-folded-p pos (caar org-fold-core--specs)) + (not (eq (caar org-fold-core--specs) (get-text-property pos 'invisible)))) + (put-text-property pos (org-fold-core-next-folding-state-change (caar org-fold-core--specs) pos end) + 'invisible (caar org-fold-core--specs))) + (setq pos (org-fold-core-next-folding-state-change (caar org-fold-core--specs) pos end)))))) + +(defun org-fold-core-remove-optimisation (beg end) + "Remove huge buffer optimisation between BEG and END. +See `org-fold-core--optimise-for-huge-buffers'." + (when (and (memql 'grab-invisible org-fold-core--optimise-for-huge-buffers) + (eq org-fold-core-style 'text-properties)) + (let ((pos beg)) + (while (< pos end) + (if (and (org-fold-core-folded-p pos (caar org-fold-core--specs)) + (eq (caar org-fold-core--specs) (get-text-property pos 'invisible))) + (remove-text-properties pos (org-fold-core-next-folding-state-change (caar org-fold-core--specs) pos end) + '(invisible t))) + (setq pos (org-fold-core-next-folding-state-change (caar org-fold-core--specs) pos end)))))) + +(provide 'org-fold-core) + +;;; org-fold-core.el ends here ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH 02/35] Separate folding functions from org.el into new library: org-fold 2022-01-29 11:37 ` [PATCH 00/35] Merge org-fold feature branch Ihor Radchenko 2022-01-29 11:37 ` [PATCH 01/35] Add org-fold-core: new folding engine Ihor Radchenko @ 2022-01-29 11:37 ` Ihor Radchenko 2022-01-29 11:37 ` [PATCH 03/35] Separate cycling functions from org.el into new library: org-cycle Ihor Radchenko ` (33 subsequent siblings) 35 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-01-29 11:37 UTC (permalink / raw) To: Bastien, Kyle Meyer, Nicolas Goaziou, Karl Voit, Christian Heinrich, emacs-orgmode Cc: Ihor Radchenko [-- Attachment #1: Type: text/plain, Size: 150 bytes --] --- lisp/org-fold.el | 1135 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 1135 insertions(+) create mode 100644 lisp/org-fold.el [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0002-Separate-folding-functions-from-org.el-into-new-libr.patch --] [-- Type: text/x-patch; name="0002-Separate-folding-functions-from-org.el-into-new-libr.patch", Size: 49902 bytes --] diff --git a/lisp/org-fold.el b/lisp/org-fold.el new file mode 100644 index 000000000..52717fd86 --- /dev/null +++ b/lisp/org-fold.el @@ -0,0 +1,1135 @@ +;;; org-fold.el --- Folding of Org entries -*- lexical-binding: t; -*- +;; +;; Copyright (C) 2020-2020 Free Software Foundation, Inc. +;; +;; Author: Ihor Radchenko <yantar92 at gmail dot com> +;; Keywords: folding, invisible text +;; Homepage: https://orgmode.org +;; +;; This file is part of GNU Emacs. +;; +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Commentary: + +;; This file contains code handling temporary invisibility (folding +;; and unfolding) of text in org buffers. + +;; The folding is implemented using generic org-fold-core library. This file +;; contains org-specific implementation of the folding. Also, various +;; useful functions from org-fold-core are aliased under shorted `org-fold' +;; prefix. + +;; The following features are implemented: +;; - Folding/unfolding various Org mode elements and regions of Org buffers: +;; + Region before first heading; +;; + Org headings, their text, children (subtree), siblings, parents, etc; +;; + Org blocks and drawers +;; - Revealing Org structure around invisible point location +;; - Revealing folded Org elements broken by user edits + +;;; Code: + +(require 'org-macs) +(require 'org-fold-core) + +(defvar org-inlinetask-min-level) +(defvar org-link--link-folding-spec) +(defvar org-link--description-folding-spec) +(defvar org-odd-levels-only) +(defvar org-drawer-regexp) +(defvar org-property-end-re) +(defvar org-link-descriptive) +(defvar org-outline-regexp-bol) +(defvar org-custom-properties-hidden-p) +(defvar org-archive-tag) + +;; Needed for overlays only +(defvar org-custom-properties-overlays) + +(declare-function isearch-filter-visible "isearch" (beg end)) +(declare-function org-element-type "org-element" (element)) +(declare-function org-element-at-point "org-element" (&optional pom cached-only)) +(declare-function org-element-property "org-element" (property element)) +(declare-function org-element--current-element "org-element" (limit &optional granularity mode structure)) +(declare-function org-element--cache-active-p "org-element" ()) +(declare-function org-toggle-custom-properties-visibility "org" ()) +(declare-function org-item-re "org-list" ()) +(declare-function org-up-heading-safe "org" ()) +(declare-function org-get-tags "org" (&optional pos local fontify)) +(declare-function org-get-valid-level "org" (level &optional change)) +(declare-function org-before-first-heading-p "org" ()) +(declare-function org-goto-sibling "org" (&optional previous)) +(declare-function org-block-map "org" (function &optional start end)) +(declare-function org-map-region "org" (fun beg end)) +(declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading)) +(declare-function org-back-to-heading-or-point-min "org" (&optional invisible-ok)) +(declare-function org-back-to-heading "org" (&optional invisible-ok)) +(declare-function org-at-heading-p "org" (&optional invisible-not-ok)) +(declare-function org-cycle-hide-drawers "org-cycle" (state)) + +(declare-function outline-show-branches "outline" ()) +(declare-function outline-hide-sublevels "outline" (levels)) +(declare-function outline-get-next-sibling "outline" ()) +(declare-function outline-invisible-p "outline" (&optional pos)) +(declare-function outline-next-heading "outline" ()) + +;;; Customization + +(defgroup org-fold-reveal-location nil + "Options about how to make context of a location visible." + :tag "Org Reveal Location" + :group 'org-structure) + +(defcustom org-fold-show-context-detail '((agenda . local) + (bookmark-jump . lineage) + (isearch . lineage) + (default . ancestors)) + "Alist between context and visibility span when revealing a location. + +\\<org-mode-map>Some actions may move point into invisible +locations. As a consequence, Org always exposes a neighborhood +around point. How much is shown depends on the initial action, +or context. Valid contexts are + + agenda when exposing an entry from the agenda + org-goto when using the command `org-goto' (`\\[org-goto]') + occur-tree when using the command `org-occur' (`\\[org-sparse-tree] /') + tags-tree when constructing a sparse tree based on tags matches + link-search when exposing search matches associated with a link + mark-goto when exposing the jump goal of a mark + bookmark-jump when exposing a bookmark location + isearch when exiting from an incremental search + default default for all contexts not set explicitly + +Allowed visibility spans are + + minimal show current headline; if point is not on headline, + also show entry + + local show current headline, entry and next headline + + ancestors show current headline and its direct ancestors; if + point is not on headline, also show entry + + ancestors-full show current subtree and its direct ancestors + + lineage show current headline, its direct ancestors and all + their children; if point is not on headline, also show + entry and first child + + tree show current headline, its direct ancestors and all + their children; if point is not on headline, also show + entry and all children + + canonical show current headline, its direct ancestors along with + their entries and children; if point is not located on + the headline, also show current entry and all children + +As special cases, a nil or t value means show all contexts in +`minimal' or `canonical' view, respectively. + +Some views can make displayed information very compact, but also +make it harder to edit the location of the match. In such +a case, use the command `org-fold-reveal' (`\\[org-fold-reveal]') to show +more context." + :group 'org-fold-reveal-location + :version "26.1" + :package-version '(Org . "9.0") + :type '(choice + (const :tag "Canonical" t) + (const :tag "Minimal" nil) + (repeat :greedy t :tag "Individual contexts" + (cons + (choice :tag "Context" + (const agenda) + (const org-goto) + (const occur-tree) + (const tags-tree) + (const link-search) + (const mark-goto) + (const bookmark-jump) + (const isearch) + (const default)) + (choice :tag "Detail level" + (const minimal) + (const local) + (const ancestors) + (const ancestors-full) + (const lineage) + (const tree) + (const canonical)))))) + +(defvar org-fold-reveal-start-hook nil + "Hook run before revealing a location.") + +(defcustom org-fold-catch-invisible-edits 'smart + "Check if in invisible region before inserting or deleting a character. +Valid values are: + +nil Do not check, so just do invisible edits. +error Throw an error and do nothing. +show Make point visible, and do the requested edit. +show-and-error Make point visible, then throw an error and abort the edit. +smart Make point visible, and do insertion/deletion if it is + adjacent to visible text and the change feels predictable. + Never delete a previously invisible character or add in the + middle or right after an invisible region. Basically, this + allows insertion and backward-delete right before ellipses. + FIXME: maybe in this case we should not even show?" + :group 'org-edit-structure + :version "24.1" + :type '(choice + (const :tag "Do not check" nil) + (const :tag "Throw error when trying to edit" error) + (const :tag "Unhide, but do not do the edit" show-and-error) + (const :tag "Show invisible part and do the edit" show) + (const :tag "Be smart and do the right thing" smart))) + +;;; Core functionality + +;;; API + +;;;; Modifying folding specs + +(defalias 'org-fold-folding-spec-p #'org-fold-core-folding-spec-p) +(defalias 'org-fold-add-folding-spec #'org-fold-core-add-folding-spec) +(defalias 'org-fold-remove-folding-spec #'org-fold-core-remove-folding-spec) + +(defun org-fold-initialize (ellipsis) + "Setup folding in current Org buffer." + (setq-local org-fold-core-isearch-open-function #'org-fold--isearch-reveal) + (setq-local org-fold-core-extend-changed-region-functions (list #'org-fold--extend-changed-region)) + ;; FIXME: Converting org-link + org-description to overlays when + ;; search matches hidden "[[" part of the link, reverses priority of + ;; link and description and hides the whole link. Working around + ;; this until there will be no need to convert text properties to + ;; overlays for isearch. + (setq-local org-fold-core--isearch-special-specs '(org-link)) + (org-fold-core-initialize `((org-fold-outline + (:ellipsis . ,ellipsis) + (:fragile . ,#'org-fold--reveal-outline-maybe) + (:isearch-open . t) + ;; This is needed to make sure that inserting a + ;; new planning line in folded heading is not + ;; revealed. + (:front-sticky . t) + (:rear-sticky . t) + (:font-lock-skip . t) + (:alias . (headline heading outline inlinetask plain-list))) + (org-fold-block + (:ellipsis . ,ellipsis) + (:fragile . ,#'org-fold--reveal-drawer-or-block-maybe) + (:isearch-open . t) + (:front-sticky . t) + (:alias . ( block center-block comment-block + dynamic-block example-block export-block + quote-block special-block src-block + verse-block))) + (org-fold-drawer + (:ellipsis . ,ellipsis) + (:fragile . ,#'org-fold--reveal-drawer-or-block-maybe) + (:isearch-open . t) + (:front-sticky . t) + (:alias . (drawer property-drawer))) + ,org-link--description-folding-spec + ,org-link--link-folding-spec))) + +;;;; Searching and examining folded text + +(defalias 'org-fold-folded-p #'org-fold-core-folded-p) +(defalias 'org-fold-get-folding-spec #'org-fold-core-get-folding-spec) +(defalias 'org-fold-get-folding-specs-in-region #'org-fold-core-get-folding-specs-in-region) +(defalias 'org-fold-get-region-at-point #'org-fold-core-get-region-at-point) +(defalias 'org-fold-next-visibility-change #'org-fold-core-next-visibility-change) +(defalias 'org-fold-previous-visibility-change #'org-fold-core-previous-visibility-change) +(defalias 'org-fold-next-folding-state-change #'org-fold-core-next-folding-state-change) +(defalias 'org-fold-previous-folding-state-change #'org-fold-core-previous-folding-state-change) +(defalias 'org-fold-search-forward #'org-fold-core-search-forward) + +;;;;; Macros + +(defmacro org-fold-save-outline-visibility--overlays (use-markers &rest body) + "Save and restore outline visibility around BODY. +If USE-MARKERS is non-nil, use markers for the positions. This +means that the buffer may change while running BODY, but it also +means that the buffer should stay alive during the operation, +because otherwise all these markers will point to nowhere." + (declare (debug (form body)) (indent 1)) + (org-with-gensyms (data invisible-types markers?) + `(let* ((,invisible-types '(org-hide-block outline)) + (,markers? ,use-markers) + (,data + (mapcar (lambda (o) + (let ((beg (overlay-start o)) + (end (overlay-end o)) + (type (overlay-get o 'invisible))) + (and beg end + (> end beg) + (memq type ,invisible-types) + (list (if ,markers? (copy-marker beg) beg) + (if ,markers? (copy-marker end t) end) + type)))) + (org-with-wide-buffer + (overlays-in (point-min) (point-max)))))) + (unwind-protect (progn ,@body) + (org-with-wide-buffer + (dolist (type ,invisible-types) + (remove-overlays (point-min) (point-max) 'invisible type)) + (pcase-dolist (`(,beg ,end ,type) (delq nil ,data)) + (org-fold-region beg end t type) + (when ,markers? + (set-marker beg nil) + (set-marker end nil)))))))) +(defmacro org-fold-save-outline-visibility--text-properties (use-markers &rest body) + "Save and restore outline visibility around BODY. +If USE-MARKERS is non-nil, use markers for the positions. This +means that the buffer may change while running BODY, but it also +means that the buffer should stay alive during the operation, +because otherwise all these markers will point to nowhere." + (declare (debug (form body)) (indent 1)) + (org-with-gensyms (data specs markers?) + `(let* ((,specs ',(org-fold-core-folding-spec-list)) + (,markers? ,use-markers) + (,data + (org-with-wide-buffer + (let ((pos (point-min)) + data-val) + (while (< pos (point-max)) + (dolist (spec (org-fold-get-folding-spec 'all pos)) + (let ((region (org-fold-get-region-at-point spec pos))) + (if ,markers? + (push (list (copy-marker (car region)) + (copy-marker (cdr region) t) + spec) + data-val) + (push (list (car region) (cdr region) spec) + data-val)))) + (setq pos (org-fold-next-folding-state-change nil pos))))))) + (unwind-protect (progn ,@body) + (org-with-wide-buffer + (dolist (spec ,specs) + (org-fold-region (point-min) (point-max) nil spec)) + (pcase-dolist (`(,beg ,end ,spec) (delq nil ,data)) + (org-fold-region beg end t spec) + (when ,markers? + (set-marker beg nil) + (set-marker end nil)))))))) +(defmacro org-fold-save-outline-visibility (use-markers &rest body) + "Save and restore outline visibility around BODY. +If USE-MARKERS is non-nil, use markers for the positions. This +means that the buffer may change while running BODY, but it also +means that the buffer should stay alive during the operation, +because otherwise all these markers will point to nowhere." + (declare (debug (form body)) (indent 1)) + `(when (eq org-fold-core-style 'text-properties) + (org-fold-save-outline-visibility--text-properties ,use-markers ,@body) + (org-fold-save-outline-visibility--overlays ,use-markers ,@body))) + +;;;; Changing visibility (regions, blocks, drawers, headlines) + +;;;;; Region visibility + +;; (defalias 'org-fold-region #'org-fold-core-region) +(defun org-fold-region--overlays (from to flag spec) + "Hide or show lines from FROM to TO, according to FLAG. +SPEC is the invisibility spec, as a symbol." + (remove-overlays from to 'invisible spec) + ;; Use `front-advance' since text right before to the beginning of + ;; the overlay belongs to the visible line than to the contents. + (when flag + (let ((o (make-overlay from to nil 'front-advance))) + (overlay-put o 'evaporate t) + (overlay-put o 'invisible spec) + (overlay-put o + 'isearch-open-invisible + (lambda (&rest _) (org-fold-show-context 'isearch)))))) +(defsubst org-fold-region (from to flag &optional spec) + "Hide or show lines from FROM to TO, according to FLAG. +SPEC is the invisibility spec, as a symbol." + (if (eq org-fold-core-style 'text-properties) + (org-fold-core-region from to flag spec) + (org-fold-region--overlays from to flag spec))) + +(defun org-fold-show-all--text-properties (&optional types) + "Show all contents in the visible part of the buffer. +By default, the function expands headings, blocks and drawers. +When optional argument TYPES is a list of symbols among `blocks', +`drawers' and `headings', to only expand one specific type." + (interactive) + (dolist (type (or types '(blocks drawers headings))) + (org-fold-region (point-min) (point-max) nil + (pcase type + (`blocks 'block) + (`drawers 'drawer) + (`headings 'headline) + (_ (error "Invalid type: %S" type)))))) +(defun org-fold-show-all--overlays (&optional types) + "Show all contents in the visible part of the buffer. +By default, the function expands headings, blocks and drawers. +When optional argument TYPE is a list of symbols among `blocks', +`drawers' and `headings', to only expand one specific type." + (interactive) + (let ((types (or types '(blocks drawers headings)))) + (when (memq 'blocks types) + (org-fold-region (point-min) (point-max) nil 'org-hide-block)) + (cond + ;; Fast path. Since headings and drawers share the same + ;; invisible spec, clear everything in one go. + ((and (memq 'headings types) + (memq 'drawers types)) + (org-fold-region (point-min) (point-max) nil 'outline)) + ((memq 'headings types) + (org-fold-region (point-min) (point-max) nil 'outline) + (org-cycle-hide-drawers 'all)) + ((memq 'drawers types) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward org-drawer-regexp nil t) + (let* ((pair (get-char-property-and-overlay (line-beginning-position) + 'invisible)) + (o (cdr-safe pair))) + (if (overlayp o) (goto-char (overlay-end o)) + (pcase (get-char-property-and-overlay (point) 'invisible) + (`(outline . ,o) + (goto-char (overlay-end o)) + (delete-overlay o)) + (_ nil)))))))))) +(defsubst org-fold-show-all (&optional types) + "Show all contents in the visible part of the buffer. +By default, the function expands headings, blocks and drawers. +When optional argument TYPES is a list of symbols among `blocks', +`drawers' and `headings', to only expand one specific type." + (interactive) + (if (eq org-fold-core-style 'text-properties) + (org-fold-show-all--text-properties types) + (org-fold-show-all--overlays types))) + +(defun org-fold-flag-above-first-heading (&optional arg) + "Hide from bob up to the first heading. +Move point to the beginning of first heading or end of buffer." + (goto-char (point-min)) + (unless (org-at-heading-p) + (outline-next-heading)) + (unless (bobp) + (org-fold-region 1 (1- (point)) (not arg) 'outline))) + +;;;;; Heading visibility + +(defun org-fold-heading (flag &optional entry) + "Fold/unfold the current heading. FLAG non-nil means make invisible. +When ENTRY is non-nil, show the entire entry." + (save-excursion + (org-back-to-heading t) + ;; Check if we should show the entire entry + (if (not entry) + (org-fold-region + (line-end-position 0) (line-end-position) flag 'outline) + (org-fold-show-entry) + (save-excursion + ;; FIXME: potentially catches inlinetasks + (and (outline-next-heading) + (org-fold-heading nil)))))) + +(defun org-fold-hide-entry () + "Hide the body directly following this heading." + (interactive) + (save-excursion + (org-back-to-heading-or-point-min t) + (when (org-at-heading-p) (forward-line)) + (unless (eobp) ; Current headline is empty and ends at the end of buffer. + (org-fold-region + (line-end-position 0) + (save-excursion + (if (re-search-forward + (concat "[\r\n]" (org-get-limited-outline-regexp)) nil t) + (line-end-position 0) + (point-max))) + t + 'outline)))) + +(defun org-fold-subtree (flag) + (save-excursion + (org-back-to-heading t) + (org-fold-region (line-end-position) + (progn (org-end-of-subtree t) (point)) + flag + 'outline))) + +;; Replaces `outline-hide-subtree'. +(defun org-fold-hide-subtree () + "Hide everything after this heading at deeper levels." + (interactive) + (org-fold-subtree t)) + +;; Replaces `outline-hide-sublevels' +(defun org-fold-hide-sublevels (levels) + "Hide everything but the top LEVELS levels of headers, in whole buffer. +This also unhides the top heading-less body, if any. + +Interactively, the prefix argument supplies the value of LEVELS. +When invoked without a prefix argument, LEVELS defaults to the level +of the current heading, or to 1 if the current line is not a heading." + (interactive (list + (cond + (current-prefix-arg (prefix-numeric-value current-prefix-arg)) + ((save-excursion (beginning-of-line) + (looking-at outline-regexp)) + (funcall outline-level)) + (t 1)))) + (if (< levels 1) + (error "Must keep at least one level of headers")) + (save-excursion + (let* ((beg (progn + (goto-char (point-min)) + ;; Skip the prelude, if any. + (unless (org-at-heading-p) (outline-next-heading)) + (point))) + (end (progn + (goto-char (point-max)) + ;; Keep empty last line, if available. + (max (point-min) (if (bolp) (1- (point)) (point)))))) + (if (< end beg) + (setq beg (prog1 end (setq end beg)))) + ;; First hide everything. + (org-fold-region beg end t 'headline) + ;; Then unhide the top level headers. + (org-map-region + (lambda () + (when (<= (funcall outline-level) levels) + (org-fold-heading nil))) + beg end) + ;; Finally unhide any trailing newline. + (goto-char (point-max)) + (if (and (bolp) (not (bobp)) (outline-invisible-p (1- (point)))) + (org-fold-region (max (point-min) (1- (point))) (point) nil))))) + +(defun org-fold-show-entry () + "Show the body directly following its heading. +Show the heading too, if it is currently invisible." + (interactive) + (save-excursion + (org-back-to-heading-or-point-min t) + (org-fold-region + (line-end-position 0) + (save-excursion + (if (re-search-forward + (concat "[\r\n]\\(" (org-get-limited-outline-regexp) "\\)") nil t) + (match-beginning 1) + (point-max))) + nil + 'outline) + (org-cycle-hide-drawers 'children))) + +(defalias 'org-fold-show-hidden-entry #'org-fold-show-entry + "Show an entry where even the heading is hidden.") + +(defun org-fold-show-siblings () + "Show all siblings of the current headline." + (save-excursion + (while (org-goto-sibling) (org-fold-heading nil))) + (save-excursion + (while (org-goto-sibling 'previous) + (org-fold-heading nil)))) + +(defun org-fold-show-children (&optional level) + "Show all direct subheadings of this heading. +Prefix arg LEVEL is how many levels below the current level +should be shown. Default is enough to cause the following +heading to appear." + (interactive "p") + (unless (org-before-first-heading-p) + (save-excursion + (org-with-limited-levels (org-back-to-heading t)) + (let* ((current-level (funcall outline-level)) + (max-level (org-get-valid-level + current-level + (if level (prefix-numeric-value level) 1))) + (end (save-excursion (org-end-of-subtree t t))) + (regexp-fmt "^\\*\\{%d,%s\\}\\(?: \\|$\\)") + (past-first-child nil) + ;; Make sure to skip inlinetasks. + (re (format regexp-fmt + current-level + (cond + ((not (featurep 'org-inlinetask)) "") + (org-odd-levels-only (- (* 2 org-inlinetask-min-level) + 3)) + (t (1- org-inlinetask-min-level)))))) + ;; Display parent heading. + (org-fold-heading nil) + (forward-line) + ;; Display children. First child may be deeper than expected + ;; MAX-LEVEL. Since we want to display it anyway, adjust + ;; MAX-LEVEL accordingly. + (while (re-search-forward re end t) + (unless past-first-child + (setq re (format regexp-fmt + current-level + (max (funcall outline-level) max-level))) + (setq past-first-child t)) + (org-fold-heading nil)))))) + +(defun org-fold-show-subtree () + "Show everything after this heading at deeper levels." + (interactive) + (org-fold-region + (point) (save-excursion (org-end-of-subtree t t)) nil 'outline)) + +(defun org-fold-show-branches () + "Show all subheadings of this heading, but not their bodies." + (interactive) + (org-fold-show-children 1000)) + +(defun org-fold-show-branches-buffer--text-properties () + "Show all branches in the buffer." + (org-fold-flag-above-first-heading) + (org-fold-hide-sublevels 1) + (unless (eobp) + (org-fold-show-branches) + (while (outline-get-next-sibling) + (org-fold-show-branches))) + (goto-char (point-min))) +(defun org-fold-show-branches-buffer--overlays () + "Show all branches in the buffer." + (org-fold-flag-above-first-heading) + (outline-hide-sublevels 1) + (unless (eobp) + (outline-show-branches) + (while (outline-get-next-sibling) + (outline-show-branches))) + (goto-char (point-min))) +(defsubst org-fold-show-branches-buffer () + "Show all branches in the buffer." + (if (eq org-fold-core-style 'text-properties) + (org-fold-show-branches-buffer--text-properties) + (org-fold-show-branches-buffer--overlays))) + +;;;;; Blocks and drawers visibility + +(defun org-fold--hide-wrapper-toggle (element category force no-error) + "Toggle visibility for ELEMENT. + +ELEMENT is a block or drawer type parsed element. CATEGORY is +either `block' or `drawer'. When FORCE is `off', show the block +or drawer. If it is non-nil, hide it unconditionally. Throw an +error when not at a block or drawer, unless NO-ERROR is non-nil. + +Return a non-nil value when toggling is successful." + (let ((type (org-element-type element))) + (cond + ((memq type + (pcase category + (`drawer '(drawer property-drawer)) + (`block '(center-block + comment-block dynamic-block example-block export-block + quote-block special-block src-block verse-block)) + (_ (error "Unknown category: %S" category)))) + (let* ((post (org-element-property :post-affiliated element)) + (start (save-excursion + (goto-char post) + (line-end-position))) + (end (save-excursion + (goto-char (org-element-property :end element)) + (skip-chars-backward " \t\n") + (line-end-position)))) + ;; Do nothing when not before or at the block opening line or + ;; at the block closing line. + (unless (let ((eol (line-end-position))) + (and (> eol start) (/= eol end))) + (let* ((spec (if (eq org-fold-core-style 'text-properties) + category + (if (eq category 'block) 'org-hide-block 'outline))) + (flag + (cond ((eq force 'off) nil) + (force t) + ((if (eq org-fold-core-style 'text-properties) + (org-fold-folded-p start spec) + (eq spec (get-char-property start 'invisible))) + nil) + (t t)))) + (org-fold-region start end flag spec)) + ;; When the block is hidden away, make sure point is left in + ;; a visible part of the buffer. + (when (invisible-p (max (1- (point)) (point-min))) + (goto-char post)) + ;; Signal success. + t))) + (no-error nil) + (t + (user-error (format "%s@%s: %s" + (buffer-file-name (buffer-base-buffer)) + (point) + (if (eq category 'drawer) + "Not at a drawer" + "Not at a block"))))))) + +(defun org-fold-hide-block-toggle (&optional force no-error element) + "Toggle the visibility of the current block. + +When optional argument FORCE is `off', make block visible. If it +is non-nil, hide it unconditionally. Throw an error when not at +a block, unless NO-ERROR is non-nil. When optional argument +ELEMENT is provided, consider it instead of the current block. + +Return a non-nil value when toggling is successful." + (interactive) + (org-fold--hide-wrapper-toggle + (or element (org-element-at-point)) 'block force no-error)) + +(defun org-fold-hide-drawer-toggle (&optional force no-error element) + "Toggle the visibility of the current drawer. + +When optional argument FORCE is `off', make drawer visible. If +it is non-nil, hide it unconditionally. Throw an error when not +at a drawer, unless NO-ERROR is non-nil. When optional argument +ELEMENT is provided, consider it instead of the current drawer. + +Return a non-nil value when toggling is successful." + (interactive) + (org-fold--hide-wrapper-toggle + (or element (org-element-at-point)) 'drawer force no-error)) + +(defun org-fold-hide-block-all () + "Fold all blocks in the current buffer." + (interactive) + (org-block-map (apply-partially #'org-fold-hide-block-toggle 'hide))) + +(defun org-fold-hide-drawer-all () + "Fold all drawers in the current buffer." + (let ((begin (point-min)) + (end (point-max))) + (org-fold--hide-drawers begin end))) + +(defun org-fold--hide-drawers--overlays (begin end) + "Hide all drawers between BEGIN and END." + (save-excursion + (goto-char begin) + (while (re-search-forward org-drawer-regexp end t) + (let* ((pair (get-char-property-and-overlay (line-beginning-position) + 'invisible)) + (o (cdr-safe pair))) + (if (overlayp o) (goto-char (overlay-end o)) ;invisible drawer + (pcase (get-char-property-and-overlay (point) 'invisible) + (`(outline . ,o) (goto-char (overlay-end o))) ;already folded + (_ + (let* ((drawer (org-element-at-point)) + (type (org-element-type drawer))) + (when (memq type '(drawer property-drawer)) + (org-fold-hide-drawer-toggle t nil drawer) + ;; Make sure to skip drawer entirely or we might flag it + ;; another time when matching its ending line with + ;; `org-drawer-regexp'. + (goto-char (org-element-property :end drawer))))))))))) +(defun org-fold--hide-drawers--text-properties (begin end) + "Hide all drawers between BEGIN and END." + (save-excursion + (goto-char begin) + (while (and (< (point) end) + (re-search-forward org-drawer-regexp end t)) + ;; Skip folded drawers + (if (org-fold-folded-p nil 'drawer) + (goto-char (org-fold-next-folding-state-change 'drawer nil end)) + (let* ((drawer (org-element-at-point)) + (type (org-element-type drawer))) + (when (memq type '(drawer property-drawer)) + (org-fold-hide-drawer-toggle t nil drawer) + ;; Make sure to skip drawer entirely or we might flag it + ;; another time when matching its ending line with + ;; `org-drawer-regexp'. + (goto-char (org-element-property :end drawer)))))))) +(defun org-fold--hide-drawers (begin end) + "Hide all drawers between BEGIN and END." + (if (eq org-fold-core-style 'text-properties) + (org-fold--hide-drawers--text-properties begin end) + (org-fold--hide-drawers--overlays begin end))) + +(defun org-fold-hide-archived-subtrees (beg end) + "Re-hide all archived subtrees after a visibility state change." + (org-with-wide-buffer + (let ((case-fold-search nil) + (re (concat org-outline-regexp-bol ".*:" org-archive-tag ":"))) + (goto-char beg) + ;; Include headline point is currently on. + (beginning-of-line) + (while (and (< (point) end) (re-search-forward re end t)) + (when (member org-archive-tag (org-get-tags nil t)) + (org-fold-subtree t) + (org-end-of-subtree t)))))) + +;;;;; Reveal point location + +(defun org-fold-show-context (&optional key) + "Make sure point and context are visible. +Optional argument KEY, when non-nil, is a symbol. See +`org-fold-show-context-detail' for allowed values and how much is to +be shown." + (org-fold-show-set-visibility + (cond ((symbolp org-fold-show-context-detail) org-fold-show-context-detail) + ((cdr (assq key org-fold-show-context-detail))) + (t (cdr (assq 'default org-fold-show-context-detail)))))) + +(defun org-fold-show-set-visibility--overlays (detail) + "Set visibility around point according to 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 within a drawer or a block, make sure to + ;; expose it. + (dolist (o (overlays-at (point))) + (when (memq (overlay-get o 'invisible) '(org-hide-block outline)) + (delete-overlay o))) + (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)))))) +(defvar org-hide-emphasis-markers); Defined in org.el +(defvar org-pretty-entities); Defined in org.el +(defun org-fold-show-set-visibility--text-properties (detail) + "Set visibility around point according to 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) + (let ((region (org-fold-get-region-at-point))) + ;; Reveal emphasis markers. + (let (org-hide-emphasis-markers + org-link-descriptive + org-pretty-entities + (region (or (org-find-text-property-region (point) 'org-emphasis) + (org-find-text-property-region (point) 'invisible) + region))) + (when region + (org-with-point-at (car region) + (beginning-of-line) + (let (font-lock-extend-region-functions) + (font-lock-fontify-region (1- (car region)) (cdr region)))))) + (when region + (org-fold-region (car region) (cdr region) nil)))) + (unless (org-before-first-heading-p) + (org-with-limited-levels + (cl-case detail + ((tree canonical t) (org-fold-show-children)) + ((nil minimal ancestors ancestors-full)) + (t (save-excursion + (outline-next-heading) + (org-fold-heading nil))))))) + ;; Show whole subtree. + (when (eq detail 'ancestors-full) (org-fold-show-subtree)) + ;; Show all siblings. + (when (eq detail 'lineage) (org-fold-show-siblings)) + ;; Show ancestors, possibly with their children. + (when (memq detail '(ancestors ancestors-full lineage tree canonical t)) + (save-excursion + (while (org-up-heading-safe) + (org-fold-heading nil) + (when (memq detail '(canonical t)) (org-fold-show-entry)) + (when (memq detail '(tree canonical t)) (org-fold-show-children)))))) +(defun org-fold-show-set-visibility (detail) + "Set visibility around point according to DETAIL. +DETAIL is either nil, `minimal', `local', `ancestors', `lineage', +`tree', `canonical' or t. See `org-fold-show-context-detail' for more +information." + (if (eq org-fold-core-style 'text-properties) + (org-fold-show-set-visibility--text-properties detail) + (org-fold-show-set-visibility--overlays detail))) + +(defun org-fold-reveal (&optional siblings) + "Show current entry, hierarchy above it, and the following headline. + +This can be used to show a consistent set of context around +locations exposed with `org-fold-show-context'. + +With optional argument SIBLINGS, on each level of the hierarchy all +siblings are shown. This repairs the tree structure to what it would +look like when opened with hierarchical calls to `org-cycle'. + +With a \\[universal-argument] \\[universal-argument] prefix, \ +go to the parent and show the entire tree." + (interactive "P") + (run-hooks 'org-fold-reveal-start-hook) + (cond ((equal siblings '(4)) (org-fold-show-set-visibility 'canonical)) + ((equal siblings '(16)) + (save-excursion + (when (org-up-heading-safe) + (org-fold-show-subtree) + (run-hook-with-args 'org-cycle-hook 'subtree)))) + (t (org-fold-show-set-visibility 'lineage)))) + +;;; Make isearch search in some text hidden via text propertoes + +(defun org-fold--isearch-reveal (&rest _) + "Reveal text at POS found by isearch." + (org-fold-show-set-visibility 'isearch)) + +;;; Handling changes in folded elements + +(defun org-fold--extend-changed-region (from to) + "Consider folded regions in the next/previous line when fixing +region visibility. +This function is intended to be used as a member of +`org-fold-core-extend-changed-region-functions'." + ;; If the edit is done in the first line of a folded drawer/block, + ;; the folded text is only starting from the next line and needs to + ;; be checked. + (setq to (save-excursion (goto-char to) (line-beginning-position 2))) + ;; If the ":END:" line of the drawer is deleted, the folded text is + ;; only ending at the previous line and needs to be checked. + (setq from (save-excursion (goto-char from) (line-beginning-position 0))) + (cons from to)) + +(defun org-fold--reveal-outline-maybe (region _) + "Reveal folded outline in REGION when needed. + +This function is intended to be used as :fragile property of +`org-fold-outline' spec. See `org-fold-core--specs' for details." + (save-match-data + (save-excursion + (goto-char (car region)) + ;; The line before beginning of the fold should be either a + ;; headline or a list item. + (backward-char) + (beginning-of-line) + ;; Make sure that headline is not partially hidden + (unless (org-fold-folded-p nil 'headline) (org-fold-region (max (point-min) (1- (point))) (line-end-position) nil 'headline)) + ;; Check the validity of headline + (unless (let ((case-fold-search t)) + (looking-at (rx-to-string `(or (regex ,(org-item-re)) + (regex ,org-outline-regexp-bol))))) ; the match-data will be used later + t)))) + +(defun org-fold--reveal-drawer-or-block-maybe (region spec) + "Reveal folded drawer/block (according to SPEC) in REGION when needed. + +This function is intended to be used as :fragile property of +`org-fold-drawer' or `org-fold-block' spec." + (let ((begin-re (cond + ((eq spec (org-fold-core-get-folding-spec-from-alias 'drawer)) + org-drawer-regexp) + ;; Group one below contains the type of the block. + ((eq spec (org-fold-core-get-folding-spec-from-alias 'block)) + (rx bol (zero-or-more (any " " "\t")) + "#+begin" + (or ":" + (seq "_" + (group (one-or-more (not (syntax whitespace)))))))))) + ;; To be determined later. May depend on `begin-re' match (i.e. for blocks). + end-re) + (save-match-data ; we should not clobber match-data in after-change-functions + (let ((fold-begin (car region)) + (fold-end (cdr region))) + (let (unfold?) + (catch :exit + ;; The line before folded text should be beginning of + ;; the drawer/block. + (save-excursion + (goto-char fold-begin) + ;; The line before beginning of the fold should be the + ;; first line of the drawer/block. + (backward-char) + (beginning-of-line) + (unless (let ((case-fold-search t)) + (looking-at begin-re)) ; the match-data will be used later + (throw :exit (setq unfold? t)))) + ;; Set `end-re' for the current drawer/block. + (setq end-re + (cond + ((eq spec (org-fold-core-get-folding-spec-from-alias 'drawer)) + org-property-end-re) + ((eq spec (org-fold-core-get-folding-spec-from-alias 'block)) + (let ((block-type (match-string 1))) ; the last match is from `begin-re' + (concat (rx bol (zero-or-more (any " " "\t")) "#+end") + (if block-type + (concat "_" + (regexp-quote block-type) + (rx (zero-or-more (any " " "\t")) eol)) + (rx (opt ":") (zero-or-more (any " " "\t")) eol))))))) + ;; The last line of the folded text should match `end-re'. + (save-excursion + (goto-char fold-end) + (beginning-of-line) + (unless (let ((case-fold-search t)) + (looking-at end-re)) + (throw :exit (setq unfold? t)))) + ;; There should be no `end-re' or + ;; `org-outline-regexp-bol' anywhere in the + ;; drawer/block body. + (save-excursion + (goto-char fold-begin) + (when (save-excursion + (let ((case-fold-search t)) + (re-search-forward (rx-to-string `(or (regex ,end-re) + (regex ,org-outline-regexp-bol))) + (max (point) + (1- (save-excursion + (goto-char fold-end) + (line-beginning-position)))) + t))) + (throw :exit (setq unfold? t))))) + unfold?))))) + +;; Catching user edits inside invisible text +(defun org-fold-check-before-invisible-edit--overlays (kind) + "Check if editing KIND is dangerous with invisible text around. +The detailed reaction depends on the user option +`org-fold-catch-invisible-edits'." + ;; First, try to get out of here as quickly as possible, to reduce overhead + (when (and org-fold-catch-invisible-edits + (or (not (boundp 'visible-mode)) (not visible-mode)) + (or (get-char-property (point) 'invisible) + (get-char-property (max (point-min) (1- (point))) 'invisible))) + ;; OK, we need to take a closer look. Do not consider + ;; invisibility obtained through text properties (e.g., link + ;; fontification), as it cannot be toggled. + (let* ((invisible-at-point + (pcase (get-char-property-and-overlay (point) 'invisible) + (`(,_ . ,(and (pred overlayp) o)) o))) + ;; Assume that point cannot land in the middle of an + ;; overlay, or between two overlays. + (invisible-before-point + (and (not invisible-at-point) + (not (bobp)) + (pcase (get-char-property-and-overlay (1- (point)) 'invisible) + (`(,_ . ,(and (pred overlayp) o)) o)))) + (border-and-ok-direction + (or + ;; Check if we are acting predictably before invisible + ;; text. + (and invisible-at-point + (memq kind '(insert delete-backward))) + ;; Check if we are acting predictably after invisible text + ;; This works not well, and I have turned it off. It seems + ;; better to always show and stop after invisible text. + ;; (and (not invisible-at-point) invisible-before-point + ;; (memq kind '(insert delete))) + ))) + (when (or invisible-at-point invisible-before-point) + (when (eq org-fold-catch-invisible-edits 'error) + (user-error "Editing in invisible areas is prohibited, make them visible first")) + (if (and org-custom-properties-overlays + (y-or-n-p "Display invisible properties in this buffer? ")) + (org-toggle-custom-properties-visibility) + ;; Make the area visible + (save-excursion + (when invisible-before-point + (goto-char + (previous-single-char-property-change (point) 'invisible))) + ;; Remove whatever overlay is currently making yet-to-be + ;; edited text invisible. Also remove nested invisibility + ;; related overlays. + (delete-overlay (or invisible-at-point invisible-before-point)) + (let ((origin (if invisible-at-point (point) (1- (point))))) + (while (pcase (get-char-property-and-overlay origin 'invisible) + (`(,_ . ,(and (pred overlayp) o)) + (delete-overlay o) + t))))) + (cond + ((eq org-fold-catch-invisible-edits 'show) + ;; That's it, we do the edit after showing + (message + "Unfolding invisible region around point before editing") + (sit-for 1)) + ((and (eq org-fold-catch-invisible-edits 'smart) + border-and-ok-direction) + (message "Unfolding invisible region around point before editing")) + (t + ;; Don't do the edit, make the user repeat it in full visibility + (user-error "Edit in invisible region aborted, repeat to confirm with text visible")))))))) +(defun org-fold-check-before-invisible-edit--text-properties (kind) + "Check if editing KIND is dangerous with invisible text around. +The detailed reaction depends on the user option +`org-fold-catch-invisible-edits'." + ;; First, try to get out of here as quickly as possible, to reduce overhead + (when (and org-fold-catch-invisible-edits + (or (not (boundp 'visible-mode)) (not visible-mode)) + (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. + (let* ((invisible-at-point (org-invisible-p)) + (invisible-before-point + (and (not (bobp)) + (org-invisible-p (1- (point))))) + (border-and-ok-direction + (or + ;; Check if we are acting predictably before invisible + ;; text. + (and invisible-at-point (not invisible-before-point) + (memq kind '(insert delete-backward))) + (and (not invisible-at-point) invisible-before-point + (memq kind '(insert delete)))))) + (when (or invisible-at-point invisible-before-point) + (when (eq org-fold-catch-invisible-edits 'error) + (user-error "Editing in invisible areas is prohibited, make them visible first")) + (if (and org-custom-properties-hidden-p + (y-or-n-p "Display invisible properties in this buffer? ")) + (org-toggle-custom-properties-visibility) + ;; Make the area visible + (save-excursion + (org-fold-show-set-visibility 'local)) + (when invisible-before-point + (org-with-point-at (1- (point)) (org-fold-show-set-visibility 'local))) + (cond + ((eq org-fold-catch-invisible-edits 'show) + ;; That's it, we do the edit after showing + (message + "Unfolding invisible region around point before editing") + (sit-for 1)) + ((and (eq org-fold-catch-invisible-edits 'smart) + border-and-ok-direction) + (message "Unfolding invisible region around point before editing")) + (t + ;; Don't do the edit, make the user repeat it in full visibility + (user-error "Edit in invisible region aborted, repeat to confirm with text visible")))))))) +(defsubst org-fold-check-before-invisible-edit (kind) + "Check if editing KIND is dangerous with invisible text around. +The detailed reaction depends on the user option +`org-fold-catch-invisible-edits'." + ;; First, try to get out of here as quickly as possible, to reduce overhead + (if (eq org-fold-core-style 'text-properties) + (org-fold-check-before-invisible-edit--text-properties kind) + (org-fold-check-before-invisible-edit--overlays kind))) + +(provide 'org-fold) + +;;; org-fold.el ends here ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH 03/35] Separate cycling functions from org.el into new library: org-cycle 2022-01-29 11:37 ` [PATCH 00/35] Merge org-fold feature branch Ihor Radchenko 2022-01-29 11:37 ` [PATCH 01/35] Add org-fold-core: new folding engine Ihor Radchenko 2022-01-29 11:37 ` [PATCH 02/35] Separate folding functions from org.el into new library: org-fold Ihor Radchenko @ 2022-01-29 11:37 ` Ihor Radchenko 2022-01-29 11:37 ` [PATCH 04/35] Remove functions from org.el that are now moved elsewhere Ihor Radchenko ` (32 subsequent siblings) 35 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-01-29 11:37 UTC (permalink / raw) To: Bastien, Kyle Meyer, Nicolas Goaziou, Karl Voit, Christian Heinrich, emacs-orgmode Cc: Ihor Radchenko [-- Attachment #1: Type: text/plain, Size: 150 bytes --] --- lisp/org-cycle.el | 818 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 818 insertions(+) create mode 100644 lisp/org-cycle.el [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0003-Separate-cycling-functions-from-org.el-into-new-libr.patch --] [-- Type: text/x-patch; name="0003-Separate-cycling-functions-from-org.el-into-new-libr.patch", Size: 34925 bytes --] diff --git a/lisp/org-cycle.el b/lisp/org-cycle.el new file mode 100644 index 000000000..df0a3761a --- /dev/null +++ b/lisp/org-cycle.el @@ -0,0 +1,818 @@ +;;; org-cycle.el --- Visibility cycling of Org entries -*- lexical-binding: t; -*- +;; +;; Copyright (C) 2020-2020 Free Software Foundation, Inc. +;; +;; Maintainer: Ihor Radchenko <yantar92 at gmail dot com> +;; Keywords: folding, visibility cycling, invisible text +;; Homepage: https://orgmode.org +;; +;; This file is part of GNU Emacs. +;; +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Commentary: + +;; This file contains code controlling global folding state in buffer +;; and TAB-cycling. + +;;; Code: + +(require 'org-macs) +(require 'org-fold) + +(declare-function org-element-type "org-element" (element)) +(declare-function org-element-property "org-element" (property element)) +(declare-function org-element-lineage "org-element" (datum &optional types with-self)) +(declare-function org-element-at-point "org-element" (&optional pom cached-only)) +(declare-function org-get-tags "org" (&optional pos local fontify)) +(declare-function org-subtree-end-visible-p "org" ()) +(declare-function org-narrow-to-subtree "org" (&optional element)) +(declare-function org-at-property-p "org" ()) +(declare-function org-re-property "org" (property &optional literal allow-null value)) +(declare-function org-item-beginning-re "org" ()) +(declare-function org-at-heading-p "org" (&optional invisible-not-ok)) +(declare-function org-at-item-p "org" ()) +(declare-function org-before-first-heading-p "org" ()) +(declare-function org-back-to-heading "org" (&optional invisible-ok)) +(declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading)) +(declare-function org-entry-end-position "org" ()) +(declare-function org-try-cdlatex-tab "org" ()) +(declare-function org-cycle-level "org" ()) +(declare-function org-table-next-field "org-table" ()) +(declare-function org-table-justify-field-maybe "org-table" (&optional new)) +(declare-function org-inlinetask-at-task-p "org-inlinetask" ()) +(declare-function org-inlinetask-toggle-visibility "org-inlinetask" ()) +(declare-function org-list-get-all-items "org-list" (item struct prevs)) +(declare-function org-list-get-bottom-point "org-list" (struct)) +(declare-function org-list-prevs-alist "org-list" (struct)) +(declare-function org-list-set-item-visibility "org-list" (item struct view)) +(declare-function org-list-search-forward "org-list" (regexp &optional bound noerror)) +(declare-function org-list-has-child-p "org-list" (item struct)) +(declare-function org-list-get-item-end-before-blank "org-list" (item struct)) +(declare-function org-list-struct "org-list" ()) +(declare-function org-cycle-item-indentation "org-list" ()) + +(declare-function outline-previous-heading "outline" ()) +(declare-function outline-next-heading "outline" ()) +(declare-function outline-end-of-heading "outline" ()) +(declare-function outline-up-heading "outline" (arg &optional invisible-ok)) + +(defvar org-drawer-regexp) +(defvar org-odd-levels-only) +(defvar org-startup-folded) +(defvar org-archive-tag) +(defvar org-cycle-include-plain-lists) +(defvar org-outline-regexp-bol) + +(defvar-local org-cycle-global-status nil) +(put 'org-cycle-global-status 'org-state t) +(defvar-local org-cycle-subtree-status nil) +(put 'org-cycle-subtree-status 'org-state t) + +;;;; Customisation: + + +(defgroup org-cycle nil + "Options concerning visibility cycling in Org mode." + :tag "Org Cycle" + :group 'org-structure) + +(defcustom org-cycle-skip-children-state-if-no-children t + "Non-nil means skip CHILDREN state in entries that don't have any." + :group 'org-cycle + :type 'boolean) + +(defcustom org-cycle-max-level nil + "Maximum level which should still be subject to visibility cycling. +Levels higher than this will, for cycling, be treated as text, not a headline. +When `org-odd-levels-only' is set, a value of N in this variable actually +means 2N-1 stars as the limiting headline. +When nil, cycle all levels. +Note that the limiting level of cycling is also influenced by +`org-inlinetask-min-level'. When `org-cycle-max-level' is not set but +`org-inlinetask-min-level' is, cycling will be limited to levels one less +than its value." + :group 'org-cycle + :type '(choice + (const :tag "No limit" nil) + (integer :tag "Maximum level"))) + +(defcustom org-cycle-hide-block-startup nil + "Non-nil means entering Org mode will fold all blocks. +This can also be set in on a per-file basis with + +#+STARTUP: hideblocks +#+STARTUP: showblocks" + :group 'org-startup + :group 'org-cycle + :type 'boolean) + +(defcustom org-cycle-global-at-bob nil + "Cycle globally if cursor is at beginning of buffer and not at a headline. + +This makes it possible to do global cycling without having to use `S-TAB' +or `\\[universal-argument] TAB'. For this special case to work, the first \ +line of the buffer +must not be a headline -- it may be empty or some other text. + +When used in this way, `org-cycle-hook' is disabled temporarily to make +sure the cursor stays at the beginning of the buffer. + +When this option is nil, don't do anything special at the beginning of +the buffer." + :group 'org-cycle + :type 'boolean) + +(defcustom org-cycle-level-after-item/entry-creation t + "Non-nil means cycle entry level or item indentation in new empty entries. + +When the cursor is at the end of an empty headline, i.e., with only stars +and maybe a TODO keyword, TAB will then switch the entry to become a child, +and then all possible ancestor states, before returning to the original state. +This makes data entry extremely fast: M-RET to create a new headline, +on TAB to make it a child, two or more tabs to make it a (grand-)uncle. + +When the cursor is at the end of an empty plain list item, one TAB will +make it a subitem, two or more tabs will back up to make this an item +higher up in the item hierarchy." + :group 'org-cycle + :type 'boolean) + +(defcustom org-cycle-emulate-tab t + "Where should `org-cycle' emulate TAB. +nil Never +white Only in completely white lines +whitestart Only at the beginning of lines, before the first non-white char +t Everywhere except in headlines +exc-hl-bol Everywhere except at the start of a headline +If TAB is used in a place where it does not emulate TAB, the current subtree +visibility is cycled." + :group 'org-cycle + :type '(choice (const :tag "Never" nil) + (const :tag "Only in completely white lines" white) + (const :tag "Before first char in a line" whitestart) + (const :tag "Everywhere except in headlines" t) + (const :tag "Everywhere except at bol in headlines" exc-hl-bol))) + +(defcustom org-cycle-separator-lines 2 + "Number of empty lines needed to keep an empty line between collapsed trees. +If you leave an empty line between the end of a subtree and the following +headline, this empty line is hidden when the subtree is folded. +Org mode will leave (exactly) one empty line visible if the number of +empty lines is equal or larger to the number given in this variable. +So the default 2 means at least 2 empty lines after the end of a subtree +are needed to produce free space between a collapsed subtree and the +following headline. + +If the number is negative, and the number of empty lines is at least -N, +all empty lines are shown. + +Special case: when 0, never leave empty lines in collapsed view." + :group 'org-cycle + :type 'integer) +(put 'org-cycle-separator-lines 'safe-local-variable 'integerp) + +(defcustom org-cycle-pre-hook nil + "Hook that is run before visibility cycling is happening. +The function(s) in this hook must accept a single argument which indicates +the new state that will be set right after running this hook. The +argument is a symbol. Before a global state change, it can have the values +`overview', `content', or `all'. Before a local state change, it can have +the values `folded', `children', or `subtree'." + :group 'org-cycle + :type 'hook) + +(defcustom org-cycle-hook '(org-cycle-hide-archived-subtrees + org-cycle-show-empty-lines + org-cycle-optimize-window-after-visibility-change) + "Hook that is run after `org-cycle' has changed the buffer visibility. +The function(s) in this hook must accept a single argument which indicates +the new state that was set by the most recent `org-cycle' command. The +argument is a symbol. After a global state change, it can have the values +`overview', `contents', or `all'. After a local state change, it can have +the values `folded', `children', or `subtree'." + :group 'org-cycle + :package-version '(Org . "9.4") + :type 'hook) + +(defcustom org-cycle-open-archived-trees nil + "Non-nil means `org-cycle' will open archived trees. +An archived tree is a tree marked with the tag ARCHIVE. +When nil, archived trees will stay folded. You can still open them with +normal outline commands like `show-all', but not with the cycling commands." + :group 'org-archive + :group 'org-cycle + :type 'boolean) + +(defvar org-cycle-tab-first-hook nil + "Hook for functions to attach themselves to TAB. +See `org-ctrl-c-ctrl-c-hook' for more information. +This hook runs as the first action when TAB is pressed, even before +`org-cycle' messes around with the `outline-regexp' to cater for +inline tasks and plain list item folding. +If any function in this hook returns t, any other actions that +would have been caused by TAB (such as table field motion or visibility +cycling) will not occur.") + +;;;; Implementation: + +(defun org-cycle-hide-drawers (state) + "Re-hide all drawers after a visibility state change. +STATE should be one of the symbols listed in the docstring of +`org-cycle-hook'." + (when (derived-mode-p 'org-mode) + (cond ((not (memq state '(overview folded contents))) + (let* ((global? (eq state 'all)) + (beg (if global? (point-min) (line-beginning-position))) + (end (cond (global? (point-max)) + ((eq state 'children) (org-entry-end-position)) + (t (save-excursion (org-end-of-subtree t t)))))) + (if (not global?) + (org-fold--hide-drawers beg end) + ;; Delay folding drawers inside folded subtrees until + ;; first unfold. + (add-hook 'org-fold-core-first-unfold-functions + #'org-fold--hide-drawers)))) + ((memq state '(overview contents)) + ;; Hide drawers before first heading. + (let ((beg (point-min)) + (end (save-excursion + (goto-char (point-min)) + (if (org-before-first-heading-p) + (org-entry-end-position) + (point-min))))) + (when (< beg end) + (org-fold--hide-drawers beg end))))))) + +;;;###autoload +(defun org-cycle (&optional arg) + "TAB-action and visibility cycling for Org mode. + +This is the command invoked in Org mode by the `TAB' key. Its main +purpose is outline visibility cycling, but it also invokes other actions +in special contexts. + +When this function is called with a `\\[universal-argument]' prefix, rotate \ +the entire +buffer through 3 states (global cycling) + 1. OVERVIEW: Show only top-level headlines. + 2. CONTENTS: Show all headlines of all levels, but no body text. + 3. SHOW ALL: Show everything. + +With a `\\[universal-argument] \\[universal-argument]' prefix argument, \ +switch to the startup visibility, +determined by the variable `org-startup-folded', and by any VISIBILITY +properties in the buffer. + +With a `\\[universal-argument] \\[universal-argument] \ +\\[universal-argument]' prefix argument, show the entire buffer, including +any drawers. + +When inside a table, re-align the table and move to the next field. + +When point is at the beginning of a headline, rotate the subtree started +by this line through 3 different states (local cycling) + 1. FOLDED: Only the main headline is shown. + 2. CHILDREN: The main headline and the direct children are shown. + From this state, you can move to one of the children + and zoom in further. + 3. SUBTREE: Show the entire subtree, including body text. +If there is no subtree, switch directly from CHILDREN to FOLDED. + +When point is at the beginning of an empty headline and the variable +`org-cycle-level-after-item/entry-creation' is set, cycle the level +of the headline by demoting and promoting it to likely levels. This +speeds up creation document structure by pressing `TAB' once or several +times right after creating a new headline. + +When there is a numeric prefix, go up to a heading with level ARG, do +a `show-subtree' and return to the previous cursor position. If ARG +is negative, go up that many levels. + +When point is not at the beginning of a headline, execute the global +binding for `TAB', which is re-indenting the line. See the option +`org-cycle-emulate-tab' for details. + +As a special case, if point is at the very beginning of the buffer, if +there is no headline there, and if the variable `org-cycle-global-at-bob' +is non-nil, this function acts as if called with prefix argument \ +\(`\\[universal-argument] TAB', +same as `S-TAB') also when called without prefix argument." + (interactive "P") + (org-load-modules-maybe) + (unless (or (run-hook-with-args-until-success 'org-cycle-tab-first-hook) + (and org-cycle-level-after-item/entry-creation + (or (org-cycle-level) + (org-cycle-item-indentation)))) + (let* ((limit-level + (or org-cycle-max-level + (and (boundp 'org-inlinetask-min-level) + org-inlinetask-min-level + (1- org-inlinetask-min-level)))) + (nstars + (and limit-level + (if org-odd-levels-only + (1- (* 2 limit-level)) + limit-level))) + (org-outline-regexp + (format "\\*%s " (if nstars (format "\\{1,%d\\}" nstars) "+")))) + (cond + ((equal arg '(16)) + (setq last-command 'dummy) + (org-cycle-set-startup-visibility) + (org-unlogged-message "Startup visibility, plus VISIBILITY properties")) + ((equal arg '(64)) + (org-fold-show-all) + (org-unlogged-message "Entire buffer visible, including drawers")) + ((equal arg '(4)) (org-cycle-internal-global)) + ;; Show-subtree, ARG levels up from here. + ((integerp arg) + (save-excursion + (org-back-to-heading) + (outline-up-heading (if (< arg 0) (- arg) + (- (funcall outline-level) arg))) + (org-fold-show-subtree))) + ;; Global cycling at BOB: delegate to `org-cycle-internal-global'. + ((and org-cycle-global-at-bob + (bobp) + (not (looking-at org-outline-regexp))) + (let ((org-cycle-hook + (remq 'org-cycle-optimize-window-after-visibility-change + org-cycle-hook))) + (org-cycle-internal-global))) + ;; Try CDLaTeX TAB completion. + ((org-try-cdlatex-tab)) + ;; Inline task: delegate to `org-inlinetask-toggle-visibility'. + ((and (featurep 'org-inlinetask) + (org-inlinetask-at-task-p) + (or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol)))) + (org-inlinetask-toggle-visibility)) + (t + (let ((pos (point)) + (element (org-element-at-point))) + (cond + ;; Try toggling visibility for block at point. + ((org-fold-hide-block-toggle nil t element)) + ;; Try toggling visibility for drawer at point. + ((org-fold-hide-drawer-toggle nil t element)) + ;; Table: enter it or move to the next field. + ((and (org-match-line "[ \t]*[|+]") + (org-element-lineage element '(table) t)) + (if (and (eq 'table (org-element-type element)) + (eq 'table.el (org-element-property :type element))) + (message (substitute-command-keys "\\<org-mode-map>\ +Use `\\[org-edit-special]' to edit table.el tables")) + (org-table-justify-field-maybe) + (call-interactively #'org-table-next-field))) + ((run-hook-with-args-until-success + 'org-tab-after-check-for-table-hook)) + ;; At an item/headline: delegate to `org-cycle-internal-local'. + ((and (or (and org-cycle-include-plain-lists + (let ((item (org-element-lineage element + '(item plain-list) + t))) + (and item + (= (line-beginning-position) + (org-element-property :post-affiliated + item))))) + (org-match-line org-outline-regexp)) + (or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol)))) + (org-cycle-internal-local)) + ;; From there: TAB emulation and template completion. + (buffer-read-only (org-back-to-heading)) + ((run-hook-with-args-until-success + 'org-tab-after-check-for-cycling-hook)) + ((run-hook-with-args-until-success + 'org-tab-before-tab-emulation-hook)) + ((and (eq org-cycle-emulate-tab 'exc-hl-bol) + (or (not (bolp)) + (not (looking-at org-outline-regexp)))) + (call-interactively (global-key-binding (kbd "TAB")))) + ((or (eq org-cycle-emulate-tab t) + (and (memq org-cycle-emulate-tab '(white whitestart)) + (save-excursion (beginning-of-line 1) (looking-at "[ \t]*")) + (or (and (eq org-cycle-emulate-tab 'white) + (= (match-end 0) (point-at-eol))) + (and (eq org-cycle-emulate-tab 'whitestart) + (>= (match-end 0) pos))))) + (call-interactively (global-key-binding (kbd "TAB")))) + (t + (save-excursion + (org-back-to-heading) + (org-cycle)))))))))) + +(defun org-cycle-force-archived () + "Cycle subtree even if it is archived." + (interactive) + (setq this-command 'org-cycle) + (let ((org-cycle-open-archived-trees t)) + (call-interactively 'org-cycle))) + +(defun org-cycle-internal-global () + "Do the global cycling action." + ;; Hack to avoid display of messages for .org attachments in Gnus + (let ((ga (string-match-p "\\*fontification" (buffer-name)))) + (cond + ((and (eq last-command this-command) + (eq org-cycle-global-status 'overview)) + ;; We just created the overview - now do table of contents + ;; This can be slow in very large buffers, so indicate action + (run-hook-with-args 'org-cycle-pre-hook 'contents) + (unless ga (org-unlogged-message "CONTENTS...")) + (org-cycle-content) + (unless ga (org-unlogged-message "CONTENTS...done")) + (setq org-cycle-global-status 'contents) + (run-hook-with-args 'org-cycle-hook 'contents)) + + ((and (eq last-command this-command) + (eq org-cycle-global-status 'contents)) + ;; We just showed the table of contents - now show everything + (run-hook-with-args 'org-cycle-pre-hook 'all) + (org-fold-show-all '(headings blocks)) + (unless ga (org-unlogged-message "SHOW ALL")) + (setq org-cycle-global-status 'all) + (run-hook-with-args 'org-cycle-hook 'all)) + + (t + ;; Default action: go to overview + (run-hook-with-args 'org-cycle-pre-hook 'overview) + (org-cycle-overview) + (unless ga (org-unlogged-message "OVERVIEW")) + (setq org-cycle-global-status 'overview) + (run-hook-with-args 'org-cycle-hook 'overview))))) + +(defun org-cycle-internal-local () + "Do the local cycling action." + (let ((goal-column 0) eoh eol eos has-children children-skipped struct) + ;; First, determine end of headline (EOH), end of subtree or item + ;; (EOS), and if item or heading has children (HAS-CHILDREN). + (save-excursion + (if (org-at-item-p) + (progn + (beginning-of-line) + (setq struct (org-list-struct)) + (setq eoh (point-at-eol)) + (setq eos (org-list-get-item-end-before-blank (point) struct)) + (setq has-children (org-list-has-child-p (point) struct))) + (org-back-to-heading) + (setq eoh (save-excursion (outline-end-of-heading) (point))) + (setq eos (save-excursion + (org-end-of-subtree t t) + (unless (eobp) (forward-char -1)) + (point))) + (setq has-children + (or + (save-excursion + (let ((level (funcall outline-level))) + (outline-next-heading) + (and (org-at-heading-p) + (> (funcall outline-level) level)))) + (and (eq org-cycle-include-plain-lists 'integrate) + (save-excursion + (org-list-search-forward (org-item-beginning-re) eos t)))))) + ;; Determine end invisible part of buffer (EOL) + (beginning-of-line 2) + (if (eq org-fold-core-style 'text-properties) + (while (and (not (eobp)) ;this is like `next-line' + (org-fold-folded-p (1- (point)))) + (goto-char (org-fold-next-visibility-change nil nil t)) + (and (eolp) (beginning-of-line 2))) + (while (and (not (eobp)) ;this is like `next-line' + (get-char-property (1- (point)) 'invisible)) + (goto-char (next-single-char-property-change (point) 'invisible)) + (and (eolp) (beginning-of-line 2)))) + (setq eol (point))) + ;; Find out what to do next and set `this-command' + (cond + ((= eos eoh) + ;; Nothing is hidden behind this heading + (unless (org-before-first-heading-p) + (run-hook-with-args 'org-cycle-pre-hook 'empty)) + (org-unlogged-message "EMPTY ENTRY") + (setq org-cycle-subtree-status nil) + (save-excursion + (goto-char eos) + (org-with-limited-levels + (outline-next-heading)) + (when (org-invisible-p) (org-fold-heading nil)))) + ((and (or (>= eol eos) + (save-excursion (goto-char eol) (skip-chars-forward "[:space:]" eos) (= (point) eos))) + (or has-children + (not (setq children-skipped + org-cycle-skip-children-state-if-no-children)))) + ;; Entire subtree is hidden in one line: children view + (unless (org-before-first-heading-p) + (org-with-limited-levels + (run-hook-with-args 'org-cycle-pre-hook 'children))) + (if (org-at-item-p) + (org-list-set-item-visibility (point-at-bol) struct 'children) + (org-fold-show-entry) + (org-with-limited-levels (org-fold-show-children)) + (org-fold-show-set-visibility 'tree) + ;; Fold every list in subtree to top-level items. + (when (eq org-cycle-include-plain-lists 'integrate) + (save-excursion + (org-back-to-heading) + (while (org-list-search-forward (org-item-beginning-re) eos t) + (beginning-of-line 1) + (let* ((struct (org-list-struct)) + (prevs (org-list-prevs-alist struct)) + (end (org-list-get-bottom-point struct))) + (dolist (e (org-list-get-all-items (point) struct prevs)) + (org-list-set-item-visibility e struct 'folded)) + (goto-char (if (< end eos) end eos))))))) + (org-unlogged-message "CHILDREN") + (save-excursion + (goto-char eos) + (org-with-limited-levels + (outline-next-heading)) + (when (and + ;; Subtree does not end at the end of visible section of the + ;; buffer. + (< (point) (point-max)) + (org-invisible-p)) + ;; Reveal the following heading line. + (org-fold-heading nil))) + (setq org-cycle-subtree-status 'children) + (unless (org-before-first-heading-p) + (run-hook-with-args 'org-cycle-hook 'children))) + ((or children-skipped + (and (eq last-command this-command) + (eq org-cycle-subtree-status 'children))) + ;; We just showed the children, or no children are there, + ;; now show everything. + (unless (org-before-first-heading-p) + (run-hook-with-args 'org-pre-cycle-hook 'subtree)) + (org-fold-region eoh eos nil 'outline) + (org-unlogged-message + (if children-skipped "SUBTREE (NO CHILDREN)" "SUBTREE")) + (setq org-cycle-subtree-status 'subtree) + (unless (org-before-first-heading-p) + (run-hook-with-args 'org-cycle-hook 'subtree))) + (t + ;; Default action: hide the subtree. + (run-hook-with-args 'org-cycle-pre-hook 'folded) + (org-fold-region eoh eos t 'outline) + (org-unlogged-message "FOLDED") + (setq org-cycle-subtree-status 'folded) + (unless (org-before-first-heading-p) + (run-hook-with-args 'org-cycle-hook 'folded)))))) + +;;;###autoload +(defun org-cycle-global (&optional arg) + "Cycle the global visibility. For details see `org-cycle'. +With `\\[universal-argument]' prefix ARG, switch to startup visibility. +With a numeric prefix, show all headlines up to that level." + (interactive "P") + (cond + ((integerp arg) + (org-cycle-content arg) + (setq org-cycle-global-status 'contents)) + ((equal arg '(4)) + (org-cycle-set-startup-visibility) + (org-unlogged-message "Startup visibility, plus VISIBILITY properties.")) + (t + (org-cycle '(4))))) + +(defun org-cycle-set-startup-visibility () + "Set the visibility required by startup options and properties." + (cond + ((eq org-startup-folded t) + (org-cycle-overview)) + ((eq org-startup-folded 'content) + (org-cycle-content)) + ((eq org-startup-folded 'show2levels) + (org-cycle-content 2)) + ((eq org-startup-folded 'show3levels) + (org-cycle-content 3)) + ((eq org-startup-folded 'show4levels) + (org-cycle-content 4)) + ((eq org-startup-folded 'show5levels) + (org-cycle-content 5)) + ((or (eq org-startup-folded 'showeverything) + (eq org-startup-folded nil)) + (org-fold-show-all))) + (unless (eq org-startup-folded 'showeverything) + (when org-cycle-hide-block-startup (org-fold-hide-block-all)) + (org-cycle-set-visibility-according-to-property) + (org-cycle-hide-archived-subtrees 'all) + (org-cycle-hide-drawers 'all) + (org-cycle-show-empty-lines t))) + +(defun org-cycle-set-visibility-according-to-property () + "Switch subtree visibility according to VISIBILITY property." + (interactive) + (let ((regexp (org-re-property "VISIBILITY"))) + (org-with-point-at 1 + (while (re-search-forward regexp nil t) + (let ((state (match-string 3))) + (if (not (org-at-property-p)) (outline-next-heading) + (save-excursion + (org-back-to-heading t) + (org-fold-subtree t) + (org-fold-reveal) + (pcase state + ("folded" + (org-fold-subtree t)) + ("children" + (org-fold-show-hidden-entry) + (org-fold-show-children)) + ("content" + (save-excursion + (save-restriction + (org-narrow-to-subtree) + (org-cycle-content)))) + ((or "all" "showall") + (org-fold-show-subtree)) + (_ nil))) + (org-end-of-subtree))))))) + +(defun org-cycle-overview--overlays () + "Switch to overview mode, showing only top-level headlines." + (interactive) + (org-fold-show-all '(headings drawers)) + (save-excursion + (goto-char (point-min)) + (when (re-search-forward org-outline-regexp-bol nil t) + (let* ((last (line-end-position)) + (level (- (match-end 0) (match-beginning 0) 1)) + (regexp (format "^\\*\\{1,%d\\} " level))) + (while (re-search-forward regexp nil :move) + (org-fold-region last (line-end-position 0) t 'outline) + (setq last (line-end-position)) + (setq level (- (match-end 0) (match-beginning 0) 1)) + (setq regexp (format "^\\*\\{1,%d\\} " level))) + (org-fold-region last (point) t 'outline))))) +(defun org-cycle-overview--text-properties () + "Switch to overview mode, showing only top-level headlines." + (interactive) + (save-excursion + (goto-char (point-min)) + ;; Hide top-level drawer. + (save-restriction + (narrow-to-region (point-min) (or (re-search-forward org-outline-regexp-bol nil t) (point-max))) + (org-fold-hide-drawer-all)) + (goto-char (point-min)) + (when (re-search-forward org-outline-regexp-bol nil t) + (let* ((last (line-end-position)) + (level (- (match-end 0) (match-beginning 0) 1)) + (regexp (format "^\\*\\{1,%d\\} " level))) + (while (re-search-forward regexp nil :move) + (org-fold-region last (line-end-position 0) t 'outline) + (setq last (line-end-position)) + (setq level (- (match-end 0) (match-beginning 0) 1)) + (setq regexp (format "^\\*\\{1,%d\\} " level))) + (org-fold-region last (point) t 'outline))))) +(defun org-cycle-overview () + "Switch to overview mode, showing only top-level headlines." + (interactive) + (if (eq org-fold-core-style 'text-properties) + (org-cycle-overview--text-properties) + (org-cycle-overview--overlays))) + +(defun org-cycle-content--text-properties (&optional arg) + "Show all headlines in the buffer, like a table of contents. +With numerical argument N, show content up to level N." + (interactive "p") + (org-fold-show-all '(headings)) + (save-excursion + (goto-char (point-min)) + ;; Hide top-level drawer. + (save-restriction + (narrow-to-region (point-min) (or (re-search-forward org-outline-regexp-bol nil t) (point-max))) + (org-fold-hide-drawer-all)) + (goto-char (point-max)) + (let ((regexp (if (and (wholenump arg) (> arg 0)) + (format "^\\*\\{1,%d\\} " arg) + "^\\*+ ")) + (last (point))) + (while (re-search-backward regexp nil t) + (org-fold-region (line-end-position) last t 'outline) + (setq last (line-end-position 0)))))) +(defun org-cycle-content--overlays (&optional arg) + "Show all headlines in the buffer, like a table of contents. +With numerical argument N, show content up to level N." + (interactive "p") + (org-fold-show-all '(headings drawers)) + (save-excursion + (goto-char (point-max)) + (let ((regexp (if (and (wholenump arg) (> arg 0)) + (format "^\\*\\{1,%d\\} " arg) + "^\\*+ ")) + (last (point))) + (while (re-search-backward regexp nil t) + (org-fold-region (line-end-position) last t 'outline) + (setq last (line-end-position 0)))))) +(defun org-cycle-content (&optional arg) + "Show all headlines in the buffer, like a table of contents. +With numerical argument N, show content up to level N." + (interactive "p") + (if (eq org-fold-core-style 'text-properties) + (org-cycle-content--text-properties arg) + (org-cycle-content--overlays arg))) + +(defvar org-cycle-scroll-position-to-restore nil + "Temporarily store scroll position to restore.") +(defun org-cycle-optimize-window-after-visibility-change (state) + "Adjust the window after a change in outline visibility. +This function is the default value of the hook `org-cycle-hook'." + (when (get-buffer-window (current-buffer)) + (let ((repeat (eq last-command this-command))) + (unless repeat + (setq org-cycle-scroll-position-to-restore nil)) + (cond + ((eq state 'content) nil) + ((eq state 'all) nil) + ((and org-cycle-scroll-position-to-restore repeat + (eq state 'folded)) + (set-window-start nil org-cycle-scroll-position-to-restore)) + ((eq state 'folded) nil) + ((eq state 'children) + (setq org-cycle-scroll-position-to-restore (window-start)) + (or (org-subtree-end-visible-p) (recenter 1))) + ((eq state 'subtree) + (unless repeat + (setq org-cycle-scroll-position-to-restore (window-start))) + (or (org-subtree-end-visible-p) (recenter 1))))))) + +(defun org-cycle-show-empty-lines (state) + "Show empty lines above all visible headlines. +The region to be covered depends on STATE when called through +`org-cycle-hook'. Lisp program can use t for STATE to get the +entire buffer covered. Note that an empty line is only shown if there +are at least `org-cycle-separator-lines' empty lines before the headline." + (when (/= org-cycle-separator-lines 0) + (save-excursion + (let* ((n (abs org-cycle-separator-lines)) + (re (cond + ((= n 1) "\\(\n[ \t]*\n\\*+\\) ") + ((= n 2) "^[ \t]*\\(\n[ \t]*\n\\*+\\) ") + (t (let ((ns (number-to-string (- n 2)))) + (concat "^\\(?:[ \t]*\n\\)\\{" ns "," ns "\\}" + "[ \t]*\\(\n[ \t]*\n\\*+\\) "))))) + beg end) + (cond + ((memq state '(overview contents t)) + (setq beg (point-min) end (point-max))) + ((memq state '(children folded)) + (setq beg (point) + end (progn (org-end-of-subtree t t) + (line-beginning-position 2))))) + (when beg + (goto-char beg) + (while (re-search-forward re end t) + (unless (org-invisible-p (match-end 1)) + (let ((e (match-end 1)) + (b (if (>= org-cycle-separator-lines 0) + (match-beginning 1) + (save-excursion + (goto-char (match-beginning 0)) + (skip-chars-backward " \t\n") + (line-end-position))))) + (org-fold-region b e nil 'outline)))))))) + ;; Never hide empty lines at the end of the file. + (save-excursion + (goto-char (point-max)) + (outline-previous-heading) + (outline-end-of-heading) + (when (and (looking-at "[ \t\n]+") + (= (match-end 0) (point-max))) + (org-fold-region (point) (match-end 0) nil 'outline)))) + +(defun org-cycle-hide-archived-subtrees (state) + "Re-hide all archived subtrees after a visibility state change. +STATE should be one of the symbols listed in the docstring of +`org-cycle-hook'." + (when (and (not org-cycle-open-archived-trees) + (not (memq state '(overview folded)))) + (let ((globalp (memq state '(contents all)))) + (if globalp + ;; Delay hiding inside folded subtrees until first unfold. + (add-hook 'org-fold-core-first-unfold-functions + #'org-fold-hide-archived-subtrees) + (org-fold-hide-archived-subtrees + (point) + (save-excursion + (org-end-of-subtree t)))) + (when (and (not globalp) + (member org-archive-tag + (org-get-tags nil 'local))) + (message "%s" (substitute-command-keys + "Subtree is archived and stays closed. Use \ +`\\[org-cycle-force-archived]' to cycle it anyway.")))))) + +(provide 'org-cycle) + +;;; org-cycle.el ends here ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH 04/35] Remove functions from org.el that are now moved elsewhere 2022-01-29 11:37 ` [PATCH 00/35] Merge org-fold feature branch Ihor Radchenko ` (2 preceding siblings ...) 2022-01-29 11:37 ` [PATCH 03/35] Separate cycling functions from org.el into new library: org-cycle Ihor Radchenko @ 2022-01-29 11:37 ` Ihor Radchenko 2022-01-29 11:37 ` [PATCH 05/35] Disable native-comp in agenda Ihor Radchenko ` (31 subsequent siblings) 35 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-01-29 11:37 UTC (permalink / raw) To: Bastien, Kyle Meyer, Nicolas Goaziou, Karl Voit, Christian Heinrich, emacs-orgmode Cc: Ihor Radchenko [-- Attachment #1: Type: text/plain, Size: 130 bytes --] --- lisp/org.el | 1272 ++------------------------------------------------- 1 file changed, 40 insertions(+), 1232 deletions(-) [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0004-Remove-functions-from-org.el-that-are-now-moved-else.patch --] [-- Type: text/x-patch; name="0004-Remove-functions-from-org.el-that-are-now-moved-else.patch", Size: 54314 bytes --] diff --git a/lisp/org.el b/lisp/org.el index b3c5f3104..d279edae4 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -1178,90 +1178,6 @@ (defgroup org-structure nil :tag "Org Structure" :group 'org) -(defgroup org-reveal-location nil - "Options about how to make context of a location visible." - :tag "Org Reveal Location" - :group 'org-structure) - -(defcustom org-show-context-detail '((agenda . local) - (bookmark-jump . lineage) - (isearch . lineage) - (default . ancestors)) - "Alist between context and visibility span when revealing a location. - -\\<org-mode-map>Some actions may move point into invisible -locations. As a consequence, Org always exposes a neighborhood -around point. How much is shown depends on the initial action, -or context. Valid contexts are - - agenda when exposing an entry from the agenda - org-goto when using the command `org-goto' (`\\[org-goto]') - occur-tree when using the command `org-occur' (`\\[org-sparse-tree] /') - tags-tree when constructing a sparse tree based on tags matches - link-search when exposing search matches associated with a link - mark-goto when exposing the jump goal of a mark - bookmark-jump when exposing a bookmark location - isearch when exiting from an incremental search - default default for all contexts not set explicitly - -Allowed visibility spans are - - minimal show current headline; if point is not on headline, - also show entry - - local show current headline, entry and next headline - - ancestors show current headline and its direct ancestors; if - point is not on headline, also show entry - - ancestors-full show current subtree and its direct ancestors - - lineage show current headline, its direct ancestors and all - their children; if point is not on headline, also show - entry and first child - - tree show current headline, its direct ancestors and all - their children; if point is not on headline, also show - entry and all children - - canonical show current headline, its direct ancestors along with - their entries and children; if point is not located on - the headline, also show current entry and all children - -As special cases, a nil or t value means show all contexts in -`minimal' or `canonical' view, respectively. - -Some views can make displayed information very compact, but also -make it harder to edit the location of the match. In such -a case, use the command `org-reveal' (`\\[org-reveal]') to show -more context." - :group 'org-reveal-location - :version "26.1" - :package-version '(Org . "9.0") - :type '(choice - (const :tag "Canonical" t) - (const :tag "Minimal" nil) - (repeat :greedy t :tag "Individual contexts" - (cons - (choice :tag "Context" - (const agenda) - (const org-goto) - (const occur-tree) - (const tags-tree) - (const link-search) - (const mark-goto) - (const bookmark-jump) - (const isearch) - (const default)) - (choice :tag "Detail level" - (const minimal) - (const local) - (const ancestors) - (const ancestors-full) - (const lineage) - (const tree) - (const canonical)))))) - (defcustom org-indirect-buffer-display 'other-window "How should indirect tree buffers be displayed? @@ -1453,130 +1369,6 @@ (defcustom org-bookmark-names-plist :group 'org-structure :type 'plist) -(defgroup org-cycle nil - "Options concerning visibility cycling in Org mode." - :tag "Org Cycle" - :group 'org-structure) - -(defcustom org-cycle-skip-children-state-if-no-children t - "Non-nil means skip CHILDREN state in entries that don't have any." - :group 'org-cycle - :type 'boolean) - -(defcustom org-cycle-max-level nil - "Maximum level which should still be subject to visibility cycling. -Levels higher than this will, for cycling, be treated as text, not a headline. -When `org-odd-levels-only' is set, a value of N in this variable actually -means 2N-1 stars as the limiting headline. -When nil, cycle all levels. -Note that the limiting level of cycling is also influenced by -`org-inlinetask-min-level'. When `org-cycle-max-level' is not set but -`org-inlinetask-min-level' is, cycling will be limited to levels one less -than its value." - :group 'org-cycle - :type '(choice - (const :tag "No limit" nil) - (integer :tag "Maximum level"))) - -(defcustom org-hide-block-startup nil - "Non-nil means entering Org mode will fold all blocks. -This can also be set in on a per-file basis with - -#+STARTUP: hideblocks -#+STARTUP: showblocks" - :group 'org-startup - :group 'org-cycle - :type 'boolean) - -(defcustom org-cycle-global-at-bob nil - "Cycle globally if cursor is at beginning of buffer and not at a headline. - -This makes it possible to do global cycling without having to use `S-TAB' -or `\\[universal-argument] TAB'. For this special case to work, the first \ -line of the buffer -must not be a headline -- it may be empty or some other text. - -When used in this way, `org-cycle-hook' is disabled temporarily to make -sure the cursor stays at the beginning of the buffer. - -When this option is nil, don't do anything special at the beginning of -the buffer." - :group 'org-cycle - :type 'boolean) - -(defcustom org-cycle-level-after-item/entry-creation t - "Non-nil means cycle entry level or item indentation in new empty entries. - -When the cursor is at the end of an empty headline, i.e., with only stars -and maybe a TODO keyword, TAB will then switch the entry to become a child, -and then all possible ancestor states, before returning to the original state. -This makes data entry extremely fast: M-RET to create a new headline, -on TAB to make it a child, two or more tabs to make it a (grand-)uncle. - -When the cursor is at the end of an empty plain list item, one TAB will -make it a subitem, two or more tabs will back up to make this an item -higher up in the item hierarchy." - :group 'org-cycle - :type 'boolean) - -(defcustom org-cycle-emulate-tab t - "Where should `org-cycle' emulate TAB. -nil Never -white Only in completely white lines -whitestart Only at the beginning of lines, before the first non-white char -t Everywhere except in headlines -exc-hl-bol Everywhere except at the start of a headline -If TAB is used in a place where it does not emulate TAB, the current subtree -visibility is cycled." - :group 'org-cycle - :type '(choice (const :tag "Never" nil) - (const :tag "Only in completely white lines" white) - (const :tag "Before first char in a line" whitestart) - (const :tag "Everywhere except in headlines" t) - (const :tag "Everywhere except at bol in headlines" exc-hl-bol))) - -(defcustom org-cycle-separator-lines 2 - "Number of empty lines needed to keep an empty line between collapsed trees. -If you leave an empty line between the end of a subtree and the following -headline, this empty line is hidden when the subtree is folded. -Org mode will leave (exactly) one empty line visible if the number of -empty lines is equal or larger to the number given in this variable. -So the default 2 means at least 2 empty lines after the end of a subtree -are needed to produce free space between a collapsed subtree and the -following headline. - -If the number is negative, and the number of empty lines is at least -N, -all empty lines are shown. - -Special case: when 0, never leave empty lines in collapsed view." - :group 'org-cycle - :type 'integer) -(put 'org-cycle-separator-lines 'safe-local-variable 'integerp) - -(defcustom org-pre-cycle-hook nil - "Hook that is run before visibility cycling is happening. -The function(s) in this hook must accept a single argument which indicates -the new state that will be set right after running this hook. The -argument is a symbol. Before a global state change, it can have the values -`overview', `content', or `all'. Before a local state change, it can have -the values `folded', `children', or `subtree'." - :group 'org-cycle - :type 'hook) - -(defcustom org-cycle-hook '(org-cycle-hide-archived-subtrees - org-cycle-hide-drawers - org-cycle-show-empty-lines - org-optimize-window-after-visibility-change) - "Hook that is run after `org-cycle' has changed the buffer visibility. -The function(s) in this hook must accept a single argument which indicates -the new state that was set by the most recent `org-cycle' command. The -argument is a symbol. After a global state change, it can have the values -`overview', `contents', or `all'. After a local state change, it can have -the values `folded', `children', or `subtree'." - :group 'org-cycle - :package-version '(Org . "9.4") - :type 'hook) - (defgroup org-edit-structure nil "Options concerning structure editing in Org mode." :tag "Org Edit Structure" @@ -1703,29 +1495,6 @@ (defcustom org-special-ctrl-o t :group 'org-edit-structure :type 'boolean) -(defcustom org-catch-invisible-edits nil - "Check if in invisible region before inserting or deleting a character. -Valid values are: - -nil Do not check, so just do invisible edits. -error Throw an error and do nothing. -show Make point visible, and do the requested edit. -show-and-error Make point visible, then throw an error and abort the edit. -smart Make point visible, and do insertion/deletion if it is - adjacent to visible text and the change feels predictable. - Never delete a previously invisible character or add in the - middle or right after an invisible region. Basically, this - allows insertion and backward-delete right before ellipses. - FIXME: maybe in this case we should not even show?" - :group 'org-edit-structure - :version "24.1" - :type '(choice - (const :tag "Do not check" nil) - (const :tag "Throw error when trying to edit" error) - (const :tag "Unhide, but do not do the edit" show-and-error) - (const :tag "Show invisible part and do the edit" show) - (const :tag "Be smart and do the right thing" smart))) - (defcustom org-yank-folded-subtrees t "Non-nil means when yanking subtrees, fold them. If the kill is a single subtree, or a sequence of subtrees, i.e. if @@ -1768,7 +1537,6 @@ (defcustom org-M-RET-may-split-line '((default . t)) (const default)) (boolean))))) - (defcustom org-insert-heading-respect-content nil "Non-nil means insert new headings after the current subtree. \\<org-mode-map> @@ -3985,15 +3753,6 @@ (defcustom org-columns-skip-archived-trees t :group 'org-properties :type 'boolean) -(defcustom org-cycle-open-archived-trees nil - "Non-nil means `org-cycle' will open archived trees. -An archived tree is a tree marked with the tag ARCHIVE. -When nil, archived trees will stay folded. You can still open them with -normal outline commands like `show-all', but not with the cycling commands." - :group 'org-archive - :group 'org-cycle - :type 'boolean) - (defcustom org-sparse-tree-open-archived-trees nil "Non-nil means sparse tree construction shows matches in archived trees. When nil, matches in these trees are highlighted, but the trees are kept in @@ -4023,51 +3782,6 @@ (defcustom org-sparse-tree-default-date-type nil :package-version '(Org . "8.3") :group 'org-sparse-trees) -(defun org-cycle-hide-archived-subtrees (state) - "Re-hide all archived subtrees after a visibility state change. -STATE should be one of the symbols listed in the docstring of -`org-cycle-hook'." - (when (and (not org-cycle-open-archived-trees) - (not (memq state '(overview folded)))) - (save-excursion - (let* ((globalp (memq state '(contents all))) - (beg (if globalp (point-min) (point))) - (end (if globalp (point-max) (org-end-of-subtree t)))) - (org-hide-archived-subtrees beg end) - (goto-char beg) - (when (looking-at-p (concat ".*:" org-archive-tag ":")) - (message "%s" (substitute-command-keys - "Subtree is archived and stays closed. Use \ -`\\[org-force-cycle-archived]' to cycle it anyway."))))))) - -(defun org-force-cycle-archived () - "Cycle subtree even if it is archived." - (interactive) - (setq this-command 'org-cycle) - (let ((org-cycle-open-archived-trees t)) - (call-interactively 'org-cycle))) - -(defun org-hide-archived-subtrees (beg end) - "Re-hide all archived subtrees after a visibility state change." - (org-with-wide-buffer - (let ((case-fold-search nil) - (re (concat org-outline-regexp-bol ".*:" org-archive-tag ":"))) - (goto-char beg) - ;; Include headline point is currently on. - (beginning-of-line) - (while (and (< (point) end) (re-search-forward re end t)) - (when (member org-archive-tag (org-get-tags nil t)) - (org-flag-subtree t) - (org-end-of-subtree t)))))) - -(defun org-flag-subtree (flag) - (save-excursion - (org-back-to-heading t) - (org-flag-region (line-end-position) - (progn (org-end-of-subtree t) (point)) - flag - 'outline))) - (defalias 'org-advertized-archive-subtree 'org-archive-subtree) ;; Declare Column View Code @@ -6031,6 +5745,7 @@ (defun org-remove-empty-overlays-at (pos) (overlay-end o)))) (delete-overlay o)))) +;; FIXME: This function is unused. (defun org-show-empty-lines-in-parent () "Move to the parent and re-show empty lines before visible headlines." (save-excursion @@ -6071,826 +5786,11 @@ (defun org-first-headline-recenter () (set-window-start window (line-beginning-position)))))) \f -;;; Visibility (headlines, blocks, drawers) - -;;;; Headlines visibility - -(defun org-show-entry () - "Show the body directly following its heading. -Show the heading too, if it is currently invisible." - (interactive) - (save-excursion - (org-back-to-heading-or-point-min t) - (org-flag-region - (line-end-position 0) - (save-excursion - (if (re-search-forward - (concat "[\r\n]\\(" org-outline-regexp "\\)") nil t) - (match-beginning 1) - (point-max))) - nil - 'outline) - (org-cycle-hide-drawers 'children))) - -(defun org-hide-entry () - "Hide the body directly following its heading." - (interactive) - (save-excursion - (org-back-to-heading-or-point-min t) - (when (org-at-heading-p) (forward-line)) - (org-flag-region - (line-end-position 0) - (save-excursion - (if (re-search-forward - (concat "[\r\n]" org-outline-regexp) nil t) - (line-end-position 0) - (point-max))) - t - 'outline))) - -(defun org-show-children (&optional level) - "Show all direct subheadings of this heading. -Prefix arg LEVEL is how many levels below the current level -should be shown. Default is enough to cause the following -heading to appear." - (interactive "p") - (unless (org-before-first-heading-p) - (save-excursion - (org-with-limited-levels (org-back-to-heading t)) - (let* ((current-level (funcall outline-level)) - (max-level (org-get-valid-level - current-level - (if level (prefix-numeric-value level) 1))) - (end (save-excursion (org-end-of-subtree t t))) - (regexp-fmt "^\\*\\{%d,%s\\}\\(?: \\|$\\)") - (past-first-child nil) - ;; Make sure to skip inlinetasks. - (re (format regexp-fmt - current-level - (cond - ((not (featurep 'org-inlinetask)) "") - (org-odd-levels-only (- (* 2 org-inlinetask-min-level) - 3)) - (t (1- org-inlinetask-min-level)))))) - ;; Display parent heading. - (org-flag-heading nil) - (forward-line) - ;; Display children. First child may be deeper than expected - ;; MAX-LEVEL. Since we want to display it anyway, adjust - ;; MAX-LEVEL accordingly. - (while (re-search-forward re end t) - (unless past-first-child - (setq re (format regexp-fmt - current-level - (max (funcall outline-level) max-level))) - (setq past-first-child t)) - (org-flag-heading nil)))))) - -(defun org-show-subtree () - "Show everything after this heading at deeper levels." - (interactive) - (org-flag-region - (point) (save-excursion (org-end-of-subtree t t)) nil 'outline)) - -;;;; Blocks and drawers visibility - -(defun org--hide-wrapper-toggle (element category force no-error) - "Toggle visibility for ELEMENT. - -ELEMENT is a block or drawer type parsed element. CATEGORY is -either `block' or `drawer'. When FORCE is `off', show the block -or drawer. If it is non-nil, hide it unconditionally. Throw an -error when not at a block or drawer, unless NO-ERROR is non-nil. - -Return a non-nil value when toggling is successful." - (let ((type (org-element-type element))) - (cond - ((memq type - (pcase category - (`drawer '(drawer property-drawer)) - (`block '(center-block - comment-block dynamic-block example-block export-block - quote-block special-block src-block verse-block)) - (_ (error "Unknown category: %S" category)))) - (let* ((post (org-element-property :post-affiliated element)) - (start (save-excursion - (goto-char post) - (line-end-position))) - (end (save-excursion - (goto-char (org-element-property :end element)) - (skip-chars-backward " \t\n") - (line-end-position)))) - ;; Do nothing when not before or at the block opening line or - ;; at the block closing line. - (unless (let ((eol (line-end-position))) - (and (> eol start) (/= eol end))) - (let* ((spec (if (eq category 'block) 'org-hide-block 'outline)) - (flag - (cond ((eq force 'off) nil) - (force t) - ((eq spec (get-char-property start 'invisible)) nil) - (t t)))) - (org-flag-region start end flag spec)) - ;; When the block is hidden away, make sure point is left in - ;; a visible part of the buffer. - (when (invisible-p (max (1- (point)) (point-min))) - (goto-char post)) - ;; Signal success. - t))) - (no-error nil) - (t - (user-error (if (eq category 'drawer) - "Not at a drawer" - "Not at a block")))))) - -(defun org-hide-block-toggle (&optional force no-error element) - "Toggle the visibility of the current block. - -When optional argument FORCE is `off', make block visible. If it -is non-nil, hide it unconditionally. Throw an error when not at -a block, unless NO-ERROR is non-nil. When optional argument -ELEMENT is provided, consider it instead of the current block. - -Return a non-nil value when toggling is successful." - (interactive) - (org--hide-wrapper-toggle - (or element (org-element-at-point)) 'block force no-error)) - -(defun org-hide-drawer-toggle (&optional force no-error element) - "Toggle the visibility of the current drawer. - -When optional argument FORCE is `off', make drawer visible. If -it is non-nil, hide it unconditionally. Throw an error when not -at a drawer, unless NO-ERROR is non-nil. When optional argument -ELEMENT is provided, consider it instead of the current drawer. - -Return a non-nil value when toggling is successful." - (interactive) - (org--hide-wrapper-toggle - (or element (org-element-at-point)) 'drawer force no-error)) - -(defun org-hide-block-all () - "Fold all blocks in the current buffer." - (interactive) - (org-show-all '(blocks)) - (org-block-map 'org-hide-block-toggle)) - -(defun org-hide-drawer-all () - "Fold all drawers in the current buffer." - (let ((begin (point-min)) - (end (point-max))) - (org--hide-drawers begin end))) - -(defun org-cycle-hide-drawers (state) - "Re-hide all drawers after a visibility state change. -STATE should be one of the symbols listed in the docstring of -`org-cycle-hook'." - (when (derived-mode-p 'org-mode) - (cond ((not (memq state '(overview folded contents))) - (let* ((global? (eq state 'all)) - (beg (if global? (point-min) (line-beginning-position))) - (end (cond (global? (point-max)) - ((eq state 'children) (org-entry-end-position)) - (t (save-excursion (org-end-of-subtree t t)))))) - (org--hide-drawers beg end))) - ((memq state '(overview contents)) - ;; Hide drawers before first heading. - (let ((beg (point-min)) - (end (save-excursion - (goto-char (point-min)) - (if (org-before-first-heading-p) - (org-entry-end-position) - (point-min))))) - (when (< beg end) - (org--hide-drawers beg end))))))) - -(defun org--hide-drawers (begin end) - "Hide all drawers between BEGIN and END." - (save-excursion - (goto-char begin) - (while (re-search-forward org-drawer-regexp end t) - (let* ((pair (get-char-property-and-overlay (line-beginning-position) - 'invisible)) - (o (cdr-safe pair))) - (if (overlayp o) (goto-char (overlay-end o)) ;invisible drawer - (pcase (get-char-property-and-overlay (point) 'invisible) - (`(outline . ,o) (goto-char (overlay-end o))) ;already folded - (_ - (let* ((drawer (org-element-at-point)) - (type (org-element-type drawer))) - (when (memq type '(drawer property-drawer)) - (org-hide-drawer-toggle t nil drawer) - ;; Make sure to skip drawer entirely or we might flag it - ;; another time when matching its ending line with - ;; `org-drawer-regexp'. - (goto-char (org-element-property :end drawer))))))))))) - -;;;; Visibility cycling - -(defvar-local org-cycle-global-status nil) -(put 'org-cycle-global-status 'org-state t) -(defvar-local org-cycle-subtree-status nil) -(put 'org-cycle-subtree-status 'org-state t) - -(defun org-show-all (&optional types) - "Show all contents in the visible part of the buffer. -By default, the function expands headings, blocks and drawers. -When optional argument TYPE is a list of symbols among `blocks', -`drawers' and `headings', to only expand one specific type." - (interactive) - (let ((types (or types '(blocks drawers headings)))) - (when (memq 'blocks types) - (org-flag-region (point-min) (point-max) nil 'org-hide-block)) - (cond - ;; Fast path. Since headings and drawers share the same - ;; invisible spec, clear everything in one go. - ((and (memq 'headings types) - (memq 'drawers types)) - (org-flag-region (point-min) (point-max) nil 'outline)) - ((memq 'headings types) - (org-flag-region (point-min) (point-max) nil 'outline) - (org-cycle-hide-drawers 'all)) - ((memq 'drawers types) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward org-drawer-regexp nil t) - (let* ((pair (get-char-property-and-overlay (line-beginning-position) - 'invisible)) - (o (cdr-safe pair))) - (if (overlayp o) (goto-char (overlay-end o)) - (pcase (get-char-property-and-overlay (point) 'invisible) - (`(outline . ,o) - (goto-char (overlay-end o)) - (delete-overlay o)) - (_ nil)))))))))) - -;;;###autoload -(defun org-cycle (&optional arg) - "TAB-action and visibility cycling for Org mode. - -This is the command invoked in Org mode by the `TAB' key. Its main -purpose is outline visibility cycling, but it also invokes other actions -in special contexts. - -When this function is called with a `\\[universal-argument]' prefix, rotate \ -the entire -buffer through 3 states (global cycling) - 1. OVERVIEW: Show only top-level headlines. - 2. CONTENTS: Show all headlines of all levels, but no body text. - 3. SHOW ALL: Show everything. - -With a `\\[universal-argument] \\[universal-argument]' prefix argument, \ -switch to the startup visibility, -determined by the variable `org-startup-folded', and by any VISIBILITY -properties in the buffer. - -With a `\\[universal-argument] \\[universal-argument] \ -\\[universal-argument]' prefix argument, show the entire buffer, including -any drawers. - -When inside a table, re-align the table and move to the next field. - -When point is at the beginning of a headline, rotate the subtree started -by this line through 3 different states (local cycling) - 1. FOLDED: Only the main headline is shown. - 2. CHILDREN: The main headline and the direct children are shown. - From this state, you can move to one of the children - and zoom in further. - 3. SUBTREE: Show the entire subtree, including body text. -If there is no subtree, switch directly from CHILDREN to FOLDED. - -When point is at the beginning of an empty headline and the variable -`org-cycle-level-after-item/entry-creation' is set, cycle the level -of the headline by demoting and promoting it to likely levels. This -speeds up creation document structure by pressing `TAB' once or several -times right after creating a new headline. - -When there is a numeric prefix, go up to a heading with level ARG, do -a `show-subtree' and return to the previous cursor position. If ARG -is negative, go up that many levels. - -When point is not at the beginning of a headline, execute the global -binding for `TAB', which is re-indenting the line. See the option -`org-cycle-emulate-tab' for details. - -As a special case, if point is at the very beginning of the buffer, if -there is no headline there, and if the variable `org-cycle-global-at-bob' -is non-nil, this function acts as if called with prefix argument \ -\(`\\[universal-argument] TAB', -same as `S-TAB') also when called without prefix argument." - (interactive "P") - (org-load-modules-maybe) - (unless (or (run-hook-with-args-until-success 'org-tab-first-hook) - (and org-cycle-level-after-item/entry-creation - (or (org-cycle-level) - (org-cycle-item-indentation)))) - (let* ((limit-level - (or org-cycle-max-level - (and (boundp 'org-inlinetask-min-level) - org-inlinetask-min-level - (1- org-inlinetask-min-level)))) - (nstars - (and limit-level - (if org-odd-levels-only - (1- (* 2 limit-level)) - limit-level))) - (org-outline-regexp - (format "\\*%s " (if nstars (format "\\{1,%d\\}" nstars) "+")))) - (cond - ((equal arg '(16)) - (setq last-command 'dummy) - (org-set-startup-visibility) - (org-unlogged-message "Startup visibility, plus VISIBILITY properties")) - ((equal arg '(64)) - (org-show-all) - (org-unlogged-message "Entire buffer visible, including drawers")) - ((equal arg '(4)) (org-cycle-internal-global)) - ;; Show-subtree, ARG levels up from here. - ((integerp arg) - (save-excursion - (org-back-to-heading) - (outline-up-heading (if (< arg 0) (- arg) - (- (funcall outline-level) arg))) - (org-show-subtree))) - ;; Global cycling at BOB: delegate to `org-cycle-internal-global'. - ((and org-cycle-global-at-bob - (bobp) - (not (looking-at org-outline-regexp))) - (let ((org-cycle-hook - (remq 'org-optimize-window-after-visibility-change - org-cycle-hook))) - (org-cycle-internal-global))) - ;; Try CDLaTeX TAB completion. - ((org-try-cdlatex-tab)) - ;; Inline task: delegate to `org-inlinetask-toggle-visibility'. - ((and (featurep 'org-inlinetask) - (org-inlinetask-at-task-p) - (or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol)))) - (org-inlinetask-toggle-visibility)) - (t - (let ((pos (point)) - (element (org-element-at-point))) - (cond - ;; Try toggling visibility for block at point. - ((org-hide-block-toggle nil t element)) - ;; Try toggling visibility for drawer at point. - ((org-hide-drawer-toggle nil t element)) - ;; Table: enter it or move to the next field. - ((and (org-match-line "[ \t]*[|+]") - (org-element-lineage element '(table) t)) - (if (and (eq 'table (org-element-type element)) - (eq 'table.el (org-element-property :type element))) - (message (substitute-command-keys "\\<org-mode-map>\ -Use `\\[org-edit-special]' to edit table.el tables")) - (org-table-justify-field-maybe) - (call-interactively #'org-table-next-field))) - ((run-hook-with-args-until-success - 'org-tab-after-check-for-table-hook)) - ;; At an item/headline: delegate to `org-cycle-internal-local'. - ((and (or (and org-cycle-include-plain-lists - (let ((item (org-element-lineage element - '(item plain-list) - t))) - (and item - (= (line-beginning-position) - (org-element-property :post-affiliated - item))))) - (org-match-line org-outline-regexp)) - (or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol)))) - (org-cycle-internal-local)) - ;; From there: TAB emulation and template completion. - (buffer-read-only (org-back-to-heading)) - ((run-hook-with-args-until-success - 'org-tab-after-check-for-cycling-hook)) - ((run-hook-with-args-until-success - 'org-tab-before-tab-emulation-hook)) - ((and (eq org-cycle-emulate-tab 'exc-hl-bol) - (or (not (bolp)) - (not (looking-at org-outline-regexp)))) - (call-interactively (global-key-binding (kbd "TAB")))) - ((or (eq org-cycle-emulate-tab t) - (and (memq org-cycle-emulate-tab '(white whitestart)) - (save-excursion (beginning-of-line 1) (looking-at "[ \t]*")) - (or (and (eq org-cycle-emulate-tab 'white) - (= (match-end 0) (point-at-eol))) - (and (eq org-cycle-emulate-tab 'whitestart) - (>= (match-end 0) pos))))) - (call-interactively (global-key-binding (kbd "TAB")))) - (t - (save-excursion - (org-back-to-heading) - (org-cycle)))))))))) - -(defun org-cycle-internal-global () - "Do the global cycling action." - ;; Hack to avoid display of messages for .org attachments in Gnus - (let ((ga (string-match-p "\\*fontification" (buffer-name)))) - (cond - ((and (eq last-command this-command) - (eq org-cycle-global-status 'overview)) - ;; We just created the overview - now do table of contents - ;; This can be slow in very large buffers, so indicate action - (run-hook-with-args 'org-pre-cycle-hook 'contents) - (unless ga (org-unlogged-message "CONTENTS...")) - (org-content) - (unless ga (org-unlogged-message "CONTENTS...done")) - (setq org-cycle-global-status 'contents) - (run-hook-with-args 'org-cycle-hook 'contents)) - - ((and (eq last-command this-command) - (eq org-cycle-global-status 'contents)) - ;; We just showed the table of contents - now show everything - (run-hook-with-args 'org-pre-cycle-hook 'all) - (org-show-all '(headings blocks)) - (unless ga (org-unlogged-message "SHOW ALL")) - (setq org-cycle-global-status 'all) - (run-hook-with-args 'org-cycle-hook 'all)) - - (t - ;; Default action: go to overview - (run-hook-with-args 'org-pre-cycle-hook 'overview) - (org-overview) - (unless ga (org-unlogged-message "OVERVIEW")) - (setq org-cycle-global-status 'overview) - (run-hook-with-args 'org-cycle-hook 'overview))))) +;; FIXME: It was in the middle of visibility section. Where should it go to? (defvar org-called-with-limited-levels nil "Non-nil when `org-with-limited-levels' is currently active.") -(defun org-cycle-internal-local () - "Do the local cycling action." - (let ((goal-column 0) eoh eol eos has-children children-skipped struct) - ;; First, determine end of headline (EOH), end of subtree or item - ;; (EOS), and if item or heading has children (HAS-CHILDREN). - (save-excursion - (if (org-at-item-p) - (progn - (beginning-of-line) - (setq struct (org-list-struct)) - (setq eoh (point-at-eol)) - (setq eos (org-list-get-item-end-before-blank (point) struct)) - (setq has-children (org-list-has-child-p (point) struct))) - (org-back-to-heading) - (setq eoh (save-excursion (outline-end-of-heading) (point))) - (setq eos (save-excursion - (org-end-of-subtree t t) - (unless (eobp) (forward-char -1)) - (point))) - (setq has-children - (or - (save-excursion - (let ((level (funcall outline-level))) - (outline-next-heading) - (and (org-at-heading-p t) - (> (funcall outline-level) level)))) - (and (eq org-cycle-include-plain-lists 'integrate) - (save-excursion - (org-list-search-forward (org-item-beginning-re) eos t)))))) - ;; Determine end invisible part of buffer (EOL) - (beginning-of-line 2) - (while (and (not (eobp)) ;this is like `next-line' - (get-char-property (1- (point)) 'invisible)) - (goto-char (next-single-char-property-change (point) 'invisible)) - (and (eolp) (beginning-of-line 2))) - (setq eol (point))) - ;; Find out what to do next and set `this-command' - (cond - ((= eos eoh) - ;; Nothing is hidden behind this heading - (unless (org-before-first-heading-p) - (run-hook-with-args 'org-pre-cycle-hook 'empty)) - (org-unlogged-message "EMPTY ENTRY") - (setq org-cycle-subtree-status nil) - (save-excursion - (goto-char eos) - (outline-next-heading) - (when (org-invisible-p) (org-flag-heading nil)))) - ((and (or (>= eol eos) - (not (string-match "\\S-" (buffer-substring eol eos)))) - (or has-children - (not (setq children-skipped - org-cycle-skip-children-state-if-no-children)))) - ;; Entire subtree is hidden in one line: children view - (unless (org-before-first-heading-p) - (run-hook-with-args 'org-pre-cycle-hook 'children)) - (if (org-at-item-p) - (org-list-set-item-visibility (point-at-bol) struct 'children) - (org-show-entry) - (org-with-limited-levels (org-show-children)) - (org-show-set-visibility 'tree) - ;; Fold every list in subtree to top-level items. - (when (eq org-cycle-include-plain-lists 'integrate) - (save-excursion - (org-back-to-heading) - (while (org-list-search-forward (org-item-beginning-re) eos t) - (beginning-of-line 1) - (let* ((struct (org-list-struct)) - (prevs (org-list-prevs-alist struct)) - (end (org-list-get-bottom-point struct))) - (dolist (e (org-list-get-all-items (point) struct prevs)) - (org-list-set-item-visibility e struct 'folded)) - (goto-char (if (< end eos) end eos))))))) - (org-unlogged-message "CHILDREN") - (save-excursion - (goto-char eos) - (outline-next-heading) - (when (org-invisible-p) (org-flag-heading nil))) - (setq org-cycle-subtree-status 'children) - (unless (org-before-first-heading-p) - (run-hook-with-args 'org-cycle-hook 'children))) - ((or children-skipped - (and (eq last-command this-command) - (eq org-cycle-subtree-status 'children))) - ;; We just showed the children, or no children are there, - ;; now show everything. - (unless (org-before-first-heading-p) - (run-hook-with-args 'org-pre-cycle-hook 'subtree)) - (org-flag-region eoh eos nil 'outline) - (org-unlogged-message - (if children-skipped "SUBTREE (NO CHILDREN)" "SUBTREE")) - (setq org-cycle-subtree-status 'subtree) - (unless (org-before-first-heading-p) - (run-hook-with-args 'org-cycle-hook 'subtree))) - (t - ;; Default action: hide the subtree. - (run-hook-with-args 'org-pre-cycle-hook 'folded) - (org-flag-region eoh eos t 'outline) - (org-unlogged-message "FOLDED") - (setq org-cycle-subtree-status 'folded) - (unless (org-before-first-heading-p) - (run-hook-with-args 'org-cycle-hook 'folded)))))) - -;;;###autoload -(defun org-global-cycle (&optional arg) - "Cycle the global visibility. For details see `org-cycle'. -With `\\[universal-argument]' prefix ARG, switch to startup visibility. -With a numeric prefix, show all headlines up to that level." - (interactive "P") - (cond - ((integerp arg) - (org-content arg) - (setq org-cycle-global-status 'contents)) - ((equal arg '(4)) - (org-set-startup-visibility) - (org-unlogged-message "Startup visibility, plus VISIBILITY properties.")) - (t - (org-cycle '(4))))) - -(defun org-set-startup-visibility () - "Set the visibility required by startup options and properties." - (cond - ((eq org-startup-folded t) - (org-overview)) - ((eq org-startup-folded 'content) - (org-content)) - ((eq org-startup-folded 'show2levels) - (org-content 2)) - ((eq org-startup-folded 'show3levels) - (org-content 3)) - ((eq org-startup-folded 'show4levels) - (org-content 4)) - ((eq org-startup-folded 'show5levels) - (org-content 5)) - ((or (eq org-startup-folded 'showeverything) - (eq org-startup-folded nil)) - (org-show-all))) - (unless (eq org-startup-folded 'showeverything) - (when org-hide-block-startup (org-hide-block-all)) - (org-set-visibility-according-to-property) - (org-cycle-hide-archived-subtrees 'all) - (org-cycle-hide-drawers 'all) - (org-cycle-show-empty-lines t))) - -(defun org-set-visibility-according-to-property () - "Switch subtree visibility according to VISIBILITY property." - (interactive) - (let ((regexp (org-re-property "VISIBILITY"))) - (org-with-point-at 1 - (while (re-search-forward regexp nil t) - (let ((state (match-string 3))) - (if (not (org-at-property-p)) (outline-next-heading) - (save-excursion - (org-back-to-heading t) - (org-flag-subtree t) - (org-reveal) - (pcase state - ("folded" - (org-flag-subtree t)) - ("children" - (org-show-hidden-entry) - (org-show-children)) - ("content" - (save-excursion - (save-restriction - (org-narrow-to-subtree) - (org-content)))) - ((or "all" "showall") - (outline-show-subtree)) - (_ nil))) - (org-end-of-subtree))))))) - -(defun org-overview () - "Switch to overview mode, showing only top-level headlines." - (interactive) - (org-show-all '(headings drawers)) - (save-excursion - (goto-char (point-min)) - (when (re-search-forward org-outline-regexp-bol nil t) - (let* ((last (line-end-position)) - (level (- (match-end 0) (match-beginning 0) 1)) - (regexp (format "^\\*\\{1,%d\\} " level))) - (while (re-search-forward regexp nil :move) - (org-flag-region last (line-end-position 0) t 'outline) - (setq last (line-end-position)) - (setq level (- (match-end 0) (match-beginning 0) 1)) - (setq regexp (format "^\\*\\{1,%d\\} " level))) - (org-flag-region last (point) t 'outline))))) - -(defun org-content (&optional arg) - "Show all headlines in the buffer, like a table of contents. -With numerical argument N, show content up to level N." - (interactive "p") - (org-show-all '(headings drawers)) - (save-excursion - (goto-char (point-max)) - (let ((regexp (if (and (wholenump arg) (> arg 0)) - (format "^\\*\\{1,%d\\} " arg) - "^\\*+ ")) - (last (point))) - (while (re-search-backward regexp nil t) - (org-flag-region (line-end-position) last t 'outline) - (setq last (line-end-position 0)))))) - -(defvar org-scroll-position-to-restore nil - "Temporarily store scroll position to restore.") -(defun org-optimize-window-after-visibility-change (state) - "Adjust the window after a change in outline visibility. -This function is the default value of the hook `org-cycle-hook'." - (when (get-buffer-window (current-buffer)) - (let ((repeat (eq last-command this-command))) - (unless repeat - (setq org-scroll-position-to-restore nil)) - (cond - ((eq state 'content) nil) - ((eq state 'all) nil) - ((and org-scroll-position-to-restore repeat - (eq state 'folded)) - (set-window-start nil org-scroll-position-to-restore)) - ((eq state 'folded) nil) - ((eq state 'children) - (setq org-scroll-position-to-restore (window-start)) - (or (org-subtree-end-visible-p) (recenter 1))) - ((eq state 'subtree) - (unless repeat - (setq org-scroll-position-to-restore (window-start))) - (or (org-subtree-end-visible-p) (recenter 1))))))) - -(defun org-clean-visibility-after-subtree-move () - "Fix visibility issues after moving a subtree." - ;; First, find a reasonable region to look at: - ;; Start two siblings above, end three below - (let* ((beg (save-excursion - (and (org-get-previous-sibling) - (org-get-previous-sibling)) - (point))) - (end (save-excursion - (and (org-get-next-sibling) - (org-get-next-sibling) - (org-get-next-sibling)) - (if (org-at-heading-p) - (point-at-eol) - (point)))) - (level (looking-at "\\*+")) - (re (when level (concat "^" (regexp-quote (match-string 0)) " ")))) - (save-excursion - (save-restriction - (narrow-to-region beg end) - (when re - ;; Properly fold already folded siblings - (goto-char (point-min)) - (while (re-search-forward re nil t) - (when (and (not (org-invisible-p)) - (org-invisible-p (line-end-position))) - (outline-hide-entry)))) - (org-cycle-hide-drawers 'all) - (org-cycle-show-empty-lines 'overview))))) - -(defun org-cycle-show-empty-lines (state) - "Show empty lines above all visible headlines. -The region to be covered depends on STATE when called through -`org-cycle-hook'. Lisp program can use t for STATE to get the -entire buffer covered. Note that an empty line is only shown if there -are at least `org-cycle-separator-lines' empty lines before the headline." - (when (/= org-cycle-separator-lines 0) - (save-excursion - (let* ((n (abs org-cycle-separator-lines)) - (re (cond - ((= n 1) "\\(\n[ \t]*\n\\*+\\) ") - ((= n 2) "^[ \t]*\\(\n[ \t]*\n\\*+\\) ") - (t (let ((ns (number-to-string (- n 2)))) - (concat "^\\(?:[ \t]*\n\\)\\{" ns "," ns "\\}" - "[ \t]*\\(\n[ \t]*\n\\*+\\) "))))) - beg end) - (cond - ((memq state '(overview contents t)) - (setq beg (point-min) end (point-max))) - ((memq state '(children folded)) - (setq beg (point) - end (progn (org-end-of-subtree t t) - (line-beginning-position 2))))) - (when beg - (goto-char beg) - (while (re-search-forward re end t) - (unless (get-char-property (match-end 1) 'invisible) - (let ((e (match-end 1)) - (b (if (>= org-cycle-separator-lines 0) - (match-beginning 1) - (save-excursion - (goto-char (match-beginning 0)) - (skip-chars-backward " \t\n") - (line-end-position))))) - (org-flag-region b e nil 'outline)))))))) - ;; Never hide empty lines at the end of the file. - (save-excursion - (goto-char (point-max)) - (outline-previous-heading) - (outline-end-of-heading) - (when (and (looking-at "[ \t\n]+") - (= (match-end 0) (point-max))) - (org-flag-region (point) (match-end 0) nil 'outline)))) - -;;;; Reveal point location - -(defun org-show-context (&optional key) - "Make sure point and context are visible. -Optional argument KEY, when non-nil, is a symbol. See -`org-show-context-detail' for allowed values and how much is to -be shown." - (org-show-set-visibility - (cond ((symbolp org-show-context-detail) org-show-context-detail) - ((cdr (assq key org-show-context-detail))) - (t (cdr (assq 'default org-show-context-detail)))))) - -(defun org-show-set-visibility (detail) - "Set visibility around point according to 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-flag-heading nil) - (org-show-entry) - ;; If point is hidden within a drawer or a block, make sure to - ;; expose it. - (dolist (o (overlays-at (point))) - (when (memq (overlay-get o 'invisible) '(org-hide-block outline)) - (delete-overlay o))) - (unless (org-before-first-heading-p) - (org-with-limited-levels - (cl-case detail - ((tree canonical t) (org-show-children)) - ((nil minimal ancestors ancestors-full)) - (t (save-excursion - (outline-next-heading) - (org-flag-heading nil))))))) - ;; Show whole subtree. - (when (eq detail 'ancestors-full) (org-show-subtree)) - ;; Show all siblings. - (when (eq detail 'lineage) (org-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-flag-heading nil) - (when (memq detail '(canonical t)) (org-show-entry)) - (when (memq detail '(tree canonical t)) (org-show-children)))))) - -(defvar org-reveal-start-hook nil - "Hook run before revealing a location.") - -(defun org-reveal (&optional siblings) - "Show current entry, hierarchy above it, and the following headline. - -This can be used to show a consistent set of context around -locations exposed with `org-show-context'. - -With optional argument SIBLINGS, on each level of the hierarchy all -siblings are shown. This repairs the tree structure to what it would -look like when opened with hierarchical calls to `org-cycle'. - -With a \\[universal-argument] \\[universal-argument] prefix, \ -go to the parent and show the entire tree." - (interactive "P") - (run-hooks 'org-reveal-start-hook) - (cond ((equal siblings '(4)) (org-show-set-visibility 'canonical)) - ((equal siblings '(16)) - (save-excursion - (when (org-up-heading-safe) - (org-show-subtree) - (run-hook-with-args 'org-cycle-hook 'subtree)))) - (t (org-show-set-visibility 'lineage)))) - \f ;;; Indirect buffer display of subtrees @@ -7641,6 +6541,36 @@ (defun org-move-subtree-up (&optional arg) (interactive "p") (org-move-subtree-down (- (prefix-numeric-value arg)))) +(defun org-clean-visibility-after-subtree-move () + "Fix visibility issues after moving a subtree." + ;; First, find a reasonable region to look at: + ;; Start two siblings above, end three below + (let* ((beg (save-excursion + (and (org-get-previous-sibling) + (org-get-previous-sibling)) + (point))) + (end (save-excursion + (and (org-get-next-sibling) + (org-get-next-sibling) + (org-get-next-sibling)) + (if (org-at-heading-p) + (point-at-eol) + (point)))) + (level (looking-at "\\*+")) + (re (when level (concat "^" (regexp-quote (match-string 0)) " ")))) + (save-excursion + (save-restriction + (narrow-to-region beg end) + (when re + ;; Properly fold already folded siblings + (goto-char (point-min)) + (while (re-search-forward re nil t) + (when (and (not (org-invisible-p)) + (org-invisible-p (line-end-position))) + (org-fold-heading nil)))) + (org-cycle-hide-drawers 'all) + (org-cycle-show-empty-lines 'overview))))) + (defun org-move-subtree-down (&optional arg) "Move the current subtree down past ARG headlines of the same level." (interactive "p") @@ -16929,6 +15859,14 @@ (defun org-remove-inline-images () (defvar org-self-insert-command-undo-counter 0) (defvar org-speed-command nil) +(defun org-fix-tags-on-the-fly () + "Align tags in headline at point. +Unlike `org-align-tags', this function does nothing if point is +either not currently on a tagged headline or on a tag." + (when (and (org-match-line org-tag-line-re) + (< (point) (match-beginning 1))) + (org-align-tags))) + (defun org-self-insert-command (N) "Like `self-insert-command', use overwrite-mode for whitespace in tables. If the cursor is in a table looking at whitespace, the whitespace is @@ -16996,80 +15934,6 @@ (defun org-self-insert-command (N) (setq org-self-insert-command-undo-counter (1+ org-self-insert-command-undo-counter)))))))) -(defun org-check-before-invisible-edit (kind) - "Check if editing kind KIND would be dangerous with invisible text around. -The detailed reaction depends on the user option `org-catch-invisible-edits'." - ;; First, try to get out of here as quickly as possible, to reduce overhead - (when (and org-catch-invisible-edits - (or (not (boundp 'visible-mode)) (not visible-mode)) - (or (get-char-property (point) 'invisible) - (get-char-property (max (point-min) (1- (point))) 'invisible))) - ;; OK, we need to take a closer look. Do not consider - ;; invisibility obtained through text properties (e.g., link - ;; fontification), as it cannot be toggled. - (let* ((invisible-at-point - (pcase (get-char-property-and-overlay (point) 'invisible) - (`(,_ . ,(and (pred overlayp) o)) o))) - ;; Assume that point cannot land in the middle of an - ;; overlay, or between two overlays. - (invisible-before-point - (and (not invisible-at-point) - (not (bobp)) - (pcase (get-char-property-and-overlay (1- (point)) 'invisible) - (`(,_ . ,(and (pred overlayp) o)) o)))) - (border-and-ok-direction - (or - ;; Check if we are acting predictably before invisible - ;; text. - (and invisible-at-point - (memq kind '(insert delete-backward))) - ;; Check if we are acting predictably after invisible text - ;; This works not well, and I have turned it off. It seems - ;; better to always show and stop after invisible text. - ;; (and (not invisible-at-point) invisible-before-point - ;; (memq kind '(insert delete))) - ))) - (when (or invisible-at-point invisible-before-point) - (when (eq org-catch-invisible-edits 'error) - (user-error "Editing in invisible areas is prohibited, make them visible first")) - (if (and org-custom-properties-overlays - (y-or-n-p "Display invisible properties in this buffer? ")) - (org-toggle-custom-properties-visibility) - ;; Make the area visible - (save-excursion - (when invisible-before-point - (goto-char - (previous-single-char-property-change (point) 'invisible))) - ;; Remove whatever overlay is currently making yet-to-be - ;; edited text invisible. Also remove nested invisibility - ;; related overlays. - (delete-overlay (or invisible-at-point invisible-before-point)) - (let ((origin (if invisible-at-point (point) (1- (point))))) - (while (pcase (get-char-property-and-overlay origin 'invisible) - (`(,_ . ,(and (pred overlayp) o)) - (delete-overlay o) - t))))) - (cond - ((eq org-catch-invisible-edits 'show) - ;; That's it, we do the edit after showing - (message - "Unfolding invisible region around point before editing") - (sit-for 1)) - ((and (eq org-catch-invisible-edits 'smart) - border-and-ok-direction) - (message "Unfolding invisible region around point before editing")) - (t - ;; Don't do the edit, make the user repeat it in full visibility - (user-error "Edit in invisible region aborted, repeat to confirm with text visible")))))))) - -(defun org-fix-tags-on-the-fly () - "Align tags in headline at point. -Unlike `org-align-tags', this function does nothing if point is -either not currently on a tagged headline or on a tag." - (when (and (org-match-line org-tag-line-re) - (< (point) (match-beginning 1))) - (org-align-tags))) - (defun org-delete-backward-char (N) "Like `delete-backward-char', insert whitespace at field end in tables. When deleting backwards, in tables this function will insert whitespace in @@ -17181,16 +16045,6 @@ (defvar org-ctrl-c-ctrl-c-final-hook nil it should do its thing and then return a non-nil value. If the context is wrong, just do nothing and return nil.") -(defvar org-tab-first-hook nil - "Hook for functions to attach themselves to TAB. -See `org-ctrl-c-ctrl-c-hook' for more information. -This hook runs as the first action when TAB is pressed, even before -`org-cycle' messes around with the `outline-regexp' to cater for -inline tasks and plain list item folding. -If any function in this hook returns t, any other actions that -would have been caused by TAB (such as table field motion or visibility -cycling) will not occur.") - (defvar org-tab-after-check-for-table-hook nil "Hook for functions to attach themselves to TAB. See `org-ctrl-c-ctrl-c-hook' for more information. @@ -18119,25 +16973,6 @@ (defun org-mode-restart () (org-reset-file-cache)) (message "%s restarted" major-mode)) -(defun org-flag-above-first-heading (&optional arg) - "Hide from bob up to the first heading. -Move point to the beginning of first heading or end of buffer." - (goto-char (point-min)) - (unless (org-at-heading-p) - (outline-next-heading)) - (unless (bobp) - (org-flag-region 1 (1- (point)) (not arg) 'outline))) - -(defun org-show-branches-buffer () - "Show all branches in the buffer." - (org-flag-above-first-heading) - (outline-hide-sublevels 1) - (unless (eobp) - (outline-show-branches) - (while (outline-get-next-sibling) - (outline-show-branches))) - (goto-char (point-min))) - (defun org-kill-note-or-show-branches () "Abort storing current note, or show just branches." (interactive) @@ -20949,14 +19784,6 @@ (defun org-goto-sibling (&optional previous) (goto-char pos) nil)))) -(defun org-show-siblings () - "Show all siblings of the current headline." - (save-excursion - (while (org-goto-sibling) (org-flag-heading nil))) - (save-excursion - (while (org-goto-sibling 'previous) - (org-flag-heading nil)))) - (defun org-goto-first-child (&optional element) "Goto the first child, even if it is invisible. Return t when a child was found. Otherwise don't move point and @@ -20985,25 +19812,6 @@ (defun org-goto-first-child (&optional element) (progn (goto-char (match-beginning 0)) t) (goto-char pos) nil))))) -(defun org-show-hidden-entry () - "Show an entry where even the heading is hidden." - (save-excursion - (org-show-entry))) - -(defun org-flag-heading (flag &optional entry) - "Flag the current heading. FLAG non-nil means make invisible. -When ENTRY is non-nil, show the entire entry." - (save-excursion - (org-back-to-heading t) - ;; Check if we should show the entire entry - (if (not entry) - (org-flag-region - (line-end-position 0) (line-end-position) flag 'outline) - (org-show-entry) - (save-excursion - (and (outline-next-heading) - (org-flag-heading nil)))))) - (defun org-get-next-sibling () "Move to next heading of the same level, and return point. If there is no such heading, return nil. ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH 05/35] Disable native-comp in agenda 2022-01-29 11:37 ` [PATCH 00/35] Merge org-fold feature branch Ihor Radchenko ` (3 preceding siblings ...) 2022-01-29 11:37 ` [PATCH 04/35] Remove functions from org.el that are now moved elsewhere Ihor Radchenko @ 2022-01-29 11:37 ` Ihor Radchenko 2022-01-29 11:37 ` [PATCH 06/35] org-macs: New function org-find-text-property-region Ihor Radchenko ` (30 subsequent siblings) 35 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-01-29 11:37 UTC (permalink / raw) To: Bastien, Kyle Meyer, Nicolas Goaziou, Karl Voit, Christian Heinrich, emacs-orgmode Cc: Ihor Radchenko [-- Attachment #1: Type: text/plain, Size: 116 bytes --] It caused cryptic bugs in the past. --- lisp/org-agenda.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0005-Disable-native-comp-in-agenda.patch --] [-- Type: text/x-patch; name="0005-Disable-native-comp-in-agenda.patch", Size: 428 bytes --] diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index 3a6a4c1b9..72292fb4e 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -1,4 +1,4 @@ -;;; org-agenda.el --- Dynamic task and appointment lists for Org -*- lexical-binding: t; -*- +;;; org-agenda.el --- Dynamic task and appointment lists for Org -*- lexical-binding: t; no-native-compile: t; -*- ;; Copyright (C) 2004-2022 Free Software Foundation, Inc. ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH 06/35] org-macs: New function org-find-text-property-region 2022-01-29 11:37 ` [PATCH 00/35] Merge org-fold feature branch Ihor Radchenko ` (4 preceding siblings ...) 2022-01-29 11:37 ` [PATCH 05/35] Disable native-comp in agenda Ihor Radchenko @ 2022-01-29 11:37 ` Ihor Radchenko 2022-01-29 11:37 ` [PATCH 07/35] org-at-heading-p: Accept optional argument Ihor Radchenko ` (29 subsequent siblings) 35 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-01-29 11:37 UTC (permalink / raw) To: Bastien, Kyle Meyer, Nicolas Goaziou, Karl Voit, Christian Heinrich, emacs-orgmode Cc: Ihor Radchenko [-- Attachment #1: Type: text/plain, Size: 144 bytes --] --- lisp/org-macs.el | 32 +++++++++++++++++--------------- lisp/org.el | 7 ++++++- 2 files changed, 23 insertions(+), 16 deletions(-) [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0006-org-macs-New-function-org-find-text-property-region.patch --] [-- Type: text/x-patch; name="0006-org-macs-New-function-org-find-text-property-region.patch", Size: 2818 bytes --] diff --git a/lisp/org-macs.el b/lisp/org-macs.el index 3c902b603..d5d4c205d 100644 --- a/lisp/org-macs.el +++ b/lisp/org-macs.el @@ -722,7 +722,7 @@ (defsubst org-current-line (&optional pos) \f -;;; Overlays +;;; Overlays and text properties (defun org-overlay-display (ovl text &optional face evap) "Make overlay OVL display TEXT with face FACE." @@ -745,20 +745,22 @@ (defun org-find-overlays (prop &optional pos delete) (delete (delete-overlay ov)) (t (push ov found)))))) -(defun org-flag-region (from to flag spec) - "Hide or show lines from FROM to TO, according to FLAG. -SPEC is the invisibility spec, as a symbol." - (remove-overlays from to 'invisible spec) - ;; Use `front-advance' since text right before to the beginning of - ;; the overlay belongs to the visible line than to the contents. - (when flag - (let ((o (make-overlay from to nil 'front-advance))) - (overlay-put o 'evaporate t) - (overlay-put o 'invisible spec) - (overlay-put o - 'isearch-open-invisible - (lambda (&rest _) (org-show-context 'isearch)))))) - +(defun org-find-text-property-region (pos prop) + "Find a region around POS containing same non-nil value of PROP text property. +Return nil when PROP is not set at POS." + (let* ((beg (and (get-text-property pos prop) pos)) + (end beg)) + (when beg + (unless (or (equal beg (point-min)) + (not (eq (get-text-property beg prop) + (get-text-property (1- beg) prop)))) + (setq beg (previous-single-property-change pos prop nil (point-min)))) + (unless (or (equal end (point-max)) + ;; (not (eq (get-text-property end prop) + ;; (get-text-property (1+ end) prop))) + ) + (setq end (next-single-property-change pos prop nil (point-max)))) + (cons beg end)))) \f ;;; Regexp matching diff --git a/lisp/org.el b/lisp/org.el index d279edae4..f59d2cfb0 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -5596,7 +5596,10 @@ (defun org-fontify-like-in-org-mode (s &optional odd-levels) (let ((org-odd-levels-only odd-levels)) (org-mode) (org-font-lock-ensure) - (buffer-string)))) + (if org-link-descriptive + (org-link-display-format + (buffer-string)) + (buffer-string))))) (defun org-get-level-face (n) "Get the right face for match N in font-lock matching of headlines." @@ -5726,6 +5729,8 @@ (defun org-raise-scripts (limit) (if (equal (char-after (match-beginning 2)) ?^) (nth (if table-p 3 1) org-script-display) (nth (if table-p 2 0) org-script-display))) + (put-text-property (match-beginning 2) (match-end 3) + 'org-emphasis t) (add-text-properties (match-beginning 2) (match-end 2) (list 'invisible t)) (when (and (eq (char-after (match-beginning 3)) ?{) ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH 07/35] org-at-heading-p: Accept optional argument 2022-01-29 11:37 ` [PATCH 00/35] Merge org-fold feature branch Ihor Radchenko ` (5 preceding siblings ...) 2022-01-29 11:37 ` [PATCH 06/35] org-macs: New function org-find-text-property-region Ihor Radchenko @ 2022-01-29 11:37 ` Ihor Radchenko 2022-01-29 11:38 ` [PATCH 08/35] org-string-width: Reimplement to work with new folding Ihor Radchenko ` (28 subsequent siblings) 35 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-01-29 11:37 UTC (permalink / raw) To: Bastien, Kyle Meyer, Nicolas Goaziou, Karl Voit, Christian Heinrich, emacs-orgmode Cc: Ihor Radchenko [-- Attachment #1: Type: text/plain, Size: 634 bytes --] * lisp/org.el (org-at-heading-p): Use second argument to allow checking for visible headings. Note that by default, unlike `outline-on-heading-p', `org-at-heading-p' returns non-nil for invisible headings. Passing second argument is just like `(outline-on-heading-p)'. (org-indent-line): * lisp/org-agenda.el (org-agenda-add-entry-to-org-agenda-diary-file): * lisp/org-colview.el (org-columns--call): (org-columns-store-format): Update arguments in `org-at-heading-p' calls. --- lisp/org-agenda.el | 2 +- lisp/org-colview.el | 4 ++-- lisp/org.el | 14 +++++++++----- 3 files changed, 12 insertions(+), 8 deletions(-) [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0007-org-at-heading-p-Accept-optional-argument.patch --] [-- Type: text/x-patch; name="0007-org-at-heading-p-Accept-optional-argument.patch", Size: 2856 bytes --] diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index 72292fb4e..cc7cb5527 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -10526,7 +10526,7 @@ (defun org-agenda-add-entry-to-org-agenda-diary-file (type text &optional d1 d2) (anniversary (or (re-search-forward "^\\*[ \t]+Anniversaries" nil t) (progn - (or (org-at-heading-p t) + (or (org-at-heading-p) (progn (outline-next-heading) (insert "* Anniversaries\n\n") diff --git a/lisp/org-colview.el b/lisp/org-colview.el index 082d6def0..15cab35f0 100644 --- a/lisp/org-colview.el +++ b/lisp/org-colview.el @@ -699,7 +699,7 @@ (defun org-columns--call (fun) (let ((hide-body (and (/= (line-end-position) (point-max)) (save-excursion (move-beginning-of-line 2) - (org-at-heading-p t))))) + (org-at-heading-p))))) (unwind-protect (funcall fun) (when hide-body (outline-hide-entry))))) @@ -1026,7 +1026,7 @@ (defun org-columns-store-format () ;; No COLUMNS keyword in the buffer. Insert one at the ;; beginning, right before the first heading, if any. (goto-char (point-min)) - (unless (org-at-heading-p t) (outline-next-heading)) + (unless (org-at-heading-p) (outline-next-heading)) (let ((inhibit-read-only t)) (insert-before-markers "#+COLUMNS: " fmt "\n")))) (setq-local org-columns-default-format fmt)))))) diff --git a/lisp/org.el b/lisp/org.el index f59d2cfb0..b17a5477c 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -17243,7 +17243,7 @@ (defun org-toggle-heading (&optional nstars) ;; Case 1. Started at an heading: de-star headings. ((org-at-heading-p) (while (< (point) end) - (when (org-at-heading-p t) + (when (org-at-heading-p) (looking-at org-outline-regexp) (replace-match "") (setq toggled t)) (forward-line))) @@ -17844,7 +17844,7 @@ (defun org-context () (p (point)) clist o) ;; First the large context (cond - ((org-at-heading-p t) + ((org-at-heading-p) (push (list :headline (point-at-bol) (point-at-eol)) clist) (when (progn (beginning-of-line 1) @@ -19594,9 +19594,13 @@ (defun org-before-first-heading-p () (end-of-line) (null (re-search-backward org-outline-regexp-bol nil t)))))) -(defun org-at-heading-p (&optional _) - "Non-nil when on a headline." - (outline-on-heading-p t)) +(defun org-at-heading-p (&optional invisible-not-ok) + "Return t if point is on a (possibly invisible) heading line. +If INVISIBLE-NOT-OK is non-nil, an invisible heading line is not ok." + (save-excursion + (beginning-of-line) + (and (bolp) (or (not invisible-not-ok) (not (org-fold-folded-p))) + (looking-at outline-regexp)))) (defun org-in-commented-heading-p (&optional no-inheritance element) "Non-nil if point is under a commented heading. ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH 08/35] org-string-width: Reimplement to work with new folding 2022-01-29 11:37 ` [PATCH 00/35] Merge org-fold feature branch Ihor Radchenko ` (6 preceding siblings ...) 2022-01-29 11:37 ` [PATCH 07/35] org-at-heading-p: Accept optional argument Ihor Radchenko @ 2022-01-29 11:38 ` Ihor Radchenko 2022-01-29 11:38 ` [PATCH 09/35] Rename old function call to use org-fold Ihor Radchenko ` (27 subsequent siblings) 35 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-01-29 11:38 UTC (permalink / raw) To: Bastien, Kyle Meyer, Nicolas Goaziou, Karl Voit, Christian Heinrich, emacs-orgmode Cc: Ihor Radchenko [-- Attachment #1: Type: text/plain, Size: 273 bytes --] * lisp/org-macs.el (org--string-from-props): Removed since it is no longer needed. (org-string-width): Updated to use `window-text-pixel-size'. --- lisp/org-macs.el | 121 ++++++++++++++++++++++------------------------- 1 file changed, 57 insertions(+), 64 deletions(-) [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0008-org-string-width-Reimplement-to-work-with-new-foldin.patch --] [-- Type: text/x-patch; name="0008-org-string-width-Reimplement-to-work-with-new-foldin.patch", Size: 5750 bytes --] diff --git a/lisp/org-macs.el b/lisp/org-macs.el index d5d4c205d..8d156fa2f 100644 --- a/lisp/org-macs.el +++ b/lisp/org-macs.el @@ -883,71 +883,64 @@ (defun org-split-string (string &optional separators) results ;skip trailing separator (cons (substring string i) results))))))) -(defun org--string-from-props (s property beg end) - "Return the visible part of string S. -Visible part is determined according to text PROPERTY, which is -either `invisible' or `display'. BEG and END are 0-indices -delimiting S." - (let ((width 0) - (cursor beg)) - (while (setq beg (text-property-not-all beg end property nil s)) - (let* ((next (next-single-property-change beg property s end)) - (props (text-properties-at beg s)) - (spec (plist-get props property)) - (value - (pcase property - (`invisible - ;; If `invisible' property in PROPS means text is to - ;; be invisible, return 0. Otherwise return nil so - ;; as to resume search. - (and (or (eq t buffer-invisibility-spec) - (assoc-string spec buffer-invisibility-spec)) - 0)) - (`display - (pcase spec - (`nil nil) - (`(space . ,props) - (let ((width (plist-get props :width))) - (and (wholenump width) width))) - (`(image . ,_) - (and (fboundp 'image-size) - (ceiling (car (image-size spec))))) - ((pred stringp) - ;; Displayed string could contain invisible parts, - ;; but no nested display. - (org--string-from-props spec 'invisible 0 (length spec))) - (_ - ;; Un-handled `display' value. Ignore it. - ;; Consider the original string instead. - nil))) - (_ (error "Unknown property: %S" property))))) - (when value - (cl-incf width - ;; When looking for `display' parts, we still need - ;; to look for `invisible' property elsewhere. - (+ (cond ((eq property 'display) - (org--string-from-props s 'invisible cursor beg)) - ((= cursor beg) 0) - (t (string-width (substring s cursor beg)))) - value)) - (setq cursor next)) - (setq beg next))) - (+ width - ;; Look for `invisible' property in the last part of the - ;; string. See above. - (cond ((eq property 'display) - (org--string-from-props s 'invisible cursor end)) - ((= cursor end) 0) - (t (string-width (substring s cursor end))))))) - -(defun org-string-width (string) +(defun org-string-width (string &optional pixels) "Return width of STRING when displayed in the current buffer. -Unlike `string-width', this function takes into consideration -`invisible' and `display' text properties. It supports the -latter in a limited way, mostly for combinations used in Org. -Results may be off sometimes if it cannot handle a given -`display' value." - (org--string-from-props string 'display 0 (length string))) +Return width in pixels when PIXELS is non-nil." + ;; Wrap/line prefix will make `window-text-pizel-size' return too + ;; large value including the prefix. + ;; Face should be removed to make sure that all the string symbols + ;; are using default face with constant width. Constant char width + ;; is critical to get right string width from pixel width. + (remove-text-properties 0 (length string) + '(wrap-prefix t line-prefix t face t) + string) + (let (;; We need to remove the folds to make sure that folded table + ;; alignment is not messed up. + (current-invisibility-spec + (or (and (not (listp buffer-invisibility-spec)) + buffer-invisibility-spec) + (let (result) + (dolist (el buffer-invisibility-spec) + (unless (or (memq el + '(org-fold-drawer + org-fold-block + org-fold-outline)) + (and (listp el) + (memq (car el) + '(org-fold-drawer + org-fold-block + org-fold-outline)))) + (push el result))) + result))) + (current-char-property-alias-alist char-property-alias-alist)) + (with-temp-buffer + (setq-local display-line-numbers nil) + (setq-local buffer-invisibility-spec + current-invisibility-spec) + (setq-local char-property-alias-alist + current-char-property-alias-alist) + (let (pixel-width symbol-width) + (with-silent-modifications + (setf (buffer-string) string) + (setq pixel-width + (if (get-buffer-window (current-buffer)) + (car (window-text-pixel-size + nil (line-beginning-position) (point-max))) + (set-window-buffer nil (current-buffer)) + (car (window-text-pixel-size + nil (line-beginning-position) (point-max))))) + (unless pixels + (setf (buffer-string) "a") + (setq symbol-width + (if (get-buffer-window (current-buffer)) + (car (window-text-pixel-size + nil (line-beginning-position) (point-max))) + (set-window-buffer nil (current-buffer)) + (car (window-text-pixel-size + nil (line-beginning-position) (point-max))))))) + (if pixels + pixel-width + (/ pixel-width symbol-width)))))) (defun org-not-nil (v) "If V not nil, and also not the string \"nil\", then return V. ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH 09/35] Rename old function call to use org-fold 2022-01-29 11:37 ` [PATCH 00/35] Merge org-fold feature branch Ihor Radchenko ` (7 preceding siblings ...) 2022-01-29 11:38 ` [PATCH 08/35] org-string-width: Reimplement to work with new folding Ihor Radchenko @ 2022-01-29 11:38 ` Ihor Radchenko 2022-01-29 11:38 ` [PATCH 10/35] Implement link folding Ihor Radchenko ` (26 subsequent siblings) 35 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-01-29 11:38 UTC (permalink / raw) To: Bastien, Kyle Meyer, Nicolas Goaziou, Karl Voit, Christian Heinrich, emacs-orgmode Cc: Ihor Radchenko [-- Attachment #1: Type: text/plain, Size: 1302 bytes --] --- lisp/ob-core.el | 14 ++-- lisp/ob-lilypond.el | 4 +- lisp/ob-ref.el | 4 +- lisp/ol.el | 13 ++-- lisp/org-agenda.el | 43 +++++------ lisp/org-archive.el | 12 +-- lisp/org-capture.el | 2 +- lisp/org-clock.el | 10 +-- lisp/org-colview.el | 6 +- lisp/org-compat.el | 29 +++---- lisp/org-crypt.el | 8 +- lisp/org-element.el | 1 + lisp/org-feed.el | 4 +- lisp/org-footnote.el | 6 +- lisp/org-goto.el | 6 +- lisp/org-id.el | 4 +- lisp/org-keys.el | 26 +++---- lisp/org-lint.el | 3 +- lisp/org-list.el | 10 ++- lisp/org-macs.el | 40 ++-------- lisp/org-mobile.el | 2 +- lisp/org-mouse.el | 4 +- lisp/org-refile.el | 2 +- lisp/org-src.el | 6 +- lisp/org-timer.el | 2 +- lisp/org.el | 137 +++++++++++++++++++--------------- lisp/ox-org.el | 2 +- testing/lisp/test-org-list.el | 2 +- testing/lisp/test-org.el | 78 +++++++++---------- 29 files changed, 242 insertions(+), 238 deletions(-) [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0009-Rename-old-function-call-to-use-org-fold.patch --] [-- Type: text/x-patch; name="0009-Rename-old-function-call-to-use-org-fold.patch", Size: 71466 bytes --] diff --git a/lisp/ob-core.el b/lisp/ob-core.el index 239a57f96..6590eeee7 100644 --- a/lisp/ob-core.el +++ b/lisp/ob-core.el @@ -26,7 +26,9 @@ ;;; Code: (require 'cl-lib) (require 'ob-eval) (require 'org-macs) +(require 'org-fold) (require 'org-compat) +(require 'org-cycle) (defconst org-babel-exeext (if (memq system-type '(windows-nt cygwin)) @@ -50,7 +52,7 @@ (declare-function org-babel-ref-resolve "ob-ref" (ref)) (declare-function org-babel-ref-split-args "ob-ref" (arg-string)) (declare-function org-babel-tangle-comment-links "ob-tangle" (&optional info)) (declare-function org-current-level "org" ()) -(declare-function org-cycle "org" (&optional arg)) +(declare-function org-cycle "org-cycle" (&optional arg)) (declare-function org-edit-src-code "org-src" (&optional code edit-buffer-name)) (declare-function org-edit-src-exit "org-src" ()) (declare-function org-element-at-point "org-element" (&optional pom cached-only)) @@ -75,7 +77,7 @@ (declare-function org-narrow-to-subtree "org" (&optional element)) (declare-function org-next-block "org" (arg &optional backward block-regexp)) (declare-function org-open-at-point "org" (&optional in-emacs reference-buffer)) (declare-function org-previous-block "org" (arg &optional block-regexp)) -(declare-function org-show-context "org" (&optional key)) +(declare-function org-fold-show-context "org-fold" (&optional key)) (declare-function org-src-coderef-format "org-src" (&optional element)) (declare-function org-src-coderef-regexp "org-src" (fmt &optional label)) (declare-function org-src-get-lang-mode "org-src" (lang)) @@ -945,7 +947,7 @@ (defun org-babel-enter-header-arg-w-completion (&optional lang) (insert (concat header " " (or arg ""))) (cons header arg))) -(add-hook 'org-tab-first-hook 'org-babel-header-arg-expand) +(add-hook 'org-cycle-tab-first-hook 'org-babel-header-arg-expand) ;;;###autoload (defun org-babel-load-in-session (&optional _arg info) @@ -1469,7 +1471,7 @@ (defun org-babel-hide-result-toggle (&optional force) (push ov org-babel-hide-result-overlays))))) ;; org-tab-after-check-for-cycling-hook -(add-hook 'org-tab-first-hook #'org-babel-hide-result-toggle-maybe) +(add-hook 'org-cycle-tab-first-hook #'org-babel-hide-result-toggle-maybe) ;; Remove overlays when changing major mode (add-hook 'org-mode-hook (lambda () (add-hook 'change-major-mode-hook @@ -1817,7 +1819,7 @@ (defun org-babel-goto-named-src-block (name) (let ((point (org-babel-find-named-block name))) (if point ;; Taken from `org-open-at-point'. - (progn (org-mark-ring-push) (goto-char point) (org-show-context)) + (progn (org-mark-ring-push) (goto-char point) (org-fold-show-context)) (message "source-code block `%s' not found in this buffer" name)))) (defun org-babel-find-named-block (name) @@ -1857,7 +1859,7 @@ (defun org-babel-goto-named-result (name) (let ((point (org-babel-find-named-result name))) (if point ;; taken from `org-open-at-point' - (progn (goto-char point) (org-show-context)) + (progn (goto-char point) (org-fold-show-context)) (message "result `%s' not found in this buffer" name)))) (defun org-babel-find-named-result (name) diff --git a/lisp/ob-lilypond.el b/lisp/ob-lilypond.el index 15538b503..df128441a 100644 --- a/lisp/ob-lilypond.el +++ b/lisp/ob-lilypond.el @@ -34,7 +34,7 @@ ;;; Commentary: ;;; Code: (require 'ob) -(declare-function org-show-all "org" (&optional types)) +(declare-function org-fold-show-all "org-fold" (&optional types)) (defalias 'lilypond-mode 'LilyPond-mode) @@ -279,7 +279,7 @@ (defun org-babel-lilypond-mark-error-line (file-name line) (setq case-fold-search nil) (if (search-forward line nil t) (progn - (org-show-all) + (org-fold-show-all) (set-mark (point)) (goto-char (- (point) (length line)))) (goto-char temp)))) diff --git a/lisp/ob-ref.el b/lisp/ob-ref.el index db8ced6b6..1a77e39b1 100644 --- a/lisp/ob-ref.el +++ b/lisp/ob-ref.el @@ -62,8 +62,8 @@ (declare-function org-find-property "org" (property &optional value)) (declare-function org-id-find-id-file "org-id" (id)) (declare-function org-id-find-id-in-file "org-id" (id file &optional markerp)) (declare-function org-in-commented-heading-p "org" (&optional no-inheritance)) -(declare-function org-show-context "org" (&optional key)) (declare-function org-narrow-to-subtree "org" (&optional element)) +(declare-function org-fold-show-context "org-fold" (&optional key)) (defvar org-babel-update-intermediate nil "Update the in-buffer results of code blocks executed to resolve references.") @@ -104,7 +104,7 @@ (defun org-babel-ref-goto-headline-id (id) (pop-to-buffer-same-window (marker-buffer m)) (goto-char m) (move-marker m nil) - (org-show-context) + (org-fold-show-context) t)))) (defun org-babel-ref-headline-body () diff --git a/lisp/ol.el b/lisp/ol.el index b80f943b2..21bd854e9 100644 --- a/lisp/ol.el +++ b/lisp/ol.el @@ -29,6 +29,7 @@ ;;; Code: (require 'org-compat) (require 'org-macs) +(require 'org-fold) (defvar clean-buffer-list-kill-buffer-names) (defvar org-agenda-buffer-name) @@ -66,10 +67,10 @@ (declare-function org-mark-ring-push "org" (&optional pos buffer)) (declare-function org-mode "org" ()) (declare-function org-occur "org" (regexp &optional keep-previous callback)) (declare-function org-open-file "org" (path &optional in-emacs line search)) -(declare-function org-overview "org" ()) +(declare-function org-cycle-overview "org-cycle" ()) (declare-function org-restart-font-lock "org" ()) (declare-function org-run-like-in-org-mode "org" (cmd)) -(declare-function org-show-context "org" (&optional key)) +(declare-function org-fold-show-context "org-fold" (&optional key)) (declare-function org-src-coderef-format "org-src" (&optional element)) (declare-function org-src-coderef-regexp "org-src" (fmt &optional label)) (declare-function org-src-edit-buffer-p "org-src" (&optional buffer)) @@ -700,7 +701,7 @@ (defun org-link--buffer-for-internals () (make-indirect-buffer (current-buffer) indirect-buffer-name 'clone)))) - (with-current-buffer indirect-buffer (org-overview)) + (with-current-buffer indirect-buffer (org-cycle-overview)) indirect-buffer)))) (defun org-link--search-radio-target (target) @@ -718,7 +719,7 @@ (defun org-link--search-radio-target (target) (let ((object (org-element-context))) (when (eq (org-element-type object) 'radio-target) (goto-char (org-element-property :begin object)) - (org-show-context 'link-search) + (org-fold-show-context 'link-search) (throw :radio-match nil)))) (goto-char origin) (user-error "No match for radio target: %s" target)))) @@ -1257,7 +1258,7 @@ (defun org-link-search (s &optional avoid-pos stealth) (error "No match for fuzzy expression: %s" normalized))) ;; Disclose surroundings of match, if appropriate. (when (and (derived-mode-p 'org-mode) (not stealth)) - (org-show-context 'link-search)) + (org-fold-show-context 'link-search)) type)) (defun org-link-heading-search-string (&optional string) @@ -1430,7 +1431,7 @@ (defun org-next-link (&optional search-backward) (`nil nil) (link (goto-char (org-element-property :begin link)) - (when (org-invisible-p) (org-show-context)) + (when (org-invisible-p) (org-fold-show-context)) (throw :found t))))) (goto-char pos) (setq org-link--search-failed t) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index cc7cb5527..2802e8636 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -47,6 +47,7 @@ ;;; Code: (require 'cl-lib) (require 'ol) +(require 'org-fold-core) (require 'org) (require 'org-macs) (require 'org-refile) @@ -9392,7 +9393,7 @@ (defun org-agenda-goto (&optional highlight) (push-mark) (goto-char pos) (when (derived-mode-p 'org-mode) - (org-show-context 'agenda) + (org-fold-show-context 'agenda) (recenter (/ (window-height) 2)) (org-back-to-heading t) (let ((case-fold-search nil)) @@ -9681,7 +9682,7 @@ (defun org-agenda-switch-to (&optional delete-other-windows) (widen) (goto-char pos) (when (derived-mode-p 'org-mode) - (org-show-context 'agenda) + (org-fold-show-context 'agenda) (run-hooks 'org-agenda-after-show-hook))))) (defun org-agenda-goto-mouse (ev) @@ -9697,7 +9698,7 @@ (defun org-agenda-show (&optional full-entry) (interactive "P") (let ((win (selected-window))) (org-agenda-goto t) - (when full-entry (org-show-entry)) + (when full-entry (org-fold-show-entry)) (select-window win))) (defvar org-agenda-show-window nil) @@ -9716,12 +9717,12 @@ (defun org-agenda-show-and-scroll-up (&optional arg) (select-window org-agenda-show-window) (ignore-errors (scroll-up))) (org-agenda-goto t) - (org-show-entry) + (org-fold-show-entry) (if arg (org-cycle-hide-drawers 'children) (org-with-wide-buffer (narrow-to-region (org-entry-beginning-position) (org-entry-end-position)) - (org-show-all '(drawers)))) + (org-fold-show-all '(drawers)))) (setq org-agenda-show-window (selected-window))) (select-window win))) @@ -9752,7 +9753,7 @@ (defun org-agenda-show-1 (&optional more) (set-window-start (selected-window) (point-at-bol)) (cond ((= more 0) - (org-flag-subtree t) + (org-fold-subtree t) (save-excursion (org-back-to-heading) (run-hook-with-args 'org-cycle-hook 'folded)) @@ -9760,20 +9761,20 @@ (defun org-agenda-show-1 (&optional more) ((and (called-interactively-p 'any) (= more 1)) (message "Remote: show with default settings")) ((= more 2) - (outline-show-entry) - (org-show-children) + (org-fold-show-entry) + (org-fold-show-children) (save-excursion (org-back-to-heading) (run-hook-with-args 'org-cycle-hook 'children)) (message "Remote: CHILDREN")) ((= more 3) - (outline-show-subtree) + (org-fold-show-subtree) (save-excursion (org-back-to-heading) (run-hook-with-args 'org-cycle-hook 'subtree)) (message "Remote: SUBTREE")) ((> more 3) - (outline-show-subtree) + (org-fold-show-subtree) (message "Remote: SUBTREE AND ALL DRAWERS"))) (select-window win))) @@ -9905,7 +9906,7 @@ (defun org-agenda-todo (&optional arg) (with-current-buffer buffer (widen) (goto-char pos) - (org-show-context 'agenda) + (org-fold-show-context 'agenda) (let ((current-prefix-arg arg)) (call-interactively 'org-todo) ;; Make sure that log is recorded in current undo. @@ -9946,7 +9947,7 @@ (defun org-agenda-add-note (&optional _arg) (with-current-buffer buffer (widen) (goto-char pos) - (org-show-context 'agenda) + (org-fold-show-context 'agenda) (org-add-note)))) (defun org-agenda-change-all-lines (newhead hdmarker @@ -10095,7 +10096,7 @@ (defun org-agenda-priority (&optional force-direction) (with-current-buffer buffer (widen) (goto-char pos) - (org-show-context 'agenda) + (org-fold-show-context 'agenda) (org-priority force-direction) (end-of-line 1) (setq newhead (org-get-heading))) @@ -10119,7 +10120,7 @@ (defun org-agenda-set-tags (&optional tag onoff) (with-current-buffer buffer (widen) (goto-char pos) - (org-show-context 'agenda) + (org-fold-show-context 'agenda) (if tag (org-toggle-tag tag onoff) (call-interactively #'org-set-tags-command)) @@ -10144,7 +10145,7 @@ (defun org-agenda-set-property () (with-current-buffer buffer (widen) (goto-char pos) - (org-show-context 'agenda) + (org-fold-show-context 'agenda) (call-interactively 'org-set-property)))))) (defun org-agenda-set-effort () @@ -10163,7 +10164,7 @@ (defun org-agenda-set-effort () (with-current-buffer buffer (widen) (goto-char pos) - (org-show-context 'agenda) + (org-fold-show-context 'agenda) (call-interactively 'org-set-effort) (end-of-line 1) (setq newhead (org-get-heading))) @@ -10185,7 +10186,7 @@ (defun org-agenda-toggle-archive-tag () (with-current-buffer buffer (widen) (goto-char pos) - (org-show-context 'agenda) + (org-fold-show-context 'agenda) (call-interactively 'org-toggle-archive-tag) (end-of-line 1) (setq newhead (org-get-heading))) @@ -10395,7 +10396,7 @@ (defun org-agenda-clock-in (&optional arg) (with-current-buffer (marker-buffer marker) (widen) (goto-char pos) - (org-show-context 'agenda) + (org-fold-show-context 'agenda) (org-clock-in arg) (setq newhead (org-get-heading))) (org-agenda-change-all-lines newhead hdmarker)) @@ -10484,7 +10485,7 @@ (defun org-agenda-diary-entry-in-org-file () (find-file-noselect org-agenda-diary-file)) (require 'org-datetree) (org-datetree-find-date-create d1) - (org-reveal t)) + (org-fold-reveal t)) (t (user-error "Invalid selection character `%c'" char))))) (defcustom org-agenda-insert-diary-strategy 'date-tree @@ -10586,7 +10587,7 @@ (defun org-agenda-add-entry-to-org-agenda-diary-file (type text &optional d1 d2) (message "%s entry added to %s" (capitalize (symbol-name type)) (abbreviate-file-name org-agenda-diary-file))) - (org-reveal t) + (org-fold-reveal t) (message "Please finish entry here")))) (defun org-agenda-insert-diary-as-top-level (text) @@ -10624,7 +10625,7 @@ (defun org-agenda-insert-diary-make-new-entry (text) (unless (bolp) (insert "\n")) (unless (looking-at-p "^[ \t]*$") (save-excursion (insert "\n"))) (when org-adapt-indentation (indent-to-column col))) - (org-show-set-visibility 'lineage)) + (org-fold-show-set-visibility 'lineage)) (defun org-agenda-diary-entry () "Make a diary entry, like the `i' command from the calendar. diff --git a/lisp/org-archive.el b/lisp/org-archive.el index 6ea16f8c1..1026a295e 100644 --- a/lisp/org-archive.el +++ b/lisp/org-archive.el @@ -324,7 +324,7 @@ (defun org-archive-subtree (&optional find-done) (org-todo-regexp tr-org-todo-regexp) (org-todo-line-regexp tr-org-todo-line-regexp)) (goto-char (point-min)) - (org-show-all '(headings blocks)) + (org-fold-show-all '(headings blocks)) (if (and heading (not (and datetree-date (not datetree-subheading-p)))) (progn (if (re-search-forward @@ -339,7 +339,7 @@ (defun org-archive-subtree (&optional find-done) (insert (if datetree-date "" "\n") heading "\n") (end-of-line 0)) ;; Make the subtree visible - (outline-show-subtree) + (org-fold-show-subtree) (if org-archive-reversed-order (progn (org-back-to-heading t) @@ -417,7 +417,7 @@ (defun org-archive-subtree (&optional find-done) (if (eq this-buffer buffer) (concat "under heading: " heading) (concat "in file: " (abbreviate-file-name afile))))))) - (org-reveal) + (org-fold-reveal) (if (looking-at "^[ \t]*$") (outline-next-visible-heading 1)))) @@ -487,13 +487,13 @@ (defun org-archive-to-archive-sibling () (format-time-string (substring (cdr org-time-stamp-formats) 1 -1))) (outline-up-heading 1 t) - (org-flag-subtree t) + (org-fold-subtree t) (org-cycle-show-empty-lines 'folded) (when org-provide-todo-statistics ;; Update TODO statistics of parent. (org-update-parent-todo-statistics)) (goto-char pos))) - (org-reveal) + (org-fold-reveal) (if (looking-at "^[ \t]*$") (outline-next-visible-heading 1)))) @@ -602,7 +602,7 @@ (defun org-toggle-archive-tag (&optional find-done) (save-excursion (org-back-to-heading t) (setq set (org-toggle-tag org-archive-tag)) - (when set (org-flag-subtree t))) + (when set (org-fold-subtree t))) (and set (beginning-of-line 1)) (message "Subtree %s" (if set "archived" "unarchived")))))) diff --git a/lisp/org-capture.el b/lisp/org-capture.el index 5195b785e..1d4d6e877 100644 --- a/lisp/org-capture.el +++ b/lisp/org-capture.el @@ -1129,7 +1129,7 @@ (defun org-capture-place-template (&optional inhibit-wconf-store) (org-switch-to-buffer-other-window (org-capture-get-indirect-buffer (org-capture-get :buffer) "CAPTURE")) (widen) - (org-show-all) + (org-fold-show-all) (goto-char (org-capture-get :pos)) (setq-local outline-level 'org-outline-level) (pcase (org-capture-get :type) diff --git a/lisp/org-clock.el b/lisp/org-clock.el index 6f441c18e..583b30237 100644 --- a/lisp/org-clock.el +++ b/lisp/org-clock.el @@ -1035,7 +1035,7 @@ (defun org-clock-jump-to-current-clock (&optional effective-clock) (let ((element (org-element-at-point))) (when (eq (org-element-type element) 'drawer) (when (> (org-element-property :end element) (car clock)) - (org-hide-drawer-toggle 'off nil element)) + (org-fold-hide-drawer-toggle 'off nil element)) (throw 'exit nil))))))))))) (defun org-clock-resolve (clock &optional prompt-fn last-valid fail-quietly) @@ -1843,10 +1843,10 @@ (defun org-clock-goto (&optional select) (pop-to-buffer-same-window (marker-buffer m)) (if (or (< m (point-min)) (> m (point-max))) (widen)) (goto-char m) - (org-show-entry) + (org-fold-show-entry) (org-back-to-heading t) (recenter org-clock-goto-before-context) - (org-reveal) + (org-fold-reveal) (if recent (message "No running clock, this is the most recently clocked task")) (run-hooks 'org-clock-goto-hook))) @@ -2140,7 +2140,7 @@ (defun org-clock-report (&optional arg) (org-clock-remove-overlays) (when arg (org-find-dblock "clocktable") - (org-show-entry)) + (org-fold-show-entry)) (pcase (org-in-clocktable-p) (`nil (org-create-dblock @@ -3125,7 +3125,7 @@ (defun org-clock-load () (let ((org-clock-in-resume 'auto-restart) (org-clock-auto-clock-resolution nil)) (org-clock-in) - (when (org-invisible-p) (org-show-context)))))) + (when (org-invisible-p) (org-fold-show-context)))))) (_ nil))))) (defun org-clock-kill-emacs-query () diff --git a/lisp/org-colview.el b/lisp/org-colview.el index 15cab35f0..c8443c135 100644 --- a/lisp/org-colview.el +++ b/lisp/org-colview.el @@ -159,8 +159,8 @@ (defconst org-columns-summary-types-default (defun org-columns-content () "Switch to contents view while in columns view." (interactive) - (org-overview) - (org-content)) + (org-cycle-overview) + (org-cycle-content)) (org-defkey org-columns-map "c" #'org-columns-content) (org-defkey org-columns-map "o" #'org-overview) @@ -701,7 +701,7 @@ (defun org-columns--call (fun) (move-beginning-of-line 2) (org-at-heading-p))))) (unwind-protect (funcall fun) - (when hide-body (outline-hide-entry))))) + (when hide-body (org-fold-hide-entry))))) (defun org-columns-previous-allowed-value () "Switch to the previous allowed value for this column." diff --git a/lisp/org-compat.el b/lisp/org-compat.el index 38d330de6..772ef37f9 100644 --- a/lisp/org-compat.el +++ b/lisp/org-compat.el @@ -50,18 +50,20 @@ (declare-function org-element-property "org-element" (property element)) (declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading)) (declare-function org-get-heading "org" (&optional no-tags no-todo no-priority no-comment)) (declare-function org-get-tags "org" (&optional pos local)) -(declare-function org-hide-block-toggle "org" (&optional force no-error element)) +(declare-function org-fold-hide-block-toggle "org-fold" (&optional force no-error element)) (declare-function org-link-display-format "ol" (s)) (declare-function org-link-set-parameters "ol" (type &rest rest)) (declare-function org-log-into-drawer "org" ()) (declare-function org-make-tag-string "org" (tags)) (declare-function org-reduced-level "org" (l)) (declare-function org-return "org" (&optional indent arg interactive)) -(declare-function org-show-context "org" (&optional key)) +(declare-function org-fold-show-context "org-fold" (&optional key)) (declare-function org-table-end "org-table" (&optional table-type)) (declare-function outline-next-heading "outline" ()) (declare-function speedbar-line-directory "speedbar" (&optional depth)) (declare-function table--at-cell-p "table" (position &optional object at-column)) +(declare-function org-fold-region "org-fold" (from to flag &optional spec)) +(declare-function org-fold-show-all "org-fold" (&optional types)) (defvar calendar-mode-map) (defvar org-complex-heading-regexp) @@ -72,6 +74,7 @@ (defvar org-table-any-border-regexp) (defvar org-table-dataline-regexp) (defvar org-table-tab-recognizes-table.el) (defvar org-table1-hline-regexp) +(defvar org-fold-core-style) \f ;;; Emacs < 28.1 compatibility @@ -627,7 +630,7 @@ (make-obsolete 'org-capture-import-remember-templates (defun org-show-block-all () "Unfold all blocks in the current buffer." (interactive) - (remove-overlays nil nil 'invisible 'org-hide-block)) + (org-fold-show-all '(blocks))) (make-obsolete 'org-show-block-all "use `org-show-all' instead." @@ -670,7 +673,7 @@ (defun org-flag-drawer (flag &optional element beg end) When buffer positions BEG and END are provided, hide or show that region as a drawer without further ado." (declare (obsolete "use `org-hide-drawer-toggle' instead." "9.4")) - (if (and beg end) (org-flag-region beg end flag 'outline) + (if (and beg end) (org-fold-region beg end flag (if (eq org-fold-core-style 'text-properties) 'drawer 'outline)) (let ((drawer (or element (and (save-excursion @@ -679,12 +682,12 @@ (defun org-flag-drawer (flag &optional element beg end) (org-element-at-point))))) (when (memq (org-element-type drawer) '(drawer property-drawer)) (let ((post (org-element-property :post-affiliated drawer))) - (org-flag-region + (org-fold-region (save-excursion (goto-char post) (line-end-position)) (save-excursion (goto-char (org-element-property :end drawer)) (skip-chars-backward " \t\n") (line-end-position)) - flag 'outline) + flag (if (eq org-fold-core-style 'text-properties) 'drawer 'outline)) ;; When the drawer is hidden away, make sure point lies in ;; a visible part of the buffer. (when (invisible-p (max (1- (point)) (point-min))) @@ -696,7 +699,7 @@ (defun org-hide-block-toggle-maybe () an error. Return a non-nil value when toggling is successful." (declare (obsolete "use `org-hide-block-toggle' instead." "9.4")) (interactive) - (org-hide-block-toggle nil t)) + (org-fold-hide-block-toggle nil t)) (defun org-hide-block-toggle-all () "Toggle the visibility of all blocks in the current buffer." @@ -712,7 +715,7 @@ (defun org-hide-block-toggle-all () (save-excursion (save-match-data (goto-char (match-beginning 0)) - (org-hide-block-toggle))))))) + (org-fold-hide-block-toggle))))))) (defun org-return-indent () "Goto next table row or insert a newline and indent. @@ -941,7 +944,7 @@ (eval-after-load 'imenu (add-hook 'imenu-after-jump-hook (lambda () (when (derived-mode-p 'org-mode) - (org-show-context 'org-goto)))) + (org-fold-show-context 'org-goto)))) (add-hook 'org-mode-hook (lambda () (setq imenu-create-index-function 'org-imenu-get-tree))))) @@ -1006,7 +1009,7 @@ (eval-after-load 'speedbar (define-key speedbar-file-key-map ">" 'org-agenda-remove-restriction-lock) (define-key speedbar-file-key-map "\C-c\C-x>" 'org-agenda-remove-restriction-lock) (add-hook 'speedbar-visiting-tag-hook - (lambda () (and (derived-mode-p 'org-mode) (org-show-context 'org-goto)))))) + (lambda () (and (derived-mode-p 'org-mode) (org-fold-show-context 'org-goto)))))) ;;;; Add Log @@ -1120,7 +1123,7 @@ (defun org-bookmark-jump-unhide () (or (org-invisible-p) (save-excursion (goto-char (max (point-min) (1- (point)))) (org-invisible-p))) - (org-show-context 'bookmark-jump))) + (org-fold-show-context 'bookmark-jump))) ;; Make `bookmark-jump' shows the jump location if it was hidden. (add-hook 'bookmark-after-jump-hook 'org-bookmark-jump-unhide) @@ -1188,7 +1191,7 @@ (eval-after-load 'ecb '(defadvice ecb-method-clicked (after esf/org-show-context activate) "Make hierarchy visible when jumping into location from ECB tree buffer." (when (derived-mode-p 'org-mode) - (org-show-context)))) + (org-fold-show-context)))) ;;;; Simple @@ -1196,7 +1199,7 @@ (defun org-mark-jump-unhide () "Make the point visible with `org-show-context' after jumping to the mark." (when (and (derived-mode-p 'org-mode) (org-invisible-p)) - (org-show-context 'mark-goto))) + (org-fold-show-context 'mark-goto))) (eval-after-load 'simple '(defadvice pop-to-mark-command (after org-make-visible activate) diff --git a/lisp/org-crypt.el b/lisp/org-crypt.el index 41813cb18..b2542ab43 100644 --- a/lisp/org-crypt.el +++ b/lisp/org-crypt.el @@ -73,7 +73,7 @@ (declare-function org-before-first-heading-p "org" ()) (declare-function org-end-of-meta-data "org" (&optional full)) (declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading)) (declare-function org-entry-get "org" (pom property &optional inherit literal-nil)) -(declare-function org-flag-subtree "org" (flag)) +(declare-function org-fold-subtree "org-fold" (flag)) (declare-function org-make-tags-matcher "org" (match)) (declare-function org-previous-visible-heading "org" (arg)) (declare-function org-scan-tags "org" (action matcher todo-only &optional start-level)) @@ -243,7 +243,7 @@ (defun org-encrypt-entry () (error (error-message-string err))))) (when folded-heading (goto-char folded-heading) - (org-flag-subtree t)) + (org-fold-subtree t)) nil))))) ;;;###autoload @@ -280,7 +280,7 @@ (defun org-decrypt-entry () 'org-crypt-text encrypted-text)) (when folded-heading (goto-char folded-heading) - (org-flag-subtree t)) + (org-fold-subtree t)) nil))) (_ nil))) @@ -313,7 +313,7 @@ (defun org-crypt-use-before-save-magic () 'org-mode-hook (lambda () (add-hook 'before-save-hook 'org-encrypt-entries nil t)))) -(add-hook 'org-reveal-start-hook 'org-decrypt-entry) +(add-hook 'org-fold-reveal-start-hook 'org-decrypt-entry) (provide 'org-crypt) diff --git a/lisp/org-element.el b/lisp/org-element.el index 77a9fc6e3..99999fb32 100644 --- a/lisp/org-element.el +++ b/lisp/org-element.el @@ -70,6 +70,7 @@ (require 'org-footnote) (require 'org-list) (require 'org-macs) (require 'org-table) +(require 'org-fold-core) (declare-function org-at-heading-p "org" (&optional _)) (declare-function org-escape-code-in-string "org-src" (s)) diff --git a/lisp/org-feed.el b/lisp/org-feed.el index a5fea0888..d634f9c41 100644 --- a/lisp/org-feed.el +++ b/lisp/org-feed.el @@ -412,8 +412,8 @@ (defun org-feed-update (feed &optional retrieve-only) ;; Normalize the visibility of the inbox tree (goto-char inbox-pos) - (org-flag-subtree t) - (org-show-children) + (org-fold-subtree t) + (org-fold-show-children) ;; Hooks and messages (when org-feed-save-after-adding (save-buffer)) diff --git a/lisp/org-footnote.el b/lisp/org-footnote.el index b55f6d98e..a4c9ae770 100644 --- a/lisp/org-footnote.el +++ b/lisp/org-footnote.el @@ -52,7 +52,7 @@ (declare-function org-in-verbatim-emphasis "org" ()) (declare-function org-inside-LaTeX-fragment-p "org" ()) (declare-function org-inside-latex-macro-p "org" ()) (declare-function org-mark-ring-push "org" (&optional pos buffer)) -(declare-function org-show-context "org" (&optional key)) +(declare-function org-fold-show-context "org-fold" (&optional key)) (declare-function outline-next-heading "outline") (defvar electric-indent-mode) @@ -555,7 +555,7 @@ (defun org-footnote-goto-definition (label &optional location) (goto-char def-start) (looking-at (format "\\[fn:%s[]:]" (regexp-quote label))) (goto-char (match-end 0)) - (org-show-context 'link-search) + (org-fold-show-context 'link-search) (when (derived-mode-p 'org-mode) (message "%s" (substitute-command-keys "Edit definition and go back with \ @@ -581,7 +581,7 @@ (defun org-footnote-goto-previous-reference (label) (user-error "Reference is outside narrowed part of buffer"))) (org-mark-ring-push) (goto-char start) - (org-show-context 'link-search))) + (org-fold-show-context 'link-search))) \f ;;;; Getters diff --git a/lisp/org-goto.el b/lisp/org-goto.el index 860b0a3de..cd5000037 100644 --- a/lisp/org-goto.el +++ b/lisp/org-goto.el @@ -222,13 +222,13 @@ (defun org-goto-location (&optional _buf help) " Just type for auto-isearch." " n/p/f/b/u to navigate, q to quit."))))) (org-fit-window-to-buffer (get-buffer-window "*Org Help*")) - (org-overview) + (org-cycle-overview) (setq buffer-read-only t) (if (and (boundp 'org-goto-start-pos) (integer-or-marker-p org-goto-start-pos)) (progn (goto-char org-goto-start-pos) (when (org-invisible-p) - (org-show-set-visibility 'lineage))) + (org-fold-show-set-visibility 'lineage))) (goto-char (point-min))) (let (org-special-ctrl-a/e) (org-beginning-of-line)) (message "Select location and press RET") @@ -279,7 +279,7 @@ (defun org-goto (&optional alternative-interface) (org-mark-ring-push org-goto-start-pos) (goto-char selected-point) (when (or (org-invisible-p) (org-invisible-p2)) - (org-show-context 'org-goto))) + (org-fold-show-context 'org-goto))) (message "Quit")))) (provide 'org-goto) diff --git a/lisp/org-id.el b/lisp/org-id.el index b4acec7bd..780907cfa 100644 --- a/lisp/org-id.el +++ b/lisp/org-id.el @@ -331,7 +331,7 @@ (defun org-id-goto (id) (pop-to-buffer-same-window (marker-buffer m)) (goto-char m) (move-marker m nil) - (org-show-context))) + (org-fold-show-context))) ;;;###autoload (defun org-id-find (id &optional markerp) @@ -742,7 +742,7 @@ (defun org-id-open (id _) (funcall cmd (marker-buffer m))) (goto-char m) (move-marker m nil) - (org-show-context))) + (org-fold-show-context))) (org-link-set-parameters "id" :follow #'org-id-open) diff --git a/lisp/org-keys.el b/lisp/org-keys.el index b8e9ddd93..782ffa871 100644 --- a/lisp/org-keys.el +++ b/lisp/org-keys.el @@ -67,8 +67,8 @@ (declare-function org-ctrl-c-star "org" ()) (declare-function org-ctrl-c-tab "org" (&optional arg)) (declare-function org-cut-special "org" ()) (declare-function org-cut-subtree "org" (&optional n)) -(declare-function org-cycle "org" (&optional arg)) -(declare-function org-cycle-agenda-files "org" ()) +(declare-function org-cycle "org-cycle" (&optional arg)) +(declare-function org-cycle-agenda-files "org-cycle" ()) (declare-function org-date-from-calendar "org" ()) (declare-function org-dynamic-block-insert-dblock "org" (&optional arg)) (declare-function org-dblock-update "org" (&optional arg)) @@ -94,7 +94,7 @@ (declare-function org-feed-update-all "org" ()) (declare-function org-fill-paragraph "org" (&optional justify region)) (declare-function org-find-file-at-mouse "org" (ev)) (declare-function org-footnote-action "org" (&optional special)) -(declare-function org-force-cycle-archived "org" ()) +(declare-function org-cycle-force-archived "org-cycle" ()) (declare-function org-force-self-insert "org" (n)) (declare-function org-forward-element "org" ()) (declare-function org-forward-heading-same-level "org" (arg &optional invisible-ok)) @@ -143,8 +143,8 @@ (declare-function org-previous-visible-heading "org" (arg)) (declare-function org-priority "org" (&optional action show)) (declare-function org-promote-subtree "org" ()) (declare-function org-redisplay-inline-images "org" ()) -(declare-function org-refile "org" (&optional arg1 default-buffer rfloc msg)) -(declare-function org-refile-copy "org" ()) +(declare-function org-refile "org-refile" (&optional arg1 default-buffer rfloc msg)) +(declare-function org-refile-copy "org-refile" ()) (declare-function org-refile-reverse "org-refile" (&optional arg default-buffer rfloc msg)) (declare-function org-reftex-citation "org" ()) (declare-function org-reload "org" (&optional arg1)) @@ -152,7 +152,7 @@ (declare-function org-remove-file "org" (&optional file)) (declare-function org-resolve-clocks "org" (&optional only-dangling-p prompt-fn last-valid)) (declare-function org-return "org" (&optional indent)) (declare-function org-return-and-maybe-indent "org" ()) -(declare-function org-reveal "org" (&optional siblings)) +(declare-function org-fold-reveal "org-fold" (&optional siblings)) (declare-function org-schedule "org" (arg &optional time)) (declare-function org-self-insert-command "org" (N)) (declare-function org-set-effort "org" (&optional increment value)) @@ -172,9 +172,9 @@ (declare-function org-shiftmetaup "org" (&optional arg)) (declare-function org-shiftright "org" (&optional arg)) (declare-function org-shifttab "org" (&optional arg)) (declare-function org-shiftup "org" (&optional arg)) -(declare-function org-show-all "org" (&optional types)) -(declare-function org-show-children "org" (&optional level)) -(declare-function org-show-subtree "org" ()) +(declare-function org-fold-show-all "org-fold" (&optional types)) +(declare-function org-fold-show-children "org-fold" (&optional level)) +(declare-function org-fold-show-subtree "org-fold" ()) (declare-function org-sort "org" (&optional with-case)) (declare-function org-sparse-tree "org" (&optional arg type)) (declare-function org-table-copy-down "org" (n)) @@ -423,7 +423,7 @@ (define-key org-mode-map [menu-bar hide] 'undefined) (define-key org-mode-map [menu-bar show] 'undefined) (define-key org-mode-map [remap outline-mark-subtree] #'org-mark-subtree) -(define-key org-mode-map [remap outline-show-subtree] #'org-show-subtree) +(define-key org-mode-map [remap outline-show-subtree] #'org-fold-show-subtree) (define-key org-mode-map [remap outline-forward-same-level] #'org-forward-heading-same-level) (define-key org-mode-map [remap outline-backward-same-level] @@ -437,14 +437,14 @@ (define-key org-mode-map [remap outline-next-visible-heading] #'org-next-visible-heading) (define-key org-mode-map [remap outline-previous-visible-heading] #'org-previous-visible-heading) -(define-key org-mode-map [remap show-children] #'org-show-children) +(define-key org-mode-map [remap outline-show-children] #'org-fold-show-children) ;;;; Make `C-c C-x' a prefix key (org-defkey org-mode-map (kbd "C-c C-x") (make-sparse-keymap)) ;;;; TAB key with modifiers (org-defkey org-mode-map (kbd "TAB") #'org-cycle) -(org-defkey org-mode-map (kbd "C-c C-<tab>") #'org-force-cycle-archived) +(org-defkey org-mode-map (kbd "C-c C-<tab>") #'org-cycle-force-archived) ;; Override text-mode binding to expose `complete-symbol' for ;; pcomplete functionality. (org-defkey org-mode-map (kbd "M-TAB") nil) @@ -544,7 +544,7 @@ (org-remap org-mode-map ;;;; All the other keys (org-defkey org-mode-map (kbd "|") #'org-force-self-insert) -(org-defkey org-mode-map (kbd "C-c C-r") #'org-reveal) +(org-defkey org-mode-map (kbd "C-c C-r") #'org-fold-reveal) (org-defkey org-mode-map (kbd "C-M-t") #'org-transpose-element) (org-defkey org-mode-map (kbd "M-}") #'org-forward-element) (org-defkey org-mode-map (kbd "ESC }") #'org-forward-element) diff --git a/lisp/org-lint.el b/lisp/org-lint.el index 10b9a3589..3518edeb1 100644 --- a/lisp/org-lint.el +++ b/lisp/org-lint.el @@ -91,6 +91,7 @@ (require 'oc) (require 'ol) (require 'org-attach) (require 'org-macro) +(require 'org-fold) (require 'ox) (require 'seq) @@ -264,7 +265,7 @@ (defun org-lint--jump-to-source () (let ((l (org-lint--current-line))) (switch-to-buffer-other-window org-lint--source-buffer) (org-goto-line l) - (org-show-set-visibility 'local) + (org-fold-show-set-visibility 'local) (recenter))) (defun org-lint--show-source () diff --git a/lisp/org-list.el b/lisp/org-list.el index 3533c8319..187e9a9ff 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -79,6 +79,7 @@ ;;; Code: (require 'cl-lib) (require 'org-macs) (require 'org-compat) +(require 'org-fold-core) (defvar org-M-RET-may-split-line) (defvar org-adapt-indentation) @@ -138,7 +139,8 @@ (declare-function org-outline-level "org" ()) (declare-function org-previous-line-empty-p "org" ()) (declare-function org-reduced-level "org" (L)) (declare-function org-set-tags "org" (tags)) -(declare-function org-show-subtree "org" ()) +(declare-function org-fold-show-subtree "org-fold" ()) +(declare-function org-fold-region "org-fold" (from to flag &optional spec)) (declare-function org-sort-remove-invisible "org" (S)) (declare-function org-time-string-to-seconds "org" (s)) (declare-function org-timer-hms-to-secs "org-timer" (hms)) @@ -2029,7 +2031,7 @@ (defun org-list-set-item-visibility (item struct view) ((eq view 'folded) (let ((item-end (org-list-get-item-end-before-blank item struct))) ;; Hide from eol - (org-flag-region (save-excursion (goto-char item) (line-end-position)) + (org-fold-region (save-excursion (goto-char item) (line-end-position)) item-end t 'outline))) ((eq view 'children) ;; First show everything. @@ -2042,7 +2044,7 @@ (defun org-list-set-item-visibility (item struct view) ((eq view 'subtree) ;; Show everything (let ((item-end (org-list-get-item-end item struct))) - (org-flag-region item item-end nil 'outline))))) + (org-fold-region item item-end nil 'outline))))) (defun org-list-item-body-column (item) "Return column at which body of ITEM should start." @@ -2455,7 +2457,7 @@ (defun org-reset-checkbox-state-subtree () (save-restriction (save-excursion (org-narrow-to-subtree) - (org-show-subtree) + (org-fold-show-subtree) (goto-char (point-min)) (let ((end (point-max))) (while (< (point) end) diff --git a/lisp/org-macs.el b/lisp/org-macs.el index 8d156fa2f..2968e2ba5 100644 --- a/lisp/org-macs.el +++ b/lisp/org-macs.el @@ -35,11 +35,16 @@ (require 'cl-lib) (require 'format-spec) (declare-function org-mode "org" ()) -(declare-function org-show-context "org" (&optional key)) +(declare-function org-agenda-files "org" (&optional unrestricted archives)) +(declare-function org-fold-show-context "org-fold" (&optional key)) +(declare-function org-fold-save-outline-visibility "org-fold" (use-markers &rest body)) +(declare-function org-fold-next-visibility-change "org-fold" (&optional pos limit ignore-hidden-p previous-p)) +(declare-function org-fold-folded-p "org-fold" (&optional pos limit ignore-hidden-p previous-p)) (declare-function string-collate-lessp "org-compat" (s1 s2 &optional locale ignore-case)) (defvar org-ts-regexp0) (defvar ffap-url-regexp) +(defvar org-fold-core-style) \f ;;; Macros @@ -117,38 +122,7 @@ (defmacro org-no-read-only (&rest body) (declare (debug (body))) `(let ((inhibit-read-only t)) ,@body)) -(defmacro org-save-outline-visibility (use-markers &rest body) - "Save and restore outline visibility around BODY. -If USE-MARKERS is non-nil, use markers for the positions. This -means that the buffer may change while running BODY, but it also -means that the buffer should stay alive during the operation, -because otherwise all these markers will point to nowhere." - (declare (debug (form body)) (indent 1)) - (org-with-gensyms (data invisible-types markers?) - `(let* ((,invisible-types '(org-hide-block outline)) - (,markers? ,use-markers) - (,data - (mapcar (lambda (o) - (let ((beg (overlay-start o)) - (end (overlay-end o)) - (type (overlay-get o 'invisible))) - (and beg end - (> end beg) - (memq type ,invisible-types) - (list (if ,markers? (copy-marker beg) beg) - (if ,markers? (copy-marker end t) end) - type)))) - (org-with-wide-buffer - (overlays-in (point-min) (point-max)))))) - (unwind-protect (progn ,@body) - (org-with-wide-buffer - (dolist (type ,invisible-types) - (remove-overlays (point-min) (point-max) 'invisible type)) - (pcase-dolist (`(,beg ,end ,type) (delq nil ,data)) - (org-flag-region beg end t type) - (when ,markers? - (set-marker beg nil) - (set-marker end nil)))))))) +(defalias 'org-save-outline-visibility #'org-fold-save-outline-visibility) (defmacro org-with-wide-buffer (&rest body) "Execute body while temporarily widening the buffer." diff --git a/lisp/org-mobile.el b/lisp/org-mobile.el index 5cfaa7fe0..dd5333399 100644 --- a/lisp/org-mobile.el +++ b/lisp/org-mobile.el @@ -1064,7 +1064,7 @@ (defun org-mobile-edit (what old new) (progn ;; Workaround a `org-insert-heading-respect-content' bug ;; which prevents correct insertion when point is invisible - (org-show-subtree) + (org-fold-show-subtree) (end-of-line 1) (org-insert-heading-respect-content t) (org-demote)) diff --git a/lisp/org-mouse.el b/lisp/org-mouse.el index 8d5be4254..fadd38848 100644 --- a/lisp/org-mouse.el +++ b/lisp/org-mouse.el @@ -1003,10 +1003,10 @@ (defun org-mouse-do-remotely (command) (with-current-buffer buffer (widen) (goto-char pos) - (org-show-hidden-entry) + (org-fold-show-hidden-entry) (save-excursion (and (outline-next-heading) - (org-flag-heading nil))) ; show the next heading + (org-fold-heading nil))) ; show the next heading (org-back-to-heading) (setq marker (point-marker)) (goto-char (max (point-at-bol) (- (point-at-eol) anticol))) diff --git a/lisp/org-refile.el b/lisp/org-refile.el index 5dfffe785..d68760623 100644 --- a/lisp/org-refile.el +++ b/lisp/org-refile.el @@ -521,7 +521,7 @@ (defun org-refile (&optional arg default-buffer rfloc msg) (goto-char (cond (pos) ((org-notes-order-reversed-p) (point-min)) (t (point-max)))) - (org-show-context 'org-goto)) + (org-fold-show-context 'org-goto)) (if regionp (progn (org-kill-new (buffer-substring region-start region-end)) diff --git a/lisp/org-src.el b/lisp/org-src.el index 4fac93400..1197540d1 100644 --- a/lisp/org-src.el +++ b/lisp/org-src.el @@ -1356,8 +1356,10 @@ (defun org-edit-src-exit () (goto-char beg) (cond ;; Block is hidden; move at start of block. - ((cl-some (lambda (o) (eq (overlay-get o 'invisible) 'org-hide-block)) - (overlays-at (point))) + ((if (eq org-fold-core-style 'text-properties) + (org-fold-folded-p nil 'block) + (cl-some (lambda (o) (eq (overlay-get o 'invisible) 'org-hide-block)) + (overlays-at (point)))) (beginning-of-line 0)) (write-back (org-src--goto-coordinates coordinates beg end)))) ;; Clean up left-over markers and restore window configuration. diff --git a/lisp/org-timer.el b/lisp/org-timer.el index a6f3648fa..0c9350e76 100644 --- a/lisp/org-timer.el +++ b/lisp/org-timer.el @@ -478,7 +478,7 @@ (defun org-timer--get-timer-title () (with-current-buffer (marker-buffer marker) (org-with-wide-buffer (goto-char hdmarker) - (org-show-entry) + (org-fold-show-entry) (or (ignore-errors (org-get-heading)) (buffer-name (buffer-base-buffer)))))))) ((derived-mode-p 'org-mode) diff --git a/lisp/org.el b/lisp/org.el index b17a5477c..ebc9d81db 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -96,6 +96,9 @@ (require 'org-keys) (require 'ol) (require 'oc) (require 'org-table) +(require 'org-fold) + +(require 'org-cycle) ;; `org-outline-regexp' ought to be a defconst but is let-bound in ;; some places -- e.g. see the macro `org-with-limited-levels'. @@ -4669,7 +4672,7 @@ (define-derived-mode org-mode outline-mode "Org" t)) (when org-startup-with-inline-images (org-display-inline-images)) (when org-startup-with-latex-preview (org-latex-preview '(16))) - (unless org-inhibit-startup-visibility-stuff (org-set-startup-visibility)) + (unless org-inhibit-startup-visibility-stuff (org-cycle-set-startup-visibility)) (when org-startup-truncated (setq truncate-lines t)) (when org-startup-numerated (require 'org-num) (org-num-mode 1)) (when org-startup-indented (require 'org-indent) (org-indent-mode 1)))) @@ -5864,7 +5867,7 @@ (defun org-tree-to-indirect-buffer (&optional arg) (pop-to-buffer ibuf)) (t (error "Invalid value"))) (narrow-to-region beg end) - (org-show-all '(headings drawers blocks)) + (org-fold-show-all '(headings drawers blocks)) (goto-char pos) (run-hook-with-args 'org-cycle-hook 'all) (and (window-live-p cwin) (select-window cwin)))) @@ -5976,10 +5979,15 @@ (defun org-insert-heading (&optional arg invisible-ok top) ;; When INVISIBLE-OK is non-nil, ensure newly created headline ;; is visible. (unless invisible-ok - (pcase (get-char-property-and-overlay (point) 'invisible) - (`(outline . ,o) - (move-overlay o (overlay-start o) (line-end-position 0))) - (_ nil)))) + (if (eq org-fold-core-style 'text-properties) + (cond + ((org-fold-folded-p (line-beginning-position) 'headline) + (org-fold-region (line-end-position 0) (line-end-position) nil 'headline)) + (t nil)) + (pcase (get-char-property-and-overlay (point) 'invisible) + (`(outline . ,o) + (move-overlay o (overlay-start o) (line-end-position 0))) + (_ nil))))) ;; At a headline... ((org-at-heading-p) (cond ((bolp) @@ -6521,7 +6529,7 @@ (defun org-convert-to-oddeven-levels () (goto-char (point-min)) ;; First check if there are no even levels (when (re-search-forward "^\\(\\*\\*\\)+ " nil t) - (org-show-set-visibility 'canonical) + (org-fold-show-set-visibility 'canonical) (error "Not all levels are odd in this file. Conversion not possible")) (when (yes-or-no-p "Are you sure you want to globally change levels to odd-even? ") (let ((outline-regexp org-outline-regexp) @@ -6614,9 +6622,9 @@ (defun org-move-subtree-down (&optional arg) (setq txt (buffer-substring beg end)) (org-save-markers-in-region beg end) (delete-region beg end) - (org-remove-empty-overlays-at beg) - (unless (= beg (point-min)) (org-flag-region (1- beg) beg nil 'outline)) - (unless (bobp) (org-flag-region (1- (point)) (point) nil 'outline)) + (when (eq org-fold-core-style 'overlays) (org-remove-empty-overlays-at beg)) + (unless (= beg (point-min)) (org-fold-region (1- beg) beg nil 'outline)) + (unless (bobp) (org-fold-region (1- (point)) (point) nil 'outline)) (and (not (bolp)) (looking-at "\n") (forward-char 1)) (let ((bbb (point))) (insert-before-markers txt) @@ -6627,9 +6635,9 @@ (defun org-move-subtree-down (&optional arg) (org-skip-whitespace) (move-marker ins-point nil) (if folded - (org-flag-subtree t) - (org-show-entry) - (org-show-children)) + (org-fold-subtree t) + (org-fold-show-entry) + (org-fold-show-children)) (org-clean-visibility-after-subtree-move) ;; move back to the initial column we were at (move-to-column col)))) @@ -6987,7 +6995,7 @@ (defun org-clone-subtree-with-time-shift (n &optional shift) (insert template) (org-mode) (goto-char (point-min)) - (org-show-subtree) + (org-fold-show-subtree) (and idprop (if org-clone-delete-id (org-entry-delete nil "ID") (org-id-get-create t))) @@ -7259,7 +7267,7 @@ (defun org-sort-entries (point)) what "children") (goto-char start) - (outline-show-subtree) + (org-fold-show-subtree) (outline-next-heading)) (t ;; we will sort the top-level entries in this file @@ -7275,7 +7283,7 @@ (defun org-sort-entries (setq end (point-max)) (setq what "top-level") (goto-char start) - (org-show-all '(headings drawers blocks)))) + (org-fold-show-all '(headings drawers blocks)))) (setq beg (point)) (when (>= beg end) (goto-char start) (user-error "Nothing to sort")) @@ -7858,7 +7866,7 @@ (defun org-open-file (path &optional in-emacs line search) (funcall (cdr (assq 'file org-link-frame-setup)) file) (widen) (cond (line (org-goto-line line) - (when (derived-mode-p 'org-mode) (org-reveal))) + (when (derived-mode-p 'org-mode) (org-fold-reveal))) (search (condition-case err (org-link-search search) ;; Save position before error-ing out so user @@ -8154,7 +8162,7 @@ (defun org-mark-ring-goto (&optional n) (setq m (car p)) (pop-to-buffer-same-window (marker-buffer m)) (goto-char m) - (when (or (org-invisible-p) (org-invisible-p2)) (org-show-context 'mark-goto)))) + (when (or (org-invisible-p) (org-invisible-p2)) (org-fold-show-context 'mark-goto)))) ;;; Following specific links @@ -10165,7 +10173,7 @@ (defun org-occur (regexp &optional keep-previous callback) "Make a compact tree showing all matches of REGEXP. The tree will show the lines where the regexp matches, and any other context -defined in `org-show-context-detail', which see. +defined in `org-fold-show-context-detail', which see. When optional argument KEEP-PREVIOUS is non-nil, highlighting and exposing done by a previous call to `org-occur' will be kept, to allow stacking of @@ -10187,7 +10195,7 @@ (defun org-occur (regexp &optional keep-previous callback) (when (or (not keep-previous) ; do not want to keep (not org-occur-highlights)) ; no previous matches ;; hide everything - (org-overview)) + (org-cycle-overview)) (let ((case-fold-search (if (eq org-occur-case-fold-search 'smart) (isearch-no-upper-case-p regexp t) org-occur-case-fold-search))) @@ -10197,12 +10205,12 @@ (defun org-occur (regexp &optional keep-previous callback) (setq cnt (1+ cnt)) (when org-highlight-sparse-tree-matches (org-highlight-new-match (match-beginning 0) (match-end 0))) - (org-show-context 'occur-tree))))) + (org-fold-show-context 'occur-tree))))) (when org-remove-highlights-with-change (add-hook 'before-change-functions 'org-remove-occur-highlights nil 'local)) (unless org-sparse-tree-open-archived-trees - (org-hide-archived-subtrees (point-min) (point-max))) + (org-fold-hide-archived-subtrees (point-min) (point-max))) (run-hooks 'org-occur-hook) (when (called-interactively-p 'interactive) (message "%d match(es) for regexp %s" cnt regexp)) @@ -10486,7 +10494,7 @@ (defun org-scan-tags (action matcher todo-only &optional start-level) (save-excursion (goto-char (point-min)) (when (eq action 'sparse-tree) - (org-overview) + (org-cycle-overview) (org-remove-occur-highlights)) (if (org-element--cache-active-p) (let ((fast-re (concat "^" @@ -10535,7 +10543,7 @@ (defun org-scan-tags (action matcher todo-only &optional start-level) (org-get-heading) (match-end 0) (org-highlight-new-match (match-beginning 1) (match-end 1))) - (org-show-context 'tags-tree)) + (org-fold-show-context 'tags-tree)) ((eq action 'agenda) (let* ((effort (org-entry-get (point) org-effort-property)) (effort-minutes (when effort (save-match-data (org-duration-to-minutes effort))))) @@ -10661,7 +10669,7 @@ (defun org-scan-tags (action matcher todo-only &optional start-level) (org-get-heading) (match-end 0) (org-highlight-new-match (match-beginning 1) (match-end 1))) - (org-show-context 'tags-tree)) + (org-fold-show-context 'tags-tree)) ((eq action 'agenda) (setq txt (org-agenda-format-item "" @@ -10699,7 +10707,7 @@ (defun org-scan-tags (action matcher todo-only &optional start-level) (and (= (point) lspos) (end-of-line 1)))))) (when (and (eq action 'sparse-tree) (not org-sparse-tree-open-archived-trees)) - (org-hide-archived-subtrees (point-min) (point-max))) + (org-fold-hide-archived-subtrees (point-min) (point-max))) (nreverse rtn))) (defun org-remove-uninherited-tags (tags) @@ -12548,7 +12556,7 @@ (defun org-insert-property-drawer () (inhibit-read-only t)) (unless (bobp) (insert "\n")) (insert ":PROPERTIES:\n:END:") - (org-flag-region (line-end-position 0) (point) t 'outline) + (org-fold-region (line-end-position 0) (point) t (if (eq org-fold-core-style 'text-properties) 'drawer 'outline)) (when (or (eobp) (= begin (point-min))) (insert "\n")) (org-indent-region begin (point)))))) @@ -14379,7 +14387,7 @@ (defun org-timestamp-change (n &optional what updown suppress-tmp-delay) (message "No clock to adjust") (save-excursion (org-goto-marker-or-bmk clfixpos) - (org-show-subtree) + (org-fold-show-subtree) (when (re-search-forward clrgx nil t) (goto-char (match-beginning 1)) (let (org-clock-adjust-closest) @@ -15877,7 +15885,7 @@ (defun org-self-insert-command (N) If the cursor is in a table looking at whitespace, the whitespace is overwritten, and the table is not marked as requiring realignment." (interactive "p") - (org-check-before-invisible-edit 'insert) + (org-fold-check-before-invisible-edit 'insert) (cond ((and org-use-speed-commands (let ((kv (this-command-keys-vector))) @@ -15947,7 +15955,7 @@ (defun org-delete-backward-char (N) because, in this case the deletion might narrow the column." (interactive "p") (save-match-data - (org-check-before-invisible-edit 'delete-backward) + (org-fold-check-before-invisible-edit 'delete-backward) (if (and (= N 1) (not overwrite-mode) (not (org-region-active-p)) @@ -15967,7 +15975,7 @@ (defun org-delete-char (N) because, in this case the deletion might narrow the column." (interactive "p") (save-match-data - (org-check-before-invisible-edit 'delete) + (org-fold-check-before-invisible-edit 'delete) (cond ((or (/= N 1) (eq (char-after) ?|) @@ -16153,11 +16161,11 @@ (defun org-shifttab (&optional arg) ((integerp arg) (let ((arg2 (if org-odd-levels-only (1- (* 2 arg)) arg))) (message "Content view to level: %d" arg) - (org-content (prefix-numeric-value arg2)) + (org-cycle-content (prefix-numeric-value arg2)) (org-cycle-show-empty-lines t) (setq org-cycle-global-status 'overview) (run-hook-with-args 'org-cycle-hook 'overview))) - (t (call-interactively 'org-global-cycle)))) + (t (call-interactively 'org-cycle-global)))) (defun org-shiftmetaleft () "Promote subtree or delete table column. @@ -16311,14 +16319,14 @@ (defun org-check-for-hidden (what) (setq beg (point-at-bol)) (beginning-of-line 2) (while (and (not (eobp)) ;; this is like `next-line' - (get-char-property (1- (point)) 'invisible)) + (org-invisible-p (1- (point)))) (beginning-of-line 2)) (setq end (point)) (goto-char beg) (goto-char (point-at-eol)) (setq end (max end (point))) (while (re-search-forward re end t) - (when (get-char-property (match-beginning 0) 'invisible) + (when (org-invisible-p (match-beginning 0)) (throw 'exit t)))) nil)))) @@ -16606,11 +16614,18 @@ (defun org-copy-visible (beg end) (interactive "r") (let ((result "")) (while (/= beg end) - (when (get-char-property beg 'invisible) - (setq beg (next-single-char-property-change beg 'invisible nil end))) - (let ((next (next-single-char-property-change beg 'invisible nil end))) - (setq result (concat result (buffer-substring beg next))) - (setq beg next))) + (if (eq org-fold-core-style 'text-properties) + (progn + (while (org-invisible-p beg) + (setq beg (org-fold-next-visibility-change beg end))) + (let ((next (org-fold-next-visibility-change beg end))) + (setq result (concat result (buffer-substring beg next))) + (setq beg next))) + (when (get-char-property beg 'invisible) + (setq beg (next-single-char-property-change beg 'invisible nil end))) + (let ((next (next-single-char-property-change beg 'invisible nil end))) + (setq result (concat result (buffer-substring beg next))) + (setq beg next)))) (setq deactivate-mark t) (kill-new result) (message "Visible strings have been copied to the kill ring."))) @@ -16984,14 +16999,14 @@ (defun org-kill-note-or-show-branches () (cond (org-finish-function (let ((org-note-abort t)) (funcall org-finish-function))) ((org-before-first-heading-p) - (org-show-branches-buffer) - (org-hide-archived-subtrees (point-min) (point-max))) + (org-fold-show-branches-buffer) + (org-fold-hide-archived-subtrees (point-min) (point-max))) (t (let ((beg (progn (org-back-to-heading) (point))) (end (save-excursion (org-end-of-subtree t t) (point)))) - (outline-hide-subtree) - (outline-show-branches) - (org-hide-archived-subtrees beg end))))) + (org-fold-hide-subtree) + (org-fold-show-branches) + (org-fold-hide-archived-subtrees beg end))))) (defun org-delete-indentation (&optional arg) "Join current line to previous and fix whitespace at join. @@ -17114,7 +17129,7 @@ (defun org-return (&optional indent arg interactive) (org-auto-align-tags (org-align-tags)) (t (org--align-tags-here tags-column))) ;preserve tags column (end-of-line) - (org-show-entry) + (org-fold-show-entry) (org--newline indent arg interactive) (when string (save-excursion (insert (org-trim string)))))) ;; In a list, make sure indenting keeps trailing text within. @@ -17152,11 +17167,11 @@ (defun org-ctrl-c-tab (&optional arg) (call-interactively #'org-table-toggle-column-width)) ((org-before-first-heading-p) (save-excursion - (org-flag-above-first-heading) - (outline-hide-sublevels (or arg 1)))) + (org-fold-flag-above-first-heading) + (org-fold-hide-sublevels (or arg 1)))) (t - (outline-hide-subtree) - (org-show-children arg)))) + (org-fold-hide-subtree) + (org-fold-show-children arg)))) (defun org-ctrl-c-star () "Compute table, or change heading status of lines. @@ -17291,7 +17306,7 @@ (defun org-meta-return (&optional arg) `org-table-wrap-region', depending on context. When called with an argument, unconditionally call `org-insert-heading'." (interactive "P") - (org-check-before-invisible-edit 'insert) + (org-fold-check-before-invisible-edit 'insert) (or (run-hook-with-args-until-success 'org-metareturn-hook) (call-interactively (cond (arg #'org-insert-heading) ((org-at-table-p) #'org-table-wrap-region) @@ -17311,8 +17326,8 @@ (easy-menu-define org-org-menu org-mode-map "Org menu." ["Cycle Visibility" org-cycle :active (or (bobp) (outline-on-heading-p))] ["Cycle Global Visibility" org-shifttab :active (not (org-at-table-p))] ["Sparse Tree..." org-sparse-tree t] - ["Reveal Context" org-reveal t] - ["Show All" org-show-all t] + ["Reveal Context" org-fold-reveal t] + ["Show All" org-fold-show-all t] "--" ["Subtree to indirect buffer" org-tree-to-indirect-buffer t]) "--" @@ -17770,7 +17785,7 @@ (defun org-goto-marker-or-bmk (marker &optional bookmark) (when (or (> marker (point-max)) (< marker (point-min))) (widen)) (goto-char marker) - (org-show-context 'org-goto)) + (org-fold-show-context 'org-goto)) (if bookmark (bookmark-jump bookmark) (error "Cannot find location")))) @@ -18007,7 +18022,7 @@ (defun org-occur-in-agenda-files (regexp &optional _nlines) regexp))) (add-hook 'occur-mode-find-occurrence-hook - (lambda () (when (derived-mode-p 'org-mode) (org-reveal)))) + (lambda () (when (derived-mode-p 'org-mode) (org-fold-reveal)))) (defun org-occur-link-in-agenda-files () "Create a link and search for it in the agendas. @@ -18943,7 +18958,7 @@ (defun org-next-block (arg &optional backward block-regexp) (cl-decf count)))) (if (= count 0) (prog1 (goto-char (org-element-property :post-affiliated last-element)) - (save-match-data (org-show-context))) + (save-match-data (org-fold-show-context))) (goto-char origin) (user-error "No %s code blocks" (if backward "previous" "further"))))) @@ -19424,7 +19439,7 @@ (defun org-kill-line (&optional _arg) ((or (not org-special-ctrl-k) (bolp) (not (org-at-heading-p))) - (when (and (get-char-property (line-end-position) 'invisible) + (when (and (org-invisible-p (line-end-position)) org-ctrl-k-protect-subtree (or (eq org-ctrl-k-protect-subtree 'error) (not (y-or-n-p "Kill hidden subtree along with headline? ")))) @@ -19512,7 +19527,7 @@ (defun org-yank-generic (command arg) (or (looking-at org-outline-regexp) (re-search-forward org-outline-regexp-bol end t)) (while (and (< (point) end) (looking-at org-outline-regexp)) - (org-flag-subtree t) + (org-fold-subtree t) (org-cycle-show-empty-lines 'folded) (condition-case nil (outline-forward-same-level 1) @@ -19569,7 +19584,7 @@ (defun org-back-to-heading (&optional invisible-ok) (fboundp 'org-inlinetask-end-p) (org-inlinetask-end-p)) (org-inlinetask-goto-beginning) - (setq found (and (or invisible-ok (not (org-invisible-p))) + (setq found (and (or invisible-ok (not (org-fold-folded-p))) (point)))))) (goto-char found) found))) @@ -20606,9 +20621,9 @@ (defun org-info-find-node (&optional nodename) \f ;;; Finish up -(add-hook 'org-mode-hook ;remove overlays when changing major mode +(add-hook 'org-mode-hook ;remove folds when changing major mode (lambda () (add-hook 'change-major-mode-hook - 'org-show-all 'append 'local))) + 'org-fold-show-all 'append 'local))) (provide 'org) diff --git a/lisp/ox-org.el b/lisp/ox-org.el index 3d3c4fe6a..96d22d178 100644 --- a/lisp/ox-org.el +++ b/lisp/ox-org.el @@ -329,7 +329,7 @@ (defun org-org-publish-to-org (plist filename pub-dir) newbuf) (with-current-buffer work-buffer (org-font-lock-ensure) - (org-show-all) + (org-fold-show-all) (setq newbuf (htmlize-buffer))) (with-current-buffer newbuf (when org-org-htmlized-css-url diff --git a/testing/lisp/test-org-list.el b/testing/lisp/test-org-list.el index 3689a172f..24d96e58b 100644 --- a/testing/lisp/test-org-list.el +++ b/testing/lisp/test-org-list.el @@ -627,7 +627,7 @@ (ert-deftest test-org-list/move-item-down-contents-visibility () #+BEGIN_CENTER Text2 #+END_CENTER" - (org-hide-block-all) + (org-fold-hide-block-all) (let ((invisible-property-1 (progn (search-forward "Text1") diff --git a/testing/lisp/test-org.el b/testing/lisp/test-org.el index ce4d7b9dd..273441e0f 100644 --- a/testing/lisp/test-org.el +++ b/testing/lisp/test-org.el @@ -3787,7 +3787,7 @@ (ert-deftest test-org/end-of-line () (should-not (org-test-with-temp-text "#+BEGIN_CENTER\nContents\n#+END_CENTER" (let ((org-special-ctrl-a/e t)) - (org-hide-block-toggle) + (org-fold-hide-block-toggle) (org-end-of-line) (eobp)))) ;; Get past invisible characters at the end of line. @@ -3935,7 +3935,7 @@ (ert-deftest test-org/forward-paragraph () (should (= 6 (org-test-with-temp-text "#+begin_center\nP1\n\nP2\n#+end_center\nP3" - (org-hide-block-toggle) + (org-fold-hide-block-toggle) (org-forward-paragraph) (org-current-line)))) ;; On an item or a footnote definition, move past the first element @@ -4055,7 +4055,7 @@ (ert-deftest test-org/backward-paragraph () (bobp))) (should (org-test-with-temp-text "#+begin_center\nP1\n\nP2\n#+end_center\n" - (org-hide-block-toggle) + (org-fold-hide-block-toggle) (goto-char (point-max)) (org-backward-paragraph) (bobp))) @@ -8057,108 +8057,110 @@ (ert-deftest test-org/timestamp-to-time () ;;; Visibility (ert-deftest test-org/hide-drawer-toggle () - "Test `org-hide-drawer-toggle' specifications." + "Test `org-fold-hide-drawer-toggle' specifications." ;; Error when not at a drawer. (should-error (org-test-with-temp-text ":fake-drawer:\ncontents" - (org-hide-drawer-toggle 'off) + (org-fold-hide-drawer-toggle 'off) (get-char-property (line-end-position) 'invisible))) (should-error (org-test-with-temp-text "#+begin_example\n<point>:D:\nc\n:END:\n#+end_example" - (org-hide-drawer-toggle t))) + (org-fold-hide-drawer-toggle t))) ;; Hide drawer. (should (org-test-with-temp-text ":drawer:\ncontents\n:end:" - (org-hide-drawer-toggle) + (org-fold-show-all) + (org-fold-hide-drawer-toggle) (get-char-property (line-end-position) 'invisible))) ;; Show drawer unconditionally when optional argument is `off'. (should-not (org-test-with-temp-text ":drawer:\ncontents\n:end:" - (org-hide-drawer-toggle) - (org-hide-drawer-toggle 'off) + (org-fold-hide-drawer-toggle) + (org-fold-hide-drawer-toggle 'off) (get-char-property (line-end-position) 'invisible))) ;; Hide drawer unconditionally when optional argument is non-nil. (should (org-test-with-temp-text ":drawer:\ncontents\n:end:" - (org-hide-drawer-toggle t) + (org-fold-hide-drawer-toggle t) (get-char-property (line-end-position) 'invisible))) ;; Do not hide drawer when called from final blank lines. (should-not (org-test-with-temp-text ":drawer:\ncontents\n:end:\n\n<point>" - (org-hide-drawer-toggle) + (org-fold-show-all) + (org-fold-hide-drawer-toggle) (goto-char (point-min)) (get-char-property (line-end-position) 'invisible))) ;; Don't leave point in an invisible part of the buffer when hiding ;; a drawer away. (should-not (org-test-with-temp-text ":drawer:\ncontents\n<point>:end:" - (org-hide-drawer-toggle) + (org-fold-hide-drawer-toggle) (get-char-property (point) 'invisible)))) (ert-deftest test-org/hide-block-toggle () - "Test `org-hide-block-toggle' specifications." + "Test `org-fold-hide-block-toggle' specifications." ;; Error when not at a block. (should-error (org-test-with-temp-text "#+BEGIN_QUOTE\ncontents" - (org-hide-block-toggle 'off) + (org-fold-hide-block-toggle 'off) (get-char-property (line-end-position) 'invisible))) ;; Hide block. (should (org-test-with-temp-text "#+BEGIN_CENTER\ncontents\n#+END_CENTER" - (org-hide-block-toggle) + (org-fold-hide-block-toggle) (get-char-property (line-end-position) 'invisible))) (should (org-test-with-temp-text "#+BEGIN_EXAMPLE\ncontents\n#+END_EXAMPLE" - (org-hide-block-toggle) + (org-fold-hide-block-toggle) (get-char-property (line-end-position) 'invisible))) ;; Show block unconditionally when optional argument is `off'. (should-not (org-test-with-temp-text "#+BEGIN_QUOTE\ncontents\n#+END_QUOTE" - (org-hide-block-toggle) - (org-hide-block-toggle 'off) + (org-fold-hide-block-toggle) + (org-fold-hide-block-toggle 'off) (get-char-property (line-end-position) 'invisible))) (should-not (org-test-with-temp-text "#+BEGIN_QUOTE\ncontents\n#+END_QUOTE" - (org-hide-block-toggle 'off) + (org-fold-hide-block-toggle 'off) (get-char-property (line-end-position) 'invisible))) ;; Hide block unconditionally when optional argument is non-nil. (should (org-test-with-temp-text "#+BEGIN_QUOTE\ncontents\n#+END_QUOTE" - (org-hide-block-toggle t) + (org-fold-hide-block-toggle t) (get-char-property (line-end-position) 'invisible))) (should (org-test-with-temp-text "#+BEGIN_QUOTE\ncontents\n#+END_QUOTE" - (org-hide-block-toggle) - (org-hide-block-toggle t) + (org-fold-hide-block-toggle) + (org-fold-hide-block-toggle t) (get-char-property (line-end-position) 'invisible))) ;; Do not hide block when called from final blank lines. (should-not (org-test-with-temp-text "#+BEGIN_QUOTE\ncontents\n#+END_QUOTE\n\n<point>" - (org-hide-block-toggle) + (org-fold-hide-block-toggle) (goto-char (point-min)) (get-char-property (line-end-position) 'invisible))) ;; Don't leave point in an invisible part of the buffer when hiding ;; a block away. (should-not (org-test-with-temp-text "#+BEGIN_QUOTE\ncontents\n<point>#+END_QUOTE" - (org-hide-block-toggle) + (org-fold-hide-block-toggle) (get-char-property (point) 'invisible)))) (ert-deftest test-org/hide-block-toggle-maybe () - "Test `org-hide-block-toggle-maybe' specifications." + "Test `org-fold-hide-block-toggle' specifications." (should (org-test-with-temp-text "#+BEGIN: dynamic\nContents\n#+END:" - (org-hide-block-toggle-maybe))) - (should-not - (org-test-with-temp-text "Paragraph" (org-hide-block-toggle-maybe)))) + (org-hide-block-toggle))) + (should-error + (org-test-with-temp-text "Paragraph" (org-hide-block-toggle)))) (ert-deftest test-org/show-set-visibility () - "Test `org-show-set-visibility' specifications." + "Test `org-fold-show-set-visibility' specifications." ;; Do not throw an error before first heading. (should (org-test-with-temp-text "Preamble\n* Headline" - (org-show-set-visibility 'tree) + (org-fold-show-set-visibility 'tree) t)) ;; Test all visibility spans, both on headline and in entry. (let ((list-visible-lines @@ -8180,7 +8182,7 @@ (ert-deftest test-org/show-set-visibility () " (org-cycle t) (search-forward (if headerp "Self" "Match")) - (org-show-set-visibility state) + (org-fold-show-set-visibility state) (goto-char (point-min)) (let (result (line 0)) (while (not (eobp)) @@ -8211,24 +8213,24 @@ (ert-deftest test-org/show-set-visibility () ;; visible. (should-not (org-test-with-temp-text "#+BEGIN_QUOTE\nText\n#+END_QUOTE" - (org-hide-block-toggle) + (org-fold-hide-block-toggle) (search-forward "Text") - (org-show-set-visibility 'minimal) + (org-fold-show-set-visibility 'minimal) (org-invisible-p2))) (should-not (org-test-with-temp-text ":DRAWER:\nText\n:END:" - (org-hide-drawer-toggle) + (org-fold-hide-drawer-toggle) (search-forward "Text") - (org-show-set-visibility 'minimal) + (org-fold-show-set-visibility 'minimal) (org-invisible-p2))) (should-not (org-test-with-temp-text "#+BEGIN_QUOTE\n<point>:DRAWER:\nText\n:END:\n#+END_QUOTE" - (org-hide-drawer-toggle) + (org-fold-hide-drawer-toggle) (forward-line -1) - (org-hide-block-toggle) + (org-fold-hide-block-toggle) (search-forward "Text") - (org-show-set-visibility 'minimal) + (org-fold-show-set-visibility 'minimal) (org-invisible-p2)))) (defun test-org/copy-visible () ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH 10/35] Implement link folding 2022-01-29 11:37 ` [PATCH 00/35] Merge org-fold feature branch Ihor Radchenko ` (8 preceding siblings ...) 2022-01-29 11:38 ` [PATCH 09/35] Rename old function call to use org-fold Ihor Radchenko @ 2022-01-29 11:38 ` Ihor Radchenko 2022-05-04 6:13 ` [BUG] 67275f4 broke evil-search " Tom Gillespie 2022-01-29 11:38 ` [PATCH 11/35] Implement overlay- and text-property-based versions of some functions Ihor Radchenko ` (25 subsequent siblings) 35 siblings, 1 reply; 192+ messages in thread From: Ihor Radchenko @ 2022-01-29 11:38 UTC (permalink / raw) To: Bastien, Kyle Meyer, Nicolas Goaziou, Karl Voit, Christian Heinrich, emacs-orgmode Cc: Ihor Radchenko [-- Attachment #1: Type: text/plain, Size: 752 bytes --] * lisp/ol.el (org-link--link-folding-spec): (org-link--description-folding-spec): New variables controlling link folding settings. (org-link--reveal-maybe): Handle revealing folded links. (org-link-descriptive-ensure): Implement `org-link-descriptive' support with org-fold. (org-toggle-link-display--overlays): (org-toggle-link-display--text-properties): (org-toggle-link-display): Provide text-properties and overlays versions. * lisp/org-agenda.el (org-agenda-mode): Use org-fold to fold links in agenda. * lisp/org.el (org-do-emphasis-faces): Use org-fold. --- lisp/ol.el | 42 +++++++++++++++++++++++++++++++++++++++++- lisp/org-agenda.el | 3 ++- lisp/org.el | 11 +++++++++-- 3 files changed, 52 insertions(+), 4 deletions(-) [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0010-Implement-link-folding.patch --] [-- Type: text/x-patch; name="0010-Implement-link-folding.patch", Size: 4670 bytes --] diff --git a/lisp/ol.el b/lisp/ol.el index 21bd854e9..1837bf37c 100644 --- a/lisp/ol.el +++ b/lisp/ol.el @@ -605,6 +605,22 @@ (defvar org-link--insert-history nil (defvar org-link--search-failed nil "Non-nil when last link search failed.") + +(defvar-local org-link--link-folding-spec '(org-link + (:global t) + (:ellipsis . nil) + (:isearch-open . t) + (:fragile . org-link--reveal-maybe)) + "Folding spec used to hide invisible parts of links.") + +(defvar-local org-link--description-folding-spec '(org-link-description + (:global t) + (:ellipsis . nil) + (:visible . t) + (:isearch-open . nil) + (:fragile . org-link--reveal-maybe)) + "Folding spec used to reveal link description.") + \f ;;; Internal Functions @@ -762,6 +778,13 @@ (defun org-link--normalize-string (string &optional context) (t nil)))) string)) +(defun org-link--reveal-maybe (region _) + "Reveal folded link in REGION when needed. +This function is intended to be used as :fragile property of a folding +spec." + (org-with-point-at (car region) + (not (org-in-regexp org-link-any-re)))) + \f ;;; Public API @@ -1444,14 +1467,31 @@ (defun org-previous-link () (interactive) (org-next-link t)) +(defun org-link-descriptive-ensure () + "Toggle the literal or descriptive display of links in current buffer if needed." + (if org-link-descriptive + (org-fold-core-set-folding-spec-property (car org-link--link-folding-spec) :visible nil) + (org-fold-core-set-folding-spec-property (car org-link--link-folding-spec) :visible t))) + ;;;###autoload -(defun org-toggle-link-display () +(defun org-toggle-link-display--overlays () "Toggle the literal or descriptive display of links." (interactive) (if org-link-descriptive (remove-from-invisibility-spec '(org-link)) (add-to-invisibility-spec '(org-link))) (org-restart-font-lock) (setq org-link-descriptive (not org-link-descriptive))) +(defun org-toggle-link-display--text-properties () + "Toggle the literal or descriptive display of links in current buffer." + (interactive) + (setq org-link-descriptive (not org-link-descriptive)) + (org-link-descriptive-ensure)) +(defsubst org-toggle-link-display () + "Toggle the literal or descriptive display of links." + (interactive) + (if (eq org-fold-core-style 'text-properties) + (org-toggle-link-display--text-properties) + (org-toggle-link-display--overlays))) ;;;###autoload (defun org-store-link (arg &optional interactive?) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index 2802e8636..063da6566 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -2325,7 +2325,8 @@ (defun org-agenda-mode () org-agenda-show-log org-agenda-start-with-log-mode org-agenda-clockreport-mode org-agenda-start-with-clockreport-mode)) (add-to-invisibility-spec '(org-filtered)) - (add-to-invisibility-spec '(org-link)) + (org-fold-core-initialize `(,org-link--description-folding-spec + ,org-link--link-folding-spec)) (easy-menu-change '("Agenda") "Agenda Files" (append diff --git a/lisp/org.el b/lisp/org.el index ebc9d81db..5465ed3ea 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -4562,9 +4562,16 @@ (define-derived-mode org-mode outline-mode "Org" (setq-local org-mode-loading t) (org-load-modules-maybe) (org-install-agenda-files-menu) - (when org-link-descriptive (add-to-invisibility-spec '(org-link))) + (when (and org-link-descriptive + (eq org-fold-core-style 'overlays)) + (add-to-invisibility-spec '(org-link))) + (org-fold-initialize (or (and (stringp org-ellipsis) (not (equal "" org-ellipsis)) org-ellipsis) + "...")) (make-local-variable 'org-link-descriptive) - (add-to-invisibility-spec '(org-hide-block . t)) + (when (eq org-fold-core-style 'overlays) (add-to-invisibility-spec '(org-hide-block . t))) + (if org-link-descriptive + (org-fold-core-set-folding-spec-property (car org-link--link-folding-spec) :visible nil) + (org-fold-core-set-folding-spec-property (car org-link--link-folding-spec) :visible t)) (setq-local outline-regexp org-outline-regexp) (setq-local outline-level 'org-outline-level) (setq bidi-paragraph-direction 'left-to-right) ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [BUG] 67275f4 broke evil-search Re: [PATCH 10/35] Implement link folding 2022-01-29 11:38 ` [PATCH 10/35] Implement link folding Ihor Radchenko @ 2022-05-04 6:13 ` Tom Gillespie 2022-05-04 6:38 ` Ihor Radchenko 0 siblings, 1 reply; 192+ messages in thread From: Tom Gillespie @ 2022-05-04 6:13 UTC (permalink / raw) To: Ihor Radchenko; +Cc: emacs-orgmode Hi Ihor, It seems that this patch (as commit 67275f4664ce00b5263c75398d78816e7dc2ffa6, found using git bisect to hunt down the issue) breaks search in evil mode when (evil-select-search-module 'evil-search-module 'evil-search) is set. The broken behavior is that evil-search no longer searches inside folded headings. I had a quick look at the changes but couldn't figure out why these changes might cause the issue. Best, Tom ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [BUG] 67275f4 broke evil-search Re: [PATCH 10/35] Implement link folding 2022-05-04 6:13 ` [BUG] 67275f4 broke evil-search " Tom Gillespie @ 2022-05-04 6:38 ` Ihor Radchenko 2022-05-28 2:17 ` Tom Gillespie 0 siblings, 1 reply; 192+ messages in thread From: Ihor Radchenko @ 2022-05-04 6:38 UTC (permalink / raw) To: Tom Gillespie; +Cc: emacs-orgmode Tom Gillespie <tgbugs@gmail.com> writes: > It seems that this patch (as commit > 67275f4664ce00b5263c75398d78816e7dc2ffa6, found using git bisect to > hunt down the issue) breaks search in evil mode when > (evil-select-search-module 'evil-search-module 'evil-search) is set. > The broken behavior is that evil-search no longer searches inside > folded headings. I had a quick look at the changes but couldn't figure > out why these changes might cause the issue. Best, Evil re-implements isearch functionality and it does it only partially. It appears to respect isearch-filter-predicate, but not isearch-mode-end-hook. I expect this to be a bug on evil side. Meanwhile, you can try to set search-invisible to t. It should help (in theory). Best, Ihor ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [BUG] 67275f4 broke evil-search Re: [PATCH 10/35] Implement link folding 2022-05-04 6:38 ` Ihor Radchenko @ 2022-05-28 2:17 ` Tom Gillespie 2022-05-28 2:37 ` Ihor Radchenko 0 siblings, 1 reply; 192+ messages in thread From: Tom Gillespie @ 2022-05-28 2:17 UTC (permalink / raw) To: Ihor Radchenko; +Cc: emacs-orgmode > It appears to respect isearch-filter-predicate, but not > isearch-mode-end-hook. This is true only when isearch is used as the module via (evil-select-search-module 'evil-search-module 'isearch), and indeed, when using evil search in that way headings no longer refold. When using evil-search, things won't even unfold. I think that I have tracked the issue down to evil-ex-find-next in a call to isearch-range-invisible which returns nil for commits < 67275f4, and t for >=. When isearch-range-invisible returns nil the invisible overlay is made visible, when it returns t it stays closed. Might restoring the invisible overlay text property restore the old behavior? Is there a reason it was removed? Best, Tom ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [BUG] 67275f4 broke evil-search Re: [PATCH 10/35] Implement link folding 2022-05-28 2:17 ` Tom Gillespie @ 2022-05-28 2:37 ` Ihor Radchenko 2022-05-28 2:42 ` Tom Gillespie 0 siblings, 1 reply; 192+ messages in thread From: Ihor Radchenko @ 2022-05-28 2:37 UTC (permalink / raw) To: Tom Gillespie; +Cc: emacs-orgmode Tom Gillespie <tgbugs@gmail.com> writes: > Might restoring the invisible overlay text property restore > the old behavior? Is there a reason it was removed? The whole point of the patch is _not_ using overlays. For performance reasons. You can, however, switch to the old behavior by setting org-fold-core-style to 'overlays. At the cost of some new features being disabled. Note that if evil were to comply with the canonical isearch implementation and respect isearch-mode-end-hook, there would be no issue. Best, Ihor ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [BUG] 67275f4 broke evil-search Re: [PATCH 10/35] Implement link folding 2022-05-28 2:37 ` Ihor Radchenko @ 2022-05-28 2:42 ` Tom Gillespie 2022-05-28 3:09 ` Ihor Radchenko 2022-05-28 3:11 ` Ihor Radchenko 0 siblings, 2 replies; 192+ messages in thread From: Tom Gillespie @ 2022-05-28 2:42 UTC (permalink / raw) To: Ihor Radchenko; +Cc: emacs-orgmode The workaround from the other thread to (setq org-fold-core-style 'overlays) is perfect. > The whole point of the patch is _not_ using overlays. For performance > reasons. Yep, the workaround is sufficient for now, and the note on performance for large files in the docstring makes it clear what the tradeoffs are, and why we want the text properties to be the default. Not need to "restore" the old behavior since it is just a setq away. > Note that if evil were to comply with the canonical isearch > implementation and respect isearch-mode-end-hook, there would be no > issue. I think we might want to update the documentation to mention issue with evil for now, and alert the evil devs about this change. Then we can approach them about implementing support for searching inside invisible regions marked via text properties since that is essentially a new feature that is being added to org for 9.6, though one that will be on by default. The evil-search module doesn't seem to support _any_ of the isearch hooks needed but while looking into this I think I know generally where it might be possible to add them. Thanks! Tom ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [BUG] 67275f4 broke evil-search Re: [PATCH 10/35] Implement link folding 2022-05-28 2:42 ` Tom Gillespie @ 2022-05-28 3:09 ` Ihor Radchenko 2022-05-28 3:11 ` Ihor Radchenko 1 sibling, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-05-28 3:09 UTC (permalink / raw) To: Tom Gillespie; +Cc: emacs-orgmode Tom Gillespie <tgbugs@gmail.com> writes: >> Note that if evil were to comply with the canonical isearch >> implementation and respect isearch-mode-end-hook, there would be no >> issue. > > I think we might want to update the documentation to mention > issue with evil for now, and alert the evil devs about this change. > Then we can approach them about implementing support for > searching inside invisible regions marked via text properties > since that is essentially a new feature that is being added to > org for 9.6, though one that will be on by default. Feel free to open an issue in evil repo. I do not use evil, so I will not be able to test any fixes there. > The evil-search > module doesn't seem to support _any_ of the isearch hooks needed > but while looking into this I think I know generally where it might be > possible to add them. Not exactly. Evil does support `isearch-filter-predicate', but not `isearch-mode-end-hook' and `isearch-mode-hook'. Basically, Org needs evil to support settings listed in `org-fold-core--isearch-setup'. Best, Ihor ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [BUG] 67275f4 broke evil-search Re: [PATCH 10/35] Implement link folding 2022-05-28 2:42 ` Tom Gillespie 2022-05-28 3:09 ` Ihor Radchenko @ 2022-05-28 3:11 ` Ihor Radchenko 1 sibling, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-05-28 3:11 UTC (permalink / raw) To: Tom Gillespie; +Cc: emacs-orgmode Tom Gillespie <tgbugs@gmail.com> writes: > I think we might want to update the documentation to mention > issue with evil for now We can, but it will only be required if evil devs don't fix the issue in a reasonable time frame. Best, Ihor ^ permalink raw reply [flat|nested] 192+ messages in thread
* [PATCH 11/35] Implement overlay- and text-property-based versions of some functions 2022-01-29 11:37 ` [PATCH 00/35] Merge org-fold feature branch Ihor Radchenko ` (9 preceding siblings ...) 2022-01-29 11:38 ` [PATCH 10/35] Implement link folding Ihor Radchenko @ 2022-01-29 11:38 ` Ihor Radchenko 2022-01-29 11:38 ` [PATCH 12/35] org-fold: Handle indirect buffer visibility Ihor Radchenko ` (24 subsequent siblings) 35 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-01-29 11:38 UTC (permalink / raw) To: Bastien, Kyle Meyer, Nicolas Goaziou, Karl Voit, Christian Heinrich, emacs-orgmode Cc: Ihor Radchenko [-- Attachment #1: Type: text/plain, Size: 307 bytes --] --- lisp/org-element.el | 54 ++++- lisp/org-fold.el | 5 +- lisp/org-inlinetask.el | 26 ++- lisp/org-list.el | 74 ++++++- lisp/org-macs.el | 54 ++++- lisp/org.el | 469 +++++++++++++++++++++++++++++++++-------- 6 files changed, 585 insertions(+), 97 deletions(-) [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0011-Implement-overlay-and-text-property-based-versions-o.patch --] [-- Type: text/x-patch; name="0011-Implement-overlay-and-text-property-based-versions-o.patch", Size: 35772 bytes --] diff --git a/lisp/org-element.el b/lisp/org-element.el index 99999fb32..bf9f3b69d 100644 --- a/lisp/org-element.el +++ b/lisp/org-element.el @@ -7905,7 +7905,7 @@ (defun org-element-nested-p (elem-A elem-B) (or (and (>= beg-A beg-B) (<= end-A end-B)) (and (>= beg-B beg-A) (<= end-B end-A))))) -(defun org-element-swap-A-B (elem-A elem-B) +(defun org-element-swap-A-B--overlays (elem-A elem-B) "Swap elements ELEM-A and ELEM-B. Assume ELEM-B is after ELEM-A in the buffer. Leave point at the end of ELEM-A." @@ -7973,6 +7973,58 @@ (defun org-element-swap-A-B (elem-A elem-B) (dolist (o (cdr overlays)) (move-overlay (car o) (- (nth 1 o) offset) (- (nth 2 o) offset)))) (goto-char (org-element-property :end elem-B))))) +(defun org-element-swap-A-B--text-properties (elem-A elem-B) + "Swap elements ELEM-A and ELEM-B. +Assume ELEM-B is after ELEM-A in the buffer. Leave point at the +end of ELEM-A." + (goto-char (org-element-property :begin elem-A)) + ;; There are two special cases when an element doesn't start at bol: + ;; the first paragraph in an item or in a footnote definition. + (let ((specialp (not (bolp)))) + ;; Only a paragraph without any affiliated keyword can be moved at + ;; ELEM-A position in such a situation. Note that the case of + ;; a footnote definition is impossible: it cannot contain two + ;; paragraphs in a row because it cannot contain a blank line. + (when (and specialp + (or (not (eq (org-element-type elem-B) 'paragraph)) + (/= (org-element-property :begin elem-B) + (org-element-property :contents-begin elem-B)))) + (error "Cannot swap elements")) + ;; In a special situation, ELEM-A will have no indentation. We'll + ;; give it ELEM-B's (which will in, in turn, have no indentation). + (org-fold-core-ignore-modifications ;; Preserve folding state + (let* ((ind-B (when specialp + (goto-char (org-element-property :begin elem-B)) + (current-indentation))) + (beg-A (org-element-property :begin elem-A)) + (end-A (save-excursion + (goto-char (org-element-property :end elem-A)) + (skip-chars-backward " \r\t\n") + (point-at-eol))) + (beg-B (org-element-property :begin elem-B)) + (end-B (save-excursion + (goto-char (org-element-property :end elem-B)) + (skip-chars-backward " \r\t\n") + (point-at-eol))) + ;; Get contents. + (body-A (buffer-substring beg-A end-A)) + (body-B (delete-and-extract-region beg-B end-B))) + (goto-char beg-B) + (when specialp + (setq body-B (replace-regexp-in-string "\\`[ \t]*" "" body-B)) + (indent-to-column ind-B)) + (insert body-A) + (goto-char beg-A) + (delete-region beg-A end-A) + (insert body-B) + (goto-char (org-element-property :end elem-B)))))) +(defsubst org-element-swap-A-B (elem-A elem-B) + "Swap elements ELEM-A and ELEM-B. +Assume ELEM-B is after ELEM-A in the buffer. Leave point at the +end of ELEM-A." + (if (eq org-fold-core-style 'text-properties) + (org-element-swap-A-B--text-properties elem-A elem-B) + (org-element-swap-A-B--overlays elem-A elem-B))) (provide 'org-element) diff --git a/lisp/org-fold.el b/lisp/org-fold.el index 52717fd86..e48a528bf 100644 --- a/lisp/org-fold.el +++ b/lisp/org-fold.el @@ -53,10 +53,7 @@ (defvar org-drawer-regexp) (defvar org-property-end-re) (defvar org-link-descriptive) (defvar org-outline-regexp-bol) -(defvar org-custom-properties-hidden-p) (defvar org-archive-tag) - -;; Needed for overlays only (defvar org-custom-properties-overlays) (declare-function isearch-filter-visible "isearch" (beg end)) @@ -1101,7 +1098,7 @@ (defun org-fold-check-before-invisible-edit--text-properties (kind) (when (or invisible-at-point invisible-before-point) (when (eq org-fold-catch-invisible-edits 'error) (user-error "Editing in invisible areas is prohibited, make them visible first")) - (if (and org-custom-properties-hidden-p + (if (and org-custom-properties-overlays (y-or-n-p "Display invisible properties in this buffer? ")) (org-toggle-custom-properties-visibility) ;; Make the area visible diff --git a/lisp/org-inlinetask.el b/lisp/org-inlinetask.el index 581370bb5..a63704a05 100644 --- a/lisp/org-inlinetask.el +++ b/lisp/org-inlinetask.el @@ -305,7 +305,22 @@ (defun org-inlinetask-fontify (limit) (add-text-properties (match-beginning 3) (match-end 3) '(face org-inlinetask font-lock-fontified t))))) -(defun org-inlinetask-toggle-visibility () +(defun org-inlinetask-toggle-visibility--text-properties () + "Toggle visibility of inline task at point." + (let ((end (save-excursion + (org-inlinetask-goto-end) + (if (bolp) (1- (point)) (point)))) + (start (save-excursion + (org-inlinetask-goto-beginning) + (point-at-eol)))) + (cond + ;; Nothing to show/hide. + ((= end start)) + ;; Inlinetask was folded: expand it. + ((org-fold-get-folding-spec 'headline (1+ start)) + (org-fold-region start end nil 'headline)) + (t (org-fold-region start end t 'headline))))) +(defun org-inlinetask-toggle-visibility--overlays () "Toggle visibility of inline task at point." (let ((end (save-excursion (org-inlinetask-goto-end) @@ -318,8 +333,13 @@ (defun org-inlinetask-toggle-visibility () ((= end start)) ;; Inlinetask was folded: expand it. ((eq (get-char-property (1+ start) 'invisible) 'outline) - (org-flag-region start end nil 'outline)) - (t (org-flag-region start end t 'outline))))) + (org-fold-region start end nil 'outline)) + (t (org-fold-region start end t 'outline))))) +(defsubst org-inlinetask-toggle-visibility () + "Toggle visibility of inline task at point." + (if (eq org-fold-core-style 'text-properties) + (org-inlinetask-toggle-visibility--text-properties) + (org-inlinetask-toggle-visibility--overlays))) (defun org-inlinetask-hide-tasks (state) "Hide inline tasks in buffer when STATE is `contents' or `children'. diff --git a/lisp/org-list.el b/lisp/org-list.el index 187e9a9ff..3e76eb6b2 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -1079,7 +1079,65 @@ (defsubst org-list-bullet-string (bullet) (replace-match spaces nil nil bullet 1) bullet)))) -(defun org-list-swap-items (beg-A beg-B struct) +(defun org-list-swap-items--text-properties (beg-A beg-B struct) + "Swap item starting at BEG-A with item starting at BEG-B in STRUCT. + +Blank lines at the end of items are left in place. Item +visibility is preserved. Return the new structure after the +changes. + +Assume BEG-A is lesser than BEG-B and that BEG-A and BEG-B belong +to the same sub-list. + +This function modifies STRUCT." + (save-excursion + (org-fold-core-ignore-modifications + (let* ((end-A-no-blank (org-list-get-item-end-before-blank beg-A struct)) + (end-B-no-blank (org-list-get-item-end-before-blank beg-B struct)) + (end-A (org-list-get-item-end beg-A struct)) + (end-B (org-list-get-item-end beg-B struct)) + (size-A (- end-A-no-blank beg-A)) + (size-B (- end-B-no-blank beg-B)) + (body-A (buffer-substring beg-A end-A-no-blank)) + (body-B (buffer-substring beg-B end-B-no-blank)) + (between-A-no-blank-and-B (buffer-substring end-A-no-blank beg-B)) + (sub-A (cons beg-A (org-list-get-subtree beg-A struct))) + (sub-B (cons beg-B (org-list-get-subtree beg-B struct)))) + ;; 1. Move effectively items in buffer. + (goto-char beg-A) + (delete-region beg-A end-B-no-blank) + (insert (concat body-B between-A-no-blank-and-B body-A)) + ;; 2. Now modify struct. No need to re-read the list, the + ;; transformation is just a shift of positions. Some special + ;; attention is required for items ending at END-A and END-B + ;; as empty spaces are not moved there. In others words, + ;; item BEG-A will end with whitespaces that were at the end + ;; of BEG-B and the same applies to BEG-B. + (dolist (e struct) + (let ((pos (car e))) + (cond + ((< pos beg-A)) + ((memq pos sub-A) + (let ((end-e (nth 6 e))) + (setcar e (+ pos (- end-B-no-blank end-A-no-blank))) + (setcar (nthcdr 6 e) + (+ end-e (- end-B-no-blank end-A-no-blank))) + (when (= end-e end-A) (setcar (nthcdr 6 e) end-B)))) + ((memq pos sub-B) + (let ((end-e (nth 6 e))) + (setcar e (- (+ pos beg-A) beg-B)) + (setcar (nthcdr 6 e) (+ end-e (- beg-A beg-B))) + (when (= end-e end-B) + (setcar (nthcdr 6 e) + (+ beg-A size-B (- end-A end-A-no-blank)))))) + ((< pos beg-B) + (let ((end-e (nth 6 e))) + (setcar e (+ pos (- size-B size-A))) + (setcar (nthcdr 6 e) (+ end-e (- size-B size-A)))))))) + (setq struct (sort struct #'car-less-than-car)) + ;; Return structure. + struct)))) +(defun org-list-swap-items--overlays (beg-A beg-B struct) "Swap item starting at BEG-A with item starting at BEG-B in STRUCT. Blank lines at the end of items are left in place. Item @@ -1164,6 +1222,20 @@ (defun org-list-swap-items (beg-A beg-B struct) (+ (nth 2 ov) (- beg-A beg-B)))) ;; Return structure. struct))) +(defsubst org-list-swap-items (beg-A beg-B struct) + "Swap item starting at BEG-A with item starting at BEG-B in STRUCT. + +Blank lines at the end of items are left in place. Item +visibility is preserved. Return the new structure after the +changes. + +Assume BEG-A is lesser than BEG-B and that BEG-A and BEG-B belong +to the same sub-list. + +This function modifies STRUCT." + (if (eq org-fold-core-style 'text-properties) + (org-list-swap-items--text-properties beg-A beg-B struct) + (org-list-swap-items--overlays beg-A beg-B struct))) (defun org-list-separating-blank-lines-number (pos struct prevs) "Return number of blank lines that should separate items in list. diff --git a/lisp/org-macs.el b/lisp/org-macs.el index 2968e2ba5..8f2133dd0 100644 --- a/lisp/org-macs.el +++ b/lisp/org-macs.el @@ -1103,7 +1103,18 @@ (defun org-find-text-property-in-string (prop s) (get-text-property (or (next-single-property-change 0 prop s) 0) prop s))) -(defun org-invisible-p (&optional pos folding-only) +;; FIXME: move to org-fold? +(defun org-invisible-p--text-properties (&optional pos folding-only) + "Non-nil if the character after POS is invisible. +If POS is nil, use `point' instead. When optional argument +FOLDING-ONLY is non-nil, only consider invisible parts due to +folding of a headline, a block or a drawer, i.e., not because of +fontification." + (let ((value (invisible-p (or pos (point))))) + (cond ((not value) nil) + (folding-only (org-fold-folded-p (or pos (point)))) + (t value)))) +(defun org-invisible-p--overlays (&optional pos folding-only) "Non-nil if the character after POS is invisible. If POS is nil, use `point' instead. When optional argument FOLDING-ONLY is non-nil, only consider invisible parts due to @@ -1112,7 +1123,16 @@ (defun org-invisible-p (&optional pos folding-only) (let ((value (get-char-property (or pos (point)) 'invisible))) (cond ((not value) nil) (folding-only (memq value '(org-hide-block outline))) - (t value)))) + (t (and (invisible-p (or pos (point))) value))))) +(defsubst org-invisible-p (&optional pos folding-only) + "Non-nil if the character after POS is invisible. +If POS is nil, use `point' instead. When optional argument +FOLDING-ONLY is non-nil, only consider invisible parts due to +folding of a headline, a block or a drawer, i.e., not because of +fontification." + (if (eq org-fold-core-style 'text-properties) + (org-invisible-p--text-properties pos folding-only) + (org-invisible-p--overlays pos folding-only))) (defun org-truely-invisible-p () "Check if point is at a character currently not visible. @@ -1130,17 +1150,43 @@ (defun org-invisible-p2 () (backward-char 1)) (org-invisible-p))) -(defun org-find-visible () +(defun org-region-invisible-p (beg end) + "Check if region if completely hidden." + (org-with-wide-buffer + (and (org-invisible-p beg) + (org-invisible-p (org-fold-next-visibility-change beg end))))) + +(defun org-find-visible--overlays () "Return closest visible buffer position, or `point-max'." (if (org-invisible-p) (next-single-char-property-change (point) 'invisible) (point))) +(defun org-find-visible--text-properties () + "Return closest visible buffer position, or `point-max'." + (if (org-invisible-p) + (org-fold-next-visibility-change (point)) + (point))) +(defsubst org-find-visible () + "Return closest visible buffer position, or `point-max'." + (if (eq org-fold-core-style 'text-properties) + (org-find-visible--text-properties) + (org-find-visible--overlays))) -(defun org-find-invisible () +(defun org-find-invisible--overlays () "Return closest invisible buffer position, or `point-max'." (if (org-invisible-p) (point) (next-single-char-property-change (point) 'invisible))) +(defun org-find-invisible--text-properties () + "Return closest invisible buffer position, or `point-max'." + (if (org-invisible-p) + (point) + (org-fold-next-visibility-change (point)))) +(defsubst org-find-invisible () + "Return closest invisible buffer position, or `point-max'." + (if (eq org-fold-core-style 'text-properties) + (org-find-invisible--text-properties) + (org-find-invisible--overlays))) \f ;;; Time diff --git a/lisp/org.el b/lisp/org.el index 5465ed3ea..0967cbf1c 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -4911,7 +4911,7 @@ (defconst org-nonsticky-props (defsubst org-rear-nonsticky-at (pos) (add-text-properties (1- pos) pos (list 'rear-nonsticky org-nonsticky-props))) -(defun org-activate-links (limit) +(defun org-activate-links--overlays (limit) "Add link properties to links. This includes angle, plain, and bracket links." (catch :exit @@ -4926,13 +4926,13 @@ (defun org-activate-links (limit) (when (and (memq style org-highlight-links) ;; Do not span over paragraph boundaries. (not (string-match-p org-element-paragraph-separate - (match-string 0))) + (match-string 0))) ;; Do not confuse plain links with tags. (not (and (eq style 'plain) - (let ((face (get-text-property - (max (1- start) (point-min)) 'face))) - (if (consp face) (memq 'org-tag face) - (eq 'org-tag face)))))) + (let ((face (get-text-property + (max (1- start) (point-min)) 'face))) + (if (consp face) (memq 'org-tag face) + (eq 'org-tag face)))))) (let* ((link-object (save-excursion (goto-char start) (save-match-data (org-element-link-parser)))) @@ -4982,6 +4982,99 @@ (defun org-activate-links (limit) (funcall f start end path (eq style 'bracket)))) (throw :exit t))))) ;signal success nil)) +(defun org-activate-links--text-properties (limit) + "Add link properties to links. +This includes angle, plain, and bracket links." + (catch :exit + (while (re-search-forward org-link-any-re limit t) + (let* ((start (match-beginning 0)) + (end (match-end 0)) + (visible-start (or (match-beginning 3) (match-beginning 2))) + (visible-end (or (match-end 3) (match-end 2))) + (style (cond ((eq ?< (char-after start)) 'angle) + ((eq ?\[ (char-after (1+ start))) 'bracket) + (t 'plain)))) + (when (and (memq style org-highlight-links) + ;; Do not span over paragraph boundaries. + (not (string-match-p org-element-paragraph-separate + (match-string 0))) + ;; Do not confuse plain links with tags. + (not (and (eq style 'plain) + (let ((face (get-text-property + (max (1- start) (point-min)) 'face))) + (if (consp face) (memq 'org-tag face) + (eq 'org-tag face)))))) + (let* ((link-object (save-excursion + (goto-char start) + (save-match-data (org-element-link-parser)))) + (link (org-element-property :raw-link link-object)) + (type (org-element-property :type link-object)) + (path (org-element-property :path link-object)) + (face-property (pcase (org-link-get-parameter type :face) + ((and (pred functionp) face) (funcall face path)) + ((and (pred facep) face) face) + ((and (pred consp) face) face) ;anonymous + (_ 'org-link))) + (properties ;for link's visible part + (list 'mouse-face (or (org-link-get-parameter type :mouse-face) + 'highlight) + 'keymap (or (org-link-get-parameter type :keymap) + org-mouse-map) + 'help-echo (pcase (org-link-get-parameter type :help-echo) + ((and (pred stringp) echo) echo) + ((and (pred functionp) echo) echo) + (_ (concat "LINK: " link))) + 'htmlize-link (pcase (org-link-get-parameter type + :htmlize-link) + ((and (pred functionp) f) (funcall f)) + (_ `(:uri ,link))) + 'font-lock-multiline t))) + (org-remove-flyspell-overlays-in start end) + (org-rear-nonsticky-at end) + (if (not (eq 'bracket style)) + (progn + (add-face-text-property start end face-property) + (add-text-properties start end properties)) + ;; Initialise folding when used ouside org-mode. + (unless (or (derived-mode-p 'org-mode) + (and (org-fold-folding-spec-p 'org-link-description) + (org-fold-folding-spec-p 'org-link))) + (org-fold-initialize (or (and (stringp org-ellipsis) (not (equal "" org-ellipsis)) org-ellipsis) + "..."))) + ;; Handle invisible parts in bracket links. + (let ((spec (or (org-link-get-parameter type :display) + 'org-link))) + (unless (org-fold-folding-spec-p spec) + (org-fold-add-folding-spec spec + (cdr org-link--link-folding-spec) + nil + 'append) + (org-fold-core-set-folding-spec-property spec :visible t)) + (org-fold-region start end nil 'org-link) + (org-fold-region start end nil 'org-link-description) + ;; We are folding the whole emphasised text with SPEC + ;; first. It makes everything invisible (or whatever + ;; the user wants). + (org-fold-region start end t spec) + ;; The visible part of the text is folded using + ;; 'org-link-description, which is forcing this part of + ;; the text to be visible. + (org-fold-region visible-start visible-end t 'org-link-description) + (add-text-properties start end properties) + (add-face-text-property start end face-property) + (org-rear-nonsticky-at visible-start) + (org-rear-nonsticky-at visible-end))) + (let ((f (org-link-get-parameter type :activate-func))) + (when (functionp f) + (funcall f start end path (eq style 'bracket)))) + (throw :exit t))))) ;signal success + nil)) +(defsubst org-activate-links (limit) + "Add link properties to links. +This includes angle, plain, and bracket links." + (if (eq org-fold-core-style 'text-properties) + (org-activate-links--text-properties limit) + (org-activate-links--overlays limit))) (defun org-activate-code (limit) (when (re-search-forward "^[ \t]*\\(:\\(?: .*\\|$\\)\n?\\)" limit t) @@ -6739,81 +6832,82 @@ (defun org-paste-subtree (&optional level tree for-yank remove) (substitute-command-keys "The kill is not a (set of) tree(s). Use `\\[yank]' to yank anyway"))) (org-with-limited-levels - (let* ((visp (not (org-invisible-p))) - (txt tree) - (old-level (if (string-match org-outline-regexp-bol txt) - (- (match-end 0) (match-beginning 0) 1) - -1)) - (force-level - (cond - (level (prefix-numeric-value level)) - ;; When point is after the stars in an otherwise empty - ;; headline, use the number of stars as the forced level. - ((and (org-match-line "^\\*+[ \t]*$") - (not (eq ?* (char-after)))) - (org-outline-level)) - ((looking-at-p org-outline-regexp-bol) (org-outline-level)))) - (previous-level - (save-excursion - (org-previous-visible-heading 1) - (if (org-at-heading-p) (org-outline-level) 1))) - (next-level - (save-excursion - (if (org-at-heading-p) (org-outline-level) - (org-next-visible-heading 1) - (if (org-at-heading-p) (org-outline-level) 1)))) - (new-level (or force-level (max previous-level next-level))) - (shift (if (or (= old-level -1) - (= new-level -1) - (= old-level new-level)) - 0 - (- new-level old-level))) - (delta (if (> shift 0) -1 1)) - (func (if (> shift 0) #'org-demote #'org-promote)) - (org-odd-levels-only nil) - beg end newend) - ;; Remove the forced level indicator. - (when (and force-level (not level)) - (delete-region (line-beginning-position) (point))) - ;; Paste before the next visible heading or at end of buffer, - ;; unless point is at the beginning of a headline. - (unless (and (bolp) (org-at-heading-p)) - (org-next-visible-heading 1) - (unless (bolp) (insert "\n"))) - (setq beg (point)) - ;; Avoid re-parsing cache elements when i.e. level 1 heading - ;; is inserted and then promoted. - (combine-change-calls beg beg - (when (fboundp 'org-id-paste-tracker) (org-id-paste-tracker txt)) - (insert-before-markers txt) - (unless (string-suffix-p "\n" txt) (insert "\n")) - (setq newend (point)) - (org-reinstall-markers-in-region beg) - (setq end (point)) - (goto-char beg) - (skip-chars-forward " \t\n\r") - (setq beg (point)) - (when (and (org-invisible-p) visp) - (save-excursion (outline-show-heading))) - ;; Shift if necessary. - (unless (= shift 0) - (save-restriction - (narrow-to-region beg end) - (while (not (= shift 0)) - (org-map-region func (point-min) (point-max)) - (setq shift (+ delta shift))) - (goto-char (point-min)) - (setq newend (point-max))))) - (when (or for-yank (called-interactively-p 'interactive)) - (message "Clipboard pasted as level %d subtree" new-level)) - (when (and (not for-yank) ; in this case, org-yank will decide about folding - kill-ring - (equal org-subtree-clip (current-kill 0)) - org-subtree-clip-folded) - ;; The tree was folded before it was killed/copied - (org-flag-subtree t)) - (when for-yank (goto-char newend)) - (when remove (pop kill-ring))))) + (org-fold-core-ignore-fragility-checks + (let* ((visp (not (org-invisible-p))) + (txt tree) + (old-level (if (string-match org-outline-regexp-bol txt) + (- (match-end 0) (match-beginning 0) 1) + -1)) + (force-level + (cond + (level (prefix-numeric-value level)) + ;; When point is after the stars in an otherwise empty + ;; headline, use the number of stars as the forced level. + ((and (org-match-line "^\\*+[ \t]*$") + (not (eq ?* (char-after)))) + (org-outline-level)) + ((looking-at-p org-outline-regexp-bol) (org-outline-level)))) + (previous-level + (save-excursion + (org-previous-visible-heading 1) + (if (org-at-heading-p) (org-outline-level) 1))) + (next-level + (save-excursion + (if (org-at-heading-p) (org-outline-level) + (org-next-visible-heading 1) + (if (org-at-heading-p) (org-outline-level) 1)))) + (new-level (or force-level (max previous-level next-level))) + (shift (if (or (= old-level -1) + (= new-level -1) + (= old-level new-level)) + 0 + (- new-level old-level))) + (delta (if (> shift 0) -1 1)) + (func (if (> shift 0) #'org-demote #'org-promote)) + (org-odd-levels-only nil) + beg end newend) + ;; Remove the forced level indicator. + (when (and force-level (not level)) + (delete-region (line-beginning-position) (point))) + ;; Paste before the next visible heading or at end of buffer, + ;; unless point is at the beginning of a headline. + (unless (and (bolp) (org-at-heading-p)) + (org-next-visible-heading 1) + (unless (bolp) (insert "\n"))) + (setq beg (point)) + ;; Avoid re-parsing cache elements when i.e. level 1 heading + ;; is inserted and then promoted. + (combine-change-calls beg beg + (when (fboundp 'org-id-paste-tracker) (org-id-paste-tracker txt)) + (insert-before-markers txt) + (unless (string-suffix-p "\n" txt) (insert "\n")) + (setq newend (point)) + (org-reinstall-markers-in-region beg) + (setq end (point)) + (goto-char beg) + (skip-chars-forward " \t\n\r") + (setq beg (point)) + (when (and (org-invisible-p) visp) + (save-excursion (org-fold-heading nil))) + ;; Shift if necessary. + (unless (= shift 0) + (save-restriction + (narrow-to-region beg end) + (while (not (= shift 0)) + (org-map-region func (point-min) (point-max)) + (setq shift (+ delta shift))) + (goto-char (point-min)) + (setq newend (point-max))))) + (when (or for-yank (called-interactively-p 'interactive)) + (message "Clipboard pasted as level %d subtree" new-level)) + (when (and (not for-yank) ; in this case, org-yank will decide about folding + kill-ring + (equal org-subtree-clip (current-kill 0)) + org-subtree-clip-folded) + ;; The tree was folded before it was killed/copied + (org-fold-subtree t)) + (when for-yank (goto-char newend)) + (when remove (pop kill-ring)))))) (defun org-kill-is-subtree-p (&optional txt) "Check if the current kill is an outline subtree, or a set of trees. @@ -19996,7 +20090,7 @@ (defun org-backward-heading-same-level (arg &optional invisible-ok) (interactive "p") (org-forward-heading-same-level (if arg (- arg) -1) invisible-ok)) -(defun org-next-visible-heading (arg) +(defun org-next-visible-heading--overlays (arg) "Move to the next visible heading line. With ARG, repeats or can move backward if negative." (interactive "p") @@ -20022,6 +20116,35 @@ (defun org-next-visible-heading (arg) nil))) ;leave the loop (cl-decf arg)) (if (> arg 0) (goto-char (point-max)) (beginning-of-line)))) +(defun org-next-visible-heading--text-properties (arg) + "Move to the next visible heading line. +With ARG, repeats or can move backward if negative." + (interactive "p") + (let ((regexp (concat "^" (org-get-limited-outline-regexp)))) + (if (< arg 0) + (beginning-of-line) + (end-of-line)) + (while (and (< arg 0) (re-search-backward regexp nil :move)) + (unless (bobp) + (when (org-fold-folded-p) + (goto-char (org-fold-previous-visibility-change)) + (unless (looking-at-p regexp) + (re-search-backward regexp nil :mode)))) + (cl-incf arg)) + (while (and (> arg 0) (re-search-forward regexp nil :move)) + (when (org-fold-folded-p) + (goto-char (org-fold-next-visibility-change)) + (skip-chars-forward " \t\n") + (end-of-line)) + (cl-decf arg)) + (if (> arg 0) (goto-char (point-max)) (beginning-of-line)))) +(defun org-next-visible-heading (arg) + "Move to the next visible heading line. +With ARG, repeats or can move backward if negative." + (interactive "p") + (if (eq org-fold-core-style 'text-properties) + (org-next-visible-heading--text-properties arg) + (org-next-visible-heading--overlays arg))) (defun org-previous-visible-heading (arg) "Move to the previous visible heading. @@ -20154,7 +20277,7 @@ (defun org--paragraph-at-point () (list :begin b :end e :parent p :post-blank 0 :post-affiliated b))) (_ e)))) -(defun org--forward-paragraph-once () +(defun org--forward-paragraph-once--overlays () "Move forward to end of paragraph or equivalent, once. See `org-forward-paragraph'." (interactive) @@ -20226,8 +20349,84 @@ (defun org--forward-paragraph-once () (goto-char end) (skip-chars-backward " \t\n") (forward-line)))))))) +(defun org--forward-paragraph-once--text-properties () + "Move forward to end of paragraph or equivalent, once. +See `org-forward-paragraph'." + (interactive) + (save-restriction + (widen) + (skip-chars-forward " \t\n") + (cond + ((eobp) nil) + ;; When inside a folded part, move out of it. + ((when (org-invisible-p nil t) + (goto-char (cdr (org-fold-get-region-at-point))) + (forward-line) + t)) + (t + (let* ((element (org--paragraph-at-point)) + (type (org-element-type element)) + (contents-begin (org-element-property :contents-begin element)) + (end (org-element-property :end element)) + (post-affiliated (org-element-property :post-affiliated element))) + (cond + ((eq type 'plain-list) + (forward-char) + (org--forward-paragraph-once)) + ;; If the element is folded, skip it altogether. + ((when (org-with-point-at post-affiliated (org-invisible-p (line-end-position) t)) + (goto-char (cdr (org-fold-get-region-at-point + nil + (org-with-point-at post-affiliated + (line-end-position))))) + (forward-line) + t)) + ;; At a greater element, move inside. + ((and contents-begin + (> contents-begin (point)) + (not (eq type 'paragraph))) + (goto-char contents-begin) + ;; Items and footnote definitions contents may not start at + ;; the beginning of the line. In this case, skip until the + ;; next paragraph. + (cond + ((not (bolp)) (org--forward-paragraph-once)) + ((org-previous-line-empty-p) (forward-line -1)) + (t nil))) + ;; Move between empty lines in some blocks. + ((memq type '(comment-block example-block export-block src-block + verse-block)) + (let ((contents-start + (org-with-point-at post-affiliated + (line-beginning-position 2)))) + (if (< (point) contents-start) + (goto-char contents-start) + (let ((contents-end + (org-with-point-at end + (skip-chars-backward " \t\n") + (line-beginning-position)))) + (cond + ((>= (point) contents-end) + (goto-char end) + (skip-chars-backward " \t\n") + (forward-line)) + ((re-search-forward "^[ \t]*\n" contents-end :move) + (forward-line -1)) + (t nil)))))) + (t + ;; Move to element's end. + (goto-char end) + (skip-chars-backward " \t\n") + (forward-line)))))))) +(defun org--forward-paragraph-once () + "Move forward to end of paragraph or equivalent, once. +See `org-forward-paragraph'." + (interactive) + (if (eq org-fold-core-style 'text-properties) + (org--forward-paragraph-once--text-properties) + (org--forward-paragraph-once--overlays))) -(defun org--backward-paragraph-once () +(defun org--backward-paragraph-once--overlays () "Move backward to start of paragraph or equivalent, once. See `org-backward-paragraph'." (interactive) @@ -20329,6 +20528,108 @@ (defun org--backward-paragraph-once () ;; Move to element's start. (t (funcall reach begin)))))))) +(defun org--backward-paragraph-once--text-properties () + "Move backward to start of paragraph or equivalent, once. +See `org-backward-paragraph'." + (interactive) + (save-restriction + (widen) + (cond + ((bobp) nil) + ;; Blank lines at the beginning of the buffer. + ((and (org-match-line "^[ \t]*$") + (save-excursion (skip-chars-backward " \t\n") (bobp))) + (goto-char (point-min))) + ;; When inside a folded part, move out of it. + ((when (org-invisible-p (1- (point)) t) + (goto-char (1- (car (org-fold-get-region-at-point nil (1- (point)))))) + (org--backward-paragraph-once) + t)) + (t + (let* ((element (org--paragraph-at-point)) + (type (org-element-type element)) + (begin (org-element-property :begin element)) + (post-affiliated (org-element-property :post-affiliated element)) + (contents-end (org-element-property :contents-end element)) + (end (org-element-property :end element)) + (parent (org-element-property :parent element)) + (reach + ;; Move to the visible empty line above position P, or + ;; to position P. Return t. + (lambda (p) + (goto-char p) + (when (and (org-previous-line-empty-p) + (let ((end (line-end-position 0))) + (or (= end (point-min)) + (not (org-invisible-p (1- end)))))) + (forward-line -1)) + t))) + (cond + ;; Already at the beginning of an element. + ((= begin (point)) + (cond + ;; There is a blank line above. Move there. + ((and (org-previous-line-empty-p) + (not (org-invisible-p (1- (line-end-position 0))))) + (forward-line -1)) + ;; At the beginning of the first element within a greater + ;; element. Move to the beginning of the greater element. + ((and parent + (not (eq 'section (org-element-type parent))) + (= begin (org-element-property :contents-begin parent))) + (funcall reach (org-element-property :begin parent))) + ;; Since we have to move anyway, find the beginning + ;; position of the element above. + (t + (forward-char -1) + (org--backward-paragraph-once)))) + ;; Skip paragraphs at the very beginning of footnote + ;; definitions or items. + ((and (eq type 'paragraph) + (org-with-point-at begin (not (bolp)))) + (funcall reach (progn (goto-char begin) (line-beginning-position)))) + ;; If the element is folded, skip it altogether. + ((org-with-point-at post-affiliated (org-invisible-p (line-end-position) t)) + (funcall reach begin)) + ;; At the end of a greater element, move inside. + ((and contents-end + (<= contents-end (point)) + (not (eq type 'paragraph))) + (cond + ((memq type '(footnote-definition plain-list)) + (skip-chars-backward " \t\n") + (org--backward-paragraph-once)) + ((= contents-end (point)) + (forward-char -1) + (org--backward-paragraph-once)) + (t + (goto-char contents-end)))) + ;; Move between empty lines in some blocks. + ((and (memq type '(comment-block example-block export-block src-block + verse-block)) + (let ((contents-start + (org-with-point-at post-affiliated + (line-beginning-position 2)))) + (when (> (point) contents-start) + (let ((contents-end + (org-with-point-at end + (skip-chars-backward " \t\n") + (line-beginning-position)))) + (if (> (point) contents-end) + (progn (goto-char contents-end) t) + (skip-chars-backward " \t\n" begin) + (re-search-backward "^[ \t]*\n" contents-start :move) + t)))))) + ;; Move to element's start. + (t + (funcall reach begin)))))))) +(defun org--backward-paragraph-once () + "Move backward to start of paragraph or equivalent, once. +See `org-backward-paragraph'." + (interactive) + (if (eq org-fold-core-style 'text-properties) + (org--backward-paragraph-once--text-properties) + (org--backward-paragraph-once--overlays))) (defun org-forward-element () "Move forward by one element. ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH 12/35] org-fold: Handle indirect buffer visibility 2022-01-29 11:37 ` [PATCH 00/35] Merge org-fold feature branch Ihor Radchenko ` (10 preceding siblings ...) 2022-01-29 11:38 ` [PATCH 11/35] Implement overlay- and text-property-based versions of some functions Ihor Radchenko @ 2022-01-29 11:38 ` Ihor Radchenko 2022-01-29 11:38 ` [PATCH 13/35] Fix subtle differences between overlays and invisible text properties Ihor Radchenko ` (23 subsequent siblings) 35 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-01-29 11:38 UTC (permalink / raw) To: Bastien, Kyle Meyer, Nicolas Goaziou, Karl Voit, Christian Heinrich, emacs-orgmode Cc: Ihor Radchenko [-- Attachment #1: Type: text/plain, Size: 121 bytes --] --- lisp/org-capture.el | 5 ++++- lisp/org.el | 8 +++++++- 2 files changed, 11 insertions(+), 2 deletions(-) [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0012-org-fold-Handle-indirect-buffer-visibility.patch --] [-- Type: text/x-patch; name="0012-org-fold-Handle-indirect-buffer-visibility.patch", Size: 1493 bytes --] diff --git a/lisp/org-capture.el b/lisp/org-capture.el index 1d4d6e877..08b35dd99 100644 --- a/lisp/org-capture.el +++ b/lisp/org-capture.el @@ -1171,7 +1171,10 @@ (defun org-capture-place-entry () (goto-char (point-min)) (unless (org-at-heading-p) (outline-next-heading))) ;; Otherwise, insert as a top-level entry at the end of the file. - (t (goto-char (point-max)))) + (t (goto-char (point-max)) + ;; Make sure that last point is not folded. + (org-fold-core-cycle-over-indirect-buffers + (org-fold-region (max 1 (1- (point-max))) (point-max) nil)))) (let ((origin (point))) (unless (bolp) (insert "\n")) (org-capture-empty-lines-before) diff --git a/lisp/org.el b/lisp/org.el index 0967cbf1c..575a327da 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -5983,7 +5983,13 @@ (defun org-get-indirect-buffer (&optional buffer heading) (number-to-string n)))))) (setq n (1+ n))) (condition-case nil - (make-indirect-buffer buffer bname 'clone) + (let ((indirect-buffer (make-indirect-buffer buffer bname 'clone))) + ;; Decouple folding state. We need to do it manually since + ;; `make-indirect-buffer' does not run + ;; `clone-indirect-buffer-hook'. + (org-fold-core-decouple-indirect-buffer-folds) + ;; Return the buffer. + indirect-buffer) (error (make-indirect-buffer buffer bname))))) (defun org-set-frame-title (title) ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH 13/35] Fix subtle differences between overlays and invisible text properties 2022-01-29 11:37 ` [PATCH 00/35] Merge org-fold feature branch Ihor Radchenko ` (11 preceding siblings ...) 2022-01-29 11:38 ` [PATCH 12/35] org-fold: Handle indirect buffer visibility Ihor Radchenko @ 2022-01-29 11:38 ` Ihor Radchenko 2022-01-29 11:38 ` [PATCH 14/35] Support extra org-fold optimisations for huge buffers Ihor Radchenko ` (22 subsequent siblings) 35 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-01-29 11:38 UTC (permalink / raw) To: Bastien, Kyle Meyer, Nicolas Goaziou, Karl Voit, Christian Heinrich, emacs-orgmode Cc: Ihor Radchenko [-- Attachment #1: Type: text/plain, Size: 1188 bytes --] * lisp/org-clock.el (org-clock-in): (org-clock-find-position): (org-clock-out): * lisp/org.el (org-add-planning-info): (org-scan-tags): (org-global-tags-completion-table): (org-make-tags-matcher): (org-tags-expand): (org--property-local-values): (org-read-date-analyze): (org-revert-all-org-buffers): (org-beginning-of-line): Make sure that we inherit invisible state when inserting text. (org-sort-entries): Preserve invisible state after replace-match. (org-log-beginning): Do not try to move by visible lines. * lisp/org-macs.el (org-preserve-local-variables): Do not try to preserve overlays. * lisp/ox.el (org-export--generate-copy-script): Preserve folding properties in export buffer. * testing/lisp/test-ob.el (test-ob/preserve-results-indentation): Fix test failure. * testing/lisp/test-org.el (test-org/meta-return): (test-org/custom-properties): Use new folding. --- lisp/org-clock.el | 116 ++++---- lisp/org-macs.el | 12 +- lisp/org.el | 560 ++++++++++++++++++++------------------- lisp/ox.el | 4 +- testing/lisp/test-ob.el | 12 +- testing/lisp/test-org.el | 3 + 6 files changed, 367 insertions(+), 340 deletions(-) [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0013-Fix-subtle-differences-between-overlays-and-invisibl.patch --] [-- Type: text/x-patch; name="0013-Fix-subtle-differences-between-overlays-and-invisibl.patch", Size: 37914 bytes --] diff --git a/lisp/org-clock.el b/lisp/org-clock.el index 583b30237..ec87aaf8a 100644 --- a/lisp/org-clock.el +++ b/lisp/org-clock.el @@ -1373,14 +1373,14 @@ (defun org-clock-in (&optional select start-time) (sit-for 2) (throw 'abort nil)) (t - (insert-before-markers "\n") + (insert-before-markers-and-inherit "\n") (backward-char 1) (when (and (save-excursion (end-of-line 0) (org-in-item-p))) (beginning-of-line 1) (indent-line-to (max 0 (- (current-indentation) 2)))) - (insert org-clock-string " ") + (insert-and-inherit org-clock-string " ") (setq org-clock-effort (org-entry-get (point) org-effort-property)) (setq org-clock-total-time (org-clock-sum-current-item (org-clock-get-sum-start))) @@ -1581,19 +1581,23 @@ (defun org-clock-find-position (find-unclosed) count (1+ count)))))) (cond ((null positions) - ;; Skip planning line and property drawer, if any. - (org-end-of-meta-data) - (unless (bolp) (insert "\n")) - ;; Create a new drawer if necessary. - (when (and org-clock-into-drawer - (or (not (wholenump org-clock-into-drawer)) - (< org-clock-into-drawer 2))) - (let ((beg (point))) - (insert ":" drawer ":\n:END:\n") - (org-indent-region beg (point)) - (org-flag-region - (line-end-position -1) (1- (point)) t 'outline) - (forward-line -1)))) + (org-fold-core-ignore-modifications + ;; Skip planning line and property drawer, if any. + (org-end-of-meta-data) + (unless (bolp) (insert-and-inherit "\n")) + ;; Create a new drawer if necessary. + (when (and org-clock-into-drawer + (or (not (wholenump org-clock-into-drawer)) + (< org-clock-into-drawer 2))) + (let ((beg (point))) + (insert-and-inherit ":" drawer ":\n:END:\n") + (org-indent-region beg (point)) + (if (eq org-fold-core-style 'text-properties) + (org-fold-region + (line-end-position -1) (1- (point)) t 'drawer) + (org-fold-region + (line-end-position -1) (1- (point)) t 'outline)) + (forward-line -1))))) ;; When a clock drawer needs to be created because of the ;; number of clock items or simply if it is missing, collect ;; all clocks in the section and wrap them within the drawer. @@ -1602,28 +1606,29 @@ (defun org-clock-find-position (find-unclosed) drawer) ;; Skip planning line and property drawer, if any. (org-end-of-meta-data) - (let ((beg (point))) - (insert - (mapconcat - (lambda (p) - (save-excursion - (goto-char p) - (org-trim (delete-and-extract-region - (save-excursion (skip-chars-backward " \r\t\n") - (line-beginning-position 2)) - (line-beginning-position 2))))) - positions "\n") - "\n:END:\n") - (let ((end (point-marker))) - (goto-char beg) - (save-excursion (insert ":" drawer ":\n")) - (org-flag-region (line-end-position) (1- end) t 'outline) - (org-indent-region (point) end) - (forward-line) - (unless org-log-states-order-reversed - (goto-char end) - (beginning-of-line -1)) - (set-marker end nil)))) + (org-fold-core-ignore-modifications + (let ((beg (point))) + (insert-and-inherit + (mapconcat + (lambda (p) + (save-excursion + (goto-char p) + (org-trim (delete-and-extract-region + (save-excursion (skip-chars-backward " \r\t\n") + (line-beginning-position 2)) + (line-beginning-position 2))))) + positions "\n") + "\n:END:\n") + (let ((end (point-marker))) + (goto-char beg) + (save-excursion (insert-and-inherit ":" drawer ":\n")) + (org-fold-region (line-end-position) (1- end) t 'outline) + (org-indent-region (point) end) + (forward-line) + (unless org-log-states-order-reversed + (goto-char end) + (beginning-of-line -1)) + (set-marker end nil))))) (org-log-states-order-reversed (goto-char (car (last positions)))) (t (goto-char (car positions)))))))) @@ -1672,24 +1677,25 @@ (defun org-clock-out (&optional switch-to-state fail-quietly at-time) (if fail-quietly (throw 'exit nil) (error "Clock start time is gone"))) (goto-char (match-end 0)) (delete-region (point) (point-at-eol)) - (insert "--") - (setq te (org-insert-time-stamp (or at-time now) 'with-hm 'inactive)) - (setq s (org-time-convert-to-integer - (time-subtract - (org-time-string-to-time te) - (org-time-string-to-time ts))) - h (floor s 3600) - m (floor (mod s 3600) 60)) - (insert " => " (format "%2d:%02d" h m)) - (move-marker org-clock-marker nil) - (move-marker org-clock-hd-marker nil) - ;; Possibly remove zero time clocks. - (when (and org-clock-out-remove-zero-time-clocks - (= 0 h m)) - (setq remove t) - (delete-region (line-beginning-position) - (line-beginning-position 2))) - (org-clock-remove-empty-clock-drawer) + (org-fold-core-ignore-modifications + (insert-and-inherit "--") + (setq te (org-insert-time-stamp (or at-time now) 'with-hm 'inactive)) + (setq s (org-time-convert-to-integer + (time-subtract + (org-time-string-to-time te) + (org-time-string-to-time ts))) + h (floor s 3600) + m (floor (mod s 3600) 60)) + (insert-and-inherit " => " (format "%2d:%02d" h m)) + (move-marker org-clock-marker nil) + (move-marker org-clock-hd-marker nil) + ;; Possibly remove zero time clocks. + (when (and org-clock-out-remove-zero-time-clocks + (= 0 h m)) + (setq remove t) + (delete-region (line-beginning-position) + (line-beginning-position 2))) + (org-clock-remove-empty-clock-drawer)) (when org-clock-mode-line-timer (cancel-timer org-clock-mode-line-timer) (setq org-clock-mode-line-timer nil)) diff --git a/lisp/org-macs.el b/lisp/org-macs.el index 8f2133dd0..5494acb3e 100644 --- a/lisp/org-macs.el +++ b/lisp/org-macs.el @@ -170,16 +170,8 @@ (defmacro org-preserve-local-variables (&rest body) (when local-variables (org-with-wide-buffer (goto-char (point-max)) - ;; If last section is folded, make sure to also hide file - ;; local variables after inserting them back. - (let ((overlay - (cl-find-if (lambda (o) - (eq 'outline (overlay-get o 'invisible))) - (overlays-at (1- (point)))))) - (unless (bolp) (insert "\n")) - (insert local-variables) - (when overlay - (move-overlay overlay (overlay-start overlay) (point-max))))))))) + (unless (bolp) (insert "\n")) + (insert local-variables)))))) (defmacro org-no-popups (&rest body) "Suppress popup windows and evaluate BODY." diff --git a/lisp/org.el b/lisp/org.el index 575a327da..a59d550ca 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -6410,7 +6410,7 @@ (defun org-promote () (replace-match "# " nil t)) ((= level 1) (user-error "Cannot promote to level 0. UNDO to recover if necessary")) - (t (replace-match up-head nil t))) + (t (replace-match (apply #'propertize up-head (text-properties-at (match-beginning 0))) t))) (unless (= level 1) (when org-auto-align-tags (org-align-tags)) (when org-adapt-indentation (org-fixup-indentation (- diff)))) @@ -6425,9 +6425,10 @@ (defun org-demote () (level (save-match-data (funcall outline-level))) (down-head (concat (make-string (org-get-valid-level level 1) ?*) " ")) (diff (abs (- level (length down-head) -1)))) - (replace-match down-head nil t) - (when org-auto-align-tags (org-align-tags)) - (when org-adapt-indentation (org-fixup-indentation diff)) + (org-fold-core-ignore-fragility-checks + (replace-match (apply #'propertize down-head (text-properties-at (match-beginning 0))) t) + (when org-auto-align-tags (org-align-tags)) + (when org-adapt-indentation (org-fixup-indentation diff))) (run-hooks 'org-after-demote-entry-hook)))) (defun org-cycle-level () @@ -8954,7 +8955,15 @@ (defun org-todo (&optional arg) this org-state block-reason) (throw 'exit nil))))) (store-match-data match-data) - (replace-match next t t) + (org-fold-core-ignore-modifications + (save-excursion + (goto-char (match-beginning 0)) + (setf (buffer-substring (match-beginning 0) (match-end 0)) "") + (insert-and-inherit next) + (unless (org-invisible-p (line-beginning-position)) + (org-fold-region (line-beginning-position) + (line-end-position) + nil)))) (cond ((and org-state (equal this org-state)) (message "TODO state was already %s" (org-trim next))) ((not (pos-visible-in-window-p hl-pos)) @@ -9695,81 +9704,82 @@ (defun org--deadline-or-schedule (arg type time) "Insert DEADLINE or SCHEDULE information in current entry. TYPE is either `deadline' or `scheduled'. See `org-deadline' or `org-schedule' for information about ARG and TIME arguments." - (let* ((deadline? (eq type 'deadline)) - (keyword (if deadline? org-deadline-string org-scheduled-string)) - (log (if deadline? org-log-redeadline org-log-reschedule)) - (old-date (org-entry-get nil (if deadline? "DEADLINE" "SCHEDULED"))) - (old-date-time (and old-date (org-time-string-to-time old-date))) - ;; Save repeater cookie from either TIME or current scheduled - ;; time stamp. We are going to insert it back at the end of - ;; the process. - (repeater (or (and (org-string-nw-p time) - ;; We use `org-repeat-re' because we need - ;; to tell the difference between a real - ;; repeater and a time delta, e.g. "+2d". - (string-match org-repeat-re time) - (match-string 1 time)) - (and (org-string-nw-p old-date) - (string-match "\\([.+-]+[0-9]+[hdwmy]\ + (org-fold-core-ignore-modifications + (let* ((deadline? (eq type 'deadline)) + (keyword (if deadline? org-deadline-string org-scheduled-string)) + (log (if deadline? org-log-redeadline org-log-reschedule)) + (old-date (org-entry-get nil (if deadline? "DEADLINE" "SCHEDULED"))) + (old-date-time (and old-date (org-time-string-to-time old-date))) + ;; Save repeater cookie from either TIME or current scheduled + ;; time stamp. We are going to insert it back at the end of + ;; the process. + (repeater (or (and (org-string-nw-p time) + ;; We use `org-repeat-re' because we need + ;; to tell the difference between a real + ;; repeater and a time delta, e.g. "+2d". + (string-match org-repeat-re time) + (match-string 1 time)) + (and (org-string-nw-p old-date) + (string-match "\\([.+-]+[0-9]+[hdwmy]\ \\(?:[/ ][-+]?[0-9]+[hdwmy]\\)?\\)" - old-date) - (match-string 1 old-date))))) - (pcase arg - (`(4) - (if (not old-date) - (message (if deadline? "Entry had no deadline to remove" - "Entry was not scheduled")) - (when (and old-date log) - (org-add-log-setup (if deadline? 'deldeadline 'delschedule) - nil old-date log)) - (org-remove-timestamp-with-keyword keyword) - (message (if deadline? "Entry no longer has a deadline." - "Entry is no longer scheduled.")))) - (`(16) - (save-excursion - (org-back-to-heading t) - (let ((regexp (if deadline? org-deadline-time-regexp - org-scheduled-time-regexp))) - (if (not (re-search-forward regexp (line-end-position 2) t)) - (user-error (if deadline? "No deadline information to update" - "No scheduled information to update")) - (let* ((rpl0 (match-string 1)) - (rpl (replace-regexp-in-string " -[0-9]+[hdwmy]" "" rpl0)) - (msg (if deadline? "Warn starting from" "Delay until"))) - (replace-match - (concat keyword - " <" rpl - (format " -%dd" - (abs (- (time-to-days - (save-match-data - (org-read-date - nil t nil msg old-date-time))) - (time-to-days old-date-time)))) - ">") t t)))))) - (_ - (org-add-planning-info type time 'closed) - (when (and old-date - log - (not (equal old-date org-last-inserted-timestamp))) - (org-add-log-setup (if deadline? 'redeadline 'reschedule) - org-last-inserted-timestamp - old-date - log)) - (when repeater - (save-excursion - (org-back-to-heading t) - (when (re-search-forward - (concat keyword " " org-last-inserted-timestamp) - (line-end-position 2) - t) - (goto-char (1- (match-end 0))) - (insert " " repeater) - (setq org-last-inserted-timestamp - (concat (substring org-last-inserted-timestamp 0 -1) - " " repeater - (substring org-last-inserted-timestamp -1)))))) - (message (if deadline? "Deadline on %s" "Scheduled to %s") - org-last-inserted-timestamp))))) + old-date) + (match-string 1 old-date))))) + (pcase arg + (`(4) + (if (not old-date) + (message (if deadline? "Entry had no deadline to remove" + "Entry was not scheduled")) + (when (and old-date log) + (org-add-log-setup (if deadline? 'deldeadline 'delschedule) + nil old-date log)) + (org-remove-timestamp-with-keyword keyword) + (message (if deadline? "Entry no longer has a deadline." + "Entry is no longer scheduled.")))) + (`(16) + (save-excursion + (org-back-to-heading t) + (let ((regexp (if deadline? org-deadline-time-regexp + org-scheduled-time-regexp))) + (if (not (re-search-forward regexp (line-end-position 2) t)) + (user-error (if deadline? "No deadline information to update" + "No scheduled information to update")) + (let* ((rpl0 (match-string 1)) + (rpl (replace-regexp-in-string " -[0-9]+[hdwmy]" "" rpl0)) + (msg (if deadline? "Warn starting from" "Delay until"))) + (replace-match + (concat keyword + " <" rpl + (format " -%dd" + (abs (- (time-to-days + (save-match-data + (org-read-date + nil t nil msg old-date-time))) + (time-to-days old-date-time)))) + ">") t t)))))) + (_ + (org-add-planning-info type time 'closed) + (when (and old-date + log + (not (equal old-date org-last-inserted-timestamp))) + (org-add-log-setup (if deadline? 'redeadline 'reschedule) + org-last-inserted-timestamp + old-date + log)) + (when repeater + (save-excursion + (org-back-to-heading t) + (when (re-search-forward + (concat keyword " " org-last-inserted-timestamp) + (line-end-position 2) + t) + (goto-char (1- (match-end 0))) + (insert-and-inherit " " repeater) + (setq org-last-inserted-timestamp + (concat (substring org-last-inserted-timestamp 0 -1) + " " repeater + (substring org-last-inserted-timestamp -1)))))) + (message (if deadline? "Deadline on %s" "Scheduled to %s") + org-last-inserted-timestamp)))))) (defun org-deadline (arg &optional time) "Insert a \"DEADLINE:\" string with a timestamp to make a deadline. @@ -9874,101 +9884,102 @@ (defun org-add-planning-info (what &optional time &rest remove) the time to use. If none is given, the user is prompted for a date. REMOVE indicates what kind of entries to remove. An old WHAT entry will also be removed." - (let (org-time-was-given org-end-time-was-given default-time default-input) - (when (and (memq what '(scheduled deadline)) - (or (not time) - (and (stringp time) - (string-match "^[-+]+[0-9]" time)))) - ;; Try to get a default date/time from existing timestamp - (save-excursion - (org-back-to-heading t) - (let ((end (save-excursion (outline-next-heading) (point))) ts) - (when (re-search-forward (if (eq what 'scheduled) - org-scheduled-time-regexp - org-deadline-time-regexp) - end t) - (setq ts (match-string 1) - default-time (org-time-string-to-time ts) - default-input (and ts (org-get-compact-tod ts))))))) - (when what - (setq time - (if (stringp time) - ;; This is a string (relative or absolute), set - ;; proper date. - (apply #'encode-time - (org-read-date-analyze - time default-time (decode-time default-time))) - ;; If necessary, get the time from the user - (or time (org-read-date nil 'to-time nil - (cl-case what - (deadline "DEADLINE") - (scheduled "SCHEDULED") - (otherwise nil)) - default-time default-input))))) - (org-with-wide-buffer - (org-back-to-heading t) - (let ((planning? (save-excursion - (forward-line) - (looking-at-p org-planning-line-re)))) - (cond - (planning? - (forward-line) - ;; Move to current indentation. - (skip-chars-forward " \t") - ;; Check if we have to remove something. - (dolist (type (if what (cons what remove) remove)) - (save-excursion - (when (re-search-forward - (cl-case type - (closed org-closed-time-regexp) - (deadline org-deadline-time-regexp) - (scheduled org-scheduled-time-regexp) - (otherwise (error "Invalid planning type: %s" type))) - (line-end-position) - t) - ;; Delete until next keyword or end of line. - (delete-region - (match-beginning 0) - (if (re-search-forward org-keyword-time-not-clock-regexp - (line-end-position) - t) + (org-fold-core-ignore-modifications + (let (org-time-was-given org-end-time-was-given default-time default-input) + (when (and (memq what '(scheduled deadline)) + (or (not time) + (and (stringp time) + (string-match "^[-+]+[0-9]" time)))) + ;; Try to get a default date/time from existing timestamp + (save-excursion + (org-back-to-heading t) + (let ((end (save-excursion (outline-next-heading) (point))) ts) + (when (re-search-forward (if (eq what 'scheduled) + org-scheduled-time-regexp + org-deadline-time-regexp) + end t) + (setq ts (match-string 1) + default-time (org-time-string-to-time ts) + default-input (and ts (org-get-compact-tod ts))))))) + (when what + (setq time + (if (stringp time) + ;; This is a string (relative or absolute), set + ;; proper date. + (apply #'encode-time + (org-read-date-analyze + time default-time (decode-time default-time))) + ;; If necessary, get the time from the user + (or time (org-read-date nil 'to-time nil + (cl-case what + (deadline "DEADLINE") + (scheduled "SCHEDULED") + (otherwise nil)) + default-time default-input))))) + (org-with-wide-buffer + (org-back-to-heading t) + (let ((planning? (save-excursion + (forward-line) + (looking-at-p org-planning-line-re)))) + (cond + (planning? + (forward-line) + ;; Move to current indentation. + (skip-chars-forward " \t") + ;; Check if we have to remove something. + (dolist (type (if what (cons what remove) remove)) + (save-excursion + (when (re-search-forward + (cl-case type + (closed org-closed-time-regexp) + (deadline org-deadline-time-regexp) + (scheduled org-scheduled-time-regexp) + (otherwise (error "Invalid planning type: %s" type))) + (line-end-position) + t) + ;; Delete until next keyword or end of line. + (delete-region (match-beginning 0) - (line-end-position)))))) - ;; If there is nothing more to add and no more keyword is - ;; left, remove the line completely. - (if (and (looking-at-p "[ \t]*$") (not what)) - (delete-region (line-end-position 0) - (line-end-position)) - ;; If we removed last keyword, do not leave trailing white - ;; space at the end of line. - (let ((p (point))) - (save-excursion - (end-of-line) - (unless (= (skip-chars-backward " \t" p) 0) - (delete-region (point) (line-end-position))))))) - (what - (end-of-line) - (insert "\n") - (when org-adapt-indentation - (indent-to-column (1+ (org-outline-level))))) - (t nil))) - (when what - ;; Insert planning keyword. - (insert (cl-case what - (closed org-closed-string) - (deadline org-deadline-string) - (scheduled org-scheduled-string) - (otherwise (error "Invalid planning type: %s" what))) - " ") - ;; Insert associated timestamp. - (let ((ts (org-insert-time-stamp - time - (or org-time-was-given - (and (eq what 'closed) org-log-done-with-time)) - (eq what 'closed) - nil nil (list org-end-time-was-given)))) - (unless (eolp) (insert " ")) - ts))))) + (if (re-search-forward org-keyword-time-not-clock-regexp + (line-end-position) + t) + (match-beginning 0) + (line-end-position)))))) + ;; If there is nothing more to add and no more keyword is + ;; left, remove the line completely. + (if (and (looking-at-p "[ \t]*$") (not what)) + (delete-region (line-end-position 0) + (line-end-position)) + ;; If we removed last keyword, do not leave trailing white + ;; space at the end of line. + (let ((p (point))) + (save-excursion + (end-of-line) + (unless (= (skip-chars-backward " \t" p) 0) + (delete-region (point) (line-end-position))))))) + (what + (end-of-line) + (insert-and-inherit "\n") + (when org-adapt-indentation + (indent-to-column (1+ (org-outline-level))))) + (t nil))) + (when what + ;; Insert planning keyword. + (insert-and-inherit (cl-case what + (closed org-closed-string) + (deadline org-deadline-string) + (scheduled org-scheduled-string) + (otherwise (error "Invalid planning type: %s" what))) + " ") + ;; Insert associated timestamp. + (let ((ts (org-insert-time-stamp + time + (or org-time-was-given + (and (eq what 'closed) org-log-done-with-time)) + (eq what 'closed) + nil nil (list org-end-time-was-given)))) + (unless (eolp) (insert " ")) + ts)))))) (defvar org-log-note-marker (make-marker) "Marker pointing at the entry where the note is to be inserted.") @@ -10018,13 +10029,19 @@ (defun org-log-beginning (&optional create) (throw 'exit nil)))) ;; No drawer found. Create one, if permitted. (when create - (unless (bolp) (insert "\n")) - (let ((beg (point))) - (insert ":" drawer ":\n:END:\n") - (org-indent-region beg (point)) - (org-flag-region (line-end-position -1) - (1- (point)) t 'outline)) - (end-of-line -1))))) + ;; Avoid situation when we insert drawer right before + ;; first "*". Otherwise, if the previous heading is + ;; folded, we are inserting after visible newline at + ;; the end of the fold, thus breaking the fold + ;; continuity. + (when (org-at-heading-p) (backward-char)) + (org-fold-core-ignore-modifications + (unless (bolp) (insert-and-inherit "\n")) + (let ((beg (point))) + (insert-and-inherit ":" drawer ":\n:END:\n") + (org-indent-region beg (point)) + (org-fold-region (line-end-position -1) (1- (point)) t (if (eq org-fold-core-style 'text-properties) 'drawer 'outline))))) + (end-of-line -1)))) (t (org-end-of-meta-data org-log-state-notes-insert-after-drawers) (skip-chars-forward " \t\n") @@ -10032,7 +10049,7 @@ (defun org-log-beginning (&optional create) (unless org-log-states-order-reversed (org-skip-over-state-notes) (skip-chars-backward " \t\n") - (forward-line))))) + (beginning-of-line 2))))) (if (bolp) (point) (line-beginning-position 2)))) (defun org-add-log-setup (&optional purpose state prev-state how extra) @@ -10158,34 +10175,35 @@ (defun org-store-log-note () (push note lines)) (when (and lines (not org-note-abort)) (with-current-buffer (marker-buffer org-log-note-marker) - (org-with-wide-buffer - ;; Find location for the new note. - (goto-char org-log-note-marker) - (set-marker org-log-note-marker nil) - ;; Note associated to a clock is to be located right after - ;; the clock. Do not move point. - (unless (eq org-log-note-purpose 'clock-out) - (goto-char (org-log-beginning t))) - ;; Make sure point is at the beginning of an empty line. - (cond ((not (bolp)) (let ((inhibit-read-only t)) (insert "\n"))) - ((looking-at "[ \t]*\\S-") (save-excursion (insert "\n")))) - ;; In an existing list, add a new item at the top level. - ;; Otherwise, indent line like a regular one. - (let ((itemp (org-in-item-p))) - (if itemp - (indent-line-to - (let ((struct (save-excursion - (goto-char itemp) (org-list-struct)))) - (org-list-get-ind (org-list-get-top-point struct) struct))) - (org-indent-line))) - (insert (org-list-bullet-string "-") (pop lines)) - (let ((ind (org-list-item-body-column (line-beginning-position)))) - (dolist (line lines) - (insert "\n") - (indent-line-to ind) - (insert line))) - (message "Note stored") - (org-back-to-heading t))))) + (org-fold-core-ignore-modifications + (org-with-wide-buffer + ;; Find location for the new note. + (goto-char org-log-note-marker) + (set-marker org-log-note-marker nil) + ;; Note associated to a clock is to be located right after + ;; the clock. Do not move point. + (unless (eq org-log-note-purpose 'clock-out) + (goto-char (org-log-beginning t))) + ;; Make sure point is at the beginning of an empty line. + (cond ((not (bolp)) (let ((inhibit-read-only t)) (insert-and-inherit "\n"))) + ((looking-at "[ \t]*\\S-") (save-excursion (insert-and-inherit "\n")))) + ;; In an existing list, add a new item at the top level. + ;; Otherwise, indent line like a regular one. + (let ((itemp (org-in-item-p))) + (if itemp + (indent-line-to + (let ((struct (save-excursion + (goto-char itemp) (org-list-struct)))) + (org-list-get-ind (org-list-get-top-point struct) struct))) + (org-indent-line))) + (insert-and-inherit (org-list-bullet-string "-") (pop lines)) + (let ((ind (org-list-item-body-column (line-beginning-position)))) + (dolist (line lines) + (insert-and-inherit "\n") + (indent-line-to ind) + (insert-and-inherit line))) + (message "Note stored") + (org-back-to-heading t)))))) ;; Don't add undo information when called from `org-agenda-todo'. (set-window-configuration org-log-note-window-configuration) (with-current-buffer (marker-buffer org-log-note-return-to) @@ -11316,34 +11334,35 @@ (defun org-set-tags (tags) This function assumes point is on a headline." (org-with-wide-buffer - (let ((tags (pcase tags - ((pred listp) tags) - ((pred stringp) (split-string (org-trim tags) ":" t)) - (_ (error "Invalid tag specification: %S" tags)))) - (old-tags (org-get-tags nil t)) - (tags-change? nil)) - (when (functionp org-tags-sort-function) - (setq tags (sort tags org-tags-sort-function))) - (setq tags-change? (not (equal tags old-tags))) - (when tags-change? - ;; Delete previous tags and any trailing white space. - (goto-char (if (org-match-line org-tag-line-re) (match-beginning 1) - (line-end-position))) - (skip-chars-backward " \t") - (delete-region (point) (line-end-position)) - ;; Deleting white spaces may break an otherwise empty headline. - ;; Re-introduce one space in this case. - (unless (org-at-heading-p) (insert " ")) - (when tags - (save-excursion (insert " " (org-make-tag-string tags))) - ;; When text is being inserted on an invisible region - ;; boundary, it can be inadvertently sucked into - ;; invisibility. - (unless (org-invisible-p (line-beginning-position)) - (org-flag-region (point) (line-end-position) nil 'outline)))) - ;; Align tags, if any. - (when tags (org-align-tags)) - (when tags-change? (run-hooks 'org-after-tags-change-hook))))) + (org-fold-core-ignore-modifications + (let ((tags (pcase tags + ((pred listp) tags) + ((pred stringp) (split-string (org-trim tags) ":" t)) + (_ (error "Invalid tag specification: %S" tags)))) + (old-tags (org-get-tags nil t)) + (tags-change? nil)) + (when (functionp org-tags-sort-function) + (setq tags (sort tags org-tags-sort-function))) + (setq tags-change? (not (equal tags old-tags))) + (when tags-change? + ;; Delete previous tags and any trailing white space. + (goto-char (if (org-match-line org-tag-line-re) (match-beginning 1) + (line-end-position))) + (skip-chars-backward " \t") + (delete-region (point) (line-end-position)) + ;; Deleting white spaces may break an otherwise empty headline. + ;; Re-introduce one space in this case. + (unless (org-at-heading-p) (insert " ")) + (when tags + (save-excursion (insert-and-inherit " " (org-make-tag-string tags))) + ;; When text is being inserted on an invisible region + ;; boundary, it can be inadvertently sucked into + ;; invisibility. + (unless (org-invisible-p (line-beginning-position)) + (org-fold-region (point) (line-end-position) nil 'outline)))) + ;; Align tags, if any. + (when tags (org-align-tags)) + (when tags-change? (run-hooks 'org-after-tags-change-hook)))))) (defun org-change-tag-in-region (beg end tag off) "Add or remove TAG for each entry in the region. @@ -12537,19 +12556,20 @@ (defun org-entry-put (pom property value) ((member property org-special-properties) (error "The %s property cannot be set with `org-entry-put'" property)) (t - (let* ((range (org-get-property-block beg 'force)) - (end (cdr range)) - (case-fold-search t)) - (goto-char (car range)) - (if (re-search-forward (org-re-property property nil t) end t) - (progn (delete-region (match-beginning 0) (match-end 0)) - (goto-char (match-beginning 0))) - (goto-char end) - (insert "\n") - (backward-char)) - (insert ":" property ":") - (when value (insert " " value)) - (org-indent-line))))) + (org-fold-core-ignore-modifications + (let* ((range (org-get-property-block beg 'force)) + (end (cdr range)) + (case-fold-search t)) + (goto-char (car range)) + (if (re-search-forward (org-re-property property nil t) end t) + (progn (delete-region (match-beginning 0) (match-end 0)) + (goto-char (match-beginning 0))) + (goto-char end) + (insert-and-inherit "\n") + (backward-char)) + (insert-and-inherit ":" property ":") + (when value (insert-and-inherit " " value)) + (org-indent-line)))))) (run-hook-with-args 'org-property-changed-functions property value)))) (defun org-buffer-property-keys (&optional specials defaults columns) @@ -13704,23 +13724,24 @@ (defun org-insert-time-stamp (time &optional with-hm inactive pre post extra) PRE and POST are optional strings to be inserted before and after the stamp. The command returns the inserted time stamp." - (let ((fmt (funcall (if with-hm 'cdr 'car) org-time-stamp-formats)) - stamp) - (when inactive (setq fmt (concat "[" (substring fmt 1 -1) "]"))) - (insert-before-markers (or pre "")) - (when (listp extra) - (setq extra (car extra)) - (if (and (stringp extra) - (string-match "\\([0-9]+\\):\\([0-9]+\\)" extra)) - (setq extra (format "-%02d:%02d" - (string-to-number (match-string 1 extra)) - (string-to-number (match-string 2 extra)))) - (setq extra nil))) - (when extra - (setq fmt (concat (substring fmt 0 -1) extra (substring fmt -1)))) - (insert-before-markers (setq stamp (format-time-string fmt time))) - (insert-before-markers (or post "")) - (setq org-last-inserted-timestamp stamp))) + (org-fold-core-ignore-modifications + (let ((fmt (funcall (if with-hm 'cdr 'car) org-time-stamp-formats)) + stamp) + (when inactive (setq fmt (concat "[" (substring fmt 1 -1) "]"))) + (insert-before-markers-and-inherit (or pre "")) + (when (listp extra) + (setq extra (car extra)) + (if (and (stringp extra) + (string-match "\\([0-9]+\\):\\([0-9]+\\)" extra)) + (setq extra (format "-%02d:%02d" + (string-to-number (match-string 1 extra)) + (string-to-number (match-string 2 extra)))) + (setq extra nil))) + (when extra + (setq fmt (concat (substring fmt 0 -1) extra (substring fmt -1)))) + (insert-before-markers-and-inherit (setq stamp (format-time-string fmt time))) + (insert-before-markers-and-inherit (or post "")) + (setq org-last-inserted-timestamp stamp)))) (defun org-toggle-time-stamp-overlays () "Toggle the use of custom time stamp formats." @@ -18328,7 +18349,10 @@ (defun org--align-node-property () (let ((newtext (concat (match-string 4) (org-trim (format org-property-format (match-string 1) (match-string 3)))))) - (setf (buffer-substring (match-beginning 0) (match-end 0)) newtext))))) + ;; Do not use `replace-match' here as we want to inherit folding + ;; properties if inside fold. + (setf (buffer-substring (match-beginning 0) (match-end 0)) "") + (insert-and-inherit newtext))))) (defun org-indent-line () "Indent line depending on context. diff --git a/lisp/ox.el b/lisp/ox.el index 831b3bf12..9cf396c0e 100644 --- a/lisp/ox.el +++ b/lisp/ox.el @@ -2588,7 +2588,9 @@ (defun org-export--generate-copy-script (buffer) (or (memq var '(default-directory buffer-file-name - buffer-file-coding-system)) + buffer-file-coding-system + ;; Needed to preserve folding state + char-property-alias-alist)) (assq var bound-variables) (string-match "^\\(org-\\|orgtbl-\\)" (symbol-name var))) diff --git a/testing/lisp/test-ob.el b/testing/lisp/test-ob.el index 579d4df02..aa05f87a3 100644 --- a/testing/lisp/test-ob.el +++ b/testing/lisp/test-ob.el @@ -1557,8 +1557,8 @@ (ert-deftest test-ob/preserve-results-indentation () (org-test-with-temp-text " #+begin_src emacs-lisp\n(+ 1 1)\n #+end_src" (org-babel-execute-src-block) (let ((case-fold-search t)) (search-forward "RESULTS")) - (list (org-get-indentation) - (progn (forward-line) (org-get-indentation)))))) + (list (current-indentation) + (progn (forward-line) (current-indentation)))))) (should (equal '(2 2) @@ -1566,8 +1566,8 @@ (ert-deftest test-ob/preserve-results-indentation () " #+name: block\n #+begin_src emacs-lisp\n(+ 1 1)\n #+end_src" (org-babel-execute-src-block) (let ((case-fold-search t)) (search-forward "RESULTS")) - (list (org-get-indentation) - (progn (forward-line) (org-get-indentation)))))) + (list (current-indentation) + (progn (forward-line) (current-indentation)))))) ;; Don't get fooled by TAB-based indentation. (should (equal @@ -1577,8 +1577,8 @@ (ert-deftest test-ob/preserve-results-indentation () (setq tab-width 4) (org-babel-execute-src-block) (let ((case-fold-search t)) (search-forward "RESULTS")) - (list (org-get-indentation) - (progn (forward-line) (org-get-indentation)))))) + (list (current-indentation) + (progn (forward-line) (current-indentation)))))) ;; Properly indent examplified blocks. (should (equal diff --git a/testing/lisp/test-org.el b/testing/lisp/test-org.el index 273441e0f..364d783ee 100644 --- a/testing/lisp/test-org.el +++ b/testing/lisp/test-org.el @@ -1522,6 +1522,7 @@ (ert-deftest test-org/meta-return () (should (org-test-with-temp-text ":MYDRAWER:\n- a\n:END:" (forward-line) + (org-fold-reveal) (org-meta-return) (beginning-of-line) (looking-at "- $")))) @@ -2943,6 +2944,7 @@ (ert-deftest test-org/custom-properties () (let ((org-custom-properties '("FOO" "BAR"))) (org-test-with-temp-text "* H\n:PROPERTIES:\n<point>:FOO: val\n:P: 1\n:BAR: baz\n:END:\n" + (org-fold-reveal) (org-toggle-custom-properties-visibility) (and (org-invisible-p2) (not (progn (forward-line) (org-invisible-p2))) @@ -2963,6 +2965,7 @@ (ert-deftest test-org/custom-properties () (let ((org-custom-properties '("A"))) (org-test-with-temp-text "* H\n:PROPERTIES:\n:A: 1\n:END:\n\n:PROPERTIES:\n<point>:A: 2\n:END:" + (org-fold-reveal) (org-toggle-custom-properties-visibility) (org-invisible-p2))))) ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH 14/35] Support extra org-fold optimisations for huge buffers 2022-01-29 11:37 ` [PATCH 00/35] Merge org-fold feature branch Ihor Radchenko ` (12 preceding siblings ...) 2022-01-29 11:38 ` [PATCH 13/35] Fix subtle differences between overlays and invisible text properties Ihor Radchenko @ 2022-01-29 11:38 ` Ihor Radchenko 2022-01-29 11:38 ` [PATCH 15/35] Alias new org-fold functions to their old shorter names Ihor Radchenko ` (21 subsequent siblings) 35 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-01-29 11:38 UTC (permalink / raw) To: Bastien, Kyle Meyer, Nicolas Goaziou, Karl Voit, Christian Heinrich, emacs-orgmode Cc: Ihor Radchenko [-- Attachment #1: Type: text/plain, Size: 100 bytes --] --- lisp/org.el | 26 ++++++++++++++++++-------- 1 file changed, 18 insertions(+), 8 deletions(-) [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0014-Support-extra-org-fold-optimisations-for-huge-buffer.patch --] [-- Type: text/x-patch; name="0014-Support-extra-org-fold-optimisations-for-huge-buffer.patch", Size: 2779 bytes --] diff --git a/lisp/org.el b/lisp/org.el index a59d550ca..22fce184e 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -5787,6 +5787,7 @@ (defun org-unfontify-region (beg end &optional _maybe_loudly) '(mouse-face t keymap t org-linked-text t invisible t intangible t org-emphasis t)) + (org-fold-core-update-optimisation beg end) (org-remove-font-lock-display-properties beg end))) (defconst org-script-display '(((raise -0.3) (height 0.7)) @@ -6157,7 +6158,11 @@ (defun org-get-heading (&optional no-tags no-todo no-priority no-comment) (org-back-to-heading t) (let ((case-fold-search nil)) (looking-at org-complex-heading-regexp) - (let ((todo (and (not no-todo) (match-string 2))) + ;; When using `org-fold-core--optimise-for-huge-buffers', + ;; returned text may be invisible. Clear it up. + (save-match-data + (org-fold-core-remove-optimisation (match-beginning 0) (match-end 0))) + (let ((todo (and (not no-todo) (match-string 2))) (priority (and (not no-priority) (match-string 3))) (headline (pcase (match-string 4) (`nil "") @@ -6168,6 +6173,8 @@ (defun org-get-heading (&optional no-tags no-todo no-priority no-comment) "" h)) (h h))) (tags (and (not no-tags) (match-string 5)))) + ;; Restore cleared optimisation. + (org-fold-core-update-optimisation (match-beginning 0) (match-end 0)) (mapconcat #'identity (delq nil (list todo priority headline tags)) " ")))))) @@ -6184,18 +6191,21 @@ (defun org-heading-components () (save-excursion (org-back-to-heading t) (when (let (case-fold-search) (looking-at org-complex-heading-regexp)) - (list (length (match-string 1)) - (org-reduced-level (length (match-string 1))) - (match-string-no-properties 2) - (and (match-end 3) (aref (match-string 3) 2)) - (match-string-no-properties 4) - (match-string-no-properties 5))))) + (org-fold-core-remove-optimisation (match-beginning 0) (match-end 0)) + (prog1 + (list (length (match-string 1)) + (org-reduced-level (length (match-string 1))) + (match-string-no-properties 2) + (and (match-end 3) (aref (match-string 3) 2)) + (match-string-no-properties 4) + (match-string-no-properties 5)) + (org-fold-core-update-optimisation (match-beginning 0) (match-end 0)))))) (defun org-get-entry () "Get the entry text, after heading, entire subtree." (save-excursion (org-back-to-heading t) - (buffer-substring (point-at-bol 2) (org-end-of-subtree t)))) + (filter-buffer-substring (point-at-bol 2) (org-end-of-subtree t)))) (defun org-edit-headline (&optional heading) "Edit the current headline. ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH 15/35] Alias new org-fold functions to their old shorter names 2022-01-29 11:37 ` [PATCH 00/35] Merge org-fold feature branch Ihor Radchenko ` (13 preceding siblings ...) 2022-01-29 11:38 ` [PATCH 14/35] Support extra org-fold optimisations for huge buffers Ihor Radchenko @ 2022-01-29 11:38 ` Ihor Radchenko 2022-01-29 11:38 ` [PATCH 16/35] Obsolete old function names that are now in org-fold Ihor Radchenko ` (20 subsequent siblings) 35 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-01-29 11:38 UTC (permalink / raw) To: Bastien, Kyle Meyer, Nicolas Goaziou, Karl Voit, Christian Heinrich, emacs-orgmode Cc: Ihor Radchenko [-- Attachment #1: Type: text/plain, Size: 64 bytes --] --- lisp/org.el | 8 ++++++++ 1 file changed, 8 insertions(+) [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0015-Alias-new-org-fold-functions-to-their-old-shorter-na.patch --] [-- Type: text/x-patch; name="0015-Alias-new-org-fold-functions-to-their-old-shorter-na.patch", Size: 762 bytes --] diff --git a/lisp/org.el b/lisp/org.el index 22fce184e..cbdbf32f1 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -99,6 +99,14 @@ (require 'org-table) (require 'org-fold) (require 'org-cycle) +(defvaralias 'org-hide-block-startup 'org-cycle-hide-block-startup) +(defvaralias 'org-pre-cycle-hook 'org-cycle-pre-hook) +(defvaralias 'org-tab-first-hook 'org-cycle-tab-first-hook) +(defalias 'org-global-cycle #'org-cycle-global) +(defalias 'org-overview #'org-cycle-overview) +(defalias 'org-content #'org-cycle-content) +(defalias 'org-reveal #'org-fold-reveal) +(defalias 'org-force-cycle-archived #'org-cycle-force-archived) ;; `org-outline-regexp' ought to be a defconst but is let-bound in ;; some places -- e.g. see the macro `org-with-limited-levels'. ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH 16/35] Obsolete old function names that are now in org-fold 2022-01-29 11:37 ` [PATCH 00/35] Merge org-fold feature branch Ihor Radchenko ` (14 preceding siblings ...) 2022-01-29 11:38 ` [PATCH 15/35] Alias new org-fold functions to their old shorter names Ihor Radchenko @ 2022-01-29 11:38 ` Ihor Radchenko 2022-01-29 11:38 ` [PATCH 17/35] org-compat: Work around some third-party packages using outline-* functions Ihor Radchenko ` (19 subsequent siblings) 35 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-01-29 11:38 UTC (permalink / raw) To: Bastien, Kyle Meyer, Nicolas Goaziou, Karl Voit, Christian Heinrich, emacs-orgmode Cc: Ihor Radchenko [-- Attachment #1: Type: text/plain, Size: 111 bytes --] --- lisp/org-compat.el | 88 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 88 insertions(+) [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0016-Obsolete-old-function-names-that-are-now-in-org-fold.patch --] [-- Type: text/x-patch; name="0016-Obsolete-old-function-names-that-are-now-in-org-fold.patch", Size: 4206 bytes --] diff --git a/lisp/org-compat.el b/lisp/org-compat.el index 772ef37f9..14afb4600 100644 --- a/lisp/org-compat.el +++ b/lisp/org-compat.el @@ -238,6 +238,11 @@ (define-obsolete-function-alias 'org-propertize 'propertize "9.0") (define-obsolete-function-alias 'org-select-frame-set-input-focus 'select-frame-set-input-focus "9.0") (define-obsolete-function-alias 'org-file-remote-p 'file-remote-p "9.2") +(define-obsolete-function-alias 'org-show-context 'org-fold-show-context "9.6") +(define-obsolete-function-alias 'org-show-entry 'org-fold-show-entry "9.6") +(define-obsolete-function-alias 'org-show-children 'org-fold-show-children "9.6") + + (defmacro org-re (s) "Replace posix classes in regular expression S." (declare (debug (form)) @@ -347,6 +352,80 @@ (define-obsolete-function-alias 'org-toggle-latex-fragment 'org-latex-preview (define-obsolete-function-alias 'org-remove-latex-fragment-image-overlays 'org-clear-latex-preview "9.3") +(define-obsolete-function-alias 'org-hide-archived-subtrees + 'org-fold-hide-archived-subtrees "9.6") + +(define-obsolete-function-alias 'org-flag-region + 'org-fold-region "9.6") + +(define-obsolete-function-alias 'org-flag-subtree + 'org-fold-subtree "9.6") + +(define-obsolete-function-alias 'org-hide-entry + 'org-fold-hide-entry "9.6") + +(define-obsolete-function-alias 'org-show-subtree + 'org-fold-show-subtree "9.6") + +(define-obsolete-function-alias 'org--hide-wrapper-toggle + 'org-fold--hide-wrapper-toggle "9.6") + +(define-obsolete-function-alias 'org-hide-block-toggle + 'org-fold-hide-block-toggle "9.6") + +(define-obsolete-function-alias 'org-hide-drawer-toggle + 'org-fold-hide-drawer-toggle "9.6") + +(define-obsolete-function-alias 'org--hide-drawers + 'org-fold--hide-drawers "9.6") + +(define-obsolete-function-alias 'org-hide-block-all + 'org-fold-hide-block-all "9.6") + +(define-obsolete-function-alias 'org-hide-drawer-all + 'org-fold-hide-drawer-all "9.6") + +(define-obsolete-function-alias 'org-show-all + 'org-fold-show-all "9.6") + +(define-obsolete-function-alias 'org-set-startup-visibility + 'org-cycle-set-startup-visibility "9.6") + +(define-obsolete-function-alias 'org-show-set-visibility + 'org-fold-show-set-visibility "9.6") + +(define-obsolete-function-alias 'org-check-before-invisible-edit + 'org-fold-check-before-invisible-edit "9.6") + +(define-obsolete-function-alias 'org-flag-above-first-heading + 'org-fold-flag-above-first-heading "9.6") + +(define-obsolete-function-alias 'org-show-branches-buffer + 'org-fold-show-branches-buffer "9.6") + +(define-obsolete-function-alias 'org-show-siblings + 'org-fold-show-siblings "9.6") + +(define-obsolete-function-alias 'org-show-hidden-entry + 'org-fold-show-hidden-entry "9.6") + +(define-obsolete-function-alias 'org-flag-heading + 'org-fold-heading "9.6") + +(define-obsolete-function-alias 'org-set-startup-visibility + 'org-cycle-set-startup-visibility "9.6") + +(define-obsolete-function-alias 'org-set-visibility-according-to-property + 'org-cycle-set-visibility-according-to-property "9.6") + +(define-obsolete-variable-alias 'org-scroll-position-to-restore + 'org-cycle-scroll-position-to-restore "9.6") +(define-obsolete-function-alias 'org-optimize-window-after-visibility-change + 'org-cycle-optimize-window-after-visibility-change "9.6") + +(define-obsolete-function-alias 'org-force-cycle-archived + 'org-cycle-force-archived "9.6") + (define-obsolete-variable-alias 'org-attach-directory 'org-attach-id-dir "9.3") (make-obsolete 'org-attach-store-link "No longer used" "9.4") @@ -354,6 +433,15 @@ (make-obsolete 'org-attach-expand-link "No longer used" "9.4") (define-obsolete-function-alias 'org-file-url-p 'org-url-p "9.5") +(define-obsolete-variable-alias 'org-show-context-detail + 'org-fold-show-context-detail "9.6") + +(define-obsolete-variable-alias 'org-catch-invisible-edits + 'org-fold-catch-invisible-edits "9.6") + +(define-obsolete-variable-alias 'org-reveal-start-hook + 'org-fold-reveal-start-hook "9.6") +(define-obsolete-function-alias 'org-file-url-p 'org-url-p "9.6") (defun org-in-fixed-width-region-p () "Non-nil if point in a fixed-width region." (save-match-data ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH 17/35] org-compat: Work around some third-party packages using outline-* functions 2022-01-29 11:37 ` [PATCH 00/35] Merge org-fold feature branch Ihor Radchenko ` (15 preceding siblings ...) 2022-01-29 11:38 ` [PATCH 16/35] Obsolete old function names that are now in org-fold Ihor Radchenko @ 2022-01-29 11:38 ` Ihor Radchenko 2022-01-29 11:38 ` [PATCH 18/35] Move `org-buffer-list' to org-macs.el Ihor Radchenko ` (18 subsequent siblings) 35 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-01-29 11:38 UTC (permalink / raw) To: Bastien, Kyle Meyer, Nicolas Goaziou, Karl Voit, Christian Heinrich, emacs-orgmode Cc: Ihor Radchenko [-- Attachment #1: Type: text/plain, Size: 126 bytes --] --- lisp/org-compat.el | 72 +++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 71 insertions(+), 1 deletion(-) [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0017-org-compat-Work-around-some-third-party-packages-usi.patch --] [-- Type: text/x-patch; name="0017-org-compat-Work-around-some-third-party-packages-usi.patch", Size: 3384 bytes --] diff --git a/lisp/org-compat.el b/lisp/org-compat.el index 14afb4600..05efeca11 100644 --- a/lisp/org-compat.el +++ b/lisp/org-compat.el @@ -1311,11 +1311,81 @@ (defvar session-globals-exclude) (eval-after-load 'session '(add-to-list 'session-globals-exclude 'org-mark-ring)) +;;;; outline-mode + +;; Folding in outline-mode is not compatible with org-mode folding +;; anymore. Working around to avoid breakage of external packages +;; assuming the compatibility. +(defadvice outline-flag-region (around outline-flag-region@fix-for-org-fold (from to flag) activate) + "Run `org-fold-region' when in org-mode." + (if (eq major-mode 'org-mode) + (setq ad-return-value (org-fold-region (max from (point-min)) (min to (point-max)) flag 'headline)) + ad-do-it)) + +(defadvice outline-next-visible-heading (around outline-next-visible-heading@fix-for-org-fold (arg) activate) + "Run `org-next-visible-heading' when in org-mode." + (interactive "p") + (if (eq major-mode 'org-mode) + (setq ad-return-value (org-next-visible-heading arg)) + ad-do-it)) + +(defadvice outline-back-to-heading (around outline-back-to-heading@fix-for-org-fold (&optional invisible-ok) activate) + "Run `org-back-to-heading' when in org-mode." + (if (eq major-mode 'org-mode) + (setq ad-return-value + (progn + (beginning-of-line) + (or (org-at-heading-p (not invisible-ok)) + (let (found) + (save-excursion + (while (not found) + (or (re-search-backward (concat "^\\(?:" outline-regexp "\\)") + nil t) + (signal 'outline-before-first-heading nil)) + (setq found (and (or invisible-ok (not (org-fold-folded-p))) + (point))))) + (goto-char found) + found)))) + ad-do-it)) + +(defadvice outline-on-heading-p (around outline-on-heading-p@fix-for-org-fold (&optional invisible-ok) activate) + "Run `org-at-heading-p' when in org-mode." + (if (eq major-mode 'org-mode) + (setq ad-return-value (org-at-heading-p (not invisible-ok))) + ad-do-it)) + +(defadvice outline-hide-sublevels (around outline-hide-sublevels@fix-for-org-fold (levels) activate) + "Run `org-fold-hide-sublevels' when in org-mode." + (interactive (list + (cond + (current-prefix-arg (prefix-numeric-value current-prefix-arg)) + ((save-excursion (beginning-of-line) + (looking-at outline-regexp)) + (funcall outline-level)) + (t 1)))) + (if (eq major-mode 'org-mode) + (setq ad-return-value (org-fold-hide-sublevels levels)) + ad-do-it)) + +(defadvice outline-toggle-children (around outline-toggle-children@fix-for-org-fold () activate) + "Run `org-fold-hide-sublevels' when in org-mode." + (interactive) + (if (eq major-mode 'org-mode) + (setq ad-return-value + (save-excursion + (org-back-to-heading) + (if (not (org-fold-folded-p (line-end-position))) + (org-fold-hide-subtree) + (org-fold-show-children) + (org-fold-show-entry)))) + ad-do-it)) + +;; TODO: outline-headers-as-kill + ;;;; Speed commands (make-obsolete-variable 'org-speed-commands-user "configure `org-speed-commands' instead." "9.5") - (provide 'org-compat) ;; Local variables: ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH 18/35] Move `org-buffer-list' to org-macs.el 2022-01-29 11:37 ` [PATCH 00/35] Merge org-fold feature branch Ihor Radchenko ` (16 preceding siblings ...) 2022-01-29 11:38 ` [PATCH 17/35] org-compat: Work around some third-party packages using outline-* functions Ihor Radchenko @ 2022-01-29 11:38 ` Ihor Radchenko 2022-01-29 11:38 ` [PATCH 19/35] Restore old visibility behaviour of org-refile Ihor Radchenko ` (17 subsequent siblings) 35 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-01-29 11:38 UTC (permalink / raw) To: Bastien, Kyle Meyer, Nicolas Goaziou, Karl Voit, Christian Heinrich, emacs-orgmode Cc: Ihor Radchenko [-- Attachment #1: Type: text/plain, Size: 181 bytes --] --- lisp/org-macs.el | 38 ++++++++++++++++++++++++++++++++++++++ lisp/org.el | 38 -------------------------------------- 2 files changed, 38 insertions(+), 38 deletions(-) [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0018-Move-org-buffer-list-to-org-macs.el.patch --] [-- Type: text/x-patch; name="0018-Move-org-buffer-list-to-org-macs.el.patch", Size: 3287 bytes --] diff --git a/lisp/org-macs.el b/lisp/org-macs.el index 5494acb3e..0ccf080a3 100644 --- a/lisp/org-macs.el +++ b/lisp/org-macs.el @@ -217,6 +217,44 @@ (defun org-fit-window-to-buffer (&optional window max-height min-height (shrink-window-if-larger-than-buffer window))) (or window (selected-window))) +(defun org-buffer-list (&optional predicate exclude-tmp) + "Return a list of Org buffers. +PREDICATE can be `export', `files' or `agenda'. + +export restrict the list to Export buffers. +files restrict the list to buffers visiting Org files. +agenda restrict the list to buffers visiting agenda files. + +If EXCLUDE-TMP is non-nil, ignore temporary buffers." + (let* ((bfn nil) + (agenda-files (and (eq predicate 'agenda) + (mapcar 'file-truename (org-agenda-files t)))) + (filter + (cond + ((eq predicate 'files) + (lambda (b) (with-current-buffer b (derived-mode-p 'org-mode)))) + ((eq predicate 'export) + (lambda (b) (string-match "\\*Org .*Export" (buffer-name b)))) + ((eq predicate 'agenda) + (lambda (b) + (with-current-buffer b + (and (derived-mode-p 'org-mode) + (setq bfn (buffer-file-name b)) + (member (file-truename bfn) agenda-files))))) + (t (lambda (b) (with-current-buffer b + (or (derived-mode-p 'org-mode) + (string-match "\\*Org .*Export" + (buffer-name b))))))))) + (delq nil + (mapcar + (lambda(b) + (if (and (funcall filter b) + (or (not exclude-tmp) + (not (string-match "tmp" (buffer-name b))))) + b + nil)) + (buffer-list))))) + \f ;;; File diff --git a/lisp/org.el b/lisp/org.el index cbdbf32f1..a9a7b4621 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -14736,44 +14736,6 @@ (defun org-switchb (&optional arg) (mapcar #'list (mapcar #'buffer-name blist)) nil t)))) -(defun org-buffer-list (&optional predicate exclude-tmp) - "Return a list of Org buffers. -PREDICATE can be `export', `files' or `agenda'. - -export restrict the list to Export buffers. -files restrict the list to buffers visiting Org files. -agenda restrict the list to buffers visiting agenda files. - -If EXCLUDE-TMP is non-nil, ignore temporary buffers." - (let* ((bfn nil) - (agenda-files (and (eq predicate 'agenda) - (mapcar 'file-truename (org-agenda-files t)))) - (filter - (cond - ((eq predicate 'files) - (lambda (b) (with-current-buffer b (derived-mode-p 'org-mode)))) - ((eq predicate 'export) - (lambda (b) (string-match "\\*Org .*Export" (buffer-name b)))) - ((eq predicate 'agenda) - (lambda (b) - (with-current-buffer b - (and (derived-mode-p 'org-mode) - (setq bfn (buffer-file-name b)) - (member (file-truename bfn) agenda-files))))) - (t (lambda (b) (with-current-buffer b - (or (derived-mode-p 'org-mode) - (string-match "\\*Org .*Export" - (buffer-name b))))))))) - (delq nil - (mapcar - (lambda(b) - (if (and (funcall filter b) - (or (not exclude-tmp) - (not (string-match "tmp" (buffer-name b))))) - b - nil)) - (buffer-list))))) - (defun org-agenda-files (&optional unrestricted archives) "Get the list of agenda files. Optional UNRESTRICTED means return the full list even if a restriction ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH 19/35] Restore old visibility behaviour of org-refile 2022-01-29 11:37 ` [PATCH 00/35] Merge org-fold feature branch Ihor Radchenko ` (17 preceding siblings ...) 2022-01-29 11:38 ` [PATCH 18/35] Move `org-buffer-list' to org-macs.el Ihor Radchenko @ 2022-01-29 11:38 ` Ihor Radchenko 2022-01-29 11:38 ` [PATCH 20/35] Add org-fold-related tests Ihor Radchenko ` (16 subsequent siblings) 35 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-01-29 11:38 UTC (permalink / raw) To: Bastien, Kyle Meyer, Nicolas Goaziou, Karl Voit, Christian Heinrich, emacs-orgmode Cc: Ihor Radchenko [-- Attachment #1: Type: text/plain, Size: 63 bytes --] --- lisp/org-refile.el | 1 + 1 file changed, 1 insertion(+) [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0019-Restore-old-visibility-behaviour-of-org-refile.patch --] [-- Type: text/x-patch; name="0019-Restore-old-visibility-behaviour-of-org-refile.patch", Size: 543 bytes --] diff --git a/lisp/org-refile.el b/lisp/org-refile.el index d68760623..df7f645ef 100644 --- a/lisp/org-refile.el +++ b/lisp/org-refile.el @@ -547,6 +547,7 @@ (defun org-refile (&optional arg default-buffer rfloc msg) (goto-char (point-min)) (or (outline-next-heading) (goto-char (point-max))))) (unless (bolp) (newline)) + (org-fold-reveal) (org-paste-subtree level nil nil t) ;; Record information, according to `org-log-refile'. ;; Do not prompt for a note when refiling multiple ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH 20/35] Add org-fold-related tests 2022-01-29 11:37 ` [PATCH 00/35] Merge org-fold feature branch Ihor Radchenko ` (18 preceding siblings ...) 2022-01-29 11:38 ` [PATCH 19/35] Restore old visibility behaviour of org-refile Ihor Radchenko @ 2022-01-29 11:38 ` Ihor Radchenko 2022-01-29 11:38 ` [PATCH 21/35] org-manual: Update to new org-fold function names Ihor Radchenko ` (15 subsequent siblings) 35 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-01-29 11:38 UTC (permalink / raw) To: Bastien, Kyle Meyer, Nicolas Goaziou, Karl Voit, Christian Heinrich, emacs-orgmode Cc: Ihor Radchenko [-- Attachment #1: Type: text/plain, Size: 225 bytes --] --- testing/lisp/test-ol.el | 24 +++++ testing/lisp/test-org-list.el | 73 ++++++++++---- testing/lisp/test-org.el | 177 +++++++++++++++++++++++++++++++--- 3 files changed, 238 insertions(+), 36 deletions(-) [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0020-Add-org-fold-related-tests.patch --] [-- Type: text/x-patch; name="0020-Add-org-fold-related-tests.patch", Size: 11728 bytes --] diff --git a/testing/lisp/test-ol.el b/testing/lisp/test-ol.el index ddcc570b3..343631623 100644 --- a/testing/lisp/test-ol.el +++ b/testing/lisp/test-ol.el @@ -50,6 +50,30 @@ (ert-deftest test-ol/encode-url-with-escaped-char () (org-link-encode "http://some.host.com/form?&id=blah%2Bblah25" '(?\s ?\[ ?\] ?%)))))) +(ert-deftest test-ol/org-toggle-link-display () + "Make sure that `org-toggle-link-display' is working. +See https://github.com/yantar92/org/issues/4." + (dolist (org-link-descriptive '(nil t)) + (org-test-with-temp-text "* Org link test +[[https://example.com][A link to a site]]" + (dotimes (_ 2) + (goto-char 1) + (re-search-forward "\\[") + (should-not (xor org-link-descriptive (org-invisible-p))) + (re-search-forward "example") + (should-not (xor org-link-descriptive (org-invisible-p))) + (re-search-forward "com") + (should-not (xor org-link-descriptive (org-invisible-p))) + (re-search-forward "]") + (should-not (xor org-link-descriptive (org-invisible-p))) + (re-search-forward "\\[") + (should-not (org-invisible-p)) + (re-search-forward "link") + (should-not (org-invisible-p)) + (re-search-forward "]") + (should-not (xor org-link-descriptive (org-invisible-p))) + (org-toggle-link-display))))) + \f ;;; Escape and Unescape Links diff --git a/testing/lisp/test-org-list.el b/testing/lisp/test-org-list.el index 24d96e58b..66ec97b49 100644 --- a/testing/lisp/test-org-list.el +++ b/testing/lisp/test-org-list.el @@ -580,22 +580,40 @@ (ert-deftest test-org-list/move-item-down () (let ((org-list-use-circular-motion t)) (org-move-item-down)) (buffer-string)))) ;; Preserve item visibility. + (should + (equal + (make-list 2 'org-fold-outline) + (let ((org-fold-core-style 'text-properties)) + (org-test-with-temp-text + "* Headline\n<point>- item 1\n body 1\n- item 2\n body 2" + (let ((org-cycle-include-plain-lists t)) + (org-cycle) + (search-forward "- item 2") + (org-cycle)) + (search-backward "- item 1") + (org-move-item-down) + (forward-line) + (list (org-fold-get-folding-spec) + (progn + (search-backward " body 2") + (org-fold-get-folding-spec))))))) (should (equal '(outline outline) - (org-test-with-temp-text - "* Headline\n<point>- item 1\n body 1\n- item 2\n body 2" - (let ((org-cycle-include-plain-lists t)) - (org-cycle) - (search-forward "- item 2") - (org-cycle)) - (search-backward "- item 1") - (org-move-item-down) - (forward-line) - (list (org-invisible-p2) - (progn - (search-backward " body 2") - (org-invisible-p2)))))) + (let ((org-fold-core-style 'overlays)) + (org-test-with-temp-text + "* Headline\n<point>- item 1\n body 1\n- item 2\n body 2" + (let ((org-cycle-include-plain-lists t)) + (org-cycle) + (search-forward "- item 2") + (org-cycle)) + (search-backward "- item 1") + (org-move-item-down) + (forward-line) + (list (org-invisible-p2) + (progn + (search-backward " body 2") + (org-invisible-p2))))))) ;; Preserve children visibility. (org-test-with-temp-text "* Headline - item 1 @@ -869,17 +887,30 @@ (ert-deftest test-org-list/insert-item () (org-insert-item) (buffer-string)))) ;; Preserve list visibility when inserting an item. + (should + (equal + `(org-fold-outline org-fold-outline) + (let ((org-fold-core-style 'text-properties)) + (org-test-with-temp-text "- A\n - B\n- C\n - D" + (let ((org-cycle-include-plain-lists t)) + (org-cycle) + (forward-line 2) + (org-cycle) + (org-insert-item) + (list (org-fold-get-folding-spec nil (line-beginning-position 0)) + (org-fold-get-folding-spec nil (line-end-position 2)))))))) (should (equal '(outline outline) - (org-test-with-temp-text "- A\n - B\n- C\n - D" - (let ((org-cycle-include-plain-lists t)) - (org-cycle) - (forward-line 2) - (org-cycle) - (org-insert-item) - (list (get-char-property (line-beginning-position 0) 'invisible) - (get-char-property (line-end-position 2) 'invisible)))))) + (let ((org-fold-core-style 'overlays)) + (org-test-with-temp-text "- A\n - B\n- C\n - D" + (let ((org-cycle-include-plain-lists t)) + (org-cycle) + (forward-line 2) + (org-cycle) + (org-insert-item) + (list (get-char-property (line-beginning-position 0) 'invisible) + (get-char-property (line-end-position 2) 'invisible))))))) ;; Test insertion in area after a sub-list. In particular, if point ;; is right at the end of the previous sub-list, still insert ;; a sub-item in that list. diff --git a/testing/lisp/test-org.el b/testing/lisp/test-org.el index 364d783ee..3a1f213c1 100644 --- a/testing/lisp/test-org.el +++ b/testing/lisp/test-org.el @@ -4462,7 +4462,9 @@ (ert-deftest test-org/drag-element-backward () ;; Preserve visibility of elements and their contents. (should (equal '((63 . 82) (26 . 48)) - (org-test-with-temp-text " + (let ((org-fold-core-style 'text-properties)) + (org-test-with-temp-text + " #+BEGIN_CENTER Text. #+END_CENTER @@ -4470,11 +4472,35 @@ (ert-deftest test-org/drag-element-backward () #+BEGIN_QUOTE Text. #+END_QUOTE" - (while (search-forward "BEGIN_" nil t) (org-cycle)) - (search-backward "- item 1") - (org-drag-element-backward) - (mapcar (lambda (ov) (cons (overlay-start ov) (overlay-end ov))) - (overlays-in (point-min) (point-max)))))) + (while (search-forward "BEGIN_" nil t) (org-cycle)) + (search-backward "- item 1") + (org-drag-element-backward) + (let (regions) + (goto-char (point-min)) + (while (< (point) (point-max)) + (let ((region (org-fold-get-region-at-point))) + (if (not region) + (goto-char (org-fold-next-folding-state-change)) + (goto-char (cdr region)) + (push region regions)))) + regions))))) + (should + (equal '((63 . 82) (26 . 48)) + (let ((org-fold-core-style 'overlays)) + (org-test-with-temp-text + " +#+BEGIN_CENTER +Text. +#+END_CENTER +- item 1 + #+BEGIN_QUOTE + Text. + #+END_QUOTE" + (while (search-forward "BEGIN_" nil t) (org-cycle)) + (search-backward "- item 1") + (org-drag-element-backward) + (mapcar (lambda (ov) (cons (overlay-start ov) (overlay-end ov))) + (overlays-in (point-min) (point-max))))))) ;; Pathological case: handle call with point in blank lines right ;; after a headline. (should @@ -4511,7 +4537,9 @@ (ert-deftest test-org/drag-element-forward () (should (equal (buffer-string) "Para2\n\n\nParagraph 1\n\nPara3")) (should (looking-at " 1"))) ;; 5. Preserve visibility of elements and their contents. - (org-test-with-temp-text " + (let ((org-fold-core-style 'text-properties)) + (org-test-with-temp-text + " #+BEGIN_CENTER Text. #+END_CENTER @@ -4519,14 +4547,39 @@ (ert-deftest test-org/drag-element-forward () #+BEGIN_QUOTE Text. #+END_QUOTE" - (while (search-forward "BEGIN_" nil t) (org-cycle)) - (search-backward "#+BEGIN_CENTER") - (org-drag-element-forward) - (should - (equal - '((63 . 82) (26 . 48)) - (mapcar (lambda (ov) (cons (overlay-start ov) (overlay-end ov))) - (overlays-in (point-min) (point-max))))))) + (while (search-forward "BEGIN_" nil t) (org-cycle)) + (search-backward "#+BEGIN_CENTER") + (org-drag-element-forward) + (should + (equal + '((63 . 82) (26 . 48)) + (let (regions) + (goto-char (point-min)) + (while (< (point) (point-max)) + (let ((region (org-fold-get-region-at-point))) + (if (not region) + (goto-char (org-fold-next-folding-state-change)) + (goto-char (cdr region)) + (push region regions)))) + regions))))) + (let ((org-fold-core-style 'overlays)) + (org-test-with-temp-text + " +#+BEGIN_CENTER +Text. +#+END_CENTER +- item 1 + #+BEGIN_QUOTE + Text. + #+END_QUOTE" + (while (search-forward "BEGIN_" nil t) (org-cycle)) + (search-backward "#+BEGIN_CENTER") + (org-drag-element-forward) + (should + (equal + '((63 . 82) (26 . 48)) + (mapcar (lambda (ov) (cons (overlay-start ov) (overlay-end ov))) + (overlays-in (point-min) (point-max)))))))) (ert-deftest test-org/next-block () "Test `org-next-block' specifications." @@ -8396,6 +8449,100 @@ (ert-deftest test-org/visibility-show-branches () (org-kill-note-or-show-branches) (should (org-invisible-p (- (point-max) 2))))) +(ert-deftest test-org/org-cycle-narrowed-subtree () + "Test cycling in narrowed buffer." + (org-test-with-temp-text + "* Heading 1<point> +** Child 1.1 +** Child 1.2 +some text +*** Sub-child 1.2.1 +* Heading 2" + (org-overview) + (org-narrow-to-subtree) + (org-cycle) + (re-search-forward "Sub-child") + (should (org-invisible-p)))) + +(ert-deftest test-org/org-fold-reveal-broken-structure () + "Test unfolding broken elements." + (let ((org-fold-core-style 'text-properties)) + (org-test-with-temp-text + "<point>* Heading 1 +Text here" + (org-overview) + (re-search-forward "Text") + (should (org-invisible-p)) + (goto-char 1) + (delete-char 1) + (re-search-forward "Text") + (should-not (org-invisible-p))) + (org-test-with-temp-text + "* Heading 1 +<point>:PROPERTIES: +:ID: something +:END: +Text here" + (org-cycle) + (org-fold-hide-drawer-all) + (re-search-forward "ID") + (should (org-invisible-p)) + (re-search-backward ":PROPERTIES:") + (delete-char 1) + (re-search-forward "ID") + (should-not (org-invisible-p))) + (org-test-with-temp-text + "* Heading 1 +<point>:PROPERTIES: +:ID: something +:END: +Text here" + (org-cycle) + (org-fold-hide-drawer-all) + (re-search-forward "ID") + (should (org-invisible-p)) + (re-search-forward ":END:") + (delete-char -1) + (re-search-backward "ID") + (should-not (org-invisible-p))) + (org-test-with-temp-text + "* Heading 1 +<point>#+begin_src emacs-lisp +(+ 1 2) +#+end_src +Text here" + (org-cycle) + (org-fold-hide-drawer-all) + (re-search-forward "end") + (should (org-invisible-p)) + (delete-char -1) + (re-search-backward "2") + (should-not (org-invisible-p))))) + +(ert-deftest test-org/re-hide-edits-inside-fold () + "Test edits inside folded regions." + (org-test-with-temp-text + "<point>* Heading 1 +Text here" + (org-overview) + (org-set-property "TEST" "1") + (re-search-forward "TEST") + (should (org-invisible-p))) + (org-test-with-temp-text + "* Heading 1<point> +Text here" + (org-overview) + (insert " and extra heading text") + (re-search-backward "heading") + (should-not (org-invisible-p))) + (org-test-with-temp-text + "* Heading 1 +Text<point> here" + (org-overview) + (insert " and extra text") + (re-search-backward "extra") + (should (org-invisible-p)))) + \f ;;; Yank and Kill ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH 21/35] org-manual: Update to new org-fold function names 2022-01-29 11:37 ` [PATCH 00/35] Merge org-fold feature branch Ihor Radchenko ` (19 preceding siblings ...) 2022-01-29 11:38 ` [PATCH 20/35] Add org-fold-related tests Ihor Radchenko @ 2022-01-29 11:38 ` Ihor Radchenko 2022-01-29 11:38 ` [PATCH 22/35] ORG-NEWS: Add list of changes Ihor Radchenko ` (14 subsequent siblings) 35 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-01-29 11:38 UTC (permalink / raw) To: Bastien, Kyle Meyer, Nicolas Goaziou, Karl Voit, Christian Heinrich, emacs-orgmode Cc: Ihor Radchenko [-- Attachment #1: Type: text/plain, Size: 94 bytes --] --- doc/org-manual.org | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0021-org-manual-Update-to-new-org-fold-function-names.patch --] [-- Type: text/x-patch; name="0021-org-manual-Update-to-new-org-fold-function-names.patch", Size: 1774 bytes --] diff --git a/doc/org-manual.org b/doc/org-manual.org index 2c54fde87..ba63d3a4e 100644 --- a/doc/org-manual.org +++ b/doc/org-manual.org @@ -495,11 +495,11 @@ *** Global and local cycling Switch back to the startup visibility of the buffer (see [[*Initial visibility]]). -- {{{kbd(C-u C-u C-u TAB)}}} (~outline-show-all~) :: +- {{{kbd(C-u C-u C-u TAB)}}} (~org-show-all~) :: #+cindex: show all, command #+kindex: C-u C-u C-u TAB - #+findex: outline-show-all + #+findex: org-show-all Show all, including drawers. - {{{kbd(C-c C-r)}}} (~org-reveal~) :: @@ -515,18 +515,18 @@ *** Global and local cycling headings. With a double prefix argument, also show the entire subtree of the parent. -- {{{kbd(C-c C-k)}}} (~outline-show-branches~) :: +- {{{kbd(C-c C-k)}}} (~org-show-branches~) :: #+cindex: show branches, command #+kindex: C-c C-k - #+findex: outline-show-branches + #+findex: org-show-branches Expose all the headings of the subtree, but not their bodies. -- {{{kbd(C-c TAB)}}} (~outline-show-children~) :: +- {{{kbd(C-c TAB)}}} (~org-show-children~) :: #+cindex: show children, command #+kindex: C-c TAB - #+findex: outline-show-children + #+findex: org-show-children Expose all direct children of the subtree. With a numeric prefix argument {{{var(N)}}}, expose all children down to level {{{var(N)}}}. @@ -7369,7 +7369,7 @@ *** Internal archiving command (see [[*Visibility Cycling]]). You can force cycling archived subtrees with {{{kbd(C-TAB)}}}, or by setting the option ~org-cycle-open-archived-trees~. Also normal outline commands, like - ~outline-show-all~, open archived subtrees. + ~org-show-all~, open archived subtrees. - #+vindex: org-sparse-tree-open-archived-trees ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH 22/35] ORG-NEWS: Add list of changes 2022-01-29 11:37 ` [PATCH 00/35] Merge org-fold feature branch Ihor Radchenko ` (20 preceding siblings ...) 2022-01-29 11:38 ` [PATCH 21/35] org-manual: Update to new org-fold function names Ihor Radchenko @ 2022-01-29 11:38 ` Ihor Radchenko 2022-01-29 20:31 ` New folding backend & outline (was: [PATCH 22/35] ORG-NEWS: Add list of changes) Kévin Le Gouguec 2022-01-29 11:38 ` [PATCH 23/35] Backport contributed commits Ihor Radchenko ` (13 subsequent siblings) 35 siblings, 1 reply; 192+ messages in thread From: Ihor Radchenko @ 2022-01-29 11:38 UTC (permalink / raw) To: Bastien, Kyle Meyer, Nicolas Goaziou, Karl Voit, Christian Heinrich, emacs-orgmode Cc: Ihor Radchenko [-- Attachment #1: Type: text/plain, Size: 112 bytes --] --- etc/ORG-NEWS | 104 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 104 insertions(+) [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0022-ORG-NEWS-Add-list-of-changes.patch --] [-- Type: text/x-patch; name="0022-ORG-NEWS-Add-list-of-changes.patch", Size: 4444 bytes --] diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS index 5a94e737e..a60248589 100644 --- a/etc/ORG-NEWS +++ b/etc/ORG-NEWS @@ -40,6 +40,105 @@ The cache state is saved between Emacs sessions. Enabled by default. The cache persistence can be controlled via ~org-element-cache-persistent~. +*** Users experiencing performance issues can use new folding backend + +The old folding backend used in Org is poorly scalable when the file +size increases beyond few Mbs. The symptoms usually include slow +cursor motion, especially in long-running Emacs sessions. + +A new optimised folding backend is now available, and enabled by +default. To disable it, put the following to the Emacs config *before* +loading Org: + +#+begin_src emacs-lisp +(setq org-fold-core-style 'overlays) +#+end_src + +Even more performance optimisation can be enabled by customising +=org-fold-core--optimise-for-huge-buffers=. However, this option may +be dangerous. Please, read the variable docstring carefully to +understand the possible consequences. + +When =org-fold-core-style= is set to =text-properties=, several new +features will become available and several notable changes will happen +to the Org behaviour. The new features and changes are listed below. + +**** Hidden parts of the links can now be searched and revealed during isearch + +In the past, hidden parts of the links could not be searched using +isearch (=C-s=). Now, they are searchable by default. The hidden +match is also revealed temporarily during isearch. + +To restore the old behaviour add the following core to your Emacs +config: + +#+begin_src emacs-lisp +(defun org-hidden-link-ignore-isearch () + "Do not match hidden parts of links during isearch." + (org-fold-core-set-folding-spec-property 'org-link :isearch-open nil) + (org-fold-core-set-folding-spec-property 'org-link :isearch-ignore t)) +(add-hook 'org-mode-hook #'org-hidden-link-ignore-isearch) +#+end_src + +See docstring of =org-fold-core--specs= to see more details about +=:isearch-open= and =:isearch-ignore= properties. + +**** =org-catch-invisible-edits= now works for hidden parts of the links and for emphasis markers + +In the past, user could edit invisible parts of the links and emphasis markers. Now, the editing is respecting the value of =org-catch-invisible-edits=. + +Note that hidden parts of sub-/super-scripts are still not handled. + +**** Breaking structure of folded elements automatically reveals the folded text + +In the past, the user could be left with unfoldable text after breaking the org structure. + +For example, if + +#+begin_src org +:DRAWER: +like this +:END: +#+end_src + +is folded and then edited into + +#+begin_src org +DRAWER: +like this +:END: +#+end_src +The hidden text would not be revealed. + +Now, breaking structure of drawers, blocks, and headings automatically +reveals the folded text. + +**** Folding state of the drawers is now preserved when cycling headline visibility + +In the past drawers were folded every time a headline is unfolded. + +Now, it is not the case anymore. The drawer folding state is +preserved. The initial folding state of all the drawers in buffer is +set according to the startup visibility settings. + +To restore the old behaviour, add the following code to Emacs config: + +#+begin_src emacs-lisp +(add-hook 'org-cycle-hook #'org-cycle-hide-drawers) +#+end_src + +Note that old behaviour may cause performance issues when cycling +headline visibility in large buffers. + +**** =outline-*= functions may no longer work correctly in Org mode + +The new folding backend breaks some of the =outline-*= functions that +rely on the details of visibility state implementation in +=outline.el=. The old Org folding backend was compatible with the +=outline.el= folding, but it is not the case anymore with the new +backend. From now on, using =outline-*= functions is strongly +discouraged when working with Org files. + ** New features *** New library =org-persist.el= implements variable persistence across Emacs sessions @@ -98,6 +197,11 @@ argument. ~org-get-tags~ now accepts Org element or buffer position as first argument. +*** =org-at-heading-p= now recognises optional argument. Its meaning is inverted. + +=org-at-heading-p= now returns t by default on headings inside folds. +Passing optional argument will produce the old behaviour. + ** Miscellaneous *** Styles are customizable in ~biblatex~ citation processor ^ permalink raw reply related [flat|nested] 192+ messages in thread
* New folding backend & outline (was: [PATCH 22/35] ORG-NEWS: Add list of changes) 2022-01-29 11:38 ` [PATCH 22/35] ORG-NEWS: Add list of changes Ihor Radchenko @ 2022-01-29 20:31 ` Kévin Le Gouguec 2022-01-30 2:15 ` Ihor Radchenko 0 siblings, 1 reply; 192+ messages in thread From: Kévin Le Gouguec @ 2022-01-29 20:31 UTC (permalink / raw) To: Ihor Radchenko Cc: Karl Voit, Bastien, emacs-orgmode, Nicolas Goaziou, Christian Heinrich, Kyle Meyer Ihor Radchenko <yantar92@gmail.com> writes: > +**** =outline-*= functions may no longer work correctly in Org mode > + > +The new folding backend breaks some of the =outline-*= functions that > +rely on the details of visibility state implementation in > +=outline.el=. The old Org folding backend was compatible with the > +=outline.el= folding, but it is not the case anymore with the new > +backend. From now on, using =outline-*= functions is strongly > +discouraged when working with Org files. From the perspective of a heavy outline-minor-mode user, who dreams of Org "backporting" its great outlining features to outline.el, that's a bit disheartening, since IIUC this will cause Org and outline.el to drift further apart? I realize this question might sound outlandish, but I'll ask it anyway: would it be feasible (and relevant) to add this new folding backend to outline.el, so that (1) /both/ Org and outline(-minor)-mode benefit from it, (2) outline.el functions keep working in Org? (Assuming outline.el could be turned into a :core GNU ELPA package, and Org would tolerate adding this dependency) I hope this doesn't come across as negative criticism; the amount of work that went into this branch is astounding, and as an Org user I'm indebted to the developers for the energy that goes into maintaining it. I just wish more of the loving care that goes into Org trickled down to outline(-minor)-mode; the last couple of months were encouraging because lots of great improvements have been added to outline.el (TAB-cycling, buttons, control over default visibility and font-locking), and those improvements enhance *every* major mode with outline-minor-mode support, so I was hoping for the trend to continue… Lest I let this message end on that sour note: great work, and thanks for the energy you put into Org! ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: New folding backend & outline (was: [PATCH 22/35] ORG-NEWS: Add list of changes) 2022-01-29 20:31 ` New folding backend & outline (was: [PATCH 22/35] ORG-NEWS: Add list of changes) Kévin Le Gouguec @ 2022-01-30 2:15 ` Ihor Radchenko 0 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-01-30 2:15 UTC (permalink / raw) To: Kévin Le Gouguec Cc: Karl Voit, Bastien, emacs-orgmode, Nicolas Goaziou, Christian Heinrich, Kyle Meyer Kévin Le Gouguec <kevin.legouguec@gmail.com> writes: > From the perspective of a heavy outline-minor-mode user, who dreams of > Org "backporting" its great outlining features to outline.el, that's a > bit disheartening, since IIUC this will cause Org and outline.el to > drift further apart? We already had some subtle (yet important) deviations between Org mode and outline.el, which made using outline-* functions in Org buffers unreliable at times. This patch just makes the already existing trend more prominent. > I realize this question might sound outlandish, but I'll ask it anyway: > would it be feasible (and relevant) to add this new folding backend to > outline.el, so that (1) /both/ Org and outline(-minor)-mode benefit from > it, (2) outline.el functions keep working in Org? > > (Assuming outline.el could be turned into a :core GNU ELPA package, and > Org would tolerate adding this dependency) Sure. I kept this idea in mind when developing the branch. org-fold-core.el is written in such a way that it can be used by an arbitrary major or minor mode: ;; This file contains library to control temporary invisibility ;; (folding and unfolding) of text in buffers. ;; The file implements the following functionality: ;; ;; - Folding/unfolding regions of text ;; - Searching and examining boundaries of folded text ;; - Interactive searching in folded text (via isearch) ;; - Handling edits in folded text ;; - Killing/yanking (copying/pasting) of the folded text ;; - Fontification of the folded text If desired, outline.el can be rather trivially converted to use org-fold-core. > I hope this doesn't come across as negative criticism; the amount of > work that went into this branch is astounding, and as an Org user I'm > indebted to the developers for the energy that goes into maintaining it. > > Lest I let this message end on that sour note: great work, and thanks > for the energy you put into Org! Thanks! Best, Ihor ^ permalink raw reply [flat|nested] 192+ messages in thread
* [PATCH 23/35] Backport contributed commits 2022-01-29 11:37 ` [PATCH 00/35] Merge org-fold feature branch Ihor Radchenko ` (21 preceding siblings ...) 2022-01-29 11:38 ` [PATCH 22/35] ORG-NEWS: Add list of changes Ihor Radchenko @ 2022-01-29 11:38 ` Ihor Radchenko 2022-01-29 11:38 ` [PATCH 24/35] Fix typo: delete-duplicates → delete-dups Ihor Radchenko ` (12 subsequent siblings) 35 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-01-29 11:38 UTC (permalink / raw) To: Bastien, Kyle Meyer, Nicolas Goaziou, Karl Voit, Christian Heinrich, emacs-orgmode Cc: Ihor Radchenko [-- Attachment #1: Type: text/plain, Size: 181 bytes --] --- lisp/org-cycle.el | 2 +- lisp/org-fold-core.el | 2 +- lisp/org-keys.el | 4 ++-- lisp/org.el | 6 ++---- 4 files changed, 6 insertions(+), 8 deletions(-) [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0023-Backport-contributed-commits.patch --] [-- Type: text/x-patch; name="0023-Backport-contributed-commits.patch", Size: 4052 bytes --] diff --git a/lisp/org-cycle.el b/lisp/org-cycle.el index df0a3761a..d2fcc356c 100644 --- a/lisp/org-cycle.el +++ b/lisp/org-cycle.el @@ -811,7 +811,7 @@ (defun org-cycle-hide-archived-subtrees (state) (org-get-tags nil 'local))) (message "%s" (substitute-command-keys "Subtree is archived and stays closed. Use \ -`\\[org-cycle-force-archived]' to cycle it anyway.")))))) +`\\[org-force-cycle-archived]' to cycle it anyway.")))))) (provide 'org-cycle) diff --git a/lisp/org-fold-core.el b/lisp/org-fold-core.el index 121c6b5c4..6ea374498 100644 --- a/lisp/org-fold-core.el +++ b/lisp/org-fold-core.el @@ -592,7 +592,7 @@ (defun org-fold-core--property-symbol-get-create (spec &optional buffer return-o (org-fold-core-cycle-over-indirect-buffers (push (current-buffer) bufs)) (push buf bufs) - (delete-dups bufs))))) + (delete-duplicates bufs))))) ;; Copy all the old folding properties to preserve the folding state (with-silent-modifications (dolist (old-prop (cdr (assq 'invisible char-property-alias-alist))) diff --git a/lisp/org-keys.el b/lisp/org-keys.el index 782ffa871..e6b8ff459 100644 --- a/lisp/org-keys.el +++ b/lisp/org-keys.el @@ -94,7 +94,7 @@ (declare-function org-feed-update-all "org" ()) (declare-function org-fill-paragraph "org" (&optional justify region)) (declare-function org-find-file-at-mouse "org" (ev)) (declare-function org-footnote-action "org" (&optional special)) -(declare-function org-cycle-force-archived "org-cycle" ()) +(declare-function org-force-cycle-archived "org-cycle" ()) (declare-function org-force-self-insert "org" (n)) (declare-function org-forward-element "org" ()) (declare-function org-forward-heading-same-level "org" (arg &optional invisible-ok)) @@ -444,7 +444,7 @@ (org-defkey org-mode-map (kbd "C-c C-x") (make-sparse-keymap)) ;;;; TAB key with modifiers (org-defkey org-mode-map (kbd "TAB") #'org-cycle) -(org-defkey org-mode-map (kbd "C-c C-<tab>") #'org-cycle-force-archived) +(org-defkey org-mode-map (kbd "C-c C-<tab>") #'org-force-cycle-archived) ;; Override text-mode binding to expose `complete-symbol' for ;; pcomplete functionality. (org-defkey org-mode-map (kbd "M-TAB") nil) diff --git a/lisp/org.el b/lisp/org.el index a9a7b4621..1c01ecf88 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -106,7 +106,6 @@ (defalias 'org-global-cycle #'org-cycle-global) (defalias 'org-overview #'org-cycle-overview) (defalias 'org-content #'org-cycle-content) (defalias 'org-reveal #'org-fold-reveal) -(defalias 'org-force-cycle-archived #'org-cycle-force-archived) ;; `org-outline-regexp' ought to be a defconst but is let-bound in ;; some places -- e.g. see the macro `org-with-limited-levels'. @@ -6168,8 +6167,7 @@ (defun org-get-heading (&optional no-tags no-todo no-priority no-comment) (looking-at org-complex-heading-regexp) ;; When using `org-fold-core--optimise-for-huge-buffers', ;; returned text may be invisible. Clear it up. - (save-match-data - (org-fold-core-remove-optimisation (match-beginning 0) (match-end 0))) + (org-fold-core-remove-optimisation (match-beginning 0) (match-end 0)) (let ((todo (and (not no-todo) (match-string 2))) (priority (and (not no-priority) (match-string 3))) (headline (pcase (match-string 4) @@ -11697,7 +11695,7 @@ (defun org--get-local-tags () (let* ((cached (and (org-element--cache-active-p) (org-element-at-point nil 'cached))) (cached-tags (org-element-property :tags cached))) (if cached - ;; If we do explicitly copy the result, reference would + ;; If we do not explicitly copy the result, reference would ;; be returned and cache element might be modified directly. (mapcar #'copy-sequence cached-tags) ;; Parse tags manually. ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH 24/35] Fix typo: delete-duplicates → delete-dups 2022-01-29 11:37 ` [PATCH 00/35] Merge org-fold feature branch Ihor Radchenko ` (22 preceding siblings ...) 2022-01-29 11:38 ` [PATCH 23/35] Backport contributed commits Ihor Radchenko @ 2022-01-29 11:38 ` Ihor Radchenko 2022-01-29 11:38 ` [PATCH 25/35] Fix bug in org-get-heading Ihor Radchenko ` (11 subsequent siblings) 35 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-01-29 11:38 UTC (permalink / raw) To: Bastien, Kyle Meyer, Nicolas Goaziou, Karl Voit, Christian Heinrich, emacs-orgmode Cc: Anders Johansson [-- Attachment #1: Type: text/plain, Size: 44 bytes --] This is a multi-part message in MIME format. [-- Attachment #2: Type: text/plain, Size: 82 bytes --] --- lisp/org-fold-core.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #3: 0024-Fix-typo-delete-duplicates-delete-dups.patch --] [-- Type: text/x-patch; name="0024-Fix-typo-delete-duplicates-delete-dups.patch", Size: 788 bytes --] diff --git a/lisp/org-fold-core.el b/lisp/org-fold-core.el index 6ea374498..121c6b5c4 100644 --- a/lisp/org-fold-core.el +++ b/lisp/org-fold-core.el @@ -592,7 +592,7 @@ (defun org-fold-core--property-symbol-get-create (spec &optional buffer return-o (org-fold-core-cycle-over-indirect-buffers (push (current-buffer) bufs)) (push buf bufs) - (delete-duplicates bufs))))) + (delete-dups bufs))))) ;; Copy all the old folding properties to preserve the folding state (with-silent-modifications (dolist (old-prop (cdr (assq 'invisible char-property-alias-alist))) ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH 25/35] Fix bug in org-get-heading 2022-01-29 11:37 ` [PATCH 00/35] Merge org-fold feature branch Ihor Radchenko ` (23 preceding siblings ...) 2022-01-29 11:38 ` [PATCH 24/35] Fix typo: delete-duplicates → delete-dups Ihor Radchenko @ 2022-01-29 11:38 ` Ihor Radchenko 2022-01-29 11:38 ` [PATCH 26/35] Rename remaining org-force-cycle-archived → org-cycle-force-archived Ihor Radchenko ` (10 subsequent siblings) 35 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-01-29 11:38 UTC (permalink / raw) To: Bastien, Kyle Meyer, Nicolas Goaziou, Karl Voit, Christian Heinrich, emacs-orgmode Cc: Anders Johansson [-- Attachment #1: Type: text/plain, Size: 44 bytes --] This is a multi-part message in MIME format. [-- Attachment #2: Type: text/plain, Size: 176 bytes --] Fixes #26, where fontification could make the matching and extraction of heading components fail. --- lisp/org.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #3: 0025-Fix-bug-in-org-get-heading.patch --] [-- Type: text/x-patch; name="0025-Fix-bug-in-org-get-heading.patch", Size: 816 bytes --] diff --git a/lisp/org.el b/lisp/org.el index 1c01ecf88..dd6298104 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -6166,8 +6166,9 @@ (defun org-get-heading (&optional no-tags no-todo no-priority no-comment) (let ((case-fold-search nil)) (looking-at org-complex-heading-regexp) ;; When using `org-fold-core--optimise-for-huge-buffers', - ;; returned text may be invisible. Clear it up. - (org-fold-core-remove-optimisation (match-beginning 0) (match-end 0)) + ;; returned text will be invisible. Clear it up. + (save-match-data + (org-fold-core-remove-optimisation (match-beginning 0) (match-end 0))) (let ((todo (and (not no-todo) (match-string 2))) (priority (and (not no-priority) (match-string 3))) (headline (pcase (match-string 4) ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH 26/35] Rename remaining org-force-cycle-archived → org-cycle-force-archived 2022-01-29 11:37 ` [PATCH 00/35] Merge org-fold feature branch Ihor Radchenko ` (24 preceding siblings ...) 2022-01-29 11:38 ` [PATCH 25/35] Fix bug in org-get-heading Ihor Radchenko @ 2022-01-29 11:38 ` Ihor Radchenko 2022-01-29 11:38 ` [PATCH 27/35] Fix org-fold--hide-drawers--overlays Ihor Radchenko ` (9 subsequent siblings) 35 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-01-29 11:38 UTC (permalink / raw) To: Bastien, Kyle Meyer, Nicolas Goaziou, Karl Voit, Christian Heinrich, emacs-orgmode Cc: Anders Johansson [-- Attachment #1: Type: text/plain, Size: 44 bytes --] This is a multi-part message in MIME format. [-- Attachment #2: Type: text/plain, Size: 134 bytes --] --- lisp/org-cycle.el | 2 +- lisp/org-keys.el | 4 ++-- lisp/org.el | 1 + 3 files changed, 4 insertions(+), 3 deletions(-) [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #3: 0026-Rename-remaining-org-force-cycle-archived-org-cycle-.patch --] [-- Type: text/x-patch; name="0026-Rename-remaining-org-force-cycle-archived-org-cycle-.patch", Size: 2151 bytes --] diff --git a/lisp/org-cycle.el b/lisp/org-cycle.el index d2fcc356c..df0a3761a 100644 --- a/lisp/org-cycle.el +++ b/lisp/org-cycle.el @@ -811,7 +811,7 @@ (defun org-cycle-hide-archived-subtrees (state) (org-get-tags nil 'local))) (message "%s" (substitute-command-keys "Subtree is archived and stays closed. Use \ -`\\[org-force-cycle-archived]' to cycle it anyway.")))))) +`\\[org-cycle-force-archived]' to cycle it anyway.")))))) (provide 'org-cycle) diff --git a/lisp/org-keys.el b/lisp/org-keys.el index e6b8ff459..782ffa871 100644 --- a/lisp/org-keys.el +++ b/lisp/org-keys.el @@ -94,7 +94,7 @@ (declare-function org-feed-update-all "org" ()) (declare-function org-fill-paragraph "org" (&optional justify region)) (declare-function org-find-file-at-mouse "org" (ev)) (declare-function org-footnote-action "org" (&optional special)) -(declare-function org-force-cycle-archived "org-cycle" ()) +(declare-function org-cycle-force-archived "org-cycle" ()) (declare-function org-force-self-insert "org" (n)) (declare-function org-forward-element "org" ()) (declare-function org-forward-heading-same-level "org" (arg &optional invisible-ok)) @@ -444,7 +444,7 @@ (org-defkey org-mode-map (kbd "C-c C-x") (make-sparse-keymap)) ;;;; TAB key with modifiers (org-defkey org-mode-map (kbd "TAB") #'org-cycle) -(org-defkey org-mode-map (kbd "C-c C-<tab>") #'org-force-cycle-archived) +(org-defkey org-mode-map (kbd "C-c C-<tab>") #'org-cycle-force-archived) ;; Override text-mode binding to expose `complete-symbol' for ;; pcomplete functionality. (org-defkey org-mode-map (kbd "M-TAB") nil) diff --git a/lisp/org.el b/lisp/org.el index dd6298104..d2271b98a 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -106,6 +106,7 @@ (defalias 'org-global-cycle #'org-cycle-global) (defalias 'org-overview #'org-cycle-overview) (defalias 'org-content #'org-cycle-content) (defalias 'org-reveal #'org-fold-reveal) +(defalias 'org-force-cycle-archived #'org-cycle-force-archived) ;; `org-outline-regexp' ought to be a defconst but is let-bound in ;; some places -- e.g. see the macro `org-with-limited-levels'. ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH 27/35] Fix org-fold--hide-drawers--overlays 2022-01-29 11:37 ` [PATCH 00/35] Merge org-fold feature branch Ihor Radchenko ` (25 preceding siblings ...) 2022-01-29 11:38 ` [PATCH 26/35] Rename remaining org-force-cycle-archived → org-cycle-force-archived Ihor Radchenko @ 2022-01-29 11:38 ` Ihor Radchenko 2022-01-29 11:38 ` [PATCH 28/35] org-string-width: Handle undefined behaviour in older Emacs Ihor Radchenko ` (8 subsequent siblings) 35 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-01-29 11:38 UTC (permalink / raw) To: Bastien, Kyle Meyer, Nicolas Goaziou, Karl Voit, Christian Heinrich, emacs-orgmode Cc: Ihor Radchenko [-- Attachment #1: Type: text/plain, Size: 77 bytes --] --- lisp/org-fold.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0027-Fix-org-fold-hide-drawers-overlays.patch --] [-- Type: text/x-patch; name="0027-Fix-org-fold-hide-drawers-overlays.patch", Size: 598 bytes --] diff --git a/lisp/org-fold.el b/lisp/org-fold.el index e48a528bf..a16ee0f9b 100644 --- a/lisp/org-fold.el +++ b/lisp/org-fold.el @@ -714,7 +714,7 @@ (defun org-fold--hide-drawers--overlays (begin end) "Hide all drawers between BEGIN and END." (save-excursion (goto-char begin) - (while (re-search-forward org-drawer-regexp end t) + (while (and (< (point) end) (re-search-forward org-drawer-regexp end t)) (let* ((pair (get-char-property-and-overlay (line-beginning-position) 'invisible)) (o (cdr-safe pair))) ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH 28/35] org-string-width: Handle undefined behaviour in older Emacs 2022-01-29 11:37 ` [PATCH 00/35] Merge org-fold feature branch Ihor Radchenko ` (26 preceding siblings ...) 2022-01-29 11:38 ` [PATCH 27/35] Fix org-fold--hide-drawers--overlays Ihor Radchenko @ 2022-01-29 11:38 ` Ihor Radchenko 2022-01-29 11:38 ` [PATCH 29/35] org-string-width: Work around `window-pixel-width' bug in old Emacs Ihor Radchenko ` (7 subsequent siblings) 35 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-01-29 11:38 UTC (permalink / raw) To: Bastien, Kyle Meyer, Nicolas Goaziou, Karl Voit, Christian Heinrich, emacs-orgmode Cc: Ihor Radchenko [-- Attachment #1: Type: text/plain, Size: 239 bytes --] * lisp/org-macs.el (org-string-width): Force older Emacs treating invisible text with ellipsis as zero-width. Newer Emacs versions do exactly this. --- lisp/org-macs.el | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0028-org-string-width-Handle-undefined-behaviour-in-older.patch --] [-- Type: text/x-patch; name="0028-org-string-width-Handle-undefined-behaviour-in-older.patch", Size: 1080 bytes --] diff --git a/lisp/org-macs.el b/lisp/org-macs.el index 0ccf080a3..0a7da0637 100644 --- a/lisp/org-macs.el +++ b/lisp/org-macs.el @@ -920,7 +920,16 @@ (defun org-string-width (string &optional pixels) (with-temp-buffer (setq-local display-line-numbers nil) (setq-local buffer-invisibility-spec - current-invisibility-spec) + (if (listp current-invisibility-spec) + (mapcar (lambda (el) + ;; Consider elipsis to have 0 width. + ;; It is what Emacs 28+ does, but we have + ;; to force it in earlier Emacs versions. + (if (and (consp el) (cdr el)) + (list (car el)) + el)) + current-invisibility-spec) + current-invisibility-spec)) (setq-local char-property-alias-alist current-char-property-alias-alist) (let (pixel-width symbol-width) ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH 29/35] org-string-width: Work around `window-pixel-width' bug in old Emacs 2022-01-29 11:37 ` [PATCH 00/35] Merge org-fold feature branch Ihor Radchenko ` (27 preceding siblings ...) 2022-01-29 11:38 ` [PATCH 28/35] org-string-width: Handle undefined behaviour in older Emacs Ihor Radchenko @ 2022-01-29 11:38 ` Ihor Radchenko 2022-01-29 11:38 ` [PATCH 30/35] org-fold-show-set-visibility: Fix edge case when folded region is at BOB Ihor Radchenko ` (6 subsequent siblings) 35 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-01-29 11:38 UTC (permalink / raw) To: Bastien, Kyle Meyer, Nicolas Goaziou, Karl Voit, Christian Heinrich, emacs-orgmode Cc: Ihor Radchenko [-- Attachment #1: Type: text/plain, Size: 129 bytes --] --- lisp/org-macs.el | 188 ++++++++++++++++++++++++++++++++--------------- 1 file changed, 129 insertions(+), 59 deletions(-) [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0029-org-string-width-Work-around-window-pixel-width-bug-.patch --] [-- Type: text/x-patch; name="0029-org-string-width-Work-around-window-pixel-width-bug-.patch", Size: 9661 bytes --] diff --git a/lisp/org-macs.el b/lisp/org-macs.el index 0a7da0637..db98dd149 100644 --- a/lisp/org-macs.el +++ b/lisp/org-macs.el @@ -887,73 +887,143 @@ (defun org-split-string (string &optional separators) results ;skip trailing separator (cons (substring string i) results))))))) +(defun org--string-from-props (s property beg end) + "Return the visible part of string S. +Visible part is determined according to text PROPERTY, which is +either `invisible' or `display'. BEG and END are 0-indices +delimiting S." + (let ((width 0) + (cursor beg)) + (while (setq beg (text-property-not-all beg end property nil s)) + (let* ((next (next-single-property-change beg property s end)) + (props (text-properties-at beg s)) + (spec (plist-get props property)) + (value + (pcase property + (`invisible + ;; If `invisible' property in PROPS means text is to + ;; be invisible, return 0. Otherwise return nil so + ;; as to resume search. + (and (or (eq t buffer-invisibility-spec) + (assoc-string spec buffer-invisibility-spec)) + 0)) + (`display + (pcase spec + (`nil nil) + (`(space . ,props) + (let ((width (plist-get props :width))) + (and (wholenump width) width))) + (`(image . ,_) + (and (fboundp 'image-size) + (ceiling (car (image-size spec))))) + ((pred stringp) + ;; Displayed string could contain invisible parts, + ;; but no nested display. + (org--string-from-props spec 'invisible 0 (length spec))) + (_ + ;; Un-handled `display' value. Ignore it. + ;; Consider the original string instead. + nil))) + (_ (error "Unknown property: %S" property))))) + (when value + (cl-incf width + ;; When looking for `display' parts, we still need + ;; to look for `invisible' property elsewhere. + (+ (cond ((eq property 'display) + (org--string-from-props s 'invisible cursor beg)) + ((= cursor beg) 0) + (t (string-width (substring s cursor beg)))) + value)) + (setq cursor next)) + (setq beg next))) + (+ width + ;; Look for `invisible' property in the last part of the + ;; string. See above. + (cond ((eq property 'display) + (org--string-from-props s 'invisible cursor end)) + ((= cursor end) 0) + (t (string-width (substring s cursor end))))))) + +(defun org--string-width-1 (string) + "Return width of STRING when displayed in the current buffer. +Unlike `string-width', this function takes into consideration +`invisible' and `display' text properties. It supports the +latter in a limited way, mostly for combinations used in Org. +Results may be off sometimes if it cannot handle a given +`display' value." + (org--string-from-props string 'display 0 (length string))) + (defun org-string-width (string &optional pixels) "Return width of STRING when displayed in the current buffer. Return width in pixels when PIXELS is non-nil." - ;; Wrap/line prefix will make `window-text-pizel-size' return too - ;; large value including the prefix. - ;; Face should be removed to make sure that all the string symbols - ;; are using default face with constant width. Constant char width - ;; is critical to get right string width from pixel width. - (remove-text-properties 0 (length string) - '(wrap-prefix t line-prefix t face t) - string) - (let (;; We need to remove the folds to make sure that folded table - ;; alignment is not messed up. - (current-invisibility-spec - (or (and (not (listp buffer-invisibility-spec)) - buffer-invisibility-spec) - (let (result) - (dolist (el buffer-invisibility-spec) - (unless (or (memq el - '(org-fold-drawer - org-fold-block - org-fold-outline)) - (and (listp el) - (memq (car el) - '(org-fold-drawer - org-fold-block - org-fold-outline)))) - (push el result))) - result))) - (current-char-property-alias-alist char-property-alias-alist)) - (with-temp-buffer - (setq-local display-line-numbers nil) - (setq-local buffer-invisibility-spec - (if (listp current-invisibility-spec) - (mapcar (lambda (el) - ;; Consider elipsis to have 0 width. - ;; It is what Emacs 28+ does, but we have - ;; to force it in earlier Emacs versions. - (if (and (consp el) (cdr el)) - (list (car el)) - el)) - current-invisibility-spec) - current-invisibility-spec)) - (setq-local char-property-alias-alist - current-char-property-alias-alist) - (let (pixel-width symbol-width) - (with-silent-modifications - (setf (buffer-string) string) - (setq pixel-width - (if (get-buffer-window (current-buffer)) - (car (window-text-pixel-size - nil (line-beginning-position) (point-max))) - (set-window-buffer nil (current-buffer)) - (car (window-text-pixel-size - nil (line-beginning-position) (point-max))))) - (unless pixels - (setf (buffer-string) "a") - (setq symbol-width + (if (and (version< emacs-version "28") (not pixels)) + ;; FIXME: Fallback to old limited version, because + ;; `window-pixel-width' is buggy in older Emacs. + (org--string-width-1 string) + ;; Wrap/line prefix will make `window-text-pizel-size' return too + ;; large value including the prefix. + ;; Face should be removed to make sure that all the string symbols + ;; are using default face with constant width. Constant char width + ;; is critical to get right string width from pixel width. + (remove-text-properties 0 (length string) + '(wrap-prefix t line-prefix t face t) + string) + (let (;; We need to remove the folds to make sure that folded table + ;; alignment is not messed up. + (current-invisibility-spec + (or (and (not (listp buffer-invisibility-spec)) + buffer-invisibility-spec) + (let (result) + (dolist (el buffer-invisibility-spec) + (unless (or (memq el + '(org-fold-drawer + org-fold-block + org-fold-outline)) + (and (listp el) + (memq (car el) + '(org-fold-drawer + org-fold-block + org-fold-outline)))) + (push el result))) + result))) + (current-char-property-alias-alist char-property-alias-alist)) + (with-temp-buffer + (setq-local display-line-numbers nil) + (setq-local buffer-invisibility-spec + (if (listp current-invisibility-spec) + (mapcar (lambda (el) + ;; Consider elipsis to have 0 width. + ;; It is what Emacs 28+ does, but we have + ;; to force it in earlier Emacs versions. + (if (and (consp el) (cdr el)) + (list (car el)) + el)) + current-invisibility-spec) + current-invisibility-spec)) + (setq-local char-property-alias-alist + current-char-property-alias-alist) + (let (pixel-width symbol-width) + (with-silent-modifications + (setf (buffer-string) string) + (setq pixel-width (if (get-buffer-window (current-buffer)) (car (window-text-pixel-size nil (line-beginning-position) (point-max))) (set-window-buffer nil (current-buffer)) (car (window-text-pixel-size - nil (line-beginning-position) (point-max))))))) - (if pixels - pixel-width - (/ pixel-width symbol-width)))))) + nil (line-beginning-position) (point-max))))) + (unless pixels + (setf (buffer-string) "a") + (setq symbol-width + (if (get-buffer-window (current-buffer)) + (car (window-text-pixel-size + nil (line-beginning-position) (point-max))) + (set-window-buffer nil (current-buffer)) + (car (window-text-pixel-size + nil (line-beginning-position) (point-max))))))) + (if pixels + pixel-width + (/ pixel-width symbol-width))))))) (defun org-not-nil (v) "If V not nil, and also not the string \"nil\", then return V. ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH 30/35] org-fold-show-set-visibility: Fix edge case when folded region is at BOB 2022-01-29 11:37 ` [PATCH 00/35] Merge org-fold feature branch Ihor Radchenko ` (28 preceding siblings ...) 2022-01-29 11:38 ` [PATCH 29/35] org-string-width: Work around `window-pixel-width' bug in old Emacs Ihor Radchenko @ 2022-01-29 11:38 ` Ihor Radchenko 2022-01-29 11:38 ` [PATCH 31/35] org-fold-core: Fix fontification inside folded regions Ihor Radchenko ` (5 subsequent siblings) 35 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-01-29 11:38 UTC (permalink / raw) To: Bastien, Kyle Meyer, Nicolas Goaziou, Karl Voit, Christian Heinrich, emacs-orgmode Cc: Ihor Radchenko [-- Attachment #1: Type: text/plain, Size: 77 bytes --] --- lisp/org-fold.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0030-org-fold-show-set-visibility-Fix-edge-case-when-fold.patch --] [-- Type: text/x-patch; name="0030-org-fold-show-set-visibility-Fix-edge-case-when-fold.patch", Size: 649 bytes --] diff --git a/lisp/org-fold.el b/lisp/org-fold.el index a16ee0f9b..d5a21cbcb 100644 --- a/lisp/org-fold.el +++ b/lisp/org-fold.el @@ -840,7 +840,7 @@ (defun org-fold-show-set-visibility--text-properties (detail) (org-with-point-at (car region) (beginning-of-line) (let (font-lock-extend-region-functions) - (font-lock-fontify-region (1- (car region)) (cdr region)))))) + (font-lock-fontify-region (max (point-min) (1- (car region))) (cdr region)))))) (when region (org-fold-region (car region) (cdr region) nil)))) (unless (org-before-first-heading-p) ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH 31/35] org-fold-core: Fix fontification inside folded regions 2022-01-29 11:37 ` [PATCH 00/35] Merge org-fold feature branch Ihor Radchenko ` (29 preceding siblings ...) 2022-01-29 11:38 ` [PATCH 30/35] org-fold-show-set-visibility: Fix edge case when folded region is at BOB Ihor Radchenko @ 2022-01-29 11:38 ` Ihor Radchenko 2022-01-29 11:38 ` [PATCH 32/35] test-org/string-width: Add tests for strings with prefix properties Ihor Radchenko ` (4 subsequent siblings) 35 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-01-29 11:38 UTC (permalink / raw) To: Bastien, Kyle Meyer, Nicolas Goaziou, Karl Voit, Christian Heinrich, emacs-orgmode Cc: Ihor Radchenko [-- Attachment #1: Type: text/plain, Size: 766 bytes --] * lisp/org-fold-core.el (org-fold-core-initialize): Declare `org-fold-core-fontified' text property for font-lock. (org-fold-core--force-fontification): New variable controlling forced fontification inside folded regions. (org-fold-core-fontify-region): Fix cases when BEG is inside folded region. Respect `org-fold-core--force-fontification'. * lisp/org-macs.el (org-with-forced-fontification): New macro. (org-buffer-substring-fontified): (org-looking-at-fontified): Do not rely on jit-lock. Use `org-fold-core-fontified' text property to determine whether text is already fontified. --- lisp/org-fold-core.el | 69 +++++++++++++++++++++++++------------------ lisp/org-macs.el | 31 +++++++++++++++++++ 2 files changed, 72 insertions(+), 28 deletions(-) [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0031-org-fold-core-Fix-fontification-inside-folded-region.patch --] [-- Type: text/x-patch; name="0031-org-fold-core-Fix-fontification-inside-folded-region.patch", Size: 6967 bytes --] diff --git a/lisp/org-fold-core.el b/lisp/org-fold-core.el index 121c6b5c4..edae316ff 100644 --- a/lisp/org-fold-core.el +++ b/lisp/org-fold-core.el @@ -746,7 +746,8 @@ (defun org-fold-core-initialize (&optional specs) (add-hook 'clone-indirect-buffer-hook #'org-fold-core-decouple-indirect-buffer-folds nil 'local) ;; Optimise buffer fontification to not fontify folded text. (when (eq font-lock-fontify-region-function #'font-lock-default-fontify-region) - (setq-local font-lock-fontify-region-function 'org-fold-core-fontify-region)) + (setq-local font-lock-fontify-region-function 'org-fold-core-fontify-region) + (add-to-list 'font-lock-extra-managed-props 'org-fold-core-fontified)) ;; Setup killing text (setq-local filter-buffer-substring-function #'org-fold-core--buffer-substring-filter) (if (and (boundp 'isearch-opened-regions) @@ -1429,35 +1430,47 @@ (defun org-fold-core--buffer-substring-filter (beg end &optional delete) return-string)) ;;; Do not fontify folded text until needed. - +(defvar org-fold-core--force-fontification nil + "Let-bind this variable to t in order to force fontification in +folded regions.") (defun org-fold-core-fontify-region (beg end loudly &optional force) "Run `font-lock-default-fontify-region' in visible regions." - (let ((pos beg) next - (org-fold-core--fontifying t)) - (while (< pos end) - (setq next (org-fold-core-next-folding-state-change - (if force nil - (let (result) - (dolist (spec (org-fold-core-folding-spec-list)) - (when (and (not (org-fold-core-get-folding-spec-property spec :visible)) - (org-fold-core-get-folding-spec-property spec :font-lock-skip)) - (push spec result))) - result)) - pos - end)) - (while (and (not (catch :found - (dolist (spec (org-fold-core-get-folding-spec 'all next)) - (when (org-fold-core-get-folding-spec-property spec :font-lock-skip) - (throw :found spec))))) - (< next end)) - (setq next (org-fold-core-next-folding-state-change nil next end))) - (save-excursion - (font-lock-default-fontify-region pos next loudly) - (save-match-data - (unless (<= pos (point) next) - (run-hook-with-args 'org-fold-core-first-unfold-functions pos next)))) - (put-text-property pos next 'org-fold-core-fontified t) - (setq pos next)))) + (with-silent-modifications + (let ((pos beg) next + (force (or force org-fold-core--force-fontification)) + (org-fold-core--fontifying t) + (skip-specs + (let (result) + (dolist (spec (org-fold-core-folding-spec-list)) + (when (and (not (org-fold-core-get-folding-spec-property spec :visible)) + (org-fold-core-get-folding-spec-property spec :font-lock-skip)) + (push spec result))) + result))) + ;; Move POS to first visible point within BEG..END. + (while (and (catch :found + (dolist (spec (org-fold-core-get-folding-spec 'all pos)) + (when (org-fold-core-get-folding-spec-property spec :font-lock-skip) + (throw :found spec)))) + (< pos end)) + (setq pos (org-fold-core-next-folding-state-change nil pos end))) + (when force (setq pos beg next end)) + (while (< pos end) + (unless force + (setq next (org-fold-core-next-folding-state-change skip-specs pos end))) + ;; Move to the end of the region to be fontified. + (while (and (not (catch :found + (dolist (spec (org-fold-core-get-folding-spec 'all next)) + (when (org-fold-core-get-folding-spec-property spec :font-lock-skip) + (throw :found spec))))) + (< next end)) + (setq next (org-fold-core-next-folding-state-change nil next end))) + (save-excursion + (font-lock-default-fontify-region pos next loudly) + (save-match-data + (unless (<= pos (point) next) + (run-hook-with-args 'org-fold-core-first-unfold-functions pos next)))) + (put-text-property pos next 'org-fold-core-fontified t) + (setq pos next))))) (defun org-fold-core-update-optimisation (beg end) "Update huge buffer optimisation between BEG and END. diff --git a/lisp/org-macs.el b/lisp/org-macs.el index db98dd149..867139742 100644 --- a/lisp/org-macs.el +++ b/lisp/org-macs.el @@ -39,6 +39,7 @@ (declare-function org-agenda-files "org" (&optional unrestricted archives)) (declare-function org-fold-show-context "org-fold" (&optional key)) (declare-function org-fold-save-outline-visibility "org-fold" (use-markers &rest body)) (declare-function org-fold-next-visibility-change "org-fold" (&optional pos limit ignore-hidden-p previous-p)) +(declare-function org-fold-core-with-forced-fontification "org-fold" (&rest body)) (declare-function org-fold-folded-p "org-fold" (&optional pos limit ignore-hidden-p previous-p)) (declare-function string-collate-lessp "org-compat" (s1 s2 &optional locale ignore-case)) @@ -1172,6 +1173,36 @@ (defconst org-rm-props '(invisible t face t keymap t intangible t mouse-face t org-emphasis t) "Properties to remove when a string without properties is wanted.") +(defvar org-fold-core--force-fontification) +(defmacro org-with-forced-fontification (&rest body) + "Run BODY forcing fontification of folded regions." + (declare (debug (form body)) (indent 1)) + `(unwind-protect + (progn + (setq org-fold-core--force-fontification t) + ,@body) + (setq org-fold-core--force-fontification nil))) + +(defun org-buffer-substring-fontified (beg end) + "Return fontified region between BEG and END." + (when (bound-and-true-p jit-lock-mode) + (org-with-forced-fontification + (when (text-property-not-all beg end 'org-fold-core-fontified t) + (save-match-data (font-lock-fontify-region beg end))))) + (buffer-substring beg end)) + +(defun org-looking-at-fontified (re) + "Call `looking-at' RE and make sure that the match is fontified." + (prog1 (looking-at re) + (when (bound-and-true-p jit-lock-mode) + (org-with-forced-fontification + (when (text-property-not-all + (match-beginning 0) (match-end 0) + 'org-fold-core-fontified t) + (save-match-data + (font-lock-fontify-region (match-beginning 0) + (match-end 0)))))))) + (defsubst org-no-properties (s &optional restricted) "Remove all text properties from string S. When RESTRICTED is non-nil, only remove the properties listed ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH 32/35] test-org/string-width: Add tests for strings with prefix properties 2022-01-29 11:37 ` [PATCH 00/35] Merge org-fold feature branch Ihor Radchenko ` (30 preceding siblings ...) 2022-01-29 11:38 ` [PATCH 31/35] org-fold-core: Fix fontification inside folded regions Ihor Radchenko @ 2022-01-29 11:38 ` Ihor Radchenko 2022-01-29 11:38 ` [PATCH 33/35] org--string-from-props: Fix handling folds in Emacs <28 Ihor Radchenko ` (3 subsequent siblings) 35 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-01-29 11:38 UTC (permalink / raw) To: Bastien, Kyle Meyer, Nicolas Goaziou, Karl Voit, Christian Heinrich, emacs-orgmode Cc: Ihor Radchenko [-- Attachment #1: Type: text/plain, Size: 95 bytes --] --- testing/lisp/test-org-macs.el | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0032-test-org-string-width-Add-tests-for-strings-with-pre.patch --] [-- Type: text/x-patch; name="0032-test-org-string-width-Add-tests-for-strings-with-pre.patch", Size: 745 bytes --] diff --git a/testing/lisp/test-org-macs.el b/testing/lisp/test-org-macs.el index 6a7ccea3c..05cef1281 100644 --- a/testing/lisp/test-org-macs.el +++ b/testing/lisp/test-org-macs.el @@ -65,7 +65,11 @@ (ert-deftest test-org/string-width () (should (= 4 (org-string-width #("123" 1 2 (display #("abc" 1 2 (invisible t))))))) ;; Test `space' property in `display'. - (should (= 2 (org-string-width #(" " 0 1 (display (space :width 2))))))) + (should (= 2 (org-string-width #(" " 0 1 (display (space :width 2)))))) + ;; Test `wrap-prefix' property. + (should (= 2 (org-string-width #("ab" 0 2 (wrap-prefix " "))))) + ;; Test `line-prefix' property. + (should (= 2 (org-string-width #("ab" 0 2 (line-prefix " ")))))) \f ;;; Regexp ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH 33/35] org--string-from-props: Fix handling folds in Emacs <28 2022-01-29 11:37 ` [PATCH 00/35] Merge org-fold feature branch Ihor Radchenko ` (31 preceding siblings ...) 2022-01-29 11:38 ` [PATCH 32/35] test-org/string-width: Add tests for strings with prefix properties Ihor Radchenko @ 2022-01-29 11:38 ` Ihor Radchenko 2022-01-29 11:38 ` [PATCH 34/35] org-link-make-string: Throw error when both LINK and DESCRIPTION are empty Ihor Radchenko ` (2 subsequent siblings) 35 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-01-29 11:38 UTC (permalink / raw) To: Bastien, Kyle Meyer, Nicolas Goaziou, Karl Voit, Christian Heinrich, emacs-orgmode Cc: Ihor Radchenko [-- Attachment #1: Type: text/plain, Size: 213 bytes --] * lisp/org-macs.el (org--string-from-props): Respect `char-property-alias-alist' when querying for `invisible' text property. --- lisp/org-macs.el | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0033-org-string-from-props-Fix-handling-folds-in-Emacs-28.patch --] [-- Type: text/x-patch; name="0033-org-string-from-props-Fix-handling-folds-in-Emacs-28.patch", Size: 926 bytes --] diff --git a/lisp/org-macs.el b/lisp/org-macs.el index 867139742..6a2d7fe85 100644 --- a/lisp/org-macs.el +++ b/lisp/org-macs.el @@ -897,14 +897,13 @@ (defun org--string-from-props (s property beg end) (cursor beg)) (while (setq beg (text-property-not-all beg end property nil s)) (let* ((next (next-single-property-change beg property s end)) - (props (text-properties-at beg s)) - (spec (plist-get props property)) + (spec (get-text-property beg property s)) (value (pcase property (`invisible - ;; If `invisible' property in PROPS means text is to - ;; be invisible, return 0. Otherwise return nil so - ;; as to resume search. + ;; If `invisible' property means text is to be + ;; invisible, return 0. Otherwise return nil so as + ;; to resume search. (and (or (eq t buffer-invisibility-spec) (assoc-string spec buffer-invisibility-spec)) 0)) ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH 34/35] org-link-make-string: Throw error when both LINK and DESCRIPTION are empty 2022-01-29 11:37 ` [PATCH 00/35] Merge org-fold feature branch Ihor Radchenko ` (32 preceding siblings ...) 2022-01-29 11:38 ` [PATCH 33/35] org--string-from-props: Fix handling folds in Emacs <28 Ihor Radchenko @ 2022-01-29 11:38 ` Ihor Radchenko 2022-01-29 11:38 ` [PATCH 35/35] test-ol/org-toggle-link-display: Fix compatibility with old Emacs Ihor Radchenko 2022-02-03 6:27 ` [PATCH 00/35] Merge org-fold feature branch Bastien 35 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-01-29 11:38 UTC (permalink / raw) To: Bastien, Kyle Meyer, Nicolas Goaziou, Karl Voit, Christian Heinrich, emacs-orgmode Cc: Ihor Radchenko [-- Attachment #1: Type: text/plain, Size: 138 bytes --] This behaviour is expected according to `test-ol/make-string'. --- lisp/ol.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0034-org-link-make-string-Throw-error-when-both-LINK-and-.patch --] [-- Type: text/x-patch; name="0034-org-link-make-string-Throw-error-when-both-LINK-and-.patch", Size: 559 bytes --] diff --git a/lisp/ol.el b/lisp/ol.el index 1837bf37c..2e954a57f 100644 --- a/lisp/ol.el +++ b/lisp/ol.el @@ -999,7 +999,9 @@ (defun org-link-make-string (link &optional description) (replace-regexp-in-string "]\\'" (concat "\\&" zero-width-space) (org-trim description)))))) - (if (not (org-string-nw-p link)) description + (if (not (org-string-nw-p link)) + (or description + (error "Empty link")) (format "[[%s]%s]" (org-link-escape link) (if description (format "[%s]" description) ""))))) ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH 35/35] test-ol/org-toggle-link-display: Fix compatibility with old Emacs 2022-01-29 11:37 ` [PATCH 00/35] Merge org-fold feature branch Ihor Radchenko ` (33 preceding siblings ...) 2022-01-29 11:38 ` [PATCH 34/35] org-link-make-string: Throw error when both LINK and DESCRIPTION are empty Ihor Radchenko @ 2022-01-29 11:38 ` Ihor Radchenko 2022-02-03 6:27 ` [PATCH 00/35] Merge org-fold feature branch Bastien 35 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-01-29 11:38 UTC (permalink / raw) To: Bastien, Kyle Meyer, Nicolas Goaziou, Karl Voit, Christian Heinrich, emacs-orgmode Cc: Ihor Radchenko [-- Attachment #1: Type: text/plain, Size: 205 bytes --] * testing/lisp/test-ol.el (test-ol/org-toggle-link-display): Use back-compatible `org-xor' instead of `xor'. --- testing/lisp/test-ol.el | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0035-test-ol-org-toggle-link-display-Fix-compatibility-wi.patch --] [-- Type: text/x-patch; name="0035-test-ol-org-toggle-link-display-Fix-compatibility-wi.patch", Size: 1330 bytes --] diff --git a/testing/lisp/test-ol.el b/testing/lisp/test-ol.el index 343631623..429bb52ee 100644 --- a/testing/lisp/test-ol.el +++ b/testing/lisp/test-ol.el @@ -59,19 +59,19 @@ (ert-deftest test-ol/org-toggle-link-display () (dotimes (_ 2) (goto-char 1) (re-search-forward "\\[") - (should-not (xor org-link-descriptive (org-invisible-p))) + (should-not (org-xor org-link-descriptive (org-invisible-p))) (re-search-forward "example") - (should-not (xor org-link-descriptive (org-invisible-p))) + (should-not (org-xor org-link-descriptive (org-invisible-p))) (re-search-forward "com") - (should-not (xor org-link-descriptive (org-invisible-p))) + (should-not (org-xor org-link-descriptive (org-invisible-p))) (re-search-forward "]") - (should-not (xor org-link-descriptive (org-invisible-p))) + (should-not (org-xor org-link-descriptive (org-invisible-p))) (re-search-forward "\\[") (should-not (org-invisible-p)) (re-search-forward "link") (should-not (org-invisible-p)) (re-search-forward "]") - (should-not (xor org-link-descriptive (org-invisible-p))) + (should-not (org-xor org-link-descriptive (org-invisible-p))) (org-toggle-link-display))))) \f ^ permalink raw reply related [flat|nested] 192+ messages in thread
* Re: [PATCH 00/35] Merge org-fold feature branch 2022-01-29 11:37 ` [PATCH 00/35] Merge org-fold feature branch Ihor Radchenko ` (34 preceding siblings ...) 2022-01-29 11:38 ` [PATCH 35/35] test-ol/org-toggle-link-display: Fix compatibility with old Emacs Ihor Radchenko @ 2022-02-03 6:27 ` Bastien 2022-02-03 7:07 ` Ihor Radchenko 35 siblings, 1 reply; 192+ messages in thread From: Bastien @ 2022-02-03 6:27 UTC (permalink / raw) To: Ihor Radchenko Cc: Karl Voit, emacs-orgmode, Kyle Meyer, Christian Heinrich, Nicolas Goaziou Hi Ihor, thank you very much for the hard work! It looks very promising. How would you sum up the main benefit of this contribution? Is there a branch where I could easily test this? I've taken most of next week off to be able to catch up with the mailing list and I'll prioritize the review of these changes. Thanks again, -- Bastien ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [PATCH 00/35] Merge org-fold feature branch 2022-02-03 6:27 ` [PATCH 00/35] Merge org-fold feature branch Bastien @ 2022-02-03 7:07 ` Ihor Radchenko 2022-04-20 13:23 ` [PATCH v2 00/38] Final call for comments: " Ihor Radchenko 0 siblings, 1 reply; 192+ messages in thread From: Ihor Radchenko @ 2022-02-03 7:07 UTC (permalink / raw) To: Bastien Cc: Karl Voit, emacs-orgmode, Kyle Meyer, Christian Heinrich, Nicolas Goaziou Bastien <bzg@gnu.org> writes: > How would you sum up the main benefit of this contribution? In short: (1) Performance improvements in large files - we do not use overlays; (2) Better handling of invisible edits; (3) Deferred fontification of folded regions (for faster startup); (4) More modular Org code. Details are in the ORG-NEWS ([PATCH 22/35] ORG-NEWS: Add list of changes). > Is there a branch where I could easily test this? The branch containing the submitted patch set: https://github.com/yantar92/org/tree/feature/org-fold-universal-core-tidy Best, Ihor ^ permalink raw reply [flat|nested] 192+ messages in thread
* [PATCH v2 00/38] Final call for comments: Merge org-fold feature branch 2022-02-03 7:07 ` Ihor Radchenko @ 2022-04-20 13:23 ` Ihor Radchenko 2022-04-20 13:23 ` [PATCH v2 01/38] Add org-fold-core: new folding engine--- Ihor Radchenko ` (41 more replies) 0 siblings, 42 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-04-20 13:23 UTC (permalink / raw) To: emacs-orgmode This is the final version of the patch. I am going to merge it this weekend. If there are any comments, please send them ASAP. This version is basically the same as previous, but (1) Rebased onto current main; (2) org-agenda.el can be native compiled; (3) Fixed some edge cases with fontification. Best, Ihor Anders Johansson (3): Fix typo: delete-duplicates → delete-dups Fix bug in org-get-heading Rename remaining org-force-cycle-archived → org-cycle-force-archived Ihor Radchenko (35): Add org-fold-core: new folding engine Separate folding functions from org.el into new library: org-fold Separate cycling functions from org.el into new library: org-cycle Remove functions from org.el that are now moved elsewhere Disable native-comp in agenda org-macs: New function org-find-text-property-region org-at-heading-p: Accept optional argument org-string-width: Reimplement to work with new folding Rename old function call to use org-fold Implement link folding Implement overlay- and text-property-based versions of some functions org-fold: Handle indirect buffer visibility Fix subtle differences between overlays and invisible text properties Support extra org-fold optimisations for huge buffers Alias new org-fold functions to their old shorter names Obsolete old function names that are now in org-fold org-compat: Work around some third-party packages using outline-* functions Move `org-buffer-list' to org-macs.el Restore old visibility behaviour of org-refile Add org-fold-related tests org-manual: Update to new org-fold function names ORG-NEWS: Add list of changes Backport contributed commits Fix org-fold--hide-drawers--overlays org-string-width: Handle undefined behaviour in older Emacs org-string-width: Work around `window-pixel-width' bug in old Emacs org-fold-show-set-visibility: Fix edge case when folded region is at BOB org-fold-core: Fix fontification inside folded regions test-org/string-width: Add tests for strings with prefix properties org--string-from-props: Fix handling folds in Emacs <28 org-link-make-string: Throw error when both LINK and DESCRIPTION are empty test-ol/org-toggle-link-display: Fix compatibility with old Emacs org-macs.el: Fix fontification checks take 2 org-fold-core-fontify-region: Fix cases when fontification is not registered org-agenda.el: Re-enable native compilation doc/org-manual.org | 14 +- etc/ORG-NEWS | 104 ++ lisp/ob-core.el | 14 +- lisp/ob-lilypond.el | 4 +- lisp/ob-ref.el | 4 +- lisp/ol.el | 59 +- lisp/org-agenda.el | 48 +- lisp/org-archive.el | 12 +- lisp/org-capture.el | 7 +- lisp/org-clock.el | 126 +- lisp/org-colview.el | 10 +- lisp/org-compat.el | 189 ++- lisp/org-crypt.el | 8 +- lisp/org-cycle.el | 818 +++++++++++ lisp/org-element.el | 55 +- lisp/org-feed.el | 4 +- lisp/org-fold-core.el | 1506 +++++++++++++++++++ lisp/org-fold.el | 1132 +++++++++++++++ lisp/org-footnote.el | 6 +- lisp/org-goto.el | 6 +- lisp/org-id.el | 4 +- lisp/org-inlinetask.el | 26 +- lisp/org-keys.el | 26 +- lisp/org-lint.el | 3 +- lisp/org-list.el | 84 +- lisp/org-macs.el | 294 +++- lisp/org-mobile.el | 2 +- lisp/org-mouse.el | 4 +- lisp/org-refile.el | 3 +- lisp/org-src.el | 6 +- lisp/org-timer.el | 2 +- lisp/org.el | 2550 +++++++++++---------------------- lisp/ox-org.el | 2 +- lisp/ox.el | 4 +- testing/lisp/test-ob.el | 12 +- testing/lisp/test-ol.el | 24 + testing/lisp/test-org-list.el | 75 +- testing/lisp/test-org-macs.el | 6 +- testing/lisp/test-org.el | 258 +++- 39 files changed, 5480 insertions(+), 2031 deletions(-) create mode 100644 lisp/org-cycle.el create mode 100644 lisp/org-fold-core.el create mode 100644 lisp/org-fold.el -- 2.35.1 -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply [flat|nested] 192+ messages in thread
* [PATCH v2 01/38] Add org-fold-core: new folding engine--- 2022-04-20 13:23 ` [PATCH v2 00/38] Final call for comments: " Ihor Radchenko @ 2022-04-20 13:23 ` Ihor Radchenko 2022-04-20 13:24 ` [PATCH v2 02/38] Separate folding functions from org.el into new library: org-fold Ihor Radchenko ` (40 subsequent siblings) 41 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-04-20 13:23 UTC (permalink / raw) To: emacs-orgmode --- lisp/org-fold-core.el | 1490 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 1490 insertions(+) create mode 100644 lisp/org-fold-core.el diff --git a/lisp/org-fold-core.el b/lisp/org-fold-core.el new file mode 100644 index 000000000..121c6b5c4 --- /dev/null +++ b/lisp/org-fold-core.el @@ -0,0 +1,1490 @@ +;;; org-fold-core.el --- Folding buffer text -*- lexical-binding: t; -*- +;; +;; Copyright (C) 2020-2020 Free Software Foundation, Inc. +;; +;; Author: Ihor Radchenko <yantar92 at gmail dot com> +;; Keywords: folding, invisible text +;; Homepage: https://orgmode.org +;; +;; This file is part of GNU Emacs. +;; +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Commentary: + +;; This file contains library to control temporary invisibility +;; (folding and unfolding) of text in buffers. + +;; The file implements the following functionality: +;; +;; - Folding/unfolding regions of text +;; - Searching and examining boundaries of folded text +;; - Interactive searching in folded text (via isearch) +;; - Handling edits in folded text +;; - Killing/yanking (copying/pasting) of the folded text +;; - Fontification of the folded text + +;; To setup folding in an arbitrary buffer, one must call +;; `org-fold-core-initialize', optionally providing the list of folding specs to be +;; used in the buffer. The specs can be added, removed, or +;; re-configured later. Read below for more details. + +;;; Folding/unfolding regions of text + +;; User can temporarily hide/reveal (fold/unfold) arbitrary regions or +;; text. The folds can be nested. + +;; Internally, nested folds are marked with different folding specs +;; Overlapping folds marked with the same folding spec are +;; automatically merged, while folds with different folding specs can +;; coexist and be folded/unfolded independently. + +;; When multiple folding specs are applied to the same region of text, +;; text visibility is decided according to the folding spec with +;; topmost priority. + +;; By default, we define two types of folding specs: +;; - 'org-fold-visible :: the folded text is not hidden +;; - 'org-fold-hidden :: the folded text is completely hidden +;; +;; The 'org-fold-visible spec has highest priority allowing parts of +;; text folded with 'org-fold-hidden to be shown unconditionally. + +;; Consider the following Org mode link: +;; [[file:/path/to/file/file.ext][description]] +;; Only the word "description" is normally visible in this link. +;; +;; The way this partial visibility is achieved is combining the two +;; folding specs. The whole link is folded using 'org-fold-hidden +;; folding spec, but the visible part is additionally folded using +;; 'org-fold-visible: +;; +;; <begin org-fold-hidden>[[file:/path/to/file/file.ext][<begin org-fold-visible>description<end org-fold-visible>]]<end org-fold-hidden> +;; +;; Because 'org-fold-visible has higher priority than +;; 'org-fold-hidden, it suppresses the 'org-fold-hidden effect and +;; thus reveals the description part of the link. + +;; Similar to 'org-fold-visible, display of any arbitrary folding spec +;; can be configured using folding spec properties. In particular, +;; `:visible' folding spec proprety controls whether the folded text +;; is visible or not. If the `:visible' folding spec property is nil, +;; folded text is hidden or displayed as a constant string (ellipsis) +;; according to the value of `:ellipsis' folding spec property. See +;; docstring of `org-fold-core--specs' for the description of all the available +;; folding spec properties. + +;; Folding spec properties of any valid folding spec can be changed +;; any time using `org-fold-core-set-folding-spec-property'. + +;; If necessary, one can add or remove folding specs using +;; `org-fold-core-add-folding-spec' and `org-fold-core-remove-folding-spec'. + +;; If a buffer initialised with `org-fold-core-initialize' is cloned into indirect +;; buffers, it's folding state is copied to that indirect buffer. +;; The folding states are independent. + +;; When working with indirect buffers that are handled by this +;; library, one has to keep in mind that folding state is preserved on +;; copy when using non-interactive functions. Moreover, the folding +;; states of all the indirect buffers will be copied together. +;; +;; Example of the implications: +;; Consider a base buffer and indirect buffer with the following state: +;; ----- base buffer -------- +;; * Heading<begin fold> +;; Some text folded in the base buffer, but unfolded in the indirect buffer<end fold> +;; * Other heading +;; Heading unfolded in both the buffers. +;; --------------------------- +;; ------ indirect buffer ---- +;; * Heading +;; Some text folded in the base buffer, but unfolded in the indirect buffer +;; * Other heading +;; Heading unfolded in both the buffers. +;; ---------------------------- +;; If some Elisp code copies the whole "Heading" from the indirect +;; buffer with `buffer-substring' or match data and inserts it into +;; the base buffer, the inserted heading will be folded since the +;; internal setting for the folding state is shared between the base +;; and indirect buffers. It's just that the indirect buffer ignores +;; the base buffer folding settings. However, as soon as the text is +;; copied back to the base buffer, the folding state will become +;; respected again. + +;; If the described situation is undesired, Elisp code can use +;; `filter-buffer-substring' instead of `buffer-substring'. All the +;; folding states that do not belong to the currently active buffer +;; will be cleared in the copied text then. See +;; `org-fold-core--buffer-substring-filter' for more details. + +;; Because of details of implementation of the folding, it is also not +;; recommended to set text visibility in buffer directly by setting +;; `invisible' text property to anything other than t. While this +;; should usually work just fine, normal folding can be broken if one +;; sets `invisible' text property to a value not listed in +;; `buffer-invisibility-spec'. + +;;; Searching and examining boundaries of folded text + +;; It is possible to examine folding specs (there may be several) of +;; text at point or search for regions with the same folding spec. +;; See functions defined under ";;;; Searching and examining folded +;; text" below for details. + +;; All the folding specs can be specified by symbol representing their +;; name. However, this is not always convenient, especially if the +;; same spec can be used for fold different syntaxical structures. +;; Any folding spec can be additionally referenced by a symbol listed +;; in the spec's `:alias' folding spec property. For example, Org +;; mode's `org-fold-outline' folding spec can be referened as any +;; symbol from the following list: '(headline heading outline +;; inlinetask plain-list) The list is the value of the spec's `:alias' +;; property. + +;; Most of the functions defined below that require a folding spec +;; symbol as their argument, can also accept any symbol from the +;; `:alias' spec property to reference that folding spec. + +;; If one wants to search invisible text without using the provided +;; functions, it is important to keep in mind that 'invisible text +;; property may have multiple possible values (not just nil and +;; t). Hence, (next-single-char-property-change pos 'invisible) is not +;; guarantied to return the boundary of invisible/visible text. + +;;; Interactive searching inside folded text (via isearch) + +;; The library provides a way to control if the folded text can be +;; searchable using isearch. If the text is searchable, it is also +;; possible to control to unfold it temporarily during interactive +;; isearch session. + +;; The isearch behaviour is controlled on per-folding-spec basis by +;; setting `isearch-open' and `isearch-ignore' folding spec +;; properties. The the docstring of `org-fold-core--specs' for more details. + +;;; Handling edits inside folded text + +;; The visibility of the text inserted in front, rear, or in the +;; middle of a folded region is managed according to `:front-sticky' +;; and `:rear-sticky' folding properties of the corresponding folding +;; spec. The rules are the same with stickyness of text properties in +;; Elisp. + +;; If a text being inserted into the buffer is already folded and +;; invisible (before applying the stickyness rules), then it is +;; revealed. This behaviour can be changed by wrapping the insertion +;; code into `org-fold-core-ignore-modifications' macro. The macro will disable +;; all the processing related to buffer modifications. + +;; The library also provides a way to unfold the text after some +;; destructive changes breaking syntaxical structure of the buffer. +;; For example, Org mode automatically reveals folded drawers when the +;; drawer becomes syntaxically incorrect: +;; ------- before modification ------- +;; :DRAWER:<begin fold> +;; Some folded text inside drawer +;; :END:<end fold> +;; ----------------------------------- +;; If the ":END:" is edited, drawer syntax is not correct anymore and +;; the folded text is automatically unfolded. +;; ------- after modification -------- +;; :DRAWER: +;; Some folded text inside drawer +;; :EN: +;; ----------------------------------- + +;; The described automatic unfolding is controlled by `:fragile' +;; folding spec property. It's value can be a function checking if +;; changes inside (or around) the fold should drigger the unfold. By +;; default, only changes that directly involve folded regions will +;; trigger the check. In addition, `org-fold-core-extend-changed-region-functions' +;; can be set to extend the checks to all folded regions intersecting +;; with the region returned by the functions listed in the variable. + +;; The fragility checks can be bypassed if the code doing +;; modifications is wrapped into `org-fold-core-ignore-fragility-checks' macro. + +;;; Fontification of the folded text + +;; When working with huge buffers, `font-lock' may take a lot of time +;; to fontify all the buffer text during startup. This library +;; provides a way to delay fontification of initially folded text to +;; the time when the text is unfolded. The fontification is +;; controlled on per-folding-spec basis according to `:font-lock-skip' +;; folding spec property. + +;; This library replaces `font-lock-fontify-region-function' to implement the +;; delayed fontification. However, it only does so when +;; `font-lock-fontify-region-function' is not modified at the initialisation +;; time. If one needs to use both delayed fontification and custom +;; `font-lock-fontify-region-function', it is recommended to consult the +;; source code of `org-fold-core-fontify-region'. + +;;; Performance considerations + +;; This library is using text properties to hide text. Text +;; properties are much faster than overlays, that could be used for +;; the same purpose. Overlays are implemented with O(n) complexity in +;; Emacs (as for 2021-03-11). It means that any attempt to move +;; through hidden text in a file with many invisible overlays will +;; require time scaling with the number of folded regions (the problem +;; Overlays note of the manual warns about). For curious, historical +;; reasons why overlays are not efficient can be found in +;; https://www.jwz.org/doc/lemacs.html. + +;; Despite using text properties, the performance is still limited by +;; Emacs display engine. For example, >7Mb of text hidden within +;; visible part of a buffer may cause noticeable lags (which is still +;; orders of magnitude better in comparison with overlays). If the +;; performance issues become critical while using this library, it is +;; recommended to minimise the number of folding specs used in the +;; same buffer at a time. + +;; Alternatively, the library provides `org-fold-core--optimise-for-huge-buffers' +;; for additional speedup. This can be used as a file-local variable +;; in huge buffers. The variable can be set to enable various levels +;; of extra optimisation. See the docstring for detailed information. + +;; It is worth noting that when using `org-fold-core--optimise-for-huge-buffers' +;; with `grab-invisible' option, folded regions copied to other +;; buffers (including buffers that do not use this library) will +;; remain invisible. org-fold-core provides functions to work around +;; this issue: `org-fold-core-remove-optimisation' and `org-fold-core-update-optimisation', but +;; it is unlikely that a random external package will use them. + +;; Another possible bottleneck is the fragility check after the change +;; related to the folded text. The functions used in `:fragile' +;; folding properties must be optimised. Also, +;; `org-fold-core-ignore-fragility-checks' or even `org-fold-core-ignore-modifications' may be +;; used when appropriate in the performance-critical code. When +;; inserting text from within `org-fold-core-ignore-modifications' macro, it is +;; recommended to use `insert-and-inherit' instead of `insert' and +;; `insert-before-markers-and-inherit' instead of +;; `insert-before-markers' to avoid revealing inserted text in the +;; middle of a folded region. + +;; Performance of isearch is currently limited by Emacs isearch +;; implementation. For now, Emacs isearch only supports searching +;; through text hidden using overlays. This library handles isearch +;; by converting folds with matching text to overlays, which may +;; affect performance in case of large number of matches. In the +;; future, Emacs will hopefully accept the relevant patch allowing +;; isearch to work with text hidden via text properties, but the +;; performance hit has to be accepted meanwhile. + +;;; Code: + +(require 'org-macs) +(require 'org-compat) + +(declare-function isearch-filter-visible "isearch" (beg end)) + +;;; Customization + +(defcustom org-fold-core-style 'text-properties + "Internal implementation detail used to hide folded text. +Can be either `text-properties' or `overlays'. +The former is faster on large files, while the latter is generally +less error-prone." + :group 'org + :package-version '(Org . "9.6") + :type '(choice + (const :tag "Overlays" 'overlays) + (const :tag "Text properties" 'text-properties))) + +(defcustom org-fold-core-first-unfold-functions nil + "Functions executed after first unfolding during fontification. +Each function is exectured with two arguments: begin and end points of +the unfolded region." + :group 'org + :package-version '(Org . "9.6") + :type 'hook) + +(defvar-local org-fold-core-isearch-open-function #'org-fold-core--isearch-reveal + "Function used to reveal hidden text found by isearch. +The function is called with a single argument - point where text is to +be revealed.") + +(defvar-local org-fold-core--optimise-for-huge-buffers nil + "Non-nil turns on extra speedup on huge buffers (Mbs of folded text). + +This setting is risky and may cause various artefacts and degraded +functionality, especially when using external packages. It is +recommended to enable it on per-buffer basis as file-local variable. + +When set to non-nil, must be a list containing one or multiple the +following symbols: + +- `grab-invisible': Use `invisible' text property to hide text. This + will reduce the load on Emacs display engine and one may use it if + moving point across folded regions becomes slow. However, as a side + effect, some external packages extracting i.e. headlings from folded + parts of buffer may keep the text invisible. + +- `ignore-fragility-checks': Do not try to detect when user edits + break structure of the folded elements. This will speed up + modifying the folded regions at the cost that some higher-level + functions relying on this package might not be able to unfold the + edited text. For example, removed leading stars from a folded + headline in Org mode will break visibility cycling since Org mode + will not be avare that the following folded text belonged to + headline. + +- `ignore-modification-checks': Do not try to detect insertions in the + middle of the folded regions. This will speed up non-interactive + edits of the folded regions. However, text inserted in the middle + of the folded regions may become visible for some external packages + inserting text using `insert' instead of `insert-and-inherit' (the + latter is rarely used in practice). + +- `ignore-indirect': Do not decouple folding state in the indirect + buffers. This can speed up Emacs display engine (and thus motion of + point), especially when large number of indirect buffers is being + used. + +- `merge-folds': Do not distinguish between different types of folding + specs. This is the most aggressive optimisation with unforseen and + potentially drastic effects.") +(put 'org-fold-core--optimise-for-huge-buffers 'safe-local-variable 'listp) + +;;; Core functionality + +;;;; Folding specs + +(defvar-local org-fold-core--specs '((org-fold-visible + (:visible . t) + (:alias . (visible))) + (org-fold-hidden + (:ellipsis . "...") + (:isearch-open . t) + (:alias . (hidden)))) + "Folding specs defined in current buffer. + +Each spec is a list (SPEC-SYMBOL SPEC-PROPERTIES). +SPEC-SYMBOL is the symbol respresenting the folding spec. +SPEC-PROPERTIES is an alist defining folding spec properties. + +If a text region is folded using multiple specs, only the folding spec +listed earlier is used. + +The following properties are known: +- :ellipsis :: must be nil or string to show when text is folded + using this spec. +- :global :: non-nil means that folding state will be preserved + when copying folded text between buffers. +- :isearch-ignore :: non-nil means that folded text is not searchable + using isearch. +- :isearch-open :: non-nil means that isearch can reveal text hidden + using this spec. This property does nothing + when 'isearch-ignore property is non-nil. +- :front-sticky :: non-nil means that text prepended to the folded text + is automatically folded. +- :rear-sticky :: non-nil means that text appended to the folded text + is folded. +- :visible :: non-nil means that folding spec visibility is not + managed. Instead, visibility settings in + `buffer-invisibility-spec' will be used as is. + Note that changing this property from nil to t may + clear the setting in `buffer-invisibility-spec'. +- :alias :: a list of aliases for the SPEC-SYMBOL. +- :font-lock-skip :: Suppress font-locking in folded text. +- :fragile :: Must be a function accepting two arguments. + Non-nil means that changes in region may cause + the region to be revealed. The region is + revealed after changes if the function returns + non-nil. + The function called after changes are made with + two arguments: cons (beg . end) representing the + folded region and spec symbol.") +(defvar-local org-fold-core--spec-symbols nil + "Alist holding buffer spec symbols and aliases. + +This variable is defined to reduce load on Emacs garbage collector +reducing the number of transiently allocated variables.") +(defvar-local org-fold-core--spec-list nil + "List holding buffer spec symbols, but not aliases. + +This variable is defined to reduce load on Emacs garbage collector +reducing the number of transiently allocated variables.") + +(defvar-local org-fold-core-extend-changed-region-functions nil + "Special hook run just before handling changes in buffer. + +This is used to account changes outside folded regions that still +affect the folded region visibility. For example, removing all stars +at the beginning of a folded Org mode heading should trigger the +folded text to be revealed. Each function is called with two +arguments: beginning and the end of the changed region.") + +;;; Utility functions + +(defsubst org-fold-core-folding-spec-list (&optional buffer) + "Return list of all the folding spec symbols in BUFFER." + (or (buffer-local-value 'org-fold-core--spec-list (or buffer (current-buffer))) + (with-current-buffer (or buffer (current-buffer)) + (setq org-fold-core--spec-list (mapcar #'car org-fold-core--specs))))) + +(defun org-fold-core-get-folding-spec-from-alias (spec-or-alias) + "Return the folding spec symbol for SPEC-OR-ALIAS. +Return nil when there is no matching folding spec." + (when spec-or-alias + (unless org-fold-core--spec-symbols + (dolist (spec (org-fold-core-folding-spec-list)) + (push (cons spec spec) org-fold-core--spec-symbols) + (dolist (alias (assq :alias (assq spec org-fold-core--specs))) + (push (cons alias spec) org-fold-core--spec-symbols)))) + (alist-get spec-or-alias org-fold-core--spec-symbols))) + +(defsubst org-fold-core-folding-spec-p (spec-or-alias) + "Check if SPEC-OR-ALIAS is a registered folding spec." + (org-fold-core-get-folding-spec-from-alias spec-or-alias)) + +(defsubst org-fold-core--check-spec (spec-or-alias) + "Throw an error if SPEC-OR-ALIAS is not in `org-fold-core--spec-priority-list'." + (unless (org-fold-core-folding-spec-p spec-or-alias) + (error "%s is not a valid folding spec" spec-or-alias))) + +(defsubst org-fold-core-get-folding-spec-property (spec-or-alias property) + "Get PROPERTY of a folding SPEC-OR-ALIAS. +Possible properties can be found in `org-fold-core--specs' docstring." + (org-fold-core--check-spec spec-or-alias) + (if (and (memql 'ignore-indirect org-fold-core--optimise-for-huge-buffers) + (eq property :global)) + t + (if (and (memql 'merge-folds org-fold-core--optimise-for-huge-buffers) + (eq property :visible)) + nil + (cdr (assq property (assq (org-fold-core-get-folding-spec-from-alias spec-or-alias) org-fold-core--specs)))))) + +(defconst org-fold-core--spec-property-prefix "org-fold--spec-" + "Prefix used to create property symbol.") + +(defsubst org-fold-core-get-folding-property-symbol (spec &optional buffer global) + "Get folding text property using to store SPEC in current buffer or BUFFER. +If GLOBAL is non-nil, do not make the property unique in the BUFFER." + (if (memql 'merge-folds org-fold-core--optimise-for-huge-buffers) + (intern (format "%s-global" org-fold-core--spec-property-prefix)) + (intern (format (concat org-fold-core--spec-property-prefix "%s-%S") + (symbol-name spec) + ;; (sxhash buf) appears to be not constant over time. + ;; Using buffer-name is safe, since the only place where + ;; buffer-local text property actually matters is an indirect + ;; buffer, where the name cannot be same anyway. + (if global 'global + (sxhash (buffer-name (or buffer (current-buffer))))))))) + +(defsubst org-fold-core-get-folding-spec-from-folding-prop (folding-prop) + "Return folding spec symbol used for folding property with name FOLDING-PROP." + (catch :exit + (dolist (spec (org-fold-core-folding-spec-list)) + ;; We know that folding properties have + ;; folding spec in their name. + (when (string-match-p (symbol-name spec) + (symbol-name folding-prop)) + (throw :exit spec))))) + +(defvar org-fold-core--property-symbol-cache (make-hash-table :test 'equal) + "Saved values of folding properties for (buffer . spec) conses.") +(defvar-local org-fold-core--indirect-buffers nil + "List of indirect buffers created from current buffer. + +The first element of the list is always the current buffer. + +This variable is needed to work around Emacs bug#46982, while Emacs +does not provide a way `after-change-functions' in any other buffer +than the buffer where the change was actually made.") + +(defmacro org-fold-core-cycle-over-indirect-buffers (&rest body) + "Execute BODY in current buffer and all its indirect buffers. + +Also, make sure that folding properties from killed buffers are not +hanging around." + (declare (debug (form body)) (indent 1)) + `(let (buffers dead-properties) + (if (and (not (buffer-base-buffer)) + (not (eq (current-buffer) (car org-fold-core--indirect-buffers)))) + ;; We are in base buffer with `org-fold-core--indirect-buffers' value from + ;; different buffer. This can happen, for example, when + ;; org-capture copies local variables into *Capture* buffer. + (setq buffers (list (current-buffer))) + (dolist (buf (cons (or (buffer-base-buffer) (current-buffer)) + (buffer-local-value 'org-fold-core--indirect-buffers (or (buffer-base-buffer) (current-buffer))))) + (if (buffer-live-p buf) + (push buf buffers) + (dolist (spec (org-fold-core-folding-spec-list)) + (when (and (not (org-fold-core-get-folding-spec-property spec :global)) + (gethash (cons buf spec) org-fold-core--property-symbol-cache)) + ;; Make sure that dead-properties variable can be passed + ;; as argument to `remove-text-properties'. + (push t dead-properties) + (push (gethash (cons buf spec) org-fold-core--property-symbol-cache) + dead-properties)))))) + (dolist (buf buffers) + (with-current-buffer buf + (with-silent-modifications + (save-restriction + (widen) + (remove-text-properties + (point-min) (point-max) + dead-properties))) + ,@body)))) + +;; This is the core function used to fold text in buffers. We use +;; text properties to hide folded text, however 'invisible property is +;; not directly used (unless risky `org-fold-core--optimise-for-huge-buffers' is +;; enabled). Instead, we define unique text property (folding +;; property) for every possible folding spec and add the resulting +;; text properties into `char-property-alias-alist', so that +;; 'invisible text property is automatically defined if any of the +;; folding properties is non-nil. This approach lets us maintain +;; multiple folds for the same text region - poor man's overlays (but +;; much faster). Additionally, folding properties are ensured to be +;; unique for different buffers (especially for indirect +;; buffers). This is done to allow different folding states in +;; indirect buffers. +(defun org-fold-core--property-symbol-get-create (spec &optional buffer return-only) + "Return a unique symbol suitable as folding text property. +Return value is unique for folding SPEC in BUFFER. +If the buffer already have buffer-local setup in `char-property-alias-alist' +and the setup appears to be created for different buffer, +copy the old invisibility state into new buffer-local text properties, +unless RETURN-ONLY is non-nil." + (if (eq org-fold-core-style 'overlays) + (org-fold-core-get-folding-property-symbol spec nil 'global) + (let* ((buf (or buffer (current-buffer)))) + ;; Create unique property symbol for SPEC in BUFFER + (let ((local-prop (or (gethash (cons buf spec) org-fold-core--property-symbol-cache) + (puthash (cons buf spec) + (org-fold-core-get-folding-property-symbol + spec buf + (org-fold-core-get-folding-spec-property spec :global)) + org-fold-core--property-symbol-cache)))) + (prog1 + local-prop + (unless return-only + (with-current-buffer buf + ;; Update folding properties carried over from other + ;; buffer (implying that current buffer is indirect + ;; buffer). Normally, `char-property-alias-alist' in new + ;; indirect buffer is a copy of the same variable from + ;; the base buffer. Then, `char-property-alias-alist' + ;; would contain folding properties, which are not + ;; matching the generated `local-prop'. + (unless (member local-prop (cdr (assq 'invisible char-property-alias-alist))) + ;; Add current buffer to the list of indirect buffers in the base buffer. + (when (buffer-base-buffer) + (with-current-buffer (buffer-base-buffer) + (setq-local org-fold-core--indirect-buffers + (let (bufs) + (org-fold-core-cycle-over-indirect-buffers + (push (current-buffer) bufs)) + (push buf bufs) + (delete-dups bufs))))) + ;; Copy all the old folding properties to preserve the folding state + (with-silent-modifications + (dolist (old-prop (cdr (assq 'invisible char-property-alias-alist))) + (org-with-wide-buffer + (let* ((pos (point-min)) + (spec (org-fold-core-get-folding-spec-from-folding-prop old-prop)) + ;; Generate new buffer-unique folding property + (new-prop (when spec (org-fold-core--property-symbol-get-create spec nil 'return-only)))) + ;; Copy the visibility state for `spec' from `old-prop' to `new-prop' + (unless (eq old-prop new-prop) + (while (< pos (point-max)) + (let ((val (get-text-property pos old-prop)) + (next (next-single-char-property-change pos old-prop))) + (when val + (put-text-property pos next new-prop val)) + (setq pos next))))))) + ;; Update `char-property-alias-alist' with folding + ;; properties unique for the current buffer. + (setq-local char-property-alias-alist + (cons (cons 'invisible + (mapcar (lambda (spec) + (org-fold-core--property-symbol-get-create spec nil 'return-only)) + (org-fold-core-folding-spec-list))) + (remove (assq 'invisible char-property-alias-alist) + char-property-alias-alist))) + ;; Set folding property stickyness according to + ;; their `:font-sticky' and `:rear-sticky' + ;; parameters. + (let (full-prop-list) + (org-fold-core-cycle-over-indirect-buffers + (setq full-prop-list + (append full-prop-list + (delq nil + (mapcar (lambda (spec) + (cond + ((org-fold-core-get-folding-spec-property spec :front-sticky) + (cons (org-fold-core--property-symbol-get-create spec nil 'return-only) + nil)) + ((org-fold-core-get-folding-spec-property spec :rear-sticky) + nil) + (t + (cons (org-fold-core--property-symbol-get-create spec nil 'return-only) + t)))) + (org-fold-core-folding-spec-list)))))) + (org-fold-core-cycle-over-indirect-buffers + (setq-local text-property-default-nonsticky + (delete-dups (append + text-property-default-nonsticky + full-prop-list)))))))))))))) + +(defun org-fold-core-decouple-indirect-buffer-folds () + "Copy and decouple folding state in a newly created indirect buffer. +This function is mostly indented to be used in `clone-indirect-buffer-hook'." + (when (and (buffer-base-buffer) + (eq org-fold-core-style 'text-properties)) + (org-fold-core--property-symbol-get-create (car (org-fold-core-folding-spec-list))))) + +;;; API + +;;;; Modifying folding specs + +(defun org-fold-core-set-folding-spec-property (spec property value &optional force) + "Set PROPERTY of a folding SPEC to VALUE. +Possible properties and values can be found in `org-fold-core--specs' docstring. +Do not check previous value when FORCE is non-nil." + (pcase property + (:ellipsis + (unless (and (not force) (equal value (org-fold-core-get-folding-spec-property spec :ellipsis))) + (remove-from-invisibility-spec (cons spec (org-fold-core-get-folding-spec-property spec :ellipsis))) + (unless (org-fold-core-get-folding-spec-property spec :visible) + (add-to-invisibility-spec (cons spec value))))) + (:visible + (unless (or (memql 'merge-folds org-fold-core--optimise-for-huge-buffers) + (and (not force) (equal value (org-fold-core-get-folding-spec-property spec :visible)))) + (if value + (remove-from-invisibility-spec (cons spec (org-fold-core-get-folding-spec-property spec :ellipsis))) + (add-to-invisibility-spec (cons spec (org-fold-core-get-folding-spec-property spec :ellipsis)))))) + (:alias + ;; Clear symbol cache. + (setq org-fold-core--spec-symbols nil)) + (:isearch-open nil) + (:isearch-ignore nil) + (:front-sticky nil) + (:rear-sticky nil) + (_ nil)) + (setf (cdr (assq property (assq spec org-fold-core--specs))) value)) + +(defun org-fold-core-add-folding-spec (spec &optional properties buffer append) + "Add a new folding SPEC with PROPERTIES in BUFFER. + +SPEC must be a symbol. BUFFER can be a buffer to set SPEC in or nil to +set SPEC in current buffer. + +By default, the added SPEC will have highest priority among the +previously defined specs. When optional APPEND argument is non-nil, +SPEC will have the lowest priority instead. If SPEC was already +defined earlier, it will be redefined according to provided optional +arguments. +` +The folding spec properties will be set to PROPERTIES (see +`org-fold-core--specs' for details)." + (when (eq spec 'all) (error "Cannot use reserved folding spec symbol 'all")) + (with-current-buffer (or buffer (current-buffer)) + ;; Clear the cache. + (setq org-fold-core--spec-list nil + org-fold-core--spec-symbols nil) + (let* ((full-properties (mapcar (lambda (prop) (cons prop (cdr (assq prop properties)))) + '( :visible :ellipsis :isearch-ignore + :global :isearch-open :front-sticky + :rear-sticky :fragile :alias + :font-lock-skip))) + (full-spec (cons spec full-properties))) + (add-to-list 'org-fold-core--specs full-spec append) + (mapc (lambda (prop-cons) (org-fold-core-set-folding-spec-property spec (car prop-cons) (cdr prop-cons) 'force)) full-properties) + ;; Update buffer inivisibility specs. + (org-fold-core--property-symbol-get-create spec)))) + +(defun org-fold-core-remove-folding-spec (spec &optional buffer) + "Remove a folding SPEC in BUFFER. + +SPEC must be a symbol. + +BUFFER can be a buffer to remove SPEC in, nil to remove SPEC in current +buffer, or 'all to remove SPEC in all open `org-mode' buffers and all +future org buffers." + (org-fold-core--check-spec spec) + (when (eq buffer 'all) + (setq-default org-fold-core--specs (delete (cdr (assq spec org-fold-core--specs)) org-fold-core--specs)) + (mapc (lambda (buf) + (org-fold-core-remove-folding-spec spec buf)) + (buffer-list))) + (let ((buffer (or buffer (current-buffer)))) + (with-current-buffer buffer + ;; Clear the cache. + (setq org-fold-core--spec-list nil + org-fold-core--spec-symbols nil) + (org-fold-core-set-folding-spec-property spec :visible t) + (setq org-fold-core--specs (delete (cdr (assq spec org-fold-core--specs)) org-fold-core--specs))))) + +(defun org-fold-core-initialize (&optional specs) + "Setup folding in current buffer using SPECS as value of `org-fold-core--specs'." + ;; Preserve the priorities. + (when specs (setq specs (nreverse specs))) + (unless specs (setq specs org-fold-core--specs)) + (setq org-fold-core--specs nil + org-fold-core--spec-list nil + org-fold-core--spec-symbols nil) + (dolist (spec specs) + (org-fold-core-add-folding-spec (car spec) (cdr spec))) + (add-hook 'after-change-functions 'org-fold-core--fix-folded-region nil 'local) + (add-hook 'clone-indirect-buffer-hook #'org-fold-core-decouple-indirect-buffer-folds nil 'local) + ;; Optimise buffer fontification to not fontify folded text. + (when (eq font-lock-fontify-region-function #'font-lock-default-fontify-region) + (setq-local font-lock-fontify-region-function 'org-fold-core-fontify-region)) + ;; Setup killing text + (setq-local filter-buffer-substring-function #'org-fold-core--buffer-substring-filter) + (if (and (boundp 'isearch-opened-regions) + (eq org-fold-core-style 'text-properties)) + ;; Use new implementation of isearch allowing to search inside text + ;; hidden via text properties. + (org-fold-core--isearch-setup 'text-properties) + (org-fold-core--isearch-setup 'overlays))) + +;;;; Searching and examining folded text + +(defsubst org-fold-core-folded-p (&optional pos spec-or-alias) + "Non-nil if the character after POS is folded. +If POS is nil, use `point' instead. +If SPEC-OR-ALIAS is a folding spec, only check the given folding spec." + (org-fold-core-get-folding-spec spec-or-alias pos)) + +(defun org-fold-core-region-folded-p (beg end &optional spec-or-alias) + "Non-nil if the region between BEG and END is folded. +If SPEC-OR-ALIAS is a folding spec, only check the given folding spec." + (org-with-point-at beg + (catch :visible + (while (< (point) end) + (unless (org-fold-core-get-folding-spec spec-or-alias) (throw :visible nil)) + (goto-char (org-fold-core-next-folding-state-change spec-or-alias nil end))) + t))) + +(defun org-fold-core-get-folding-spec (&optional spec-or-alias pom) + "Get folding state at `point' or POM. +Return nil if there is no folding at point or POM. +If SPEC-OR-ALIAS is nil, return a folding spec with highest priority +among present at `point' or POM. +If SPEC-OR-ALIAS is 'all, return the list of all present folding +specs. +If SPEC-OR-ALIAS is a valid folding spec or a spec alias, return the +corresponding folding spec (if the text is folded using that spec)." + (let ((spec (if (eq spec-or-alias 'all) + 'all + (org-fold-core-get-folding-spec-from-alias spec-or-alias)))) + (when (and spec (not (eq spec 'all))) (org-fold-core--check-spec spec)) + (org-with-point-at pom + (cond + ((eq spec 'all) + (let ((result)) + (dolist (spec (org-fold-core-folding-spec-list)) + (let ((val (get-char-property (point) (org-fold-core--property-symbol-get-create spec nil t)))) + (when val (push val result)))) + (reverse result))) + ((null spec) + (let ((result (get-char-property (point) 'invisible))) + (when (org-fold-core-folding-spec-p result) result))) + (t (get-char-property (point) (org-fold-core--property-symbol-get-create spec nil t))))))) + +(defun org-fold-core-get-folding-specs-in-region (beg end) + "Get all folding specs in region from BEG to END." + (let ((pos beg) + all-specs) + (while (< pos end) + (setq all-specs (append all-specs (org-fold-core-get-folding-spec nil pos))) + (setq pos (org-fold-core-next-folding-state-change nil pos end))) + (unless (listp all-specs) (setq all-specs (list all-specs))) + (delete-dups all-specs))) + +(defun org-fold-core-get-region-at-point (&optional spec-or-alias pom) + "Return region folded using SPEC-OR-ALIAS at POM. +If SPEC is nil, return the largest possible folded region. +The return value is a cons of beginning and the end of the region. +Return nil when no fold is present at point of POM." + (let ((spec (org-fold-core-get-folding-spec-from-alias spec-or-alias))) + (org-with-point-at (or pom (point)) + (if spec + (if (eq org-fold-core-style 'text-properties) + (org-find-text-property-region (point) (org-fold-core--property-symbol-get-create spec nil t)) + (let ((ov (cdr (get-char-property-and-overlay (point) (org-fold-core--property-symbol-get-create spec nil t))))) + (when ov (cons (overlay-start ov) (overlay-end ov))))) + (let ((region (cons (point) (point)))) + (dolist (spec (org-fold-core-get-folding-spec 'all)) + (let ((local-region (org-fold-core-get-region-at-point spec))) + (when (< (car local-region) (car region)) + (setcar region (car local-region))) + (when (> (cdr local-region) (cdr region)) + (setcdr region (cdr local-region))))) + (unless (eq (car region) (cdr region)) region)))))) + +(defun org-fold-core-next-visibility-change (&optional pos limit ignore-hidden-p previous-p) + "Return next point from POS up to LIMIT where text becomes visible/invisible. +By default, text hidden by any means (i.e. not only by folding, but +also via fontification) will be considered. +If IGNORE-HIDDEN-P is non-nil, consider only folded text. +If PREVIOUS-P is non-nil, search backwards." + (let* ((pos (or pos (point))) + (invisible-p (if ignore-hidden-p + #'org-fold-core-folded-p + #'invisible-p)) + (invisible-initially? (funcall invisible-p pos)) + (limit (or limit (if previous-p + (point-min) + (point-max)))) + (cmp (if previous-p #'> #'<)) + (next-change (if previous-p + (if ignore-hidden-p + (lambda (p) (org-fold-core-previous-folding-state-change (org-fold-core-get-folding-spec nil p) p limit)) + (lambda (p) (max limit (1- (previous-single-char-property-change p 'invisible nil limit))))) + (if ignore-hidden-p + (lambda (p) (org-fold-core-next-folding-state-change (org-fold-core-get-folding-spec nil p) p limit)) + (lambda (p) (next-single-char-property-change p 'invisible nil limit))))) + (next pos)) + (while (and (funcall cmp next limit) + (not (org-xor invisible-initially? (funcall invisible-p next)))) + (setq next (funcall next-change next))) + next)) + +(defun org-fold-core-previous-visibility-change (&optional pos limit ignore-hidden-p) + "Call `org-fold-core-next-visibility-change' searching backwards." + (org-fold-core-next-visibility-change pos limit ignore-hidden-p 'previous)) + +(defun org-fold-core-next-folding-state-change (&optional spec-or-alias pos limit previous-p) + "Return point after POS where folding state changes up to LIMIT. +If SPEC-OR-ALIAS is nil, return next point where _any_ single folding +spec changes. +For example, (org-fold-core-next-folding-state-change nil) with point +somewhere in the below structure will return the nearest <...> point. + +* Headline <begin outline fold> +:PROPERTIES:<begin drawer fold> +:ID: test +:END:<end drawer fold> + +Fusce suscipit, wisi nec facilisis facilisis, est dui fermentum leo, +quis tempor ligula erat quis odio. + +** Another headline +:DRAWER:<begin drawer fold> +:END:<end drawer fold> +** Yet another headline +<end of outline fold> + +If SPEC-OR-ALIAS is a folding spec symbol, only consider that folding +spec. + +If SPEC-OR-ALIAS is a list, only consider changes of folding specs +from the list. + +Search backwards when PREVIOUS-P is non-nil." + (when (and spec-or-alias (symbolp spec-or-alias)) + (setq spec-or-alias (list spec-or-alias))) + (when spec-or-alias + (setq spec-or-alias + (mapcar (lambda (spec-or-alias) + (or (org-fold-core-get-folding-spec-from-alias spec-or-alias) + spec-or-alias)) + spec-or-alias)) + (mapc #'org-fold-core--check-spec spec-or-alias)) + (unless spec-or-alias + (setq spec-or-alias (org-fold-core-folding-spec-list))) + (setq pos (or pos (point))) + (apply (if previous-p + #'max + #'min) + (mapcar (if previous-p + (lambda (prop) (max (or limit (point-min)) (previous-single-property-change pos prop nil (or limit (point-min))))) + (lambda (prop) (next-single-property-change pos prop nil (or limit (point-max))))) + (mapcar (lambda (el) (org-fold-core--property-symbol-get-create el nil t)) + spec-or-alias)))) + +(defun org-fold-core-previous-folding-state-change (&optional spec-or-alias pos limit) + "Call `org-fold-core-next-folding-state-change' searching backwards." + (org-fold-core-next-folding-state-change spec-or-alias pos limit 'previous)) + +(defun org-fold-core-search-forward (spec-or-alias &optional limit) + "Search next region folded via folding SPEC-OR-ALIAS up to LIMIT. +Move point right after the end of the region, to LIMIT, or +`point-max'. The `match-data' will contain the region." + (let ((spec (org-fold-core-get-folding-spec-from-alias spec-or-alias))) + (let ((prop-symbol (org-fold-core--property-symbol-get-create spec nil t))) + (goto-char (or (next-single-char-property-change (point) prop-symbol nil limit) limit (point-max))) + (when (and (< (point) (or limit (point-max))) + (not (org-fold-core-get-folding-spec spec))) + (goto-char (next-single-char-property-change (point) prop-symbol nil limit))) + (when (org-fold-core-get-folding-spec spec) + (let ((region (org-fold-core-get-region-at-point spec))) + (when (< (cdr region) (or limit (point-max))) + (goto-char (1+ (cdr region))) + (set-match-data (list (set-marker (make-marker) (car region) (current-buffer)) + (set-marker (make-marker) (cdr region) (current-buffer)))))))))) + +;;;; Changing visibility + +;;;;; Region visibility + +(defvar org-fold-core--fontifying nil + "Flag used to avoid font-lock recursion.") + +;; This is the core function performing actual folding/unfolding. The +;; folding state is stored in text property (folding property) +;; returned by `org-fold-core--property-symbol-get-create'. The value of the +;; folding property is folding spec symbol. +(defun org-fold-core-region (from to flag &optional spec-or-alias) + "Hide or show lines from FROM to TO, according to FLAG. +SPEC-OR-ALIAS is the folding spec or foldable element, as a symbol. +If SPEC-OR-ALIAS is omitted and FLAG is nil, unfold everything in the region." + (let ((spec (org-fold-core-get-folding-spec-from-alias spec-or-alias))) + (when spec (org-fold-core--check-spec spec)) + (with-silent-modifications + (org-with-wide-buffer + (when (eq org-fold-core-style 'overlays) (remove-overlays from to 'invisible spec)) + (if flag + (if (not spec) + (error "Calling `org-fold-core-region' with missing SPEC") + (if (eq org-fold-core-style 'overlays) + ;; Use `front-advance' since text right before to the beginning of + ;; the overlay belongs to the visible line than to the contents. + (let ((o (make-overlay from to nil + (org-fold-core-get-folding-spec-property spec :front-sticky) + (org-fold-core-get-folding-spec-property spec :rear-sticky)))) + (overlay-put o 'evaporate t) + (overlay-put o (org-fold-core--property-symbol-get-create spec) spec) + (overlay-put o 'invisible spec) + (overlay-put o 'isearch-open-invisible #'org-fold-core--isearch-show) + (overlay-put o 'isearch-open-invisible-temporary #'org-fold-core--isearch-show-temporary)) + (put-text-property from to (org-fold-core--property-symbol-get-create spec) spec) + (put-text-property from to 'isearch-open-invisible #'org-fold-core--isearch-show) + (put-text-property from to 'isearch-open-invisible-temporary #'org-fold-core--isearch-show-temporary) + (when (memql 'grab-invisible org-fold-core--optimise-for-huge-buffers) + ;; If the SPEC has highest priority, assign it directly + ;; to 'invisible property as well. This is done to speed + ;; up Emacs redisplay on huge (Mbs) folded regions where + ;; we don't even want Emacs to spend time cycling over + ;; `char-property-alias-alist'. + (when (eq spec (caar org-fold-core--specs)) (put-text-property from to 'invisible spec))))) + (if (not spec) + (mapc (lambda (spec) (org-fold-core-region from to nil spec)) (org-fold-core-folding-spec-list)) + (when (and (memql 'grab-invisible org-fold-core--optimise-for-huge-buffers) + (eq org-fold-core-style 'text-properties)) + (when (eq spec (caar org-fold-core--specs)) + (let ((pos from)) + (while (< pos to) + (if (eq spec (get-text-property pos 'invisible)) + (let ((next (org-fold-core-next-folding-state-change spec pos to))) + (remove-text-properties pos next '(invisible t)) + (setq pos next)) + (setq pos (next-single-char-property-change pos 'invisible nil to))))))) + (when (eq org-fold-core-style 'text-properties) + (remove-text-properties from to (list (org-fold-core--property-symbol-get-create spec) nil))) + ;; Fontify unfolded text. + (unless (or (not font-lock-mode) + org-fold-core--fontifying + (not (org-fold-core-get-folding-spec-property spec :font-lock-skip)) + (not (text-property-not-all from to 'org-fold-core-fontified t))) + (let ((org-fold-core--fontifying t)) + (if jit-lock-mode + (jit-lock-refontify from to) + (save-match-data (font-lock-fontify-region from to))))))))))) + +;;; Make isearch search in some text hidden via text propertoes + +(defvar org-fold-core--isearch-overlays nil + "List of overlays temporarily created during isearch. +This is used to allow searching in regions hidden via text properties. +As for [2020-05-09 Sat], Isearch only has special handling of hidden overlays. +Any text hidden via text properties is not revealed even if `search-invisible' +is set to 't.") + +(defvar-local org-fold-core--isearch-local-regions (make-hash-table :test 'equal) + "Hash table storing temporarily shown folds from isearch matches.") + +(defun org-fold-core--isearch-setup (type) + "Initialize isearch in org buffer. +TYPE can be either `text-properties' or `overlays'." + (pcase type + (`text-properties + (setq-local search-invisible 'open-all) + (add-hook 'isearch-mode-end-hook #'org-fold-core--clear-isearch-state nil 'local) + (add-hook 'isearch-mode-hook #'org-fold-core--clear-isearch-state nil 'local) + (setq-local isearch-filter-predicate #'org-fold-core--isearch-filter-predicate-text-properties)) + (`overlays + (when (eq org-fold-core-style 'text-properties) + (setq-local isearch-filter-predicate #'org-fold-core--isearch-filter-predicate-overlays) + (add-hook 'isearch-mode-end-hook #'org-fold-core--clear-isearch-overlays nil 'local))) + (_ (error "%s: Unknown type of setup for `org-fold-core--isearch-setup'" type)))) + +(defun org-fold-core--isearch-reveal (pos) + "Default function used to reveal hidden text at POS for isearch." + (let ((region (org-fold-core-get-region-at-point pos))) + (org-fold-core-region (car region) (cdr region) nil))) + +(defun org-fold-core--isearch-filter-predicate-text-properties (beg end) + "Make sure that folded text is searchable when user whant so. +This function is intended to be used as `isearch-filter-predicate'." + (and + ;; Check folding specs that cannot be searched + (not (memq nil (mapcar (lambda (spec) (not (org-fold-core-get-folding-spec-property spec :isearch-ignore))) + (org-fold-core-get-folding-specs-in-region beg end)))) + ;; Check 'invisible properties that are not folding specs. + (or (eq search-invisible t) ; User wants to search anyway, allow it. + (let ((pos beg) + unknown-invisible-property) + (while (and (< pos end) + (not unknown-invisible-property)) + (when (and (get-text-property pos 'invisible) + (not (org-fold-core-folding-spec-p (get-text-property pos 'invisible)))) + (setq unknown-invisible-property t)) + (setq pos (next-single-char-property-change pos 'invisible))) + (not unknown-invisible-property))) + (or (and (eq search-invisible t) + ;; FIXME: this opens regions permanenly for now. + ;; I also tried to force search-invisible 'open-all around + ;; `isearch-range-invisible', but that somehow causes + ;; infinite loop in `isearch-lazy-highlight'. + (prog1 t + ;; We still need to reveal the folded location + (org-fold-core--isearch-show-temporary (cons beg end) nil))) + (not (isearch-range-invisible beg end))))) + +(defun org-fold-core--clear-isearch-state () + "Clear `org-fold-core--isearch-local-regions'." + (clrhash org-fold-core--isearch-local-regions)) + +(defun org-fold-core--isearch-show (region) + "Reveal text in REGION found by isearch." + (org-with-point-at (car region) + (while (< (point) (cdr region)) + (funcall org-fold-core-isearch-open-function (car region)) + (goto-char (org-fold-core-next-visibility-change (point) (cdr region) 'ignore-hidden))))) + +(defun org-fold-core--isearch-show-temporary (region hide-p) + "Temporarily reveal text in REGION. +Hide text instead if HIDE-P is non-nil." + (if (not hide-p) + (let ((pos (car region))) + (while (< pos (cdr region)) + (let ((spec-no-open + (catch :found + (dolist (spec (org-fold-core-get-folding-spec 'all pos)) + (unless (org-fold-core-get-folding-spec-property spec :isearch-open) + (throw :found spec)))))) + (if spec-no-open + ;; Skip regions folded with folding specs that cannot be opened. + (setq pos (org-fold-core-next-folding-state-change spec-no-open pos (cdr region))) + (dolist (spec (org-fold-core-get-folding-spec 'all pos)) + (push (cons spec (org-fold-core-get-region-at-point spec pos)) (gethash region org-fold-core--isearch-local-regions))) + (org-fold-core--isearch-show region) + (setq pos (org-fold-core-next-folding-state-change nil pos (cdr region))))))) + (mapc (lambda (val) (org-fold-core-region (cadr val) (cddr val) t (car val))) (gethash region org-fold-core--isearch-local-regions)) + (remhash region org-fold-core--isearch-local-regions))) + +(defvar-local org-fold-core--isearch-special-specs nil + "List of specs that can break visibility state when converted to overlays. +This is a hack, but I do not see a better way around until isearch +gets support of text properties.") +(defun org-fold-core--create-isearch-overlays (beg end) + "Replace text property invisibility spec by overlays between BEG and END. +All the searcheable folded regions will be changed to use overlays +instead of text properties. The created overlays will be stored in +`org-fold-core--isearch-overlays'." + (let ((pos beg)) + (while (< pos end) + ;; We need loop below to make sure that we clean all invisible + ;; properties, which may be nested. + (dolist (spec (org-fold-core-get-folding-spec 'all pos)) + (unless (org-fold-core-get-folding-spec-property spec :isearch-ignore) + (let* ((region (org-fold-core-get-region-at-point spec pos))) + (when (memq spec org-fold-core--isearch-special-specs) + (setq pos (min pos (car region))) + (setq end (max end (cdr region)))) + ;; Changing text properties is considered buffer modification. + ;; We do not want it here. + (with-silent-modifications + (org-fold-core-region (car region) (cdr region) nil spec) + ;; The overlay is modelled after `outline-flag-region' + ;; [2020-05-09 Sat] overlay for 'outline blocks. + (let ((o (make-overlay (car region) (cdr region) nil 'front-advance))) + (overlay-put o 'evaporate t) + (overlay-put o 'invisible spec) + (overlay-put o 'org-invisible spec) + ;; Make sure that overlays are applied in the same order + ;; with the folding specs. + ;; Note: `memq` returns cdr with car equal to the first + ;; found matching element. + (overlay-put o 'priority (length (memq spec (org-fold-core-folding-spec-list)))) + ;; `delete-overlay' here means that spec information will be lost + ;; for the region. The region will remain visible. + (if (org-fold-core-get-folding-spec-property spec :isearch-open) + (overlay-put o 'isearch-open-invisible #'delete-overlay) + (overlay-put o 'isearch-open-invisible #'ignore) + (overlay-put o 'isearch-open-invisible-temporary #'ignore)) + (push o org-fold-core--isearch-overlays)))))) + (setq pos (org-fold-core-next-folding-state-change nil pos end))))) + +(defun org-fold-core--isearch-filter-predicate-overlays (beg end) + "Return non-nil if text between BEG and END is deemed visible by isearch. +This function is intended to be used as `isearch-filter-predicate'." + (org-fold-core--create-isearch-overlays beg end) ;; trick isearch by creating overlays in place of invisible text + (isearch-filter-visible beg end)) + +(defun org-fold-core--clear-isearch-overlay (ov) + "Convert OV region back into using text properties." + (let ((spec (if isearch-mode-end-hook-quit + ;; Restore all folds. + (overlay-get ov 'org-invisible) + ;; Leave opened folds open. + (overlay-get ov 'invisible)))) + ;; Ignore deleted overlays. + (when (and spec + (overlay-buffer ov)) + ;; Changing text properties is considered buffer modification. + ;; We do not want it here. + (with-silent-modifications + (when (<= (overlay-end ov) (point-max)) + (org-fold-core-region (overlay-start ov) (overlay-end ov) t spec))))) + (when (member ov isearch-opened-overlays) + (setq isearch-opened-overlays (delete ov isearch-opened-overlays))) + (delete-overlay ov)) + +(defun org-fold-core--clear-isearch-overlays () + "Convert overlays from `org-fold-core--isearch-overlays' back to text properties." + (when org-fold-core--isearch-overlays + (mapc #'org-fold-core--clear-isearch-overlay org-fold-core--isearch-overlays) + (setq org-fold-core--isearch-overlays nil))) + +;;; Handling changes in folded elements + +(defvar org-fold-core--ignore-modifications nil + "Non-nil: skip processing modifications in `org-fold-core--fix-folded-region'.") +(defvar org-fold-core--ignore-fragility-checks nil + "Non-nil: skip fragility checks in `org-fold-core--fix-folded-region'.") + +(defmacro org-fold-core-ignore-modifications (&rest body) + "Run BODY ignoring buffer modifications in `org-fold-core--fix-folded-region'." + (declare (debug (form body)) (indent 1)) + `(let ((org-fold-core--ignore-modifications t)) + (unwind-protect (progn ,@body) + (setq org-fold-core--last-buffer-chars-modified-tick (buffer-chars-modified-tick))))) + +(defmacro org-fold-core-ignore-fragility-checks (&rest body) + "Run BODY skipping :fragility checks in `org-fold-core--fix-folded-region'." + (declare (debug (form body)) (indent 1)) + `(let ((org-fold-core--ignore-fragility-checks t)) + (progn ,@body))) + +(defvar-local org-fold-core--last-buffer-chars-modified-tick nil + "Variable storing the last return value of `buffer-chars-modified-tick'.") + +(defun org-fold-core--fix-folded-region (from to _) + "Process modifications in folded elements within FROM . TO region. +This function intended to be used as one of `after-change-functions'. + +This function does nothing if text the only modification was changing +text properties (for the sake of reducing overheads). + +If a text was inserted into invisible region, hide the inserted text. +If a text was inserted in front/back of the region, hide it according +to :font-sticky/:rear-sticky folding spec property. + +If the folded region is folded with a spec with non-nil :fragile +property, unfold the region if the :fragile function returns non-nil." + ;; If no insertions or deletions in buffer, skip all the checks. + (unless (or (eq org-fold-core--last-buffer-chars-modified-tick (buffer-chars-modified-tick)) + org-fold-core--ignore-modifications + (memql 'ignore-modification-checks org-fold-core--optimise-for-huge-buffers)) + ;; Store the new buffer modification state. + (setq org-fold-core--last-buffer-chars-modified-tick (buffer-chars-modified-tick)) + (save-match-data + ;; Handle changes in all the indirect buffers and in the base + ;; buffer. Work around Emacs bug#46982. + (when (eq org-fold-core-style 'text-properties) + (org-fold-core-cycle-over-indirect-buffers + ;; Re-hide text inserted in the middle/font/back of a folded + ;; region. + (unless (equal from to) ; Ignore deletions. + (dolist (spec (org-fold-core-folding-spec-list)) + ;; Reveal fully invisible text inserted in the middle + ;; of visible portion of the buffer. This is needed, + ;; for example, when there was a deletion in a folded + ;; heading, the heading was unfolded, end `undo' was + ;; called. The `undo' would insert the folded text. + (when (and (or (eq from (point-min)) + (not (org-fold-core-folded-p (1- from) spec))) + (or (eq to (point-max)) + (not (org-fold-core-folded-p to spec))) + (org-fold-core-region-folded-p from to spec)) + (org-fold-core-region from to nil spec)) + ;; Look around and fold the new text if the nearby folds are + ;; sticky. + (unless (org-fold-core-region-folded-p from to spec) + (let ((spec-to (org-fold-core-get-folding-spec spec (min to (1- (point-max))))) + (spec-from (org-fold-core-get-folding-spec spec (max (point-min) (1- from))))) + ;; Reveal folds around undoed deletion. + (when undo-in-progress + (let ((lregion (org-fold-core-get-region-at-point spec (max (point-min) (1- from)))) + (rregion (org-fold-core-get-region-at-point spec (min to (1- (point-max)))))) + (if (and lregion rregion) + (org-fold-core-region (car lregion) (cdr rregion) nil spec) + (when lregion + (org-fold-core-region (car lregion) (cdr lregion) nil spec)) + (when rregion + (org-fold-core-region (car rregion) (cdr rregion) nil spec))))) + ;; Hide text inserted in the middle of a fold. + (when (and (or spec-from (eq from (point-min))) + (or spec-to (eq to (point-max))) + (or spec-from spec-to) + (eq spec-to spec-from) + (or (org-fold-core-get-folding-spec-property spec :front-sticky) + (org-fold-core-get-folding-spec-property spec :rear-sticky))) + (unless (and (eq from (point-min)) (eq to (point-max))) ; Buffer content replaced. + (org-fold-core-region from to t (or spec-from spec-to)))) + ;; Hide text inserted at the end of a fold. + (when (and spec-from (org-fold-core-get-folding-spec-property spec-from :rear-sticky)) + (org-fold-core-region from to t spec-from)) + ;; Hide text inserted in front of a fold. + (when (and spec-to + (not (eq to (point-max))) ; Text inserted at the end of buffer is not prepended anywhere. + (org-fold-core-get-folding-spec-property spec-to :front-sticky)) + (org-fold-core-region from to t spec-to)))))))) + ;; Process all the folded text between `from' and `to'. Do it + ;; only in current buffer to avoid verifying semantic structure + ;; multiple times in indirect buffers that have exactly same + ;; text anyway. + (unless (or org-fold-core--ignore-fragility-checks + (memql 'ignore-fragility-checks org-fold-core--optimise-for-huge-buffers)) + (dolist (func org-fold-core-extend-changed-region-functions) + (let ((new-region (funcall func from to))) + (setq from (car new-region)) + (setq to (cdr new-region)))) + (dolist (spec (org-fold-core-folding-spec-list)) + ;; No action is needed when :fragile is nil for the spec. + (when (org-fold-core-get-folding-spec-property spec :fragile) + (org-with-wide-buffer + ;; Expand the considered region to include partially present fold. + ;; Note: It is important to do this inside loop over all + ;; specs. Otherwise, the region may be expanded to huge + ;; outline fold, potentially involving majority of the + ;; buffer. That would cause the below code to loop over + ;; almost all the folds in buffer, which would be too slow. + (let ((local-from from) + (local-to to) + (region-from (org-fold-core-get-region-at-point spec (max (point-min) (1- from)))) + (region-to (org-fold-core-get-region-at-point spec (min to (1- (point-max)))))) + (when region-from (setq local-from (car region-from))) + (when region-to (setq local-to (cdr region-to))) + (let ((pos local-from)) + ;; Move to the first hidden region. + (unless (org-fold-core-get-folding-spec spec pos) + (setq pos (org-fold-core-next-folding-state-change spec pos local-to))) + ;; Cycle over all the folds. + (while (< pos local-to) + (save-match-data ; we should not clobber match-data in after-change-functions + (let ((fold-begin (and (org-fold-core-get-folding-spec spec pos) + pos)) + (fold-end (org-fold-core-next-folding-state-change spec pos local-to))) + (when (and fold-begin fold-end) + (when (save-excursion + (funcall (org-fold-core-get-folding-spec-property spec :fragile) + (cons fold-begin fold-end) + spec)) + ;; Reveal completely, not just from the SPEC. + (org-fold-core-region fold-begin fold-end nil))))) + ;; Move to next fold. + (setq pos (org-fold-core-next-folding-state-change spec pos local-to)))))))))))) + +;;; Hanlding killing/yanking of folded text + +;; Backward compatibility with Emacs 24. +(defun org-fold-core--seq-partition (list n) + "Return list of elements of LIST grouped into sub-sequences of length N. +The last list may contain less than N elements. If N is a +negative integer or 0, nil is returned." + (if (fboundp 'seq-partition) + (seq-partition list n) + (unless (< n 1) + (let ((result '())) + (while list + (let (part) + (dotimes (_ n) + (when list (push (car list) part))) + (push part result)) + (dotimes (_ n) + (setq list (cdr list)))) + (nreverse result))))) + +;; By default, all the text properties of the killed text are +;; preserved, including the folding text properties. This can be +;; awkward when we copy a text from an indirect buffer to another +;; indirect buffer (or the base buffer). The copied text might be +;; visible in the source buffer, but might disappear if we yank it in +;; another buffer. This happens in the following situation: +;; ---- base buffer ---- +;; * Headline<begin fold> +;; Some text hidden in the base buffer, but revealed in the indirect +;; buffer.<end fold> +;; * Another headline +;; +;; ---- end of base buffer ---- +;; ---- indirect buffer ---- +;; * Headline +;; Some text hidden in the base buffer, but revealed in the indirect +;; buffer. +;; * Another headline +;; +;; ---- end of indirect buffer ---- +;; If we copy the text under "Headline" from the indirect buffer and +;; insert it under "Another headline" in the base buffer, the inserted +;; text will be hidden since it's folding text properties are copyed. +;; Basically, the copied text would have two sets of folding text +;; properties: (1) Properties for base buffer telling that the text is +;; hidden; (2) Properties for the indirect buffer telling that the +;; text is visible. The first set of the text properties in inactive +;; in the indirect buffer, but will become active once we yank the +;; text back into the base buffer. +;; +;; To avoid the above situation, we simply clear all the properties, +;; unrealated to current buffer when a text is copied. +;; FIXME: Ideally, we may want to carry the folding state of copied +;; text between buffer (probably via user customisation). +(defun org-fold-core--buffer-substring-filter (beg end &optional delete) + "Clear folding state in killed text. +This function is intended to be used as `filter-buffer-substring-function'. +The arguments and return value are as specified for `filter-buffer-substring'." + (let ((return-string (buffer-substring--filter beg end delete)) + ;; The list will be used as an argument to `remove-text-properties'. + props-list) + ;; There is no easy way to examine all the text properties of a + ;; string, so we utilise the fact that printed string + ;; representation lists all its properties. + ;; Loop over the elements of string representation. + (unless (or (string= "" return-string) + (<= end beg) + (eq org-fold-core-style 'overlays)) + ;; Collect all the text properties the string is completely + ;; hidden with. + (dolist (spec (org-fold-core-folding-spec-list)) + (when (and (org-fold-core-region-folded-p beg end spec) + (org-region-invisible-p beg end)) + (push (org-fold-core--property-symbol-get-create spec nil t) props-list))) + (dolist (plist + (if (fboundp 'object-intervals) + (object-intervals return-string) + ;; Backward compatibility with Emacs <28. + ;; FIXME: Is there any better way to do it? + ;; Yes, it is a hack. + ;; The below gives us string representation as a list. + ;; Note that we need to remove unreadable values, like markers (#<...>). + (org-fold-core--seq-partition + (cdr (let ((data (read (replace-regexp-in-string + "^#(" "(" + (replace-regexp-in-string + " #(" " (" + (replace-regexp-in-string + "#<[^>]+>" "dummy" + ;; Get text representation of the string object. + ;; Make sure to print everything (see `prin1' docstring). + ;; `prin1' is used to print "%S" format. + (let (print-level print-length) + (format "%S" return-string)))))))) + (if (listp data) data (list data)))) + 3))) + (let* ((start (car plist)) + (fin (cadr plist)) + (plist (car (cddr plist)))) + ;; Only lists contain text properties. + (when (listp plist) + ;; Collect all the relevant text properties. + (while plist + (let* ((prop (car plist)) + (prop-name (symbol-name prop))) + ;; Reveal hard-hidden text. See + ;; `org-fold-core--optimise-for-huge-buffers'. + (when (and (eq prop 'invisible) + (member (cadr plist) (org-fold-core-folding-spec-list))) + (remove-text-properties start fin '(invisible t) return-string)) + ;; We do not care about values now. + (setq plist (cddr plist)) + (when (string-match-p org-fold-core--spec-property-prefix prop-name) + ;; Leave folding specs from current buffer. See + ;; comments in `org-fold-core--property-symbol-get-create' to + ;; understand why it works. + (unless (member prop (cdr (assq 'invisible char-property-alias-alist))) + (push prop props-list)))))))) + (remove-text-properties 0 (length return-string) props-list return-string)) + return-string)) + +;;; Do not fontify folded text until needed. + +(defun org-fold-core-fontify-region (beg end loudly &optional force) + "Run `font-lock-default-fontify-region' in visible regions." + (let ((pos beg) next + (org-fold-core--fontifying t)) + (while (< pos end) + (setq next (org-fold-core-next-folding-state-change + (if force nil + (let (result) + (dolist (spec (org-fold-core-folding-spec-list)) + (when (and (not (org-fold-core-get-folding-spec-property spec :visible)) + (org-fold-core-get-folding-spec-property spec :font-lock-skip)) + (push spec result))) + result)) + pos + end)) + (while (and (not (catch :found + (dolist (spec (org-fold-core-get-folding-spec 'all next)) + (when (org-fold-core-get-folding-spec-property spec :font-lock-skip) + (throw :found spec))))) + (< next end)) + (setq next (org-fold-core-next-folding-state-change nil next end))) + (save-excursion + (font-lock-default-fontify-region pos next loudly) + (save-match-data + (unless (<= pos (point) next) + (run-hook-with-args 'org-fold-core-first-unfold-functions pos next)))) + (put-text-property pos next 'org-fold-core-fontified t) + (setq pos next)))) + +(defun org-fold-core-update-optimisation (beg end) + "Update huge buffer optimisation between BEG and END. +See `org-fold-core--optimise-for-huge-buffers'." + (when (and (memql 'grab-invisible org-fold-core--optimise-for-huge-buffers) + (eq org-fold-core-style 'text-properties)) + (let ((pos beg)) + (while (< pos end) + (when (and (org-fold-core-folded-p pos (caar org-fold-core--specs)) + (not (eq (caar org-fold-core--specs) (get-text-property pos 'invisible)))) + (put-text-property pos (org-fold-core-next-folding-state-change (caar org-fold-core--specs) pos end) + 'invisible (caar org-fold-core--specs))) + (setq pos (org-fold-core-next-folding-state-change (caar org-fold-core--specs) pos end)))))) + +(defun org-fold-core-remove-optimisation (beg end) + "Remove huge buffer optimisation between BEG and END. +See `org-fold-core--optimise-for-huge-buffers'." + (when (and (memql 'grab-invisible org-fold-core--optimise-for-huge-buffers) + (eq org-fold-core-style 'text-properties)) + (let ((pos beg)) + (while (< pos end) + (if (and (org-fold-core-folded-p pos (caar org-fold-core--specs)) + (eq (caar org-fold-core--specs) (get-text-property pos 'invisible))) + (remove-text-properties pos (org-fold-core-next-folding-state-change (caar org-fold-core--specs) pos end) + '(invisible t))) + (setq pos (org-fold-core-next-folding-state-change (caar org-fold-core--specs) pos end)))))) + +(provide 'org-fold-core) + +;;; org-fold-core.el ends here -- 2.35.1 -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH v2 02/38] Separate folding functions from org.el into new library: org-fold 2022-04-20 13:23 ` [PATCH v2 00/38] Final call for comments: " Ihor Radchenko 2022-04-20 13:23 ` [PATCH v2 01/38] Add org-fold-core: new folding engine--- Ihor Radchenko @ 2022-04-20 13:24 ` Ihor Radchenko 2022-04-20 13:24 ` [PATCH v2 03/38] Separate cycling functions from org.el into new library: org-cycle Ihor Radchenko ` (39 subsequent siblings) 41 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-04-20 13:24 UTC (permalink / raw) To: emacs-orgmode --- lisp/org-fold.el | 1135 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 1135 insertions(+) create mode 100644 lisp/org-fold.el diff --git a/lisp/org-fold.el b/lisp/org-fold.el new file mode 100644 index 000000000..52717fd86 --- /dev/null +++ b/lisp/org-fold.el @@ -0,0 +1,1135 @@ +;;; org-fold.el --- Folding of Org entries -*- lexical-binding: t; -*- +;; +;; Copyright (C) 2020-2020 Free Software Foundation, Inc. +;; +;; Author: Ihor Radchenko <yantar92 at gmail dot com> +;; Keywords: folding, invisible text +;; Homepage: https://orgmode.org +;; +;; This file is part of GNU Emacs. +;; +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Commentary: + +;; This file contains code handling temporary invisibility (folding +;; and unfolding) of text in org buffers. + +;; The folding is implemented using generic org-fold-core library. This file +;; contains org-specific implementation of the folding. Also, various +;; useful functions from org-fold-core are aliased under shorted `org-fold' +;; prefix. + +;; The following features are implemented: +;; - Folding/unfolding various Org mode elements and regions of Org buffers: +;; + Region before first heading; +;; + Org headings, their text, children (subtree), siblings, parents, etc; +;; + Org blocks and drawers +;; - Revealing Org structure around invisible point location +;; - Revealing folded Org elements broken by user edits + +;;; Code: + +(require 'org-macs) +(require 'org-fold-core) + +(defvar org-inlinetask-min-level) +(defvar org-link--link-folding-spec) +(defvar org-link--description-folding-spec) +(defvar org-odd-levels-only) +(defvar org-drawer-regexp) +(defvar org-property-end-re) +(defvar org-link-descriptive) +(defvar org-outline-regexp-bol) +(defvar org-custom-properties-hidden-p) +(defvar org-archive-tag) + +;; Needed for overlays only +(defvar org-custom-properties-overlays) + +(declare-function isearch-filter-visible "isearch" (beg end)) +(declare-function org-element-type "org-element" (element)) +(declare-function org-element-at-point "org-element" (&optional pom cached-only)) +(declare-function org-element-property "org-element" (property element)) +(declare-function org-element--current-element "org-element" (limit &optional granularity mode structure)) +(declare-function org-element--cache-active-p "org-element" ()) +(declare-function org-toggle-custom-properties-visibility "org" ()) +(declare-function org-item-re "org-list" ()) +(declare-function org-up-heading-safe "org" ()) +(declare-function org-get-tags "org" (&optional pos local fontify)) +(declare-function org-get-valid-level "org" (level &optional change)) +(declare-function org-before-first-heading-p "org" ()) +(declare-function org-goto-sibling "org" (&optional previous)) +(declare-function org-block-map "org" (function &optional start end)) +(declare-function org-map-region "org" (fun beg end)) +(declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading)) +(declare-function org-back-to-heading-or-point-min "org" (&optional invisible-ok)) +(declare-function org-back-to-heading "org" (&optional invisible-ok)) +(declare-function org-at-heading-p "org" (&optional invisible-not-ok)) +(declare-function org-cycle-hide-drawers "org-cycle" (state)) + +(declare-function outline-show-branches "outline" ()) +(declare-function outline-hide-sublevels "outline" (levels)) +(declare-function outline-get-next-sibling "outline" ()) +(declare-function outline-invisible-p "outline" (&optional pos)) +(declare-function outline-next-heading "outline" ()) + +;;; Customization + +(defgroup org-fold-reveal-location nil + "Options about how to make context of a location visible." + :tag "Org Reveal Location" + :group 'org-structure) + +(defcustom org-fold-show-context-detail '((agenda . local) + (bookmark-jump . lineage) + (isearch . lineage) + (default . ancestors)) + "Alist between context and visibility span when revealing a location. + +\\<org-mode-map>Some actions may move point into invisible +locations. As a consequence, Org always exposes a neighborhood +around point. How much is shown depends on the initial action, +or context. Valid contexts are + + agenda when exposing an entry from the agenda + org-goto when using the command `org-goto' (`\\[org-goto]') + occur-tree when using the command `org-occur' (`\\[org-sparse-tree] /') + tags-tree when constructing a sparse tree based on tags matches + link-search when exposing search matches associated with a link + mark-goto when exposing the jump goal of a mark + bookmark-jump when exposing a bookmark location + isearch when exiting from an incremental search + default default for all contexts not set explicitly + +Allowed visibility spans are + + minimal show current headline; if point is not on headline, + also show entry + + local show current headline, entry and next headline + + ancestors show current headline and its direct ancestors; if + point is not on headline, also show entry + + ancestors-full show current subtree and its direct ancestors + + lineage show current headline, its direct ancestors and all + their children; if point is not on headline, also show + entry and first child + + tree show current headline, its direct ancestors and all + their children; if point is not on headline, also show + entry and all children + + canonical show current headline, its direct ancestors along with + their entries and children; if point is not located on + the headline, also show current entry and all children + +As special cases, a nil or t value means show all contexts in +`minimal' or `canonical' view, respectively. + +Some views can make displayed information very compact, but also +make it harder to edit the location of the match. In such +a case, use the command `org-fold-reveal' (`\\[org-fold-reveal]') to show +more context." + :group 'org-fold-reveal-location + :version "26.1" + :package-version '(Org . "9.0") + :type '(choice + (const :tag "Canonical" t) + (const :tag "Minimal" nil) + (repeat :greedy t :tag "Individual contexts" + (cons + (choice :tag "Context" + (const agenda) + (const org-goto) + (const occur-tree) + (const tags-tree) + (const link-search) + (const mark-goto) + (const bookmark-jump) + (const isearch) + (const default)) + (choice :tag "Detail level" + (const minimal) + (const local) + (const ancestors) + (const ancestors-full) + (const lineage) + (const tree) + (const canonical)))))) + +(defvar org-fold-reveal-start-hook nil + "Hook run before revealing a location.") + +(defcustom org-fold-catch-invisible-edits 'smart + "Check if in invisible region before inserting or deleting a character. +Valid values are: + +nil Do not check, so just do invisible edits. +error Throw an error and do nothing. +show Make point visible, and do the requested edit. +show-and-error Make point visible, then throw an error and abort the edit. +smart Make point visible, and do insertion/deletion if it is + adjacent to visible text and the change feels predictable. + Never delete a previously invisible character or add in the + middle or right after an invisible region. Basically, this + allows insertion and backward-delete right before ellipses. + FIXME: maybe in this case we should not even show?" + :group 'org-edit-structure + :version "24.1" + :type '(choice + (const :tag "Do not check" nil) + (const :tag "Throw error when trying to edit" error) + (const :tag "Unhide, but do not do the edit" show-and-error) + (const :tag "Show invisible part and do the edit" show) + (const :tag "Be smart and do the right thing" smart))) + +;;; Core functionality + +;;; API + +;;;; Modifying folding specs + +(defalias 'org-fold-folding-spec-p #'org-fold-core-folding-spec-p) +(defalias 'org-fold-add-folding-spec #'org-fold-core-add-folding-spec) +(defalias 'org-fold-remove-folding-spec #'org-fold-core-remove-folding-spec) + +(defun org-fold-initialize (ellipsis) + "Setup folding in current Org buffer." + (setq-local org-fold-core-isearch-open-function #'org-fold--isearch-reveal) + (setq-local org-fold-core-extend-changed-region-functions (list #'org-fold--extend-changed-region)) + ;; FIXME: Converting org-link + org-description to overlays when + ;; search matches hidden "[[" part of the link, reverses priority of + ;; link and description and hides the whole link. Working around + ;; this until there will be no need to convert text properties to + ;; overlays for isearch. + (setq-local org-fold-core--isearch-special-specs '(org-link)) + (org-fold-core-initialize `((org-fold-outline + (:ellipsis . ,ellipsis) + (:fragile . ,#'org-fold--reveal-outline-maybe) + (:isearch-open . t) + ;; This is needed to make sure that inserting a + ;; new planning line in folded heading is not + ;; revealed. + (:front-sticky . t) + (:rear-sticky . t) + (:font-lock-skip . t) + (:alias . (headline heading outline inlinetask plain-list))) + (org-fold-block + (:ellipsis . ,ellipsis) + (:fragile . ,#'org-fold--reveal-drawer-or-block-maybe) + (:isearch-open . t) + (:front-sticky . t) + (:alias . ( block center-block comment-block + dynamic-block example-block export-block + quote-block special-block src-block + verse-block))) + (org-fold-drawer + (:ellipsis . ,ellipsis) + (:fragile . ,#'org-fold--reveal-drawer-or-block-maybe) + (:isearch-open . t) + (:front-sticky . t) + (:alias . (drawer property-drawer))) + ,org-link--description-folding-spec + ,org-link--link-folding-spec))) + +;;;; Searching and examining folded text + +(defalias 'org-fold-folded-p #'org-fold-core-folded-p) +(defalias 'org-fold-get-folding-spec #'org-fold-core-get-folding-spec) +(defalias 'org-fold-get-folding-specs-in-region #'org-fold-core-get-folding-specs-in-region) +(defalias 'org-fold-get-region-at-point #'org-fold-core-get-region-at-point) +(defalias 'org-fold-next-visibility-change #'org-fold-core-next-visibility-change) +(defalias 'org-fold-previous-visibility-change #'org-fold-core-previous-visibility-change) +(defalias 'org-fold-next-folding-state-change #'org-fold-core-next-folding-state-change) +(defalias 'org-fold-previous-folding-state-change #'org-fold-core-previous-folding-state-change) +(defalias 'org-fold-search-forward #'org-fold-core-search-forward) + +;;;;; Macros + +(defmacro org-fold-save-outline-visibility--overlays (use-markers &rest body) + "Save and restore outline visibility around BODY. +If USE-MARKERS is non-nil, use markers for the positions. This +means that the buffer may change while running BODY, but it also +means that the buffer should stay alive during the operation, +because otherwise all these markers will point to nowhere." + (declare (debug (form body)) (indent 1)) + (org-with-gensyms (data invisible-types markers?) + `(let* ((,invisible-types '(org-hide-block outline)) + (,markers? ,use-markers) + (,data + (mapcar (lambda (o) + (let ((beg (overlay-start o)) + (end (overlay-end o)) + (type (overlay-get o 'invisible))) + (and beg end + (> end beg) + (memq type ,invisible-types) + (list (if ,markers? (copy-marker beg) beg) + (if ,markers? (copy-marker end t) end) + type)))) + (org-with-wide-buffer + (overlays-in (point-min) (point-max)))))) + (unwind-protect (progn ,@body) + (org-with-wide-buffer + (dolist (type ,invisible-types) + (remove-overlays (point-min) (point-max) 'invisible type)) + (pcase-dolist (`(,beg ,end ,type) (delq nil ,data)) + (org-fold-region beg end t type) + (when ,markers? + (set-marker beg nil) + (set-marker end nil)))))))) +(defmacro org-fold-save-outline-visibility--text-properties (use-markers &rest body) + "Save and restore outline visibility around BODY. +If USE-MARKERS is non-nil, use markers for the positions. This +means that the buffer may change while running BODY, but it also +means that the buffer should stay alive during the operation, +because otherwise all these markers will point to nowhere." + (declare (debug (form body)) (indent 1)) + (org-with-gensyms (data specs markers?) + `(let* ((,specs ',(org-fold-core-folding-spec-list)) + (,markers? ,use-markers) + (,data + (org-with-wide-buffer + (let ((pos (point-min)) + data-val) + (while (< pos (point-max)) + (dolist (spec (org-fold-get-folding-spec 'all pos)) + (let ((region (org-fold-get-region-at-point spec pos))) + (if ,markers? + (push (list (copy-marker (car region)) + (copy-marker (cdr region) t) + spec) + data-val) + (push (list (car region) (cdr region) spec) + data-val)))) + (setq pos (org-fold-next-folding-state-change nil pos))))))) + (unwind-protect (progn ,@body) + (org-with-wide-buffer + (dolist (spec ,specs) + (org-fold-region (point-min) (point-max) nil spec)) + (pcase-dolist (`(,beg ,end ,spec) (delq nil ,data)) + (org-fold-region beg end t spec) + (when ,markers? + (set-marker beg nil) + (set-marker end nil)))))))) +(defmacro org-fold-save-outline-visibility (use-markers &rest body) + "Save and restore outline visibility around BODY. +If USE-MARKERS is non-nil, use markers for the positions. This +means that the buffer may change while running BODY, but it also +means that the buffer should stay alive during the operation, +because otherwise all these markers will point to nowhere." + (declare (debug (form body)) (indent 1)) + `(when (eq org-fold-core-style 'text-properties) + (org-fold-save-outline-visibility--text-properties ,use-markers ,@body) + (org-fold-save-outline-visibility--overlays ,use-markers ,@body))) + +;;;; Changing visibility (regions, blocks, drawers, headlines) + +;;;;; Region visibility + +;; (defalias 'org-fold-region #'org-fold-core-region) +(defun org-fold-region--overlays (from to flag spec) + "Hide or show lines from FROM to TO, according to FLAG. +SPEC is the invisibility spec, as a symbol." + (remove-overlays from to 'invisible spec) + ;; Use `front-advance' since text right before to the beginning of + ;; the overlay belongs to the visible line than to the contents. + (when flag + (let ((o (make-overlay from to nil 'front-advance))) + (overlay-put o 'evaporate t) + (overlay-put o 'invisible spec) + (overlay-put o + 'isearch-open-invisible + (lambda (&rest _) (org-fold-show-context 'isearch)))))) +(defsubst org-fold-region (from to flag &optional spec) + "Hide or show lines from FROM to TO, according to FLAG. +SPEC is the invisibility spec, as a symbol." + (if (eq org-fold-core-style 'text-properties) + (org-fold-core-region from to flag spec) + (org-fold-region--overlays from to flag spec))) + +(defun org-fold-show-all--text-properties (&optional types) + "Show all contents in the visible part of the buffer. +By default, the function expands headings, blocks and drawers. +When optional argument TYPES is a list of symbols among `blocks', +`drawers' and `headings', to only expand one specific type." + (interactive) + (dolist (type (or types '(blocks drawers headings))) + (org-fold-region (point-min) (point-max) nil + (pcase type + (`blocks 'block) + (`drawers 'drawer) + (`headings 'headline) + (_ (error "Invalid type: %S" type)))))) +(defun org-fold-show-all--overlays (&optional types) + "Show all contents in the visible part of the buffer. +By default, the function expands headings, blocks and drawers. +When optional argument TYPE is a list of symbols among `blocks', +`drawers' and `headings', to only expand one specific type." + (interactive) + (let ((types (or types '(blocks drawers headings)))) + (when (memq 'blocks types) + (org-fold-region (point-min) (point-max) nil 'org-hide-block)) + (cond + ;; Fast path. Since headings and drawers share the same + ;; invisible spec, clear everything in one go. + ((and (memq 'headings types) + (memq 'drawers types)) + (org-fold-region (point-min) (point-max) nil 'outline)) + ((memq 'headings types) + (org-fold-region (point-min) (point-max) nil 'outline) + (org-cycle-hide-drawers 'all)) + ((memq 'drawers types) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward org-drawer-regexp nil t) + (let* ((pair (get-char-property-and-overlay (line-beginning-position) + 'invisible)) + (o (cdr-safe pair))) + (if (overlayp o) (goto-char (overlay-end o)) + (pcase (get-char-property-and-overlay (point) 'invisible) + (`(outline . ,o) + (goto-char (overlay-end o)) + (delete-overlay o)) + (_ nil)))))))))) +(defsubst org-fold-show-all (&optional types) + "Show all contents in the visible part of the buffer. +By default, the function expands headings, blocks and drawers. +When optional argument TYPES is a list of symbols among `blocks', +`drawers' and `headings', to only expand one specific type." + (interactive) + (if (eq org-fold-core-style 'text-properties) + (org-fold-show-all--text-properties types) + (org-fold-show-all--overlays types))) + +(defun org-fold-flag-above-first-heading (&optional arg) + "Hide from bob up to the first heading. +Move point to the beginning of first heading or end of buffer." + (goto-char (point-min)) + (unless (org-at-heading-p) + (outline-next-heading)) + (unless (bobp) + (org-fold-region 1 (1- (point)) (not arg) 'outline))) + +;;;;; Heading visibility + +(defun org-fold-heading (flag &optional entry) + "Fold/unfold the current heading. FLAG non-nil means make invisible. +When ENTRY is non-nil, show the entire entry." + (save-excursion + (org-back-to-heading t) + ;; Check if we should show the entire entry + (if (not entry) + (org-fold-region + (line-end-position 0) (line-end-position) flag 'outline) + (org-fold-show-entry) + (save-excursion + ;; FIXME: potentially catches inlinetasks + (and (outline-next-heading) + (org-fold-heading nil)))))) + +(defun org-fold-hide-entry () + "Hide the body directly following this heading." + (interactive) + (save-excursion + (org-back-to-heading-or-point-min t) + (when (org-at-heading-p) (forward-line)) + (unless (eobp) ; Current headline is empty and ends at the end of buffer. + (org-fold-region + (line-end-position 0) + (save-excursion + (if (re-search-forward + (concat "[\r\n]" (org-get-limited-outline-regexp)) nil t) + (line-end-position 0) + (point-max))) + t + 'outline)))) + +(defun org-fold-subtree (flag) + (save-excursion + (org-back-to-heading t) + (org-fold-region (line-end-position) + (progn (org-end-of-subtree t) (point)) + flag + 'outline))) + +;; Replaces `outline-hide-subtree'. +(defun org-fold-hide-subtree () + "Hide everything after this heading at deeper levels." + (interactive) + (org-fold-subtree t)) + +;; Replaces `outline-hide-sublevels' +(defun org-fold-hide-sublevels (levels) + "Hide everything but the top LEVELS levels of headers, in whole buffer. +This also unhides the top heading-less body, if any. + +Interactively, the prefix argument supplies the value of LEVELS. +When invoked without a prefix argument, LEVELS defaults to the level +of the current heading, or to 1 if the current line is not a heading." + (interactive (list + (cond + (current-prefix-arg (prefix-numeric-value current-prefix-arg)) + ((save-excursion (beginning-of-line) + (looking-at outline-regexp)) + (funcall outline-level)) + (t 1)))) + (if (< levels 1) + (error "Must keep at least one level of headers")) + (save-excursion + (let* ((beg (progn + (goto-char (point-min)) + ;; Skip the prelude, if any. + (unless (org-at-heading-p) (outline-next-heading)) + (point))) + (end (progn + (goto-char (point-max)) + ;; Keep empty last line, if available. + (max (point-min) (if (bolp) (1- (point)) (point)))))) + (if (< end beg) + (setq beg (prog1 end (setq end beg)))) + ;; First hide everything. + (org-fold-region beg end t 'headline) + ;; Then unhide the top level headers. + (org-map-region + (lambda () + (when (<= (funcall outline-level) levels) + (org-fold-heading nil))) + beg end) + ;; Finally unhide any trailing newline. + (goto-char (point-max)) + (if (and (bolp) (not (bobp)) (outline-invisible-p (1- (point)))) + (org-fold-region (max (point-min) (1- (point))) (point) nil))))) + +(defun org-fold-show-entry () + "Show the body directly following its heading. +Show the heading too, if it is currently invisible." + (interactive) + (save-excursion + (org-back-to-heading-or-point-min t) + (org-fold-region + (line-end-position 0) + (save-excursion + (if (re-search-forward + (concat "[\r\n]\\(" (org-get-limited-outline-regexp) "\\)") nil t) + (match-beginning 1) + (point-max))) + nil + 'outline) + (org-cycle-hide-drawers 'children))) + +(defalias 'org-fold-show-hidden-entry #'org-fold-show-entry + "Show an entry where even the heading is hidden.") + +(defun org-fold-show-siblings () + "Show all siblings of the current headline." + (save-excursion + (while (org-goto-sibling) (org-fold-heading nil))) + (save-excursion + (while (org-goto-sibling 'previous) + (org-fold-heading nil)))) + +(defun org-fold-show-children (&optional level) + "Show all direct subheadings of this heading. +Prefix arg LEVEL is how many levels below the current level +should be shown. Default is enough to cause the following +heading to appear." + (interactive "p") + (unless (org-before-first-heading-p) + (save-excursion + (org-with-limited-levels (org-back-to-heading t)) + (let* ((current-level (funcall outline-level)) + (max-level (org-get-valid-level + current-level + (if level (prefix-numeric-value level) 1))) + (end (save-excursion (org-end-of-subtree t t))) + (regexp-fmt "^\\*\\{%d,%s\\}\\(?: \\|$\\)") + (past-first-child nil) + ;; Make sure to skip inlinetasks. + (re (format regexp-fmt + current-level + (cond + ((not (featurep 'org-inlinetask)) "") + (org-odd-levels-only (- (* 2 org-inlinetask-min-level) + 3)) + (t (1- org-inlinetask-min-level)))))) + ;; Display parent heading. + (org-fold-heading nil) + (forward-line) + ;; Display children. First child may be deeper than expected + ;; MAX-LEVEL. Since we want to display it anyway, adjust + ;; MAX-LEVEL accordingly. + (while (re-search-forward re end t) + (unless past-first-child + (setq re (format regexp-fmt + current-level + (max (funcall outline-level) max-level))) + (setq past-first-child t)) + (org-fold-heading nil)))))) + +(defun org-fold-show-subtree () + "Show everything after this heading at deeper levels." + (interactive) + (org-fold-region + (point) (save-excursion (org-end-of-subtree t t)) nil 'outline)) + +(defun org-fold-show-branches () + "Show all subheadings of this heading, but not their bodies." + (interactive) + (org-fold-show-children 1000)) + +(defun org-fold-show-branches-buffer--text-properties () + "Show all branches in the buffer." + (org-fold-flag-above-first-heading) + (org-fold-hide-sublevels 1) + (unless (eobp) + (org-fold-show-branches) + (while (outline-get-next-sibling) + (org-fold-show-branches))) + (goto-char (point-min))) +(defun org-fold-show-branches-buffer--overlays () + "Show all branches in the buffer." + (org-fold-flag-above-first-heading) + (outline-hide-sublevels 1) + (unless (eobp) + (outline-show-branches) + (while (outline-get-next-sibling) + (outline-show-branches))) + (goto-char (point-min))) +(defsubst org-fold-show-branches-buffer () + "Show all branches in the buffer." + (if (eq org-fold-core-style 'text-properties) + (org-fold-show-branches-buffer--text-properties) + (org-fold-show-branches-buffer--overlays))) + +;;;;; Blocks and drawers visibility + +(defun org-fold--hide-wrapper-toggle (element category force no-error) + "Toggle visibility for ELEMENT. + +ELEMENT is a block or drawer type parsed element. CATEGORY is +either `block' or `drawer'. When FORCE is `off', show the block +or drawer. If it is non-nil, hide it unconditionally. Throw an +error when not at a block or drawer, unless NO-ERROR is non-nil. + +Return a non-nil value when toggling is successful." + (let ((type (org-element-type element))) + (cond + ((memq type + (pcase category + (`drawer '(drawer property-drawer)) + (`block '(center-block + comment-block dynamic-block example-block export-block + quote-block special-block src-block verse-block)) + (_ (error "Unknown category: %S" category)))) + (let* ((post (org-element-property :post-affiliated element)) + (start (save-excursion + (goto-char post) + (line-end-position))) + (end (save-excursion + (goto-char (org-element-property :end element)) + (skip-chars-backward " \t\n") + (line-end-position)))) + ;; Do nothing when not before or at the block opening line or + ;; at the block closing line. + (unless (let ((eol (line-end-position))) + (and (> eol start) (/= eol end))) + (let* ((spec (if (eq org-fold-core-style 'text-properties) + category + (if (eq category 'block) 'org-hide-block 'outline))) + (flag + (cond ((eq force 'off) nil) + (force t) + ((if (eq org-fold-core-style 'text-properties) + (org-fold-folded-p start spec) + (eq spec (get-char-property start 'invisible))) + nil) + (t t)))) + (org-fold-region start end flag spec)) + ;; When the block is hidden away, make sure point is left in + ;; a visible part of the buffer. + (when (invisible-p (max (1- (point)) (point-min))) + (goto-char post)) + ;; Signal success. + t))) + (no-error nil) + (t + (user-error (format "%s@%s: %s" + (buffer-file-name (buffer-base-buffer)) + (point) + (if (eq category 'drawer) + "Not at a drawer" + "Not at a block"))))))) + +(defun org-fold-hide-block-toggle (&optional force no-error element) + "Toggle the visibility of the current block. + +When optional argument FORCE is `off', make block visible. If it +is non-nil, hide it unconditionally. Throw an error when not at +a block, unless NO-ERROR is non-nil. When optional argument +ELEMENT is provided, consider it instead of the current block. + +Return a non-nil value when toggling is successful." + (interactive) + (org-fold--hide-wrapper-toggle + (or element (org-element-at-point)) 'block force no-error)) + +(defun org-fold-hide-drawer-toggle (&optional force no-error element) + "Toggle the visibility of the current drawer. + +When optional argument FORCE is `off', make drawer visible. If +it is non-nil, hide it unconditionally. Throw an error when not +at a drawer, unless NO-ERROR is non-nil. When optional argument +ELEMENT is provided, consider it instead of the current drawer. + +Return a non-nil value when toggling is successful." + (interactive) + (org-fold--hide-wrapper-toggle + (or element (org-element-at-point)) 'drawer force no-error)) + +(defun org-fold-hide-block-all () + "Fold all blocks in the current buffer." + (interactive) + (org-block-map (apply-partially #'org-fold-hide-block-toggle 'hide))) + +(defun org-fold-hide-drawer-all () + "Fold all drawers in the current buffer." + (let ((begin (point-min)) + (end (point-max))) + (org-fold--hide-drawers begin end))) + +(defun org-fold--hide-drawers--overlays (begin end) + "Hide all drawers between BEGIN and END." + (save-excursion + (goto-char begin) + (while (re-search-forward org-drawer-regexp end t) + (let* ((pair (get-char-property-and-overlay (line-beginning-position) + 'invisible)) + (o (cdr-safe pair))) + (if (overlayp o) (goto-char (overlay-end o)) ;invisible drawer + (pcase (get-char-property-and-overlay (point) 'invisible) + (`(outline . ,o) (goto-char (overlay-end o))) ;already folded + (_ + (let* ((drawer (org-element-at-point)) + (type (org-element-type drawer))) + (when (memq type '(drawer property-drawer)) + (org-fold-hide-drawer-toggle t nil drawer) + ;; Make sure to skip drawer entirely or we might flag it + ;; another time when matching its ending line with + ;; `org-drawer-regexp'. + (goto-char (org-element-property :end drawer))))))))))) +(defun org-fold--hide-drawers--text-properties (begin end) + "Hide all drawers between BEGIN and END." + (save-excursion + (goto-char begin) + (while (and (< (point) end) + (re-search-forward org-drawer-regexp end t)) + ;; Skip folded drawers + (if (org-fold-folded-p nil 'drawer) + (goto-char (org-fold-next-folding-state-change 'drawer nil end)) + (let* ((drawer (org-element-at-point)) + (type (org-element-type drawer))) + (when (memq type '(drawer property-drawer)) + (org-fold-hide-drawer-toggle t nil drawer) + ;; Make sure to skip drawer entirely or we might flag it + ;; another time when matching its ending line with + ;; `org-drawer-regexp'. + (goto-char (org-element-property :end drawer)))))))) +(defun org-fold--hide-drawers (begin end) + "Hide all drawers between BEGIN and END." + (if (eq org-fold-core-style 'text-properties) + (org-fold--hide-drawers--text-properties begin end) + (org-fold--hide-drawers--overlays begin end))) + +(defun org-fold-hide-archived-subtrees (beg end) + "Re-hide all archived subtrees after a visibility state change." + (org-with-wide-buffer + (let ((case-fold-search nil) + (re (concat org-outline-regexp-bol ".*:" org-archive-tag ":"))) + (goto-char beg) + ;; Include headline point is currently on. + (beginning-of-line) + (while (and (< (point) end) (re-search-forward re end t)) + (when (member org-archive-tag (org-get-tags nil t)) + (org-fold-subtree t) + (org-end-of-subtree t)))))) + +;;;;; Reveal point location + +(defun org-fold-show-context (&optional key) + "Make sure point and context are visible. +Optional argument KEY, when non-nil, is a symbol. See +`org-fold-show-context-detail' for allowed values and how much is to +be shown." + (org-fold-show-set-visibility + (cond ((symbolp org-fold-show-context-detail) org-fold-show-context-detail) + ((cdr (assq key org-fold-show-context-detail))) + (t (cdr (assq 'default org-fold-show-context-detail)))))) + +(defun org-fold-show-set-visibility--overlays (detail) + "Set visibility around point according to 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 within a drawer or a block, make sure to + ;; expose it. + (dolist (o (overlays-at (point))) + (when (memq (overlay-get o 'invisible) '(org-hide-block outline)) + (delete-overlay o))) + (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)))))) +(defvar org-hide-emphasis-markers); Defined in org.el +(defvar org-pretty-entities); Defined in org.el +(defun org-fold-show-set-visibility--text-properties (detail) + "Set visibility around point according to 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) + (let ((region (org-fold-get-region-at-point))) + ;; Reveal emphasis markers. + (let (org-hide-emphasis-markers + org-link-descriptive + org-pretty-entities + (region (or (org-find-text-property-region (point) 'org-emphasis) + (org-find-text-property-region (point) 'invisible) + region))) + (when region + (org-with-point-at (car region) + (beginning-of-line) + (let (font-lock-extend-region-functions) + (font-lock-fontify-region (1- (car region)) (cdr region)))))) + (when region + (org-fold-region (car region) (cdr region) nil)))) + (unless (org-before-first-heading-p) + (org-with-limited-levels + (cl-case detail + ((tree canonical t) (org-fold-show-children)) + ((nil minimal ancestors ancestors-full)) + (t (save-excursion + (outline-next-heading) + (org-fold-heading nil))))))) + ;; Show whole subtree. + (when (eq detail 'ancestors-full) (org-fold-show-subtree)) + ;; Show all siblings. + (when (eq detail 'lineage) (org-fold-show-siblings)) + ;; Show ancestors, possibly with their children. + (when (memq detail '(ancestors ancestors-full lineage tree canonical t)) + (save-excursion + (while (org-up-heading-safe) + (org-fold-heading nil) + (when (memq detail '(canonical t)) (org-fold-show-entry)) + (when (memq detail '(tree canonical t)) (org-fold-show-children)))))) +(defun org-fold-show-set-visibility (detail) + "Set visibility around point according to DETAIL. +DETAIL is either nil, `minimal', `local', `ancestors', `lineage', +`tree', `canonical' or t. See `org-fold-show-context-detail' for more +information." + (if (eq org-fold-core-style 'text-properties) + (org-fold-show-set-visibility--text-properties detail) + (org-fold-show-set-visibility--overlays detail))) + +(defun org-fold-reveal (&optional siblings) + "Show current entry, hierarchy above it, and the following headline. + +This can be used to show a consistent set of context around +locations exposed with `org-fold-show-context'. + +With optional argument SIBLINGS, on each level of the hierarchy all +siblings are shown. This repairs the tree structure to what it would +look like when opened with hierarchical calls to `org-cycle'. + +With a \\[universal-argument] \\[universal-argument] prefix, \ +go to the parent and show the entire tree." + (interactive "P") + (run-hooks 'org-fold-reveal-start-hook) + (cond ((equal siblings '(4)) (org-fold-show-set-visibility 'canonical)) + ((equal siblings '(16)) + (save-excursion + (when (org-up-heading-safe) + (org-fold-show-subtree) + (run-hook-with-args 'org-cycle-hook 'subtree)))) + (t (org-fold-show-set-visibility 'lineage)))) + +;;; Make isearch search in some text hidden via text propertoes + +(defun org-fold--isearch-reveal (&rest _) + "Reveal text at POS found by isearch." + (org-fold-show-set-visibility 'isearch)) + +;;; Handling changes in folded elements + +(defun org-fold--extend-changed-region (from to) + "Consider folded regions in the next/previous line when fixing +region visibility. +This function is intended to be used as a member of +`org-fold-core-extend-changed-region-functions'." + ;; If the edit is done in the first line of a folded drawer/block, + ;; the folded text is only starting from the next line and needs to + ;; be checked. + (setq to (save-excursion (goto-char to) (line-beginning-position 2))) + ;; If the ":END:" line of the drawer is deleted, the folded text is + ;; only ending at the previous line and needs to be checked. + (setq from (save-excursion (goto-char from) (line-beginning-position 0))) + (cons from to)) + +(defun org-fold--reveal-outline-maybe (region _) + "Reveal folded outline in REGION when needed. + +This function is intended to be used as :fragile property of +`org-fold-outline' spec. See `org-fold-core--specs' for details." + (save-match-data + (save-excursion + (goto-char (car region)) + ;; The line before beginning of the fold should be either a + ;; headline or a list item. + (backward-char) + (beginning-of-line) + ;; Make sure that headline is not partially hidden + (unless (org-fold-folded-p nil 'headline) (org-fold-region (max (point-min) (1- (point))) (line-end-position) nil 'headline)) + ;; Check the validity of headline + (unless (let ((case-fold-search t)) + (looking-at (rx-to-string `(or (regex ,(org-item-re)) + (regex ,org-outline-regexp-bol))))) ; the match-data will be used later + t)))) + +(defun org-fold--reveal-drawer-or-block-maybe (region spec) + "Reveal folded drawer/block (according to SPEC) in REGION when needed. + +This function is intended to be used as :fragile property of +`org-fold-drawer' or `org-fold-block' spec." + (let ((begin-re (cond + ((eq spec (org-fold-core-get-folding-spec-from-alias 'drawer)) + org-drawer-regexp) + ;; Group one below contains the type of the block. + ((eq spec (org-fold-core-get-folding-spec-from-alias 'block)) + (rx bol (zero-or-more (any " " "\t")) + "#+begin" + (or ":" + (seq "_" + (group (one-or-more (not (syntax whitespace)))))))))) + ;; To be determined later. May depend on `begin-re' match (i.e. for blocks). + end-re) + (save-match-data ; we should not clobber match-data in after-change-functions + (let ((fold-begin (car region)) + (fold-end (cdr region))) + (let (unfold?) + (catch :exit + ;; The line before folded text should be beginning of + ;; the drawer/block. + (save-excursion + (goto-char fold-begin) + ;; The line before beginning of the fold should be the + ;; first line of the drawer/block. + (backward-char) + (beginning-of-line) + (unless (let ((case-fold-search t)) + (looking-at begin-re)) ; the match-data will be used later + (throw :exit (setq unfold? t)))) + ;; Set `end-re' for the current drawer/block. + (setq end-re + (cond + ((eq spec (org-fold-core-get-folding-spec-from-alias 'drawer)) + org-property-end-re) + ((eq spec (org-fold-core-get-folding-spec-from-alias 'block)) + (let ((block-type (match-string 1))) ; the last match is from `begin-re' + (concat (rx bol (zero-or-more (any " " "\t")) "#+end") + (if block-type + (concat "_" + (regexp-quote block-type) + (rx (zero-or-more (any " " "\t")) eol)) + (rx (opt ":") (zero-or-more (any " " "\t")) eol))))))) + ;; The last line of the folded text should match `end-re'. + (save-excursion + (goto-char fold-end) + (beginning-of-line) + (unless (let ((case-fold-search t)) + (looking-at end-re)) + (throw :exit (setq unfold? t)))) + ;; There should be no `end-re' or + ;; `org-outline-regexp-bol' anywhere in the + ;; drawer/block body. + (save-excursion + (goto-char fold-begin) + (when (save-excursion + (let ((case-fold-search t)) + (re-search-forward (rx-to-string `(or (regex ,end-re) + (regex ,org-outline-regexp-bol))) + (max (point) + (1- (save-excursion + (goto-char fold-end) + (line-beginning-position)))) + t))) + (throw :exit (setq unfold? t))))) + unfold?))))) + +;; Catching user edits inside invisible text +(defun org-fold-check-before-invisible-edit--overlays (kind) + "Check if editing KIND is dangerous with invisible text around. +The detailed reaction depends on the user option +`org-fold-catch-invisible-edits'." + ;; First, try to get out of here as quickly as possible, to reduce overhead + (when (and org-fold-catch-invisible-edits + (or (not (boundp 'visible-mode)) (not visible-mode)) + (or (get-char-property (point) 'invisible) + (get-char-property (max (point-min) (1- (point))) 'invisible))) + ;; OK, we need to take a closer look. Do not consider + ;; invisibility obtained through text properties (e.g., link + ;; fontification), as it cannot be toggled. + (let* ((invisible-at-point + (pcase (get-char-property-and-overlay (point) 'invisible) + (`(,_ . ,(and (pred overlayp) o)) o))) + ;; Assume that point cannot land in the middle of an + ;; overlay, or between two overlays. + (invisible-before-point + (and (not invisible-at-point) + (not (bobp)) + (pcase (get-char-property-and-overlay (1- (point)) 'invisible) + (`(,_ . ,(and (pred overlayp) o)) o)))) + (border-and-ok-direction + (or + ;; Check if we are acting predictably before invisible + ;; text. + (and invisible-at-point + (memq kind '(insert delete-backward))) + ;; Check if we are acting predictably after invisible text + ;; This works not well, and I have turned it off. It seems + ;; better to always show and stop after invisible text. + ;; (and (not invisible-at-point) invisible-before-point + ;; (memq kind '(insert delete))) + ))) + (when (or invisible-at-point invisible-before-point) + (when (eq org-fold-catch-invisible-edits 'error) + (user-error "Editing in invisible areas is prohibited, make them visible first")) + (if (and org-custom-properties-overlays + (y-or-n-p "Display invisible properties in this buffer? ")) + (org-toggle-custom-properties-visibility) + ;; Make the area visible + (save-excursion + (when invisible-before-point + (goto-char + (previous-single-char-property-change (point) 'invisible))) + ;; Remove whatever overlay is currently making yet-to-be + ;; edited text invisible. Also remove nested invisibility + ;; related overlays. + (delete-overlay (or invisible-at-point invisible-before-point)) + (let ((origin (if invisible-at-point (point) (1- (point))))) + (while (pcase (get-char-property-and-overlay origin 'invisible) + (`(,_ . ,(and (pred overlayp) o)) + (delete-overlay o) + t))))) + (cond + ((eq org-fold-catch-invisible-edits 'show) + ;; That's it, we do the edit after showing + (message + "Unfolding invisible region around point before editing") + (sit-for 1)) + ((and (eq org-fold-catch-invisible-edits 'smart) + border-and-ok-direction) + (message "Unfolding invisible region around point before editing")) + (t + ;; Don't do the edit, make the user repeat it in full visibility + (user-error "Edit in invisible region aborted, repeat to confirm with text visible")))))))) +(defun org-fold-check-before-invisible-edit--text-properties (kind) + "Check if editing KIND is dangerous with invisible text around. +The detailed reaction depends on the user option +`org-fold-catch-invisible-edits'." + ;; First, try to get out of here as quickly as possible, to reduce overhead + (when (and org-fold-catch-invisible-edits + (or (not (boundp 'visible-mode)) (not visible-mode)) + (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. + (let* ((invisible-at-point (org-invisible-p)) + (invisible-before-point + (and (not (bobp)) + (org-invisible-p (1- (point))))) + (border-and-ok-direction + (or + ;; Check if we are acting predictably before invisible + ;; text. + (and invisible-at-point (not invisible-before-point) + (memq kind '(insert delete-backward))) + (and (not invisible-at-point) invisible-before-point + (memq kind '(insert delete)))))) + (when (or invisible-at-point invisible-before-point) + (when (eq org-fold-catch-invisible-edits 'error) + (user-error "Editing in invisible areas is prohibited, make them visible first")) + (if (and org-custom-properties-hidden-p + (y-or-n-p "Display invisible properties in this buffer? ")) + (org-toggle-custom-properties-visibility) + ;; Make the area visible + (save-excursion + (org-fold-show-set-visibility 'local)) + (when invisible-before-point + (org-with-point-at (1- (point)) (org-fold-show-set-visibility 'local))) + (cond + ((eq org-fold-catch-invisible-edits 'show) + ;; That's it, we do the edit after showing + (message + "Unfolding invisible region around point before editing") + (sit-for 1)) + ((and (eq org-fold-catch-invisible-edits 'smart) + border-and-ok-direction) + (message "Unfolding invisible region around point before editing")) + (t + ;; Don't do the edit, make the user repeat it in full visibility + (user-error "Edit in invisible region aborted, repeat to confirm with text visible")))))))) +(defsubst org-fold-check-before-invisible-edit (kind) + "Check if editing KIND is dangerous with invisible text around. +The detailed reaction depends on the user option +`org-fold-catch-invisible-edits'." + ;; First, try to get out of here as quickly as possible, to reduce overhead + (if (eq org-fold-core-style 'text-properties) + (org-fold-check-before-invisible-edit--text-properties kind) + (org-fold-check-before-invisible-edit--overlays kind))) + +(provide 'org-fold) + +;;; org-fold.el ends here -- 2.35.1 -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH v2 03/38] Separate cycling functions from org.el into new library: org-cycle 2022-04-20 13:23 ` [PATCH v2 00/38] Final call for comments: " Ihor Radchenko 2022-04-20 13:23 ` [PATCH v2 01/38] Add org-fold-core: new folding engine--- Ihor Radchenko 2022-04-20 13:24 ` [PATCH v2 02/38] Separate folding functions from org.el into new library: org-fold Ihor Radchenko @ 2022-04-20 13:24 ` Ihor Radchenko 2022-04-20 13:24 ` [PATCH v2 04/38] Remove functions from org.el that are now moved elsewhere Ihor Radchenko ` (38 subsequent siblings) 41 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-04-20 13:24 UTC (permalink / raw) To: emacs-orgmode --- lisp/org-cycle.el | 818 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 818 insertions(+) create mode 100644 lisp/org-cycle.el diff --git a/lisp/org-cycle.el b/lisp/org-cycle.el new file mode 100644 index 000000000..df0a3761a --- /dev/null +++ b/lisp/org-cycle.el @@ -0,0 +1,818 @@ +;;; org-cycle.el --- Visibility cycling of Org entries -*- lexical-binding: t; -*- +;; +;; Copyright (C) 2020-2020 Free Software Foundation, Inc. +;; +;; Maintainer: Ihor Radchenko <yantar92 at gmail dot com> +;; Keywords: folding, visibility cycling, invisible text +;; Homepage: https://orgmode.org +;; +;; This file is part of GNU Emacs. +;; +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Commentary: + +;; This file contains code controlling global folding state in buffer +;; and TAB-cycling. + +;;; Code: + +(require 'org-macs) +(require 'org-fold) + +(declare-function org-element-type "org-element" (element)) +(declare-function org-element-property "org-element" (property element)) +(declare-function org-element-lineage "org-element" (datum &optional types with-self)) +(declare-function org-element-at-point "org-element" (&optional pom cached-only)) +(declare-function org-get-tags "org" (&optional pos local fontify)) +(declare-function org-subtree-end-visible-p "org" ()) +(declare-function org-narrow-to-subtree "org" (&optional element)) +(declare-function org-at-property-p "org" ()) +(declare-function org-re-property "org" (property &optional literal allow-null value)) +(declare-function org-item-beginning-re "org" ()) +(declare-function org-at-heading-p "org" (&optional invisible-not-ok)) +(declare-function org-at-item-p "org" ()) +(declare-function org-before-first-heading-p "org" ()) +(declare-function org-back-to-heading "org" (&optional invisible-ok)) +(declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading)) +(declare-function org-entry-end-position "org" ()) +(declare-function org-try-cdlatex-tab "org" ()) +(declare-function org-cycle-level "org" ()) +(declare-function org-table-next-field "org-table" ()) +(declare-function org-table-justify-field-maybe "org-table" (&optional new)) +(declare-function org-inlinetask-at-task-p "org-inlinetask" ()) +(declare-function org-inlinetask-toggle-visibility "org-inlinetask" ()) +(declare-function org-list-get-all-items "org-list" (item struct prevs)) +(declare-function org-list-get-bottom-point "org-list" (struct)) +(declare-function org-list-prevs-alist "org-list" (struct)) +(declare-function org-list-set-item-visibility "org-list" (item struct view)) +(declare-function org-list-search-forward "org-list" (regexp &optional bound noerror)) +(declare-function org-list-has-child-p "org-list" (item struct)) +(declare-function org-list-get-item-end-before-blank "org-list" (item struct)) +(declare-function org-list-struct "org-list" ()) +(declare-function org-cycle-item-indentation "org-list" ()) + +(declare-function outline-previous-heading "outline" ()) +(declare-function outline-next-heading "outline" ()) +(declare-function outline-end-of-heading "outline" ()) +(declare-function outline-up-heading "outline" (arg &optional invisible-ok)) + +(defvar org-drawer-regexp) +(defvar org-odd-levels-only) +(defvar org-startup-folded) +(defvar org-archive-tag) +(defvar org-cycle-include-plain-lists) +(defvar org-outline-regexp-bol) + +(defvar-local org-cycle-global-status nil) +(put 'org-cycle-global-status 'org-state t) +(defvar-local org-cycle-subtree-status nil) +(put 'org-cycle-subtree-status 'org-state t) + +;;;; Customisation: + + +(defgroup org-cycle nil + "Options concerning visibility cycling in Org mode." + :tag "Org Cycle" + :group 'org-structure) + +(defcustom org-cycle-skip-children-state-if-no-children t + "Non-nil means skip CHILDREN state in entries that don't have any." + :group 'org-cycle + :type 'boolean) + +(defcustom org-cycle-max-level nil + "Maximum level which should still be subject to visibility cycling. +Levels higher than this will, for cycling, be treated as text, not a headline. +When `org-odd-levels-only' is set, a value of N in this variable actually +means 2N-1 stars as the limiting headline. +When nil, cycle all levels. +Note that the limiting level of cycling is also influenced by +`org-inlinetask-min-level'. When `org-cycle-max-level' is not set but +`org-inlinetask-min-level' is, cycling will be limited to levels one less +than its value." + :group 'org-cycle + :type '(choice + (const :tag "No limit" nil) + (integer :tag "Maximum level"))) + +(defcustom org-cycle-hide-block-startup nil + "Non-nil means entering Org mode will fold all blocks. +This can also be set in on a per-file basis with + +#+STARTUP: hideblocks +#+STARTUP: showblocks" + :group 'org-startup + :group 'org-cycle + :type 'boolean) + +(defcustom org-cycle-global-at-bob nil + "Cycle globally if cursor is at beginning of buffer and not at a headline. + +This makes it possible to do global cycling without having to use `S-TAB' +or `\\[universal-argument] TAB'. For this special case to work, the first \ +line of the buffer +must not be a headline -- it may be empty or some other text. + +When used in this way, `org-cycle-hook' is disabled temporarily to make +sure the cursor stays at the beginning of the buffer. + +When this option is nil, don't do anything special at the beginning of +the buffer." + :group 'org-cycle + :type 'boolean) + +(defcustom org-cycle-level-after-item/entry-creation t + "Non-nil means cycle entry level or item indentation in new empty entries. + +When the cursor is at the end of an empty headline, i.e., with only stars +and maybe a TODO keyword, TAB will then switch the entry to become a child, +and then all possible ancestor states, before returning to the original state. +This makes data entry extremely fast: M-RET to create a new headline, +on TAB to make it a child, two or more tabs to make it a (grand-)uncle. + +When the cursor is at the end of an empty plain list item, one TAB will +make it a subitem, two or more tabs will back up to make this an item +higher up in the item hierarchy." + :group 'org-cycle + :type 'boolean) + +(defcustom org-cycle-emulate-tab t + "Where should `org-cycle' emulate TAB. +nil Never +white Only in completely white lines +whitestart Only at the beginning of lines, before the first non-white char +t Everywhere except in headlines +exc-hl-bol Everywhere except at the start of a headline +If TAB is used in a place where it does not emulate TAB, the current subtree +visibility is cycled." + :group 'org-cycle + :type '(choice (const :tag "Never" nil) + (const :tag "Only in completely white lines" white) + (const :tag "Before first char in a line" whitestart) + (const :tag "Everywhere except in headlines" t) + (const :tag "Everywhere except at bol in headlines" exc-hl-bol))) + +(defcustom org-cycle-separator-lines 2 + "Number of empty lines needed to keep an empty line between collapsed trees. +If you leave an empty line between the end of a subtree and the following +headline, this empty line is hidden when the subtree is folded. +Org mode will leave (exactly) one empty line visible if the number of +empty lines is equal or larger to the number given in this variable. +So the default 2 means at least 2 empty lines after the end of a subtree +are needed to produce free space between a collapsed subtree and the +following headline. + +If the number is negative, and the number of empty lines is at least -N, +all empty lines are shown. + +Special case: when 0, never leave empty lines in collapsed view." + :group 'org-cycle + :type 'integer) +(put 'org-cycle-separator-lines 'safe-local-variable 'integerp) + +(defcustom org-cycle-pre-hook nil + "Hook that is run before visibility cycling is happening. +The function(s) in this hook must accept a single argument which indicates +the new state that will be set right after running this hook. The +argument is a symbol. Before a global state change, it can have the values +`overview', `content', or `all'. Before a local state change, it can have +the values `folded', `children', or `subtree'." + :group 'org-cycle + :type 'hook) + +(defcustom org-cycle-hook '(org-cycle-hide-archived-subtrees + org-cycle-show-empty-lines + org-cycle-optimize-window-after-visibility-change) + "Hook that is run after `org-cycle' has changed the buffer visibility. +The function(s) in this hook must accept a single argument which indicates +the new state that was set by the most recent `org-cycle' command. The +argument is a symbol. After a global state change, it can have the values +`overview', `contents', or `all'. After a local state change, it can have +the values `folded', `children', or `subtree'." + :group 'org-cycle + :package-version '(Org . "9.4") + :type 'hook) + +(defcustom org-cycle-open-archived-trees nil + "Non-nil means `org-cycle' will open archived trees. +An archived tree is a tree marked with the tag ARCHIVE. +When nil, archived trees will stay folded. You can still open them with +normal outline commands like `show-all', but not with the cycling commands." + :group 'org-archive + :group 'org-cycle + :type 'boolean) + +(defvar org-cycle-tab-first-hook nil + "Hook for functions to attach themselves to TAB. +See `org-ctrl-c-ctrl-c-hook' for more information. +This hook runs as the first action when TAB is pressed, even before +`org-cycle' messes around with the `outline-regexp' to cater for +inline tasks and plain list item folding. +If any function in this hook returns t, any other actions that +would have been caused by TAB (such as table field motion or visibility +cycling) will not occur.") + +;;;; Implementation: + +(defun org-cycle-hide-drawers (state) + "Re-hide all drawers after a visibility state change. +STATE should be one of the symbols listed in the docstring of +`org-cycle-hook'." + (when (derived-mode-p 'org-mode) + (cond ((not (memq state '(overview folded contents))) + (let* ((global? (eq state 'all)) + (beg (if global? (point-min) (line-beginning-position))) + (end (cond (global? (point-max)) + ((eq state 'children) (org-entry-end-position)) + (t (save-excursion (org-end-of-subtree t t)))))) + (if (not global?) + (org-fold--hide-drawers beg end) + ;; Delay folding drawers inside folded subtrees until + ;; first unfold. + (add-hook 'org-fold-core-first-unfold-functions + #'org-fold--hide-drawers)))) + ((memq state '(overview contents)) + ;; Hide drawers before first heading. + (let ((beg (point-min)) + (end (save-excursion + (goto-char (point-min)) + (if (org-before-first-heading-p) + (org-entry-end-position) + (point-min))))) + (when (< beg end) + (org-fold--hide-drawers beg end))))))) + +;;;###autoload +(defun org-cycle (&optional arg) + "TAB-action and visibility cycling for Org mode. + +This is the command invoked in Org mode by the `TAB' key. Its main +purpose is outline visibility cycling, but it also invokes other actions +in special contexts. + +When this function is called with a `\\[universal-argument]' prefix, rotate \ +the entire +buffer through 3 states (global cycling) + 1. OVERVIEW: Show only top-level headlines. + 2. CONTENTS: Show all headlines of all levels, but no body text. + 3. SHOW ALL: Show everything. + +With a `\\[universal-argument] \\[universal-argument]' prefix argument, \ +switch to the startup visibility, +determined by the variable `org-startup-folded', and by any VISIBILITY +properties in the buffer. + +With a `\\[universal-argument] \\[universal-argument] \ +\\[universal-argument]' prefix argument, show the entire buffer, including +any drawers. + +When inside a table, re-align the table and move to the next field. + +When point is at the beginning of a headline, rotate the subtree started +by this line through 3 different states (local cycling) + 1. FOLDED: Only the main headline is shown. + 2. CHILDREN: The main headline and the direct children are shown. + From this state, you can move to one of the children + and zoom in further. + 3. SUBTREE: Show the entire subtree, including body text. +If there is no subtree, switch directly from CHILDREN to FOLDED. + +When point is at the beginning of an empty headline and the variable +`org-cycle-level-after-item/entry-creation' is set, cycle the level +of the headline by demoting and promoting it to likely levels. This +speeds up creation document structure by pressing `TAB' once or several +times right after creating a new headline. + +When there is a numeric prefix, go up to a heading with level ARG, do +a `show-subtree' and return to the previous cursor position. If ARG +is negative, go up that many levels. + +When point is not at the beginning of a headline, execute the global +binding for `TAB', which is re-indenting the line. See the option +`org-cycle-emulate-tab' for details. + +As a special case, if point is at the very beginning of the buffer, if +there is no headline there, and if the variable `org-cycle-global-at-bob' +is non-nil, this function acts as if called with prefix argument \ +\(`\\[universal-argument] TAB', +same as `S-TAB') also when called without prefix argument." + (interactive "P") + (org-load-modules-maybe) + (unless (or (run-hook-with-args-until-success 'org-cycle-tab-first-hook) + (and org-cycle-level-after-item/entry-creation + (or (org-cycle-level) + (org-cycle-item-indentation)))) + (let* ((limit-level + (or org-cycle-max-level + (and (boundp 'org-inlinetask-min-level) + org-inlinetask-min-level + (1- org-inlinetask-min-level)))) + (nstars + (and limit-level + (if org-odd-levels-only + (1- (* 2 limit-level)) + limit-level))) + (org-outline-regexp + (format "\\*%s " (if nstars (format "\\{1,%d\\}" nstars) "+")))) + (cond + ((equal arg '(16)) + (setq last-command 'dummy) + (org-cycle-set-startup-visibility) + (org-unlogged-message "Startup visibility, plus VISIBILITY properties")) + ((equal arg '(64)) + (org-fold-show-all) + (org-unlogged-message "Entire buffer visible, including drawers")) + ((equal arg '(4)) (org-cycle-internal-global)) + ;; Show-subtree, ARG levels up from here. + ((integerp arg) + (save-excursion + (org-back-to-heading) + (outline-up-heading (if (< arg 0) (- arg) + (- (funcall outline-level) arg))) + (org-fold-show-subtree))) + ;; Global cycling at BOB: delegate to `org-cycle-internal-global'. + ((and org-cycle-global-at-bob + (bobp) + (not (looking-at org-outline-regexp))) + (let ((org-cycle-hook + (remq 'org-cycle-optimize-window-after-visibility-change + org-cycle-hook))) + (org-cycle-internal-global))) + ;; Try CDLaTeX TAB completion. + ((org-try-cdlatex-tab)) + ;; Inline task: delegate to `org-inlinetask-toggle-visibility'. + ((and (featurep 'org-inlinetask) + (org-inlinetask-at-task-p) + (or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol)))) + (org-inlinetask-toggle-visibility)) + (t + (let ((pos (point)) + (element (org-element-at-point))) + (cond + ;; Try toggling visibility for block at point. + ((org-fold-hide-block-toggle nil t element)) + ;; Try toggling visibility for drawer at point. + ((org-fold-hide-drawer-toggle nil t element)) + ;; Table: enter it or move to the next field. + ((and (org-match-line "[ \t]*[|+]") + (org-element-lineage element '(table) t)) + (if (and (eq 'table (org-element-type element)) + (eq 'table.el (org-element-property :type element))) + (message (substitute-command-keys "\\<org-mode-map>\ +Use `\\[org-edit-special]' to edit table.el tables")) + (org-table-justify-field-maybe) + (call-interactively #'org-table-next-field))) + ((run-hook-with-args-until-success + 'org-tab-after-check-for-table-hook)) + ;; At an item/headline: delegate to `org-cycle-internal-local'. + ((and (or (and org-cycle-include-plain-lists + (let ((item (org-element-lineage element + '(item plain-list) + t))) + (and item + (= (line-beginning-position) + (org-element-property :post-affiliated + item))))) + (org-match-line org-outline-regexp)) + (or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol)))) + (org-cycle-internal-local)) + ;; From there: TAB emulation and template completion. + (buffer-read-only (org-back-to-heading)) + ((run-hook-with-args-until-success + 'org-tab-after-check-for-cycling-hook)) + ((run-hook-with-args-until-success + 'org-tab-before-tab-emulation-hook)) + ((and (eq org-cycle-emulate-tab 'exc-hl-bol) + (or (not (bolp)) + (not (looking-at org-outline-regexp)))) + (call-interactively (global-key-binding (kbd "TAB")))) + ((or (eq org-cycle-emulate-tab t) + (and (memq org-cycle-emulate-tab '(white whitestart)) + (save-excursion (beginning-of-line 1) (looking-at "[ \t]*")) + (or (and (eq org-cycle-emulate-tab 'white) + (= (match-end 0) (point-at-eol))) + (and (eq org-cycle-emulate-tab 'whitestart) + (>= (match-end 0) pos))))) + (call-interactively (global-key-binding (kbd "TAB")))) + (t + (save-excursion + (org-back-to-heading) + (org-cycle)))))))))) + +(defun org-cycle-force-archived () + "Cycle subtree even if it is archived." + (interactive) + (setq this-command 'org-cycle) + (let ((org-cycle-open-archived-trees t)) + (call-interactively 'org-cycle))) + +(defun org-cycle-internal-global () + "Do the global cycling action." + ;; Hack to avoid display of messages for .org attachments in Gnus + (let ((ga (string-match-p "\\*fontification" (buffer-name)))) + (cond + ((and (eq last-command this-command) + (eq org-cycle-global-status 'overview)) + ;; We just created the overview - now do table of contents + ;; This can be slow in very large buffers, so indicate action + (run-hook-with-args 'org-cycle-pre-hook 'contents) + (unless ga (org-unlogged-message "CONTENTS...")) + (org-cycle-content) + (unless ga (org-unlogged-message "CONTENTS...done")) + (setq org-cycle-global-status 'contents) + (run-hook-with-args 'org-cycle-hook 'contents)) + + ((and (eq last-command this-command) + (eq org-cycle-global-status 'contents)) + ;; We just showed the table of contents - now show everything + (run-hook-with-args 'org-cycle-pre-hook 'all) + (org-fold-show-all '(headings blocks)) + (unless ga (org-unlogged-message "SHOW ALL")) + (setq org-cycle-global-status 'all) + (run-hook-with-args 'org-cycle-hook 'all)) + + (t + ;; Default action: go to overview + (run-hook-with-args 'org-cycle-pre-hook 'overview) + (org-cycle-overview) + (unless ga (org-unlogged-message "OVERVIEW")) + (setq org-cycle-global-status 'overview) + (run-hook-with-args 'org-cycle-hook 'overview))))) + +(defun org-cycle-internal-local () + "Do the local cycling action." + (let ((goal-column 0) eoh eol eos has-children children-skipped struct) + ;; First, determine end of headline (EOH), end of subtree or item + ;; (EOS), and if item or heading has children (HAS-CHILDREN). + (save-excursion + (if (org-at-item-p) + (progn + (beginning-of-line) + (setq struct (org-list-struct)) + (setq eoh (point-at-eol)) + (setq eos (org-list-get-item-end-before-blank (point) struct)) + (setq has-children (org-list-has-child-p (point) struct))) + (org-back-to-heading) + (setq eoh (save-excursion (outline-end-of-heading) (point))) + (setq eos (save-excursion + (org-end-of-subtree t t) + (unless (eobp) (forward-char -1)) + (point))) + (setq has-children + (or + (save-excursion + (let ((level (funcall outline-level))) + (outline-next-heading) + (and (org-at-heading-p) + (> (funcall outline-level) level)))) + (and (eq org-cycle-include-plain-lists 'integrate) + (save-excursion + (org-list-search-forward (org-item-beginning-re) eos t)))))) + ;; Determine end invisible part of buffer (EOL) + (beginning-of-line 2) + (if (eq org-fold-core-style 'text-properties) + (while (and (not (eobp)) ;this is like `next-line' + (org-fold-folded-p (1- (point)))) + (goto-char (org-fold-next-visibility-change nil nil t)) + (and (eolp) (beginning-of-line 2))) + (while (and (not (eobp)) ;this is like `next-line' + (get-char-property (1- (point)) 'invisible)) + (goto-char (next-single-char-property-change (point) 'invisible)) + (and (eolp) (beginning-of-line 2)))) + (setq eol (point))) + ;; Find out what to do next and set `this-command' + (cond + ((= eos eoh) + ;; Nothing is hidden behind this heading + (unless (org-before-first-heading-p) + (run-hook-with-args 'org-cycle-pre-hook 'empty)) + (org-unlogged-message "EMPTY ENTRY") + (setq org-cycle-subtree-status nil) + (save-excursion + (goto-char eos) + (org-with-limited-levels + (outline-next-heading)) + (when (org-invisible-p) (org-fold-heading nil)))) + ((and (or (>= eol eos) + (save-excursion (goto-char eol) (skip-chars-forward "[:space:]" eos) (= (point) eos))) + (or has-children + (not (setq children-skipped + org-cycle-skip-children-state-if-no-children)))) + ;; Entire subtree is hidden in one line: children view + (unless (org-before-first-heading-p) + (org-with-limited-levels + (run-hook-with-args 'org-cycle-pre-hook 'children))) + (if (org-at-item-p) + (org-list-set-item-visibility (point-at-bol) struct 'children) + (org-fold-show-entry) + (org-with-limited-levels (org-fold-show-children)) + (org-fold-show-set-visibility 'tree) + ;; Fold every list in subtree to top-level items. + (when (eq org-cycle-include-plain-lists 'integrate) + (save-excursion + (org-back-to-heading) + (while (org-list-search-forward (org-item-beginning-re) eos t) + (beginning-of-line 1) + (let* ((struct (org-list-struct)) + (prevs (org-list-prevs-alist struct)) + (end (org-list-get-bottom-point struct))) + (dolist (e (org-list-get-all-items (point) struct prevs)) + (org-list-set-item-visibility e struct 'folded)) + (goto-char (if (< end eos) end eos))))))) + (org-unlogged-message "CHILDREN") + (save-excursion + (goto-char eos) + (org-with-limited-levels + (outline-next-heading)) + (when (and + ;; Subtree does not end at the end of visible section of the + ;; buffer. + (< (point) (point-max)) + (org-invisible-p)) + ;; Reveal the following heading line. + (org-fold-heading nil))) + (setq org-cycle-subtree-status 'children) + (unless (org-before-first-heading-p) + (run-hook-with-args 'org-cycle-hook 'children))) + ((or children-skipped + (and (eq last-command this-command) + (eq org-cycle-subtree-status 'children))) + ;; We just showed the children, or no children are there, + ;; now show everything. + (unless (org-before-first-heading-p) + (run-hook-with-args 'org-pre-cycle-hook 'subtree)) + (org-fold-region eoh eos nil 'outline) + (org-unlogged-message + (if children-skipped "SUBTREE (NO CHILDREN)" "SUBTREE")) + (setq org-cycle-subtree-status 'subtree) + (unless (org-before-first-heading-p) + (run-hook-with-args 'org-cycle-hook 'subtree))) + (t + ;; Default action: hide the subtree. + (run-hook-with-args 'org-cycle-pre-hook 'folded) + (org-fold-region eoh eos t 'outline) + (org-unlogged-message "FOLDED") + (setq org-cycle-subtree-status 'folded) + (unless (org-before-first-heading-p) + (run-hook-with-args 'org-cycle-hook 'folded)))))) + +;;;###autoload +(defun org-cycle-global (&optional arg) + "Cycle the global visibility. For details see `org-cycle'. +With `\\[universal-argument]' prefix ARG, switch to startup visibility. +With a numeric prefix, show all headlines up to that level." + (interactive "P") + (cond + ((integerp arg) + (org-cycle-content arg) + (setq org-cycle-global-status 'contents)) + ((equal arg '(4)) + (org-cycle-set-startup-visibility) + (org-unlogged-message "Startup visibility, plus VISIBILITY properties.")) + (t + (org-cycle '(4))))) + +(defun org-cycle-set-startup-visibility () + "Set the visibility required by startup options and properties." + (cond + ((eq org-startup-folded t) + (org-cycle-overview)) + ((eq org-startup-folded 'content) + (org-cycle-content)) + ((eq org-startup-folded 'show2levels) + (org-cycle-content 2)) + ((eq org-startup-folded 'show3levels) + (org-cycle-content 3)) + ((eq org-startup-folded 'show4levels) + (org-cycle-content 4)) + ((eq org-startup-folded 'show5levels) + (org-cycle-content 5)) + ((or (eq org-startup-folded 'showeverything) + (eq org-startup-folded nil)) + (org-fold-show-all))) + (unless (eq org-startup-folded 'showeverything) + (when org-cycle-hide-block-startup (org-fold-hide-block-all)) + (org-cycle-set-visibility-according-to-property) + (org-cycle-hide-archived-subtrees 'all) + (org-cycle-hide-drawers 'all) + (org-cycle-show-empty-lines t))) + +(defun org-cycle-set-visibility-according-to-property () + "Switch subtree visibility according to VISIBILITY property." + (interactive) + (let ((regexp (org-re-property "VISIBILITY"))) + (org-with-point-at 1 + (while (re-search-forward regexp nil t) + (let ((state (match-string 3))) + (if (not (org-at-property-p)) (outline-next-heading) + (save-excursion + (org-back-to-heading t) + (org-fold-subtree t) + (org-fold-reveal) + (pcase state + ("folded" + (org-fold-subtree t)) + ("children" + (org-fold-show-hidden-entry) + (org-fold-show-children)) + ("content" + (save-excursion + (save-restriction + (org-narrow-to-subtree) + (org-cycle-content)))) + ((or "all" "showall") + (org-fold-show-subtree)) + (_ nil))) + (org-end-of-subtree))))))) + +(defun org-cycle-overview--overlays () + "Switch to overview mode, showing only top-level headlines." + (interactive) + (org-fold-show-all '(headings drawers)) + (save-excursion + (goto-char (point-min)) + (when (re-search-forward org-outline-regexp-bol nil t) + (let* ((last (line-end-position)) + (level (- (match-end 0) (match-beginning 0) 1)) + (regexp (format "^\\*\\{1,%d\\} " level))) + (while (re-search-forward regexp nil :move) + (org-fold-region last (line-end-position 0) t 'outline) + (setq last (line-end-position)) + (setq level (- (match-end 0) (match-beginning 0) 1)) + (setq regexp (format "^\\*\\{1,%d\\} " level))) + (org-fold-region last (point) t 'outline))))) +(defun org-cycle-overview--text-properties () + "Switch to overview mode, showing only top-level headlines." + (interactive) + (save-excursion + (goto-char (point-min)) + ;; Hide top-level drawer. + (save-restriction + (narrow-to-region (point-min) (or (re-search-forward org-outline-regexp-bol nil t) (point-max))) + (org-fold-hide-drawer-all)) + (goto-char (point-min)) + (when (re-search-forward org-outline-regexp-bol nil t) + (let* ((last (line-end-position)) + (level (- (match-end 0) (match-beginning 0) 1)) + (regexp (format "^\\*\\{1,%d\\} " level))) + (while (re-search-forward regexp nil :move) + (org-fold-region last (line-end-position 0) t 'outline) + (setq last (line-end-position)) + (setq level (- (match-end 0) (match-beginning 0) 1)) + (setq regexp (format "^\\*\\{1,%d\\} " level))) + (org-fold-region last (point) t 'outline))))) +(defun org-cycle-overview () + "Switch to overview mode, showing only top-level headlines." + (interactive) + (if (eq org-fold-core-style 'text-properties) + (org-cycle-overview--text-properties) + (org-cycle-overview--overlays))) + +(defun org-cycle-content--text-properties (&optional arg) + "Show all headlines in the buffer, like a table of contents. +With numerical argument N, show content up to level N." + (interactive "p") + (org-fold-show-all '(headings)) + (save-excursion + (goto-char (point-min)) + ;; Hide top-level drawer. + (save-restriction + (narrow-to-region (point-min) (or (re-search-forward org-outline-regexp-bol nil t) (point-max))) + (org-fold-hide-drawer-all)) + (goto-char (point-max)) + (let ((regexp (if (and (wholenump arg) (> arg 0)) + (format "^\\*\\{1,%d\\} " arg) + "^\\*+ ")) + (last (point))) + (while (re-search-backward regexp nil t) + (org-fold-region (line-end-position) last t 'outline) + (setq last (line-end-position 0)))))) +(defun org-cycle-content--overlays (&optional arg) + "Show all headlines in the buffer, like a table of contents. +With numerical argument N, show content up to level N." + (interactive "p") + (org-fold-show-all '(headings drawers)) + (save-excursion + (goto-char (point-max)) + (let ((regexp (if (and (wholenump arg) (> arg 0)) + (format "^\\*\\{1,%d\\} " arg) + "^\\*+ ")) + (last (point))) + (while (re-search-backward regexp nil t) + (org-fold-region (line-end-position) last t 'outline) + (setq last (line-end-position 0)))))) +(defun org-cycle-content (&optional arg) + "Show all headlines in the buffer, like a table of contents. +With numerical argument N, show content up to level N." + (interactive "p") + (if (eq org-fold-core-style 'text-properties) + (org-cycle-content--text-properties arg) + (org-cycle-content--overlays arg))) + +(defvar org-cycle-scroll-position-to-restore nil + "Temporarily store scroll position to restore.") +(defun org-cycle-optimize-window-after-visibility-change (state) + "Adjust the window after a change in outline visibility. +This function is the default value of the hook `org-cycle-hook'." + (when (get-buffer-window (current-buffer)) + (let ((repeat (eq last-command this-command))) + (unless repeat + (setq org-cycle-scroll-position-to-restore nil)) + (cond + ((eq state 'content) nil) + ((eq state 'all) nil) + ((and org-cycle-scroll-position-to-restore repeat + (eq state 'folded)) + (set-window-start nil org-cycle-scroll-position-to-restore)) + ((eq state 'folded) nil) + ((eq state 'children) + (setq org-cycle-scroll-position-to-restore (window-start)) + (or (org-subtree-end-visible-p) (recenter 1))) + ((eq state 'subtree) + (unless repeat + (setq org-cycle-scroll-position-to-restore (window-start))) + (or (org-subtree-end-visible-p) (recenter 1))))))) + +(defun org-cycle-show-empty-lines (state) + "Show empty lines above all visible headlines. +The region to be covered depends on STATE when called through +`org-cycle-hook'. Lisp program can use t for STATE to get the +entire buffer covered. Note that an empty line is only shown if there +are at least `org-cycle-separator-lines' empty lines before the headline." + (when (/= org-cycle-separator-lines 0) + (save-excursion + (let* ((n (abs org-cycle-separator-lines)) + (re (cond + ((= n 1) "\\(\n[ \t]*\n\\*+\\) ") + ((= n 2) "^[ \t]*\\(\n[ \t]*\n\\*+\\) ") + (t (let ((ns (number-to-string (- n 2)))) + (concat "^\\(?:[ \t]*\n\\)\\{" ns "," ns "\\}" + "[ \t]*\\(\n[ \t]*\n\\*+\\) "))))) + beg end) + (cond + ((memq state '(overview contents t)) + (setq beg (point-min) end (point-max))) + ((memq state '(children folded)) + (setq beg (point) + end (progn (org-end-of-subtree t t) + (line-beginning-position 2))))) + (when beg + (goto-char beg) + (while (re-search-forward re end t) + (unless (org-invisible-p (match-end 1)) + (let ((e (match-end 1)) + (b (if (>= org-cycle-separator-lines 0) + (match-beginning 1) + (save-excursion + (goto-char (match-beginning 0)) + (skip-chars-backward " \t\n") + (line-end-position))))) + (org-fold-region b e nil 'outline)))))))) + ;; Never hide empty lines at the end of the file. + (save-excursion + (goto-char (point-max)) + (outline-previous-heading) + (outline-end-of-heading) + (when (and (looking-at "[ \t\n]+") + (= (match-end 0) (point-max))) + (org-fold-region (point) (match-end 0) nil 'outline)))) + +(defun org-cycle-hide-archived-subtrees (state) + "Re-hide all archived subtrees after a visibility state change. +STATE should be one of the symbols listed in the docstring of +`org-cycle-hook'." + (when (and (not org-cycle-open-archived-trees) + (not (memq state '(overview folded)))) + (let ((globalp (memq state '(contents all)))) + (if globalp + ;; Delay hiding inside folded subtrees until first unfold. + (add-hook 'org-fold-core-first-unfold-functions + #'org-fold-hide-archived-subtrees) + (org-fold-hide-archived-subtrees + (point) + (save-excursion + (org-end-of-subtree t)))) + (when (and (not globalp) + (member org-archive-tag + (org-get-tags nil 'local))) + (message "%s" (substitute-command-keys + "Subtree is archived and stays closed. Use \ +`\\[org-cycle-force-archived]' to cycle it anyway.")))))) + +(provide 'org-cycle) + +;;; org-cycle.el ends here -- 2.35.1 -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH v2 04/38] Remove functions from org.el that are now moved elsewhere 2022-04-20 13:23 ` [PATCH v2 00/38] Final call for comments: " Ihor Radchenko ` (2 preceding siblings ...) 2022-04-20 13:24 ` [PATCH v2 03/38] Separate cycling functions from org.el into new library: org-cycle Ihor Radchenko @ 2022-04-20 13:24 ` Ihor Radchenko 2022-04-20 13:24 ` [PATCH v2 05/38] Disable native-comp in agendaIt caused cryptic bugs in the past Ihor Radchenko ` (37 subsequent siblings) 41 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-04-20 13:24 UTC (permalink / raw) To: emacs-orgmode --- lisp/org.el | 1272 ++------------------------------------------------- 1 file changed, 40 insertions(+), 1232 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index 2353c6594..855f0813d 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -1179,90 +1179,6 @@ (defgroup org-structure nil :tag "Org Structure" :group 'org) -(defgroup org-reveal-location nil - "Options about how to make context of a location visible." - :tag "Org Reveal Location" - :group 'org-structure) - -(defcustom org-show-context-detail '((agenda . local) - (bookmark-jump . lineage) - (isearch . lineage) - (default . ancestors)) - "Alist between context and visibility span when revealing a location. - -\\<org-mode-map>Some actions may move point into invisible -locations. As a consequence, Org always exposes a neighborhood -around point. How much is shown depends on the initial action, -or context. Valid contexts are - - agenda when exposing an entry from the agenda - org-goto when using the command `org-goto' (`\\[org-goto]') - occur-tree when using the command `org-occur' (`\\[org-sparse-tree] /') - tags-tree when constructing a sparse tree based on tags matches - link-search when exposing search matches associated with a link - mark-goto when exposing the jump goal of a mark - bookmark-jump when exposing a bookmark location - isearch when exiting from an incremental search - default default for all contexts not set explicitly - -Allowed visibility spans are - - minimal show current headline; if point is not on headline, - also show entry - - local show current headline, entry and next headline - - ancestors show current headline and its direct ancestors; if - point is not on headline, also show entry - - ancestors-full show current subtree and its direct ancestors - - lineage show current headline, its direct ancestors and all - their children; if point is not on headline, also show - entry and first child - - tree show current headline, its direct ancestors and all - their children; if point is not on headline, also show - entry and all children - - canonical show current headline, its direct ancestors along with - their entries and children; if point is not located on - the headline, also show current entry and all children - -As special cases, a nil or t value means show all contexts in -`minimal' or `canonical' view, respectively. - -Some views can make displayed information very compact, but also -make it harder to edit the location of the match. In such -a case, use the command `org-reveal' (`\\[org-reveal]') to show -more context." - :group 'org-reveal-location - :version "26.1" - :package-version '(Org . "9.0") - :type '(choice - (const :tag "Canonical" t) - (const :tag "Minimal" nil) - (repeat :greedy t :tag "Individual contexts" - (cons - (choice :tag "Context" - (const agenda) - (const org-goto) - (const occur-tree) - (const tags-tree) - (const link-search) - (const mark-goto) - (const bookmark-jump) - (const isearch) - (const default)) - (choice :tag "Detail level" - (const minimal) - (const local) - (const ancestors) - (const ancestors-full) - (const lineage) - (const tree) - (const canonical)))))) - (defcustom org-indirect-buffer-display 'other-window "How should indirect tree buffers be displayed? @@ -1454,130 +1370,6 @@ (defcustom org-bookmark-names-plist :group 'org-structure :type 'plist) -(defgroup org-cycle nil - "Options concerning visibility cycling in Org mode." - :tag "Org Cycle" - :group 'org-structure) - -(defcustom org-cycle-skip-children-state-if-no-children t - "Non-nil means skip CHILDREN state in entries that don't have any." - :group 'org-cycle - :type 'boolean) - -(defcustom org-cycle-max-level nil - "Maximum level which should still be subject to visibility cycling. -Levels higher than this will, for cycling, be treated as text, not a headline. -When `org-odd-levels-only' is set, a value of N in this variable actually -means 2N-1 stars as the limiting headline. -When nil, cycle all levels. -Note that the limiting level of cycling is also influenced by -`org-inlinetask-min-level'. When `org-cycle-max-level' is not set but -`org-inlinetask-min-level' is, cycling will be limited to levels one less -than its value." - :group 'org-cycle - :type '(choice - (const :tag "No limit" nil) - (integer :tag "Maximum level"))) - -(defcustom org-hide-block-startup nil - "Non-nil means entering Org mode will fold all blocks. -This can also be set in on a per-file basis with - -#+STARTUP: hideblocks -#+STARTUP: showblocks" - :group 'org-startup - :group 'org-cycle - :type 'boolean) - -(defcustom org-cycle-global-at-bob nil - "Cycle globally if cursor is at beginning of buffer and not at a headline. - -This makes it possible to do global cycling without having to use `S-TAB' -or `\\[universal-argument] TAB'. For this special case to work, the first \ -line of the buffer -must not be a headline -- it may be empty or some other text. - -When used in this way, `org-cycle-hook' is disabled temporarily to make -sure the cursor stays at the beginning of the buffer. - -When this option is nil, don't do anything special at the beginning of -the buffer." - :group 'org-cycle - :type 'boolean) - -(defcustom org-cycle-level-after-item/entry-creation t - "Non-nil means cycle entry level or item indentation in new empty entries. - -When the cursor is at the end of an empty headline, i.e., with only stars -and maybe a TODO keyword, TAB will then switch the entry to become a child, -and then all possible ancestor states, before returning to the original state. -This makes data entry extremely fast: M-RET to create a new headline, -on TAB to make it a child, two or more tabs to make it a (grand-)uncle. - -When the cursor is at the end of an empty plain list item, one TAB will -make it a subitem, two or more tabs will back up to make this an item -higher up in the item hierarchy." - :group 'org-cycle - :type 'boolean) - -(defcustom org-cycle-emulate-tab t - "Where should `org-cycle' emulate TAB. -nil Never -white Only in completely white lines -whitestart Only at the beginning of lines, before the first non-white char -t Everywhere except in headlines -exc-hl-bol Everywhere except at the start of a headline -If TAB is used in a place where it does not emulate TAB, the current subtree -visibility is cycled." - :group 'org-cycle - :type '(choice (const :tag "Never" nil) - (const :tag "Only in completely white lines" white) - (const :tag "Before first char in a line" whitestart) - (const :tag "Everywhere except in headlines" t) - (const :tag "Everywhere except at bol in headlines" exc-hl-bol))) - -(defcustom org-cycle-separator-lines 2 - "Number of empty lines needed to keep an empty line between collapsed trees. -If you leave an empty line between the end of a subtree and the following -headline, this empty line is hidden when the subtree is folded. -Org mode will leave (exactly) one empty line visible if the number of -empty lines is equal or larger to the number given in this variable. -So the default 2 means at least 2 empty lines after the end of a subtree -are needed to produce free space between a collapsed subtree and the -following headline. - -If the number is negative, and the number of empty lines is at least -N, -all empty lines are shown. - -Special case: when 0, never leave empty lines in collapsed view." - :group 'org-cycle - :type 'integer) -(put 'org-cycle-separator-lines 'safe-local-variable 'integerp) - -(defcustom org-pre-cycle-hook nil - "Hook that is run before visibility cycling is happening. -The function(s) in this hook must accept a single argument which indicates -the new state that will be set right after running this hook. The -argument is a symbol. Before a global state change, it can have the values -`overview', `content', or `all'. Before a local state change, it can have -the values `folded', `children', or `subtree'." - :group 'org-cycle - :type 'hook) - -(defcustom org-cycle-hook '(org-cycle-hide-archived-subtrees - org-cycle-hide-drawers - org-cycle-show-empty-lines - org-optimize-window-after-visibility-change) - "Hook that is run after `org-cycle' has changed the buffer visibility. -The function(s) in this hook must accept a single argument which indicates -the new state that was set by the most recent `org-cycle' command. The -argument is a symbol. After a global state change, it can have the values -`overview', `contents', or `all'. After a local state change, it can have -the values `folded', `children', or `subtree'." - :group 'org-cycle - :package-version '(Org . "9.4") - :type 'hook) - (defgroup org-edit-structure nil "Options concerning structure editing in Org mode." :tag "Org Edit Structure" @@ -1704,29 +1496,6 @@ (defcustom org-special-ctrl-o t :group 'org-edit-structure :type 'boolean) -(defcustom org-catch-invisible-edits nil - "Check if in invisible region before inserting or deleting a character. -Valid values are: - -nil Do not check, so just do invisible edits. -error Throw an error and do nothing. -show Make point visible, and do the requested edit. -show-and-error Make point visible, then throw an error and abort the edit. -smart Make point visible, and do insertion/deletion if it is - adjacent to visible text and the change feels predictable. - Never delete a previously invisible character or add in the - middle or right after an invisible region. Basically, this - allows insertion and backward-delete right before ellipses. - FIXME: maybe in this case we should not even show?" - :group 'org-edit-structure - :version "24.1" - :type '(choice - (const :tag "Do not check" nil) - (const :tag "Throw error when trying to edit" error) - (const :tag "Unhide, but do not do the edit" show-and-error) - (const :tag "Show invisible part and do the edit" show) - (const :tag "Be smart and do the right thing" smart))) - (defcustom org-yank-folded-subtrees t "Non-nil means when yanking subtrees, fold them. If the kill is a single subtree, or a sequence of subtrees, i.e. if @@ -1769,7 +1538,6 @@ (defcustom org-M-RET-may-split-line '((default . t)) (const default)) (boolean))))) - (defcustom org-insert-heading-respect-content nil "Non-nil means insert new headings after the current subtree. \\<org-mode-map> @@ -3986,15 +3754,6 @@ (defcustom org-columns-skip-archived-trees t :group 'org-properties :type 'boolean) -(defcustom org-cycle-open-archived-trees nil - "Non-nil means `org-cycle' will open archived trees. -An archived tree is a tree marked with the tag ARCHIVE. -When nil, archived trees will stay folded. You can still open them with -normal outline commands like `show-all', but not with the cycling commands." - :group 'org-archive - :group 'org-cycle - :type 'boolean) - (defcustom org-sparse-tree-open-archived-trees nil "Non-nil means sparse tree construction shows matches in archived trees. When nil, matches in these trees are highlighted, but the trees are kept in @@ -4024,51 +3783,6 @@ (defcustom org-sparse-tree-default-date-type nil :package-version '(Org . "8.3") :group 'org-sparse-trees) -(defun org-cycle-hide-archived-subtrees (state) - "Re-hide all archived subtrees after a visibility state change. -STATE should be one of the symbols listed in the docstring of -`org-cycle-hook'." - (when (and (not org-cycle-open-archived-trees) - (not (memq state '(overview folded)))) - (save-excursion - (let* ((globalp (memq state '(contents all))) - (beg (if globalp (point-min) (point))) - (end (if globalp (point-max) (org-end-of-subtree t)))) - (org-hide-archived-subtrees beg end) - (goto-char beg) - (when (looking-at-p (concat ".*:" org-archive-tag ":")) - (message "%s" (substitute-command-keys - "Subtree is archived and stays closed. Use \ -`\\[org-force-cycle-archived]' to cycle it anyway."))))))) - -(defun org-force-cycle-archived () - "Cycle subtree even if it is archived." - (interactive) - (setq this-command 'org-cycle) - (let ((org-cycle-open-archived-trees t)) - (call-interactively 'org-cycle))) - -(defun org-hide-archived-subtrees (beg end) - "Re-hide all archived subtrees after a visibility state change." - (org-with-wide-buffer - (let ((case-fold-search nil) - (re (concat org-outline-regexp-bol ".*:" org-archive-tag ":"))) - (goto-char beg) - ;; Include headline point is currently on. - (beginning-of-line) - (while (and (< (point) end) (re-search-forward re end t)) - (when (member org-archive-tag (org-get-tags nil t)) - (org-flag-subtree t) - (org-end-of-subtree t)))))) - -(defun org-flag-subtree (flag) - (save-excursion - (org-back-to-heading t) - (org-flag-region (line-end-position) - (progn (org-end-of-subtree t) (point)) - flag - 'outline))) - (defalias 'org-advertized-archive-subtree 'org-archive-subtree) ;; Declare Column View Code @@ -6032,6 +5746,7 @@ (defun org-remove-empty-overlays-at (pos) (overlay-end o)))) (delete-overlay o)))) +;; FIXME: This function is unused. (defun org-show-empty-lines-in-parent () "Move to the parent and re-show empty lines before visible headlines." (save-excursion @@ -6072,826 +5787,11 @@ (defun org-first-headline-recenter () (set-window-start window (line-beginning-position)))))) \f -;;; Visibility (headlines, blocks, drawers) - -;;;; Headlines visibility - -(defun org-show-entry () - "Show the body directly following its heading. -Show the heading too, if it is currently invisible." - (interactive) - (save-excursion - (org-back-to-heading-or-point-min t) - (org-flag-region - (line-end-position 0) - (save-excursion - (if (re-search-forward - (concat "[\r\n]\\(" org-outline-regexp "\\)") nil t) - (match-beginning 1) - (point-max))) - nil - 'outline) - (org-cycle-hide-drawers 'children))) - -(defun org-hide-entry () - "Hide the body directly following its heading." - (interactive) - (save-excursion - (org-back-to-heading-or-point-min t) - (when (org-at-heading-p) (forward-line)) - (org-flag-region - (line-end-position 0) - (save-excursion - (if (re-search-forward - (concat "[\r\n]" org-outline-regexp) nil t) - (line-end-position 0) - (point-max))) - t - 'outline))) - -(defun org-show-children (&optional level) - "Show all direct subheadings of this heading. -Prefix arg LEVEL is how many levels below the current level -should be shown. Default is enough to cause the following -heading to appear." - (interactive "p") - (unless (org-before-first-heading-p) - (save-excursion - (org-with-limited-levels (org-back-to-heading t)) - (let* ((current-level (funcall outline-level)) - (max-level (org-get-valid-level - current-level - (if level (prefix-numeric-value level) 1))) - (end (save-excursion (org-end-of-subtree t t))) - (regexp-fmt "^\\*\\{%d,%s\\}\\(?: \\|$\\)") - (past-first-child nil) - ;; Make sure to skip inlinetasks. - (re (format regexp-fmt - current-level - (cond - ((not (featurep 'org-inlinetask)) "") - (org-odd-levels-only (- (* 2 org-inlinetask-min-level) - 3)) - (t (1- org-inlinetask-min-level)))))) - ;; Display parent heading. - (org-flag-heading nil) - (forward-line) - ;; Display children. First child may be deeper than expected - ;; MAX-LEVEL. Since we want to display it anyway, adjust - ;; MAX-LEVEL accordingly. - (while (re-search-forward re end t) - (unless past-first-child - (setq re (format regexp-fmt - current-level - (max (funcall outline-level) max-level))) - (setq past-first-child t)) - (org-flag-heading nil)))))) - -(defun org-show-subtree () - "Show everything after this heading at deeper levels." - (interactive) - (org-flag-region - (point) (save-excursion (org-end-of-subtree t t)) nil 'outline)) - -;;;; Blocks and drawers visibility - -(defun org--hide-wrapper-toggle (element category force no-error) - "Toggle visibility for ELEMENT. - -ELEMENT is a block or drawer type parsed element. CATEGORY is -either `block' or `drawer'. When FORCE is `off', show the block -or drawer. If it is non-nil, hide it unconditionally. Throw an -error when not at a block or drawer, unless NO-ERROR is non-nil. - -Return a non-nil value when toggling is successful." - (let ((type (org-element-type element))) - (cond - ((memq type - (pcase category - (`drawer '(drawer property-drawer)) - (`block '(center-block - comment-block dynamic-block example-block export-block - quote-block special-block src-block verse-block)) - (_ (error "Unknown category: %S" category)))) - (let* ((post (org-element-property :post-affiliated element)) - (start (save-excursion - (goto-char post) - (line-end-position))) - (end (save-excursion - (goto-char (org-element-property :end element)) - (skip-chars-backward " \t\n") - (line-end-position)))) - ;; Do nothing when not before or at the block opening line or - ;; at the block closing line. - (unless (let ((eol (line-end-position))) - (and (> eol start) (/= eol end))) - (let* ((spec (if (eq category 'block) 'org-hide-block 'outline)) - (flag - (cond ((eq force 'off) nil) - (force t) - ((eq spec (get-char-property start 'invisible)) nil) - (t t)))) - (org-flag-region start end flag spec)) - ;; When the block is hidden away, make sure point is left in - ;; a visible part of the buffer. - (when (invisible-p (max (1- (point)) (point-min))) - (goto-char post)) - ;; Signal success. - t))) - (no-error nil) - (t - (user-error (if (eq category 'drawer) - "Not at a drawer" - "Not at a block")))))) - -(defun org-hide-block-toggle (&optional force no-error element) - "Toggle the visibility of the current block. - -When optional argument FORCE is `off', make block visible. If it -is non-nil, hide it unconditionally. Throw an error when not at -a block, unless NO-ERROR is non-nil. When optional argument -ELEMENT is provided, consider it instead of the current block. - -Return a non-nil value when toggling is successful." - (interactive) - (org--hide-wrapper-toggle - (or element (org-element-at-point)) 'block force no-error)) - -(defun org-hide-drawer-toggle (&optional force no-error element) - "Toggle the visibility of the current drawer. - -When optional argument FORCE is `off', make drawer visible. If -it is non-nil, hide it unconditionally. Throw an error when not -at a drawer, unless NO-ERROR is non-nil. When optional argument -ELEMENT is provided, consider it instead of the current drawer. - -Return a non-nil value when toggling is successful." - (interactive) - (org--hide-wrapper-toggle - (or element (org-element-at-point)) 'drawer force no-error)) - -(defun org-hide-block-all () - "Fold all blocks in the current buffer." - (interactive) - (org-show-all '(blocks)) - (org-block-map 'org-hide-block-toggle)) - -(defun org-hide-drawer-all () - "Fold all drawers in the current buffer." - (let ((begin (point-min)) - (end (point-max))) - (org--hide-drawers begin end))) - -(defun org-cycle-hide-drawers (state) - "Re-hide all drawers after a visibility state change. -STATE should be one of the symbols listed in the docstring of -`org-cycle-hook'." - (when (derived-mode-p 'org-mode) - (cond ((not (memq state '(overview folded contents))) - (let* ((global? (eq state 'all)) - (beg (if global? (point-min) (line-beginning-position))) - (end (cond (global? (point-max)) - ((eq state 'children) (org-entry-end-position)) - (t (save-excursion (org-end-of-subtree t t)))))) - (org--hide-drawers beg end))) - ((memq state '(overview contents)) - ;; Hide drawers before first heading. - (let ((beg (point-min)) - (end (save-excursion - (goto-char (point-min)) - (if (org-before-first-heading-p) - (org-entry-end-position) - (point-min))))) - (when (< beg end) - (org--hide-drawers beg end))))))) - -(defun org--hide-drawers (begin end) - "Hide all drawers between BEGIN and END." - (save-excursion - (goto-char begin) - (while (re-search-forward org-drawer-regexp end t) - (let* ((pair (get-char-property-and-overlay (line-beginning-position) - 'invisible)) - (o (cdr-safe pair))) - (if (overlayp o) (goto-char (overlay-end o)) ;invisible drawer - (pcase (get-char-property-and-overlay (point) 'invisible) - (`(outline . ,o) (goto-char (overlay-end o))) ;already folded - (_ - (let* ((drawer (org-element-at-point)) - (type (org-element-type drawer))) - (when (memq type '(drawer property-drawer)) - (org-hide-drawer-toggle t nil drawer) - ;; Make sure to skip drawer entirely or we might flag it - ;; another time when matching its ending line with - ;; `org-drawer-regexp'. - (goto-char (org-element-property :end drawer))))))))))) - -;;;; Visibility cycling - -(defvar-local org-cycle-global-status nil) -(put 'org-cycle-global-status 'org-state t) -(defvar-local org-cycle-subtree-status nil) -(put 'org-cycle-subtree-status 'org-state t) - -(defun org-show-all (&optional types) - "Show all contents in the visible part of the buffer. -By default, the function expands headings, blocks and drawers. -When optional argument TYPE is a list of symbols among `blocks', -`drawers' and `headings', to only expand one specific type." - (interactive) - (let ((types (or types '(blocks drawers headings)))) - (when (memq 'blocks types) - (org-flag-region (point-min) (point-max) nil 'org-hide-block)) - (cond - ;; Fast path. Since headings and drawers share the same - ;; invisible spec, clear everything in one go. - ((and (memq 'headings types) - (memq 'drawers types)) - (org-flag-region (point-min) (point-max) nil 'outline)) - ((memq 'headings types) - (org-flag-region (point-min) (point-max) nil 'outline) - (org-cycle-hide-drawers 'all)) - ((memq 'drawers types) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward org-drawer-regexp nil t) - (let* ((pair (get-char-property-and-overlay (line-beginning-position) - 'invisible)) - (o (cdr-safe pair))) - (if (overlayp o) (goto-char (overlay-end o)) - (pcase (get-char-property-and-overlay (point) 'invisible) - (`(outline . ,o) - (goto-char (overlay-end o)) - (delete-overlay o)) - (_ nil)))))))))) - -;;;###autoload -(defun org-cycle (&optional arg) - "TAB-action and visibility cycling for Org mode. - -This is the command invoked in Org mode by the `TAB' key. Its main -purpose is outline visibility cycling, but it also invokes other actions -in special contexts. - -When this function is called with a `\\[universal-argument]' prefix, rotate \ -the entire -buffer through 3 states (global cycling) - 1. OVERVIEW: Show only top-level headlines. - 2. CONTENTS: Show all headlines of all levels, but no body text. - 3. SHOW ALL: Show everything. - -With a `\\[universal-argument] \\[universal-argument]' prefix argument, \ -switch to the startup visibility, -determined by the variable `org-startup-folded', and by any VISIBILITY -properties in the buffer. - -With a `\\[universal-argument] \\[universal-argument] \ -\\[universal-argument]' prefix argument, show the entire buffer, including -any drawers. - -When inside a table, re-align the table and move to the next field. - -When point is at the beginning of a headline, rotate the subtree started -by this line through 3 different states (local cycling) - 1. FOLDED: Only the main headline is shown. - 2. CHILDREN: The main headline and the direct children are shown. - From this state, you can move to one of the children - and zoom in further. - 3. SUBTREE: Show the entire subtree, including body text. -If there is no subtree, switch directly from CHILDREN to FOLDED. - -When point is at the beginning of an empty headline and the variable -`org-cycle-level-after-item/entry-creation' is set, cycle the level -of the headline by demoting and promoting it to likely levels. This -speeds up creation document structure by pressing `TAB' once or several -times right after creating a new headline. - -When there is a numeric prefix, go up to a heading with level ARG, do -a `show-subtree' and return to the previous cursor position. If ARG -is negative, go up that many levels. - -When point is not at the beginning of a headline, execute the global -binding for `TAB', which is re-indenting the line. See the option -`org-cycle-emulate-tab' for details. - -As a special case, if point is at the very beginning of the buffer, if -there is no headline there, and if the variable `org-cycle-global-at-bob' -is non-nil, this function acts as if called with prefix argument \ -\(`\\[universal-argument] TAB', -same as `S-TAB') also when called without prefix argument." - (interactive "P") - (org-load-modules-maybe) - (unless (or (run-hook-with-args-until-success 'org-tab-first-hook) - (and org-cycle-level-after-item/entry-creation - (or (org-cycle-level) - (org-cycle-item-indentation)))) - (let* ((limit-level - (or org-cycle-max-level - (and (boundp 'org-inlinetask-min-level) - org-inlinetask-min-level - (1- org-inlinetask-min-level)))) - (nstars - (and limit-level - (if org-odd-levels-only - (1- (* 2 limit-level)) - limit-level))) - (org-outline-regexp - (format "\\*%s " (if nstars (format "\\{1,%d\\}" nstars) "+")))) - (cond - ((equal arg '(16)) - (setq last-command 'dummy) - (org-set-startup-visibility) - (org-unlogged-message "Startup visibility, plus VISIBILITY properties")) - ((equal arg '(64)) - (org-show-all) - (org-unlogged-message "Entire buffer visible, including drawers")) - ((equal arg '(4)) (org-cycle-internal-global)) - ;; Show-subtree, ARG levels up from here. - ((integerp arg) - (save-excursion - (org-back-to-heading) - (outline-up-heading (if (< arg 0) (- arg) - (- (funcall outline-level) arg))) - (org-show-subtree))) - ;; Global cycling at BOB: delegate to `org-cycle-internal-global'. - ((and org-cycle-global-at-bob - (bobp) - (not (looking-at org-outline-regexp))) - (let ((org-cycle-hook - (remq 'org-optimize-window-after-visibility-change - org-cycle-hook))) - (org-cycle-internal-global))) - ;; Try CDLaTeX TAB completion. - ((org-try-cdlatex-tab)) - ;; Inline task: delegate to `org-inlinetask-toggle-visibility'. - ((and (featurep 'org-inlinetask) - (org-inlinetask-at-task-p) - (or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol)))) - (org-inlinetask-toggle-visibility)) - (t - (let ((pos (point)) - (element (org-element-at-point))) - (cond - ;; Try toggling visibility for block at point. - ((org-hide-block-toggle nil t element)) - ;; Try toggling visibility for drawer at point. - ((org-hide-drawer-toggle nil t element)) - ;; Table: enter it or move to the next field. - ((and (org-match-line "[ \t]*[|+]") - (org-element-lineage element '(table) t)) - (if (and (eq 'table (org-element-type element)) - (eq 'table.el (org-element-property :type element))) - (message (substitute-command-keys "\\<org-mode-map>\ -Use `\\[org-edit-special]' to edit table.el tables")) - (org-table-justify-field-maybe) - (call-interactively #'org-table-next-field))) - ((run-hook-with-args-until-success - 'org-tab-after-check-for-table-hook)) - ;; At an item/headline: delegate to `org-cycle-internal-local'. - ((and (or (and org-cycle-include-plain-lists - (let ((item (org-element-lineage element - '(item plain-list) - t))) - (and item - (= (line-beginning-position) - (org-element-property :post-affiliated - item))))) - (org-match-line org-outline-regexp)) - (or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol)))) - (org-cycle-internal-local)) - ;; From there: TAB emulation and template completion. - (buffer-read-only (org-back-to-heading)) - ((run-hook-with-args-until-success - 'org-tab-after-check-for-cycling-hook)) - ((run-hook-with-args-until-success - 'org-tab-before-tab-emulation-hook)) - ((and (eq org-cycle-emulate-tab 'exc-hl-bol) - (or (not (bolp)) - (not (looking-at org-outline-regexp)))) - (call-interactively (global-key-binding (kbd "TAB")))) - ((or (eq org-cycle-emulate-tab t) - (and (memq org-cycle-emulate-tab '(white whitestart)) - (save-excursion (beginning-of-line 1) (looking-at "[ \t]*")) - (or (and (eq org-cycle-emulate-tab 'white) - (= (match-end 0) (point-at-eol))) - (and (eq org-cycle-emulate-tab 'whitestart) - (>= (match-end 0) pos))))) - (call-interactively (global-key-binding (kbd "TAB")))) - (t - (save-excursion - (org-back-to-heading) - (org-cycle)))))))))) - -(defun org-cycle-internal-global () - "Do the global cycling action." - ;; Hack to avoid display of messages for .org attachments in Gnus - (let ((ga (string-match-p "\\*fontification" (buffer-name)))) - (cond - ((and (eq last-command this-command) - (eq org-cycle-global-status 'overview)) - ;; We just created the overview - now do table of contents - ;; This can be slow in very large buffers, so indicate action - (run-hook-with-args 'org-pre-cycle-hook 'contents) - (unless ga (org-unlogged-message "CONTENTS...")) - (org-content) - (unless ga (org-unlogged-message "CONTENTS...done")) - (setq org-cycle-global-status 'contents) - (run-hook-with-args 'org-cycle-hook 'contents)) - - ((and (eq last-command this-command) - (eq org-cycle-global-status 'contents)) - ;; We just showed the table of contents - now show everything - (run-hook-with-args 'org-pre-cycle-hook 'all) - (org-show-all '(headings blocks)) - (unless ga (org-unlogged-message "SHOW ALL")) - (setq org-cycle-global-status 'all) - (run-hook-with-args 'org-cycle-hook 'all)) - - (t - ;; Default action: go to overview - (run-hook-with-args 'org-pre-cycle-hook 'overview) - (org-overview) - (unless ga (org-unlogged-message "OVERVIEW")) - (setq org-cycle-global-status 'overview) - (run-hook-with-args 'org-cycle-hook 'overview))))) +;; FIXME: It was in the middle of visibility section. Where should it go to? (defvar org-called-with-limited-levels nil "Non-nil when `org-with-limited-levels' is currently active.") -(defun org-cycle-internal-local () - "Do the local cycling action." - (let ((goal-column 0) eoh eol eos has-children children-skipped struct) - ;; First, determine end of headline (EOH), end of subtree or item - ;; (EOS), and if item or heading has children (HAS-CHILDREN). - (save-excursion - (if (org-at-item-p) - (progn - (beginning-of-line) - (setq struct (org-list-struct)) - (setq eoh (point-at-eol)) - (setq eos (org-list-get-item-end-before-blank (point) struct)) - (setq has-children (org-list-has-child-p (point) struct))) - (org-back-to-heading) - (setq eoh (save-excursion (outline-end-of-heading) (point))) - (setq eos (save-excursion - (org-end-of-subtree t t) - (unless (eobp) (forward-char -1)) - (point))) - (setq has-children - (or - (save-excursion - (let ((level (funcall outline-level))) - (outline-next-heading) - (and (org-at-heading-p t) - (> (funcall outline-level) level)))) - (and (eq org-cycle-include-plain-lists 'integrate) - (save-excursion - (org-list-search-forward (org-item-beginning-re) eos t)))))) - ;; Determine end invisible part of buffer (EOL) - (beginning-of-line 2) - (while (and (not (eobp)) ;this is like `next-line' - (get-char-property (1- (point)) 'invisible)) - (goto-char (next-single-char-property-change (point) 'invisible)) - (and (eolp) (beginning-of-line 2))) - (setq eol (point))) - ;; Find out what to do next and set `this-command' - (cond - ((= eos eoh) - ;; Nothing is hidden behind this heading - (unless (org-before-first-heading-p) - (run-hook-with-args 'org-pre-cycle-hook 'empty)) - (org-unlogged-message "EMPTY ENTRY") - (setq org-cycle-subtree-status nil) - (save-excursion - (goto-char eos) - (outline-next-heading) - (when (org-invisible-p) (org-flag-heading nil)))) - ((and (or (>= eol eos) - (not (string-match "\\S-" (buffer-substring eol eos)))) - (or has-children - (not (setq children-skipped - org-cycle-skip-children-state-if-no-children)))) - ;; Entire subtree is hidden in one line: children view - (unless (org-before-first-heading-p) - (run-hook-with-args 'org-pre-cycle-hook 'children)) - (if (org-at-item-p) - (org-list-set-item-visibility (point-at-bol) struct 'children) - (org-show-entry) - (org-with-limited-levels (org-show-children)) - (org-show-set-visibility 'tree) - ;; Fold every list in subtree to top-level items. - (when (eq org-cycle-include-plain-lists 'integrate) - (save-excursion - (org-back-to-heading) - (while (org-list-search-forward (org-item-beginning-re) eos t) - (beginning-of-line 1) - (let* ((struct (org-list-struct)) - (prevs (org-list-prevs-alist struct)) - (end (org-list-get-bottom-point struct))) - (dolist (e (org-list-get-all-items (point) struct prevs)) - (org-list-set-item-visibility e struct 'folded)) - (goto-char (if (< end eos) end eos))))))) - (org-unlogged-message "CHILDREN") - (save-excursion - (goto-char eos) - (outline-next-heading) - (when (org-invisible-p) (org-flag-heading nil))) - (setq org-cycle-subtree-status 'children) - (unless (org-before-first-heading-p) - (run-hook-with-args 'org-cycle-hook 'children))) - ((or children-skipped - (and (eq last-command this-command) - (eq org-cycle-subtree-status 'children))) - ;; We just showed the children, or no children are there, - ;; now show everything. - (unless (org-before-first-heading-p) - (run-hook-with-args 'org-pre-cycle-hook 'subtree)) - (org-flag-region eoh eos nil 'outline) - (org-unlogged-message - (if children-skipped "SUBTREE (NO CHILDREN)" "SUBTREE")) - (setq org-cycle-subtree-status 'subtree) - (unless (org-before-first-heading-p) - (run-hook-with-args 'org-cycle-hook 'subtree))) - (t - ;; Default action: hide the subtree. - (run-hook-with-args 'org-pre-cycle-hook 'folded) - (org-flag-region eoh eos t 'outline) - (org-unlogged-message "FOLDED") - (setq org-cycle-subtree-status 'folded) - (unless (org-before-first-heading-p) - (run-hook-with-args 'org-cycle-hook 'folded)))))) - -;;;###autoload -(defun org-global-cycle (&optional arg) - "Cycle the global visibility. For details see `org-cycle'. -With `\\[universal-argument]' prefix ARG, switch to startup visibility. -With a numeric prefix, show all headlines up to that level." - (interactive "P") - (cond - ((integerp arg) - (org-content arg) - (setq org-cycle-global-status 'contents)) - ((equal arg '(4)) - (org-set-startup-visibility) - (org-unlogged-message "Startup visibility, plus VISIBILITY properties.")) - (t - (org-cycle '(4))))) - -(defun org-set-startup-visibility () - "Set the visibility required by startup options and properties." - (cond - ((eq org-startup-folded t) - (org-overview)) - ((eq org-startup-folded 'content) - (org-content)) - ((eq org-startup-folded 'show2levels) - (org-content 2)) - ((eq org-startup-folded 'show3levels) - (org-content 3)) - ((eq org-startup-folded 'show4levels) - (org-content 4)) - ((eq org-startup-folded 'show5levels) - (org-content 5)) - ((or (eq org-startup-folded 'showeverything) - (eq org-startup-folded nil)) - (org-show-all))) - (unless (eq org-startup-folded 'showeverything) - (when org-hide-block-startup (org-hide-block-all)) - (org-set-visibility-according-to-property) - (org-cycle-hide-archived-subtrees 'all) - (org-cycle-hide-drawers 'all) - (org-cycle-show-empty-lines t))) - -(defun org-set-visibility-according-to-property () - "Switch subtree visibility according to VISIBILITY property." - (interactive) - (let ((regexp (org-re-property "VISIBILITY"))) - (org-with-point-at 1 - (while (re-search-forward regexp nil t) - (let ((state (match-string 3))) - (if (not (org-at-property-p)) (outline-next-heading) - (save-excursion - (org-back-to-heading t) - (org-flag-subtree t) - (org-reveal) - (pcase state - ("folded" - (org-flag-subtree t)) - ("children" - (org-show-hidden-entry) - (org-show-children)) - ("content" - (save-excursion - (save-restriction - (org-narrow-to-subtree) - (org-content)))) - ((or "all" "showall") - (outline-show-subtree)) - (_ nil))) - (org-end-of-subtree))))))) - -(defun org-overview () - "Switch to overview mode, showing only top-level headlines." - (interactive) - (org-show-all '(headings drawers)) - (save-excursion - (goto-char (point-min)) - (when (re-search-forward org-outline-regexp-bol nil t) - (let* ((last (line-end-position)) - (level (- (match-end 0) (match-beginning 0) 1)) - (regexp (format "^\\*\\{1,%d\\} " level))) - (while (re-search-forward regexp nil :move) - (org-flag-region last (line-end-position 0) t 'outline) - (setq last (line-end-position)) - (setq level (- (match-end 0) (match-beginning 0) 1)) - (setq regexp (format "^\\*\\{1,%d\\} " level))) - (org-flag-region last (point) t 'outline))))) - -(defun org-content (&optional arg) - "Show all headlines in the buffer, like a table of contents. -With numerical argument N, show content up to level N." - (interactive "p") - (org-show-all '(headings drawers)) - (save-excursion - (goto-char (point-max)) - (let ((regexp (if (and (wholenump arg) (> arg 0)) - (format "^\\*\\{1,%d\\} " arg) - "^\\*+ ")) - (last (point))) - (while (re-search-backward regexp nil t) - (org-flag-region (line-end-position) last t 'outline) - (setq last (line-end-position 0)))))) - -(defvar org-scroll-position-to-restore nil - "Temporarily store scroll position to restore.") -(defun org-optimize-window-after-visibility-change (state) - "Adjust the window after a change in outline visibility. -This function is the default value of the hook `org-cycle-hook'." - (when (get-buffer-window (current-buffer)) - (let ((repeat (eq last-command this-command))) - (unless repeat - (setq org-scroll-position-to-restore nil)) - (cond - ((eq state 'content) nil) - ((eq state 'all) nil) - ((and org-scroll-position-to-restore repeat - (eq state 'folded)) - (set-window-start nil org-scroll-position-to-restore)) - ((eq state 'folded) nil) - ((eq state 'children) - (setq org-scroll-position-to-restore (window-start)) - (or (org-subtree-end-visible-p) (recenter 1))) - ((eq state 'subtree) - (unless repeat - (setq org-scroll-position-to-restore (window-start))) - (or (org-subtree-end-visible-p) (recenter 1))))))) - -(defun org-clean-visibility-after-subtree-move () - "Fix visibility issues after moving a subtree." - ;; First, find a reasonable region to look at: - ;; Start two siblings above, end three below - (let* ((beg (save-excursion - (and (org-get-previous-sibling) - (org-get-previous-sibling)) - (point))) - (end (save-excursion - (and (org-get-next-sibling) - (org-get-next-sibling) - (org-get-next-sibling)) - (if (org-at-heading-p) - (point-at-eol) - (point)))) - (level (looking-at "\\*+")) - (re (when level (concat "^" (regexp-quote (match-string 0)) " ")))) - (save-excursion - (save-restriction - (narrow-to-region beg end) - (when re - ;; Properly fold already folded siblings - (goto-char (point-min)) - (while (re-search-forward re nil t) - (when (and (not (org-invisible-p)) - (org-invisible-p (line-end-position))) - (outline-hide-entry)))) - (org-cycle-hide-drawers 'all) - (org-cycle-show-empty-lines 'overview))))) - -(defun org-cycle-show-empty-lines (state) - "Show empty lines above all visible headlines. -The region to be covered depends on STATE when called through -`org-cycle-hook'. Lisp program can use t for STATE to get the -entire buffer covered. Note that an empty line is only shown if there -are at least `org-cycle-separator-lines' empty lines before the headline." - (when (/= org-cycle-separator-lines 0) - (save-excursion - (let* ((n (abs org-cycle-separator-lines)) - (re (cond - ((= n 1) "\\(\n[ \t]*\n\\*+\\) ") - ((= n 2) "^[ \t]*\\(\n[ \t]*\n\\*+\\) ") - (t (let ((ns (number-to-string (- n 2)))) - (concat "^\\(?:[ \t]*\n\\)\\{" ns "," ns "\\}" - "[ \t]*\\(\n[ \t]*\n\\*+\\) "))))) - beg end) - (cond - ((memq state '(overview contents t)) - (setq beg (point-min) end (point-max))) - ((memq state '(children folded)) - (setq beg (point) - end (progn (org-end-of-subtree t t) - (line-beginning-position 2))))) - (when beg - (goto-char beg) - (while (re-search-forward re end t) - (unless (get-char-property (match-end 1) 'invisible) - (let ((e (match-end 1)) - (b (if (>= org-cycle-separator-lines 0) - (match-beginning 1) - (save-excursion - (goto-char (match-beginning 0)) - (skip-chars-backward " \t\n") - (line-end-position))))) - (org-flag-region b e nil 'outline)))))))) - ;; Never hide empty lines at the end of the file. - (save-excursion - (goto-char (point-max)) - (outline-previous-heading) - (outline-end-of-heading) - (when (and (looking-at "[ \t\n]+") - (= (match-end 0) (point-max))) - (org-flag-region (point) (match-end 0) nil 'outline)))) - -;;;; Reveal point location - -(defun org-show-context (&optional key) - "Make sure point and context are visible. -Optional argument KEY, when non-nil, is a symbol. See -`org-show-context-detail' for allowed values and how much is to -be shown." - (org-show-set-visibility - (cond ((symbolp org-show-context-detail) org-show-context-detail) - ((cdr (assq key org-show-context-detail))) - (t (cdr (assq 'default org-show-context-detail)))))) - -(defun org-show-set-visibility (detail) - "Set visibility around point according to 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-flag-heading nil) - (org-show-entry) - ;; If point is hidden within a drawer or a block, make sure to - ;; expose it. - (dolist (o (overlays-at (point))) - (when (memq (overlay-get o 'invisible) '(org-hide-block outline)) - (delete-overlay o))) - (unless (org-before-first-heading-p) - (org-with-limited-levels - (cl-case detail - ((tree canonical t) (org-show-children)) - ((nil minimal ancestors ancestors-full)) - (t (save-excursion - (outline-next-heading) - (org-flag-heading nil))))))) - ;; Show whole subtree. - (when (eq detail 'ancestors-full) (org-show-subtree)) - ;; Show all siblings. - (when (eq detail 'lineage) (org-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-flag-heading nil) - (when (memq detail '(canonical t)) (org-show-entry)) - (when (memq detail '(tree canonical t)) (org-show-children)))))) - -(defvar org-reveal-start-hook nil - "Hook run before revealing a location.") - -(defun org-reveal (&optional siblings) - "Show current entry, hierarchy above it, and the following headline. - -This can be used to show a consistent set of context around -locations exposed with `org-show-context'. - -With optional argument SIBLINGS, on each level of the hierarchy all -siblings are shown. This repairs the tree structure to what it would -look like when opened with hierarchical calls to `org-cycle'. - -With a \\[universal-argument] \\[universal-argument] prefix, \ -go to the parent and show the entire tree." - (interactive "P") - (run-hooks 'org-reveal-start-hook) - (cond ((equal siblings '(4)) (org-show-set-visibility 'canonical)) - ((equal siblings '(16)) - (save-excursion - (when (org-up-heading-safe) - (org-show-subtree) - (run-hook-with-args 'org-cycle-hook 'subtree)))) - (t (org-show-set-visibility 'lineage)))) - \f ;;; Indirect buffer display of subtrees @@ -7642,6 +6542,36 @@ (defun org-move-subtree-up (&optional arg) (interactive "p") (org-move-subtree-down (- (prefix-numeric-value arg)))) +(defun org-clean-visibility-after-subtree-move () + "Fix visibility issues after moving a subtree." + ;; First, find a reasonable region to look at: + ;; Start two siblings above, end three below + (let* ((beg (save-excursion + (and (org-get-previous-sibling) + (org-get-previous-sibling)) + (point))) + (end (save-excursion + (and (org-get-next-sibling) + (org-get-next-sibling) + (org-get-next-sibling)) + (if (org-at-heading-p) + (point-at-eol) + (point)))) + (level (looking-at "\\*+")) + (re (when level (concat "^" (regexp-quote (match-string 0)) " ")))) + (save-excursion + (save-restriction + (narrow-to-region beg end) + (when re + ;; Properly fold already folded siblings + (goto-char (point-min)) + (while (re-search-forward re nil t) + (when (and (not (org-invisible-p)) + (org-invisible-p (line-end-position))) + (org-fold-heading nil)))) + (org-cycle-hide-drawers 'all) + (org-cycle-show-empty-lines 'overview))))) + (defun org-move-subtree-down (&optional arg) "Move the current subtree down past ARG headlines of the same level." (interactive "p") @@ -16945,6 +15875,14 @@ (defun org-remove-inline-images () (defvar org-self-insert-command-undo-counter 0) (defvar org-speed-command nil) +(defun org-fix-tags-on-the-fly () + "Align tags in headline at point. +Unlike `org-align-tags', this function does nothing if point is +either not currently on a tagged headline or on a tag." + (when (and (org-match-line org-tag-line-re) + (< (point) (match-beginning 1))) + (org-align-tags))) + (defun org-self-insert-command (N) "Like `self-insert-command', use overwrite-mode for whitespace in tables. If the cursor is in a table looking at whitespace, the whitespace is @@ -17012,80 +15950,6 @@ (defun org-self-insert-command (N) (setq org-self-insert-command-undo-counter (1+ org-self-insert-command-undo-counter)))))))) -(defun org-check-before-invisible-edit (kind) - "Check if editing kind KIND would be dangerous with invisible text around. -The detailed reaction depends on the user option `org-catch-invisible-edits'." - ;; First, try to get out of here as quickly as possible, to reduce overhead - (when (and org-catch-invisible-edits - (or (not (boundp 'visible-mode)) (not visible-mode)) - (or (get-char-property (point) 'invisible) - (get-char-property (max (point-min) (1- (point))) 'invisible))) - ;; OK, we need to take a closer look. Do not consider - ;; invisibility obtained through text properties (e.g., link - ;; fontification), as it cannot be toggled. - (let* ((invisible-at-point - (pcase (get-char-property-and-overlay (point) 'invisible) - (`(,_ . ,(and (pred overlayp) o)) o))) - ;; Assume that point cannot land in the middle of an - ;; overlay, or between two overlays. - (invisible-before-point - (and (not invisible-at-point) - (not (bobp)) - (pcase (get-char-property-and-overlay (1- (point)) 'invisible) - (`(,_ . ,(and (pred overlayp) o)) o)))) - (border-and-ok-direction - (or - ;; Check if we are acting predictably before invisible - ;; text. - (and invisible-at-point - (memq kind '(insert delete-backward))) - ;; Check if we are acting predictably after invisible text - ;; This works not well, and I have turned it off. It seems - ;; better to always show and stop after invisible text. - ;; (and (not invisible-at-point) invisible-before-point - ;; (memq kind '(insert delete))) - ))) - (when (or invisible-at-point invisible-before-point) - (when (eq org-catch-invisible-edits 'error) - (user-error "Editing in invisible areas is prohibited, make them visible first")) - (if (and org-custom-properties-overlays - (y-or-n-p "Display invisible properties in this buffer? ")) - (org-toggle-custom-properties-visibility) - ;; Make the area visible - (save-excursion - (when invisible-before-point - (goto-char - (previous-single-char-property-change (point) 'invisible))) - ;; Remove whatever overlay is currently making yet-to-be - ;; edited text invisible. Also remove nested invisibility - ;; related overlays. - (delete-overlay (or invisible-at-point invisible-before-point)) - (let ((origin (if invisible-at-point (point) (1- (point))))) - (while (pcase (get-char-property-and-overlay origin 'invisible) - (`(,_ . ,(and (pred overlayp) o)) - (delete-overlay o) - t))))) - (cond - ((eq org-catch-invisible-edits 'show) - ;; That's it, we do the edit after showing - (message - "Unfolding invisible region around point before editing") - (sit-for 1)) - ((and (eq org-catch-invisible-edits 'smart) - border-and-ok-direction) - (message "Unfolding invisible region around point before editing")) - (t - ;; Don't do the edit, make the user repeat it in full visibility - (user-error "Edit in invisible region aborted, repeat to confirm with text visible")))))))) - -(defun org-fix-tags-on-the-fly () - "Align tags in headline at point. -Unlike `org-align-tags', this function does nothing if point is -either not currently on a tagged headline or on a tag." - (when (and (org-match-line org-tag-line-re) - (< (point) (match-beginning 1))) - (org-align-tags))) - (defun org-delete-backward-char (N) "Like `delete-backward-char', insert whitespace at field end in tables. When deleting backwards, in tables this function will insert whitespace in @@ -17197,16 +16061,6 @@ (defvar org-ctrl-c-ctrl-c-final-hook nil it should do its thing and then return a non-nil value. If the context is wrong, just do nothing and return nil.") -(defvar org-tab-first-hook nil - "Hook for functions to attach themselves to TAB. -See `org-ctrl-c-ctrl-c-hook' for more information. -This hook runs as the first action when TAB is pressed, even before -`org-cycle' messes around with the `outline-regexp' to cater for -inline tasks and plain list item folding. -If any function in this hook returns t, any other actions that -would have been caused by TAB (such as table field motion or visibility -cycling) will not occur.") - (defvar org-tab-after-check-for-table-hook nil "Hook for functions to attach themselves to TAB. See `org-ctrl-c-ctrl-c-hook' for more information. @@ -18135,25 +16989,6 @@ (defun org-mode-restart () (org-reset-file-cache)) (message "%s restarted" major-mode)) -(defun org-flag-above-first-heading (&optional arg) - "Hide from bob up to the first heading. -Move point to the beginning of first heading or end of buffer." - (goto-char (point-min)) - (unless (org-at-heading-p) - (outline-next-heading)) - (unless (bobp) - (org-flag-region 1 (1- (point)) (not arg) 'outline))) - -(defun org-show-branches-buffer () - "Show all branches in the buffer." - (org-flag-above-first-heading) - (outline-hide-sublevels 1) - (unless (eobp) - (outline-show-branches) - (while (outline-get-next-sibling) - (outline-show-branches))) - (goto-char (point-min))) - (defun org-kill-note-or-show-branches () "Abort storing current note, or show just branches." (interactive) @@ -20966,14 +19801,6 @@ (defun org-goto-sibling (&optional previous) (goto-char pos) nil)))) -(defun org-show-siblings () - "Show all siblings of the current headline." - (save-excursion - (while (org-goto-sibling) (org-flag-heading nil))) - (save-excursion - (while (org-goto-sibling 'previous) - (org-flag-heading nil)))) - (defun org-goto-first-child (&optional element) "Goto the first child, even if it is invisible. Return t when a child was found. Otherwise don't move point and @@ -21002,25 +19829,6 @@ (defun org-goto-first-child (&optional element) (progn (goto-char (match-beginning 0)) t) (goto-char pos) nil))))) -(defun org-show-hidden-entry () - "Show an entry where even the heading is hidden." - (save-excursion - (org-show-entry))) - -(defun org-flag-heading (flag &optional entry) - "Flag the current heading. FLAG non-nil means make invisible. -When ENTRY is non-nil, show the entire entry." - (save-excursion - (org-back-to-heading t) - ;; Check if we should show the entire entry - (if (not entry) - (org-flag-region - (line-end-position 0) (line-end-position) flag 'outline) - (org-show-entry) - (save-excursion - (and (outline-next-heading) - (org-flag-heading nil)))))) - (defun org-get-next-sibling () "Move to next heading of the same level, and return point. If there is no such heading, return nil. -- 2.35.1 -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH v2 05/38] Disable native-comp in agendaIt caused cryptic bugs in the past. 2022-04-20 13:23 ` [PATCH v2 00/38] Final call for comments: " Ihor Radchenko ` (3 preceding siblings ...) 2022-04-20 13:24 ` [PATCH v2 04/38] Remove functions from org.el that are now moved elsewhere Ihor Radchenko @ 2022-04-20 13:24 ` Ihor Radchenko 2022-04-20 13:24 ` [PATCH v2 06/38] org-macs: New function org-find-text-property-region--- Ihor Radchenko ` (36 subsequent siblings) 41 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-04-20 13:24 UTC (permalink / raw) To: emacs-orgmode It caused cryptic bugs in the past. --- lisp/org-agenda.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index a09b53563..b55e00803 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -1,4 +1,4 @@ -;;; org-agenda.el --- Dynamic task and appointment lists for Org -*- lexical-binding: t; -*- +;;; org-agenda.el --- Dynamic task and appointment lists for Org -*- lexical-binding: t; no-native-compile: t; -*- ;; Copyright (C) 2004-2022 Free Software Foundation, Inc. -- 2.35.1 -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH v2 06/38] org-macs: New function org-find-text-property-region--- 2022-04-20 13:23 ` [PATCH v2 00/38] Final call for comments: " Ihor Radchenko ` (4 preceding siblings ...) 2022-04-20 13:24 ` [PATCH v2 05/38] Disable native-comp in agendaIt caused cryptic bugs in the past Ihor Radchenko @ 2022-04-20 13:24 ` Ihor Radchenko 2022-04-20 13:24 ` [PATCH v2 07/38] org-at-heading-p: Accept optional argument* lisp/org.el (org-at-heading-p): Use second argument to allow Ihor Radchenko ` (35 subsequent siblings) 41 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-04-20 13:24 UTC (permalink / raw) To: emacs-orgmode --- lisp/org-macs.el | 32 +++++++++++++++++--------------- lisp/org.el | 7 ++++++- 2 files changed, 23 insertions(+), 16 deletions(-) diff --git a/lisp/org-macs.el b/lisp/org-macs.el index a09115e7c..6161a7bfc 100644 --- a/lisp/org-macs.el +++ b/lisp/org-macs.el @@ -728,7 +728,7 @@ (defsubst org-current-line (&optional pos) \f -;;; Overlays +;;; Overlays and text properties (defun org-overlay-display (ovl text &optional face evap) "Make overlay OVL display TEXT with face FACE." @@ -751,20 +751,22 @@ (defun org-find-overlays (prop &optional pos delete) (delete (delete-overlay ov)) (t (push ov found)))))) -(defun org-flag-region (from to flag spec) - "Hide or show lines from FROM to TO, according to FLAG. -SPEC is the invisibility spec, as a symbol." - (remove-overlays from to 'invisible spec) - ;; Use `front-advance' since text right before to the beginning of - ;; the overlay belongs to the visible line than to the contents. - (when flag - (let ((o (make-overlay from to nil 'front-advance))) - (overlay-put o 'evaporate t) - (overlay-put o 'invisible spec) - (overlay-put o - 'isearch-open-invisible - (lambda (&rest _) (org-show-context 'isearch)))))) - +(defun org-find-text-property-region (pos prop) + "Find a region around POS containing same non-nil value of PROP text property. +Return nil when PROP is not set at POS." + (let* ((beg (and (get-text-property pos prop) pos)) + (end beg)) + (when beg + (unless (or (equal beg (point-min)) + (not (eq (get-text-property beg prop) + (get-text-property (1- beg) prop)))) + (setq beg (previous-single-property-change pos prop nil (point-min)))) + (unless (or (equal end (point-max)) + ;; (not (eq (get-text-property end prop) + ;; (get-text-property (1+ end) prop))) + ) + (setq end (next-single-property-change pos prop nil (point-max)))) + (cons beg end)))) \f ;;; Regexp matching diff --git a/lisp/org.el b/lisp/org.el index 855f0813d..b9d2d7834 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -5597,7 +5597,10 @@ (defun org-fontify-like-in-org-mode (s &optional odd-levels) (let ((org-odd-levels-only odd-levels)) (org-mode) (org-font-lock-ensure) - (buffer-string)))) + (if org-link-descriptive + (org-link-display-format + (buffer-string)) + (buffer-string))))) (defun org-get-level-face (n) "Get the right face for match N in font-lock matching of headlines." @@ -5727,6 +5730,8 @@ (defun org-raise-scripts (limit) (if (equal (char-after (match-beginning 2)) ?^) (nth (if table-p 3 1) org-script-display) (nth (if table-p 2 0) org-script-display))) + (put-text-property (match-beginning 2) (match-end 3) + 'org-emphasis t) (add-text-properties (match-beginning 2) (match-end 2) (list 'invisible t)) (when (and (eq (char-after (match-beginning 3)) ?{) -- 2.35.1 -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH v2 07/38] org-at-heading-p: Accept optional argument* lisp/org.el (org-at-heading-p): Use second argument to allow 2022-04-20 13:23 ` [PATCH v2 00/38] Final call for comments: " Ihor Radchenko ` (5 preceding siblings ...) 2022-04-20 13:24 ` [PATCH v2 06/38] org-macs: New function org-find-text-property-region--- Ihor Radchenko @ 2022-04-20 13:24 ` Ihor Radchenko 2022-04-20 13:25 ` [PATCH v2 08/38] org-string-width: Reimplement to work with new folding Ihor Radchenko ` (34 subsequent siblings) 41 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-04-20 13:24 UTC (permalink / raw) To: emacs-orgmode * lisp/org.el (org-at-heading-p): Use second argument to allow checking for visible headings. Note that by default, unlike `outline-on-heading-p', `org-at-heading-p' returns non-nil for invisible headings. Passing second argument is just like `(outline-on-heading-p)'. (org-indent-line): * lisp/org-agenda.el (org-agenda-add-entry-to-org-agenda-diary-file): * lisp/org-colview.el (org-columns--call): (org-columns-store-format): Update arguments in `org-at-heading-p' calls. --- lisp/org-agenda.el | 2 +- lisp/org-colview.el | 4 ++-- lisp/org.el | 14 +++++++++----- 3 files changed, 12 insertions(+), 8 deletions(-) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index b55e00803..862243f28 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -10527,7 +10527,7 @@ (defun org-agenda-add-entry-to-org-agenda-diary-file (type text &optional d1 d2) (anniversary (or (re-search-forward "^\\*[ \t]+Anniversaries" nil t) (progn - (or (org-at-heading-p t) + (or (org-at-heading-p) (progn (outline-next-heading) (insert "* Anniversaries\n\n") diff --git a/lisp/org-colview.el b/lisp/org-colview.el index 082d6def0..15cab35f0 100644 --- a/lisp/org-colview.el +++ b/lisp/org-colview.el @@ -699,7 +699,7 @@ (defun org-columns--call (fun) (let ((hide-body (and (/= (line-end-position) (point-max)) (save-excursion (move-beginning-of-line 2) - (org-at-heading-p t))))) + (org-at-heading-p))))) (unwind-protect (funcall fun) (when hide-body (outline-hide-entry))))) @@ -1026,7 +1026,7 @@ (defun org-columns-store-format () ;; No COLUMNS keyword in the buffer. Insert one at the ;; beginning, right before the first heading, if any. (goto-char (point-min)) - (unless (org-at-heading-p t) (outline-next-heading)) + (unless (org-at-heading-p) (outline-next-heading)) (let ((inhibit-read-only t)) (insert-before-markers "#+COLUMNS: " fmt "\n")))) (setq-local org-columns-default-format fmt)))))) diff --git a/lisp/org.el b/lisp/org.el index b9d2d7834..8c823a7c8 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -17259,7 +17259,7 @@ (defun org-toggle-heading (&optional nstars) ;; Case 1. Started at an heading: de-star headings. ((org-at-heading-p) (while (< (point) end) - (when (org-at-heading-p t) + (when (org-at-heading-p) (looking-at org-outline-regexp) (replace-match "") (setq toggled t)) (forward-line))) @@ -17861,7 +17861,7 @@ (defun org-context () (p (point)) clist o) ;; First the large context (cond - ((org-at-heading-p t) + ((org-at-heading-p) (push (list :headline (point-at-bol) (point-at-eol)) clist) (when (progn (beginning-of-line 1) @@ -19611,9 +19611,13 @@ (defun org-before-first-heading-p () (end-of-line) (null (re-search-backward org-outline-regexp-bol nil t)))))) -(defun org-at-heading-p (&optional _) - "Non-nil when on a headline." - (outline-on-heading-p t)) +(defun org-at-heading-p (&optional invisible-not-ok) + "Return t if point is on a (possibly invisible) heading line. +If INVISIBLE-NOT-OK is non-nil, an invisible heading line is not ok." + (save-excursion + (beginning-of-line) + (and (bolp) (or (not invisible-not-ok) (not (org-fold-folded-p))) + (looking-at outline-regexp)))) (defun org-in-commented-heading-p (&optional no-inheritance element) "Non-nil if point is under a commented heading. -- 2.35.1 -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH v2 08/38] org-string-width: Reimplement to work with new folding 2022-04-20 13:23 ` [PATCH v2 00/38] Final call for comments: " Ihor Radchenko ` (6 preceding siblings ...) 2022-04-20 13:24 ` [PATCH v2 07/38] org-at-heading-p: Accept optional argument* lisp/org.el (org-at-heading-p): Use second argument to allow Ihor Radchenko @ 2022-04-20 13:25 ` Ihor Radchenko 2022-04-20 13:25 ` [PATCH v2 09/38] Rename old function call to use org-fold--- Ihor Radchenko ` (33 subsequent siblings) 41 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-04-20 13:25 UTC (permalink / raw) To: emacs-orgmode * lisp/org-macs.el (org--string-from-props): Removed since it is no longer needed. (org-string-width): Updated to use `window-text-pixel-size'. --- lisp/org-macs.el | 121 ++++++++++++++++++++++------------------------- 1 file changed, 57 insertions(+), 64 deletions(-) diff --git a/lisp/org-macs.el b/lisp/org-macs.el index 6161a7bfc..f63458f70 100644 --- a/lisp/org-macs.el +++ b/lisp/org-macs.el @@ -889,71 +889,64 @@ (defun org-split-string (string &optional separators) results ;skip trailing separator (cons (substring string i) results))))))) -(defun org--string-from-props (s property beg end) - "Return the visible part of string S. -Visible part is determined according to text PROPERTY, which is -either `invisible' or `display'. BEG and END are 0-indices -delimiting S." - (let ((width 0) - (cursor beg)) - (while (setq beg (text-property-not-all beg end property nil s)) - (let* ((next (next-single-property-change beg property s end)) - (props (text-properties-at beg s)) - (spec (plist-get props property)) - (value - (pcase property - (`invisible - ;; If `invisible' property in PROPS means text is to - ;; be invisible, return 0. Otherwise return nil so - ;; as to resume search. - (and (or (eq t buffer-invisibility-spec) - (assoc-string spec buffer-invisibility-spec)) - 0)) - (`display - (pcase spec - (`nil nil) - (`(space . ,props) - (let ((width (plist-get props :width))) - (and (wholenump width) width))) - (`(image . ,_) - (and (fboundp 'image-size) - (ceiling (car (image-size spec))))) - ((pred stringp) - ;; Displayed string could contain invisible parts, - ;; but no nested display. - (org--string-from-props spec 'invisible 0 (length spec))) - (_ - ;; Un-handled `display' value. Ignore it. - ;; Consider the original string instead. - nil))) - (_ (error "Unknown property: %S" property))))) - (when value - (cl-incf width - ;; When looking for `display' parts, we still need - ;; to look for `invisible' property elsewhere. - (+ (cond ((eq property 'display) - (org--string-from-props s 'invisible cursor beg)) - ((= cursor beg) 0) - (t (string-width (substring s cursor beg)))) - value)) - (setq cursor next)) - (setq beg next))) - (+ width - ;; Look for `invisible' property in the last part of the - ;; string. See above. - (cond ((eq property 'display) - (org--string-from-props s 'invisible cursor end)) - ((= cursor end) 0) - (t (string-width (substring s cursor end))))))) - -(defun org-string-width (string) +(defun org-string-width (string &optional pixels) "Return width of STRING when displayed in the current buffer. -Unlike `string-width', this function takes into consideration -`invisible' and `display' text properties. It supports the -latter in a limited way, mostly for combinations used in Org. -Results may be off sometimes if it cannot handle a given -`display' value." - (org--string-from-props string 'display 0 (length string))) +Return width in pixels when PIXELS is non-nil." + ;; Wrap/line prefix will make `window-text-pizel-size' return too + ;; large value including the prefix. + ;; Face should be removed to make sure that all the string symbols + ;; are using default face with constant width. Constant char width + ;; is critical to get right string width from pixel width. + (remove-text-properties 0 (length string) + '(wrap-prefix t line-prefix t face t) + string) + (let (;; We need to remove the folds to make sure that folded table + ;; alignment is not messed up. + (current-invisibility-spec + (or (and (not (listp buffer-invisibility-spec)) + buffer-invisibility-spec) + (let (result) + (dolist (el buffer-invisibility-spec) + (unless (or (memq el + '(org-fold-drawer + org-fold-block + org-fold-outline)) + (and (listp el) + (memq (car el) + '(org-fold-drawer + org-fold-block + org-fold-outline)))) + (push el result))) + result))) + (current-char-property-alias-alist char-property-alias-alist)) + (with-temp-buffer + (setq-local display-line-numbers nil) + (setq-local buffer-invisibility-spec + current-invisibility-spec) + (setq-local char-property-alias-alist + current-char-property-alias-alist) + (let (pixel-width symbol-width) + (with-silent-modifications + (setf (buffer-string) string) + (setq pixel-width + (if (get-buffer-window (current-buffer)) + (car (window-text-pixel-size + nil (line-beginning-position) (point-max))) + (set-window-buffer nil (current-buffer)) + (car (window-text-pixel-size + nil (line-beginning-position) (point-max))))) + (unless pixels + (setf (buffer-string) "a") + (setq symbol-width + (if (get-buffer-window (current-buffer)) + (car (window-text-pixel-size + nil (line-beginning-position) (point-max))) + (set-window-buffer nil (current-buffer)) + (car (window-text-pixel-size + nil (line-beginning-position) (point-max))))))) + (if pixels + pixel-width + (/ pixel-width symbol-width)))))) (defun org-not-nil (v) "If V not nil, and also not the string \"nil\", then return V. -- 2.35.1 -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH v2 09/38] Rename old function call to use org-fold--- 2022-04-20 13:23 ` [PATCH v2 00/38] Final call for comments: " Ihor Radchenko ` (7 preceding siblings ...) 2022-04-20 13:25 ` [PATCH v2 08/38] org-string-width: Reimplement to work with new folding Ihor Radchenko @ 2022-04-20 13:25 ` Ihor Radchenko 2022-04-20 13:25 ` [PATCH v2 10/38] Implement link folding* lisp/ol.el (org-link--link-folding-spec): Ihor Radchenko ` (32 subsequent siblings) 41 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-04-20 13:25 UTC (permalink / raw) To: emacs-orgmode --- lisp/ob-core.el | 14 ++-- lisp/ob-lilypond.el | 4 +- lisp/ob-ref.el | 4 +- lisp/ol.el | 13 ++-- lisp/org-agenda.el | 43 +++++------ lisp/org-archive.el | 12 +-- lisp/org-capture.el | 2 +- lisp/org-clock.el | 10 +-- lisp/org-colview.el | 6 +- lisp/org-compat.el | 29 ++++---- lisp/org-crypt.el | 8 +- lisp/org-element.el | 1 + lisp/org-feed.el | 4 +- lisp/org-footnote.el | 6 +- lisp/org-goto.el | 6 +- lisp/org-id.el | 4 +- lisp/org-keys.el | 26 +++---- lisp/org-lint.el | 3 +- lisp/org-list.el | 10 ++- lisp/org-macs.el | 40 ++-------- lisp/org-mobile.el | 2 +- lisp/org-mouse.el | 4 +- lisp/org-refile.el | 2 +- lisp/org-src.el | 6 +- lisp/org-timer.el | 2 +- lisp/org.el | 135 +++++++++++++++++++--------------- lisp/ox-org.el | 2 +- testing/lisp/test-org-list.el | 2 +- testing/lisp/test-org.el | 78 ++++++++++---------- 29 files changed, 241 insertions(+), 237 deletions(-) diff --git a/lisp/ob-core.el b/lisp/ob-core.el index 239a57f96..6590eeee7 100644 --- a/lisp/ob-core.el +++ b/lisp/ob-core.el @@ -26,7 +26,9 @@ ;;; Code: (require 'cl-lib) (require 'ob-eval) (require 'org-macs) +(require 'org-fold) (require 'org-compat) +(require 'org-cycle) (defconst org-babel-exeext (if (memq system-type '(windows-nt cygwin)) @@ -50,7 +52,7 @@ (declare-function org-babel-ref-resolve "ob-ref" (ref)) (declare-function org-babel-ref-split-args "ob-ref" (arg-string)) (declare-function org-babel-tangle-comment-links "ob-tangle" (&optional info)) (declare-function org-current-level "org" ()) -(declare-function org-cycle "org" (&optional arg)) +(declare-function org-cycle "org-cycle" (&optional arg)) (declare-function org-edit-src-code "org-src" (&optional code edit-buffer-name)) (declare-function org-edit-src-exit "org-src" ()) (declare-function org-element-at-point "org-element" (&optional pom cached-only)) @@ -75,7 +77,7 @@ (declare-function org-narrow-to-subtree "org" (&optional element)) (declare-function org-next-block "org" (arg &optional backward block-regexp)) (declare-function org-open-at-point "org" (&optional in-emacs reference-buffer)) (declare-function org-previous-block "org" (arg &optional block-regexp)) -(declare-function org-show-context "org" (&optional key)) +(declare-function org-fold-show-context "org-fold" (&optional key)) (declare-function org-src-coderef-format "org-src" (&optional element)) (declare-function org-src-coderef-regexp "org-src" (fmt &optional label)) (declare-function org-src-get-lang-mode "org-src" (lang)) @@ -945,7 +947,7 @@ (defun org-babel-enter-header-arg-w-completion (&optional lang) (insert (concat header " " (or arg ""))) (cons header arg))) -(add-hook 'org-tab-first-hook 'org-babel-header-arg-expand) +(add-hook 'org-cycle-tab-first-hook 'org-babel-header-arg-expand) ;;;###autoload (defun org-babel-load-in-session (&optional _arg info) @@ -1469,7 +1471,7 @@ (defun org-babel-hide-result-toggle (&optional force) (push ov org-babel-hide-result-overlays))))) ;; org-tab-after-check-for-cycling-hook -(add-hook 'org-tab-first-hook #'org-babel-hide-result-toggle-maybe) +(add-hook 'org-cycle-tab-first-hook #'org-babel-hide-result-toggle-maybe) ;; Remove overlays when changing major mode (add-hook 'org-mode-hook (lambda () (add-hook 'change-major-mode-hook @@ -1817,7 +1819,7 @@ (defun org-babel-goto-named-src-block (name) (let ((point (org-babel-find-named-block name))) (if point ;; Taken from `org-open-at-point'. - (progn (org-mark-ring-push) (goto-char point) (org-show-context)) + (progn (org-mark-ring-push) (goto-char point) (org-fold-show-context)) (message "source-code block `%s' not found in this buffer" name)))) (defun org-babel-find-named-block (name) @@ -1857,7 +1859,7 @@ (defun org-babel-goto-named-result (name) (let ((point (org-babel-find-named-result name))) (if point ;; taken from `org-open-at-point' - (progn (goto-char point) (org-show-context)) + (progn (goto-char point) (org-fold-show-context)) (message "result `%s' not found in this buffer" name)))) (defun org-babel-find-named-result (name) diff --git a/lisp/ob-lilypond.el b/lisp/ob-lilypond.el index 15538b503..df128441a 100644 --- a/lisp/ob-lilypond.el +++ b/lisp/ob-lilypond.el @@ -34,7 +34,7 @@ ;;; Commentary: ;;; Code: (require 'ob) -(declare-function org-show-all "org" (&optional types)) +(declare-function org-fold-show-all "org-fold" (&optional types)) (defalias 'lilypond-mode 'LilyPond-mode) @@ -279,7 +279,7 @@ (defun org-babel-lilypond-mark-error-line (file-name line) (setq case-fold-search nil) (if (search-forward line nil t) (progn - (org-show-all) + (org-fold-show-all) (set-mark (point)) (goto-char (- (point) (length line)))) (goto-char temp)))) diff --git a/lisp/ob-ref.el b/lisp/ob-ref.el index db8ced6b6..1a77e39b1 100644 --- a/lisp/ob-ref.el +++ b/lisp/ob-ref.el @@ -62,8 +62,8 @@ (declare-function org-find-property "org" (property &optional value)) (declare-function org-id-find-id-file "org-id" (id)) (declare-function org-id-find-id-in-file "org-id" (id file &optional markerp)) (declare-function org-in-commented-heading-p "org" (&optional no-inheritance)) -(declare-function org-show-context "org" (&optional key)) (declare-function org-narrow-to-subtree "org" (&optional element)) +(declare-function org-fold-show-context "org-fold" (&optional key)) (defvar org-babel-update-intermediate nil "Update the in-buffer results of code blocks executed to resolve references.") @@ -104,7 +104,7 @@ (defun org-babel-ref-goto-headline-id (id) (pop-to-buffer-same-window (marker-buffer m)) (goto-char m) (move-marker m nil) - (org-show-context) + (org-fold-show-context) t)))) (defun org-babel-ref-headline-body () diff --git a/lisp/ol.el b/lisp/ol.el index 1b2bb9a9a..4cc813d5b 100644 --- a/lisp/ol.el +++ b/lisp/ol.el @@ -29,6 +29,7 @@ ;;; Code: (require 'org-compat) (require 'org-macs) +(require 'org-fold) (defvar clean-buffer-list-kill-buffer-names) (defvar org-agenda-buffer-name) @@ -66,10 +67,10 @@ (declare-function org-mark-ring-push "org" (&optional pos buffer)) (declare-function org-mode "org" ()) (declare-function org-occur "org" (regexp &optional keep-previous callback)) (declare-function org-open-file "org" (path &optional in-emacs line search)) -(declare-function org-overview "org" ()) +(declare-function org-cycle-overview "org-cycle" ()) (declare-function org-restart-font-lock "org" ()) (declare-function org-run-like-in-org-mode "org" (cmd)) -(declare-function org-show-context "org" (&optional key)) +(declare-function org-fold-show-context "org-fold" (&optional key)) (declare-function org-src-coderef-format "org-src" (&optional element)) (declare-function org-src-coderef-regexp "org-src" (fmt &optional label)) (declare-function org-src-edit-buffer-p "org-src" (&optional buffer)) @@ -700,7 +701,7 @@ (defun org-link--buffer-for-internals () (make-indirect-buffer (current-buffer) indirect-buffer-name 'clone)))) - (with-current-buffer indirect-buffer (org-overview)) + (with-current-buffer indirect-buffer (org-cycle-overview)) indirect-buffer)))) (defun org-link--search-radio-target (target) @@ -718,7 +719,7 @@ (defun org-link--search-radio-target (target) (let ((object (org-element-context))) (when (eq (org-element-type object) 'radio-target) (goto-char (org-element-property :begin object)) - (org-show-context 'link-search) + (org-fold-show-context 'link-search) (throw :radio-match nil)))) (goto-char origin) (user-error "No match for radio target: %s" target)))) @@ -1257,7 +1258,7 @@ (defun org-link-search (s &optional avoid-pos stealth) (error "No match for fuzzy expression: %s" normalized))) ;; Disclose surroundings of match, if appropriate. (when (and (derived-mode-p 'org-mode) (not stealth)) - (org-show-context 'link-search)) + (org-fold-show-context 'link-search)) type)) (defun org-link-heading-search-string (&optional string) @@ -1430,7 +1431,7 @@ (defun org-next-link (&optional search-backward) (`nil nil) (link (goto-char (org-element-property :begin link)) - (when (org-invisible-p) (org-show-context)) + (when (org-invisible-p) (org-fold-show-context)) (throw :found t))))) (goto-char pos) (setq org-link--search-failed t) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index 862243f28..fa60f4f19 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -47,6 +47,7 @@ ;;; Code: (require 'cl-lib) (require 'ol) +(require 'org-fold-core) (require 'org) (require 'org-macs) (require 'org-refile) @@ -9393,7 +9394,7 @@ (defun org-agenda-goto (&optional highlight) (push-mark) (goto-char pos) (when (derived-mode-p 'org-mode) - (org-show-context 'agenda) + (org-fold-show-context 'agenda) (recenter (/ (window-height) 2)) (org-back-to-heading t) (let ((case-fold-search nil)) @@ -9682,7 +9683,7 @@ (defun org-agenda-switch-to (&optional delete-other-windows) (widen) (goto-char pos) (when (derived-mode-p 'org-mode) - (org-show-context 'agenda) + (org-fold-show-context 'agenda) (run-hooks 'org-agenda-after-show-hook))))) (defun org-agenda-goto-mouse (ev) @@ -9698,7 +9699,7 @@ (defun org-agenda-show (&optional full-entry) (interactive "P") (let ((win (selected-window))) (org-agenda-goto t) - (when full-entry (org-show-entry)) + (when full-entry (org-fold-show-entry)) (select-window win))) (defvar org-agenda-show-window nil) @@ -9717,12 +9718,12 @@ (defun org-agenda-show-and-scroll-up (&optional arg) (select-window org-agenda-show-window) (ignore-errors (scroll-up))) (org-agenda-goto t) - (org-show-entry) + (org-fold-show-entry) (if arg (org-cycle-hide-drawers 'children) (org-with-wide-buffer (narrow-to-region (org-entry-beginning-position) (org-entry-end-position)) - (org-show-all '(drawers)))) + (org-fold-show-all '(drawers)))) (setq org-agenda-show-window (selected-window))) (select-window win))) @@ -9753,7 +9754,7 @@ (defun org-agenda-show-1 (&optional more) (set-window-start (selected-window) (point-at-bol)) (cond ((= more 0) - (org-flag-subtree t) + (org-fold-subtree t) (save-excursion (org-back-to-heading) (run-hook-with-args 'org-cycle-hook 'folded)) @@ -9761,20 +9762,20 @@ (defun org-agenda-show-1 (&optional more) ((and (called-interactively-p 'any) (= more 1)) (message "Remote: show with default settings")) ((= more 2) - (outline-show-entry) - (org-show-children) + (org-fold-show-entry) + (org-fold-show-children) (save-excursion (org-back-to-heading) (run-hook-with-args 'org-cycle-hook 'children)) (message "Remote: CHILDREN")) ((= more 3) - (outline-show-subtree) + (org-fold-show-subtree) (save-excursion (org-back-to-heading) (run-hook-with-args 'org-cycle-hook 'subtree)) (message "Remote: SUBTREE")) ((> more 3) - (outline-show-subtree) + (org-fold-show-subtree) (message "Remote: SUBTREE AND ALL DRAWERS"))) (select-window win))) @@ -9906,7 +9907,7 @@ (defun org-agenda-todo (&optional arg) (with-current-buffer buffer (widen) (goto-char pos) - (org-show-context 'agenda) + (org-fold-show-context 'agenda) (let ((current-prefix-arg arg)) (call-interactively 'org-todo) ;; Make sure that log is recorded in current undo. @@ -9947,7 +9948,7 @@ (defun org-agenda-add-note (&optional _arg) (with-current-buffer buffer (widen) (goto-char pos) - (org-show-context 'agenda) + (org-fold-show-context 'agenda) (org-add-note)))) (defun org-agenda-change-all-lines (newhead hdmarker @@ -10096,7 +10097,7 @@ (defun org-agenda-priority (&optional force-direction) (with-current-buffer buffer (widen) (goto-char pos) - (org-show-context 'agenda) + (org-fold-show-context 'agenda) (org-priority force-direction) (end-of-line 1) (setq newhead (org-get-heading))) @@ -10120,7 +10121,7 @@ (defun org-agenda-set-tags (&optional tag onoff) (with-current-buffer buffer (widen) (goto-char pos) - (org-show-context 'agenda) + (org-fold-show-context 'agenda) (if tag (org-toggle-tag tag onoff) (call-interactively #'org-set-tags-command)) @@ -10145,7 +10146,7 @@ (defun org-agenda-set-property () (with-current-buffer buffer (widen) (goto-char pos) - (org-show-context 'agenda) + (org-fold-show-context 'agenda) (call-interactively 'org-set-property)))))) (defun org-agenda-set-effort () @@ -10164,7 +10165,7 @@ (defun org-agenda-set-effort () (with-current-buffer buffer (widen) (goto-char pos) - (org-show-context 'agenda) + (org-fold-show-context 'agenda) (call-interactively 'org-set-effort) (end-of-line 1) (setq newhead (org-get-heading))) @@ -10186,7 +10187,7 @@ (defun org-agenda-toggle-archive-tag () (with-current-buffer buffer (widen) (goto-char pos) - (org-show-context 'agenda) + (org-fold-show-context 'agenda) (call-interactively 'org-toggle-archive-tag) (end-of-line 1) (setq newhead (org-get-heading))) @@ -10396,7 +10397,7 @@ (defun org-agenda-clock-in (&optional arg) (with-current-buffer (marker-buffer marker) (widen) (goto-char pos) - (org-show-context 'agenda) + (org-fold-show-context 'agenda) (org-clock-in arg) (setq newhead (org-get-heading))) (org-agenda-change-all-lines newhead hdmarker)) @@ -10485,7 +10486,7 @@ (defun org-agenda-diary-entry-in-org-file () (find-file-noselect org-agenda-diary-file)) (require 'org-datetree) (org-datetree-find-date-create d1) - (org-reveal t)) + (org-fold-reveal t)) (t (user-error "Invalid selection character `%c'" char))))) (defcustom org-agenda-insert-diary-strategy 'date-tree @@ -10587,7 +10588,7 @@ (defun org-agenda-add-entry-to-org-agenda-diary-file (type text &optional d1 d2) (message "%s entry added to %s" (capitalize (symbol-name type)) (abbreviate-file-name org-agenda-diary-file))) - (org-reveal t) + (org-fold-reveal t) (message "Please finish entry here")))) (defun org-agenda-insert-diary-as-top-level (text) @@ -10625,7 +10626,7 @@ (defun org-agenda-insert-diary-make-new-entry (text) (unless (bolp) (insert "\n")) (unless (looking-at-p "^[ \t]*$") (save-excursion (insert "\n"))) (when org-adapt-indentation (indent-to-column col))) - (org-show-set-visibility 'lineage)) + (org-fold-show-set-visibility 'lineage)) (defun org-agenda-diary-entry () "Make a diary entry, like the `i' command from the calendar. diff --git a/lisp/org-archive.el b/lisp/org-archive.el index 6ea16f8c1..1026a295e 100644 --- a/lisp/org-archive.el +++ b/lisp/org-archive.el @@ -324,7 +324,7 @@ (defun org-archive-subtree (&optional find-done) (org-todo-regexp tr-org-todo-regexp) (org-todo-line-regexp tr-org-todo-line-regexp)) (goto-char (point-min)) - (org-show-all '(headings blocks)) + (org-fold-show-all '(headings blocks)) (if (and heading (not (and datetree-date (not datetree-subheading-p)))) (progn (if (re-search-forward @@ -339,7 +339,7 @@ (defun org-archive-subtree (&optional find-done) (insert (if datetree-date "" "\n") heading "\n") (end-of-line 0)) ;; Make the subtree visible - (outline-show-subtree) + (org-fold-show-subtree) (if org-archive-reversed-order (progn (org-back-to-heading t) @@ -417,7 +417,7 @@ (defun org-archive-subtree (&optional find-done) (if (eq this-buffer buffer) (concat "under heading: " heading) (concat "in file: " (abbreviate-file-name afile))))))) - (org-reveal) + (org-fold-reveal) (if (looking-at "^[ \t]*$") (outline-next-visible-heading 1)))) @@ -487,13 +487,13 @@ (defun org-archive-to-archive-sibling () (format-time-string (substring (cdr org-time-stamp-formats) 1 -1))) (outline-up-heading 1 t) - (org-flag-subtree t) + (org-fold-subtree t) (org-cycle-show-empty-lines 'folded) (when org-provide-todo-statistics ;; Update TODO statistics of parent. (org-update-parent-todo-statistics)) (goto-char pos))) - (org-reveal) + (org-fold-reveal) (if (looking-at "^[ \t]*$") (outline-next-visible-heading 1)))) @@ -602,7 +602,7 @@ (defun org-toggle-archive-tag (&optional find-done) (save-excursion (org-back-to-heading t) (setq set (org-toggle-tag org-archive-tag)) - (when set (org-flag-subtree t))) + (when set (org-fold-subtree t))) (and set (beginning-of-line 1)) (message "Subtree %s" (if set "archived" "unarchived")))))) diff --git a/lisp/org-capture.el b/lisp/org-capture.el index bbb37eb27..1324ffab4 100644 --- a/lisp/org-capture.el +++ b/lisp/org-capture.el @@ -1129,7 +1129,7 @@ (defun org-capture-place-template (&optional inhibit-wconf-store) (org-switch-to-buffer-other-window (org-capture-get-indirect-buffer (org-capture-get :buffer) "CAPTURE")) (widen) - (org-show-all) + (org-fold-show-all) (goto-char (org-capture-get :pos)) (setq-local outline-level 'org-outline-level) (pcase (org-capture-get :type) diff --git a/lisp/org-clock.el b/lisp/org-clock.el index 6f441c18e..583b30237 100644 --- a/lisp/org-clock.el +++ b/lisp/org-clock.el @@ -1035,7 +1035,7 @@ (defun org-clock-jump-to-current-clock (&optional effective-clock) (let ((element (org-element-at-point))) (when (eq (org-element-type element) 'drawer) (when (> (org-element-property :end element) (car clock)) - (org-hide-drawer-toggle 'off nil element)) + (org-fold-hide-drawer-toggle 'off nil element)) (throw 'exit nil))))))))))) (defun org-clock-resolve (clock &optional prompt-fn last-valid fail-quietly) @@ -1843,10 +1843,10 @@ (defun org-clock-goto (&optional select) (pop-to-buffer-same-window (marker-buffer m)) (if (or (< m (point-min)) (> m (point-max))) (widen)) (goto-char m) - (org-show-entry) + (org-fold-show-entry) (org-back-to-heading t) (recenter org-clock-goto-before-context) - (org-reveal) + (org-fold-reveal) (if recent (message "No running clock, this is the most recently clocked task")) (run-hooks 'org-clock-goto-hook))) @@ -2140,7 +2140,7 @@ (defun org-clock-report (&optional arg) (org-clock-remove-overlays) (when arg (org-find-dblock "clocktable") - (org-show-entry)) + (org-fold-show-entry)) (pcase (org-in-clocktable-p) (`nil (org-create-dblock @@ -3125,7 +3125,7 @@ (defun org-clock-load () (let ((org-clock-in-resume 'auto-restart) (org-clock-auto-clock-resolution nil)) (org-clock-in) - (when (org-invisible-p) (org-show-context)))))) + (when (org-invisible-p) (org-fold-show-context)))))) (_ nil))))) (defun org-clock-kill-emacs-query () diff --git a/lisp/org-colview.el b/lisp/org-colview.el index 15cab35f0..c8443c135 100644 --- a/lisp/org-colview.el +++ b/lisp/org-colview.el @@ -159,8 +159,8 @@ (defconst org-columns-summary-types-default (defun org-columns-content () "Switch to contents view while in columns view." (interactive) - (org-overview) - (org-content)) + (org-cycle-overview) + (org-cycle-content)) (org-defkey org-columns-map "c" #'org-columns-content) (org-defkey org-columns-map "o" #'org-overview) @@ -701,7 +701,7 @@ (defun org-columns--call (fun) (move-beginning-of-line 2) (org-at-heading-p))))) (unwind-protect (funcall fun) - (when hide-body (outline-hide-entry))))) + (when hide-body (org-fold-hide-entry))))) (defun org-columns-previous-allowed-value () "Switch to the previous allowed value for this column." diff --git a/lisp/org-compat.el b/lisp/org-compat.el index b35e66b84..ed2ae62f4 100644 --- a/lisp/org-compat.el +++ b/lisp/org-compat.el @@ -50,18 +50,20 @@ (declare-function org-element-property "org-element" (property element)) (declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading)) (declare-function org-get-heading "org" (&optional no-tags no-todo no-priority no-comment)) (declare-function org-get-tags "org" (&optional pos local)) -(declare-function org-hide-block-toggle "org" (&optional force no-error element)) +(declare-function org-fold-hide-block-toggle "org-fold" (&optional force no-error element)) (declare-function org-link-display-format "ol" (s)) (declare-function org-link-set-parameters "ol" (type &rest rest)) (declare-function org-log-into-drawer "org" ()) (declare-function org-make-tag-string "org" (tags)) (declare-function org-reduced-level "org" (l)) (declare-function org-return "org" (&optional indent arg interactive)) -(declare-function org-show-context "org" (&optional key)) +(declare-function org-fold-show-context "org-fold" (&optional key)) (declare-function org-table-end "org-table" (&optional table-type)) (declare-function outline-next-heading "outline" ()) (declare-function speedbar-line-directory "speedbar" (&optional depth)) (declare-function table--at-cell-p "table" (position &optional object at-column)) +(declare-function org-fold-region "org-fold" (from to flag &optional spec)) +(declare-function org-fold-show-all "org-fold" (&optional types)) (defvar calendar-mode-map) (defvar org-complex-heading-regexp) @@ -72,6 +74,7 @@ (defvar org-table-any-border-regexp) (defvar org-table-dataline-regexp) (defvar org-table-tab-recognizes-table.el) (defvar org-table1-hline-regexp) +(defvar org-fold-core-style) \f ;;; Emacs < 29 compatibility @@ -656,7 +659,7 @@ (make-obsolete 'org-capture-import-remember-templates (defun org-show-block-all () "Unfold all blocks in the current buffer." (interactive) - (remove-overlays nil nil 'invisible 'org-hide-block)) + (org-fold-show-all '(blocks))) (make-obsolete 'org-show-block-all "use `org-show-all' instead." @@ -699,7 +702,7 @@ (defun org-flag-drawer (flag &optional element beg end) When buffer positions BEG and END are provided, hide or show that region as a drawer without further ado." (declare (obsolete "use `org-hide-drawer-toggle' instead." "9.4")) - (if (and beg end) (org-flag-region beg end flag 'outline) + (if (and beg end) (org-fold-region beg end flag (if (eq org-fold-core-style 'text-properties) 'drawer 'outline)) (let ((drawer (or element (and (save-excursion @@ -708,12 +711,12 @@ (defun org-flag-drawer (flag &optional element beg end) (org-element-at-point))))) (when (memq (org-element-type drawer) '(drawer property-drawer)) (let ((post (org-element-property :post-affiliated drawer))) - (org-flag-region + (org-fold-region (save-excursion (goto-char post) (line-end-position)) (save-excursion (goto-char (org-element-property :end drawer)) (skip-chars-backward " \t\n") (line-end-position)) - flag 'outline) + flag (if (eq org-fold-core-style 'text-properties) 'drawer 'outline)) ;; When the drawer is hidden away, make sure point lies in ;; a visible part of the buffer. (when (invisible-p (max (1- (point)) (point-min))) @@ -725,7 +728,7 @@ (defun org-hide-block-toggle-maybe () an error. Return a non-nil value when toggling is successful." (declare (obsolete "use `org-hide-block-toggle' instead." "9.4")) (interactive) - (org-hide-block-toggle nil t)) + (org-fold-hide-block-toggle nil t)) (defun org-hide-block-toggle-all () "Toggle the visibility of all blocks in the current buffer." @@ -741,7 +744,7 @@ (defun org-hide-block-toggle-all () (save-excursion (save-match-data (goto-char (match-beginning 0)) - (org-hide-block-toggle))))))) + (org-fold-hide-block-toggle))))))) (defun org-return-indent () "Goto next table row or insert a newline and indent. @@ -973,7 +976,7 @@ (eval-after-load 'imenu (add-hook 'imenu-after-jump-hook (lambda () (when (derived-mode-p 'org-mode) - (org-show-context 'org-goto)))) + (org-fold-show-context 'org-goto)))) (add-hook 'org-mode-hook (lambda () (setq imenu-create-index-function 'org-imenu-get-tree))))) @@ -1038,7 +1041,7 @@ (eval-after-load 'speedbar (define-key speedbar-file-key-map ">" 'org-agenda-remove-restriction-lock) (define-key speedbar-file-key-map "\C-c\C-x>" 'org-agenda-remove-restriction-lock) (add-hook 'speedbar-visiting-tag-hook - (lambda () (and (derived-mode-p 'org-mode) (org-show-context 'org-goto)))))) + (lambda () (and (derived-mode-p 'org-mode) (org-fold-show-context 'org-goto)))))) ;;;; Add Log @@ -1152,7 +1155,7 @@ (defun org-bookmark-jump-unhide (&rest _) (or (org-invisible-p) (save-excursion (goto-char (max (point-min) (1- (point)))) (org-invisible-p))) - (org-show-context 'bookmark-jump))) + (org-fold-show-context 'bookmark-jump))) ;; Make `bookmark-jump' shows the jump location if it was hidden. (add-hook 'bookmark-after-jump-hook #'org-bookmark-jump-unhide) @@ -1217,7 +1220,7 @@ (advice-add 'ecb-method-clicked :after #'org--ecb-show-context) (defun org--ecb-show-context (&rest _) "Make hierarchy visible when jumping into location from ECB tree buffer." (when (derived-mode-p 'org-mode) - (org-show-context))) + (org-fold-show-context))) ;;;; Simple @@ -1225,7 +1228,7 @@ (defun org-mark-jump-unhide (&rest _) "Make the point visible with `org-show-context' after jumping to the mark." (when (and (derived-mode-p 'org-mode) (org-invisible-p)) - (org-show-context 'mark-goto))) + (org-fold-show-context 'mark-goto))) (advice-add 'pop-to-mark-command :after #'org-mark-jump-unhide) diff --git a/lisp/org-crypt.el b/lisp/org-crypt.el index 41813cb18..b2542ab43 100644 --- a/lisp/org-crypt.el +++ b/lisp/org-crypt.el @@ -73,7 +73,7 @@ (declare-function org-before-first-heading-p "org" ()) (declare-function org-end-of-meta-data "org" (&optional full)) (declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading)) (declare-function org-entry-get "org" (pom property &optional inherit literal-nil)) -(declare-function org-flag-subtree "org" (flag)) +(declare-function org-fold-subtree "org-fold" (flag)) (declare-function org-make-tags-matcher "org" (match)) (declare-function org-previous-visible-heading "org" (arg)) (declare-function org-scan-tags "org" (action matcher todo-only &optional start-level)) @@ -243,7 +243,7 @@ (defun org-encrypt-entry () (error (error-message-string err))))) (when folded-heading (goto-char folded-heading) - (org-flag-subtree t)) + (org-fold-subtree t)) nil))))) ;;;###autoload @@ -280,7 +280,7 @@ (defun org-decrypt-entry () 'org-crypt-text encrypted-text)) (when folded-heading (goto-char folded-heading) - (org-flag-subtree t)) + (org-fold-subtree t)) nil))) (_ nil))) @@ -313,7 +313,7 @@ (defun org-crypt-use-before-save-magic () 'org-mode-hook (lambda () (add-hook 'before-save-hook 'org-encrypt-entries nil t)))) -(add-hook 'org-reveal-start-hook 'org-decrypt-entry) +(add-hook 'org-fold-reveal-start-hook 'org-decrypt-entry) (provide 'org-crypt) diff --git a/lisp/org-element.el b/lisp/org-element.el index 28339c1b8..f627dd4ea 100644 --- a/lisp/org-element.el +++ b/lisp/org-element.el @@ -70,6 +70,7 @@ (require 'org-footnote) (require 'org-list) (require 'org-macs) (require 'org-table) +(require 'org-fold-core) (declare-function org-at-heading-p "org" (&optional _)) (declare-function org-escape-code-in-string "org-src" (s)) diff --git a/lisp/org-feed.el b/lisp/org-feed.el index a5fea0888..d634f9c41 100644 --- a/lisp/org-feed.el +++ b/lisp/org-feed.el @@ -412,8 +412,8 @@ (defun org-feed-update (feed &optional retrieve-only) ;; Normalize the visibility of the inbox tree (goto-char inbox-pos) - (org-flag-subtree t) - (org-show-children) + (org-fold-subtree t) + (org-fold-show-children) ;; Hooks and messages (when org-feed-save-after-adding (save-buffer)) diff --git a/lisp/org-footnote.el b/lisp/org-footnote.el index b55f6d98e..a4c9ae770 100644 --- a/lisp/org-footnote.el +++ b/lisp/org-footnote.el @@ -52,7 +52,7 @@ (declare-function org-in-verbatim-emphasis "org" ()) (declare-function org-inside-LaTeX-fragment-p "org" ()) (declare-function org-inside-latex-macro-p "org" ()) (declare-function org-mark-ring-push "org" (&optional pos buffer)) -(declare-function org-show-context "org" (&optional key)) +(declare-function org-fold-show-context "org-fold" (&optional key)) (declare-function outline-next-heading "outline") (defvar electric-indent-mode) @@ -555,7 +555,7 @@ (defun org-footnote-goto-definition (label &optional location) (goto-char def-start) (looking-at (format "\\[fn:%s[]:]" (regexp-quote label))) (goto-char (match-end 0)) - (org-show-context 'link-search) + (org-fold-show-context 'link-search) (when (derived-mode-p 'org-mode) (message "%s" (substitute-command-keys "Edit definition and go back with \ @@ -581,7 +581,7 @@ (defun org-footnote-goto-previous-reference (label) (user-error "Reference is outside narrowed part of buffer"))) (org-mark-ring-push) (goto-char start) - (org-show-context 'link-search))) + (org-fold-show-context 'link-search))) \f ;;;; Getters diff --git a/lisp/org-goto.el b/lisp/org-goto.el index 860b0a3de..cd5000037 100644 --- a/lisp/org-goto.el +++ b/lisp/org-goto.el @@ -222,13 +222,13 @@ (defun org-goto-location (&optional _buf help) " Just type for auto-isearch." " n/p/f/b/u to navigate, q to quit."))))) (org-fit-window-to-buffer (get-buffer-window "*Org Help*")) - (org-overview) + (org-cycle-overview) (setq buffer-read-only t) (if (and (boundp 'org-goto-start-pos) (integer-or-marker-p org-goto-start-pos)) (progn (goto-char org-goto-start-pos) (when (org-invisible-p) - (org-show-set-visibility 'lineage))) + (org-fold-show-set-visibility 'lineage))) (goto-char (point-min))) (let (org-special-ctrl-a/e) (org-beginning-of-line)) (message "Select location and press RET") @@ -279,7 +279,7 @@ (defun org-goto (&optional alternative-interface) (org-mark-ring-push org-goto-start-pos) (goto-char selected-point) (when (or (org-invisible-p) (org-invisible-p2)) - (org-show-context 'org-goto))) + (org-fold-show-context 'org-goto))) (message "Quit")))) (provide 'org-goto) diff --git a/lisp/org-id.el b/lisp/org-id.el index a8f8eb4eb..0331b7c1d 100644 --- a/lisp/org-id.el +++ b/lisp/org-id.el @@ -333,7 +333,7 @@ (defun org-id-goto (id) (pop-to-buffer-same-window (marker-buffer m)) (goto-char m) (move-marker m nil) - (org-show-context))) + (org-fold-show-context))) ;;;###autoload (defun org-id-find (id &optional markerp) @@ -745,7 +745,7 @@ (defun org-id-open (id _) (funcall cmd (marker-buffer m))) (goto-char m) (move-marker m nil) - (org-show-context))) + (org-fold-show-context))) (org-link-set-parameters "id" :follow #'org-id-open) diff --git a/lisp/org-keys.el b/lisp/org-keys.el index b8e9ddd93..782ffa871 100644 --- a/lisp/org-keys.el +++ b/lisp/org-keys.el @@ -67,8 +67,8 @@ (declare-function org-ctrl-c-star "org" ()) (declare-function org-ctrl-c-tab "org" (&optional arg)) (declare-function org-cut-special "org" ()) (declare-function org-cut-subtree "org" (&optional n)) -(declare-function org-cycle "org" (&optional arg)) -(declare-function org-cycle-agenda-files "org" ()) +(declare-function org-cycle "org-cycle" (&optional arg)) +(declare-function org-cycle-agenda-files "org-cycle" ()) (declare-function org-date-from-calendar "org" ()) (declare-function org-dynamic-block-insert-dblock "org" (&optional arg)) (declare-function org-dblock-update "org" (&optional arg)) @@ -94,7 +94,7 @@ (declare-function org-feed-update-all "org" ()) (declare-function org-fill-paragraph "org" (&optional justify region)) (declare-function org-find-file-at-mouse "org" (ev)) (declare-function org-footnote-action "org" (&optional special)) -(declare-function org-force-cycle-archived "org" ()) +(declare-function org-cycle-force-archived "org-cycle" ()) (declare-function org-force-self-insert "org" (n)) (declare-function org-forward-element "org" ()) (declare-function org-forward-heading-same-level "org" (arg &optional invisible-ok)) @@ -143,8 +143,8 @@ (declare-function org-previous-visible-heading "org" (arg)) (declare-function org-priority "org" (&optional action show)) (declare-function org-promote-subtree "org" ()) (declare-function org-redisplay-inline-images "org" ()) -(declare-function org-refile "org" (&optional arg1 default-buffer rfloc msg)) -(declare-function org-refile-copy "org" ()) +(declare-function org-refile "org-refile" (&optional arg1 default-buffer rfloc msg)) +(declare-function org-refile-copy "org-refile" ()) (declare-function org-refile-reverse "org-refile" (&optional arg default-buffer rfloc msg)) (declare-function org-reftex-citation "org" ()) (declare-function org-reload "org" (&optional arg1)) @@ -152,7 +152,7 @@ (declare-function org-remove-file "org" (&optional file)) (declare-function org-resolve-clocks "org" (&optional only-dangling-p prompt-fn last-valid)) (declare-function org-return "org" (&optional indent)) (declare-function org-return-and-maybe-indent "org" ()) -(declare-function org-reveal "org" (&optional siblings)) +(declare-function org-fold-reveal "org-fold" (&optional siblings)) (declare-function org-schedule "org" (arg &optional time)) (declare-function org-self-insert-command "org" (N)) (declare-function org-set-effort "org" (&optional increment value)) @@ -172,9 +172,9 @@ (declare-function org-shiftmetaup "org" (&optional arg)) (declare-function org-shiftright "org" (&optional arg)) (declare-function org-shifttab "org" (&optional arg)) (declare-function org-shiftup "org" (&optional arg)) -(declare-function org-show-all "org" (&optional types)) -(declare-function org-show-children "org" (&optional level)) -(declare-function org-show-subtree "org" ()) +(declare-function org-fold-show-all "org-fold" (&optional types)) +(declare-function org-fold-show-children "org-fold" (&optional level)) +(declare-function org-fold-show-subtree "org-fold" ()) (declare-function org-sort "org" (&optional with-case)) (declare-function org-sparse-tree "org" (&optional arg type)) (declare-function org-table-copy-down "org" (n)) @@ -423,7 +423,7 @@ (define-key org-mode-map [menu-bar hide] 'undefined) (define-key org-mode-map [menu-bar show] 'undefined) (define-key org-mode-map [remap outline-mark-subtree] #'org-mark-subtree) -(define-key org-mode-map [remap outline-show-subtree] #'org-show-subtree) +(define-key org-mode-map [remap outline-show-subtree] #'org-fold-show-subtree) (define-key org-mode-map [remap outline-forward-same-level] #'org-forward-heading-same-level) (define-key org-mode-map [remap outline-backward-same-level] @@ -437,14 +437,14 @@ (define-key org-mode-map [remap outline-next-visible-heading] #'org-next-visible-heading) (define-key org-mode-map [remap outline-previous-visible-heading] #'org-previous-visible-heading) -(define-key org-mode-map [remap show-children] #'org-show-children) +(define-key org-mode-map [remap outline-show-children] #'org-fold-show-children) ;;;; Make `C-c C-x' a prefix key (org-defkey org-mode-map (kbd "C-c C-x") (make-sparse-keymap)) ;;;; TAB key with modifiers (org-defkey org-mode-map (kbd "TAB") #'org-cycle) -(org-defkey org-mode-map (kbd "C-c C-<tab>") #'org-force-cycle-archived) +(org-defkey org-mode-map (kbd "C-c C-<tab>") #'org-cycle-force-archived) ;; Override text-mode binding to expose `complete-symbol' for ;; pcomplete functionality. (org-defkey org-mode-map (kbd "M-TAB") nil) @@ -544,7 +544,7 @@ (org-remap org-mode-map ;;;; All the other keys (org-defkey org-mode-map (kbd "|") #'org-force-self-insert) -(org-defkey org-mode-map (kbd "C-c C-r") #'org-reveal) +(org-defkey org-mode-map (kbd "C-c C-r") #'org-fold-reveal) (org-defkey org-mode-map (kbd "C-M-t") #'org-transpose-element) (org-defkey org-mode-map (kbd "M-}") #'org-forward-element) (org-defkey org-mode-map (kbd "ESC }") #'org-forward-element) diff --git a/lisp/org-lint.el b/lisp/org-lint.el index b21412be1..cce6fddbd 100644 --- a/lisp/org-lint.el +++ b/lisp/org-lint.el @@ -91,6 +91,7 @@ (require 'oc) (require 'ol) (require 'org-attach) (require 'org-macro) +(require 'org-fold) (require 'ox) (require 'seq) @@ -264,7 +265,7 @@ (defun org-lint--jump-to-source () (let ((l (org-lint--current-line))) (switch-to-buffer-other-window org-lint--source-buffer) (org-goto-line l) - (org-show-set-visibility 'local) + (org-fold-show-set-visibility 'local) (recenter))) (defun org-lint--show-source () diff --git a/lisp/org-list.el b/lisp/org-list.el index f1ab2ca76..05a73a609 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -79,6 +79,7 @@ ;;; Code: (require 'cl-lib) (require 'org-macs) (require 'org-compat) +(require 'org-fold-core) (defvar org-M-RET-may-split-line) (defvar org-adapt-indentation) @@ -138,7 +139,8 @@ (declare-function org-outline-level "org" ()) (declare-function org-previous-line-empty-p "org" ()) (declare-function org-reduced-level "org" (L)) (declare-function org-set-tags "org" (tags)) -(declare-function org-show-subtree "org" ()) +(declare-function org-fold-show-subtree "org-fold" ()) +(declare-function org-fold-region "org-fold" (from to flag &optional spec)) (declare-function org-sort-remove-invisible "org" (S)) (declare-function org-time-string-to-seconds "org" (s)) (declare-function org-timer-hms-to-secs "org-timer" (hms)) @@ -2029,7 +2031,7 @@ (defun org-list-set-item-visibility (item struct view) ((eq view 'folded) (let ((item-end (org-list-get-item-end-before-blank item struct))) ;; Hide from eol - (org-flag-region (save-excursion (goto-char item) (line-end-position)) + (org-fold-region (save-excursion (goto-char item) (line-end-position)) item-end t 'outline))) ((eq view 'children) ;; First show everything. @@ -2042,7 +2044,7 @@ (defun org-list-set-item-visibility (item struct view) ((eq view 'subtree) ;; Show everything (let ((item-end (org-list-get-item-end item struct))) - (org-flag-region item item-end nil 'outline))))) + (org-fold-region item item-end nil 'outline))))) (defun org-list-item-body-column (item) "Return column at which body of ITEM should start." @@ -2455,7 +2457,7 @@ (defun org-reset-checkbox-state-subtree () (save-restriction (save-excursion (org-narrow-to-subtree) - (org-show-subtree) + (org-fold-show-subtree) (goto-char (point-min)) (let ((end (point-max))) (while (< (point) end) diff --git a/lisp/org-macs.el b/lisp/org-macs.el index f63458f70..7703e09e4 100644 --- a/lisp/org-macs.el +++ b/lisp/org-macs.el @@ -35,11 +35,16 @@ (require 'cl-lib) (require 'format-spec) (declare-function org-mode "org" ()) -(declare-function org-show-context "org" (&optional key)) +(declare-function org-agenda-files "org" (&optional unrestricted archives)) +(declare-function org-fold-show-context "org-fold" (&optional key)) +(declare-function org-fold-save-outline-visibility "org-fold" (use-markers &rest body)) +(declare-function org-fold-next-visibility-change "org-fold" (&optional pos limit ignore-hidden-p previous-p)) +(declare-function org-fold-folded-p "org-fold" (&optional pos limit ignore-hidden-p previous-p)) (declare-function string-collate-lessp "org-compat" (s1 s2 &optional locale ignore-case)) (defvar org-ts-regexp0) (defvar ffap-url-regexp) +(defvar org-fold-core-style) \f ;;; Macros @@ -117,38 +122,7 @@ (defmacro org-no-read-only (&rest body) (declare (debug (body))) `(let ((inhibit-read-only t)) ,@body)) -(defmacro org-save-outline-visibility (use-markers &rest body) - "Save and restore outline visibility around BODY. -If USE-MARKERS is non-nil, use markers for the positions. This -means that the buffer may change while running BODY, but it also -means that the buffer should stay alive during the operation, -because otherwise all these markers will point to nowhere." - (declare (debug (form body)) (indent 1)) - (org-with-gensyms (data invisible-types markers?) - `(let* ((,invisible-types '(org-hide-block outline)) - (,markers? ,use-markers) - (,data - (mapcar (lambda (o) - (let ((beg (overlay-start o)) - (end (overlay-end o)) - (type (overlay-get o 'invisible))) - (and beg end - (> end beg) - (memq type ,invisible-types) - (list (if ,markers? (copy-marker beg) beg) - (if ,markers? (copy-marker end t) end) - type)))) - (org-with-wide-buffer - (overlays-in (point-min) (point-max)))))) - (unwind-protect (progn ,@body) - (org-with-wide-buffer - (dolist (type ,invisible-types) - (remove-overlays (point-min) (point-max) 'invisible type)) - (pcase-dolist (`(,beg ,end ,type) (delq nil ,data)) - (org-flag-region beg end t type) - (when ,markers? - (set-marker beg nil) - (set-marker end nil)))))))) +(defalias 'org-save-outline-visibility #'org-fold-save-outline-visibility) (defmacro org-with-wide-buffer (&rest body) "Execute body while temporarily widening the buffer." diff --git a/lisp/org-mobile.el b/lisp/org-mobile.el index 5cfaa7fe0..dd5333399 100644 --- a/lisp/org-mobile.el +++ b/lisp/org-mobile.el @@ -1064,7 +1064,7 @@ (defun org-mobile-edit (what old new) (progn ;; Workaround a `org-insert-heading-respect-content' bug ;; which prevents correct insertion when point is invisible - (org-show-subtree) + (org-fold-show-subtree) (end-of-line 1) (org-insert-heading-respect-content t) (org-demote)) diff --git a/lisp/org-mouse.el b/lisp/org-mouse.el index 2d8136b75..912efb770 100644 --- a/lisp/org-mouse.el +++ b/lisp/org-mouse.el @@ -1007,10 +1007,10 @@ (defun org-mouse-do-remotely (command) (with-current-buffer buffer (widen) (goto-char pos) - (org-show-hidden-entry) + (org-fold-show-hidden-entry) (save-excursion (and (outline-next-heading) - (org-flag-heading nil))) ; show the next heading + (org-fold-heading nil))) ; show the next heading (org-back-to-heading) (setq marker (point-marker)) (goto-char (max (point-at-bol) (- (point-at-eol) anticol))) diff --git a/lisp/org-refile.el b/lisp/org-refile.el index 5ad73422e..6f2b019ad 100644 --- a/lisp/org-refile.el +++ b/lisp/org-refile.el @@ -521,7 +521,7 @@ (defun org-refile (&optional arg default-buffer rfloc msg) (goto-char (cond (pos) ((org-notes-order-reversed-p) (point-min)) (t (point-max)))) - (org-show-context 'org-goto)) + (org-fold-show-context 'org-goto)) (if regionp (progn (org-kill-new (buffer-substring region-start region-end)) diff --git a/lisp/org-src.el b/lisp/org-src.el index 663ccb334..cc4918161 100644 --- a/lisp/org-src.el +++ b/lisp/org-src.el @@ -1358,8 +1358,10 @@ (defun org-edit-src-exit () (goto-char beg) (cond ;; Block is hidden; move at start of block. - ((cl-some (lambda (o) (eq (overlay-get o 'invisible) 'org-hide-block)) - (overlays-at (point))) + ((if (eq org-fold-core-style 'text-properties) + (org-fold-folded-p nil 'block) + (cl-some (lambda (o) (eq (overlay-get o 'invisible) 'org-hide-block)) + (overlays-at (point)))) (beginning-of-line 0)) (write-back (org-src--goto-coordinates coordinates beg end)))) ;; Clean up left-over markers and restore window configuration. diff --git a/lisp/org-timer.el b/lisp/org-timer.el index a6f3648fa..0c9350e76 100644 --- a/lisp/org-timer.el +++ b/lisp/org-timer.el @@ -478,7 +478,7 @@ (defun org-timer--get-timer-title () (with-current-buffer (marker-buffer marker) (org-with-wide-buffer (goto-char hdmarker) - (org-show-entry) + (org-fold-show-entry) (or (ignore-errors (org-get-heading)) (buffer-name (buffer-base-buffer)))))))) ((derived-mode-p 'org-mode) diff --git a/lisp/org.el b/lisp/org.el index 8c823a7c8..ca4973bc3 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -96,6 +96,9 @@ (require 'org-keys) (require 'ol) (require 'oc) (require 'org-table) +(require 'org-fold) + +(require 'org-cycle) ;; `org-outline-regexp' ought to be a defconst but is let-bound in ;; some places -- e.g. see the macro `org-with-limited-levels'. @@ -4670,7 +4673,7 @@ (define-derived-mode org-mode outline-mode "Org" t)) (when org-startup-with-inline-images (org-display-inline-images)) (when org-startup-with-latex-preview (org-latex-preview '(16))) - (unless org-inhibit-startup-visibility-stuff (org-set-startup-visibility)) + (unless org-inhibit-startup-visibility-stuff (org-cycle-set-startup-visibility)) (when org-startup-truncated (setq truncate-lines t)) (when org-startup-numerated (require 'org-num) (org-num-mode 1)) (when org-startup-indented (require 'org-indent) (org-indent-mode 1)))) @@ -5865,7 +5868,7 @@ (defun org-tree-to-indirect-buffer (&optional arg) (pop-to-buffer ibuf)) (t (error "Invalid value"))) (narrow-to-region beg end) - (org-show-all '(headings drawers blocks)) + (org-fold-show-all '(headings drawers blocks)) (goto-char pos) (run-hook-with-args 'org-cycle-hook 'all) (and (window-live-p cwin) (select-window cwin)))) @@ -5977,10 +5980,15 @@ (defun org-insert-heading (&optional arg invisible-ok top) ;; When INVISIBLE-OK is non-nil, ensure newly created headline ;; is visible. (unless invisible-ok - (pcase (get-char-property-and-overlay (point) 'invisible) - (`(outline . ,o) - (move-overlay o (overlay-start o) (line-end-position 0))) - (_ nil)))) + (if (eq org-fold-core-style 'text-properties) + (cond + ((org-fold-folded-p (line-beginning-position) 'headline) + (org-fold-region (line-end-position 0) (line-end-position) nil 'headline)) + (t nil)) + (pcase (get-char-property-and-overlay (point) 'invisible) + (`(outline . ,o) + (move-overlay o (overlay-start o) (line-end-position 0))) + (_ nil))))) ;; At a headline... ((org-at-heading-p) (cond ((bolp) @@ -6522,7 +6530,7 @@ (defun org-convert-to-oddeven-levels () (goto-char (point-min)) ;; First check if there are no even levels (when (re-search-forward "^\\(\\*\\*\\)+ " nil t) - (org-show-set-visibility 'canonical) + (org-fold-show-set-visibility 'canonical) (error "Not all levels are odd in this file. Conversion not possible")) (when (yes-or-no-p "Are you sure you want to globally change levels to odd-even? ") (let ((outline-regexp org-outline-regexp) @@ -6615,9 +6623,9 @@ (defun org-move-subtree-down (&optional arg) (setq txt (buffer-substring beg end)) (org-save-markers-in-region beg end) (delete-region beg end) - (org-remove-empty-overlays-at beg) - (unless (= beg (point-min)) (org-flag-region (1- beg) beg nil 'outline)) - (unless (bobp) (org-flag-region (1- (point)) (point) nil 'outline)) + (when (eq org-fold-core-style 'overlays) (org-remove-empty-overlays-at beg)) + (unless (= beg (point-min)) (org-fold-region (1- beg) beg nil 'outline)) + (unless (bobp) (org-fold-region (1- (point)) (point) nil 'outline)) (and (not (bolp)) (looking-at "\n") (forward-char 1)) (let ((bbb (point))) (insert-before-markers txt) @@ -6628,9 +6636,9 @@ (defun org-move-subtree-down (&optional arg) (org-skip-whitespace) (move-marker ins-point nil) (if folded - (org-flag-subtree t) - (org-show-entry) - (org-show-children)) + (org-fold-subtree t) + (org-fold-show-entry) + (org-fold-show-children)) (org-clean-visibility-after-subtree-move) ;; move back to the initial column we were at (move-to-column col)))) @@ -6988,7 +6996,7 @@ (defun org-clone-subtree-with-time-shift (n &optional shift) (insert template) (org-mode) (goto-char (point-min)) - (org-show-subtree) + (org-fold-show-subtree) (and idprop (if org-clone-delete-id (org-entry-delete nil "ID") (org-id-get-create t))) @@ -7260,7 +7268,7 @@ (defun org-sort-entries (point)) what "children") (goto-char start) - (outline-show-subtree) + (org-fold-show-subtree) (outline-next-heading)) (t ;; we will sort the top-level entries in this file @@ -7276,7 +7284,7 @@ (defun org-sort-entries (setq end (point-max)) (setq what "top-level") (goto-char start) - (org-show-all '(headings drawers blocks)))) + (org-fold-show-all '(headings drawers blocks)))) (setq beg (point)) (when (>= beg end) (goto-char start) (user-error "Nothing to sort")) @@ -7860,7 +7868,7 @@ (defun org-open-file (path &optional in-emacs line search) (funcall (cdr (assq 'file org-link-frame-setup)) file) (widen) (cond (line (org-goto-line line) - (when (derived-mode-p 'org-mode) (org-reveal))) + (when (derived-mode-p 'org-mode) (org-fold-reveal))) (search (condition-case err (org-link-search search) ;; Save position before error-ing out so user @@ -8156,7 +8164,7 @@ (defun org-mark-ring-goto (&optional n) (setq m (car p)) (pop-to-buffer-same-window (marker-buffer m)) (goto-char m) - (when (or (org-invisible-p) (org-invisible-p2)) (org-show-context 'mark-goto)))) + (when (or (org-invisible-p) (org-invisible-p2)) (org-fold-show-context 'mark-goto)))) ;;; Following specific links @@ -10167,7 +10175,7 @@ (defun org-occur (regexp &optional keep-previous callback) "Make a compact tree showing all matches of REGEXP. The tree will show the lines where the regexp matches, and any other context -defined in `org-show-context-detail', which see. +defined in `org-fold-show-context-detail', which see. When optional argument KEEP-PREVIOUS is non-nil, highlighting and exposing done by a previous call to `org-occur' will be kept, to allow stacking of @@ -10189,7 +10197,7 @@ (defun org-occur (regexp &optional keep-previous callback) (when (or (not keep-previous) ; do not want to keep (not org-occur-highlights)) ; no previous matches ;; hide everything - (org-overview)) + (org-cycle-overview)) (let ((case-fold-search (if (eq org-occur-case-fold-search 'smart) (isearch-no-upper-case-p regexp t) org-occur-case-fold-search))) @@ -10199,12 +10207,12 @@ (defun org-occur (regexp &optional keep-previous callback) (setq cnt (1+ cnt)) (when org-highlight-sparse-tree-matches (org-highlight-new-match (match-beginning 0) (match-end 0))) - (org-show-context 'occur-tree))))) + (org-fold-show-context 'occur-tree))))) (when org-remove-highlights-with-change (add-hook 'before-change-functions 'org-remove-occur-highlights nil 'local)) (unless org-sparse-tree-open-archived-trees - (org-hide-archived-subtrees (point-min) (point-max))) + (org-fold-hide-archived-subtrees (point-min) (point-max))) (run-hooks 'org-occur-hook) (when (called-interactively-p 'interactive) (message "%d match(es) for regexp %s" cnt regexp)) @@ -10488,7 +10496,7 @@ (defun org-scan-tags (action matcher todo-only &optional start-level) (save-excursion (goto-char (point-min)) (when (eq action 'sparse-tree) - (org-overview) + (org-cycle-overview) (org-remove-occur-highlights)) (if (org-element--cache-active-p) (let ((fast-re (concat "^" @@ -10537,7 +10545,7 @@ (defun org-scan-tags (action matcher todo-only &optional start-level) (org-get-heading) (match-end 0) (org-highlight-new-match (match-beginning 1) (match-end 1))) - (org-show-context 'tags-tree)) + (org-fold-show-context 'tags-tree)) ((eq action 'agenda) (let* ((effort (org-entry-get (point) org-effort-property)) (effort-minutes (when effort (save-match-data (org-duration-to-minutes effort))))) @@ -10663,7 +10671,7 @@ (defun org-scan-tags (action matcher todo-only &optional start-level) (org-get-heading) (match-end 0) (org-highlight-new-match (match-beginning 1) (match-end 1))) - (org-show-context 'tags-tree)) + (org-fold-show-context 'tags-tree)) ((eq action 'agenda) (setq txt (org-agenda-format-item "" @@ -10701,7 +10709,7 @@ (defun org-scan-tags (action matcher todo-only &optional start-level) (and (= (point) lspos) (end-of-line 1)))))) (when (and (eq action 'sparse-tree) (not org-sparse-tree-open-archived-trees)) - (org-hide-archived-subtrees (point-min) (point-max))) + (org-fold-hide-archived-subtrees (point-min) (point-max))) (nreverse rtn))) (defun org-remove-uninherited-tags (tags) @@ -12549,7 +12557,7 @@ (defun org-insert-property-drawer () (inhibit-read-only t)) (unless (bobp) (insert "\n")) (insert ":PROPERTIES:\n:END:") - (org-flag-region (line-end-position 0) (point) t 'outline) + (org-fold-region (line-end-position 0) (point) t (if (eq org-fold-core-style 'text-properties) 'drawer 'outline)) (when (or (eobp) (= begin (point-min))) (insert "\n")) (org-indent-region begin (point)))))) @@ -14391,7 +14399,7 @@ (defun org-timestamp-change (n &optional what updown suppress-tmp-delay) (message "No clock to adjust") (save-excursion (org-goto-marker-or-bmk clfixpos) - (org-show-subtree) + (org-fold-show-subtree) (when (re-search-forward clrgx nil t) (goto-char (match-beginning 1)) (let (org-clock-adjust-closest) @@ -15893,7 +15901,7 @@ (defun org-self-insert-command (N) If the cursor is in a table looking at whitespace, the whitespace is overwritten, and the table is not marked as requiring realignment." (interactive "p") - (org-check-before-invisible-edit 'insert) + (org-fold-check-before-invisible-edit 'insert) (cond ((and org-use-speed-commands (let ((kv (this-command-keys-vector))) @@ -15963,7 +15971,7 @@ (defun org-delete-backward-char (N) because, in this case the deletion might narrow the column." (interactive "p") (save-match-data - (org-check-before-invisible-edit 'delete-backward) + (org-fold-check-before-invisible-edit 'delete-backward) (if (and (= N 1) (not overwrite-mode) (not (org-region-active-p)) @@ -15983,7 +15991,7 @@ (defun org-delete-char (N) because, in this case the deletion might narrow the column." (interactive "p") (save-match-data - (org-check-before-invisible-edit 'delete) + (org-fold-check-before-invisible-edit 'delete) (cond ((or (/= N 1) (eq (char-after) ?|) @@ -16169,11 +16177,11 @@ (defun org-shifttab (&optional arg) ((integerp arg) (let ((arg2 (if org-odd-levels-only (1- (* 2 arg)) arg))) (message "Content view to level: %d" arg) - (org-content (prefix-numeric-value arg2)) + (org-cycle-content (prefix-numeric-value arg2)) (org-cycle-show-empty-lines t) (setq org-cycle-global-status 'overview) (run-hook-with-args 'org-cycle-hook 'overview))) - (t (call-interactively 'org-global-cycle)))) + (t (call-interactively 'org-cycle-global)))) (defun org-shiftmetaleft () "Promote subtree or delete table column. @@ -16327,14 +16335,14 @@ (defun org-check-for-hidden (what) (setq beg (point-at-bol)) (beginning-of-line 2) (while (and (not (eobp)) ;; this is like `next-line' - (get-char-property (1- (point)) 'invisible)) + (org-invisible-p (1- (point)))) (beginning-of-line 2)) (setq end (point)) (goto-char beg) (goto-char (point-at-eol)) (setq end (max end (point))) (while (re-search-forward re end t) - (when (get-char-property (match-beginning 0) 'invisible) + (when (org-invisible-p (match-beginning 0)) (throw 'exit t)))) nil)))) @@ -16622,11 +16630,18 @@ (defun org-copy-visible (beg end) (interactive "r") (let ((result "")) (while (/= beg end) - (if (invisible-p beg) - (setq beg (next-single-char-property-change beg 'invisible nil end)) + (if (eq org-fold-core-style 'text-properties) + (progn + (while (org-invisible-p beg) + (setq beg (org-fold-next-visibility-change beg end))) + (let ((next (org-fold-next-visibility-change beg end))) + (setq result (concat result (buffer-substring beg next))) + (setq beg next))) + (when (invisible-p beg) + (setq beg (next-single-char-property-change beg 'invisible nil end))) (let ((next (next-single-char-property-change beg 'invisible nil end))) - (setq result (concat result (buffer-substring beg next))) - (setq beg next)))) + (setq result (concat result (buffer-substring beg next))) + (setq beg next)))) (setq deactivate-mark t) (kill-new result) (message "Visible strings have been copied to the kill ring."))) @@ -17000,14 +17015,14 @@ (defun org-kill-note-or-show-branches () (cond (org-finish-function (let ((org-note-abort t)) (funcall org-finish-function))) ((org-before-first-heading-p) - (org-show-branches-buffer) - (org-hide-archived-subtrees (point-min) (point-max))) + (org-fold-show-branches-buffer) + (org-fold-hide-archived-subtrees (point-min) (point-max))) (t (let ((beg (progn (org-back-to-heading) (point))) (end (save-excursion (org-end-of-subtree t t) (point)))) - (outline-hide-subtree) - (outline-show-branches) - (org-hide-archived-subtrees beg end))))) + (org-fold-hide-subtree) + (org-fold-show-branches) + (org-fold-hide-archived-subtrees beg end))))) (defun org-delete-indentation (&optional arg) "Join current line to previous and fix whitespace at join. @@ -17130,7 +17145,7 @@ (defun org-return (&optional indent arg interactive) (org-auto-align-tags (org-align-tags)) (t (org--align-tags-here tags-column))) ;preserve tags column (end-of-line) - (org-show-entry) + (org-fold-show-entry) (org--newline indent arg interactive) (when string (save-excursion (insert (org-trim string)))))) ;; In a list, make sure indenting keeps trailing text within. @@ -17168,11 +17183,11 @@ (defun org-ctrl-c-tab (&optional arg) (call-interactively #'org-table-toggle-column-width)) ((org-before-first-heading-p) (save-excursion - (org-flag-above-first-heading) - (outline-hide-sublevels (or arg 1)))) + (org-fold-flag-above-first-heading) + (org-fold-hide-sublevels (or arg 1)))) (t - (outline-hide-subtree) - (org-show-children arg)))) + (org-fold-hide-subtree) + (org-fold-show-children arg)))) (defun org-ctrl-c-star () "Compute table, or change heading status of lines. @@ -17307,7 +17322,7 @@ (defun org-meta-return (&optional arg) `org-table-wrap-region', depending on context. When called with an argument, unconditionally call `org-insert-heading'." (interactive "P") - (org-check-before-invisible-edit 'insert) + (org-fold-check-before-invisible-edit 'insert) (or (run-hook-with-args-until-success 'org-metareturn-hook) (call-interactively (cond (arg #'org-insert-heading) ((org-at-table-p) #'org-table-wrap-region) @@ -17327,8 +17342,8 @@ (easy-menu-define org-org-menu org-mode-map "Org menu." ["Cycle Visibility" org-cycle :active (or (bobp) (outline-on-heading-p))] ["Cycle Global Visibility" org-shifttab :active (not (org-at-table-p))] ["Sparse Tree..." org-sparse-tree t] - ["Reveal Context" org-reveal t] - ["Show All" org-show-all t] + ["Reveal Context" org-fold-reveal t] + ["Show All" org-fold-show-all t] "--" ["Subtree to indirect buffer" org-tree-to-indirect-buffer t]) "--" @@ -17787,7 +17802,7 @@ (defun org-goto-marker-or-bmk (marker &optional bookmark) (when (or (> marker (point-max)) (< marker (point-min))) (widen)) (goto-char marker) - (org-show-context 'org-goto)) + (org-fold-show-context 'org-goto)) (if bookmark (bookmark-jump bookmark) (error "Cannot find location")))) @@ -18024,7 +18039,7 @@ (defun org-occur-in-agenda-files (regexp &optional _nlines) regexp))) (add-hook 'occur-mode-find-occurrence-hook - (lambda () (when (derived-mode-p 'org-mode) (org-reveal)))) + (lambda () (when (derived-mode-p 'org-mode) (org-fold-reveal)))) (defun org-occur-link-in-agenda-files () "Create a link and search for it in the agendas. @@ -18960,7 +18975,7 @@ (defun org-next-block (arg &optional backward block-regexp) (cl-decf count)))) (if (= count 0) (prog1 (goto-char (org-element-property :post-affiliated last-element)) - (save-match-data (org-show-context))) + (save-match-data (org-fold-show-context))) (goto-char origin) (user-error "No %s code blocks" (if backward "previous" "further"))))) @@ -19441,7 +19456,7 @@ (defun org-kill-line (&optional _arg) ((or (not org-special-ctrl-k) (bolp) (not (org-at-heading-p))) - (when (and (get-char-property (line-end-position) 'invisible) + (when (and (org-invisible-p (line-end-position)) org-ctrl-k-protect-subtree (or (eq org-ctrl-k-protect-subtree 'error) (not (y-or-n-p "Kill hidden subtree along with headline? ")))) @@ -19529,7 +19544,7 @@ (defun org-yank-generic (command arg) (or (looking-at org-outline-regexp) (re-search-forward org-outline-regexp-bol end t)) (while (and (< (point) end) (looking-at org-outline-regexp)) - (org-flag-subtree t) + (org-fold-subtree t) (org-cycle-show-empty-lines 'folded) (condition-case nil (outline-forward-same-level 1) @@ -19586,7 +19601,7 @@ (defun org-back-to-heading (&optional invisible-ok) (fboundp 'org-inlinetask-end-p) (org-inlinetask-end-p)) (org-inlinetask-goto-beginning) - (setq found (and (or invisible-ok (not (org-invisible-p))) + (setq found (and (or invisible-ok (not (org-fold-folded-p))) (point)))))) (goto-char found) found))) @@ -20623,9 +20638,9 @@ (defun org-info-find-node (&optional nodename) \f ;;; Finish up -(add-hook 'org-mode-hook ;remove overlays when changing major mode +(add-hook 'org-mode-hook ;remove folds when changing major mode (lambda () (add-hook 'change-major-mode-hook - 'org-show-all 'append 'local))) + 'org-fold-show-all 'append 'local))) (provide 'org) diff --git a/lisp/ox-org.el b/lisp/ox-org.el index 3d3c4fe6a..96d22d178 100644 --- a/lisp/ox-org.el +++ b/lisp/ox-org.el @@ -329,7 +329,7 @@ (defun org-org-publish-to-org (plist filename pub-dir) newbuf) (with-current-buffer work-buffer (org-font-lock-ensure) - (org-show-all) + (org-fold-show-all) (setq newbuf (htmlize-buffer))) (with-current-buffer newbuf (when org-org-htmlized-css-url diff --git a/testing/lisp/test-org-list.el b/testing/lisp/test-org-list.el index e21409ca5..a9490692e 100644 --- a/testing/lisp/test-org-list.el +++ b/testing/lisp/test-org-list.el @@ -627,7 +627,7 @@ (ert-deftest test-org-list/move-item-down-contents-visibility () #+BEGIN_CENTER Text2 #+END_CENTER" - (org-hide-block-all) + (org-fold-hide-block-all) (let ((invisible-property-1 (progn (search-forward "Text1") diff --git a/testing/lisp/test-org.el b/testing/lisp/test-org.el index 6aecc3af8..0a47618ca 100644 --- a/testing/lisp/test-org.el +++ b/testing/lisp/test-org.el @@ -3787,7 +3787,7 @@ (ert-deftest test-org/end-of-line () (should-not (org-test-with-temp-text "#+BEGIN_CENTER\nContents\n#+END_CENTER" (let ((org-special-ctrl-a/e t)) - (org-hide-block-toggle) + (org-fold-hide-block-toggle) (org-end-of-line) (eobp)))) ;; Get past invisible characters at the end of line. @@ -3935,7 +3935,7 @@ (ert-deftest test-org/forward-paragraph () (should (= 6 (org-test-with-temp-text "#+begin_center\nP1\n\nP2\n#+end_center\nP3" - (org-hide-block-toggle) + (org-fold-hide-block-toggle) (org-forward-paragraph) (org-current-line)))) ;; On an item or a footnote definition, move past the first element @@ -4055,7 +4055,7 @@ (ert-deftest test-org/backward-paragraph () (bobp))) (should (org-test-with-temp-text "#+begin_center\nP1\n\nP2\n#+end_center\n" - (org-hide-block-toggle) + (org-fold-hide-block-toggle) (goto-char (point-max)) (org-backward-paragraph) (bobp))) @@ -8057,108 +8057,110 @@ (ert-deftest test-org/timestamp-to-time () ;;; Visibility (ert-deftest test-org/hide-drawer-toggle () - "Test `org-hide-drawer-toggle' specifications." + "Test `org-fold-hide-drawer-toggle' specifications." ;; Error when not at a drawer. (should-error (org-test-with-temp-text ":fake-drawer:\ncontents" - (org-hide-drawer-toggle 'off) + (org-fold-hide-drawer-toggle 'off) (get-char-property (line-end-position) 'invisible))) (should-error (org-test-with-temp-text "#+begin_example\n<point>:D:\nc\n:END:\n#+end_example" - (org-hide-drawer-toggle t))) + (org-fold-hide-drawer-toggle t))) ;; Hide drawer. (should (org-test-with-temp-text ":drawer:\ncontents\n:end:" - (org-hide-drawer-toggle) + (org-fold-show-all) + (org-fold-hide-drawer-toggle) (get-char-property (line-end-position) 'invisible))) ;; Show drawer unconditionally when optional argument is `off'. (should-not (org-test-with-temp-text ":drawer:\ncontents\n:end:" - (org-hide-drawer-toggle) - (org-hide-drawer-toggle 'off) + (org-fold-hide-drawer-toggle) + (org-fold-hide-drawer-toggle 'off) (get-char-property (line-end-position) 'invisible))) ;; Hide drawer unconditionally when optional argument is non-nil. (should (org-test-with-temp-text ":drawer:\ncontents\n:end:" - (org-hide-drawer-toggle t) + (org-fold-hide-drawer-toggle t) (get-char-property (line-end-position) 'invisible))) ;; Do not hide drawer when called from final blank lines. (should-not (org-test-with-temp-text ":drawer:\ncontents\n:end:\n\n<point>" - (org-hide-drawer-toggle) + (org-fold-show-all) + (org-fold-hide-drawer-toggle) (goto-char (point-min)) (get-char-property (line-end-position) 'invisible))) ;; Don't leave point in an invisible part of the buffer when hiding ;; a drawer away. (should-not (org-test-with-temp-text ":drawer:\ncontents\n<point>:end:" - (org-hide-drawer-toggle) + (org-fold-hide-drawer-toggle) (get-char-property (point) 'invisible)))) (ert-deftest test-org/hide-block-toggle () - "Test `org-hide-block-toggle' specifications." + "Test `org-fold-hide-block-toggle' specifications." ;; Error when not at a block. (should-error (org-test-with-temp-text "#+BEGIN_QUOTE\ncontents" - (org-hide-block-toggle 'off) + (org-fold-hide-block-toggle 'off) (get-char-property (line-end-position) 'invisible))) ;; Hide block. (should (org-test-with-temp-text "#+BEGIN_CENTER\ncontents\n#+END_CENTER" - (org-hide-block-toggle) + (org-fold-hide-block-toggle) (get-char-property (line-end-position) 'invisible))) (should (org-test-with-temp-text "#+BEGIN_EXAMPLE\ncontents\n#+END_EXAMPLE" - (org-hide-block-toggle) + (org-fold-hide-block-toggle) (get-char-property (line-end-position) 'invisible))) ;; Show block unconditionally when optional argument is `off'. (should-not (org-test-with-temp-text "#+BEGIN_QUOTE\ncontents\n#+END_QUOTE" - (org-hide-block-toggle) - (org-hide-block-toggle 'off) + (org-fold-hide-block-toggle) + (org-fold-hide-block-toggle 'off) (get-char-property (line-end-position) 'invisible))) (should-not (org-test-with-temp-text "#+BEGIN_QUOTE\ncontents\n#+END_QUOTE" - (org-hide-block-toggle 'off) + (org-fold-hide-block-toggle 'off) (get-char-property (line-end-position) 'invisible))) ;; Hide block unconditionally when optional argument is non-nil. (should (org-test-with-temp-text "#+BEGIN_QUOTE\ncontents\n#+END_QUOTE" - (org-hide-block-toggle t) + (org-fold-hide-block-toggle t) (get-char-property (line-end-position) 'invisible))) (should (org-test-with-temp-text "#+BEGIN_QUOTE\ncontents\n#+END_QUOTE" - (org-hide-block-toggle) - (org-hide-block-toggle t) + (org-fold-hide-block-toggle) + (org-fold-hide-block-toggle t) (get-char-property (line-end-position) 'invisible))) ;; Do not hide block when called from final blank lines. (should-not (org-test-with-temp-text "#+BEGIN_QUOTE\ncontents\n#+END_QUOTE\n\n<point>" - (org-hide-block-toggle) + (org-fold-hide-block-toggle) (goto-char (point-min)) (get-char-property (line-end-position) 'invisible))) ;; Don't leave point in an invisible part of the buffer when hiding ;; a block away. (should-not (org-test-with-temp-text "#+BEGIN_QUOTE\ncontents\n<point>#+END_QUOTE" - (org-hide-block-toggle) + (org-fold-hide-block-toggle) (get-char-property (point) 'invisible)))) (ert-deftest test-org/hide-block-toggle-maybe () - "Test `org-hide-block-toggle-maybe' specifications." + "Test `org-fold-hide-block-toggle' specifications." (should (org-test-with-temp-text "#+BEGIN: dynamic\nContents\n#+END:" - (org-hide-block-toggle-maybe))) - (should-not - (org-test-with-temp-text "Paragraph" (org-hide-block-toggle-maybe)))) + (org-hide-block-toggle))) + (should-error + (org-test-with-temp-text "Paragraph" (org-hide-block-toggle)))) (ert-deftest test-org/show-set-visibility () - "Test `org-show-set-visibility' specifications." + "Test `org-fold-show-set-visibility' specifications." ;; Do not throw an error before first heading. (should (org-test-with-temp-text "Preamble\n* Headline" - (org-show-set-visibility 'tree) + (org-fold-show-set-visibility 'tree) t)) ;; Test all visibility spans, both on headline and in entry. (let ((list-visible-lines @@ -8180,7 +8182,7 @@ (ert-deftest test-org/show-set-visibility () " (org-cycle t) (search-forward (if headerp "Self" "Match")) - (org-show-set-visibility state) + (org-fold-show-set-visibility state) (goto-char (point-min)) (let (result (line 0)) (while (not (eobp)) @@ -8211,24 +8213,24 @@ (ert-deftest test-org/show-set-visibility () ;; visible. (should-not (org-test-with-temp-text "#+BEGIN_QUOTE\nText\n#+END_QUOTE" - (org-hide-block-toggle) + (org-fold-hide-block-toggle) (search-forward "Text") - (org-show-set-visibility 'minimal) + (org-fold-show-set-visibility 'minimal) (org-invisible-p2))) (should-not (org-test-with-temp-text ":DRAWER:\nText\n:END:" - (org-hide-drawer-toggle) + (org-fold-hide-drawer-toggle) (search-forward "Text") - (org-show-set-visibility 'minimal) + (org-fold-show-set-visibility 'minimal) (org-invisible-p2))) (should-not (org-test-with-temp-text "#+BEGIN_QUOTE\n<point>:DRAWER:\nText\n:END:\n#+END_QUOTE" - (org-hide-drawer-toggle) + (org-fold-hide-drawer-toggle) (forward-line -1) - (org-hide-block-toggle) + (org-fold-hide-block-toggle) (search-forward "Text") - (org-show-set-visibility 'minimal) + (org-fold-show-set-visibility 'minimal) (org-invisible-p2)))) (ert-deftest test-org/copy-visible () -- 2.35.1 -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH v2 10/38] Implement link folding* lisp/ol.el (org-link--link-folding-spec): 2022-04-20 13:23 ` [PATCH v2 00/38] Final call for comments: " Ihor Radchenko ` (8 preceding siblings ...) 2022-04-20 13:25 ` [PATCH v2 09/38] Rename old function call to use org-fold--- Ihor Radchenko @ 2022-04-20 13:25 ` Ihor Radchenko 2022-04-20 13:25 ` [PATCH v2 11/38] Implement overlay- and text-property-based versions of some functions Ihor Radchenko ` (31 subsequent siblings) 41 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-04-20 13:25 UTC (permalink / raw) To: emacs-orgmode * lisp/ol.el (org-link--link-folding-spec): (org-link--description-folding-spec): New variables controlling link folding settings. (org-link--reveal-maybe): Handle revealing folded links. (org-link-descriptive-ensure): Implement `org-link-descriptive' support with org-fold. (org-toggle-link-display--overlays): (org-toggle-link-display--text-properties): (org-toggle-link-display): Provide text-properties and overlays versions. * lisp/org-agenda.el (org-agenda-mode): Use org-fold to fold links in agenda. * lisp/org.el (org-do-emphasis-faces): Use org-fold. --- lisp/ol.el | 42 +++++++++++++++++++++++++++++++++++++++++- lisp/org-agenda.el | 3 ++- lisp/org.el | 11 +++++++++-- 3 files changed, 52 insertions(+), 4 deletions(-) diff --git a/lisp/ol.el b/lisp/ol.el index 4cc813d5b..86f55d7cf 100644 --- a/lisp/ol.el +++ b/lisp/ol.el @@ -605,6 +605,22 @@ (defvar org-link--insert-history nil (defvar org-link--search-failed nil "Non-nil when last link search failed.") + +(defvar-local org-link--link-folding-spec '(org-link + (:global t) + (:ellipsis . nil) + (:isearch-open . t) + (:fragile . org-link--reveal-maybe)) + "Folding spec used to hide invisible parts of links.") + +(defvar-local org-link--description-folding-spec '(org-link-description + (:global t) + (:ellipsis . nil) + (:visible . t) + (:isearch-open . nil) + (:fragile . org-link--reveal-maybe)) + "Folding spec used to reveal link description.") + \f ;;; Internal Functions @@ -762,6 +778,13 @@ (defun org-link--normalize-string (string &optional context) (t nil)))) string)) +(defun org-link--reveal-maybe (region _) + "Reveal folded link in REGION when needed. +This function is intended to be used as :fragile property of a folding +spec." + (org-with-point-at (car region) + (not (org-in-regexp org-link-any-re)))) + \f ;;; Public API @@ -1444,14 +1467,31 @@ (defun org-previous-link () (interactive) (org-next-link t)) +(defun org-link-descriptive-ensure () + "Toggle the literal or descriptive display of links in current buffer if needed." + (if org-link-descriptive + (org-fold-core-set-folding-spec-property (car org-link--link-folding-spec) :visible nil) + (org-fold-core-set-folding-spec-property (car org-link--link-folding-spec) :visible t))) + ;;;###autoload -(defun org-toggle-link-display () +(defun org-toggle-link-display--overlays () "Toggle the literal or descriptive display of links." (interactive) (if org-link-descriptive (remove-from-invisibility-spec '(org-link)) (add-to-invisibility-spec '(org-link))) (org-restart-font-lock) (setq org-link-descriptive (not org-link-descriptive))) +(defun org-toggle-link-display--text-properties () + "Toggle the literal or descriptive display of links in current buffer." + (interactive) + (setq org-link-descriptive (not org-link-descriptive)) + (org-link-descriptive-ensure)) +(defsubst org-toggle-link-display () + "Toggle the literal or descriptive display of links." + (interactive) + (if (eq org-fold-core-style 'text-properties) + (org-toggle-link-display--text-properties) + (org-toggle-link-display--overlays))) ;;;###autoload (defun org-store-link (arg &optional interactive?) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index fa60f4f19..6aed778f0 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -2325,7 +2325,8 @@ (defun org-agenda-mode () org-agenda-show-log org-agenda-start-with-log-mode org-agenda-clockreport-mode org-agenda-start-with-clockreport-mode)) (add-to-invisibility-spec '(org-filtered)) - (add-to-invisibility-spec '(org-link)) + (org-fold-core-initialize `(,org-link--description-folding-spec + ,org-link--link-folding-spec)) (easy-menu-change '("Agenda") "Agenda Files" (append diff --git a/lisp/org.el b/lisp/org.el index ca4973bc3..f6709f4cc 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -4563,9 +4563,16 @@ (define-derived-mode org-mode outline-mode "Org" (setq-local org-mode-loading t) (org-load-modules-maybe) (org-install-agenda-files-menu) - (when org-link-descriptive (add-to-invisibility-spec '(org-link))) + (when (and org-link-descriptive + (eq org-fold-core-style 'overlays)) + (add-to-invisibility-spec '(org-link))) + (org-fold-initialize (or (and (stringp org-ellipsis) (not (equal "" org-ellipsis)) org-ellipsis) + "...")) (make-local-variable 'org-link-descriptive) - (add-to-invisibility-spec '(org-hide-block . t)) + (when (eq org-fold-core-style 'overlays) (add-to-invisibility-spec '(org-hide-block . t))) + (if org-link-descriptive + (org-fold-core-set-folding-spec-property (car org-link--link-folding-spec) :visible nil) + (org-fold-core-set-folding-spec-property (car org-link--link-folding-spec) :visible t)) (setq-local outline-regexp org-outline-regexp) (setq-local outline-level 'org-outline-level) (setq bidi-paragraph-direction 'left-to-right) -- 2.35.1 -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH v2 11/38] Implement overlay- and text-property-based versions of some functions 2022-04-20 13:23 ` [PATCH v2 00/38] Final call for comments: " Ihor Radchenko ` (9 preceding siblings ...) 2022-04-20 13:25 ` [PATCH v2 10/38] Implement link folding* lisp/ol.el (org-link--link-folding-spec): Ihor Radchenko @ 2022-04-20 13:25 ` Ihor Radchenko 2022-04-20 13:25 ` [PATCH v2 12/38] org-fold: Handle indirect buffer visibility--- Ihor Radchenko ` (30 subsequent siblings) 41 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-04-20 13:25 UTC (permalink / raw) To: emacs-orgmode --- lisp/org-element.el | 54 ++++- lisp/org-fold.el | 5 +- lisp/org-inlinetask.el | 26 ++- lisp/org-list.el | 74 ++++++- lisp/org-macs.el | 54 ++++- lisp/org.el | 469 +++++++++++++++++++++++++++++++++-------- 6 files changed, 585 insertions(+), 97 deletions(-) diff --git a/lisp/org-element.el b/lisp/org-element.el index f627dd4ea..203695c71 100644 --- a/lisp/org-element.el +++ b/lisp/org-element.el @@ -7912,7 +7912,7 @@ (defun org-element-nested-p (elem-A elem-B) (or (and (>= beg-A beg-B) (<= end-A end-B)) (and (>= beg-B beg-A) (<= end-B end-A))))) -(defun org-element-swap-A-B (elem-A elem-B) +(defun org-element-swap-A-B--overlays (elem-A elem-B) "Swap elements ELEM-A and ELEM-B. Assume ELEM-B is after ELEM-A in the buffer. Leave point at the end of ELEM-A." @@ -7980,6 +7980,58 @@ (defun org-element-swap-A-B (elem-A elem-B) (dolist (o (cdr overlays)) (move-overlay (car o) (- (nth 1 o) offset) (- (nth 2 o) offset)))) (goto-char (org-element-property :end elem-B))))) +(defun org-element-swap-A-B--text-properties (elem-A elem-B) + "Swap elements ELEM-A and ELEM-B. +Assume ELEM-B is after ELEM-A in the buffer. Leave point at the +end of ELEM-A." + (goto-char (org-element-property :begin elem-A)) + ;; There are two special cases when an element doesn't start at bol: + ;; the first paragraph in an item or in a footnote definition. + (let ((specialp (not (bolp)))) + ;; Only a paragraph without any affiliated keyword can be moved at + ;; ELEM-A position in such a situation. Note that the case of + ;; a footnote definition is impossible: it cannot contain two + ;; paragraphs in a row because it cannot contain a blank line. + (when (and specialp + (or (not (eq (org-element-type elem-B) 'paragraph)) + (/= (org-element-property :begin elem-B) + (org-element-property :contents-begin elem-B)))) + (error "Cannot swap elements")) + ;; In a special situation, ELEM-A will have no indentation. We'll + ;; give it ELEM-B's (which will in, in turn, have no indentation). + (org-fold-core-ignore-modifications ;; Preserve folding state + (let* ((ind-B (when specialp + (goto-char (org-element-property :begin elem-B)) + (current-indentation))) + (beg-A (org-element-property :begin elem-A)) + (end-A (save-excursion + (goto-char (org-element-property :end elem-A)) + (skip-chars-backward " \r\t\n") + (point-at-eol))) + (beg-B (org-element-property :begin elem-B)) + (end-B (save-excursion + (goto-char (org-element-property :end elem-B)) + (skip-chars-backward " \r\t\n") + (point-at-eol))) + ;; Get contents. + (body-A (buffer-substring beg-A end-A)) + (body-B (delete-and-extract-region beg-B end-B))) + (goto-char beg-B) + (when specialp + (setq body-B (replace-regexp-in-string "\\`[ \t]*" "" body-B)) + (indent-to-column ind-B)) + (insert body-A) + (goto-char beg-A) + (delete-region beg-A end-A) + (insert body-B) + (goto-char (org-element-property :end elem-B)))))) +(defsubst org-element-swap-A-B (elem-A elem-B) + "Swap elements ELEM-A and ELEM-B. +Assume ELEM-B is after ELEM-A in the buffer. Leave point at the +end of ELEM-A." + (if (eq org-fold-core-style 'text-properties) + (org-element-swap-A-B--text-properties elem-A elem-B) + (org-element-swap-A-B--overlays elem-A elem-B))) (provide 'org-element) diff --git a/lisp/org-fold.el b/lisp/org-fold.el index 52717fd86..e48a528bf 100644 --- a/lisp/org-fold.el +++ b/lisp/org-fold.el @@ -53,10 +53,7 @@ (defvar org-drawer-regexp) (defvar org-property-end-re) (defvar org-link-descriptive) (defvar org-outline-regexp-bol) -(defvar org-custom-properties-hidden-p) (defvar org-archive-tag) - -;; Needed for overlays only (defvar org-custom-properties-overlays) (declare-function isearch-filter-visible "isearch" (beg end)) @@ -1101,7 +1098,7 @@ (defun org-fold-check-before-invisible-edit--text-properties (kind) (when (or invisible-at-point invisible-before-point) (when (eq org-fold-catch-invisible-edits 'error) (user-error "Editing in invisible areas is prohibited, make them visible first")) - (if (and org-custom-properties-hidden-p + (if (and org-custom-properties-overlays (y-or-n-p "Display invisible properties in this buffer? ")) (org-toggle-custom-properties-visibility) ;; Make the area visible diff --git a/lisp/org-inlinetask.el b/lisp/org-inlinetask.el index 581370bb5..a63704a05 100644 --- a/lisp/org-inlinetask.el +++ b/lisp/org-inlinetask.el @@ -305,7 +305,22 @@ (defun org-inlinetask-fontify (limit) (add-text-properties (match-beginning 3) (match-end 3) '(face org-inlinetask font-lock-fontified t))))) -(defun org-inlinetask-toggle-visibility () +(defun org-inlinetask-toggle-visibility--text-properties () + "Toggle visibility of inline task at point." + (let ((end (save-excursion + (org-inlinetask-goto-end) + (if (bolp) (1- (point)) (point)))) + (start (save-excursion + (org-inlinetask-goto-beginning) + (point-at-eol)))) + (cond + ;; Nothing to show/hide. + ((= end start)) + ;; Inlinetask was folded: expand it. + ((org-fold-get-folding-spec 'headline (1+ start)) + (org-fold-region start end nil 'headline)) + (t (org-fold-region start end t 'headline))))) +(defun org-inlinetask-toggle-visibility--overlays () "Toggle visibility of inline task at point." (let ((end (save-excursion (org-inlinetask-goto-end) @@ -318,8 +333,13 @@ (defun org-inlinetask-toggle-visibility () ((= end start)) ;; Inlinetask was folded: expand it. ((eq (get-char-property (1+ start) 'invisible) 'outline) - (org-flag-region start end nil 'outline)) - (t (org-flag-region start end t 'outline))))) + (org-fold-region start end nil 'outline)) + (t (org-fold-region start end t 'outline))))) +(defsubst org-inlinetask-toggle-visibility () + "Toggle visibility of inline task at point." + (if (eq org-fold-core-style 'text-properties) + (org-inlinetask-toggle-visibility--text-properties) + (org-inlinetask-toggle-visibility--overlays))) (defun org-inlinetask-hide-tasks (state) "Hide inline tasks in buffer when STATE is `contents' or `children'. diff --git a/lisp/org-list.el b/lisp/org-list.el index 05a73a609..f72151460 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -1079,7 +1079,65 @@ (defsubst org-list-bullet-string (bullet) (replace-match spaces nil nil bullet 1) bullet)))) -(defun org-list-swap-items (beg-A beg-B struct) +(defun org-list-swap-items--text-properties (beg-A beg-B struct) + "Swap item starting at BEG-A with item starting at BEG-B in STRUCT. + +Blank lines at the end of items are left in place. Item +visibility is preserved. Return the new structure after the +changes. + +Assume BEG-A is lesser than BEG-B and that BEG-A and BEG-B belong +to the same sub-list. + +This function modifies STRUCT." + (save-excursion + (org-fold-core-ignore-modifications + (let* ((end-A-no-blank (org-list-get-item-end-before-blank beg-A struct)) + (end-B-no-blank (org-list-get-item-end-before-blank beg-B struct)) + (end-A (org-list-get-item-end beg-A struct)) + (end-B (org-list-get-item-end beg-B struct)) + (size-A (- end-A-no-blank beg-A)) + (size-B (- end-B-no-blank beg-B)) + (body-A (buffer-substring beg-A end-A-no-blank)) + (body-B (buffer-substring beg-B end-B-no-blank)) + (between-A-no-blank-and-B (buffer-substring end-A-no-blank beg-B)) + (sub-A (cons beg-A (org-list-get-subtree beg-A struct))) + (sub-B (cons beg-B (org-list-get-subtree beg-B struct)))) + ;; 1. Move effectively items in buffer. + (goto-char beg-A) + (delete-region beg-A end-B-no-blank) + (insert (concat body-B between-A-no-blank-and-B body-A)) + ;; 2. Now modify struct. No need to re-read the list, the + ;; transformation is just a shift of positions. Some special + ;; attention is required for items ending at END-A and END-B + ;; as empty spaces are not moved there. In others words, + ;; item BEG-A will end with whitespaces that were at the end + ;; of BEG-B and the same applies to BEG-B. + (dolist (e struct) + (let ((pos (car e))) + (cond + ((< pos beg-A)) + ((memq pos sub-A) + (let ((end-e (nth 6 e))) + (setcar e (+ pos (- end-B-no-blank end-A-no-blank))) + (setcar (nthcdr 6 e) + (+ end-e (- end-B-no-blank end-A-no-blank))) + (when (= end-e end-A) (setcar (nthcdr 6 e) end-B)))) + ((memq pos sub-B) + (let ((end-e (nth 6 e))) + (setcar e (- (+ pos beg-A) beg-B)) + (setcar (nthcdr 6 e) (+ end-e (- beg-A beg-B))) + (when (= end-e end-B) + (setcar (nthcdr 6 e) + (+ beg-A size-B (- end-A end-A-no-blank)))))) + ((< pos beg-B) + (let ((end-e (nth 6 e))) + (setcar e (+ pos (- size-B size-A))) + (setcar (nthcdr 6 e) (+ end-e (- size-B size-A)))))))) + (setq struct (sort struct #'car-less-than-car)) + ;; Return structure. + struct)))) +(defun org-list-swap-items--overlays (beg-A beg-B struct) "Swap item starting at BEG-A with item starting at BEG-B in STRUCT. Blank lines at the end of items are left in place. Item @@ -1164,6 +1222,20 @@ (defun org-list-swap-items (beg-A beg-B struct) (+ (nth 2 ov) (- beg-A beg-B)))) ;; Return structure. struct))) +(defsubst org-list-swap-items (beg-A beg-B struct) + "Swap item starting at BEG-A with item starting at BEG-B in STRUCT. + +Blank lines at the end of items are left in place. Item +visibility is preserved. Return the new structure after the +changes. + +Assume BEG-A is lesser than BEG-B and that BEG-A and BEG-B belong +to the same sub-list. + +This function modifies STRUCT." + (if (eq org-fold-core-style 'text-properties) + (org-list-swap-items--text-properties beg-A beg-B struct) + (org-list-swap-items--overlays beg-A beg-B struct))) (defun org-list-separating-blank-lines-number (pos struct prevs) "Return number of blank lines that should separate items in list. diff --git a/lisp/org-macs.el b/lisp/org-macs.el index 7703e09e4..a894d4323 100644 --- a/lisp/org-macs.el +++ b/lisp/org-macs.el @@ -1109,7 +1109,18 @@ (defun org-find-text-property-in-string (prop s) (get-text-property (or (next-single-property-change 0 prop s) 0) prop s))) -(defun org-invisible-p (&optional pos folding-only) +;; FIXME: move to org-fold? +(defun org-invisible-p--text-properties (&optional pos folding-only) + "Non-nil if the character after POS is invisible. +If POS is nil, use `point' instead. When optional argument +FOLDING-ONLY is non-nil, only consider invisible parts due to +folding of a headline, a block or a drawer, i.e., not because of +fontification." + (let ((value (invisible-p (or pos (point))))) + (cond ((not value) nil) + (folding-only (org-fold-folded-p (or pos (point)))) + (t value)))) +(defun org-invisible-p--overlays (&optional pos folding-only) "Non-nil if the character after POS is invisible. If POS is nil, use `point' instead. When optional argument FOLDING-ONLY is non-nil, only consider invisible parts due to @@ -1118,7 +1129,16 @@ (defun org-invisible-p (&optional pos folding-only) (let ((value (get-char-property (or pos (point)) 'invisible))) (cond ((not value) nil) (folding-only (memq value '(org-hide-block outline))) - (t value)))) + (t (and (invisible-p (or pos (point))) value))))) +(defsubst org-invisible-p (&optional pos folding-only) + "Non-nil if the character after POS is invisible. +If POS is nil, use `point' instead. When optional argument +FOLDING-ONLY is non-nil, only consider invisible parts due to +folding of a headline, a block or a drawer, i.e., not because of +fontification." + (if (eq org-fold-core-style 'text-properties) + (org-invisible-p--text-properties pos folding-only) + (org-invisible-p--overlays pos folding-only))) (defun org-truly-invisible-p () "Check if point is at a character currently not visible. @@ -1136,17 +1156,43 @@ (defun org-invisible-p2 () (backward-char 1)) (org-invisible-p))) -(defun org-find-visible () +(defun org-region-invisible-p (beg end) + "Check if region if completely hidden." + (org-with-wide-buffer + (and (org-invisible-p beg) + (org-invisible-p (org-fold-next-visibility-change beg end))))) + +(defun org-find-visible--overlays () "Return closest visible buffer position, or `point-max'." (if (org-invisible-p) (next-single-char-property-change (point) 'invisible) (point))) +(defun org-find-visible--text-properties () + "Return closest visible buffer position, or `point-max'." + (if (org-invisible-p) + (org-fold-next-visibility-change (point)) + (point))) +(defsubst org-find-visible () + "Return closest visible buffer position, or `point-max'." + (if (eq org-fold-core-style 'text-properties) + (org-find-visible--text-properties) + (org-find-visible--overlays))) -(defun org-find-invisible () +(defun org-find-invisible--overlays () "Return closest invisible buffer position, or `point-max'." (if (org-invisible-p) (point) (next-single-char-property-change (point) 'invisible))) +(defun org-find-invisible--text-properties () + "Return closest invisible buffer position, or `point-max'." + (if (org-invisible-p) + (point) + (org-fold-next-visibility-change (point)))) +(defsubst org-find-invisible () + "Return closest invisible buffer position, or `point-max'." + (if (eq org-fold-core-style 'text-properties) + (org-find-invisible--text-properties) + (org-find-invisible--overlays))) \f ;;; Time diff --git a/lisp/org.el b/lisp/org.el index f6709f4cc..0b50e30d9 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -4912,7 +4912,7 @@ (defconst org-nonsticky-props (defsubst org-rear-nonsticky-at (pos) (add-text-properties (1- pos) pos (list 'rear-nonsticky org-nonsticky-props))) -(defun org-activate-links (limit) +(defun org-activate-links--overlays (limit) "Add link properties to links. This includes angle, plain, and bracket links." (catch :exit @@ -4927,13 +4927,13 @@ (defun org-activate-links (limit) (when (and (memq style org-highlight-links) ;; Do not span over paragraph boundaries. (not (string-match-p org-element-paragraph-separate - (match-string 0))) + (match-string 0))) ;; Do not confuse plain links with tags. (not (and (eq style 'plain) - (let ((face (get-text-property - (max (1- start) (point-min)) 'face))) - (if (consp face) (memq 'org-tag face) - (eq 'org-tag face)))))) + (let ((face (get-text-property + (max (1- start) (point-min)) 'face))) + (if (consp face) (memq 'org-tag face) + (eq 'org-tag face)))))) (let* ((link-object (save-excursion (goto-char start) (save-match-data (org-element-link-parser)))) @@ -4983,6 +4983,99 @@ (defun org-activate-links (limit) (funcall f start end path (eq style 'bracket)))) (throw :exit t))))) ;signal success nil)) +(defun org-activate-links--text-properties (limit) + "Add link properties to links. +This includes angle, plain, and bracket links." + (catch :exit + (while (re-search-forward org-link-any-re limit t) + (let* ((start (match-beginning 0)) + (end (match-end 0)) + (visible-start (or (match-beginning 3) (match-beginning 2))) + (visible-end (or (match-end 3) (match-end 2))) + (style (cond ((eq ?< (char-after start)) 'angle) + ((eq ?\[ (char-after (1+ start))) 'bracket) + (t 'plain)))) + (when (and (memq style org-highlight-links) + ;; Do not span over paragraph boundaries. + (not (string-match-p org-element-paragraph-separate + (match-string 0))) + ;; Do not confuse plain links with tags. + (not (and (eq style 'plain) + (let ((face (get-text-property + (max (1- start) (point-min)) 'face))) + (if (consp face) (memq 'org-tag face) + (eq 'org-tag face)))))) + (let* ((link-object (save-excursion + (goto-char start) + (save-match-data (org-element-link-parser)))) + (link (org-element-property :raw-link link-object)) + (type (org-element-property :type link-object)) + (path (org-element-property :path link-object)) + (face-property (pcase (org-link-get-parameter type :face) + ((and (pred functionp) face) (funcall face path)) + ((and (pred facep) face) face) + ((and (pred consp) face) face) ;anonymous + (_ 'org-link))) + (properties ;for link's visible part + (list 'mouse-face (or (org-link-get-parameter type :mouse-face) + 'highlight) + 'keymap (or (org-link-get-parameter type :keymap) + org-mouse-map) + 'help-echo (pcase (org-link-get-parameter type :help-echo) + ((and (pred stringp) echo) echo) + ((and (pred functionp) echo) echo) + (_ (concat "LINK: " link))) + 'htmlize-link (pcase (org-link-get-parameter type + :htmlize-link) + ((and (pred functionp) f) (funcall f)) + (_ `(:uri ,link))) + 'font-lock-multiline t))) + (org-remove-flyspell-overlays-in start end) + (org-rear-nonsticky-at end) + (if (not (eq 'bracket style)) + (progn + (add-face-text-property start end face-property) + (add-text-properties start end properties)) + ;; Initialise folding when used ouside org-mode. + (unless (or (derived-mode-p 'org-mode) + (and (org-fold-folding-spec-p 'org-link-description) + (org-fold-folding-spec-p 'org-link))) + (org-fold-initialize (or (and (stringp org-ellipsis) (not (equal "" org-ellipsis)) org-ellipsis) + "..."))) + ;; Handle invisible parts in bracket links. + (let ((spec (or (org-link-get-parameter type :display) + 'org-link))) + (unless (org-fold-folding-spec-p spec) + (org-fold-add-folding-spec spec + (cdr org-link--link-folding-spec) + nil + 'append) + (org-fold-core-set-folding-spec-property spec :visible t)) + (org-fold-region start end nil 'org-link) + (org-fold-region start end nil 'org-link-description) + ;; We are folding the whole emphasised text with SPEC + ;; first. It makes everything invisible (or whatever + ;; the user wants). + (org-fold-region start end t spec) + ;; The visible part of the text is folded using + ;; 'org-link-description, which is forcing this part of + ;; the text to be visible. + (org-fold-region visible-start visible-end t 'org-link-description) + (add-text-properties start end properties) + (add-face-text-property start end face-property) + (org-rear-nonsticky-at visible-start) + (org-rear-nonsticky-at visible-end))) + (let ((f (org-link-get-parameter type :activate-func))) + (when (functionp f) + (funcall f start end path (eq style 'bracket)))) + (throw :exit t))))) ;signal success + nil)) +(defsubst org-activate-links (limit) + "Add link properties to links. +This includes angle, plain, and bracket links." + (if (eq org-fold-core-style 'text-properties) + (org-activate-links--text-properties limit) + (org-activate-links--overlays limit))) (defun org-activate-code (limit) (when (re-search-forward "^[ \t]*\\(:\\(?: .*\\|$\\)\n?\\)" limit t) @@ -6740,81 +6833,82 @@ (defun org-paste-subtree (&optional level tree for-yank remove) (substitute-command-keys "The kill is not a (set of) tree(s). Use `\\[yank]' to yank anyway"))) (org-with-limited-levels - (let* ((visp (not (org-invisible-p))) - (txt tree) - (old-level (if (string-match org-outline-regexp-bol txt) - (- (match-end 0) (match-beginning 0) 1) - -1)) - (force-level - (cond - (level (prefix-numeric-value level)) - ;; When point is after the stars in an otherwise empty - ;; headline, use the number of stars as the forced level. - ((and (org-match-line "^\\*+[ \t]*$") - (not (eq ?* (char-after)))) - (org-outline-level)) - ((looking-at-p org-outline-regexp-bol) (org-outline-level)))) - (previous-level - (save-excursion - (org-previous-visible-heading 1) - (if (org-at-heading-p) (org-outline-level) 1))) - (next-level - (save-excursion - (if (org-at-heading-p) (org-outline-level) - (org-next-visible-heading 1) - (if (org-at-heading-p) (org-outline-level) 1)))) - (new-level (or force-level (max previous-level next-level))) - (shift (if (or (= old-level -1) - (= new-level -1) - (= old-level new-level)) - 0 - (- new-level old-level))) - (delta (if (> shift 0) -1 1)) - (func (if (> shift 0) #'org-demote #'org-promote)) - (org-odd-levels-only nil) - beg end newend) - ;; Remove the forced level indicator. - (when (and force-level (not level)) - (delete-region (line-beginning-position) (point))) - ;; Paste before the next visible heading or at end of buffer, - ;; unless point is at the beginning of a headline. - (unless (and (bolp) (org-at-heading-p)) - (org-next-visible-heading 1) - (unless (bolp) (insert "\n"))) - (setq beg (point)) - ;; Avoid re-parsing cache elements when i.e. level 1 heading - ;; is inserted and then promoted. - (combine-change-calls beg beg - (when (fboundp 'org-id-paste-tracker) (org-id-paste-tracker txt)) - (insert-before-markers txt) - (unless (string-suffix-p "\n" txt) (insert "\n")) - (setq newend (point)) - (org-reinstall-markers-in-region beg) - (setq end (point)) - (goto-char beg) - (skip-chars-forward " \t\n\r") - (setq beg (point)) - (when (and (org-invisible-p) visp) - (save-excursion (outline-show-heading))) - ;; Shift if necessary. - (unless (= shift 0) - (save-restriction - (narrow-to-region beg end) - (while (not (= shift 0)) - (org-map-region func (point-min) (point-max)) - (setq shift (+ delta shift))) - (goto-char (point-min)) - (setq newend (point-max))))) - (when (or for-yank (called-interactively-p 'interactive)) - (message "Clipboard pasted as level %d subtree" new-level)) - (when (and (not for-yank) ; in this case, org-yank will decide about folding - kill-ring - (equal org-subtree-clip (current-kill 0)) - org-subtree-clip-folded) - ;; The tree was folded before it was killed/copied - (org-flag-subtree t)) - (when for-yank (goto-char newend)) - (when remove (pop kill-ring))))) + (org-fold-core-ignore-fragility-checks + (let* ((visp (not (org-invisible-p))) + (txt tree) + (old-level (if (string-match org-outline-regexp-bol txt) + (- (match-end 0) (match-beginning 0) 1) + -1)) + (force-level + (cond + (level (prefix-numeric-value level)) + ;; When point is after the stars in an otherwise empty + ;; headline, use the number of stars as the forced level. + ((and (org-match-line "^\\*+[ \t]*$") + (not (eq ?* (char-after)))) + (org-outline-level)) + ((looking-at-p org-outline-regexp-bol) (org-outline-level)))) + (previous-level + (save-excursion + (org-previous-visible-heading 1) + (if (org-at-heading-p) (org-outline-level) 1))) + (next-level + (save-excursion + (if (org-at-heading-p) (org-outline-level) + (org-next-visible-heading 1) + (if (org-at-heading-p) (org-outline-level) 1)))) + (new-level (or force-level (max previous-level next-level))) + (shift (if (or (= old-level -1) + (= new-level -1) + (= old-level new-level)) + 0 + (- new-level old-level))) + (delta (if (> shift 0) -1 1)) + (func (if (> shift 0) #'org-demote #'org-promote)) + (org-odd-levels-only nil) + beg end newend) + ;; Remove the forced level indicator. + (when (and force-level (not level)) + (delete-region (line-beginning-position) (point))) + ;; Paste before the next visible heading or at end of buffer, + ;; unless point is at the beginning of a headline. + (unless (and (bolp) (org-at-heading-p)) + (org-next-visible-heading 1) + (unless (bolp) (insert "\n"))) + (setq beg (point)) + ;; Avoid re-parsing cache elements when i.e. level 1 heading + ;; is inserted and then promoted. + (combine-change-calls beg beg + (when (fboundp 'org-id-paste-tracker) (org-id-paste-tracker txt)) + (insert-before-markers txt) + (unless (string-suffix-p "\n" txt) (insert "\n")) + (setq newend (point)) + (org-reinstall-markers-in-region beg) + (setq end (point)) + (goto-char beg) + (skip-chars-forward " \t\n\r") + (setq beg (point)) + (when (and (org-invisible-p) visp) + (save-excursion (org-fold-heading nil))) + ;; Shift if necessary. + (unless (= shift 0) + (save-restriction + (narrow-to-region beg end) + (while (not (= shift 0)) + (org-map-region func (point-min) (point-max)) + (setq shift (+ delta shift))) + (goto-char (point-min)) + (setq newend (point-max))))) + (when (or for-yank (called-interactively-p 'interactive)) + (message "Clipboard pasted as level %d subtree" new-level)) + (when (and (not for-yank) ; in this case, org-yank will decide about folding + kill-ring + (equal org-subtree-clip (current-kill 0)) + org-subtree-clip-folded) + ;; The tree was folded before it was killed/copied + (org-fold-subtree t)) + (when for-yank (goto-char newend)) + (when remove (pop kill-ring)))))) (defun org-kill-is-subtree-p (&optional txt) "Check if the current kill is an outline subtree, or a set of trees. @@ -20013,7 +20107,7 @@ (defun org-backward-heading-same-level (arg &optional invisible-ok) (interactive "p") (org-forward-heading-same-level (if arg (- arg) -1) invisible-ok)) -(defun org-next-visible-heading (arg) +(defun org-next-visible-heading--overlays (arg) "Move to the next visible heading line. With ARG, repeats or can move backward if negative." (interactive "p") @@ -20039,6 +20133,35 @@ (defun org-next-visible-heading (arg) nil))) ;leave the loop (cl-decf arg)) (if (> arg 0) (goto-char (point-max)) (beginning-of-line)))) +(defun org-next-visible-heading--text-properties (arg) + "Move to the next visible heading line. +With ARG, repeats or can move backward if negative." + (interactive "p") + (let ((regexp (concat "^" (org-get-limited-outline-regexp)))) + (if (< arg 0) + (beginning-of-line) + (end-of-line)) + (while (and (< arg 0) (re-search-backward regexp nil :move)) + (unless (bobp) + (when (org-fold-folded-p) + (goto-char (org-fold-previous-visibility-change)) + (unless (looking-at-p regexp) + (re-search-backward regexp nil :mode)))) + (cl-incf arg)) + (while (and (> arg 0) (re-search-forward regexp nil :move)) + (when (org-fold-folded-p) + (goto-char (org-fold-next-visibility-change)) + (skip-chars-forward " \t\n") + (end-of-line)) + (cl-decf arg)) + (if (> arg 0) (goto-char (point-max)) (beginning-of-line)))) +(defun org-next-visible-heading (arg) + "Move to the next visible heading line. +With ARG, repeats or can move backward if negative." + (interactive "p") + (if (eq org-fold-core-style 'text-properties) + (org-next-visible-heading--text-properties arg) + (org-next-visible-heading--overlays arg))) (defun org-previous-visible-heading (arg) "Move to the previous visible heading. @@ -20171,7 +20294,7 @@ (defun org--paragraph-at-point () (list :begin b :end e :parent p :post-blank 0 :post-affiliated b))) (_ e)))) -(defun org--forward-paragraph-once () +(defun org--forward-paragraph-once--overlays () "Move forward to end of paragraph or equivalent, once. See `org-forward-paragraph'." (interactive) @@ -20243,8 +20366,84 @@ (defun org--forward-paragraph-once () (goto-char end) (skip-chars-backward " \t\n") (forward-line)))))))) +(defun org--forward-paragraph-once--text-properties () + "Move forward to end of paragraph or equivalent, once. +See `org-forward-paragraph'." + (interactive) + (save-restriction + (widen) + (skip-chars-forward " \t\n") + (cond + ((eobp) nil) + ;; When inside a folded part, move out of it. + ((when (org-invisible-p nil t) + (goto-char (cdr (org-fold-get-region-at-point))) + (forward-line) + t)) + (t + (let* ((element (org--paragraph-at-point)) + (type (org-element-type element)) + (contents-begin (org-element-property :contents-begin element)) + (end (org-element-property :end element)) + (post-affiliated (org-element-property :post-affiliated element))) + (cond + ((eq type 'plain-list) + (forward-char) + (org--forward-paragraph-once)) + ;; If the element is folded, skip it altogether. + ((when (org-with-point-at post-affiliated (org-invisible-p (line-end-position) t)) + (goto-char (cdr (org-fold-get-region-at-point + nil + (org-with-point-at post-affiliated + (line-end-position))))) + (forward-line) + t)) + ;; At a greater element, move inside. + ((and contents-begin + (> contents-begin (point)) + (not (eq type 'paragraph))) + (goto-char contents-begin) + ;; Items and footnote definitions contents may not start at + ;; the beginning of the line. In this case, skip until the + ;; next paragraph. + (cond + ((not (bolp)) (org--forward-paragraph-once)) + ((org-previous-line-empty-p) (forward-line -1)) + (t nil))) + ;; Move between empty lines in some blocks. + ((memq type '(comment-block example-block export-block src-block + verse-block)) + (let ((contents-start + (org-with-point-at post-affiliated + (line-beginning-position 2)))) + (if (< (point) contents-start) + (goto-char contents-start) + (let ((contents-end + (org-with-point-at end + (skip-chars-backward " \t\n") + (line-beginning-position)))) + (cond + ((>= (point) contents-end) + (goto-char end) + (skip-chars-backward " \t\n") + (forward-line)) + ((re-search-forward "^[ \t]*\n" contents-end :move) + (forward-line -1)) + (t nil)))))) + (t + ;; Move to element's end. + (goto-char end) + (skip-chars-backward " \t\n") + (forward-line)))))))) +(defun org--forward-paragraph-once () + "Move forward to end of paragraph or equivalent, once. +See `org-forward-paragraph'." + (interactive) + (if (eq org-fold-core-style 'text-properties) + (org--forward-paragraph-once--text-properties) + (org--forward-paragraph-once--overlays))) -(defun org--backward-paragraph-once () +(defun org--backward-paragraph-once--overlays () "Move backward to start of paragraph or equivalent, once. See `org-backward-paragraph'." (interactive) @@ -20346,6 +20545,108 @@ (defun org--backward-paragraph-once () ;; Move to element's start. (t (funcall reach begin)))))))) +(defun org--backward-paragraph-once--text-properties () + "Move backward to start of paragraph or equivalent, once. +See `org-backward-paragraph'." + (interactive) + (save-restriction + (widen) + (cond + ((bobp) nil) + ;; Blank lines at the beginning of the buffer. + ((and (org-match-line "^[ \t]*$") + (save-excursion (skip-chars-backward " \t\n") (bobp))) + (goto-char (point-min))) + ;; When inside a folded part, move out of it. + ((when (org-invisible-p (1- (point)) t) + (goto-char (1- (car (org-fold-get-region-at-point nil (1- (point)))))) + (org--backward-paragraph-once) + t)) + (t + (let* ((element (org--paragraph-at-point)) + (type (org-element-type element)) + (begin (org-element-property :begin element)) + (post-affiliated (org-element-property :post-affiliated element)) + (contents-end (org-element-property :contents-end element)) + (end (org-element-property :end element)) + (parent (org-element-property :parent element)) + (reach + ;; Move to the visible empty line above position P, or + ;; to position P. Return t. + (lambda (p) + (goto-char p) + (when (and (org-previous-line-empty-p) + (let ((end (line-end-position 0))) + (or (= end (point-min)) + (not (org-invisible-p (1- end)))))) + (forward-line -1)) + t))) + (cond + ;; Already at the beginning of an element. + ((= begin (point)) + (cond + ;; There is a blank line above. Move there. + ((and (org-previous-line-empty-p) + (not (org-invisible-p (1- (line-end-position 0))))) + (forward-line -1)) + ;; At the beginning of the first element within a greater + ;; element. Move to the beginning of the greater element. + ((and parent + (not (eq 'section (org-element-type parent))) + (= begin (org-element-property :contents-begin parent))) + (funcall reach (org-element-property :begin parent))) + ;; Since we have to move anyway, find the beginning + ;; position of the element above. + (t + (forward-char -1) + (org--backward-paragraph-once)))) + ;; Skip paragraphs at the very beginning of footnote + ;; definitions or items. + ((and (eq type 'paragraph) + (org-with-point-at begin (not (bolp)))) + (funcall reach (progn (goto-char begin) (line-beginning-position)))) + ;; If the element is folded, skip it altogether. + ((org-with-point-at post-affiliated (org-invisible-p (line-end-position) t)) + (funcall reach begin)) + ;; At the end of a greater element, move inside. + ((and contents-end + (<= contents-end (point)) + (not (eq type 'paragraph))) + (cond + ((memq type '(footnote-definition plain-list)) + (skip-chars-backward " \t\n") + (org--backward-paragraph-once)) + ((= contents-end (point)) + (forward-char -1) + (org--backward-paragraph-once)) + (t + (goto-char contents-end)))) + ;; Move between empty lines in some blocks. + ((and (memq type '(comment-block example-block export-block src-block + verse-block)) + (let ((contents-start + (org-with-point-at post-affiliated + (line-beginning-position 2)))) + (when (> (point) contents-start) + (let ((contents-end + (org-with-point-at end + (skip-chars-backward " \t\n") + (line-beginning-position)))) + (if (> (point) contents-end) + (progn (goto-char contents-end) t) + (skip-chars-backward " \t\n" begin) + (re-search-backward "^[ \t]*\n" contents-start :move) + t)))))) + ;; Move to element's start. + (t + (funcall reach begin)))))))) +(defun org--backward-paragraph-once () + "Move backward to start of paragraph or equivalent, once. +See `org-backward-paragraph'." + (interactive) + (if (eq org-fold-core-style 'text-properties) + (org--backward-paragraph-once--text-properties) + (org--backward-paragraph-once--overlays))) (defun org-forward-element () "Move forward by one element. -- 2.35.1 -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH v2 12/38] org-fold: Handle indirect buffer visibility--- 2022-04-20 13:23 ` [PATCH v2 00/38] Final call for comments: " Ihor Radchenko ` (10 preceding siblings ...) 2022-04-20 13:25 ` [PATCH v2 11/38] Implement overlay- and text-property-based versions of some functions Ihor Radchenko @ 2022-04-20 13:25 ` Ihor Radchenko 2022-04-20 13:25 ` [PATCH v2 13/38] Fix subtle differences between overlays and invisible text properties Ihor Radchenko ` (29 subsequent siblings) 41 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-04-20 13:25 UTC (permalink / raw) To: emacs-orgmode --- lisp/org-capture.el | 5 ++++- lisp/org.el | 8 +++++++- 2 files changed, 11 insertions(+), 2 deletions(-) diff --git a/lisp/org-capture.el b/lisp/org-capture.el index 1324ffab4..068e3eda2 100644 --- a/lisp/org-capture.el +++ b/lisp/org-capture.el @@ -1171,7 +1171,10 @@ (defun org-capture-place-entry () (goto-char (point-min)) (unless (org-at-heading-p) (outline-next-heading))) ;; Otherwise, insert as a top-level entry at the end of the file. - (t (goto-char (point-max)))) + (t (goto-char (point-max)) + ;; Make sure that last point is not folded. + (org-fold-core-cycle-over-indirect-buffers + (org-fold-region (max 1 (1- (point-max))) (point-max) nil)))) (let ((origin (point))) (unless (bolp) (insert "\n")) (org-capture-empty-lines-before) diff --git a/lisp/org.el b/lisp/org.el index 0b50e30d9..9ebdb23e1 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -5984,7 +5984,13 @@ (defun org-get-indirect-buffer (&optional buffer heading) (number-to-string n)))))) (setq n (1+ n))) (condition-case nil - (make-indirect-buffer buffer bname 'clone) + (let ((indirect-buffer (make-indirect-buffer buffer bname 'clone))) + ;; Decouple folding state. We need to do it manually since + ;; `make-indirect-buffer' does not run + ;; `clone-indirect-buffer-hook'. + (org-fold-core-decouple-indirect-buffer-folds) + ;; Return the buffer. + indirect-buffer) (error (make-indirect-buffer buffer bname))))) (defun org-set-frame-title (title) -- 2.35.1 -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH v2 13/38] Fix subtle differences between overlays and invisible text properties 2022-04-20 13:23 ` [PATCH v2 00/38] Final call for comments: " Ihor Radchenko ` (11 preceding siblings ...) 2022-04-20 13:25 ` [PATCH v2 12/38] org-fold: Handle indirect buffer visibility--- Ihor Radchenko @ 2022-04-20 13:25 ` Ihor Radchenko 2022-04-20 13:25 ` [PATCH v2 14/38] Support extra org-fold optimisations for huge buffers Ihor Radchenko ` (28 subsequent siblings) 41 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-04-20 13:25 UTC (permalink / raw) To: emacs-orgmode * lisp/org-clock.el (org-clock-in): (org-clock-find-position): (org-clock-out): * lisp/org.el (org-add-planning-info): (org-scan-tags): (org-global-tags-completion-table): (org-make-tags-matcher): (org-tags-expand): (org--property-local-values): (org-read-date-analyze): (org-revert-all-org-buffers): (org-beginning-of-line): Make sure that we inherit invisible state when inserting text. (org-sort-entries): Preserve invisible state after replace-match. (org-log-beginning): Do not try to move by visible lines. * lisp/org-macs.el (org-preserve-local-variables): Do not try to preserve overlays. * lisp/ox.el (org-export--generate-copy-script): Preserve folding properties in export buffer. * testing/lisp/test-ob.el (test-ob/preserve-results-indentation): Fix test failure. * testing/lisp/test-org.el (test-org/meta-return): (test-org/custom-properties): Use new folding. --- lisp/org-clock.el | 116 ++++---- lisp/org-macs.el | 12 +- lisp/org.el | 560 ++++++++++++++++++++------------------- lisp/ox.el | 4 +- testing/lisp/test-ob.el | 12 +- testing/lisp/test-org.el | 3 + 6 files changed, 367 insertions(+), 340 deletions(-) diff --git a/lisp/org-clock.el b/lisp/org-clock.el index 583b30237..ec87aaf8a 100644 --- a/lisp/org-clock.el +++ b/lisp/org-clock.el @@ -1373,14 +1373,14 @@ (defun org-clock-in (&optional select start-time) (sit-for 2) (throw 'abort nil)) (t - (insert-before-markers "\n") + (insert-before-markers-and-inherit "\n") (backward-char 1) (when (and (save-excursion (end-of-line 0) (org-in-item-p))) (beginning-of-line 1) (indent-line-to (max 0 (- (current-indentation) 2)))) - (insert org-clock-string " ") + (insert-and-inherit org-clock-string " ") (setq org-clock-effort (org-entry-get (point) org-effort-property)) (setq org-clock-total-time (org-clock-sum-current-item (org-clock-get-sum-start))) @@ -1581,19 +1581,23 @@ (defun org-clock-find-position (find-unclosed) count (1+ count)))))) (cond ((null positions) - ;; Skip planning line and property drawer, if any. - (org-end-of-meta-data) - (unless (bolp) (insert "\n")) - ;; Create a new drawer if necessary. - (when (and org-clock-into-drawer - (or (not (wholenump org-clock-into-drawer)) - (< org-clock-into-drawer 2))) - (let ((beg (point))) - (insert ":" drawer ":\n:END:\n") - (org-indent-region beg (point)) - (org-flag-region - (line-end-position -1) (1- (point)) t 'outline) - (forward-line -1)))) + (org-fold-core-ignore-modifications + ;; Skip planning line and property drawer, if any. + (org-end-of-meta-data) + (unless (bolp) (insert-and-inherit "\n")) + ;; Create a new drawer if necessary. + (when (and org-clock-into-drawer + (or (not (wholenump org-clock-into-drawer)) + (< org-clock-into-drawer 2))) + (let ((beg (point))) + (insert-and-inherit ":" drawer ":\n:END:\n") + (org-indent-region beg (point)) + (if (eq org-fold-core-style 'text-properties) + (org-fold-region + (line-end-position -1) (1- (point)) t 'drawer) + (org-fold-region + (line-end-position -1) (1- (point)) t 'outline)) + (forward-line -1))))) ;; When a clock drawer needs to be created because of the ;; number of clock items or simply if it is missing, collect ;; all clocks in the section and wrap them within the drawer. @@ -1602,28 +1606,29 @@ (defun org-clock-find-position (find-unclosed) drawer) ;; Skip planning line and property drawer, if any. (org-end-of-meta-data) - (let ((beg (point))) - (insert - (mapconcat - (lambda (p) - (save-excursion - (goto-char p) - (org-trim (delete-and-extract-region - (save-excursion (skip-chars-backward " \r\t\n") - (line-beginning-position 2)) - (line-beginning-position 2))))) - positions "\n") - "\n:END:\n") - (let ((end (point-marker))) - (goto-char beg) - (save-excursion (insert ":" drawer ":\n")) - (org-flag-region (line-end-position) (1- end) t 'outline) - (org-indent-region (point) end) - (forward-line) - (unless org-log-states-order-reversed - (goto-char end) - (beginning-of-line -1)) - (set-marker end nil)))) + (org-fold-core-ignore-modifications + (let ((beg (point))) + (insert-and-inherit + (mapconcat + (lambda (p) + (save-excursion + (goto-char p) + (org-trim (delete-and-extract-region + (save-excursion (skip-chars-backward " \r\t\n") + (line-beginning-position 2)) + (line-beginning-position 2))))) + positions "\n") + "\n:END:\n") + (let ((end (point-marker))) + (goto-char beg) + (save-excursion (insert-and-inherit ":" drawer ":\n")) + (org-fold-region (line-end-position) (1- end) t 'outline) + (org-indent-region (point) end) + (forward-line) + (unless org-log-states-order-reversed + (goto-char end) + (beginning-of-line -1)) + (set-marker end nil))))) (org-log-states-order-reversed (goto-char (car (last positions)))) (t (goto-char (car positions)))))))) @@ -1672,24 +1677,25 @@ (defun org-clock-out (&optional switch-to-state fail-quietly at-time) (if fail-quietly (throw 'exit nil) (error "Clock start time is gone"))) (goto-char (match-end 0)) (delete-region (point) (point-at-eol)) - (insert "--") - (setq te (org-insert-time-stamp (or at-time now) 'with-hm 'inactive)) - (setq s (org-time-convert-to-integer - (time-subtract - (org-time-string-to-time te) - (org-time-string-to-time ts))) - h (floor s 3600) - m (floor (mod s 3600) 60)) - (insert " => " (format "%2d:%02d" h m)) - (move-marker org-clock-marker nil) - (move-marker org-clock-hd-marker nil) - ;; Possibly remove zero time clocks. - (when (and org-clock-out-remove-zero-time-clocks - (= 0 h m)) - (setq remove t) - (delete-region (line-beginning-position) - (line-beginning-position 2))) - (org-clock-remove-empty-clock-drawer) + (org-fold-core-ignore-modifications + (insert-and-inherit "--") + (setq te (org-insert-time-stamp (or at-time now) 'with-hm 'inactive)) + (setq s (org-time-convert-to-integer + (time-subtract + (org-time-string-to-time te) + (org-time-string-to-time ts))) + h (floor s 3600) + m (floor (mod s 3600) 60)) + (insert-and-inherit " => " (format "%2d:%02d" h m)) + (move-marker org-clock-marker nil) + (move-marker org-clock-hd-marker nil) + ;; Possibly remove zero time clocks. + (when (and org-clock-out-remove-zero-time-clocks + (= 0 h m)) + (setq remove t) + (delete-region (line-beginning-position) + (line-beginning-position 2))) + (org-clock-remove-empty-clock-drawer)) (when org-clock-mode-line-timer (cancel-timer org-clock-mode-line-timer) (setq org-clock-mode-line-timer nil)) diff --git a/lisp/org-macs.el b/lisp/org-macs.el index a894d4323..42a91781b 100644 --- a/lisp/org-macs.el +++ b/lisp/org-macs.el @@ -170,16 +170,8 @@ (defmacro org-preserve-local-variables (&rest body) (when local-variables (org-with-wide-buffer (goto-char (point-max)) - ;; If last section is folded, make sure to also hide file - ;; local variables after inserting them back. - (let ((overlay - (cl-find-if (lambda (o) - (eq 'outline (overlay-get o 'invisible))) - (overlays-at (1- (point)))))) - (unless (bolp) (insert "\n")) - (insert local-variables) - (when overlay - (move-overlay overlay (overlay-start overlay) (point-max))))))))) + (unless (bolp) (insert "\n")) + (insert local-variables)))))) (defmacro org-no-popups (&rest body) "Suppress popup windows and evaluate BODY." diff --git a/lisp/org.el b/lisp/org.el index 9ebdb23e1..ca0a99681 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -6411,7 +6411,7 @@ (defun org-promote () (replace-match "# " nil t)) ((= level 1) (user-error "Cannot promote to level 0. UNDO to recover if necessary")) - (t (replace-match up-head nil t))) + (t (replace-match (apply #'propertize up-head (text-properties-at (match-beginning 0))) t))) (unless (= level 1) (when org-auto-align-tags (org-align-tags)) (when org-adapt-indentation (org-fixup-indentation (- diff)))) @@ -6426,9 +6426,10 @@ (defun org-demote () (level (save-match-data (funcall outline-level))) (down-head (concat (make-string (org-get-valid-level level 1) ?*) " ")) (diff (abs (- level (length down-head) -1)))) - (replace-match down-head nil t) - (when org-auto-align-tags (org-align-tags)) - (when org-adapt-indentation (org-fixup-indentation diff)) + (org-fold-core-ignore-fragility-checks + (replace-match (apply #'propertize down-head (text-properties-at (match-beginning 0))) t) + (when org-auto-align-tags (org-align-tags)) + (when org-adapt-indentation (org-fixup-indentation diff))) (run-hooks 'org-after-demote-entry-hook)))) (defun org-cycle-level () @@ -8956,7 +8957,15 @@ (defun org-todo (&optional arg) this org-state block-reason) (throw 'exit nil))))) (store-match-data match-data) - (replace-match next t t) + (org-fold-core-ignore-modifications + (save-excursion + (goto-char (match-beginning 0)) + (setf (buffer-substring (match-beginning 0) (match-end 0)) "") + (insert-and-inherit next) + (unless (org-invisible-p (line-beginning-position)) + (org-fold-region (line-beginning-position) + (line-end-position) + nil)))) (cond ((and org-state (equal this org-state)) (message "TODO state was already %s" (org-trim next))) ((not (pos-visible-in-window-p hl-pos)) @@ -9697,81 +9706,82 @@ (defun org--deadline-or-schedule (arg type time) "Insert DEADLINE or SCHEDULE information in current entry. TYPE is either `deadline' or `scheduled'. See `org-deadline' or `org-schedule' for information about ARG and TIME arguments." - (let* ((deadline? (eq type 'deadline)) - (keyword (if deadline? org-deadline-string org-scheduled-string)) - (log (if deadline? org-log-redeadline org-log-reschedule)) - (old-date (org-entry-get nil (if deadline? "DEADLINE" "SCHEDULED"))) - (old-date-time (and old-date (org-time-string-to-time old-date))) - ;; Save repeater cookie from either TIME or current scheduled - ;; time stamp. We are going to insert it back at the end of - ;; the process. - (repeater (or (and (org-string-nw-p time) - ;; We use `org-repeat-re' because we need - ;; to tell the difference between a real - ;; repeater and a time delta, e.g. "+2d". - (string-match org-repeat-re time) - (match-string 1 time)) - (and (org-string-nw-p old-date) - (string-match "\\([.+-]+[0-9]+[hdwmy]\ + (org-fold-core-ignore-modifications + (let* ((deadline? (eq type 'deadline)) + (keyword (if deadline? org-deadline-string org-scheduled-string)) + (log (if deadline? org-log-redeadline org-log-reschedule)) + (old-date (org-entry-get nil (if deadline? "DEADLINE" "SCHEDULED"))) + (old-date-time (and old-date (org-time-string-to-time old-date))) + ;; Save repeater cookie from either TIME or current scheduled + ;; time stamp. We are going to insert it back at the end of + ;; the process. + (repeater (or (and (org-string-nw-p time) + ;; We use `org-repeat-re' because we need + ;; to tell the difference between a real + ;; repeater and a time delta, e.g. "+2d". + (string-match org-repeat-re time) + (match-string 1 time)) + (and (org-string-nw-p old-date) + (string-match "\\([.+-]+[0-9]+[hdwmy]\ \\(?:[/ ][-+]?[0-9]+[hdwmy]\\)?\\)" - old-date) - (match-string 1 old-date))))) - (pcase arg - (`(4) - (if (not old-date) - (message (if deadline? "Entry had no deadline to remove" - "Entry was not scheduled")) - (when (and old-date log) - (org-add-log-setup (if deadline? 'deldeadline 'delschedule) - nil old-date log)) - (org-remove-timestamp-with-keyword keyword) - (message (if deadline? "Entry no longer has a deadline." - "Entry is no longer scheduled.")))) - (`(16) - (save-excursion - (org-back-to-heading t) - (let ((regexp (if deadline? org-deadline-time-regexp - org-scheduled-time-regexp))) - (if (not (re-search-forward regexp (line-end-position 2) t)) - (user-error (if deadline? "No deadline information to update" - "No scheduled information to update")) - (let* ((rpl0 (match-string 1)) - (rpl (replace-regexp-in-string " -[0-9]+[hdwmy]" "" rpl0)) - (msg (if deadline? "Warn starting from" "Delay until"))) - (replace-match - (concat keyword - " <" rpl - (format " -%dd" - (abs (- (time-to-days - (save-match-data - (org-read-date - nil t nil msg old-date-time))) - (time-to-days old-date-time)))) - ">") t t)))))) - (_ - (org-add-planning-info type time 'closed) - (when (and old-date - log - (not (equal old-date org-last-inserted-timestamp))) - (org-add-log-setup (if deadline? 'redeadline 'reschedule) - org-last-inserted-timestamp - old-date - log)) - (when repeater - (save-excursion - (org-back-to-heading t) - (when (re-search-forward - (concat keyword " " org-last-inserted-timestamp) - (line-end-position 2) - t) - (goto-char (1- (match-end 0))) - (insert " " repeater) - (setq org-last-inserted-timestamp - (concat (substring org-last-inserted-timestamp 0 -1) - " " repeater - (substring org-last-inserted-timestamp -1)))))) - (message (if deadline? "Deadline on %s" "Scheduled to %s") - org-last-inserted-timestamp))))) + old-date) + (match-string 1 old-date))))) + (pcase arg + (`(4) + (if (not old-date) + (message (if deadline? "Entry had no deadline to remove" + "Entry was not scheduled")) + (when (and old-date log) + (org-add-log-setup (if deadline? 'deldeadline 'delschedule) + nil old-date log)) + (org-remove-timestamp-with-keyword keyword) + (message (if deadline? "Entry no longer has a deadline." + "Entry is no longer scheduled.")))) + (`(16) + (save-excursion + (org-back-to-heading t) + (let ((regexp (if deadline? org-deadline-time-regexp + org-scheduled-time-regexp))) + (if (not (re-search-forward regexp (line-end-position 2) t)) + (user-error (if deadline? "No deadline information to update" + "No scheduled information to update")) + (let* ((rpl0 (match-string 1)) + (rpl (replace-regexp-in-string " -[0-9]+[hdwmy]" "" rpl0)) + (msg (if deadline? "Warn starting from" "Delay until"))) + (replace-match + (concat keyword + " <" rpl + (format " -%dd" + (abs (- (time-to-days + (save-match-data + (org-read-date + nil t nil msg old-date-time))) + (time-to-days old-date-time)))) + ">") t t)))))) + (_ + (org-add-planning-info type time 'closed) + (when (and old-date + log + (not (equal old-date org-last-inserted-timestamp))) + (org-add-log-setup (if deadline? 'redeadline 'reschedule) + org-last-inserted-timestamp + old-date + log)) + (when repeater + (save-excursion + (org-back-to-heading t) + (when (re-search-forward + (concat keyword " " org-last-inserted-timestamp) + (line-end-position 2) + t) + (goto-char (1- (match-end 0))) + (insert-and-inherit " " repeater) + (setq org-last-inserted-timestamp + (concat (substring org-last-inserted-timestamp 0 -1) + " " repeater + (substring org-last-inserted-timestamp -1)))))) + (message (if deadline? "Deadline on %s" "Scheduled to %s") + org-last-inserted-timestamp)))))) (defun org-deadline (arg &optional time) "Insert a \"DEADLINE:\" string with a timestamp to make a deadline. @@ -9876,101 +9886,102 @@ (defun org-add-planning-info (what &optional time &rest remove) the time to use. If none is given, the user is prompted for a date. REMOVE indicates what kind of entries to remove. An old WHAT entry will also be removed." - (let (org-time-was-given org-end-time-was-given default-time default-input) - (when (and (memq what '(scheduled deadline)) - (or (not time) - (and (stringp time) - (string-match "^[-+]+[0-9]" time)))) - ;; Try to get a default date/time from existing timestamp - (save-excursion - (org-back-to-heading t) - (let ((end (save-excursion (outline-next-heading) (point))) ts) - (when (re-search-forward (if (eq what 'scheduled) - org-scheduled-time-regexp - org-deadline-time-regexp) - end t) - (setq ts (match-string 1) - default-time (org-time-string-to-time ts) - default-input (and ts (org-get-compact-tod ts))))))) - (when what - (setq time - (if (stringp time) - ;; This is a string (relative or absolute), set - ;; proper date. - (apply #'encode-time - (org-read-date-analyze - time default-time (decode-time default-time))) - ;; If necessary, get the time from the user - (or time (org-read-date nil 'to-time nil - (cl-case what - (deadline "DEADLINE") - (scheduled "SCHEDULED") - (otherwise nil)) - default-time default-input))))) - (org-with-wide-buffer - (org-back-to-heading t) - (let ((planning? (save-excursion - (forward-line) - (looking-at-p org-planning-line-re)))) - (cond - (planning? - (forward-line) - ;; Move to current indentation. - (skip-chars-forward " \t") - ;; Check if we have to remove something. - (dolist (type (if what (cons what remove) remove)) - (save-excursion - (when (re-search-forward - (cl-case type - (closed org-closed-time-regexp) - (deadline org-deadline-time-regexp) - (scheduled org-scheduled-time-regexp) - (otherwise (error "Invalid planning type: %s" type))) - (line-end-position) - t) - ;; Delete until next keyword or end of line. - (delete-region - (match-beginning 0) - (if (re-search-forward org-keyword-time-not-clock-regexp - (line-end-position) - t) + (org-fold-core-ignore-modifications + (let (org-time-was-given org-end-time-was-given default-time default-input) + (when (and (memq what '(scheduled deadline)) + (or (not time) + (and (stringp time) + (string-match "^[-+]+[0-9]" time)))) + ;; Try to get a default date/time from existing timestamp + (save-excursion + (org-back-to-heading t) + (let ((end (save-excursion (outline-next-heading) (point))) ts) + (when (re-search-forward (if (eq what 'scheduled) + org-scheduled-time-regexp + org-deadline-time-regexp) + end t) + (setq ts (match-string 1) + default-time (org-time-string-to-time ts) + default-input (and ts (org-get-compact-tod ts))))))) + (when what + (setq time + (if (stringp time) + ;; This is a string (relative or absolute), set + ;; proper date. + (apply #'encode-time + (org-read-date-analyze + time default-time (decode-time default-time))) + ;; If necessary, get the time from the user + (or time (org-read-date nil 'to-time nil + (cl-case what + (deadline "DEADLINE") + (scheduled "SCHEDULED") + (otherwise nil)) + default-time default-input))))) + (org-with-wide-buffer + (org-back-to-heading t) + (let ((planning? (save-excursion + (forward-line) + (looking-at-p org-planning-line-re)))) + (cond + (planning? + (forward-line) + ;; Move to current indentation. + (skip-chars-forward " \t") + ;; Check if we have to remove something. + (dolist (type (if what (cons what remove) remove)) + (save-excursion + (when (re-search-forward + (cl-case type + (closed org-closed-time-regexp) + (deadline org-deadline-time-regexp) + (scheduled org-scheduled-time-regexp) + (otherwise (error "Invalid planning type: %s" type))) + (line-end-position) + t) + ;; Delete until next keyword or end of line. + (delete-region (match-beginning 0) - (line-end-position)))))) - ;; If there is nothing more to add and no more keyword is - ;; left, remove the line completely. - (if (and (looking-at-p "[ \t]*$") (not what)) - (delete-region (line-end-position 0) - (line-end-position)) - ;; If we removed last keyword, do not leave trailing white - ;; space at the end of line. - (let ((p (point))) - (save-excursion - (end-of-line) - (unless (= (skip-chars-backward " \t" p) 0) - (delete-region (point) (line-end-position))))))) - (what - (end-of-line) - (insert "\n") - (when org-adapt-indentation - (indent-to-column (1+ (org-outline-level))))) - (t nil))) - (when what - ;; Insert planning keyword. - (insert (cl-case what - (closed org-closed-string) - (deadline org-deadline-string) - (scheduled org-scheduled-string) - (otherwise (error "Invalid planning type: %s" what))) - " ") - ;; Insert associated timestamp. - (let ((ts (org-insert-time-stamp - time - (or org-time-was-given - (and (eq what 'closed) org-log-done-with-time)) - (eq what 'closed) - nil nil (list org-end-time-was-given)))) - (unless (eolp) (insert " ")) - ts))))) + (if (re-search-forward org-keyword-time-not-clock-regexp + (line-end-position) + t) + (match-beginning 0) + (line-end-position)))))) + ;; If there is nothing more to add and no more keyword is + ;; left, remove the line completely. + (if (and (looking-at-p "[ \t]*$") (not what)) + (delete-region (line-end-position 0) + (line-end-position)) + ;; If we removed last keyword, do not leave trailing white + ;; space at the end of line. + (let ((p (point))) + (save-excursion + (end-of-line) + (unless (= (skip-chars-backward " \t" p) 0) + (delete-region (point) (line-end-position))))))) + (what + (end-of-line) + (insert-and-inherit "\n") + (when org-adapt-indentation + (indent-to-column (1+ (org-outline-level))))) + (t nil))) + (when what + ;; Insert planning keyword. + (insert-and-inherit (cl-case what + (closed org-closed-string) + (deadline org-deadline-string) + (scheduled org-scheduled-string) + (otherwise (error "Invalid planning type: %s" what))) + " ") + ;; Insert associated timestamp. + (let ((ts (org-insert-time-stamp + time + (or org-time-was-given + (and (eq what 'closed) org-log-done-with-time)) + (eq what 'closed) + nil nil (list org-end-time-was-given)))) + (unless (eolp) (insert " ")) + ts)))))) (defvar org-log-note-marker (make-marker) "Marker pointing at the entry where the note is to be inserted.") @@ -10020,13 +10031,19 @@ (defun org-log-beginning (&optional create) (throw 'exit nil)))) ;; No drawer found. Create one, if permitted. (when create - (unless (bolp) (insert "\n")) - (let ((beg (point))) - (insert ":" drawer ":\n:END:\n") - (org-indent-region beg (point)) - (org-flag-region (line-end-position -1) - (1- (point)) t 'outline)) - (end-of-line -1))))) + ;; Avoid situation when we insert drawer right before + ;; first "*". Otherwise, if the previous heading is + ;; folded, we are inserting after visible newline at + ;; the end of the fold, thus breaking the fold + ;; continuity. + (when (org-at-heading-p) (backward-char)) + (org-fold-core-ignore-modifications + (unless (bolp) (insert-and-inherit "\n")) + (let ((beg (point))) + (insert-and-inherit ":" drawer ":\n:END:\n") + (org-indent-region beg (point)) + (org-fold-region (line-end-position -1) (1- (point)) t (if (eq org-fold-core-style 'text-properties) 'drawer 'outline))))) + (end-of-line -1)))) (t (org-end-of-meta-data org-log-state-notes-insert-after-drawers) (skip-chars-forward " \t\n") @@ -10034,7 +10051,7 @@ (defun org-log-beginning (&optional create) (unless org-log-states-order-reversed (org-skip-over-state-notes) (skip-chars-backward " \t\n") - (forward-line))))) + (beginning-of-line 2))))) (if (bolp) (point) (line-beginning-position 2)))) (defun org-add-log-setup (&optional purpose state prev-state how extra) @@ -10160,34 +10177,35 @@ (defun org-store-log-note () (push note lines)) (when (and lines (not org-note-abort)) (with-current-buffer (marker-buffer org-log-note-marker) - (org-with-wide-buffer - ;; Find location for the new note. - (goto-char org-log-note-marker) - (set-marker org-log-note-marker nil) - ;; Note associated to a clock is to be located right after - ;; the clock. Do not move point. - (unless (eq org-log-note-purpose 'clock-out) - (goto-char (org-log-beginning t))) - ;; Make sure point is at the beginning of an empty line. - (cond ((not (bolp)) (let ((inhibit-read-only t)) (insert "\n"))) - ((looking-at "[ \t]*\\S-") (save-excursion (insert "\n")))) - ;; In an existing list, add a new item at the top level. - ;; Otherwise, indent line like a regular one. - (let ((itemp (org-in-item-p))) - (if itemp - (indent-line-to - (let ((struct (save-excursion - (goto-char itemp) (org-list-struct)))) - (org-list-get-ind (org-list-get-top-point struct) struct))) - (org-indent-line))) - (insert (org-list-bullet-string "-") (pop lines)) - (let ((ind (org-list-item-body-column (line-beginning-position)))) - (dolist (line lines) - (insert "\n") - (indent-line-to ind) - (insert line))) - (message "Note stored") - (org-back-to-heading t))))) + (org-fold-core-ignore-modifications + (org-with-wide-buffer + ;; Find location for the new note. + (goto-char org-log-note-marker) + (set-marker org-log-note-marker nil) + ;; Note associated to a clock is to be located right after + ;; the clock. Do not move point. + (unless (eq org-log-note-purpose 'clock-out) + (goto-char (org-log-beginning t))) + ;; Make sure point is at the beginning of an empty line. + (cond ((not (bolp)) (let ((inhibit-read-only t)) (insert-and-inherit "\n"))) + ((looking-at "[ \t]*\\S-") (save-excursion (insert-and-inherit "\n")))) + ;; In an existing list, add a new item at the top level. + ;; Otherwise, indent line like a regular one. + (let ((itemp (org-in-item-p))) + (if itemp + (indent-line-to + (let ((struct (save-excursion + (goto-char itemp) (org-list-struct)))) + (org-list-get-ind (org-list-get-top-point struct) struct))) + (org-indent-line))) + (insert-and-inherit (org-list-bullet-string "-") (pop lines)) + (let ((ind (org-list-item-body-column (line-beginning-position)))) + (dolist (line lines) + (insert-and-inherit "\n") + (indent-line-to ind) + (insert-and-inherit line))) + (message "Note stored") + (org-back-to-heading t)))))) ;; Don't add undo information when called from `org-agenda-todo'. (set-window-configuration org-log-note-window-configuration) (with-current-buffer (marker-buffer org-log-note-return-to) @@ -11318,34 +11336,35 @@ (defun org-set-tags (tags) This function assumes point is on a headline." (org-with-wide-buffer - (let ((tags (pcase tags - ((pred listp) tags) - ((pred stringp) (split-string (org-trim tags) ":" t)) - (_ (error "Invalid tag specification: %S" tags)))) - (old-tags (org-get-tags nil t)) - (tags-change? nil)) - (when (functionp org-tags-sort-function) - (setq tags (sort tags org-tags-sort-function))) - (setq tags-change? (not (equal tags old-tags))) - (when tags-change? - ;; Delete previous tags and any trailing white space. - (goto-char (if (org-match-line org-tag-line-re) (match-beginning 1) - (line-end-position))) - (skip-chars-backward " \t") - (delete-region (point) (line-end-position)) - ;; Deleting white spaces may break an otherwise empty headline. - ;; Re-introduce one space in this case. - (unless (org-at-heading-p) (insert " ")) - (when tags - (save-excursion (insert " " (org-make-tag-string tags))) - ;; When text is being inserted on an invisible region - ;; boundary, it can be inadvertently sucked into - ;; invisibility. - (unless (org-invisible-p (line-beginning-position)) - (org-flag-region (point) (line-end-position) nil 'outline)))) - ;; Align tags, if any. - (when tags (org-align-tags)) - (when tags-change? (run-hooks 'org-after-tags-change-hook))))) + (org-fold-core-ignore-modifications + (let ((tags (pcase tags + ((pred listp) tags) + ((pred stringp) (split-string (org-trim tags) ":" t)) + (_ (error "Invalid tag specification: %S" tags)))) + (old-tags (org-get-tags nil t)) + (tags-change? nil)) + (when (functionp org-tags-sort-function) + (setq tags (sort tags org-tags-sort-function))) + (setq tags-change? (not (equal tags old-tags))) + (when tags-change? + ;; Delete previous tags and any trailing white space. + (goto-char (if (org-match-line org-tag-line-re) (match-beginning 1) + (line-end-position))) + (skip-chars-backward " \t") + (delete-region (point) (line-end-position)) + ;; Deleting white spaces may break an otherwise empty headline. + ;; Re-introduce one space in this case. + (unless (org-at-heading-p) (insert " ")) + (when tags + (save-excursion (insert-and-inherit " " (org-make-tag-string tags))) + ;; When text is being inserted on an invisible region + ;; boundary, it can be inadvertently sucked into + ;; invisibility. + (unless (org-invisible-p (line-beginning-position)) + (org-fold-region (point) (line-end-position) nil 'outline)))) + ;; Align tags, if any. + (when tags (org-align-tags)) + (when tags-change? (run-hooks 'org-after-tags-change-hook)))))) (defun org-change-tag-in-region (beg end tag off) "Add or remove TAG for each entry in the region. @@ -12539,19 +12558,20 @@ (defun org-entry-put (pom property value) ((member property org-special-properties) (error "The %s property cannot be set with `org-entry-put'" property)) (t - (let* ((range (org-get-property-block beg 'force)) - (end (cdr range)) - (case-fold-search t)) - (goto-char (car range)) - (if (re-search-forward (org-re-property property nil t) end t) - (progn (delete-region (match-beginning 0) (match-end 0)) - (goto-char (match-beginning 0))) - (goto-char end) - (insert "\n") - (backward-char)) - (insert ":" property ":") - (when value (insert " " value)) - (org-indent-line))))) + (org-fold-core-ignore-modifications + (let* ((range (org-get-property-block beg 'force)) + (end (cdr range)) + (case-fold-search t)) + (goto-char (car range)) + (if (re-search-forward (org-re-property property nil t) end t) + (progn (delete-region (match-beginning 0) (match-end 0)) + (goto-char (match-beginning 0))) + (goto-char end) + (insert-and-inherit "\n") + (backward-char)) + (insert-and-inherit ":" property ":") + (when value (insert-and-inherit " " value)) + (org-indent-line)))))) (run-hook-with-args 'org-property-changed-functions property value)))) (defun org-buffer-property-keys (&optional specials defaults columns) @@ -13705,23 +13725,24 @@ (defun org-insert-time-stamp (time &optional with-hm inactive pre post extra) PRE and POST are optional strings to be inserted before and after the stamp. The command returns the inserted time stamp." - (let ((fmt (funcall (if with-hm 'cdr 'car) org-time-stamp-formats)) - stamp) - (when inactive (setq fmt (concat "[" (substring fmt 1 -1) "]"))) - (insert-before-markers (or pre "")) - (when (listp extra) - (setq extra (car extra)) - (if (and (stringp extra) - (string-match "\\([0-9]+\\):\\([0-9]+\\)" extra)) - (setq extra (format "-%02d:%02d" - (string-to-number (match-string 1 extra)) - (string-to-number (match-string 2 extra)))) - (setq extra nil))) - (when extra - (setq fmt (concat (substring fmt 0 -1) extra (substring fmt -1)))) - (insert-before-markers (setq stamp (format-time-string fmt time))) - (insert-before-markers (or post "")) - (setq org-last-inserted-timestamp stamp))) + (org-fold-core-ignore-modifications + (let ((fmt (funcall (if with-hm 'cdr 'car) org-time-stamp-formats)) + stamp) + (when inactive (setq fmt (concat "[" (substring fmt 1 -1) "]"))) + (insert-before-markers-and-inherit (or pre "")) + (when (listp extra) + (setq extra (car extra)) + (if (and (stringp extra) + (string-match "\\([0-9]+\\):\\([0-9]+\\)" extra)) + (setq extra (format "-%02d:%02d" + (string-to-number (match-string 1 extra)) + (string-to-number (match-string 2 extra)))) + (setq extra nil))) + (when extra + (setq fmt (concat (substring fmt 0 -1) extra (substring fmt -1)))) + (insert-before-markers-and-inherit (setq stamp (format-time-string fmt time))) + (insert-before-markers-and-inherit (or post "")) + (setq org-last-inserted-timestamp stamp)))) (defun org-toggle-time-stamp-overlays () "Toggle the use of custom time stamp formats." @@ -18345,7 +18366,10 @@ (defun org--align-node-property () (let ((newtext (concat (match-string 4) (org-trim (format org-property-format (match-string 1) (match-string 3)))))) - (setf (buffer-substring (match-beginning 0) (match-end 0)) newtext))))) + ;; Do not use `replace-match' here as we want to inherit folding + ;; properties if inside fold. + (setf (buffer-substring (match-beginning 0) (match-end 0)) "") + (insert-and-inherit newtext))))) (defun org-indent-line () "Indent line depending on context. diff --git a/lisp/ox.el b/lisp/ox.el index 6b68fc2da..9a8e63046 100644 --- a/lisp/ox.el +++ b/lisp/ox.el @@ -2588,7 +2588,9 @@ (defun org-export--generate-copy-script (buffer) (or (memq var '(default-directory buffer-file-name - buffer-file-coding-system)) + buffer-file-coding-system + ;; Needed to preserve folding state + char-property-alias-alist)) (assq var bound-variables) (string-match "^\\(org-\\|orgtbl-\\)" (symbol-name var))) diff --git a/testing/lisp/test-ob.el b/testing/lisp/test-ob.el index 579d4df02..aa05f87a3 100644 --- a/testing/lisp/test-ob.el +++ b/testing/lisp/test-ob.el @@ -1557,8 +1557,8 @@ (ert-deftest test-ob/preserve-results-indentation () (org-test-with-temp-text " #+begin_src emacs-lisp\n(+ 1 1)\n #+end_src" (org-babel-execute-src-block) (let ((case-fold-search t)) (search-forward "RESULTS")) - (list (org-get-indentation) - (progn (forward-line) (org-get-indentation)))))) + (list (current-indentation) + (progn (forward-line) (current-indentation)))))) (should (equal '(2 2) @@ -1566,8 +1566,8 @@ (ert-deftest test-ob/preserve-results-indentation () " #+name: block\n #+begin_src emacs-lisp\n(+ 1 1)\n #+end_src" (org-babel-execute-src-block) (let ((case-fold-search t)) (search-forward "RESULTS")) - (list (org-get-indentation) - (progn (forward-line) (org-get-indentation)))))) + (list (current-indentation) + (progn (forward-line) (current-indentation)))))) ;; Don't get fooled by TAB-based indentation. (should (equal @@ -1577,8 +1577,8 @@ (ert-deftest test-ob/preserve-results-indentation () (setq tab-width 4) (org-babel-execute-src-block) (let ((case-fold-search t)) (search-forward "RESULTS")) - (list (org-get-indentation) - (progn (forward-line) (org-get-indentation)))))) + (list (current-indentation) + (progn (forward-line) (current-indentation)))))) ;; Properly indent examplified blocks. (should (equal diff --git a/testing/lisp/test-org.el b/testing/lisp/test-org.el index 0a47618ca..0cc8df154 100644 --- a/testing/lisp/test-org.el +++ b/testing/lisp/test-org.el @@ -1522,6 +1522,7 @@ (ert-deftest test-org/meta-return () (should (org-test-with-temp-text ":MYDRAWER:\n- a\n:END:" (forward-line) + (org-fold-reveal) (org-meta-return) (beginning-of-line) (looking-at "- $")))) @@ -2943,6 +2944,7 @@ (ert-deftest test-org/custom-properties () (let ((org-custom-properties '("FOO" "BAR"))) (org-test-with-temp-text "* H\n:PROPERTIES:\n<point>:FOO: val\n:P: 1\n:BAR: baz\n:END:\n" + (org-fold-reveal) (org-toggle-custom-properties-visibility) (and (org-invisible-p2) (not (progn (forward-line) (org-invisible-p2))) @@ -2963,6 +2965,7 @@ (ert-deftest test-org/custom-properties () (let ((org-custom-properties '("A"))) (org-test-with-temp-text "* H\n:PROPERTIES:\n:A: 1\n:END:\n\n:PROPERTIES:\n<point>:A: 2\n:END:" + (org-fold-reveal) (org-toggle-custom-properties-visibility) (org-invisible-p2))))) -- 2.35.1 -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH v2 14/38] Support extra org-fold optimisations for huge buffers 2022-04-20 13:23 ` [PATCH v2 00/38] Final call for comments: " Ihor Radchenko ` (12 preceding siblings ...) 2022-04-20 13:25 ` [PATCH v2 13/38] Fix subtle differences between overlays and invisible text properties Ihor Radchenko @ 2022-04-20 13:25 ` Ihor Radchenko 2022-04-20 13:25 ` [PATCH v2 15/38] Alias new org-fold functions to their old shorter names Ihor Radchenko ` (27 subsequent siblings) 41 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-04-20 13:25 UTC (permalink / raw) To: emacs-orgmode --- lisp/org.el | 26 ++++++++++++++++++-------- 1 file changed, 18 insertions(+), 8 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index ca0a99681..f5936b67c 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -5788,6 +5788,7 @@ (defun org-unfontify-region (beg end &optional _maybe_loudly) '(mouse-face t keymap t org-linked-text t invisible t intangible t org-emphasis t)) + (org-fold-core-update-optimisation beg end) (org-remove-font-lock-display-properties beg end))) (defconst org-script-display '(((raise -0.3) (height 0.7)) @@ -6158,7 +6159,11 @@ (defun org-get-heading (&optional no-tags no-todo no-priority no-comment) (org-back-to-heading t) (let ((case-fold-search nil)) (looking-at org-complex-heading-regexp) - (let ((todo (and (not no-todo) (match-string 2))) + ;; When using `org-fold-core--optimise-for-huge-buffers', + ;; returned text may be invisible. Clear it up. + (save-match-data + (org-fold-core-remove-optimisation (match-beginning 0) (match-end 0))) + (let ((todo (and (not no-todo) (match-string 2))) (priority (and (not no-priority) (match-string 3))) (headline (pcase (match-string 4) (`nil "") @@ -6169,6 +6174,8 @@ (defun org-get-heading (&optional no-tags no-todo no-priority no-comment) "" h)) (h h))) (tags (and (not no-tags) (match-string 5)))) + ;; Restore cleared optimisation. + (org-fold-core-update-optimisation (match-beginning 0) (match-end 0)) (mapconcat #'identity (delq nil (list todo priority headline tags)) " ")))))) @@ -6185,18 +6192,21 @@ (defun org-heading-components () (save-excursion (org-back-to-heading t) (when (let (case-fold-search) (looking-at org-complex-heading-regexp)) - (list (length (match-string 1)) - (org-reduced-level (length (match-string 1))) - (match-string-no-properties 2) - (and (match-end 3) (aref (match-string 3) 2)) - (match-string-no-properties 4) - (match-string-no-properties 5))))) + (org-fold-core-remove-optimisation (match-beginning 0) (match-end 0)) + (prog1 + (list (length (match-string 1)) + (org-reduced-level (length (match-string 1))) + (match-string-no-properties 2) + (and (match-end 3) (aref (match-string 3) 2)) + (match-string-no-properties 4) + (match-string-no-properties 5)) + (org-fold-core-update-optimisation (match-beginning 0) (match-end 0)))))) (defun org-get-entry () "Get the entry text, after heading, entire subtree." (save-excursion (org-back-to-heading t) - (buffer-substring (point-at-bol 2) (org-end-of-subtree t)))) + (filter-buffer-substring (point-at-bol 2) (org-end-of-subtree t)))) (defun org-edit-headline (&optional heading) "Edit the current headline. -- 2.35.1 -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH v2 15/38] Alias new org-fold functions to their old shorter names 2022-04-20 13:23 ` [PATCH v2 00/38] Final call for comments: " Ihor Radchenko ` (13 preceding siblings ...) 2022-04-20 13:25 ` [PATCH v2 14/38] Support extra org-fold optimisations for huge buffers Ihor Radchenko @ 2022-04-20 13:25 ` Ihor Radchenko 2022-04-20 13:25 ` [PATCH v2 16/38] Obsolete old function names that are now in org-fold--- Ihor Radchenko ` (26 subsequent siblings) 41 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-04-20 13:25 UTC (permalink / raw) To: emacs-orgmode --- lisp/org.el | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/lisp/org.el b/lisp/org.el index f5936b67c..2608865da 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -99,6 +99,14 @@ (require 'org-table) (require 'org-fold) (require 'org-cycle) +(defvaralias 'org-hide-block-startup 'org-cycle-hide-block-startup) +(defvaralias 'org-pre-cycle-hook 'org-cycle-pre-hook) +(defvaralias 'org-tab-first-hook 'org-cycle-tab-first-hook) +(defalias 'org-global-cycle #'org-cycle-global) +(defalias 'org-overview #'org-cycle-overview) +(defalias 'org-content #'org-cycle-content) +(defalias 'org-reveal #'org-fold-reveal) +(defalias 'org-force-cycle-archived #'org-cycle-force-archived) ;; `org-outline-regexp' ought to be a defconst but is let-bound in ;; some places -- e.g. see the macro `org-with-limited-levels'. -- 2.35.1 -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH v2 16/38] Obsolete old function names that are now in org-fold--- 2022-04-20 13:23 ` [PATCH v2 00/38] Final call for comments: " Ihor Radchenko ` (14 preceding siblings ...) 2022-04-20 13:25 ` [PATCH v2 15/38] Alias new org-fold functions to their old shorter names Ihor Radchenko @ 2022-04-20 13:25 ` Ihor Radchenko 2022-04-20 13:26 ` [PATCH v2 17/38] org-compat: Work around some third-party packages using outline-* functions Ihor Radchenko ` (25 subsequent siblings) 41 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-04-20 13:25 UTC (permalink / raw) To: emacs-orgmode --- lisp/org-compat.el | 88 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 88 insertions(+) diff --git a/lisp/org-compat.el b/lisp/org-compat.el index ed2ae62f4..3e8f49f0a 100644 --- a/lisp/org-compat.el +++ b/lisp/org-compat.el @@ -267,6 +267,11 @@ (define-obsolete-function-alias 'org-propertize 'propertize "9.0") (define-obsolete-function-alias 'org-select-frame-set-input-focus 'select-frame-set-input-focus "9.0") (define-obsolete-function-alias 'org-file-remote-p 'file-remote-p "9.2") +(define-obsolete-function-alias 'org-show-context 'org-fold-show-context "9.6") +(define-obsolete-function-alias 'org-show-entry 'org-fold-show-entry "9.6") +(define-obsolete-function-alias 'org-show-children 'org-fold-show-children "9.6") + + (defmacro org-re (s) "Replace posix classes in regular expression S." (declare (debug (form)) @@ -376,6 +381,80 @@ (define-obsolete-function-alias 'org-toggle-latex-fragment 'org-latex-preview (define-obsolete-function-alias 'org-remove-latex-fragment-image-overlays 'org-clear-latex-preview "9.3") +(define-obsolete-function-alias 'org-hide-archived-subtrees + 'org-fold-hide-archived-subtrees "9.6") + +(define-obsolete-function-alias 'org-flag-region + 'org-fold-region "9.6") + +(define-obsolete-function-alias 'org-flag-subtree + 'org-fold-subtree "9.6") + +(define-obsolete-function-alias 'org-hide-entry + 'org-fold-hide-entry "9.6") + +(define-obsolete-function-alias 'org-show-subtree + 'org-fold-show-subtree "9.6") + +(define-obsolete-function-alias 'org--hide-wrapper-toggle + 'org-fold--hide-wrapper-toggle "9.6") + +(define-obsolete-function-alias 'org-hide-block-toggle + 'org-fold-hide-block-toggle "9.6") + +(define-obsolete-function-alias 'org-hide-drawer-toggle + 'org-fold-hide-drawer-toggle "9.6") + +(define-obsolete-function-alias 'org--hide-drawers + 'org-fold--hide-drawers "9.6") + +(define-obsolete-function-alias 'org-hide-block-all + 'org-fold-hide-block-all "9.6") + +(define-obsolete-function-alias 'org-hide-drawer-all + 'org-fold-hide-drawer-all "9.6") + +(define-obsolete-function-alias 'org-show-all + 'org-fold-show-all "9.6") + +(define-obsolete-function-alias 'org-set-startup-visibility + 'org-cycle-set-startup-visibility "9.6") + +(define-obsolete-function-alias 'org-show-set-visibility + 'org-fold-show-set-visibility "9.6") + +(define-obsolete-function-alias 'org-check-before-invisible-edit + 'org-fold-check-before-invisible-edit "9.6") + +(define-obsolete-function-alias 'org-flag-above-first-heading + 'org-fold-flag-above-first-heading "9.6") + +(define-obsolete-function-alias 'org-show-branches-buffer + 'org-fold-show-branches-buffer "9.6") + +(define-obsolete-function-alias 'org-show-siblings + 'org-fold-show-siblings "9.6") + +(define-obsolete-function-alias 'org-show-hidden-entry + 'org-fold-show-hidden-entry "9.6") + +(define-obsolete-function-alias 'org-flag-heading + 'org-fold-heading "9.6") + +(define-obsolete-function-alias 'org-set-startup-visibility + 'org-cycle-set-startup-visibility "9.6") + +(define-obsolete-function-alias 'org-set-visibility-according-to-property + 'org-cycle-set-visibility-according-to-property "9.6") + +(define-obsolete-variable-alias 'org-scroll-position-to-restore + 'org-cycle-scroll-position-to-restore "9.6") +(define-obsolete-function-alias 'org-optimize-window-after-visibility-change + 'org-cycle-optimize-window-after-visibility-change "9.6") + +(define-obsolete-function-alias 'org-force-cycle-archived + 'org-cycle-force-archived "9.6") + (define-obsolete-variable-alias 'org-attach-directory 'org-attach-id-dir "9.3") (make-obsolete 'org-attach-store-link "No longer used" "9.4") @@ -383,6 +462,15 @@ (make-obsolete 'org-attach-expand-link "No longer used" "9.4") (define-obsolete-function-alias 'org-file-url-p 'org-url-p "9.5") +(define-obsolete-variable-alias 'org-show-context-detail + 'org-fold-show-context-detail "9.6") + +(define-obsolete-variable-alias 'org-catch-invisible-edits + 'org-fold-catch-invisible-edits "9.6") + +(define-obsolete-variable-alias 'org-reveal-start-hook + 'org-fold-reveal-start-hook "9.6") +(define-obsolete-function-alias 'org-file-url-p 'org-url-p "9.6") (defun org-in-fixed-width-region-p () "Non-nil if point in a fixed-width region." (save-match-data -- 2.35.1 -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH v2 17/38] org-compat: Work around some third-party packages using outline-* functions 2022-04-20 13:23 ` [PATCH v2 00/38] Final call for comments: " Ihor Radchenko ` (15 preceding siblings ...) 2022-04-20 13:25 ` [PATCH v2 16/38] Obsolete old function names that are now in org-fold--- Ihor Radchenko @ 2022-04-20 13:26 ` Ihor Radchenko 2022-04-20 13:26 ` [PATCH v2 18/38] Move `org-buffer-list' to org-macs.el--- Ihor Radchenko ` (24 subsequent siblings) 41 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-04-20 13:26 UTC (permalink / raw) To: emacs-orgmode --- lisp/org-compat.el | 72 +++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 71 insertions(+), 1 deletion(-) diff --git a/lisp/org-compat.el b/lisp/org-compat.el index 3e8f49f0a..f599e246e 100644 --- a/lisp/org-compat.el +++ b/lisp/org-compat.el @@ -1330,11 +1330,81 @@ (defvar session-globals-exclude) (eval-after-load 'session '(add-to-list 'session-globals-exclude 'org-mark-ring)) +;;;; outline-mode + +;; Folding in outline-mode is not compatible with org-mode folding +;; anymore. Working around to avoid breakage of external packages +;; assuming the compatibility. +(defadvice outline-flag-region (around outline-flag-region@fix-for-org-fold (from to flag) activate) + "Run `org-fold-region' when in org-mode." + (if (eq major-mode 'org-mode) + (setq ad-return-value (org-fold-region (max from (point-min)) (min to (point-max)) flag 'headline)) + ad-do-it)) + +(defadvice outline-next-visible-heading (around outline-next-visible-heading@fix-for-org-fold (arg) activate) + "Run `org-next-visible-heading' when in org-mode." + (interactive "p") + (if (eq major-mode 'org-mode) + (setq ad-return-value (org-next-visible-heading arg)) + ad-do-it)) + +(defadvice outline-back-to-heading (around outline-back-to-heading@fix-for-org-fold (&optional invisible-ok) activate) + "Run `org-back-to-heading' when in org-mode." + (if (eq major-mode 'org-mode) + (setq ad-return-value + (progn + (beginning-of-line) + (or (org-at-heading-p (not invisible-ok)) + (let (found) + (save-excursion + (while (not found) + (or (re-search-backward (concat "^\\(?:" outline-regexp "\\)") + nil t) + (signal 'outline-before-first-heading nil)) + (setq found (and (or invisible-ok (not (org-fold-folded-p))) + (point))))) + (goto-char found) + found)))) + ad-do-it)) + +(defadvice outline-on-heading-p (around outline-on-heading-p@fix-for-org-fold (&optional invisible-ok) activate) + "Run `org-at-heading-p' when in org-mode." + (if (eq major-mode 'org-mode) + (setq ad-return-value (org-at-heading-p (not invisible-ok))) + ad-do-it)) + +(defadvice outline-hide-sublevels (around outline-hide-sublevels@fix-for-org-fold (levels) activate) + "Run `org-fold-hide-sublevels' when in org-mode." + (interactive (list + (cond + (current-prefix-arg (prefix-numeric-value current-prefix-arg)) + ((save-excursion (beginning-of-line) + (looking-at outline-regexp)) + (funcall outline-level)) + (t 1)))) + (if (eq major-mode 'org-mode) + (setq ad-return-value (org-fold-hide-sublevels levels)) + ad-do-it)) + +(defadvice outline-toggle-children (around outline-toggle-children@fix-for-org-fold () activate) + "Run `org-fold-hide-sublevels' when in org-mode." + (interactive) + (if (eq major-mode 'org-mode) + (setq ad-return-value + (save-excursion + (org-back-to-heading) + (if (not (org-fold-folded-p (line-end-position))) + (org-fold-hide-subtree) + (org-fold-show-children) + (org-fold-show-entry)))) + ad-do-it)) + +;; TODO: outline-headers-as-kill + ;;;; Speed commands (make-obsolete-variable 'org-speed-commands-user "configure `org-speed-commands' instead." "9.5") - (provide 'org-compat) ;; Local variables: -- 2.35.1 -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH v2 18/38] Move `org-buffer-list' to org-macs.el--- 2022-04-20 13:23 ` [PATCH v2 00/38] Final call for comments: " Ihor Radchenko ` (16 preceding siblings ...) 2022-04-20 13:26 ` [PATCH v2 17/38] org-compat: Work around some third-party packages using outline-* functions Ihor Radchenko @ 2022-04-20 13:26 ` Ihor Radchenko 2022-04-20 13:26 ` [PATCH v2 19/38] Restore old visibility behaviour of org-refile--- Ihor Radchenko ` (23 subsequent siblings) 41 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-04-20 13:26 UTC (permalink / raw) To: emacs-orgmode --- lisp/org-macs.el | 38 ++++++++++++++++++++++++++++++++++++++ lisp/org.el | 38 -------------------------------------- 2 files changed, 38 insertions(+), 38 deletions(-) diff --git a/lisp/org-macs.el b/lisp/org-macs.el index 42a91781b..188168cdc 100644 --- a/lisp/org-macs.el +++ b/lisp/org-macs.el @@ -223,6 +223,44 @@ (defun org-fit-window-to-buffer (&optional window max-height min-height (shrink-window-if-larger-than-buffer window))) (or window (selected-window))) +(defun org-buffer-list (&optional predicate exclude-tmp) + "Return a list of Org buffers. +PREDICATE can be `export', `files' or `agenda'. + +export restrict the list to Export buffers. +files restrict the list to buffers visiting Org files. +agenda restrict the list to buffers visiting agenda files. + +If EXCLUDE-TMP is non-nil, ignore temporary buffers." + (let* ((bfn nil) + (agenda-files (and (eq predicate 'agenda) + (mapcar 'file-truename (org-agenda-files t)))) + (filter + (cond + ((eq predicate 'files) + (lambda (b) (with-current-buffer b (derived-mode-p 'org-mode)))) + ((eq predicate 'export) + (lambda (b) (string-match "\\*Org .*Export" (buffer-name b)))) + ((eq predicate 'agenda) + (lambda (b) + (with-current-buffer b + (and (derived-mode-p 'org-mode) + (setq bfn (buffer-file-name b)) + (member (file-truename bfn) agenda-files))))) + (t (lambda (b) (with-current-buffer b + (or (derived-mode-p 'org-mode) + (string-match "\\*Org .*Export" + (buffer-name b))))))))) + (delq nil + (mapcar + (lambda(b) + (if (and (funcall filter b) + (or (not exclude-tmp) + (not (string-match "tmp" (buffer-name b))))) + b + nil)) + (buffer-list))))) + \f ;;; File diff --git a/lisp/org.el b/lisp/org.el index 2608865da..402ce3520 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -14748,44 +14748,6 @@ (defun org-switchb (&optional arg) (mapcar #'list (mapcar #'buffer-name blist)) nil t)))) -(defun org-buffer-list (&optional predicate exclude-tmp) - "Return a list of Org buffers. -PREDICATE can be `export', `files' or `agenda'. - -export restrict the list to Export buffers. -files restrict the list to buffers visiting Org files. -agenda restrict the list to buffers visiting agenda files. - -If EXCLUDE-TMP is non-nil, ignore temporary buffers." - (let* ((bfn nil) - (agenda-files (and (eq predicate 'agenda) - (mapcar 'file-truename (org-agenda-files t)))) - (filter - (cond - ((eq predicate 'files) - (lambda (b) (with-current-buffer b (derived-mode-p 'org-mode)))) - ((eq predicate 'export) - (lambda (b) (string-match "\\*Org .*Export" (buffer-name b)))) - ((eq predicate 'agenda) - (lambda (b) - (with-current-buffer b - (and (derived-mode-p 'org-mode) - (setq bfn (buffer-file-name b)) - (member (file-truename bfn) agenda-files))))) - (t (lambda (b) (with-current-buffer b - (or (derived-mode-p 'org-mode) - (string-match "\\*Org .*Export" - (buffer-name b))))))))) - (delq nil - (mapcar - (lambda(b) - (if (and (funcall filter b) - (or (not exclude-tmp) - (not (string-match "tmp" (buffer-name b))))) - b - nil)) - (buffer-list))))) - (defun org-agenda-files (&optional unrestricted archives) "Get the list of agenda files. Optional UNRESTRICTED means return the full list even if a restriction -- 2.35.1 -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH v2 19/38] Restore old visibility behaviour of org-refile--- 2022-04-20 13:23 ` [PATCH v2 00/38] Final call for comments: " Ihor Radchenko ` (17 preceding siblings ...) 2022-04-20 13:26 ` [PATCH v2 18/38] Move `org-buffer-list' to org-macs.el--- Ihor Radchenko @ 2022-04-20 13:26 ` Ihor Radchenko 2022-04-20 13:26 ` [PATCH v2 20/38] Add org-fold-related tests--- Ihor Radchenko ` (22 subsequent siblings) 41 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-04-20 13:26 UTC (permalink / raw) To: emacs-orgmode --- lisp/org-refile.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/org-refile.el b/lisp/org-refile.el index 6f2b019ad..e87c3e9a9 100644 --- a/lisp/org-refile.el +++ b/lisp/org-refile.el @@ -547,6 +547,7 @@ (defun org-refile (&optional arg default-buffer rfloc msg) (goto-char (point-min)) (or (outline-next-heading) (goto-char (point-max))))) (unless (bolp) (newline)) + (org-fold-reveal) (org-paste-subtree level nil nil t) ;; Record information, according to `org-log-refile'. ;; Do not prompt for a note when refiling multiple -- 2.35.1 -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH v2 20/38] Add org-fold-related tests--- 2022-04-20 13:23 ` [PATCH v2 00/38] Final call for comments: " Ihor Radchenko ` (18 preceding siblings ...) 2022-04-20 13:26 ` [PATCH v2 19/38] Restore old visibility behaviour of org-refile--- Ihor Radchenko @ 2022-04-20 13:26 ` Ihor Radchenko 2022-04-20 13:26 ` [PATCH v2 21/38] org-manual: Update to new org-fold function names--- Ihor Radchenko ` (21 subsequent siblings) 41 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-04-20 13:26 UTC (permalink / raw) To: emacs-orgmode --- testing/lisp/test-ol.el | 24 +++++ testing/lisp/test-org-list.el | 73 ++++++++++---- testing/lisp/test-org.el | 177 +++++++++++++++++++++++++++++++--- 3 files changed, 238 insertions(+), 36 deletions(-) diff --git a/testing/lisp/test-ol.el b/testing/lisp/test-ol.el index ddcc570b3..343631623 100644 --- a/testing/lisp/test-ol.el +++ b/testing/lisp/test-ol.el @@ -50,6 +50,30 @@ (ert-deftest test-ol/encode-url-with-escaped-char () (org-link-encode "http://some.host.com/form?&id=blah%2Bblah25" '(?\s ?\[ ?\] ?%)))))) +(ert-deftest test-ol/org-toggle-link-display () + "Make sure that `org-toggle-link-display' is working. +See https://github.com/yantar92/org/issues/4." + (dolist (org-link-descriptive '(nil t)) + (org-test-with-temp-text "* Org link test +[[https://example.com][A link to a site]]" + (dotimes (_ 2) + (goto-char 1) + (re-search-forward "\\[") + (should-not (xor org-link-descriptive (org-invisible-p))) + (re-search-forward "example") + (should-not (xor org-link-descriptive (org-invisible-p))) + (re-search-forward "com") + (should-not (xor org-link-descriptive (org-invisible-p))) + (re-search-forward "]") + (should-not (xor org-link-descriptive (org-invisible-p))) + (re-search-forward "\\[") + (should-not (org-invisible-p)) + (re-search-forward "link") + (should-not (org-invisible-p)) + (re-search-forward "]") + (should-not (xor org-link-descriptive (org-invisible-p))) + (org-toggle-link-display))))) + \f ;;; Escape and Unescape Links diff --git a/testing/lisp/test-org-list.el b/testing/lisp/test-org-list.el index a9490692e..bc8faa672 100644 --- a/testing/lisp/test-org-list.el +++ b/testing/lisp/test-org-list.el @@ -580,22 +580,40 @@ (ert-deftest test-org-list/move-item-down () (let ((org-list-use-circular-motion t)) (org-move-item-down)) (buffer-string)))) ;; Preserve item visibility. + (should + (equal + (make-list 2 'org-fold-outline) + (let ((org-fold-core-style 'text-properties)) + (org-test-with-temp-text + "* Headline\n<point>- item 1\n body 1\n- item 2\n body 2" + (let ((org-cycle-include-plain-lists t)) + (org-cycle) + (search-forward "- item 2") + (org-cycle)) + (search-backward "- item 1") + (org-move-item-down) + (forward-line) + (list (org-fold-get-folding-spec) + (progn + (search-backward " body 2") + (org-fold-get-folding-spec))))))) (should (equal '(outline outline) - (org-test-with-temp-text - "* Headline\n<point>- item 1\n body 1\n- item 2\n body 2" - (let ((org-cycle-include-plain-lists t)) - (org-cycle) - (search-forward "- item 2") - (org-cycle)) - (search-backward "- item 1") - (org-move-item-down) - (forward-line) - (list (org-invisible-p2) - (progn - (search-backward " body 2") - (org-invisible-p2)))))) + (let ((org-fold-core-style 'overlays)) + (org-test-with-temp-text + "* Headline\n<point>- item 1\n body 1\n- item 2\n body 2" + (let ((org-cycle-include-plain-lists t)) + (org-cycle) + (search-forward "- item 2") + (org-cycle)) + (search-backward "- item 1") + (org-move-item-down) + (forward-line) + (list (org-invisible-p2) + (progn + (search-backward " body 2") + (org-invisible-p2))))))) ;; Preserve children visibility. (org-test-with-temp-text "* Headline - item 1 @@ -869,17 +887,30 @@ (ert-deftest test-org-list/insert-item () (org-insert-item) (buffer-string)))) ;; Preserve list visibility when inserting an item. + (should + (equal + `(org-fold-outline org-fold-outline) + (let ((org-fold-core-style 'text-properties)) + (org-test-with-temp-text "- A\n - B\n- C\n - D" + (let ((org-cycle-include-plain-lists t)) + (org-cycle) + (forward-line 2) + (org-cycle) + (org-insert-item) + (list (org-fold-get-folding-spec nil (line-beginning-position 0)) + (org-fold-get-folding-spec nil (line-end-position 2)))))))) (should (equal '(outline outline) - (org-test-with-temp-text "- A\n - B\n- C\n - D" - (let ((org-cycle-include-plain-lists t)) - (org-cycle) - (forward-line 2) - (org-cycle) - (org-insert-item) - (list (get-char-property (line-beginning-position 0) 'invisible) - (get-char-property (line-end-position 2) 'invisible)))))) + (let ((org-fold-core-style 'overlays)) + (org-test-with-temp-text "- A\n - B\n- C\n - D" + (let ((org-cycle-include-plain-lists t)) + (org-cycle) + (forward-line 2) + (org-cycle) + (org-insert-item) + (list (get-char-property (line-beginning-position 0) 'invisible) + (get-char-property (line-end-position 2) 'invisible))))))) ;; Test insertion in area after a sub-list. In particular, if point ;; is right at the end of the previous sub-list, still insert ;; a sub-item in that list. diff --git a/testing/lisp/test-org.el b/testing/lisp/test-org.el index 0cc8df154..ca0dc676b 100644 --- a/testing/lisp/test-org.el +++ b/testing/lisp/test-org.el @@ -4462,7 +4462,9 @@ (ert-deftest test-org/drag-element-backward () ;; Preserve visibility of elements and their contents. (should (equal '((63 . 82) (26 . 48)) - (org-test-with-temp-text " + (let ((org-fold-core-style 'text-properties)) + (org-test-with-temp-text + " #+BEGIN_CENTER Text. #+END_CENTER @@ -4470,11 +4472,35 @@ (ert-deftest test-org/drag-element-backward () #+BEGIN_QUOTE Text. #+END_QUOTE" - (while (search-forward "BEGIN_" nil t) (org-cycle)) - (search-backward "- item 1") - (org-drag-element-backward) - (mapcar (lambda (ov) (cons (overlay-start ov) (overlay-end ov))) - (overlays-in (point-min) (point-max)))))) + (while (search-forward "BEGIN_" nil t) (org-cycle)) + (search-backward "- item 1") + (org-drag-element-backward) + (let (regions) + (goto-char (point-min)) + (while (< (point) (point-max)) + (let ((region (org-fold-get-region-at-point))) + (if (not region) + (goto-char (org-fold-next-folding-state-change)) + (goto-char (cdr region)) + (push region regions)))) + regions))))) + (should + (equal '((63 . 82) (26 . 48)) + (let ((org-fold-core-style 'overlays)) + (org-test-with-temp-text + " +#+BEGIN_CENTER +Text. +#+END_CENTER +- item 1 + #+BEGIN_QUOTE + Text. + #+END_QUOTE" + (while (search-forward "BEGIN_" nil t) (org-cycle)) + (search-backward "- item 1") + (org-drag-element-backward) + (mapcar (lambda (ov) (cons (overlay-start ov) (overlay-end ov))) + (overlays-in (point-min) (point-max))))))) ;; Pathological case: handle call with point in blank lines right ;; after a headline. (should @@ -4511,7 +4537,9 @@ (ert-deftest test-org/drag-element-forward () (should (equal (buffer-string) "Para2\n\n\nParagraph 1\n\nPara3")) (should (looking-at " 1"))) ;; 5. Preserve visibility of elements and their contents. - (org-test-with-temp-text " + (let ((org-fold-core-style 'text-properties)) + (org-test-with-temp-text + " #+BEGIN_CENTER Text. #+END_CENTER @@ -4519,14 +4547,39 @@ (ert-deftest test-org/drag-element-forward () #+BEGIN_QUOTE Text. #+END_QUOTE" - (while (search-forward "BEGIN_" nil t) (org-cycle)) - (search-backward "#+BEGIN_CENTER") - (org-drag-element-forward) - (should - (equal - '((63 . 82) (26 . 48)) - (mapcar (lambda (ov) (cons (overlay-start ov) (overlay-end ov))) - (overlays-in (point-min) (point-max))))))) + (while (search-forward "BEGIN_" nil t) (org-cycle)) + (search-backward "#+BEGIN_CENTER") + (org-drag-element-forward) + (should + (equal + '((63 . 82) (26 . 48)) + (let (regions) + (goto-char (point-min)) + (while (< (point) (point-max)) + (let ((region (org-fold-get-region-at-point))) + (if (not region) + (goto-char (org-fold-next-folding-state-change)) + (goto-char (cdr region)) + (push region regions)))) + regions))))) + (let ((org-fold-core-style 'overlays)) + (org-test-with-temp-text + " +#+BEGIN_CENTER +Text. +#+END_CENTER +- item 1 + #+BEGIN_QUOTE + Text. + #+END_QUOTE" + (while (search-forward "BEGIN_" nil t) (org-cycle)) + (search-backward "#+BEGIN_CENTER") + (org-drag-element-forward) + (should + (equal + '((63 . 82) (26 . 48)) + (mapcar (lambda (ov) (cons (overlay-start ov) (overlay-end ov))) + (overlays-in (point-min) (point-max)))))))) (ert-deftest test-org/next-block () "Test `org-next-block' specifications." @@ -8419,6 +8472,100 @@ (ert-deftest test-org/visibility-show-branches () (org-kill-note-or-show-branches) (should (org-invisible-p (- (point-max) 2))))) +(ert-deftest test-org/org-cycle-narrowed-subtree () + "Test cycling in narrowed buffer." + (org-test-with-temp-text + "* Heading 1<point> +** Child 1.1 +** Child 1.2 +some text +*** Sub-child 1.2.1 +* Heading 2" + (org-overview) + (org-narrow-to-subtree) + (org-cycle) + (re-search-forward "Sub-child") + (should (org-invisible-p)))) + +(ert-deftest test-org/org-fold-reveal-broken-structure () + "Test unfolding broken elements." + (let ((org-fold-core-style 'text-properties)) + (org-test-with-temp-text + "<point>* Heading 1 +Text here" + (org-overview) + (re-search-forward "Text") + (should (org-invisible-p)) + (goto-char 1) + (delete-char 1) + (re-search-forward "Text") + (should-not (org-invisible-p))) + (org-test-with-temp-text + "* Heading 1 +<point>:PROPERTIES: +:ID: something +:END: +Text here" + (org-cycle) + (org-fold-hide-drawer-all) + (re-search-forward "ID") + (should (org-invisible-p)) + (re-search-backward ":PROPERTIES:") + (delete-char 1) + (re-search-forward "ID") + (should-not (org-invisible-p))) + (org-test-with-temp-text + "* Heading 1 +<point>:PROPERTIES: +:ID: something +:END: +Text here" + (org-cycle) + (org-fold-hide-drawer-all) + (re-search-forward "ID") + (should (org-invisible-p)) + (re-search-forward ":END:") + (delete-char -1) + (re-search-backward "ID") + (should-not (org-invisible-p))) + (org-test-with-temp-text + "* Heading 1 +<point>#+begin_src emacs-lisp +(+ 1 2) +#+end_src +Text here" + (org-cycle) + (org-fold-hide-drawer-all) + (re-search-forward "end") + (should (org-invisible-p)) + (delete-char -1) + (re-search-backward "2") + (should-not (org-invisible-p))))) + +(ert-deftest test-org/re-hide-edits-inside-fold () + "Test edits inside folded regions." + (org-test-with-temp-text + "<point>* Heading 1 +Text here" + (org-overview) + (org-set-property "TEST" "1") + (re-search-forward "TEST") + (should (org-invisible-p))) + (org-test-with-temp-text + "* Heading 1<point> +Text here" + (org-overview) + (insert " and extra heading text") + (re-search-backward "heading") + (should-not (org-invisible-p))) + (org-test-with-temp-text + "* Heading 1 +Text<point> here" + (org-overview) + (insert " and extra text") + (re-search-backward "extra") + (should (org-invisible-p)))) + \f ;;; Yank and Kill -- 2.35.1 -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH v2 21/38] org-manual: Update to new org-fold function names--- 2022-04-20 13:23 ` [PATCH v2 00/38] Final call for comments: " Ihor Radchenko ` (19 preceding siblings ...) 2022-04-20 13:26 ` [PATCH v2 20/38] Add org-fold-related tests--- Ihor Radchenko @ 2022-04-20 13:26 ` Ihor Radchenko 2022-04-20 13:26 ` [PATCH v2 22/38] ORG-NEWS: Add list of changes--- Ihor Radchenko ` (20 subsequent siblings) 41 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-04-20 13:26 UTC (permalink / raw) To: emacs-orgmode --- doc/org-manual.org | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/doc/org-manual.org b/doc/org-manual.org index 14fea0f2b..af54dc4e8 100644 --- a/doc/org-manual.org +++ b/doc/org-manual.org @@ -501,11 +501,11 @@ *** Global and local cycling Switch back to the startup visibility of the buffer (see [[*Initial visibility]]). -- {{{kbd(C-u C-u C-u TAB)}}} (~outline-show-all~) :: +- {{{kbd(C-u C-u C-u TAB)}}} (~org-show-all~) :: #+cindex: show all, command #+kindex: C-u C-u C-u TAB - #+findex: outline-show-all + #+findex: org-show-all Show all, including drawers. - {{{kbd(C-c C-r)}}} (~org-reveal~) :: @@ -521,18 +521,18 @@ *** Global and local cycling headings. With a double prefix argument, also show the entire subtree of the parent. -- {{{kbd(C-c C-k)}}} (~outline-show-branches~) :: +- {{{kbd(C-c C-k)}}} (~org-show-branches~) :: #+cindex: show branches, command #+kindex: C-c C-k - #+findex: outline-show-branches + #+findex: org-show-branches Expose all the headings of the subtree, but not their bodies. -- {{{kbd(C-c TAB)}}} (~outline-show-children~) :: +- {{{kbd(C-c TAB)}}} (~org-show-children~) :: #+cindex: show children, command #+kindex: C-c TAB - #+findex: outline-show-children + #+findex: org-show-children Expose all direct children of the subtree. With a numeric prefix argument {{{var(N)}}}, expose all children down to level {{{var(N)}}}. @@ -7375,7 +7375,7 @@ *** Internal archiving command (see [[*Visibility Cycling]]). You can force cycling archived subtrees with {{{kbd(C-TAB)}}}, or by setting the option ~org-cycle-open-archived-trees~. Also normal outline commands, like - ~outline-show-all~, open archived subtrees. + ~org-show-all~, open archived subtrees. - #+vindex: org-sparse-tree-open-archived-trees -- 2.35.1 -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH v2 22/38] ORG-NEWS: Add list of changes--- 2022-04-20 13:23 ` [PATCH v2 00/38] Final call for comments: " Ihor Radchenko ` (20 preceding siblings ...) 2022-04-20 13:26 ` [PATCH v2 21/38] org-manual: Update to new org-fold function names--- Ihor Radchenko @ 2022-04-20 13:26 ` Ihor Radchenko 2022-04-20 13:26 ` [PATCH v2 23/38] Backport contributed commits--- Ihor Radchenko ` (19 subsequent siblings) 41 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-04-20 13:26 UTC (permalink / raw) To: emacs-orgmode --- etc/ORG-NEWS | 104 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 104 insertions(+) diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS index 4f1309ecc..5b934fe96 100644 --- a/etc/ORG-NEWS +++ b/etc/ORG-NEWS @@ -40,6 +40,105 @@ The cache state is saved between Emacs sessions. Enabled by default. The cache persistence can be controlled via ~org-element-cache-persistent~. +*** Users experiencing performance issues can use new folding backend + +The old folding backend used in Org is poorly scalable when the file +size increases beyond few Mbs. The symptoms usually include slow +cursor motion, especially in long-running Emacs sessions. + +A new optimised folding backend is now available, and enabled by +default. To disable it, put the following to the Emacs config *before* +loading Org: + +#+begin_src emacs-lisp +(setq org-fold-core-style 'overlays) +#+end_src + +Even more performance optimisation can be enabled by customising +=org-fold-core--optimise-for-huge-buffers=. However, this option may +be dangerous. Please, read the variable docstring carefully to +understand the possible consequences. + +When =org-fold-core-style= is set to =text-properties=, several new +features will become available and several notable changes will happen +to the Org behaviour. The new features and changes are listed below. + +**** Hidden parts of the links can now be searched and revealed during isearch + +In the past, hidden parts of the links could not be searched using +isearch (=C-s=). Now, they are searchable by default. The hidden +match is also revealed temporarily during isearch. + +To restore the old behaviour add the following core to your Emacs +config: + +#+begin_src emacs-lisp +(defun org-hidden-link-ignore-isearch () + "Do not match hidden parts of links during isearch." + (org-fold-core-set-folding-spec-property 'org-link :isearch-open nil) + (org-fold-core-set-folding-spec-property 'org-link :isearch-ignore t)) +(add-hook 'org-mode-hook #'org-hidden-link-ignore-isearch) +#+end_src + +See docstring of =org-fold-core--specs= to see more details about +=:isearch-open= and =:isearch-ignore= properties. + +**** =org-catch-invisible-edits= now works for hidden parts of the links and for emphasis markers + +In the past, user could edit invisible parts of the links and emphasis markers. Now, the editing is respecting the value of =org-catch-invisible-edits=. + +Note that hidden parts of sub-/super-scripts are still not handled. + +**** Breaking structure of folded elements automatically reveals the folded text + +In the past, the user could be left with unfoldable text after breaking the org structure. + +For example, if + +#+begin_src org +:DRAWER: +like this +:END: +#+end_src + +is folded and then edited into + +#+begin_src org +DRAWER: +like this +:END: +#+end_src +The hidden text would not be revealed. + +Now, breaking structure of drawers, blocks, and headings automatically +reveals the folded text. + +**** Folding state of the drawers is now preserved when cycling headline visibility + +In the past drawers were folded every time a headline is unfolded. + +Now, it is not the case anymore. The drawer folding state is +preserved. The initial folding state of all the drawers in buffer is +set according to the startup visibility settings. + +To restore the old behaviour, add the following code to Emacs config: + +#+begin_src emacs-lisp +(add-hook 'org-cycle-hook #'org-cycle-hide-drawers) +#+end_src + +Note that old behaviour may cause performance issues when cycling +headline visibility in large buffers. + +**** =outline-*= functions may no longer work correctly in Org mode + +The new folding backend breaks some of the =outline-*= functions that +rely on the details of visibility state implementation in +=outline.el=. The old Org folding backend was compatible with the +=outline.el= folding, but it is not the case anymore with the new +backend. From now on, using =outline-*= functions is strongly +discouraged when working with Org files. + ** New features *** New library =org-persist.el= implements variable persistence across Emacs sessions @@ -117,6 +216,11 @@ argument. This function is intended for us in the definition of a ~kbd~ macro in files that are exported to Texinfo. +*** =org-at-heading-p= now recognises optional argument. Its meaning is inverted. + +=org-at-heading-p= now returns t by default on headings inside folds. +Passing optional argument will produce the old behaviour. + ** Miscellaneous *** Styles are customizable in ~biblatex~ citation processor -- 2.35.1 -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH v2 23/38] Backport contributed commits--- 2022-04-20 13:23 ` [PATCH v2 00/38] Final call for comments: " Ihor Radchenko ` (21 preceding siblings ...) 2022-04-20 13:26 ` [PATCH v2 22/38] ORG-NEWS: Add list of changes--- Ihor Radchenko @ 2022-04-20 13:26 ` Ihor Radchenko 2022-04-20 13:26 ` [PATCH v2 24/38] Fix typo: delete-duplicates → delete-dups Anders Johansson ` (18 subsequent siblings) 41 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-04-20 13:26 UTC (permalink / raw) To: emacs-orgmode --- lisp/org-cycle.el | 2 +- lisp/org-fold-core.el | 2 +- lisp/org-keys.el | 4 ++-- lisp/org.el | 6 ++---- 4 files changed, 6 insertions(+), 8 deletions(-) diff --git a/lisp/org-cycle.el b/lisp/org-cycle.el index df0a3761a..d2fcc356c 100644 --- a/lisp/org-cycle.el +++ b/lisp/org-cycle.el @@ -811,7 +811,7 @@ (defun org-cycle-hide-archived-subtrees (state) (org-get-tags nil 'local))) (message "%s" (substitute-command-keys "Subtree is archived and stays closed. Use \ -`\\[org-cycle-force-archived]' to cycle it anyway.")))))) +`\\[org-force-cycle-archived]' to cycle it anyway.")))))) (provide 'org-cycle) diff --git a/lisp/org-fold-core.el b/lisp/org-fold-core.el index 121c6b5c4..6ea374498 100644 --- a/lisp/org-fold-core.el +++ b/lisp/org-fold-core.el @@ -592,7 +592,7 @@ (defun org-fold-core--property-symbol-get-create (spec &optional buffer return-o (org-fold-core-cycle-over-indirect-buffers (push (current-buffer) bufs)) (push buf bufs) - (delete-dups bufs))))) + (delete-duplicates bufs))))) ;; Copy all the old folding properties to preserve the folding state (with-silent-modifications (dolist (old-prop (cdr (assq 'invisible char-property-alias-alist))) diff --git a/lisp/org-keys.el b/lisp/org-keys.el index 782ffa871..e6b8ff459 100644 --- a/lisp/org-keys.el +++ b/lisp/org-keys.el @@ -94,7 +94,7 @@ (declare-function org-feed-update-all "org" ()) (declare-function org-fill-paragraph "org" (&optional justify region)) (declare-function org-find-file-at-mouse "org" (ev)) (declare-function org-footnote-action "org" (&optional special)) -(declare-function org-cycle-force-archived "org-cycle" ()) +(declare-function org-force-cycle-archived "org-cycle" ()) (declare-function org-force-self-insert "org" (n)) (declare-function org-forward-element "org" ()) (declare-function org-forward-heading-same-level "org" (arg &optional invisible-ok)) @@ -444,7 +444,7 @@ (org-defkey org-mode-map (kbd "C-c C-x") (make-sparse-keymap)) ;;;; TAB key with modifiers (org-defkey org-mode-map (kbd "TAB") #'org-cycle) -(org-defkey org-mode-map (kbd "C-c C-<tab>") #'org-cycle-force-archived) +(org-defkey org-mode-map (kbd "C-c C-<tab>") #'org-force-cycle-archived) ;; Override text-mode binding to expose `complete-symbol' for ;; pcomplete functionality. (org-defkey org-mode-map (kbd "M-TAB") nil) diff --git a/lisp/org.el b/lisp/org.el index 402ce3520..0f31e7794 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -106,7 +106,6 @@ (defalias 'org-global-cycle #'org-cycle-global) (defalias 'org-overview #'org-cycle-overview) (defalias 'org-content #'org-cycle-content) (defalias 'org-reveal #'org-fold-reveal) -(defalias 'org-force-cycle-archived #'org-cycle-force-archived) ;; `org-outline-regexp' ought to be a defconst but is let-bound in ;; some places -- e.g. see the macro `org-with-limited-levels'. @@ -6169,8 +6168,7 @@ (defun org-get-heading (&optional no-tags no-todo no-priority no-comment) (looking-at org-complex-heading-regexp) ;; When using `org-fold-core--optimise-for-huge-buffers', ;; returned text may be invisible. Clear it up. - (save-match-data - (org-fold-core-remove-optimisation (match-beginning 0) (match-end 0))) + (org-fold-core-remove-optimisation (match-beginning 0) (match-end 0)) (let ((todo (and (not no-todo) (match-string 2))) (priority (and (not no-priority) (match-string 3))) (headline (pcase (match-string 4) @@ -11699,7 +11697,7 @@ (defun org--get-local-tags () (let* ((cached (and (org-element--cache-active-p) (org-element-at-point nil 'cached))) (cached-tags (org-element-property :tags cached))) (if cached - ;; If we do explicitly copy the result, reference would + ;; If we do not explicitly copy the result, reference would ;; be returned and cache element might be modified directly. (mapcar #'copy-sequence cached-tags) ;; Parse tags manually. -- 2.35.1 -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH v2 24/38] Fix typo: delete-duplicates → delete-dups 2022-04-20 13:23 ` [PATCH v2 00/38] Final call for comments: " Ihor Radchenko ` (22 preceding siblings ...) 2022-04-20 13:26 ` [PATCH v2 23/38] Backport contributed commits--- Ihor Radchenko @ 2022-04-20 13:26 ` Anders Johansson 2022-04-20 13:26 ` [PATCH v2 25/38] Fix bug in org-get-headingFixes #26, where fontification could make the matching and extraction of heading Anders Johansson ` (17 subsequent siblings) 41 siblings, 0 replies; 192+ messages in thread From: Anders Johansson @ 2022-04-20 13:26 UTC (permalink / raw) To: emacs-orgmode --- lisp/org-fold-core.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/org-fold-core.el b/lisp/org-fold-core.el index 6ea374498..121c6b5c4 100644 --- a/lisp/org-fold-core.el +++ b/lisp/org-fold-core.el @@ -592,7 +592,7 @@ (defun org-fold-core--property-symbol-get-create (spec &optional buffer return-o (org-fold-core-cycle-over-indirect-buffers (push (current-buffer) bufs)) (push buf bufs) - (delete-duplicates bufs))))) + (delete-dups bufs))))) ;; Copy all the old folding properties to preserve the folding state (with-silent-modifications (dolist (old-prop (cdr (assq 'invisible char-property-alias-alist))) -- 2.35.1 -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH v2 25/38] Fix bug in org-get-headingFixes #26, where fontification could make the matching and extraction of heading 2022-04-20 13:23 ` [PATCH v2 00/38] Final call for comments: " Ihor Radchenko ` (23 preceding siblings ...) 2022-04-20 13:26 ` [PATCH v2 24/38] Fix typo: delete-duplicates → delete-dups Anders Johansson @ 2022-04-20 13:26 ` Anders Johansson 2022-04-20 13:27 ` [PATCH v2 26/38] Rename remaining org-force-cycle-archived Anders Johansson ` (16 subsequent siblings) 41 siblings, 0 replies; 192+ messages in thread From: Anders Johansson @ 2022-04-20 13:26 UTC (permalink / raw) To: emacs-orgmode Fixes #26, where fontification could make the matching and extraction of heading components fail. --- lisp/org.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index 0f31e7794..ff17bf001 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -6167,8 +6167,9 @@ (defun org-get-heading (&optional no-tags no-todo no-priority no-comment) (let ((case-fold-search nil)) (looking-at org-complex-heading-regexp) ;; When using `org-fold-core--optimise-for-huge-buffers', - ;; returned text may be invisible. Clear it up. - (org-fold-core-remove-optimisation (match-beginning 0) (match-end 0)) + ;; returned text will be invisible. Clear it up. + (save-match-data + (org-fold-core-remove-optimisation (match-beginning 0) (match-end 0))) (let ((todo (and (not no-todo) (match-string 2))) (priority (and (not no-priority) (match-string 3))) (headline (pcase (match-string 4) -- 2.35.1 -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH v2 26/38] Rename remaining org-force-cycle-archived 2022-04-20 13:23 ` [PATCH v2 00/38] Final call for comments: " Ihor Radchenko ` (24 preceding siblings ...) 2022-04-20 13:26 ` [PATCH v2 25/38] Fix bug in org-get-headingFixes #26, where fontification could make the matching and extraction of heading Anders Johansson @ 2022-04-20 13:27 ` Anders Johansson 2022-04-20 13:27 ` [PATCH v2 27/38] Fix org-fold--hide-drawers--overlays--- Ihor Radchenko ` (15 subsequent siblings) 41 siblings, 0 replies; 192+ messages in thread From: Anders Johansson @ 2022-04-20 13:27 UTC (permalink / raw) To: emacs-orgmode --- lisp/org-cycle.el | 2 +- lisp/org-keys.el | 4 ++-- lisp/org.el | 1 + 3 files changed, 4 insertions(+), 3 deletions(-) diff --git a/lisp/org-cycle.el b/lisp/org-cycle.el index d2fcc356c..df0a3761a 100644 --- a/lisp/org-cycle.el +++ b/lisp/org-cycle.el @@ -811,7 +811,7 @@ (defun org-cycle-hide-archived-subtrees (state) (org-get-tags nil 'local))) (message "%s" (substitute-command-keys "Subtree is archived and stays closed. Use \ -`\\[org-force-cycle-archived]' to cycle it anyway.")))))) +`\\[org-cycle-force-archived]' to cycle it anyway.")))))) (provide 'org-cycle) diff --git a/lisp/org-keys.el b/lisp/org-keys.el index e6b8ff459..782ffa871 100644 --- a/lisp/org-keys.el +++ b/lisp/org-keys.el @@ -94,7 +94,7 @@ (declare-function org-feed-update-all "org" ()) (declare-function org-fill-paragraph "org" (&optional justify region)) (declare-function org-find-file-at-mouse "org" (ev)) (declare-function org-footnote-action "org" (&optional special)) -(declare-function org-force-cycle-archived "org-cycle" ()) +(declare-function org-cycle-force-archived "org-cycle" ()) (declare-function org-force-self-insert "org" (n)) (declare-function org-forward-element "org" ()) (declare-function org-forward-heading-same-level "org" (arg &optional invisible-ok)) @@ -444,7 +444,7 @@ (org-defkey org-mode-map (kbd "C-c C-x") (make-sparse-keymap)) ;;;; TAB key with modifiers (org-defkey org-mode-map (kbd "TAB") #'org-cycle) -(org-defkey org-mode-map (kbd "C-c C-<tab>") #'org-force-cycle-archived) +(org-defkey org-mode-map (kbd "C-c C-<tab>") #'org-cycle-force-archived) ;; Override text-mode binding to expose `complete-symbol' for ;; pcomplete functionality. (org-defkey org-mode-map (kbd "M-TAB") nil) diff --git a/lisp/org.el b/lisp/org.el index ff17bf001..796a05fad 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -106,6 +106,7 @@ (defalias 'org-global-cycle #'org-cycle-global) (defalias 'org-overview #'org-cycle-overview) (defalias 'org-content #'org-cycle-content) (defalias 'org-reveal #'org-fold-reveal) +(defalias 'org-force-cycle-archived #'org-cycle-force-archived) ;; `org-outline-regexp' ought to be a defconst but is let-bound in ;; some places -- e.g. see the macro `org-with-limited-levels'. -- 2.35.1 -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH v2 27/38] Fix org-fold--hide-drawers--overlays--- 2022-04-20 13:23 ` [PATCH v2 00/38] Final call for comments: " Ihor Radchenko ` (25 preceding siblings ...) 2022-04-20 13:27 ` [PATCH v2 26/38] Rename remaining org-force-cycle-archived Anders Johansson @ 2022-04-20 13:27 ` Ihor Radchenko 2022-04-20 13:27 ` [PATCH v2 28/38] org-string-width: Handle undefined behaviour in older Emacs Ihor Radchenko ` (14 subsequent siblings) 41 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-04-20 13:27 UTC (permalink / raw) To: emacs-orgmode --- lisp/org-fold.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/org-fold.el b/lisp/org-fold.el index e48a528bf..a16ee0f9b 100644 --- a/lisp/org-fold.el +++ b/lisp/org-fold.el @@ -714,7 +714,7 @@ (defun org-fold--hide-drawers--overlays (begin end) "Hide all drawers between BEGIN and END." (save-excursion (goto-char begin) - (while (re-search-forward org-drawer-regexp end t) + (while (and (< (point) end) (re-search-forward org-drawer-regexp end t)) (let* ((pair (get-char-property-and-overlay (line-beginning-position) 'invisible)) (o (cdr-safe pair))) -- 2.35.1 -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH v2 28/38] org-string-width: Handle undefined behaviour in older Emacs 2022-04-20 13:23 ` [PATCH v2 00/38] Final call for comments: " Ihor Radchenko ` (26 preceding siblings ...) 2022-04-20 13:27 ` [PATCH v2 27/38] Fix org-fold--hide-drawers--overlays--- Ihor Radchenko @ 2022-04-20 13:27 ` Ihor Radchenko 2022-04-20 13:27 ` [PATCH v2 29/38] org-string-width: Work around `window-pixel-width' bug in old Emacs Ihor Radchenko ` (13 subsequent siblings) 41 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-04-20 13:27 UTC (permalink / raw) To: emacs-orgmode * lisp/org-macs.el (org-string-width): Force older Emacs treating invisible text with ellipsis as zero-width. Newer Emacs versions do exactly this. --- lisp/org-macs.el | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/lisp/org-macs.el b/lisp/org-macs.el index 188168cdc..e56a234d3 100644 --- a/lisp/org-macs.el +++ b/lisp/org-macs.el @@ -926,7 +926,16 @@ (defun org-string-width (string &optional pixels) (with-temp-buffer (setq-local display-line-numbers nil) (setq-local buffer-invisibility-spec - current-invisibility-spec) + (if (listp current-invisibility-spec) + (mapcar (lambda (el) + ;; Consider elipsis to have 0 width. + ;; It is what Emacs 28+ does, but we have + ;; to force it in earlier Emacs versions. + (if (and (consp el) (cdr el)) + (list (car el)) + el)) + current-invisibility-spec) + current-invisibility-spec)) (setq-local char-property-alias-alist current-char-property-alias-alist) (let (pixel-width symbol-width) -- 2.35.1 -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH v2 29/38] org-string-width: Work around `window-pixel-width' bug in old Emacs 2022-04-20 13:23 ` [PATCH v2 00/38] Final call for comments: " Ihor Radchenko ` (27 preceding siblings ...) 2022-04-20 13:27 ` [PATCH v2 28/38] org-string-width: Handle undefined behaviour in older Emacs Ihor Radchenko @ 2022-04-20 13:27 ` Ihor Radchenko 2022-04-20 13:27 ` [PATCH v2 30/38] org-fold-show-set-visibility: Fix edge case when folded region is at BOB Ihor Radchenko ` (12 subsequent siblings) 41 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-04-20 13:27 UTC (permalink / raw) To: emacs-orgmode --- lisp/org-macs.el | 188 ++++++++++++++++++++++++++++++++--------------- 1 file changed, 129 insertions(+), 59 deletions(-) diff --git a/lisp/org-macs.el b/lisp/org-macs.el index e56a234d3..a1d514d50 100644 --- a/lisp/org-macs.el +++ b/lisp/org-macs.el @@ -893,73 +893,143 @@ (defun org-split-string (string &optional separators) results ;skip trailing separator (cons (substring string i) results))))))) +(defun org--string-from-props (s property beg end) + "Return the visible part of string S. +Visible part is determined according to text PROPERTY, which is +either `invisible' or `display'. BEG and END are 0-indices +delimiting S." + (let ((width 0) + (cursor beg)) + (while (setq beg (text-property-not-all beg end property nil s)) + (let* ((next (next-single-property-change beg property s end)) + (props (text-properties-at beg s)) + (spec (plist-get props property)) + (value + (pcase property + (`invisible + ;; If `invisible' property in PROPS means text is to + ;; be invisible, return 0. Otherwise return nil so + ;; as to resume search. + (and (or (eq t buffer-invisibility-spec) + (assoc-string spec buffer-invisibility-spec)) + 0)) + (`display + (pcase spec + (`nil nil) + (`(space . ,props) + (let ((width (plist-get props :width))) + (and (wholenump width) width))) + (`(image . ,_) + (and (fboundp 'image-size) + (ceiling (car (image-size spec))))) + ((pred stringp) + ;; Displayed string could contain invisible parts, + ;; but no nested display. + (org--string-from-props spec 'invisible 0 (length spec))) + (_ + ;; Un-handled `display' value. Ignore it. + ;; Consider the original string instead. + nil))) + (_ (error "Unknown property: %S" property))))) + (when value + (cl-incf width + ;; When looking for `display' parts, we still need + ;; to look for `invisible' property elsewhere. + (+ (cond ((eq property 'display) + (org--string-from-props s 'invisible cursor beg)) + ((= cursor beg) 0) + (t (string-width (substring s cursor beg)))) + value)) + (setq cursor next)) + (setq beg next))) + (+ width + ;; Look for `invisible' property in the last part of the + ;; string. See above. + (cond ((eq property 'display) + (org--string-from-props s 'invisible cursor end)) + ((= cursor end) 0) + (t (string-width (substring s cursor end))))))) + +(defun org--string-width-1 (string) + "Return width of STRING when displayed in the current buffer. +Unlike `string-width', this function takes into consideration +`invisible' and `display' text properties. It supports the +latter in a limited way, mostly for combinations used in Org. +Results may be off sometimes if it cannot handle a given +`display' value." + (org--string-from-props string 'display 0 (length string))) + (defun org-string-width (string &optional pixels) "Return width of STRING when displayed in the current buffer. Return width in pixels when PIXELS is non-nil." - ;; Wrap/line prefix will make `window-text-pizel-size' return too - ;; large value including the prefix. - ;; Face should be removed to make sure that all the string symbols - ;; are using default face with constant width. Constant char width - ;; is critical to get right string width from pixel width. - (remove-text-properties 0 (length string) - '(wrap-prefix t line-prefix t face t) - string) - (let (;; We need to remove the folds to make sure that folded table - ;; alignment is not messed up. - (current-invisibility-spec - (or (and (not (listp buffer-invisibility-spec)) - buffer-invisibility-spec) - (let (result) - (dolist (el buffer-invisibility-spec) - (unless (or (memq el - '(org-fold-drawer - org-fold-block - org-fold-outline)) - (and (listp el) - (memq (car el) - '(org-fold-drawer - org-fold-block - org-fold-outline)))) - (push el result))) - result))) - (current-char-property-alias-alist char-property-alias-alist)) - (with-temp-buffer - (setq-local display-line-numbers nil) - (setq-local buffer-invisibility-spec - (if (listp current-invisibility-spec) - (mapcar (lambda (el) - ;; Consider elipsis to have 0 width. - ;; It is what Emacs 28+ does, but we have - ;; to force it in earlier Emacs versions. - (if (and (consp el) (cdr el)) - (list (car el)) - el)) - current-invisibility-spec) - current-invisibility-spec)) - (setq-local char-property-alias-alist - current-char-property-alias-alist) - (let (pixel-width symbol-width) - (with-silent-modifications - (setf (buffer-string) string) - (setq pixel-width - (if (get-buffer-window (current-buffer)) - (car (window-text-pixel-size - nil (line-beginning-position) (point-max))) - (set-window-buffer nil (current-buffer)) - (car (window-text-pixel-size - nil (line-beginning-position) (point-max))))) - (unless pixels - (setf (buffer-string) "a") - (setq symbol-width + (if (and (version< emacs-version "28") (not pixels)) + ;; FIXME: Fallback to old limited version, because + ;; `window-pixel-width' is buggy in older Emacs. + (org--string-width-1 string) + ;; Wrap/line prefix will make `window-text-pizel-size' return too + ;; large value including the prefix. + ;; Face should be removed to make sure that all the string symbols + ;; are using default face with constant width. Constant char width + ;; is critical to get right string width from pixel width. + (remove-text-properties 0 (length string) + '(wrap-prefix t line-prefix t face t) + string) + (let (;; We need to remove the folds to make sure that folded table + ;; alignment is not messed up. + (current-invisibility-spec + (or (and (not (listp buffer-invisibility-spec)) + buffer-invisibility-spec) + (let (result) + (dolist (el buffer-invisibility-spec) + (unless (or (memq el + '(org-fold-drawer + org-fold-block + org-fold-outline)) + (and (listp el) + (memq (car el) + '(org-fold-drawer + org-fold-block + org-fold-outline)))) + (push el result))) + result))) + (current-char-property-alias-alist char-property-alias-alist)) + (with-temp-buffer + (setq-local display-line-numbers nil) + (setq-local buffer-invisibility-spec + (if (listp current-invisibility-spec) + (mapcar (lambda (el) + ;; Consider elipsis to have 0 width. + ;; It is what Emacs 28+ does, but we have + ;; to force it in earlier Emacs versions. + (if (and (consp el) (cdr el)) + (list (car el)) + el)) + current-invisibility-spec) + current-invisibility-spec)) + (setq-local char-property-alias-alist + current-char-property-alias-alist) + (let (pixel-width symbol-width) + (with-silent-modifications + (setf (buffer-string) string) + (setq pixel-width (if (get-buffer-window (current-buffer)) (car (window-text-pixel-size nil (line-beginning-position) (point-max))) (set-window-buffer nil (current-buffer)) (car (window-text-pixel-size - nil (line-beginning-position) (point-max))))))) - (if pixels - pixel-width - (/ pixel-width symbol-width)))))) + nil (line-beginning-position) (point-max))))) + (unless pixels + (setf (buffer-string) "a") + (setq symbol-width + (if (get-buffer-window (current-buffer)) + (car (window-text-pixel-size + nil (line-beginning-position) (point-max))) + (set-window-buffer nil (current-buffer)) + (car (window-text-pixel-size + nil (line-beginning-position) (point-max))))))) + (if pixels + pixel-width + (/ pixel-width symbol-width))))))) (defun org-not-nil (v) "If V not nil, and also not the string \"nil\", then return V. -- 2.35.1 -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH v2 30/38] org-fold-show-set-visibility: Fix edge case when folded region is at BOB 2022-04-20 13:23 ` [PATCH v2 00/38] Final call for comments: " Ihor Radchenko ` (28 preceding siblings ...) 2022-04-20 13:27 ` [PATCH v2 29/38] org-string-width: Work around `window-pixel-width' bug in old Emacs Ihor Radchenko @ 2022-04-20 13:27 ` Ihor Radchenko 2022-04-20 13:28 ` [PATCH v2 31/38] org-fold-core: Fix fontification inside folded regions Ihor Radchenko ` (11 subsequent siblings) 41 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-04-20 13:27 UTC (permalink / raw) To: emacs-orgmode --- lisp/org-fold.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/org-fold.el b/lisp/org-fold.el index a16ee0f9b..d5a21cbcb 100644 --- a/lisp/org-fold.el +++ b/lisp/org-fold.el @@ -840,7 +840,7 @@ (defun org-fold-show-set-visibility--text-properties (detail) (org-with-point-at (car region) (beginning-of-line) (let (font-lock-extend-region-functions) - (font-lock-fontify-region (1- (car region)) (cdr region)))))) + (font-lock-fontify-region (max (point-min) (1- (car region))) (cdr region)))))) (when region (org-fold-region (car region) (cdr region) nil)))) (unless (org-before-first-heading-p) -- 2.35.1 -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH v2 31/38] org-fold-core: Fix fontification inside folded regions 2022-04-20 13:23 ` [PATCH v2 00/38] Final call for comments: " Ihor Radchenko ` (29 preceding siblings ...) 2022-04-20 13:27 ` [PATCH v2 30/38] org-fold-show-set-visibility: Fix edge case when folded region is at BOB Ihor Radchenko @ 2022-04-20 13:28 ` Ihor Radchenko 2022-04-20 13:28 ` [PATCH v2 32/38] test-org/string-width: Add tests for strings with prefix properties Ihor Radchenko ` (10 subsequent siblings) 41 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-04-20 13:28 UTC (permalink / raw) To: emacs-orgmode * lisp/org-fold-core.el (org-fold-core-initialize): Declare `org-fold-core-fontified' text property for font-lock. (org-fold-core--force-fontification): New variable controlling forced fontification inside folded regions. (org-fold-core-fontify-region): Fix cases when BEG is inside folded region. Respect `org-fold-core--force-fontification'. * lisp/org-macs.el (org-with-forced-fontification): New macro. (org-buffer-substring-fontified): (org-looking-at-fontified): Do not rely on jit-lock. Use `org-fold-core-fontified' text property to determine whether text is already fontified. --- lisp/org-fold-core.el | 69 +++++++++++++++++++++++++------------------ lisp/org-macs.el | 31 +++++++++++++++++++ 2 files changed, 72 insertions(+), 28 deletions(-) diff --git a/lisp/org-fold-core.el b/lisp/org-fold-core.el index 121c6b5c4..edae316ff 100644 --- a/lisp/org-fold-core.el +++ b/lisp/org-fold-core.el @@ -746,7 +746,8 @@ (defun org-fold-core-initialize (&optional specs) (add-hook 'clone-indirect-buffer-hook #'org-fold-core-decouple-indirect-buffer-folds nil 'local) ;; Optimise buffer fontification to not fontify folded text. (when (eq font-lock-fontify-region-function #'font-lock-default-fontify-region) - (setq-local font-lock-fontify-region-function 'org-fold-core-fontify-region)) + (setq-local font-lock-fontify-region-function 'org-fold-core-fontify-region) + (add-to-list 'font-lock-extra-managed-props 'org-fold-core-fontified)) ;; Setup killing text (setq-local filter-buffer-substring-function #'org-fold-core--buffer-substring-filter) (if (and (boundp 'isearch-opened-regions) @@ -1429,35 +1430,47 @@ (defun org-fold-core--buffer-substring-filter (beg end &optional delete) return-string)) ;;; Do not fontify folded text until needed. - +(defvar org-fold-core--force-fontification nil + "Let-bind this variable to t in order to force fontification in +folded regions.") (defun org-fold-core-fontify-region (beg end loudly &optional force) "Run `font-lock-default-fontify-region' in visible regions." - (let ((pos beg) next - (org-fold-core--fontifying t)) - (while (< pos end) - (setq next (org-fold-core-next-folding-state-change - (if force nil - (let (result) - (dolist (spec (org-fold-core-folding-spec-list)) - (when (and (not (org-fold-core-get-folding-spec-property spec :visible)) - (org-fold-core-get-folding-spec-property spec :font-lock-skip)) - (push spec result))) - result)) - pos - end)) - (while (and (not (catch :found - (dolist (spec (org-fold-core-get-folding-spec 'all next)) - (when (org-fold-core-get-folding-spec-property spec :font-lock-skip) - (throw :found spec))))) - (< next end)) - (setq next (org-fold-core-next-folding-state-change nil next end))) - (save-excursion - (font-lock-default-fontify-region pos next loudly) - (save-match-data - (unless (<= pos (point) next) - (run-hook-with-args 'org-fold-core-first-unfold-functions pos next)))) - (put-text-property pos next 'org-fold-core-fontified t) - (setq pos next)))) + (with-silent-modifications + (let ((pos beg) next + (force (or force org-fold-core--force-fontification)) + (org-fold-core--fontifying t) + (skip-specs + (let (result) + (dolist (spec (org-fold-core-folding-spec-list)) + (when (and (not (org-fold-core-get-folding-spec-property spec :visible)) + (org-fold-core-get-folding-spec-property spec :font-lock-skip)) + (push spec result))) + result))) + ;; Move POS to first visible point within BEG..END. + (while (and (catch :found + (dolist (spec (org-fold-core-get-folding-spec 'all pos)) + (when (org-fold-core-get-folding-spec-property spec :font-lock-skip) + (throw :found spec)))) + (< pos end)) + (setq pos (org-fold-core-next-folding-state-change nil pos end))) + (when force (setq pos beg next end)) + (while (< pos end) + (unless force + (setq next (org-fold-core-next-folding-state-change skip-specs pos end))) + ;; Move to the end of the region to be fontified. + (while (and (not (catch :found + (dolist (spec (org-fold-core-get-folding-spec 'all next)) + (when (org-fold-core-get-folding-spec-property spec :font-lock-skip) + (throw :found spec))))) + (< next end)) + (setq next (org-fold-core-next-folding-state-change nil next end))) + (save-excursion + (font-lock-default-fontify-region pos next loudly) + (save-match-data + (unless (<= pos (point) next) + (run-hook-with-args 'org-fold-core-first-unfold-functions pos next)))) + (put-text-property pos next 'org-fold-core-fontified t) + (setq pos next))))) (defun org-fold-core-update-optimisation (beg end) "Update huge buffer optimisation between BEG and END. diff --git a/lisp/org-macs.el b/lisp/org-macs.el index a1d514d50..5e6728101 100644 --- a/lisp/org-macs.el +++ b/lisp/org-macs.el @@ -39,6 +39,7 @@ (declare-function org-agenda-files "org" (&optional unrestricted archives)) (declare-function org-fold-show-context "org-fold" (&optional key)) (declare-function org-fold-save-outline-visibility "org-fold" (use-markers &rest body)) (declare-function org-fold-next-visibility-change "org-fold" (&optional pos limit ignore-hidden-p previous-p)) +(declare-function org-fold-core-with-forced-fontification "org-fold" (&rest body)) (declare-function org-fold-folded-p "org-fold" (&optional pos limit ignore-hidden-p previous-p)) (declare-function string-collate-lessp "org-compat" (s1 s2 &optional locale ignore-case)) @@ -1178,6 +1179,36 @@ (defconst org-rm-props '(invisible t face t keymap t intangible t mouse-face t org-emphasis t) "Properties to remove when a string without properties is wanted.") +(defvar org-fold-core--force-fontification) +(defmacro org-with-forced-fontification (&rest body) + "Run BODY forcing fontification of folded regions." + (declare (debug (form body)) (indent 1)) + `(unwind-protect + (progn + (setq org-fold-core--force-fontification t) + ,@body) + (setq org-fold-core--force-fontification nil))) + +(defun org-buffer-substring-fontified (beg end) + "Return fontified region between BEG and END." + (when (bound-and-true-p jit-lock-mode) + (org-with-forced-fontification + (when (text-property-not-all beg end 'org-fold-core-fontified t) + (save-match-data (font-lock-fontify-region beg end))))) + (buffer-substring beg end)) + +(defun org-looking-at-fontified (re) + "Call `looking-at' RE and make sure that the match is fontified." + (prog1 (looking-at re) + (when (bound-and-true-p jit-lock-mode) + (org-with-forced-fontification + (when (text-property-not-all + (match-beginning 0) (match-end 0) + 'org-fold-core-fontified t) + (save-match-data + (font-lock-fontify-region (match-beginning 0) + (match-end 0)))))))) + (defsubst org-no-properties (s &optional restricted) "Remove all text properties from string S. When RESTRICTED is non-nil, only remove the properties listed -- 2.35.1 -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH v2 32/38] test-org/string-width: Add tests for strings with prefix properties 2022-04-20 13:23 ` [PATCH v2 00/38] Final call for comments: " Ihor Radchenko ` (30 preceding siblings ...) 2022-04-20 13:28 ` [PATCH v2 31/38] org-fold-core: Fix fontification inside folded regions Ihor Radchenko @ 2022-04-20 13:28 ` Ihor Radchenko 2022-04-20 13:28 ` [PATCH v2 33/38] org--string-from-props: Fix handling folds in Emacs <28 Ihor Radchenko ` (9 subsequent siblings) 41 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-04-20 13:28 UTC (permalink / raw) To: emacs-orgmode --- testing/lisp/test-org-macs.el | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/testing/lisp/test-org-macs.el b/testing/lisp/test-org-macs.el index 6a7ccea3c..05cef1281 100644 --- a/testing/lisp/test-org-macs.el +++ b/testing/lisp/test-org-macs.el @@ -65,7 +65,11 @@ (ert-deftest test-org/string-width () (should (= 4 (org-string-width #("123" 1 2 (display #("abc" 1 2 (invisible t))))))) ;; Test `space' property in `display'. - (should (= 2 (org-string-width #(" " 0 1 (display (space :width 2))))))) + (should (= 2 (org-string-width #(" " 0 1 (display (space :width 2)))))) + ;; Test `wrap-prefix' property. + (should (= 2 (org-string-width #("ab" 0 2 (wrap-prefix " "))))) + ;; Test `line-prefix' property. + (should (= 2 (org-string-width #("ab" 0 2 (line-prefix " ")))))) \f ;;; Regexp -- 2.35.1 -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH v2 33/38] org--string-from-props: Fix handling folds in Emacs <28 2022-04-20 13:23 ` [PATCH v2 00/38] Final call for comments: " Ihor Radchenko ` (31 preceding siblings ...) 2022-04-20 13:28 ` [PATCH v2 32/38] test-org/string-width: Add tests for strings with prefix properties Ihor Radchenko @ 2022-04-20 13:28 ` Ihor Radchenko 2022-04-20 13:28 ` [PATCH v2 34/38] org-link-make-string: Throw error when both LINK and DESCRIPTION are empty Ihor Radchenko ` (8 subsequent siblings) 41 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-04-20 13:28 UTC (permalink / raw) To: emacs-orgmode * lisp/org-macs.el (org--string-from-props): Respect `char-property-alias-alist' when querying for `invisible' text property. --- lisp/org-macs.el | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/lisp/org-macs.el b/lisp/org-macs.el index 5e6728101..c71bb4094 100644 --- a/lisp/org-macs.el +++ b/lisp/org-macs.el @@ -903,14 +903,13 @@ (defun org--string-from-props (s property beg end) (cursor beg)) (while (setq beg (text-property-not-all beg end property nil s)) (let* ((next (next-single-property-change beg property s end)) - (props (text-properties-at beg s)) - (spec (plist-get props property)) + (spec (get-text-property beg property s)) (value (pcase property (`invisible - ;; If `invisible' property in PROPS means text is to - ;; be invisible, return 0. Otherwise return nil so - ;; as to resume search. + ;; If `invisible' property means text is to be + ;; invisible, return 0. Otherwise return nil so as + ;; to resume search. (and (or (eq t buffer-invisibility-spec) (assoc-string spec buffer-invisibility-spec)) 0)) -- 2.35.1 -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH v2 34/38] org-link-make-string: Throw error when both LINK and DESCRIPTION are empty 2022-04-20 13:23 ` [PATCH v2 00/38] Final call for comments: " Ihor Radchenko ` (32 preceding siblings ...) 2022-04-20 13:28 ` [PATCH v2 33/38] org--string-from-props: Fix handling folds in Emacs <28 Ihor Radchenko @ 2022-04-20 13:28 ` Ihor Radchenko 2022-04-20 13:28 ` [PATCH v2 35/38] test-ol/org-toggle-link-display: Fix compatibility with old Emacs Ihor Radchenko ` (7 subsequent siblings) 41 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-04-20 13:28 UTC (permalink / raw) To: emacs-orgmode This behaviour is expected according to `test-ol/make-string'. --- lisp/ol.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/ol.el b/lisp/ol.el index 86f55d7cf..22eaae8fb 100644 --- a/lisp/ol.el +++ b/lisp/ol.el @@ -999,7 +999,9 @@ (defun org-link-make-string (link &optional description) (replace-regexp-in-string "]\\'" (concat "\\&" zero-width-space) (org-trim description)))))) - (if (not (org-string-nw-p link)) description + (if (not (org-string-nw-p link)) + (or description + (error "Empty link")) (format "[[%s]%s]" (org-link-escape link) (if description (format "[%s]" description) ""))))) -- 2.35.1 -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH v2 35/38] test-ol/org-toggle-link-display: Fix compatibility with old Emacs 2022-04-20 13:23 ` [PATCH v2 00/38] Final call for comments: " Ihor Radchenko ` (33 preceding siblings ...) 2022-04-20 13:28 ` [PATCH v2 34/38] org-link-make-string: Throw error when both LINK and DESCRIPTION are empty Ihor Radchenko @ 2022-04-20 13:28 ` Ihor Radchenko 2022-04-20 13:28 ` [PATCH v2 36/38] org-macs.el: Fix fontification checks take 2--- Ihor Radchenko ` (6 subsequent siblings) 41 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-04-20 13:28 UTC (permalink / raw) To: emacs-orgmode * testing/lisp/test-ol.el (test-ol/org-toggle-link-display): Use back-compatible `org-xor' instead of `xor'. --- testing/lisp/test-ol.el | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/testing/lisp/test-ol.el b/testing/lisp/test-ol.el index 343631623..429bb52ee 100644 --- a/testing/lisp/test-ol.el +++ b/testing/lisp/test-ol.el @@ -59,19 +59,19 @@ (ert-deftest test-ol/org-toggle-link-display () (dotimes (_ 2) (goto-char 1) (re-search-forward "\\[") - (should-not (xor org-link-descriptive (org-invisible-p))) + (should-not (org-xor org-link-descriptive (org-invisible-p))) (re-search-forward "example") - (should-not (xor org-link-descriptive (org-invisible-p))) + (should-not (org-xor org-link-descriptive (org-invisible-p))) (re-search-forward "com") - (should-not (xor org-link-descriptive (org-invisible-p))) + (should-not (org-xor org-link-descriptive (org-invisible-p))) (re-search-forward "]") - (should-not (xor org-link-descriptive (org-invisible-p))) + (should-not (org-xor org-link-descriptive (org-invisible-p))) (re-search-forward "\\[") (should-not (org-invisible-p)) (re-search-forward "link") (should-not (org-invisible-p)) (re-search-forward "]") - (should-not (xor org-link-descriptive (org-invisible-p))) + (should-not (org-xor org-link-descriptive (org-invisible-p))) (org-toggle-link-display))))) \f -- 2.35.1 -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH v2 36/38] org-macs.el: Fix fontification checks take 2--- 2022-04-20 13:23 ` [PATCH v2 00/38] Final call for comments: " Ihor Radchenko ` (34 preceding siblings ...) 2022-04-20 13:28 ` [PATCH v2 35/38] test-ol/org-toggle-link-display: Fix compatibility with old Emacs Ihor Radchenko @ 2022-04-20 13:28 ` Ihor Radchenko 2022-04-20 13:28 ` [PATCH v2 37/38] org-fold-core-fontify-region: Fix cases when fontification is not registered Ihor Radchenko ` (5 subsequent siblings) 41 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-04-20 13:28 UTC (permalink / raw) To: emacs-orgmode --- lisp/org-macs.el | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/lisp/org-macs.el b/lisp/org-macs.el index c71bb4094..9e24e315a 100644 --- a/lisp/org-macs.el +++ b/lisp/org-macs.el @@ -1192,7 +1192,8 @@ (defun org-buffer-substring-fontified (beg end) "Return fontified region between BEG and END." (when (bound-and-true-p jit-lock-mode) (org-with-forced-fontification - (when (text-property-not-all beg end 'org-fold-core-fontified t) + (when (or (text-property-not-all beg end 'org-fold-core-fontified t) + (text-property-not-all beg end 'fontified t)) (save-match-data (font-lock-fontify-region beg end))))) (buffer-substring beg end)) @@ -1201,9 +1202,12 @@ (defun org-looking-at-fontified (re) (prog1 (looking-at re) (when (bound-and-true-p jit-lock-mode) (org-with-forced-fontification - (when (text-property-not-all - (match-beginning 0) (match-end 0) - 'org-fold-core-fontified t) + (when (or (text-property-not-all + (match-beginning 0) (match-end 0) + 'org-fold-core-fontified t) + (text-property-not-all + (match-beginning 0) (match-end 0) + 'fontified t)) (save-match-data (font-lock-fontify-region (match-beginning 0) (match-end 0)))))))) -- 2.35.1 -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH v2 37/38] org-fold-core-fontify-region: Fix cases when fontification is not registered 2022-04-20 13:23 ` [PATCH v2 00/38] Final call for comments: " Ihor Radchenko ` (35 preceding siblings ...) 2022-04-20 13:28 ` [PATCH v2 36/38] org-macs.el: Fix fontification checks take 2--- Ihor Radchenko @ 2022-04-20 13:28 ` Ihor Radchenko 2022-04-20 13:28 ` [PATCH v2 38/38] org-agenda.el: Re-enable native compilation* lisp/org-agenda.el: Re-enable native compilation as it does not Ihor Radchenko ` (4 subsequent siblings) 41 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-04-20 13:28 UTC (permalink / raw) To: emacs-orgmode * lisp/org-fold-core.el (org-fold-core-fontify-region): Handle FORCE argument better. Skip unnecessary code parts when FORCE is non-nil. Assign `fontified' text property manually in the actually fontified regions. We cannot just supply correct return value since jit-lock does not allow piecewise fontification. --- lisp/org-fold-core.el | 51 +++++++++++++++++++++++-------------------- 1 file changed, 27 insertions(+), 24 deletions(-) diff --git a/lisp/org-fold-core.el b/lisp/org-fold-core.el index edae316ff..d98eb6358 100644 --- a/lisp/org-fold-core.el +++ b/lisp/org-fold-core.el @@ -1436,40 +1436,43 @@ (defvar org-fold-core--force-fontification nil (defun org-fold-core-fontify-region (beg end loudly &optional force) "Run `font-lock-default-fontify-region' in visible regions." (with-silent-modifications - (let ((pos beg) next - (force (or force org-fold-core--force-fontification)) - (org-fold-core--fontifying t) - (skip-specs - (let (result) - (dolist (spec (org-fold-core-folding-spec-list)) - (when (and (not (org-fold-core-get-folding-spec-property spec :visible)) - (org-fold-core-get-folding-spec-property spec :font-lock-skip)) - (push spec result))) - result))) + (let* ((pos beg) next + (force (or force org-fold-core--force-fontification)) + (org-fold-core--fontifying t) + (skip-specs + (unless force + (let (result) + (dolist (spec (org-fold-core-folding-spec-list)) + (when (and (not (org-fold-core-get-folding-spec-property spec :visible)) + (org-fold-core-get-folding-spec-property spec :font-lock-skip)) + (push spec result))) + result)))) ;; Move POS to first visible point within BEG..END. - (while (and (catch :found - (dolist (spec (org-fold-core-get-folding-spec 'all pos)) - (when (org-fold-core-get-folding-spec-property spec :font-lock-skip) - (throw :found spec)))) - (< pos end)) - (setq pos (org-fold-core-next-folding-state-change nil pos end))) + (unless force + (while (and (catch :found + (dolist (spec (org-fold-core-get-folding-spec 'all pos)) + (when (org-fold-core-get-folding-spec-property spec :font-lock-skip) + (throw :found spec)))) + (< pos end)) + (setq pos (org-fold-core-next-folding-state-change nil pos end)))) (when force (setq pos beg next end)) (while (< pos end) (unless force - (setq next (org-fold-core-next-folding-state-change skip-specs pos end))) - ;; Move to the end of the region to be fontified. - (while (and (not (catch :found - (dolist (spec (org-fold-core-get-folding-spec 'all next)) - (when (org-fold-core-get-folding-spec-property spec :font-lock-skip) - (throw :found spec))))) - (< next end)) - (setq next (org-fold-core-next-folding-state-change nil next end))) + (setq next (org-fold-core-next-folding-state-change skip-specs pos end)) + ;; Move to the end of the region to be fontified. + (while (and (not (catch :found + (dolist (spec (org-fold-core-get-folding-spec 'all next)) + (when (org-fold-core-get-folding-spec-property spec :font-lock-skip) + (throw :found spec))))) + (< next end)) + (setq next (org-fold-core-next-folding-state-change nil next end)))) (save-excursion (font-lock-default-fontify-region pos next loudly) (save-match-data (unless (<= pos (point) next) (run-hook-with-args 'org-fold-core-first-unfold-functions pos next)))) (put-text-property pos next 'org-fold-core-fontified t) + (put-text-property pos next 'fontified t) (setq pos next))))) (defun org-fold-core-update-optimisation (beg end) -- 2.35.1 -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply related [flat|nested] 192+ messages in thread
* [PATCH v2 38/38] org-agenda.el: Re-enable native compilation* lisp/org-agenda.el: Re-enable native compilation as it does not 2022-04-20 13:23 ` [PATCH v2 00/38] Final call for comments: " Ihor Radchenko ` (36 preceding siblings ...) 2022-04-20 13:28 ` [PATCH v2 37/38] org-fold-core-fontify-region: Fix cases when fontification is not registered Ihor Radchenko @ 2022-04-20 13:28 ` Ihor Radchenko 2022-04-20 14:47 ` [PATCH v2 00/38] Final call for comments: Merge org-fold feature branch Bastien ` (3 subsequent siblings) 41 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-04-20 13:28 UTC (permalink / raw) To: emacs-orgmode * lisp/org-agenda.el: Re-enable native compilation as it does not cause any issues with agenda rendering without other custom changes not included in this branch. --- lisp/org-agenda.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index 6aed778f0..b817f1f04 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -1,4 +1,4 @@ -;;; org-agenda.el --- Dynamic task and appointment lists for Org -*- lexical-binding: t; no-native-compile: t; -*- +;;; org-agenda.el --- Dynamic task and appointment lists for Org -*- lexical-binding: t; -*- ;; Copyright (C) 2004-2022 Free Software Foundation, Inc. -- 2.35.1 -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg ^ permalink raw reply related [flat|nested] 192+ messages in thread
* Re: [PATCH v2 00/38] Final call for comments: Merge org-fold feature branch 2022-04-20 13:23 ` [PATCH v2 00/38] Final call for comments: " Ihor Radchenko ` (37 preceding siblings ...) 2022-04-20 13:28 ` [PATCH v2 38/38] org-agenda.el: Re-enable native compilation* lisp/org-agenda.el: Re-enable native compilation as it does not Ihor Radchenko @ 2022-04-20 14:47 ` Bastien 2022-04-20 15:38 ` Ihor Radchenko 2022-04-22 18:54 ` Kévin Le Gouguec ` (2 subsequent siblings) 41 siblings, 1 reply; 192+ messages in thread From: Bastien @ 2022-04-20 14:47 UTC (permalink / raw) To: Ihor Radchenko; +Cc: emacs-orgmode Hi Ihor, thanks for your work on this. Ihor Radchenko <yantar92@gmail.com> writes: > This is the final version of the patch. I am going to merge it this > weekend. If there are any comments, please send them ASAP. One glitch: in an agenda view with an agenda item that has a link, changing the todo state will make all parts of the link visible. Let me know if you need a more detail recipe to reproduce the bug. -- Bastien ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [PATCH v2 00/38] Final call for comments: Merge org-fold feature branch 2022-04-20 14:47 ` [PATCH v2 00/38] Final call for comments: Merge org-fold feature branch Bastien @ 2022-04-20 15:38 ` Ihor Radchenko 2022-04-20 16:22 ` Bastien 0 siblings, 1 reply; 192+ messages in thread From: Ihor Radchenko @ 2022-04-20 15:38 UTC (permalink / raw) To: Bastien; +Cc: emacs-orgmode Bastien <bzg@gnu.org> writes: > One glitch: in an agenda view with an agenda item that has a link, > changing the todo state will make all parts of the link visible. > > Let me know if you need a more detail recipe to reproduce the bug. Recipe would be helpftul. I was unable to reproduce using * TODO this is test [[https://orgmode.org][org]] SCHEDULED: <2022-04-20 Wed> Best, Ihor ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [PATCH v2 00/38] Final call for comments: Merge org-fold feature branch 2022-04-20 15:38 ` Ihor Radchenko @ 2022-04-20 16:22 ` Bastien 2022-04-21 6:01 ` Ihor Radchenko 0 siblings, 1 reply; 192+ messages in thread From: Bastien @ 2022-04-20 16:22 UTC (permalink / raw) To: Ihor Radchenko; +Cc: emacs-orgmode Ihor Radchenko <yantar92@gmail.com> writes: > Bastien <bzg@gnu.org> writes: > >> One glitch: in an agenda view with an agenda item that has a link, >> changing the todo state will make all parts of the link visible. >> >> Let me know if you need a more detail recipe to reproduce the bug. > > Recipe would be helpftul. I was unable to reproduce using I'm on commit e0abbbacf9427b69482c6c47c3ea0975b0e6fa6d from the feature/org-fold-universal-core branch of your org repo. Using Emacs 29.0.50 and this as the content for ~/test.org: * TODO [[https://orgmode.org][test]] SCHEDULED: <2022-04-20 mer.> Then run: - emacs -q - C-x C-f test.org - M-x org-agenda RET - < a . n t You should see the link losing its invisibility specs. -- Bastien ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [PATCH v2 00/38] Final call for comments: Merge org-fold feature branch 2022-04-20 16:22 ` Bastien @ 2022-04-21 6:01 ` Ihor Radchenko 2022-04-21 6:55 ` Bastien 0 siblings, 1 reply; 192+ messages in thread From: Ihor Radchenko @ 2022-04-21 6:01 UTC (permalink / raw) To: Bastien; +Cc: emacs-orgmode Bastien <bzg@gnu.org> writes: > I'm on commit e0abbbacf9427b69482c6c47c3ea0975b0e6fa6d from the > feature/org-fold-universal-core branch of your org repo. > > Using Emacs 29.0.50 and this as the content for ~/test.org: > > * TODO [[https://orgmode.org][test]] > SCHEDULED: <2022-04-20 mer.> > > Then run: > > - emacs -q > - C-x C-f test.org > - M-x org-agenda RET > - < a . n t > > You should see the link losing its invisibility specs. I did see it in fork/feature/org-fold-universal-core and it is very strange. The properties are suddenly lost after running add-text-properties and things become normal if I simply move add-text-properties above org-fold-region in org-activate-links--text-properties. What is more strange, the actual patch I proposed (fork/feature/org-fold-universal-core-tidy) does not have the problem. At least, I cannot reproduce it with you recipe. And the patch have exactly same org-activate-links--text-properties... Since the actual patch does not have the problem, I'd prefer to ignore this problem unless it appears again after merging. Best, Ihor ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [PATCH v2 00/38] Final call for comments: Merge org-fold feature branch 2022-04-21 6:01 ` Ihor Radchenko @ 2022-04-21 6:55 ` Bastien 2022-04-21 9:27 ` Ihor Radchenko 0 siblings, 1 reply; 192+ messages in thread From: Bastien @ 2022-04-21 6:55 UTC (permalink / raw) To: Ihor Radchenko; +Cc: emacs-orgmode Hi Ihor, thanks for double-checking this. Ihor Radchenko <yantar92@gmail.com> writes: > Since the actual patch does not have the problem, I'd prefer to ignore > this problem unless it appears again after merging. Sure - can you point the exact branch/commit I should test for the version that will be merged? -- Bastien ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [PATCH v2 00/38] Final call for comments: Merge org-fold feature branch 2022-04-21 6:55 ` Bastien @ 2022-04-21 9:27 ` Ihor Radchenko 2022-04-21 9:43 ` Bastien 0 siblings, 1 reply; 192+ messages in thread From: Ihor Radchenko @ 2022-04-21 9:27 UTC (permalink / raw) To: Bastien; +Cc: emacs-orgmode Bastien <bzg@gnu.org> writes: >> Since the actual patch does not have the problem, I'd prefer to ignore >> this problem unless it appears again after merging. > > Sure - can you point the exact branch/commit I should test for the > version that will be merged? https://github.com/yantar92/org/tree/feature/org-fold-universal-core-tidy ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [PATCH v2 00/38] Final call for comments: Merge org-fold feature branch 2022-04-21 9:27 ` Ihor Radchenko @ 2022-04-21 9:43 ` Bastien 0 siblings, 0 replies; 192+ messages in thread From: Bastien @ 2022-04-21 9:43 UTC (permalink / raw) To: Ihor Radchenko; +Cc: emacs-orgmode Ihor Radchenko <yantar92@gmail.com> writes: > https://github.com/yantar92/org/tree/feature/org-fold-universal-core-tidy Thanks -- I confirm the bug I reported is not present in this branch. -- Bastien ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [PATCH v2 00/38] Final call for comments: Merge org-fold feature branch 2022-04-20 13:23 ` [PATCH v2 00/38] Final call for comments: " Ihor Radchenko ` (38 preceding siblings ...) 2022-04-20 14:47 ` [PATCH v2 00/38] Final call for comments: Merge org-fold feature branch Bastien @ 2022-04-22 18:54 ` Kévin Le Gouguec 2022-04-25 11:44 ` Ihor Radchenko 2022-04-25 11:45 ` Ihor Radchenko 2022-05-03 4:44 ` [ISSUE] org-fold does not support auto-reveal for some external package commands Christopher M. Miles [not found] ` <6270b43a.1c69fb81.835d4.54a6SMTPIN_ADDED_BROKEN@mx.google.com> 41 siblings, 2 replies; 192+ messages in thread From: Kévin Le Gouguec @ 2022-04-22 18:54 UTC (permalink / raw) To: Ihor Radchenko; +Cc: emacs-orgmode [-- Attachment #1: Type: text/plain, Size: 1695 bytes --] Hey Ihor! Ihor Radchenko <yantar92@gmail.com> writes: > This is the final version of the patch. I am going to merge it this > weekend. If there are any comments, please send them ASAP. I've thrown a couple of LOGBOOK-heavy Org files at your branch; I'm observing something that I can't make sense of. I tried to condense one of these files into a small reproducer, see attached file; couldn't find the time to make it smaller, sorry! My recipe (based on commit f9dd109bc, Emacs 29.0.50 commit 864c8013fd): $ git switch feature/org-fold-universal-core-tidy $ make autoloads $ emacs -Q -L lisp -eval "(setq org-startup-folded t)" repro.org Restarting Emacs with the above between each step: (1) C-s abc ⇒ no logbook is unfolded, (2) C-s def ⇒ no logbook is unfolded, (3) C-s ghi ⇒ some logbooks are unfolded. Assuming you can reproduce: is it expected that logbooks are expanded in case (3)? I don't see what's "conceptually" different in situation (3) vs. (1) and (2), so I'm puzzled to get different results. Also, a bit of idle curiosity: > (defun org-fold--isearch-reveal (&rest _) > "Reveal text at POS found by isearch." > (org-fold-show-set-visibility 'isearch)) org-fold-show-set-visibility calls either org-fold-show-set-visibility--overlays, or org-fold-show-set-visibility--text-properties, and AFAICT neither of these handle 'isearch as an argument… Is there a (cdr (assq 'isearch org-fold-show-context-detail)) missing? (This comes from a very cursory reading of the code; apologies if I've missed something) Other than this logbook oddity, I haven't found anything concerning. Thanks for your efforts! [-- Attachment #2: repro.org --] [-- Type: text/org, Size: 5165 bytes --] * xxxxxxxxxxx xxxx :LOGBOOK: CLOCK: [2021-11-02 Tue 17:18]--[2021-11-02 Tue 17:25] => 0:07 :END: ** xxx xxx xxxxx *** xxxx [[xxxx:xxxxxxx/xxxxxxxxxx/xxxxxxxxxxxxxxxxx]] :LOGBOOK: CLOCK: [2021-11-03 Wed 13:51]--[2021-11-03 Wed 14:13] => 0:22 CLOCK: [2021-11-03 Wed 11:52]--[2021-11-03 Wed 12:00] => 0:08 CLOCK: [2021-11-03 Wed 11:27]--[2021-11-03 Wed 11:42] => 0:15 CLOCK: [2021-11-03 Wed 09:06]--[2021-11-03 Wed 10:04] => 0:58 CLOCK: [2021-11-02 Tue 18:11]--[2021-11-02 Tue 18:45] => 0:34 CLOCK: [2021-11-02 Tue 17:36]--[2021-11-02 Tue 17:38] => 0:02 CLOCK: [2021-11-02 Tue 17:25]--[2021-11-02 Tue 17:31] => 0:06 :END: - [ ] xxxxx://xxxx.xx.xxxxxxx.xxx/xxxxxxx/xxxx xxxx? (xxxx.xx xxxxx xx xxxxxxx) - 🙌 - "xxxxxxx abc xxx xxxxxxxx xxxxxxxxxx" **** [[xxxxx://xxxxxxxx.xxxxxxx.xxx/xxx/#/xxxxxxxxxxx/][xxx xxxxxxx xxxx xxxxxxxxxxx]] **** [[xxxxx://xxxx.xxxxxxx.xxx/xxxxxxx/xxxxxxxxxx/xxxxxxxxxxxxxxxxx#xxxxx-xxx-xxxxxx-xxxxxx][xxxxx xxx xxxxxx xxxxxx]] **** [[xxxxx://xxxx.xxxxxxx.xxx/xxxxxxx/xxxxxxxxxx/xxxxxxxxxxxxxxxxx#xxxxxx-xxxxxxxxxx][xxxxxx xxxxxxxxxx]] - def xxxxxxxxxx: - x (xxxxxxxx) - x (xxxxxxxx) **** [[xxxxx://xxxx.xxxxxxx.xxx/xxxxxxx/xxxxxxxxxx/xxxxxxxxxxxxxxxxx#xxxx-xxxx-xxx-xxxxxxx-xxxxx][xxxxxxx xxxxxxxxxxx]] xxxxxx xx xxx xx xxxxxxxxxxx xxxxxxx? ⇒ xxxxxxx-xxxxxxxxxxxx@xxxxxxx.xxx **** [[xxxx:xxxxxxxxxxxx]] xxxxxxxx: ~xxxxxxx.xxxx.xxx:/xxxxxxx/xxxx-xxxx~ *** xxxx [[xxxxx://xxxx.xxxxxx.xxx/xxxxxxxx/x/xxxxxxxxxxxxxxxxxxx-xxxxxxxxxxxxxxxxxxxxxxxx/xxxx][xxxxxxxxxx xxxxxxx]] :LOGBOOK: CLOCK: [2021-11-03 Wed 15:13]--[2021-11-03 Wed 15:14] => 0:01 CLOCK: [2021-11-03 Wed 14:55]--[2021-11-03 Wed 14:57] => 0:02 :END: *** xxxx [[xxxxx://xxxx.xxxxxx.xxx/xxxxxxxx/x/xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx/xxxx][xxxx xxx xx xx xxx xxx]] :LOGBOOK: CLOCK: [2021-11-03 Wed 15:14]--[2021-11-03 Wed 15:17] => 0:03 :END: *** xxxx [[xxxxx://xxxx.xxxxxx.xxx/xxxxxxxx/x/xxxxxxxxxxxxxxxxxxxxxxxxxx_xxxxxxxxxxxxxxxxx/xxxx][xxxxxx xx xxxxxxx xxxxxxx]] :LOGBOOK: CLOCK: [2021-11-03 Wed 16:00]--[2021-11-03 Wed 16:30] => 0:30 :END: *** xxxx [[xxxx:xxxxxxx/xxxxxxxxxxxx]] :LOGBOOK: CLOCK: [2021-11-05 Fri 11:02]--[2021-11-05 Fri 11:18] => 0:16 CLOCK: [2021-11-05 Fri 09:42]--[2021-11-05 Fri 09:55] => 0:13 CLOCK: [2021-11-04 Thu 18:30]--[2021-11-04 Thu 18:32] => 0:02 CLOCK: [2021-11-04 Thu 12:07]--[2021-11-04 Thu 12:14] => 0:07 CLOCK: [2021-11-04 Thu 11:10]--[2021-11-04 Thu 12:00] => 0:50 CLOCK: [2021-11-03 Wed 18:11]--[2021-11-03 Wed 18:20] => 0:09 :END: - xxxx :: xxxxxxx + xxxxxxxxxxxxxxxx - xxxxxx :: xxxx xxxxxxxx xx xxxxxxxx xxxxxxx - xxxxxxx xxx "xxxxxxxxxx": - xxxxx xx xx xxxxxxxxxxxxxxxx xxxx xxxxxxxxx - xxx xxxxxx xxx ∈ >x xxxxxxx - xxxx :: xxxxxx xxxxxx xxxxxxxx xxxxxxx + xxxxxxxxxxxxxxxx - xxxxxx xxxxxx xxxxxxxxx xxx xxxxxxxxx - xxxxxx xxxxxx xxxx xxxxxxxxxx - xxxxxxx :: xxxxx/xxxx/xxxxxx xxxxxxxxx - xxxxxxxx xxxxxxxx xxxxxx - 🙌 - [[xxxx:xxxxxxx/xxxxxxxxxxxx/xxxxxxxxxxx]] - "xxxx xxx xxxxxxxx: xx xxx xxxxx xxxxxxx xxxxxxxxxxx, xxxx xxxx xxxxxx xxxxx xxxxx xxxxxxxx" - "xx xxx xxxx xxxxxxxxxx xxxxx xxxx xx xxxx xxxxxxx" - [[xxxxx://xxxx.xxxxxx.xxx/xxxxxxxxxxxx/x/xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx/xxxx#xxx=xxxxxxxxx][xxxxxxx xxxxx xxxxxxxxxxx]] - "xxxx xxxxxxxxxxx xx xxxxxxxx xx xxxxxxxxx xxxxxxx xxxx xxxxxxxx xxxxx xxxxxxxxxxx" - [[xxxxx://xxx.xxxxxxx.xxx/xxxxxxx/xxxx-xx-xxxxxxx][xxxx xx xxxxxxx]] (xxxxx xxx <xxxxx/xx#xxxxxx xxxxxxxxxx xxxxxx>) *xxxxxxxx* : - xxxxx://xxxx.xxxxxxx.xxx/xxxxxxx/xxxxxxxxxxxx/x&x **** [[xxxxx://xxxx.xxxxxx.xxx/xxxxxxxx/x/xxxxxxxxxxxxxxxxxxxxxx-xxxxxxxxxxx_xxxxxxxxx/xxxx#][xxxxxx — xxxxxxxxxx xxx xxxxxxxxxxxx]] :LOGBOOK: CLOCK: [2021-11-05 Fri 09:55]--[2021-11-05 Fri 10:00] => 0:05 :END: **** [[xxxx:xxxxxxx/xxxxxxxxxxxx/xxxxx/xx]] :LOGBOOK: CLOCK: [2021-11-08 Mon 13:20]--[2021-11-08 Mon 13:21] => 0:01 CLOCK: [2021-11-05 Fri 11:02]--[2021-11-05 Fri 11:02] => 0:00 CLOCK: [2021-11-05 Fri 10:29]--[2021-11-05 Fri 10:45] => 0:16 CLOCK: [2021-11-05 Fri 10:00]--[2021-11-05 Fri 10:23] => 0:23 :END: *** xxxx [[xxxx:xxxxxxx/xxxxxxxxxx/xxx/xxxxxxx_xxxx/xxxxxxxxxxxxx][xxx xxxx xxxxxxx xxxxxx]] :LOGBOOK: CLOCK: [2021-11-05 Fri 15:25]--[2021-11-05 Fri 15:27] => 0:02 CLOCK: [2021-11-05 Fri 14:30]--[2021-11-05 Fri 14:47] => 0:17 CLOCK: [2021-11-05 Fri 13:47]--[2021-11-05 Fri 13:47] => 0:00 CLOCK: [2021-11-05 Fri 11:35]--[2021-11-05 Fri 11:37] => 0:02 CLOCK: [2021-11-05 Fri 11:18]--[2021-11-05 Fri 11:25] => 0:07 :END: **** [[xxxx:xxxxxxx/xxxxxxxxxx/xxx/xxxxxxx_xxxx/xxxxxxxxxxxxxx][xxxx xxxxxxxxxx]] :LOGBOOK: CLOCK: [2021-11-05 Fri 13:47]--[2021-11-05 Fri 14:30] => 0:43 :END: - 🤯 - [[xxxxx://xxxx.xxxxxx.xxx/xxxxxxxxxxxx/x/xxxxxxxxxxxxxxxxxxxxxxxx-xxxxxxxxxxxxxxxxxxx/xxxx#xxx=xxxxxxxxx][xxxxxxxxxxx xxxxxxxx & xxxx xxxxx]]: xxxxx xxxx xx xxx xxxxxxxxxxxx **** [[xxxxx://xxxx.xxxxxxx.xxx/xxxxxxx/xxxxxxxxxx/xxx/xxxxxxx_xxxx/xxxxxxxxxxxxxxxxx][xxxxxxx xxxxxxxxxx]] :LOGBOOK: CLOCK: [2021-11-05 Fri 14:47]--[2021-11-05 Fri 15:04] => 0:17 :END: - 👍 ghi xxxxxxxxxx & xxxxxxxxxx xxxx ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [PATCH v2 00/38] Final call for comments: Merge org-fold feature branch 2022-04-22 18:54 ` Kévin Le Gouguec @ 2022-04-25 11:44 ` Ihor Radchenko 2022-04-25 13:02 ` Bastien 2022-04-25 11:45 ` Ihor Radchenko 1 sibling, 1 reply; 192+ messages in thread From: Ihor Radchenko @ 2022-04-25 11:44 UTC (permalink / raw) To: Kévin Le Gouguec; +Cc: emacs-orgmode I think I addressed the raised issues. Just merged org-fold upstream. Kévin Le Gouguec <kevin.legouguec@gmail.com> writes: > My recipe (based on commit f9dd109bc, Emacs 29.0.50 commit 864c8013fd): > > $ git switch feature/org-fold-universal-core-tidy > $ make autoloads > $ emacs -Q -L lisp -eval "(setq org-startup-folded t)" repro.org > > Restarting Emacs with the above between each step: > > (1) C-s abc ⇒ no logbook is unfolded, > (2) C-s def ⇒ no logbook is unfolded, > (3) C-s ghi ⇒ some logbooks are unfolded. > > Assuming you can reproduce: is it expected that logbooks are expanded in > case (3)? I don't see what's "conceptually" different in situation (3) > vs. (1) and (2), so I'm puzzled to get different results. I had a hard time to reproduce your recipe because it was related to font-locking. The only way was increasing the font size, so that line widths were larger than the frame width. I believe I fixed the issue now. > Also, a bit of idle curiosity: > >> (defun org-fold--isearch-reveal (&rest _) >> "Reveal text at POS found by isearch." >> (org-fold-show-set-visibility 'isearch)) > > org-fold-show-set-visibility calls either > org-fold-show-set-visibility--overlays, or > org-fold-show-set-visibility--text-properties, and AFAICT neither of > these handle 'isearch as an argument… Is there a (cdr (assq 'isearch > org-fold-show-context-detail)) missing? > > (This comes from a very cursory reading of the code; apologies if I've > missed something) You are right. I supposed to use org-fold-show-context. Fixed now. Best, Ihor ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [PATCH v2 00/38] Final call for comments: Merge org-fold feature branch 2022-04-25 11:44 ` Ihor Radchenko @ 2022-04-25 13:02 ` Bastien 2022-04-25 13:25 ` Ihor Radchenko 0 siblings, 1 reply; 192+ messages in thread From: Bastien @ 2022-04-25 13:02 UTC (permalink / raw) To: Ihor Radchenko; +Cc: emacs-orgmode, Kévin Le Gouguec Hi Ihor, Ihor Radchenko <yantar92@gmail.com> writes: > I think I addressed the raised issues. > Just merged org-fold upstream. Great! Thanks again for the hard work and the merge. One glitch: when refiling an entry to a folded section, the section gets unfolded. Can you reproduce this? Let me know if you need a detailed recipe. -- Bastien ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [PATCH v2 00/38] Final call for comments: Merge org-fold feature branch 2022-04-25 13:02 ` Bastien @ 2022-04-25 13:25 ` Ihor Radchenko 2022-04-25 14:05 ` Bastien 0 siblings, 1 reply; 192+ messages in thread From: Ihor Radchenko @ 2022-04-25 13:25 UTC (permalink / raw) To: Bastien; +Cc: emacs-orgmode, Kévin Le Gouguec Bastien <bzg@gnu.org> writes: > Ihor Radchenko <yantar92@gmail.com> writes: > >> I think I addressed the raised issues. >> Just merged org-fold upstream. > > Great! Thanks again for the hard work and the merge. > > One glitch: when refiling an entry to a folded section, the section > gets unfolded. > > Can you reproduce this? Let me know if you need a detailed recipe. Apparently I did it on purpose at some point when I was tuning the differences between Emacs handling of overlays and text properties. If I am correct about the cause, commenting out the org-fold-reveal' in org-refile should solve the problem. ;; (org-fold-reveal) (org-paste-subtree level nil nil t) If you confirm, I can just remove the call to `org-fold-reveal'. Best, Ihor ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [PATCH v2 00/38] Final call for comments: Merge org-fold feature branch 2022-04-25 13:25 ` Ihor Radchenko @ 2022-04-25 14:05 ` Bastien 2022-04-26 11:48 ` Ihor Radchenko 0 siblings, 1 reply; 192+ messages in thread From: Bastien @ 2022-04-25 14:05 UTC (permalink / raw) To: Ihor Radchenko; +Cc: emacs-orgmode, Kévin Le Gouguec Ihor Radchenko <yantar92@gmail.com> writes: > If you confirm, I can just remove the call to `org-fold-reveal'. Yes, I do confirm -- thanks for the quick feedback. -- Bastien ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [PATCH v2 00/38] Final call for comments: Merge org-fold feature branch 2022-04-25 14:05 ` Bastien @ 2022-04-26 11:48 ` Ihor Radchenko 0 siblings, 0 replies; 192+ messages in thread From: Ihor Radchenko @ 2022-04-26 11:48 UTC (permalink / raw) To: Bastien; +Cc: emacs-orgmode, Kévin Le Gouguec Bastien <bzg@gnu.org> writes: > Ihor Radchenko <yantar92@gmail.com> writes: > >> If you confirm, I can just remove the call to `org-fold-reveal'. > > Yes, I do confirm -- thanks for the quick feedback. Fixed in 4280762e4. Best, Ihor ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [PATCH v2 00/38] Final call for comments: Merge org-fold feature branch 2022-04-22 18:54 ` Kévin Le Gouguec 2022-04-25 11:44 ` Ihor Radchenko @ 2022-04-25 11:45 ` Ihor Radchenko 2022-04-26 6:10 ` Kévin Le Gouguec 1 sibling, 1 reply; 192+ messages in thread From: Ihor Radchenko @ 2022-04-25 11:45 UTC (permalink / raw) To: Kévin Le Gouguec; +Cc: emacs-orgmode I think I addressed the raised issues. Just merged org-fold upstream. Kévin Le Gouguec <kevin.legouguec@gmail.com> writes: > My recipe (based on commit f9dd109bc, Emacs 29.0.50 commit 864c8013fd): > > $ git switch feature/org-fold-universal-core-tidy > $ make autoloads > $ emacs -Q -L lisp -eval "(setq org-startup-folded t)" repro.org > > Restarting Emacs with the above between each step: > > (1) C-s abc ⇒ no logbook is unfolded, > (2) C-s def ⇒ no logbook is unfolded, > (3) C-s ghi ⇒ some logbooks are unfolded. > > Assuming you can reproduce: is it expected that logbooks are expanded in > case (3)? I don't see what's "conceptually" different in situation (3) > vs. (1) and (2), so I'm puzzled to get different results. I had a hard time to reproduce your recipe because it was related to font-locking. The only way was increasing the font size, so that line widths were larger than the frame width. I believe I fixed the issue now. > Also, a bit of idle curiosity: > >> (defun org-fold--isearch-reveal (&rest _) >> "Reveal text at POS found by isearch." >> (org-fold-show-set-visibility 'isearch)) > > org-fold-show-set-visibility calls either > org-fold-show-set-visibility--overlays, or > org-fold-show-set-visibility--text-properties, and AFAICT neither of > these handle 'isearch as an argument… Is there a (cdr (assq 'isearch > org-fold-show-context-detail)) missing? > > (This comes from a very cursory reading of the code; apologies if I've > missed something) You are right. I supposed to use org-fold-show-context. Fixed now. Best, Ihor ^ permalink raw reply [flat|nested] 192+ messages in thread
* Re: [PATCH v2 00/38] Final call for comments: Merge org-fold feature branch 2022-04-25 11:45 ` Ihor Radchenko @ 2022-04-26 6:10 ` Kévin Le Gouguec 0 siblings, 0 replies; 192+ messages in thread From: Kévin Le Gouguec @ 2022-04-26 6:10 UTC (permalink / raw) To: Ihor Radchenko; +Cc: emacs-orgmode Ihor Radchenko <yantar92@gmail.com> writes: > I think I addressed the raised issues. > Just merged org-fold upstream. 👏 > Kévin Le Gouguec <kevin.legouguec@gmail.com> writes: > >> My recipe (based on commit f9dd109bc, Emacs 29.0.50 commit 864c8013fd): >> >> $ git switch feature/org-fold-universal-core-tidy >> $ make autoloads >> $ emacs -Q -L lisp -eval "(setq org-startup-folded t)" repro.org >> >> Restarting Emacs with the above between each step: >> >> (1) C-s abc ⇒ no logbook is unfolded, >> (2) C-s def ⇒ no logbook is unfolded, >> (3) C-s ghi ⇒ some logbooks are unfolded. >> >> Assuming you can reproduce: is it expected that logbooks are expanded in >> case (3)? I don't see what's "conceptually" different in situation (3) >> vs. (1) and (2), so I'm puzzled to get different results. > > I had a hard time to reproduce your recipe because it was related to > font-locking. The only way was increasing the font size, so that line > widths were larger than the frame width. Huh! Interesting; here I could trigger the bug with all lines fitting comfortably within the frame width; the longest is 70 columns long (line 69). ((frame-width) is 80; M-x describe-char says "DejaVu Sans Mono" 15) Anyway, thanks for your patience! font-lock problems are no joke 😕 > I believe I fixed the issue now. Seems fixed to me! ^ permalink raw reply [flat|nested] 192+ messages in thread
* [ISSUE] org-fold does not support auto-reveal for some external package commands 2022-04-20 13:23 ` [PATCH v2 00/38] Final call for comments: " Ihor Radchenko ` (39 preceding siblings ...) 2022-04-22 18:54 ` Kévin Le Gouguec @ 2022-05-03 4:44 ` Christopher M. Miles [not found] ` <6270b43a.1c69fb81.835d4.54a6SMTPIN_ADDED_BROKEN@mx.google.com> 41 siblings, 0 replies; 192+ messages in thread From: Christopher M. Miles @ 2022-05-03 4:44 UTC (permalink / raw) To: Ihor Radchenko; +Cc: emacs-orgmode [-- Attachment #1: Type: text/plain, Size: 1105 bytes --] I'm using package "consult" which has command "consult-org-heading" to search org headlines. It will auto jump to the selected headline and expand the jumped headline. After using org-fold, it does not auto jump to the headline now. The previous discussion here as reference https://github.com/minad/consult/issues/563. As @minad mentioned we need to wait for org-fold provide an official API to reveal content. Hope this can be added to org-fold plan. Ihor Radchenko <yantar92@gmail.com> writes: > This is the final version of the patch. I am going to merge it this > weekend. If there are any comments, please send them ASAP. > > This version is basically the same as previous, but (1) Rebased onto > current main; (2) org-agenda.el can be native compiled; (3) Fixed some > edge cases with fontification. > > Best, > Ihor -- [ stardiviner ] I try to make every word tell the meaning that I want to express. Blog: https://stardiviner.github.io/ IRC(freenode): stardiviner, Matrix: stardiviner GPG: F09F650D7D674819892591401B5DF1C95AE89AC3 [-- Attachment #2: signature.asc --] [-- Type: application/pgp-signature, Size: 487 bytes --] ^ permalink raw reply [flat|nested] 192+ messages in thread
[parent not found: <6270b43a.1c69fb81.835d4.54a6SMTPIN_ADDED_BROKEN@mx.google.com>]
* Re: [ISSUE] org-fold does not support auto-reveal for some external package commands [not found] ` <6270b43a.1c69fb81.835d4.54a6SMTPIN_ADDED_BROKEN@mx.google.com> @ 2022-05-03 6:33 ` Ihor Radchenko 2022-05-03 10:19 ` [DONE] " Christopher M. Miles 0 siblings, 1 reply; 192+ messages in thread From: Ihor Radchenko @ 2022-05-03 6:33 UTC (permalink / raw) To: numbchild; +Cc: emacs-orgmode "Christopher M. Miles" <numbchild@gmail.com> writes: > I'm using package "consult" which has command "consult-org-heading" to search org headlines. It will > auto jump to the selected headline and expand the jumped headline. After using org-fold, it does not > auto jump to the headline now. > > The previous discussion here as reference https://github.com/minad/consult/issues/563. > > As @minad mentioned we need to wait for org-fold provide an official API to reveal content. Hope > this can be added to org-fold plan. I reviewed the available API and realized that Org actually does provide sufficient functionality to reveal search matches temporarily. (there was a bug in that area, but I already fixed it) The basic idea is demonstrated in a simple function below: (defun test (pos) (interactive "nEnter point to be revealed: ") (read-char "Revealing point temporarily. Press any key...") (save-excursion (org-fold-save-outline-visibility nil (goto-char pos) (org-fold-show-set-visibility 'local) (read-char "About to restore the previous fold state. Press any key..."))) (read-char "Now, reveal the point permanently. Press any key...") (goto-char pos) (org-fold-show-set-visibility 'local)) Hope it helps. Best, Ihor ^ permalink raw reply [flat|nested] 192+ messages in thread
* [DONE] Re: [ISSUE] org-fold does not support auto-reveal for some external package commands 2022-05-03 6:33 ` Ihor Radchenko @ 2022-05-03 10:19 ` Christopher M. Miles 0 siblings, 0 replies; 192+ messages in thread From: Christopher M. Miles @ 2022-05-03 10:19 UTC (permalink / raw) To: Ihor Radchenko; +Cc: numbchild, emacs-orgmode [-- Attachment #1: Type: text/plain, Size: 1790 bytes --] Ihor Radchenko <yantar92@gmail.com> writes: > "Christopher M. Miles" <numbchild@gmail.com> writes: > >> I'm using package "consult" which has command "consult-org-heading" to search org headlines. It will >> auto jump to the selected headline and expand the jumped headline. After using org-fold, it does not >> auto jump to the headline now. >> >> The previous discussion here as reference https://github.com/minad/consult/issues/563. >> >> As @minad mentioned we need to wait for org-fold provide an official API to reveal content. Hope >> this can be added to org-fold plan. > > I reviewed the available API and realized that Org actually does provide > sufficient functionality to reveal search matches temporarily. (there > was a bug in that area, but I already fixed it) > > The basic idea is demonstrated in a simple function below: > > (defun test (pos) > (interactive "nEnter point to be revealed: ") > (read-char "Revealing point temporarily. Press any key...") > (save-excursion > (org-fold-save-outline-visibility nil > (goto-char pos) > (org-fold-show-set-visibility 'local) > (read-char "About to restore the previous fold state. Press any key..."))) > (read-char "Now, reveal the point permanently. Press any key...") > (goto-char pos) > (org-fold-show-set-visibility 'local)) > > Hope it helps. > > Best, > Ihor Interesting, I tested and confirmed this works good. Thanks for demonstrating. I will figure out consult-org-heading command part. -- [ stardiviner ] I try to make every word tell the meaning that I want to express. Blog: https://stardiviner.github.io/ IRC(freenode): stardiviner, Matrix: stardiviner GPG: F09F650D7D674819892591401B5DF1C95AE89AC3 [-- Attachment #2: signature.asc --] [-- Type: application/pgp-signature, Size: 487 bytes --] ^ permalink raw reply [flat|nested] 192+ messages in thread
end of thread, other threads:[~2022-05-28 3:12 UTC | newest] Thread overview: 192+ messages (download: mbox.gz follow: Atom feed -- links below jump to the message on this page -- 2020-04-24 6:55 [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers Ihor Radchenko 2020-04-24 8:02 ` Nicolas Goaziou 2020-04-25 0:29 ` stardiviner 2020-04-26 16:04 ` Ihor Radchenko 2020-05-04 16:56 ` Karl Voit 2020-05-07 7:18 ` Karl Voit 2020-05-09 15:43 ` Ihor Radchenko 2020-05-07 11:04 ` Christian Heinrich 2020-05-09 15:46 ` Ihor Radchenko 2020-05-08 16:38 ` Nicolas Goaziou 2020-05-09 13:58 ` Nicolas Goaziou 2020-05-09 16:22 ` Ihor Radchenko 2020-05-09 17:21 ` Nicolas Goaziou 2020-05-10 5:25 ` Ihor Radchenko 2020-05-10 9:47 ` Nicolas Goaziou 2020-05-10 13:29 ` Ihor Radchenko 2020-05-10 14:46 ` Nicolas Goaziou 2020-05-10 16:21 ` Ihor Radchenko 2020-05-10 16:38 ` Nicolas Goaziou 2020-05-10 17:08 ` Ihor Radchenko 2020-05-10 19:38 ` Nicolas Goaziou 2020-05-09 15:40 ` Ihor Radchenko 2020-05-09 16:30 ` Ihor Radchenko 2020-05-09 17:32 ` Nicolas Goaziou 2020-05-09 18:06 ` Ihor Radchenko 2020-05-10 14:59 ` Nicolas Goaziou 2020-05-10 15:15 ` Kyle Meyer 2020-05-10 16:30 ` Ihor Radchenko 2020-05-10 19:32 ` Nicolas Goaziou 2020-05-12 10:03 ` Nicolas Goaziou 2020-05-17 15:00 ` Ihor Radchenko 2020-05-17 15:40 ` Ihor Radchenko 2020-05-18 14:35 ` Nicolas Goaziou 2020-05-18 16:52 ` Ihor Radchenko 2020-05-19 13:07 ` Nicolas Goaziou 2020-05-23 13:52 ` Ihor Radchenko 2020-05-23 13:53 ` Ihor Radchenko 2020-05-23 15:26 ` Ihor Radchenko 2020-05-26 8:33 ` Nicolas Goaziou 2020-06-02 9:21 ` Ihor Radchenko 2020-06-02 9:23 ` Ihor Radchenko 2020-06-02 12:10 ` Bastien 2020-06-02 13:12 ` Ihor Radchenko 2020-06-02 13:23 ` Bastien 2020-06-02 13:30 ` Ihor Radchenko 2020-06-02 9:25 ` Ihor Radchenko 2020-06-05 7:26 ` Nicolas Goaziou 2020-06-05 8:18 ` Ihor Radchenko 2020-06-05 13:50 ` Nicolas Goaziou 2020-06-08 5:05 ` Ihor Radchenko 2020-06-08 5:06 ` Ihor Radchenko 2020-06-08 5:08 ` Ihor Radchenko 2020-06-10 17:14 ` Nicolas Goaziou 2020-06-21 9:52 ` Ihor Radchenko 2020-06-21 15:01 ` Nicolas Goaziou 2020-08-11 6:45 ` Ihor Radchenko 2020-08-11 23:07 ` Kyle Meyer 2020-08-12 6:29 ` Ihor Radchenko 2020-09-20 5:53 ` Ihor Radchenko 2020-09-20 11:45 ` Kévin Le Gouguec 2020-09-22 9:05 ` Ihor Radchenko 2020-09-22 10:00 ` Ihor Radchenko 2020-09-23 6:16 ` Kévin Le Gouguec 2020-09-23 6:48 ` Ihor Radchenko 2020-09-23 7:09 ` Bastien 2020-09-23 7:30 ` Ihor Radchenko 2020-09-24 18:07 ` Kévin Le Gouguec 2020-09-25 2:16 ` Ihor Radchenko 2020-12-15 17:38 ` [9.4] Fixing logbook visibility during isearch Kévin Le Gouguec 2020-12-16 3:15 ` Ihor Radchenko 2020-12-16 18:05 ` Kévin Le Gouguec 2020-12-17 3:18 ` Ihor Radchenko 2020-12-17 14:50 ` Kévin Le Gouguec 2020-12-18 2:23 ` Ihor Radchenko 2020-12-24 23:37 ` Kévin Le Gouguec 2020-12-25 2:51 ` Ihor Radchenko 2020-12-25 10:59 ` Kévin Le Gouguec 2020-12-25 12:32 ` Ihor Radchenko 2020-12-25 21:35 ` Kévin Le Gouguec 2020-12-26 4:14 ` Ihor Radchenko 2020-12-26 11:44 ` Kévin Le Gouguec 2020-12-26 12:22 ` Ihor Radchenko 2020-12-04 5:58 ` [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers Ihor Radchenko 2021-03-21 9:09 ` Ihor Radchenko 2021-05-03 17:28 ` Bastien 2021-09-21 13:32 ` Timothy 2021-10-26 17:25 ` Matt Price 2021-10-27 6:27 ` Ihor Radchenko 2022-01-29 11:37 ` [PATCH 00/35] Merge org-fold feature branch Ihor Radchenko 2022-01-29 11:37 ` [PATCH 01/35] Add org-fold-core: new folding engine Ihor Radchenko 2022-01-29 11:37 ` [PATCH 02/35] Separate folding functions from org.el into new library: org-fold Ihor Radchenko 2022-01-29 11:37 ` [PATCH 03/35] Separate cycling functions from org.el into new library: org-cycle Ihor Radchenko 2022-01-29 11:37 ` [PATCH 04/35] Remove functions from org.el that are now moved elsewhere Ihor Radchenko 2022-01-29 11:37 ` [PATCH 05/35] Disable native-comp in agenda Ihor Radchenko 2022-01-29 11:37 ` [PATCH 06/35] org-macs: New function org-find-text-property-region Ihor Radchenko 2022-01-29 11:37 ` [PATCH 07/35] org-at-heading-p: Accept optional argument Ihor Radchenko 2022-01-29 11:38 ` [PATCH 08/35] org-string-width: Reimplement to work with new folding Ihor Radchenko 2022-01-29 11:38 ` [PATCH 09/35] Rename old function call to use org-fold Ihor Radchenko 2022-01-29 11:38 ` [PATCH 10/35] Implement link folding Ihor Radchenko 2022-05-04 6:13 ` [BUG] 67275f4 broke evil-search " Tom Gillespie 2022-05-04 6:38 ` Ihor Radchenko 2022-05-28 2:17 ` Tom Gillespie 2022-05-28 2:37 ` Ihor Radchenko 2022-05-28 2:42 ` Tom Gillespie 2022-05-28 3:09 ` Ihor Radchenko 2022-05-28 3:11 ` Ihor Radchenko 2022-01-29 11:38 ` [PATCH 11/35] Implement overlay- and text-property-based versions of some functions Ihor Radchenko 2022-01-29 11:38 ` [PATCH 12/35] org-fold: Handle indirect buffer visibility Ihor Radchenko 2022-01-29 11:38 ` [PATCH 13/35] Fix subtle differences between overlays and invisible text properties Ihor Radchenko 2022-01-29 11:38 ` [PATCH 14/35] Support extra org-fold optimisations for huge buffers Ihor Radchenko 2022-01-29 11:38 ` [PATCH 15/35] Alias new org-fold functions to their old shorter names Ihor Radchenko 2022-01-29 11:38 ` [PATCH 16/35] Obsolete old function names that are now in org-fold Ihor Radchenko 2022-01-29 11:38 ` [PATCH 17/35] org-compat: Work around some third-party packages using outline-* functions Ihor Radchenko 2022-01-29 11:38 ` [PATCH 18/35] Move `org-buffer-list' to org-macs.el Ihor Radchenko 2022-01-29 11:38 ` [PATCH 19/35] Restore old visibility behaviour of org-refile Ihor Radchenko 2022-01-29 11:38 ` [PATCH 20/35] Add org-fold-related tests Ihor Radchenko 2022-01-29 11:38 ` [PATCH 21/35] org-manual: Update to new org-fold function names Ihor Radchenko 2022-01-29 11:38 ` [PATCH 22/35] ORG-NEWS: Add list of changes Ihor Radchenko 2022-01-29 20:31 ` New folding backend & outline (was: [PATCH 22/35] ORG-NEWS: Add list of changes) Kévin Le Gouguec 2022-01-30 2:15 ` Ihor Radchenko 2022-01-29 11:38 ` [PATCH 23/35] Backport contributed commits Ihor Radchenko 2022-01-29 11:38 ` [PATCH 24/35] Fix typo: delete-duplicates → delete-dups Ihor Radchenko 2022-01-29 11:38 ` [PATCH 25/35] Fix bug in org-get-heading Ihor Radchenko 2022-01-29 11:38 ` [PATCH 26/35] Rename remaining org-force-cycle-archived → org-cycle-force-archived Ihor Radchenko 2022-01-29 11:38 ` [PATCH 27/35] Fix org-fold--hide-drawers--overlays Ihor Radchenko 2022-01-29 11:38 ` [PATCH 28/35] org-string-width: Handle undefined behaviour in older Emacs Ihor Radchenko 2022-01-29 11:38 ` [PATCH 29/35] org-string-width: Work around `window-pixel-width' bug in old Emacs Ihor Radchenko 2022-01-29 11:38 ` [PATCH 30/35] org-fold-show-set-visibility: Fix edge case when folded region is at BOB Ihor Radchenko 2022-01-29 11:38 ` [PATCH 31/35] org-fold-core: Fix fontification inside folded regions Ihor Radchenko 2022-01-29 11:38 ` [PATCH 32/35] test-org/string-width: Add tests for strings with prefix properties Ihor Radchenko 2022-01-29 11:38 ` [PATCH 33/35] org--string-from-props: Fix handling folds in Emacs <28 Ihor Radchenko 2022-01-29 11:38 ` [PATCH 34/35] org-link-make-string: Throw error when both LINK and DESCRIPTION are empty Ihor Radchenko 2022-01-29 11:38 ` [PATCH 35/35] test-ol/org-toggle-link-display: Fix compatibility with old Emacs Ihor Radchenko 2022-02-03 6:27 ` [PATCH 00/35] Merge org-fold feature branch Bastien 2022-02-03 7:07 ` Ihor Radchenko 2022-04-20 13:23 ` [PATCH v2 00/38] Final call for comments: " Ihor Radchenko 2022-04-20 13:23 ` [PATCH v2 01/38] Add org-fold-core: new folding engine--- Ihor Radchenko 2022-04-20 13:24 ` [PATCH v2 02/38] Separate folding functions from org.el into new library: org-fold Ihor Radchenko 2022-04-20 13:24 ` [PATCH v2 03/38] Separate cycling functions from org.el into new library: org-cycle Ihor Radchenko 2022-04-20 13:24 ` [PATCH v2 04/38] Remove functions from org.el that are now moved elsewhere Ihor Radchenko 2022-04-20 13:24 ` [PATCH v2 05/38] Disable native-comp in agendaIt caused cryptic bugs in the past Ihor Radchenko 2022-04-20 13:24 ` [PATCH v2 06/38] org-macs: New function org-find-text-property-region--- Ihor Radchenko 2022-04-20 13:24 ` [PATCH v2 07/38] org-at-heading-p: Accept optional argument* lisp/org.el (org-at-heading-p): Use second argument to allow Ihor Radchenko 2022-04-20 13:25 ` [PATCH v2 08/38] org-string-width: Reimplement to work with new folding Ihor Radchenko 2022-04-20 13:25 ` [PATCH v2 09/38] Rename old function call to use org-fold--- Ihor Radchenko 2022-04-20 13:25 ` [PATCH v2 10/38] Implement link folding* lisp/ol.el (org-link--link-folding-spec): Ihor Radchenko 2022-04-20 13:25 ` [PATCH v2 11/38] Implement overlay- and text-property-based versions of some functions Ihor Radchenko 2022-04-20 13:25 ` [PATCH v2 12/38] org-fold: Handle indirect buffer visibility--- Ihor Radchenko 2022-04-20 13:25 ` [PATCH v2 13/38] Fix subtle differences between overlays and invisible text properties Ihor Radchenko 2022-04-20 13:25 ` [PATCH v2 14/38] Support extra org-fold optimisations for huge buffers Ihor Radchenko 2022-04-20 13:25 ` [PATCH v2 15/38] Alias new org-fold functions to their old shorter names Ihor Radchenko 2022-04-20 13:25 ` [PATCH v2 16/38] Obsolete old function names that are now in org-fold--- Ihor Radchenko 2022-04-20 13:26 ` [PATCH v2 17/38] org-compat: Work around some third-party packages using outline-* functions Ihor Radchenko 2022-04-20 13:26 ` [PATCH v2 18/38] Move `org-buffer-list' to org-macs.el--- Ihor Radchenko 2022-04-20 13:26 ` [PATCH v2 19/38] Restore old visibility behaviour of org-refile--- Ihor Radchenko 2022-04-20 13:26 ` [PATCH v2 20/38] Add org-fold-related tests--- Ihor Radchenko 2022-04-20 13:26 ` [PATCH v2 21/38] org-manual: Update to new org-fold function names--- Ihor Radchenko 2022-04-20 13:26 ` [PATCH v2 22/38] ORG-NEWS: Add list of changes--- Ihor Radchenko 2022-04-20 13:26 ` [PATCH v2 23/38] Backport contributed commits--- Ihor Radchenko 2022-04-20 13:26 ` [PATCH v2 24/38] Fix typo: delete-duplicates → delete-dups Anders Johansson 2022-04-20 13:26 ` [PATCH v2 25/38] Fix bug in org-get-headingFixes #26, where fontification could make the matching and extraction of heading Anders Johansson 2022-04-20 13:27 ` [PATCH v2 26/38] Rename remaining org-force-cycle-archived Anders Johansson 2022-04-20 13:27 ` [PATCH v2 27/38] Fix org-fold--hide-drawers--overlays--- Ihor Radchenko 2022-04-20 13:27 ` [PATCH v2 28/38] org-string-width: Handle undefined behaviour in older Emacs Ihor Radchenko 2022-04-20 13:27 ` [PATCH v2 29/38] org-string-width: Work around `window-pixel-width' bug in old Emacs Ihor Radchenko 2022-04-20 13:27 ` [PATCH v2 30/38] org-fold-show-set-visibility: Fix edge case when folded region is at BOB Ihor Radchenko 2022-04-20 13:28 ` [PATCH v2 31/38] org-fold-core: Fix fontification inside folded regions Ihor Radchenko 2022-04-20 13:28 ` [PATCH v2 32/38] test-org/string-width: Add tests for strings with prefix properties Ihor Radchenko 2022-04-20 13:28 ` [PATCH v2 33/38] org--string-from-props: Fix handling folds in Emacs <28 Ihor Radchenko 2022-04-20 13:28 ` [PATCH v2 34/38] org-link-make-string: Throw error when both LINK and DESCRIPTION are empty Ihor Radchenko 2022-04-20 13:28 ` [PATCH v2 35/38] test-ol/org-toggle-link-display: Fix compatibility with old Emacs Ihor Radchenko 2022-04-20 13:28 ` [PATCH v2 36/38] org-macs.el: Fix fontification checks take 2--- Ihor Radchenko 2022-04-20 13:28 ` [PATCH v2 37/38] org-fold-core-fontify-region: Fix cases when fontification is not registered Ihor Radchenko 2022-04-20 13:28 ` [PATCH v2 38/38] org-agenda.el: Re-enable native compilation* lisp/org-agenda.el: Re-enable native compilation as it does not Ihor Radchenko 2022-04-20 14:47 ` [PATCH v2 00/38] Final call for comments: Merge org-fold feature branch Bastien 2022-04-20 15:38 ` Ihor Radchenko 2022-04-20 16:22 ` Bastien 2022-04-21 6:01 ` Ihor Radchenko 2022-04-21 6:55 ` Bastien 2022-04-21 9:27 ` Ihor Radchenko 2022-04-21 9:43 ` Bastien 2022-04-22 18:54 ` Kévin Le Gouguec 2022-04-25 11:44 ` Ihor Radchenko 2022-04-25 13:02 ` Bastien 2022-04-25 13:25 ` Ihor Radchenko 2022-04-25 14:05 ` Bastien 2022-04-26 11:48 ` Ihor Radchenko 2022-04-25 11:45 ` Ihor Radchenko 2022-04-26 6:10 ` Kévin Le Gouguec 2022-05-03 4:44 ` [ISSUE] org-fold does not support auto-reveal for some external package commands Christopher M. Miles [not found] ` <6270b43a.1c69fb81.835d4.54a6SMTPIN_ADDED_BROKEN@mx.google.com> 2022-05-03 6:33 ` Ihor Radchenko 2022-05-03 10:19 ` [DONE] " Christopher M. Miles
Code repositories for project(s) associated with this public inbox https://git.savannah.gnu.org/cgit/emacs/org-mode.git This is a public inbox, see mirroring instructions for how to clone and mirror all data and code used for this inbox; as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).