Bastien writes:
> There is already this in org-macs.el:
>
> (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)))
We shouldn't define things that don't have an org prefix. I don't
really see why we needed to replace org-unmodified in the first place,
especially since with-silent-modifications does _more_ than
org-unmodified, not less as your comment in org-macs would imply.
Here's a patch to restore org-unmodified in the sources, make it an
alias to with-silent-modifications when possible and augment the
replacement definition with a few things that with-silent-modifications
does on top of what org-unmodified did. We might even copy the whole
macro definition from subr.el, but I think we're close enough with this.
>From 249b18ee13f2fbf041c081fa63b1ccd40d67dc27 Mon Sep 17 00:00:00 2001
From: Achim Gratz <strom...@stromeko.de>
Date: Sun, 24 Feb 2013 10:54:29 +0100
Subject: [PATCH 1/2] Revert "Use `with-silent-modifications' instead of
`org-unmodified' when it makes sense"
This reverts commit 43c8aa02cc2301661fe203ec4d4a90d94d6353e6.
---
lisp/org-clock.el | 158 ++++++++++++++++++++++++++--------------------------
lisp/org-colview.el | 61 ++++++++++----------
lisp/org-macs.el | 2 -
lisp/org.el | 79 +++++++++++++-------------
4 files changed, 150 insertions(+), 150 deletions(-)
diff --git a/lisp/org-clock.el b/lisp/org-clock.el
index 02924b8..20e624b 100644
--- a/lisp/org-clock.el
+++ b/lisp/org-clock.el
@@ -1700,85 +1700,85 @@ (defun org-clock-sum (&optional tstart tend headline-filter propname)
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-unmodified
+ (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."
diff --git a/lisp/org-colview.el b/lisp/org-colview.el
index 3a8a713..05b9265 100644
--- a/lisp/org-colview.el
+++ b/lisp/org-colview.el
@@ -223,17 +223,17 @@ (defun org-columns-display-here (&optional props dateline)
(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-unmodified
+ (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 @@ (defun org-columns-remove-overlays ()
(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-unmodified
+ (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 @@ (defvar org-agenda-columns-active) ;; defined in org-agenda.el
(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-unmodified
+ (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 @@ (defun org-columns-edit-value (&optional key)
(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-unmodified
+ (remove-text-properties
+ (max (point-min) (1- bol)) eol '(read-only t)))
(unwind-protect
(progn
(setq org-columns-overlays
@@ -920,8 +920,8 @@ (defun org-columns-get-autowidth-alist (s cache)
(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-unmodified
+ (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 @@ (defun org-columns-compute (property)
(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-unmodified
+ (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,9 @@ (defun org-agenda-colview-compute (fmt)
(save-excursion
(save-restriction
(widen)
- (with-silent-modifications
- (remove-text-properties (point-min) (point-max) '(org-summaries t)))
+ (org-unmodified
+ (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))
diff --git a/lisp/org-macs.el b/lisp/org-macs.el
index 172d5d1..c46ad56 100644
--- a/lisp/org-macs.el
+++ b/lisp/org-macs.el
@@ -117,8 +117,6 @@ (defmacro org-preserve-lc (&rest body)
(def-edebug-spec org-preserve-lc (body))
;; Copied from bookmark.el
-;; Use `org-unmodified' to ignore real modifications, otherwise
-;; `with-silent-modifications' is enough to ignore cosmetic ones
(defmacro org-unmodified (&rest body)
"Run BODY while preserving the buffer's `buffer-modified-p' state."
(org-with-gensyms (was-modified)
diff --git a/lisp/org.el b/lisp/org.el
index 1e22699..f311d3a 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -8948,24 +8948,24 @@ (defun org-refresh-category-properties ()
((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-unmodified
+ (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.
@@ -8973,17 +8973,17 @@ (defun org-refresh-properties (dprop tprop)
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-unmodified
+ (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
@@ -12159,15 +12159,16 @@ (defun org-block-todo-from-checkboxes (change-plist)
(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-unmodified
+ (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.
@@ -17613,7 +17614,7 @@ (defun org-agenda-prepare-buffers (files)
(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
+ (org-unmodified
(save-excursion
(remove-text-properties (point-min) (point-max) pall)
(when org-agenda-skip-archived-trees
--
1.8.1.4
>From f9b03f274f93c81e9de2ec874fcc666a61e8b750 Mon Sep 17 00:00:00 2001
From: Achim Gratz <strom...@stromeko.de>
Date: Sun, 24 Feb 2013 11:02:57 +0100
Subject: [PATCH 2/2] =?UTF-8?q?make=20org-unmodified=20an=20alias=20for=20?=
=?UTF-8?q?`with-silent-modifications=C2=B4=20or=20re-implement=20as=20a?=
=?UTF-8?q?=20macro?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
* lisp/org-macs.el (org-unmodified): If `with-silent-modifications´ is
fbound, make org-unmodified an alias to it. If not, implement it as
a macro as before. Additionally to the original implementation,
let-bind `deactivate-mark´, `buffer-file-name´ and
`buffer-file-truename´ to nil. (with-silent-modifications): Do not
define, even when not fbound.
---
lisp/org-macs.el | 34 +++++++++++++++-------------------
1 file changed, 15 insertions(+), 19 deletions(-)
diff --git a/lisp/org-macs.el b/lisp/org-macs.el
index c46ad56..36fc86c 100644
--- a/lisp/org-macs.el
+++ b/lisp/org-macs.el
@@ -63,14 +63,6 @@ (defmacro org-called-interactively-p (&optional kind)
`(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))
@@ -116,17 +108,21 @@ (defmacro org-preserve-lc (&rest body)
(org-move-to-column ,col)))))
(def-edebug-spec org-preserve-lc (body))
-;; Copied from bookmark.el
-(defmacro org-unmodified (&rest body)
- "Run BODY while preserving the buffer's `buffer-modified-p' state."
- (org-with-gensyms (was-modified)
- `(let ((,was-modified (buffer-modified-p)))
- (unwind-protect
- (let ((buffer-undo-list t)
- (inhibit-modification-hooks t))
- ,@body)
- (set-buffer-modified-p ,was-modified)))))
-(def-edebug-spec org-unmodified (body))
+(eval-and-compile
+ (if (fboundp 'with-silent-modifications)
+ (defalias 'org-unmodified 'with-silent-modifications)
+ ;; originally copied from bookmark.el
+ (defmacro org-unmodified (&rest body)
+ "Execute body without changing `buffer-modified-p'.
+Also, do not record undo information."
+ `(set-buffer-modified-p
+ (prog1 (buffer-modified-p)
+ (let ((buffer-undo-list t)
+ (inhibit-read-only t)
+ (inhibit-modification-hooks t)
+ deactivate-mark buffer-file-name buffer-file-truename)
+ ,@body))))
+ (def-edebug-spec org-unmodified (body))))
(defmacro org-without-partial-completion (&rest body)
`(if (and (boundp 'partial-completion-mode)
--
1.8.1.4
Regards,
Achim.
--
+<[Q+ Matrix-12 WAVE#46+305 Neuron microQkb Andromeda XTk Blofeld]>+
Factory and User Sound Singles for Waldorf Q+, Q and microQ:
http://Synth.Stromeko.net/Downloads.html#WaldorfSounds
