New compatibility macro `org-with-silent-modifications'

* org-macs.el: Don't define `with-silent-modifications' for
emacsen that don't have it.

* org-compat.el (org-with-silent-modifications): New
compatibility macro.

* org.el (org-refresh-category-properties)
(org-refresh-properties, org-entry-blocked-p)
(org-agenda-prepare-buffers):
* org-indent.el (org-indent-remove-properties)
(org-indent-add-properties):
* org-colview.el (org-columns-display-here)
(org-columns-remove-overlays, org-columns-quit)
(org-columns-edit-value, org-columns-compute-all)
(org-columns-compute, org-agenda-colview-compute):
* org-clock.el (org-clock-sum): Use the compatibility macro
`org-with-silent-modifications' instead of
`with-silent-modifications'.

Thanks to Achim for a preliminary patch.
This commit is contained in:
Bastien Guerry 2013-02-25 11:44:27 +01:00
parent 988240d5fd
commit 372a3ecda8
6 changed files with 213 additions and 215 deletions

View File

@ -1694,85 +1694,85 @@ 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."
(interactive)
(with-silent-modifications
(let* ((re (concat "^\\(\\*+\\)[ \t]\\|^[ \t]*"
org-clock-string
"[ \t]*\\(?:\\(\\[.*?\\]\\)-+\\(\\[.*?\\]\\)\\|=>[ \t]+\\([0-9]+\\):\\([0-9]+\\)\\)"))
(lmax 30)
(ltimes (make-vector lmax 0))
(t1 0)
(level 0)
ts te dt
time)
(if (stringp tstart) (setq tstart (org-time-string-to-seconds tstart)))
(if (stringp tend) (setq tend (org-time-string-to-seconds tend)))
(if (consp tstart) (setq tstart (org-float-time tstart)))
(if (consp tend) (setq tend (org-float-time tend)))
(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
(setq ts (match-string 2)
te (match-string 3)
ts (org-float-time
(apply 'encode-time (org-parse-time-string ts)))
te (org-float-time
(apply 'encode-time (org-parse-time-string te)))
ts (if tstart (max ts tstart) ts)
te (if tend (min te tend) te)
dt (- te ts)
t1 (if (> dt 0) (+ t1 (floor (/ dt 60))) t1)))
((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
(equal (org-clocking-buffer) (current-buffer))
(equal (marker-position org-clock-hd-marker) (point))
tstart
tend
(>= (org-float-time org-clock-start-time) tstart)
(<= (org-float-time org-clock-start-time) tend))
(let ((time (floor (- (org-float-time)
(org-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 (or (> t1 0) (> (aref ltimes level) 0))
(when (or headline-included headline-forced)
(if headline-included
(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)
(if headline-filter
(save-excursion
(save-match-data
(while
(> (funcall outline-level) 1)
(outline-up-heading 1 t)
(put-text-property
(point) (point-at-eol)
:org-clock-force-headline-inclusion t))))))
(setq t1 0)
(loop for l from level to (1- lmax) do
(aset ltimes l 0)))))))
(setq org-clock-file-total-minutes (aref ltimes 0))))))
(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))
(t1 0)
(level 0)
ts te dt
time)
(if (stringp tstart) (setq tstart (org-time-string-to-seconds tstart)))
(if (stringp tend) (setq tend (org-time-string-to-seconds tend)))
(if (consp tstart) (setq tstart (org-float-time tstart)))
(if (consp tend) (setq tend (org-float-time tend)))
(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
(setq ts (match-string 2)
te (match-string 3)
ts (org-float-time
(apply 'encode-time (org-parse-time-string ts)))
te (org-float-time
(apply 'encode-time (org-parse-time-string te)))
ts (if tstart (max ts tstart) ts)
te (if tend (min te tend) te)
dt (- te ts)
t1 (if (> dt 0) (+ t1 (floor (/ dt 60))) t1)))
((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
(equal (org-clocking-buffer) (current-buffer))
(equal (marker-position org-clock-hd-marker) (point))
tstart
tend
(>= (org-float-time org-clock-start-time) tstart)
(<= (org-float-time org-clock-start-time) tend))
(let ((time (floor (- (org-float-time)
(org-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 (or (> t1 0) (> (aref ltimes level) 0))
(when (or headline-included headline-forced)
(if headline-included
(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)
(if headline-filter
(save-excursion
(save-match-data
(while
(> (funcall outline-level) 1)
(outline-up-heading 1 t)
(put-text-property
(point) (point-at-eol)
:org-clock-force-headline-inclusion t))))))
(setq t1 0)
(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."

View File

@ -223,17 +223,17 @@ This is the compiled version of the format.")
(setq s2 (org-columns-add-ellipses (or modval val) width))
(setq string (format f s2))
;; Create the overlay
(with-silent-modifications
(setq ov (org-columns-new-overlay
beg (setq beg (1+ beg)) string (if dateline face1 face)))
(overlay-put ov 'keymap org-columns-map)
(overlay-put ov 'org-columns-key property)
(overlay-put ov 'org-columns-value (cdr ass))
(overlay-put ov 'org-columns-value-modified modval)
(overlay-put ov 'org-columns-pom pom)
(overlay-put ov 'org-columns-format f)
(overlay-put ov 'line-prefix "")
(overlay-put ov 'wrap-prefix ""))
(org-with-silent-modifications
(setq ov (org-columns-new-overlay
beg (setq beg (1+ beg)) string (if dateline face1 face)))
(overlay-put ov 'keymap org-columns-map)
(overlay-put ov 'org-columns-key property)
(overlay-put ov 'org-columns-value (cdr ass))
(overlay-put ov 'org-columns-value-modified modval)
(overlay-put ov 'org-columns-pom pom)
(overlay-put ov 'org-columns-format f)
(overlay-put ov 'line-prefix "")
(overlay-put ov 'wrap-prefix ""))
(if (or (not (char-after beg))
(equal (char-after beg) ?\n))
(let ((inhibit-read-only t))
@ -332,11 +332,11 @@ for the duration of the command.")
(remove-hook 'post-command-hook 'org-columns-hscoll-title 'local))
(move-marker org-columns-begin-marker nil)
(move-marker org-columns-top-level-marker nil)
(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))))
(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))))
(when org-columns-flyspell-was-active
(flyspell-mode 1))
(when (local-variable-p 'org-colview-initial-truncate-line-value)
@ -384,10 +384,10 @@ CPHR is the complex heading regexp to use for parsing ITEM."
(defun org-columns-quit ()
"Remove the column overlays and in this way exit column editing."
(interactive)
(with-silent-modifications
(org-columns-remove-overlays)
(let ((inhibit-read-only t))
(remove-text-properties (point-min) (point-max) '(read-only t))))
(org-with-silent-modifications
(org-columns-remove-overlays)
(let ((inhibit-read-only t))
(remove-text-properties (point-min) (point-max) '(read-only t))))
(when (eq major-mode 'org-agenda-mode)
(setq org-agenda-columns-active nil)
(message
@ -488,9 +488,9 @@ Where possible, use the standard interface for changing this line."
(org-agenda-columns)))
(t
(let ((inhibit-read-only t))
(with-silent-modifications
(remove-text-properties
(max (point-min) (1- bol)) eol '(read-only t)))
(org-with-silent-modifications
(remove-text-properties
(max (point-min) (1- bol)) eol '(read-only t)))
(unwind-protect
(progn
(setq org-columns-overlays
@ -920,8 +920,8 @@ Don't set this, this is meant for dynamic scoping.")
(defun org-columns-compute-all ()
"Compute all columns that have operators defined."
(with-silent-modifications
(remove-text-properties (point-min) (point-max) '(org-summaries t)))
(org-with-silent-modifications
(remove-text-properties (point-min) (point-max) '(org-summaries t)))
(let ((columns org-columns-current-fmt-compiled)
(org-columns-time (time-to-number-of-days (current-time)))
col)
@ -996,9 +996,9 @@ Don't set this, this is meant for dynamic scoping.")
(if (assoc property sum-alist)
(setcdr (assoc property sum-alist) useval)
(push (cons property useval) sum-alist)
(with-silent-modifications
(add-text-properties sumpos (1+ sumpos)
(list 'org-summaries sum-alist))))
(org-with-silent-modifications
(add-text-properties sumpos (1+ sumpos)
(list 'org-summaries sum-alist))))
(when (and val (not (equal val (if flag str val))))
(org-entry-put nil property (if flag str val)))
;; add current to current level accumulator
@ -1509,8 +1509,8 @@ This will add overlays to the date lines, to show the summary for each day."
(save-excursion
(save-restriction
(widen)
(with-silent-modifications
(remove-text-properties (point-min) (point-max) '(org-summaries t)))
(org-with-silent-modifications
(remove-text-properties (point-min) (point-max) '(org-summaries t)))
(goto-char (point-min))
(org-columns-get-format-and-top-level)
(while (setq fm (pop fmt))

View File

@ -499,6 +499,12 @@ Implements `file-equal-p' for older emacsen and XEmacs."
(setq f2-attr (file-attributes (file-truename f2)))
(equal f1-attr f2-attr)))))
(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))
(provide 'org-compat)
;;; org-compat.el ends here

View File

@ -147,8 +147,8 @@ useful to make it ever so slightly different."
(defsubst org-indent-remove-properties (beg end)
"Remove indentations between BEG and END."
(with-silent-modifications
(remove-text-properties beg end '(line-prefix nil wrap-prefix nil))))
(org-with-silent-modifications
(remove-text-properties beg end '(line-prefix nil wrap-prefix nil))))
;;;###autoload
(define-minor-mode org-indent-mode
@ -342,50 +342,50 @@ stopped."
;; 2. For each line, set `line-prefix' and `wrap-prefix'
;; properties depending on the type of line (headline,
;; inline task, item or other).
(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))
(line (* added-ind-per-lvl (1- nstars)))
(wrap (+ line (1+ nstars))))
(cond
;; Headline: new value for PF.
((looking-at limited-re)
(org-indent-set-line-properties line wrap t)
(setq pf wrap))
;; End of inline task: PF-INLINE is now nil.
((looking-at "\\*+ end[ \t]*$")
(org-indent-set-line-properties line wrap 'inline)
(setq pf-inline nil))
;; Start of inline task. Determine if it contains
;; text, or if it is only one line long. Set
;; PF-INLINE accordingly.
(t (org-indent-set-line-properties line wrap 'inline)
(setq pf-inline (and (org-inlinetask-in-task-p) wrap))))))
;; List item: `wrap-prefix' is set where body starts.
((org-at-item-p)
(let* ((line (or pf-inline pf 0))
(wrap (+ (org-list-item-body-column (point)) line)))
(org-indent-set-line-properties line wrap nil)))
;; Normal line: use PF-INLINE, PF or nil as prefixes.
(t (let* ((line (or pf-inline pf 0))
(wrap (+ line (org-get-indentation))))
(org-indent-set-line-properties line wrap nil))))))))))
(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))
(line (* added-ind-per-lvl (1- nstars)))
(wrap (+ line (1+ nstars))))
(cond
;; Headline: new value for PF.
((looking-at limited-re)
(org-indent-set-line-properties line wrap t)
(setq pf wrap))
;; End of inline task: PF-INLINE is now nil.
((looking-at "\\*+ end[ \t]*$")
(org-indent-set-line-properties line wrap 'inline)
(setq pf-inline nil))
;; Start of inline task. Determine if it contains
;; text, or if it is only one line long. Set
;; PF-INLINE accordingly.
(t (org-indent-set-line-properties line wrap 'inline)
(setq pf-inline (and (org-inlinetask-in-task-p) wrap))))))
;; List item: `wrap-prefix' is set where body starts.
((org-at-item-p)
(let* ((line (or pf-inline pf 0))
(wrap (+ (org-list-item-body-column (point)) line)))
(org-indent-set-line-properties line wrap nil)))
;; Normal line: use PF-INLINE, PF or nil as prefixes.
(t (let* ((line (or pf-inline pf 0))
(wrap (+ line (org-get-indentation))))
(org-indent-set-line-properties line wrap nil))))))))))
(defun org-indent-notify-modified-headline (beg end)
"Set `org-indent-modified-headline-flag' depending on context.

View File

@ -63,14 +63,6 @@
`(interactive-p))))
(def-edebug-spec org-called-interactively-p (&optional ("quote" symbolp)))
(when (and (not (fboundp 'with-silent-modifications))
(or (< emacs-major-version 23)
(and (= emacs-major-version 23)
(< emacs-minor-version 2))))
(defmacro with-silent-modifications (&rest body)
`(org-unmodified ,@body))
(def-edebug-spec with-silent-modifications (body)))
(defmacro org-bound-and-true-p (var)
"Return the value of symbol VAR if it is bound, else nil."
`(and (boundp (quote ,var)) ,var))

View File

@ -8955,24 +8955,24 @@ call CMD."
((symbolp org-category) (symbol-name org-category))
(t org-category)))
beg end cat pos optionp)
(with-silent-modifications
(save-excursion
(save-restriction
(widen)
(goto-char (point-min))
(put-text-property (point) (point-max) 'org-category def-cat)
(while (re-search-forward
"^\\(#\\+CATEGORY:\\|[ \t]*:CATEGORY:\\)\\(.*\\)" nil t)
(setq pos (match-end 0)
optionp (equal (char-after (match-beginning 0)) ?#)
cat (org-trim (match-string 2)))
(if optionp
(setq beg (point-at-bol) end (point-max))
(org-back-to-heading t)
(setq beg (point) end (org-end-of-subtree t t)))
(put-text-property beg end 'org-category cat)
(put-text-property beg end 'org-category-position beg)
(goto-char pos)))))))
(org-with-silent-modifications
(save-excursion
(save-restriction
(widen)
(goto-char (point-min))
(put-text-property (point) (point-max) 'org-category def-cat)
(while (re-search-forward
"^\\(#\\+CATEGORY:\\|[ \t]*:CATEGORY:\\)\\(.*\\)" nil t)
(setq pos (match-end 0)
optionp (equal (char-after (match-beginning 0)) ?#)
cat (org-trim (match-string 2)))
(if optionp
(setq beg (point-at-bol) end (point-max))
(org-back-to-heading t)
(setq beg (point) end (org-end-of-subtree t t)))
(put-text-property beg end 'org-category cat)
(put-text-property beg end 'org-category-position beg)
(goto-char pos)))))))
(defun org-refresh-properties (dprop tprop)
"Refresh buffer text properties.
@ -8980,17 +8980,17 @@ DPROP is the drawer property and TPROP is the corresponding text
property to set."
(let ((case-fold-search t)
(inhibit-read-only t) p)
(with-silent-modifications
(save-excursion
(save-restriction
(widen)
(goto-char (point-min))
(while (re-search-forward (concat "^[ \t]*:" dprop ": +\\(.*\\)[ \t]*$") nil t)
(setq p (org-match-string-no-properties 1))
(save-excursion
(org-back-to-heading t)
(put-text-property
(point-at-bol) (point-at-eol) tprop p))))))))
(org-with-silent-modifications
(save-excursion
(save-restriction
(widen)
(goto-char (point-min))
(while (re-search-forward (concat "^[ \t]*:" dprop ": +\\(.*\\)[ \t]*$") nil t)
(setq p (org-match-string-no-properties 1))
(save-excursion
(org-back-to-heading t)
(put-text-property
(point-at-bol) (point-at-eol) tprop p))))))))
;;;; Link Stuff
@ -12166,15 +12166,15 @@ changes because there are unchecked boxes in this entry."
(defun org-entry-blocked-p ()
"Is the current entry blocked?"
(with-silent-modifications
(if (org-entry-get nil "NOBLOCKING")
nil ;; Never block this entry
(not (run-hook-with-args-until-failure
'org-blocker-hook
(list :type 'todo-state-change
:position (point)
:from 'todo
:to 'done))))))
(org-with-silent-modifications
(if (org-entry-get nil "NOBLOCKING")
nil ;; Never block this entry
(not (run-hook-with-args-until-failure
'org-blocker-hook
(list :type 'todo-state-change
:position (point)
:from 'todo
:to 'done))))))
(defun org-update-statistics-cookies (all)
"Update the statistics cookie, either from TODO or from checkboxes.
@ -17626,20 +17626,20 @@ When a buffer is unmodified, it is just killed. When modified, it is saved
(append org-drawers-for-agenda org-drawers))
(setq org-tag-alist-for-agenda
(append org-tag-alist-for-agenda org-tag-alist))
(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)
(if (org-at-heading-p t)
(add-text-properties (point-at-bol) (org-end-of-subtree t) pa))))
(goto-char (point-min))
(setq re (format org-heading-keyword-regexp-format
org-comment-string))
(while (re-search-forward re nil t)
(add-text-properties
(match-beginning 0) (org-end-of-subtree t) pc))))))))
(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)
(if (org-at-heading-p t)
(add-text-properties (point-at-bol) (org-end-of-subtree t) pa))))
(goto-char (point-min))
(setq re (format org-heading-keyword-regexp-format
org-comment-string))
(while (re-search-forward re nil t)
(add-text-properties
(match-beginning 0) (org-end-of-subtree t) pc))))))))
(setq org-todo-keywords-for-agenda
(org-uniquify org-todo-keywords-for-agenda))
(setq org-todo-keyword-alist-for-agenda