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

Reply via email to