Created
May 10, 2020 16:27
-
-
Save yantar92/e37c2830d3bb6db8678b14424286c930 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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." | |
-;;; 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 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)))))) | |
+ | |
+;;; 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 |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment