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." -;;; 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)))))) ;;; 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)))))) + +;;; 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))) + + + ;;; Finish up (add-hook 'org-mode-hook ;remove overlays when changing major mode