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.

lisp/org-clock.el

@@ -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."

lisp/org-colview.el

@@ -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))

lisp/org-compat.el

@@ -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

lisp/org-indent.el

@@ -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.

lisp/org-macs.el

@@ -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))

lisp/org.el

@@ -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