diff --git a/lisp/org-clock.el b/lisp/org-clock.el index eb5f923e7..d727fa150 100644 --- a/lisp/org-clock.el +++ b/lisp/org-clock.el @@ -1788,87 +1788,87 @@ HEADLINE-FILTER is a zero-arg function that, if specified, is called for each headline in the time range with point at the headline. Headlines for which HEADLINE-FILTER returns nil are excluded from the clock summation. PROPNAME lets you set a custom text property instead of :org-clock-minutes." - (org-with-silent-modifications - (let* ((re (concat "^\\(\\*+\\)[ \t]\\|^[ \t]*" - org-clock-string - "[ \t]*\\(?:\\(\\[.*?\\]\\)-+\\(\\[.*?\\]\\)\\|=>[ \t]+\\([0-9]+\\):\\([0-9]+\\)\\)")) - (lmax 30) - (ltimes (make-vector lmax 0)) - (level 0) - (tstart (cond ((stringp tstart) (org-time-string-to-seconds tstart)) - ((consp tstart) (float-time tstart)) - (t tstart))) - (tend (cond ((stringp tend) (org-time-string-to-seconds tend)) - ((consp tend) (float-time tend)) - (t tend))) - (t1 0) - time) - (remove-text-properties (point-min) (point-max) - `(,(or propname :org-clock-minutes) t - :org-clock-force-headline-inclusion t)) - (save-excursion - (goto-char (point-max)) - (while (re-search-backward re nil t) - (cond - ((match-end 2) - ;; Two time stamps. - (let* ((ts (float-time - (apply #'encode-time - (save-match-data - (org-parse-time-string (match-string 2)))))) - (te (float-time - (apply #'encode-time - (org-parse-time-string (match-string 3))))) - (dt (- (if tend (min te tend) te) - (if tstart (max ts tstart) ts)))) - (when (> dt 0) (cl-incf t1 (floor (/ dt 60)))))) - ((match-end 4) - ;; A naked time. - (setq t1 (+ t1 (string-to-number (match-string 5)) - (* 60 (string-to-number (match-string 4)))))) - (t ;A headline - ;; Add the currently clocking item time to the total. - (when (and org-clock-report-include-clocking-task - (eq (org-clocking-buffer) (current-buffer)) - (eq (marker-position org-clock-hd-marker) (point)) - tstart - tend - (>= (float-time org-clock-start-time) tstart) - (<= (float-time org-clock-start-time) tend)) - (let ((time (floor (- (float-time) - (float-time org-clock-start-time)) - 60))) - (setq t1 (+ t1 time)))) - (let* ((headline-forced - (get-text-property (point) - :org-clock-force-headline-inclusion)) - (headline-included - (or (null headline-filter) - (save-excursion - (save-match-data (funcall headline-filter)))))) - (setq level (- (match-end 1) (match-beginning 1))) - (when (>= level lmax) - (setq ltimes (vconcat ltimes (make-vector lmax 0)) lmax (* 2 lmax))) - (when (or (> t1 0) (> (aref ltimes level) 0)) - (when (or headline-included headline-forced) - (if headline-included - (cl-loop for l from 0 to level do - (aset ltimes l (+ (aref ltimes l) t1)))) - (setq time (aref ltimes level)) - (goto-char (match-beginning 0)) - (put-text-property (point) (point-at-eol) - (or propname :org-clock-minutes) time) - (when headline-filter - (save-excursion - (save-match-data - (while (org-up-heading-safe) - (put-text-property - (point) (line-end-position) - :org-clock-force-headline-inclusion t)))))) - (setq t1 0) - (cl-loop for l from level to (1- lmax) do - (aset ltimes l 0))))))) - (setq org-clock-file-total-minutes (aref ltimes 0)))))) + (with-silent-modifications + (let* ((re (concat "^\\(\\*+\\)[ \t]\\|^[ \t]*" + org-clock-string + "[ \t]*\\(?:\\(\\[.*?\\]\\)-+\\(\\[.*?\\]\\)\\|=>[ \t]+\\([0-9]+\\):\\([0-9]+\\)\\)")) + (lmax 30) + (ltimes (make-vector lmax 0)) + (level 0) + (tstart (cond ((stringp tstart) (org-time-string-to-seconds tstart)) + ((consp tstart) (float-time tstart)) + (t tstart))) + (tend (cond ((stringp tend) (org-time-string-to-seconds tend)) + ((consp tend) (float-time tend)) + (t tend))) + (t1 0) + time) + (remove-text-properties (point-min) (point-max) + `(,(or propname :org-clock-minutes) t + :org-clock-force-headline-inclusion t)) + (save-excursion + (goto-char (point-max)) + (while (re-search-backward re nil t) + (cond + ((match-end 2) + ;; Two time stamps. + (let* ((ts (float-time + (apply #'encode-time + (save-match-data + (org-parse-time-string (match-string 2)))))) + (te (float-time + (apply #'encode-time + (org-parse-time-string (match-string 3))))) + (dt (- (if tend (min te tend) te) + (if tstart (max ts tstart) ts)))) + (when (> dt 0) (cl-incf t1 (floor (/ dt 60)))))) + ((match-end 4) + ;; A naked time. + (setq t1 (+ t1 (string-to-number (match-string 5)) + (* 60 (string-to-number (match-string 4)))))) + (t ;A headline + ;; Add the currently clocking item time to the total. + (when (and org-clock-report-include-clocking-task + (eq (org-clocking-buffer) (current-buffer)) + (eq (marker-position org-clock-hd-marker) (point)) + tstart + tend + (>= (float-time org-clock-start-time) tstart) + (<= (float-time org-clock-start-time) tend)) + (let ((time (floor (- (float-time) + (float-time org-clock-start-time)) + 60))) + (setq t1 (+ t1 time)))) + (let* ((headline-forced + (get-text-property (point) + :org-clock-force-headline-inclusion)) + (headline-included + (or (null headline-filter) + (save-excursion + (save-match-data (funcall headline-filter)))))) + (setq level (- (match-end 1) (match-beginning 1))) + (when (>= level lmax) + (setq ltimes (vconcat ltimes (make-vector lmax 0)) lmax (* 2 lmax))) + (when (or (> t1 0) (> (aref ltimes level) 0)) + (when (or headline-included headline-forced) + (if headline-included + (cl-loop for l from 0 to level do + (aset ltimes l (+ (aref ltimes l) t1)))) + (setq time (aref ltimes level)) + (goto-char (match-beginning 0)) + (put-text-property (point) (point-at-eol) + (or propname :org-clock-minutes) time) + (when headline-filter + (save-excursion + (save-match-data + (while (org-up-heading-safe) + (put-text-property + (point) (line-end-position) + :org-clock-force-headline-inclusion t)))))) + (setq t1 0) + (cl-loop for l from level to (1- lmax) do + (aset ltimes l 0))))))) + (setq org-clock-file-total-minutes (aref ltimes 0)))))) (defun org-clock-sum-current-item (&optional tstart) "Return time, clocked on current item in total." diff --git a/lisp/org-colview.el b/lisp/org-colview.el index cf631482c..bba8c14a1 100644 --- a/lisp/org-colview.el +++ b/lisp/org-colview.el @@ -411,14 +411,14 @@ DATELINE is non-nil when the face used should be (line-beginning-position 2)))) (overlay-put ov 'keymap org-columns-map) (push ov org-columns-overlays)) - (org-with-silent-modifications - (let ((inhibit-read-only t)) - (put-text-property - (line-end-position 0) - (line-beginning-position 2) - 'read-only - (substitute-command-keys - "Type \\`\\[org-columns-edit-value]' \ + (with-silent-modifications + (let ((inhibit-read-only t)) + (put-text-property + (line-end-position 0) + (line-beginning-position 2) + 'read-only + (substitute-command-keys + "Type \\`\\[org-columns-edit-value]' \ to edit property"))))))) (defun org-columns-add-ellipses (string width) @@ -491,11 +491,11 @@ for the duration of the command.") (set-marker org-columns-begin-marker nil) (when (markerp org-columns-top-level-marker) (set-marker org-columns-top-level-marker nil)) - (org-with-silent-modifications - (mapc #'delete-overlay org-columns-overlays) - (setq org-columns-overlays nil) - (let ((inhibit-read-only t)) - (remove-text-properties (point-min) (point-max) '(read-only t)))) + (with-silent-modifications + (mapc #'delete-overlay org-columns-overlays) + (setq org-columns-overlays nil) + (let ((inhibit-read-only t)) + (remove-text-properties (point-min) (point-max) '(read-only t)))) (when org-columns-flyspell-was-active (flyspell-mode 1)) (when (local-variable-p 'org-colview-initial-truncate-line-value) @@ -520,10 +520,10 @@ for the duration of the command.") (defun org-columns-quit () "Remove the column overlays and in this way exit column editing." (interactive) - (org-with-silent-modifications - (org-columns-remove-overlays) - (let ((inhibit-read-only t)) - (remove-text-properties (point-min) (point-max) '(read-only t)))) + (with-silent-modifications + (org-columns-remove-overlays) + (let ((inhibit-read-only t)) + (remove-text-properties (point-min) (point-max) '(read-only t)))) (if (not (eq major-mode 'org-agenda-mode)) (setq org-columns-current-fmt nil) (setq org-agenda-columns-active nil) @@ -622,8 +622,8 @@ Where possible, use the standard interface for changing this line." (org-agenda-columns))) (t (let ((inhibit-read-only t)) - (org-with-silent-modifications - (remove-text-properties (max (point-min) (1- bol)) eol '(read-only t))) + (with-silent-modifications + (remove-text-properties (max (point-min) (1- bol)) eol '(read-only t))) (org-columns--call action)) ;; Some properties can modify headline (e.g., "TODO"), and ;; possible shuffle overlays. Make sure they are still all at @@ -1170,9 +1170,9 @@ properties drawers." (old (assoc spec summaries-alist))) (if old (setcdr old summary) (push (cons spec summary) summaries-alist) - (org-with-silent-modifications - (add-text-properties - pos (1+ pos) (list 'org-summaries summaries-alist))))) + (with-silent-modifications + (add-text-properties + pos (1+ pos) (list 'org-summaries summaries-alist))))) ;; When PROPERTY exists in current node, even if empty, ;; but its value doesn't match the one computed, use ;; the latter instead. @@ -1208,8 +1208,8 @@ column specification." (defun org-columns-compute-all () "Compute all columns that have operators defined." - (org-with-silent-modifications - (remove-text-properties (point-min) (point-max) '(org-summaries t))) + (with-silent-modifications + (remove-text-properties (point-min) (point-max) '(org-summaries t))) (let ((org-columns--time (float-time (current-time))) seen) (dolist (spec org-columns-current-fmt-compiled) @@ -1638,8 +1638,8 @@ This will add overlays to the date lines, to show the summary for each day." (let ((b (find-buffer-visiting file))) (with-current-buffer (or (buffer-base-buffer b) b) (org-with-wide-buffer - (org-with-silent-modifications - (remove-text-properties (point-min) (point-max) '(org-summaries t))) + (with-silent-modifications + (remove-text-properties (point-min) (point-max) '(org-summaries t))) (goto-char (point-min)) (org-columns-get-format-and-top-level) (dolist (spec fmt) diff --git a/lisp/org-compat.el b/lisp/org-compat.el index dd5c86328..c7095c92d 100644 --- a/lisp/org-compat.el +++ b/lisp/org-compat.el @@ -436,6 +436,11 @@ use of this function is for the stuck project list." (declare (obsolete "use `org-align-tags' instead." "Org 9.2")) (org-align-tags t)) +(defmacro org-with-silent-modifications (&rest body) + (declare (obsolete "use `with-silent-modifications' instead." "9.2") + (debug (body))) + `(with-silent-modifications ,@body)) + ;;;; Obsolete link types (eval-after-load 'org @@ -563,11 +568,6 @@ Pass COLUMN and FORCE to `move-to-column'." (defun org-release () "N/A") (defun org-git-version () "N/A !!check installation!!")))))) -(defmacro org-with-silent-modifications (&rest body) - (if (fboundp 'with-silent-modifications) - `(with-silent-modifications ,@body) - `(org-unmodified ,@body))) -(def-edebug-spec org-with-silent-modifications (body)) ;;; Functions for Emacs < 24.4 compatibility diff --git a/lisp/org-indent.el b/lisp/org-indent.el index 84bac2aa7..38c5f07c5 100644 --- a/lisp/org-indent.el +++ b/lisp/org-indent.el @@ -157,8 +157,8 @@ useful to make it ever so slightly different." (defsubst org-indent-remove-properties (beg end) "Remove indentations between BEG and END." - (org-with-silent-modifications - (remove-text-properties beg end '(line-prefix nil wrap-prefix nil)))) + (with-silent-modifications + (remove-text-properties beg end '(line-prefix nil wrap-prefix nil)))) ;;;###autoload (define-minor-mode org-indent-mode @@ -329,35 +329,35 @@ stopped." ;; For each line, set `line-prefix' and `wrap-prefix' ;; properties depending on the type of line (headline, inline ;; task, item or other). - (org-with-silent-modifications - (while (and (<= (point) end) (not (eobp))) - (cond - ;; When in asynchronous mode, check if interrupt is - ;; required. - ((and delay (input-pending-p)) (throw 'interrupt (point))) - ;; In asynchronous mode, take a break of - ;; `org-indent-agent-resume-delay' every DELAY to avoid - ;; blocking any other idle timer or process output. - ((and delay (time-less-p time-limit (current-time))) - (setq org-indent-agent-resume-timer - (run-with-idle-timer - (time-add (current-idle-time) org-indent-agent-resume-delay) - nil #'org-indent-initialize-agent)) - (throw 'interrupt (point))) - ;; Headline or inline task. - ((looking-at org-outline-regexp) - (let* ((nstars (- (match-end 0) (match-beginning 0) 1)) - (type (or (looking-at-p limited-re) 'inlinetask))) - (org-indent-set-line-properties nstars 0 type) - ;; At an headline, define new value for LEVEL. - (unless (eq type 'inlinetask) (setq level nstars)))) - ;; List item: `wrap-prefix' is set where body starts. - ((org-at-item-p) - (org-indent-set-line-properties - level (org-list-item-body-column (point)))) - ;; Regular line. - (t - (org-indent-set-line-properties level (org-get-indentation)))))))))) + (with-silent-modifications + (while (and (<= (point) end) (not (eobp))) + (cond + ;; When in asynchronous mode, check if interrupt is + ;; required. + ((and delay (input-pending-p)) (throw 'interrupt (point))) + ;; In asynchronous mode, take a break of + ;; `org-indent-agent-resume-delay' every DELAY to avoid + ;; blocking any other idle timer or process output. + ((and delay (time-less-p time-limit (current-time))) + (setq org-indent-agent-resume-timer + (run-with-idle-timer + (time-add (current-idle-time) org-indent-agent-resume-delay) + nil #'org-indent-initialize-agent)) + (throw 'interrupt (point))) + ;; Headline or inline task. + ((looking-at org-outline-regexp) + (let* ((nstars (- (match-end 0) (match-beginning 0) 1)) + (type (or (looking-at-p limited-re) 'inlinetask))) + (org-indent-set-line-properties nstars 0 type) + ;; At an headline, define new value for LEVEL. + (unless (eq type 'inlinetask) (setq level nstars)))) + ;; List item: `wrap-prefix' is set where body starts. + ((org-at-item-p) + (org-indent-set-line-properties + level (org-list-item-body-column (point)))) + ;; Regular line. + (t + (org-indent-set-line-properties level (org-get-indentation)))))))))) (defun org-indent-notify-modified-headline (beg end) "Set `org-indent-modified-headline-flag' depending on context. diff --git a/lisp/org-macs.el b/lisp/org-macs.el index b1485b3ff..e47474295 100644 --- a/lisp/org-macs.el +++ b/lisp/org-macs.el @@ -41,8 +41,8 @@ symbols) ,@body)) -;; Use `org-with-silent-modifications' to ignore cosmetic changes and -;; `org-unmodified' to ignore real text modifications +;; Use `with-silent-modifications' to ignore cosmetic changes and +;; `org-unmodified' to ignore real text modifications. (defmacro org-unmodified (&rest body) "Run BODY while preserving the buffer's `buffer-modified-p' state." (declare (debug (body))) diff --git a/lisp/org.el b/lisp/org.el index f316a3e85..af6322f8e 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -8742,9 +8742,9 @@ function is being called interactively." (when (and (eq (org-clock-is-active) (current-buffer)) (<= start (marker-position org-clock-marker)) (>= end (marker-position org-clock-marker))) - (org-with-silent-modifications - (put-text-property (1- org-clock-marker) org-clock-marker - :org-clock-marker-backup t)) + (with-silent-modifications + (put-text-property (1- org-clock-marker) org-clock-marker + :org-clock-marker-backup t)) t)) (dcst (downcase sorting-type)) (case-fold-search nil) @@ -8960,16 +8960,16 @@ the value of the drawer property." (inherit? (org-property-inherit-p dprop)) (property-re (org-re-property (concat (regexp-quote dprop) "\\+?") t)) (global (and inherit? (org--property-global-value dprop nil)))) - (org-with-silent-modifications - (org-with-point-at 1 - ;; Set global values (e.g., values defined through - ;; "#+PROPERTY:" keywords) to the whole buffer. - (when global (put-text-property (point-min) (point-max) tprop global)) - ;; Set local values. - (while (re-search-forward property-re nil t) - (when (org-at-property-p) - (org-refresh-property tprop (org-entry-get (point) dprop) inherit?)) - (outline-next-heading)))))) + (with-silent-modifications + (org-with-point-at 1 + ;; Set global values (e.g., values defined through + ;; "#+PROPERTY:" keywords) to the whole buffer. + (when global (put-text-property (point-min) (point-max) tprop global)) + ;; Set local values. + (while (re-search-forward property-re nil t) + (when (org-at-property-p) + (org-refresh-property tprop (org-entry-get (point) dprop) inherit?)) + (outline-next-heading)))))) (defun org-refresh-property (tprop p &optional inherit) "Refresh the buffer text property TPROP from the drawer property P. @@ -9001,49 +9001,49 @@ sub-tree if optional argument INHERIT is non-nil." "???")) ((symbolp org-category) (symbol-name org-category)) (t org-category)))) - (org-with-silent-modifications - (org-with-wide-buffer - ;; Set buffer-wide category. Search last #+CATEGORY keyword. - ;; This is the default category for the buffer. If none is - ;; found, fall-back to `org-category' or buffer file name. - (put-text-property - (point-min) (point-max) - 'org-category - (catch 'buffer-category - (goto-char (point-max)) - (while (re-search-backward "^[ \t]*#\\+CATEGORY:" (point-min) t) - (let ((element (org-element-at-point))) - (when (eq (org-element-type element) 'keyword) - (throw 'buffer-category - (org-element-property :value element))))) - default-category)) - ;; Set sub-tree specific categories. - (goto-char (point-min)) - (let ((regexp (org-re-property "CATEGORY"))) - (while (re-search-forward regexp nil t) - (let ((value (match-string-no-properties 3))) - (when (org-at-property-p) - (put-text-property - (save-excursion (org-back-to-heading t) (point)) - (save-excursion (org-end-of-subtree t t) (point)) - 'org-category - value))))))))) + (with-silent-modifications + (org-with-wide-buffer + ;; Set buffer-wide category. Search last #+CATEGORY keyword. + ;; This is the default category for the buffer. If none is + ;; found, fall-back to `org-category' or buffer file name. + (put-text-property + (point-min) (point-max) + 'org-category + (catch 'buffer-category + (goto-char (point-max)) + (while (re-search-backward "^[ \t]*#\\+CATEGORY:" (point-min) t) + (let ((element (org-element-at-point))) + (when (eq (org-element-type element) 'keyword) + (throw 'buffer-category + (org-element-property :value element))))) + default-category)) + ;; Set sub-tree specific categories. + (goto-char (point-min)) + (let ((regexp (org-re-property "CATEGORY"))) + (while (re-search-forward regexp nil t) + (let ((value (match-string-no-properties 3))) + (when (org-at-property-p) + (put-text-property + (save-excursion (org-back-to-heading t) (point)) + (save-excursion (org-end-of-subtree t t) (point)) + 'org-category + value))))))))) (defun org-refresh-stats-properties () "Refresh stats text properties in the buffer." - (org-with-silent-modifications - (org-with-point-at 1 - (let ((regexp (concat org-outline-regexp-bol - ".*\\[\\([0-9]*\\)\\(?:%\\|/\\([0-9]*\\)\\)\\]"))) - (while (re-search-forward regexp nil t) - (let* ((numerator (string-to-number (match-string 1))) - (denominator (and (match-end 2) - (string-to-number (match-string 2)))) - (stats (cond ((not denominator) numerator) ;percent - ((= denominator 0) 0) - (t (/ (* numerator 100) denominator))))) - (put-text-property (point) (progn (org-end-of-subtree t t) (point)) - 'org-stats stats))))))) + (with-silent-modifications + (org-with-point-at 1 + (let ((regexp (concat org-outline-regexp-bol + ".*\\[\\([0-9]*\\)\\(?:%\\|/\\([0-9]*\\)\\)\\]"))) + (while (re-search-forward regexp nil t) + (let* ((numerator (string-to-number (match-string 1))) + (denominator (and (match-end 2) + (string-to-number (match-string 2)))) + (stats (cond ((not denominator) numerator) ;percent + ((= denominator 0) 0) + (t (/ (* numerator 100) denominator))))) + (put-text-property (point) (progn (org-end-of-subtree t t) (point)) + 'org-stats stats))))))) (defun org-refresh-effort-properties () "Refresh effort properties" @@ -17931,20 +17931,20 @@ When a buffer is unmodified, it is just killed. When modified, it is saved (if old (setcdr old (org-uniquify (append (cdr old) (cdr alist)))) (push alist org-tag-groups-alist-for-agenda))))) - (org-with-silent-modifications - (save-excursion - (remove-text-properties (point-min) (point-max) pall) - (when org-agenda-skip-archived-trees - (goto-char (point-min)) - (while (re-search-forward rea nil t) - (when (org-at-heading-p t) - (add-text-properties (point-at-bol) (org-end-of-subtree t) pa)))) - (goto-char (point-min)) - (setq re (format "^\\*+ .*\\<%s\\>" org-comment-string)) - (while (re-search-forward re nil t) - (when (save-match-data (org-in-commented-heading-p t)) - (add-text-properties - (match-beginning 0) (org-end-of-subtree t) pc))))) + (with-silent-modifications + (save-excursion + (remove-text-properties (point-min) (point-max) pall) + (when org-agenda-skip-archived-trees + (goto-char (point-min)) + (while (re-search-forward rea nil t) + (when (org-at-heading-p t) + (add-text-properties (point-at-bol) (org-end-of-subtree t) pa)))) + (goto-char (point-min)) + (setq re (format "^\\*+ .*\\<%s\\>" org-comment-string)) + (while (re-search-forward re nil t) + (when (save-match-data (org-in-commented-heading-p t)) + (add-text-properties + (match-beginning 0) (org-end-of-subtree t) pc))))) (goto-char pos))))) (setq org-todo-keywords-for-agenda (org-uniquify org-todo-keywords-for-agenda))