From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp1 ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms11 with LMTPS id wEykNcAb1l6aBwAA0tVLHw (envelope-from ) for ; Tue, 02 Jun 2020 09:28:32 +0000 Received: from aspmx1.migadu.com ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp1 with LMTPS id oH9oMcAb1l6SWgAAbx9fmQ (envelope-from ) for ; Tue, 02 Jun 2020 09:28:32 +0000 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by aspmx1.migadu.com (Postfix) with ESMTPS id 36213940607 for ; Tue, 2 Jun 2020 09:28:32 +0000 (UTC) Received: from localhost ([::1]:50292 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jg3Di-0007h0-GW for larch@yhetil.org; Tue, 02 Jun 2020 05:28:30 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:43558) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1jg3DC-0007fj-Um for emacs-orgmode@gnu.org; Tue, 02 Jun 2020 05:27:58 -0400 Received: from mail-pj1-x102b.google.com ([2607:f8b0:4864:20::102b]:56253) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1jg3D9-0004LJ-18 for emacs-orgmode@gnu.org; Tue, 02 Jun 2020 05:27:58 -0400 Received: by mail-pj1-x102b.google.com with SMTP id fs4so1093181pjb.5 for ; Tue, 02 Jun 2020 02:27:54 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=from:to:cc:subject:in-reply-to:references:date:message-id :mime-version; bh=gX5JyzH63d0htlzFq1IpT2aoCfPfvWP+O09tU6qLBfE=; b=cKTp4pAlL7O4nJNNHk+h3rf5y7IY9oBA9OVPVhPDfKluHrGOugnmC0J60xbNXY289Y +oCuwn2CVe0V4aQQKJ8sAo5PiBXqvFxp0b0DeRCExZtYpfH69CjK5jDEL4aGpifDXEva T/m9VNbxuoi6+YiSx9SN5bxGSBu0+yG1O7J4Vek4JnlabFVv4nC/U2RBFg451P2n/kZF U4pDV7syQGm74omi7HDZjmtcOA5GNoyzVFRUFnqZYRIDhAS20SeIz/BYKIaAxOiw9TW4 O/Ju10EQifItT044202E77fp76XxwFFXnBXVAtzGaU1Ittp9UTMeeM3VKzTv8Ao9eu8q mEYA== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:cc:subject:in-reply-to:references:date :message-id:mime-version; bh=gX5JyzH63d0htlzFq1IpT2aoCfPfvWP+O09tU6qLBfE=; b=YeAwBOYEhcpdRIJM/6xgRJnzpEODOpkNNTTVRxnZ++mmK/mbC3wjatb67NhRci3dpv aYLPIGh9nhqkvBIDhjh1WHKpUec2zT0Nrk0rRplHkhOP02TDo8GJJ9kMQGDBqT5v/VGt GYY37BMkV1vPOLUaGShJYt9DY7+GKNgiZv5Uvg7iavC1tLZQvqcjf7x4RVCqyVzlSKny WFo57Hoq3II3tOZP+V6+k2kplKG4tdG40FLjnSrHRvN8JDwK9VVuG0Ha9zQ4C7zg7HTY Fdx0Y4LhVaFlybFtR3DC18asDao+4HGC5DAMQuhLZuDszGx2lA2rMSqFOUEfg9WEl+1u Livg== X-Gm-Message-State: AOAM532ljb5pFejkVPQHF7UrHt6V/AAsfONiTX0O9zpe6EANxikAvSbf F3oqXEL/kd3U9Ww31fAPgrg= X-Google-Smtp-Source: ABdhPJyMdyeEWov7gd0ck2wISVaASj8hvL6USyzhtjTcu2vWEhMNQYGDXx/Cuz7pecUoWyJgrJrRkg== X-Received: by 2002:a17:90a:3606:: with SMTP id s6mr4590433pjb.118.1591090073849; Tue, 02 Jun 2020 02:27:53 -0700 (PDT) Received: from localhost ([101.99.64.65]) by smtp.gmail.com with ESMTPSA id s8sm1776910pjz.44.2020.06.02.02.27.51 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Tue, 02 Jun 2020 02:27:53 -0700 (PDT) From: Ihor Radchenko To: Nicolas Goaziou Subject: Re: [patch suggestion] Mitigating the poor Emacs performance on huge org files: Do not use overlays for PROPERTY and LOGBOOK drawers In-Reply-To: <87367d4ydc.fsf@localhost> References: <87h7x9e5jo.fsf@localhost> <875zdpia5i.fsf@nicolasgoaziou.fr> <87y2qi8c8w.fsf@localhost> <87r1vu5qmc.fsf@nicolasgoaziou.fr> <87imh5w1zt.fsf@localhost> <87blmxjckl.fsf@localhost> <87y2q13tgs.fsf@nicolasgoaziou.fr> <878si1j83x.fsf@localhost> <87d07bzvhd.fsf@nicolasgoaziou.fr> <87imh34usq.fsf@localhost> <87pnbby49m.fsf@nicolasgoaziou.fr> <87tv0efvyd.fsf@localhost> <874kse1seu.fsf@localhost> <87r1vhqpja.fsf@nicolasgoaziou.fr> <87tv0d2nk7.fsf@localhost> <87o8qkhy3g.fsf@nicolasgoaziou.fr> <87sgfqu5av.fsf@localhost> <87sgfn6qpc.fsf@nicolasgoaziou.fr> <87367d4ydc.fsf@localhost> Date: Tue, 02 Jun 2020 17:23:07 +0800 Message-ID: <87zh9l3jpg.fsf@localhost> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Received-SPF: pass client-ip=2607:f8b0:4864:20::102b; envelope-from=yantar92@gmail.com; helo=mail-pj1-x102b.google.com X-detected-operating-system: by eggs.gnu.org: No matching host in p0f cache. That's all we know. X-Spam_score_int: -17 X-Spam_score: -1.8 X-Spam_bar: - X-Spam_report: (-1.8 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, FREEMAIL_ENVFROM_END_DIGIT=0.25, FREEMAIL_FROM=0.001, RCVD_IN_DNSWL_NONE=-0.0001, SPF_PASS=-0.001, URIBL_BLOCKED=0.001 autolearn=_AUTOLEARN X-Spam_action: no action X-BeenThere: emacs-orgmode@gnu.org X-Mailman-Version: 2.1.23 Precedence: list List-Id: "General discussions about Org-mode." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Cc: emacs-orgmode@gnu.org Errors-To: emacs-orgmode-bounces+larch=yhetil.org@gnu.org Sender: "Emacs-orgmode" X-Scanner: scn0 Authentication-Results: aspmx1.migadu.com; dkim=fail (body hash did not verify) header.d=gmail.com header.s=20161025 header.b=cKTp4pAl; dmarc=fail reason="SPF not aligned (relaxed)" header.from=gmail.com (policy=none); spf=pass (aspmx1.migadu.com: domain of emacs-orgmode-bounces@gnu.org designates 209.51.188.17 as permitted sender) smtp.mailfrom=emacs-orgmode-bounces@gnu.org X-Spam-Score: 0.59 X-TUID: Aej5rE+9fZC/ --=-=-= Content-Type: text/plain The patch (against 758b039c0) is attached. --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=featuredrawertextprop-20200602.patch 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." -;;; 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)))) ;;; 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)))))) + +;;; 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))) + + + ;;; Finish up (add-hook 'org-mode-hook ;remove overlays when changing major mode --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Ihor Radchenko 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. >>=20 >> 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. >>=20 >> 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: >>=20 >> When that happens, the arguments to =E2=80=98before-change-functions= =E2=80=99 will >> enclose a region in which the individual changes are made, but won= =E2=80=99t >> necessarily be the minimal such region >>=20 >> however, after-change-functions calls are always minimal: >>=20 >> and the arguments to each successive call of >> =E2=80=98after-change-functions=E2=80=99 will then delimit the part = of text being >> changed exactly. >>=20 >> 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-dr= awer 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 writes: > >> Hello, >> >> Ihor Radchenko 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:=20 >>> >>> 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 =E2=80=98before-change-functions=E2= =80=99 once before >>> making changes, and then call =E2=80=98after-change-functions=E2=80=99 = 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 =E2=80=98before-change-functions= =E2=80=99 will >> enclose a region in which the individual changes are made, but won= =E2=80=99t >> necessarily be the minimal such region >> >> however, after-change-functions calls are always minimal: >> >> and the arguments to each successive call of >> =E2=80=98after-change-functions=E2=80=99 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., y= ou >>>> 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 ca= ll >>>> 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: >>> >>> >>> >>> :DRAWER: >>> 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 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=E2=80=A6 >> >>> 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) >>> -----------------------------------------------------------------------= -- >>> >>> :PROPERTIES: >>> :CREATED: [2020-05-23 Sat 02:32] >>> :END: >>> >>> >>> >>> -----------------------------------------------------------------------= -- >> >> 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, >> >> --=20 >> Nicolas Goaziou > > --=20 > 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 --=20 Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong U= niversity, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg --=-=-=--