org-agenda: Small refactoring

* lisp/org-agenda.el (org-agenda-bulk-action): Small refactoring. Two
  `eval' less in the code base.

lisp/org-agenda.el

@@ -9745,178 +9745,191 @@ bulk action."
   "Execute an remote-editing action on all marked entries.
 The prefix arg is passed through to the command if possible."
   (interactive "P")
-  ;; Make sure we have markers, and only valid ones
+  ;; Make sure we have markers, and only valid ones.
   (unless org-agenda-bulk-marked-entries (user-error "No entries are marked"))
-  (mapc
-   (lambda (m)
-     (unless (and (markerp m)
-		  (marker-buffer m)
-		  (buffer-live-p (marker-buffer m))
-		  (marker-position m))
-       (user-error "Marker %s for bulk command is invalid" m)))
-   org-agenda-bulk-marked-entries)
-
-  ;; Prompt for the bulk command
-  (let* ((msg (if org-agenda-persistent-marks "Bulk (persistent): " "Bulk: ")))
-    (message (concat msg "[$]arch [A]rch->sib [t]odo [+/-]tag [s]chd [d]eadline [r]efile "
-		     "[S]catter [f]unction    "
-		     (when org-agenda-bulk-custom-functions
-		       (concat " Custom: ["
-			       (mapconcat (lambda(f) (char-to-string (car f)))
-					  org-agenda-bulk-custom-functions "")
-			       "]"))))
-    (catch 'exit
-      (let* ((action (read-char-exclusive))
-	     (org-log-refile (if org-log-refile 'time nil))
-	     (entries (reverse org-agenda-bulk-marked-entries))
-	     (org-overriding-default-time
-	      (if (get-text-property (point) 'org-agenda-date-header)
-		  (org-get-cursor-date)))
-	     redo-at-end
-	     cmd rfloc state e tag pos (cnt 0) (cntskip 0))
-	(cond
-	 ((equal action ?p)
-	  (let ((org-agenda-persistent-marks
-		 (not org-agenda-persistent-marks)))
-	    (org-agenda-bulk-action)
-	    (throw 'exit nil)))
-
-	 ((equal action ?$)
-	  (setq cmd '(org-agenda-archive)))
-
-	 ((equal action ?A)
-	  (setq cmd '(org-agenda-archive-to-archive-sibling)))
-
-	 ((member action '(?r ?w))
-	  (setq rfloc (org-refile-get-location
-		       "Refile to"
-		       (marker-buffer (car entries))
-		       org-refile-allow-creating-parent-nodes))
-	  (if (nth 3 rfloc)
-	      (setcar (nthcdr 3 rfloc)
-		      (move-marker (make-marker) (nth 3 rfloc)
-				   (or (get-file-buffer (nth 1 rfloc))
-				       (find-buffer-visiting (nth 1 rfloc))
-				       (error "This should not happen")))))
-
-	  (setq cmd (list 'org-agenda-refile nil (list 'quote rfloc) t)
-		redo-at-end t))
-
-	 ((equal action ?t)
-	  (setq state (completing-read
+  (dolist (m org-agenda-bulk-marked-entries)
+    (unless (and (markerp m)
+		 (marker-buffer m)
+		 (buffer-live-p (marker-buffer m))
+		 (marker-position m))
+      (user-error "Marker %s for bulk command is invalid" m)))
+
+  ;; Prompt for the bulk command.
+  (message
+   (concat (if org-agenda-persistent-marks "Bulk (persistent): " "Bulk: ")
+	   "[$]arch [A]rch->sib [t]odo [+/-]tag [s]chd [d]eadline [r]efile "
+	   "[S]catter [f]unction    "
+	   (and org-agenda-bulk-custom-functions
+		(format " Custom: [%s]"
+			(mapconcat (lambda (f) (char-to-string (car f)))
+				   org-agenda-bulk-custom-functions
+				   "")))))
+  (catch 'exit
+    (let* ((org-log-refile (if org-log-refile 'time nil))
+	   (entries (reverse org-agenda-bulk-marked-entries))
+	   (org-overriding-default-time
+	    (and (get-text-property (point) 'org-agenda-date-header)
+		 (org-get-cursor-date)))
+	   redo-at-end
+	   cmd)
+      (pcase (read-char-exclusive)
+	(?p
+	 (let ((org-agenda-persistent-marks
+		(not org-agenda-persistent-marks)))
+	   (org-agenda-bulk-action)
+	   (throw 'exit nil)))
+
+	(?$
+	 (setq cmd #'org-agenda-archive))
+
+	(?A
+	 (setq cmd #'org-agenda-archive-to-archive-sibling))
+
+	((or ?r ?w)
+	 (let ((refile-location
+		(org-refile-get-location
+		 "Refile to"
+		 (marker-buffer (car entries))
+		 org-refile-allow-creating-parent-nodes)))
+	   (when (nth 3 refile-location)
+	     (setcar (nthcdr 3 refile-location)
+		     (move-marker
+		      (make-marker)
+		      (nth 3 refile-location)
+		      (or (get-file-buffer (nth 1 refile-location))
+			  (find-buffer-visiting (nth 1 refile-location))
+			  (error "This should not happen")))))
+
+	   (setq cmd `(lambda () (org-agenda-refile nil ',refile-location t)))
+	   (setq redo-at-end t)))
+
+	(?t
+	 (let ((state (completing-read
 		       "Todo state: "
 		       (with-current-buffer (marker-buffer (car entries))
-			 (mapcar #'list org-todo-keywords-1))))
-	  (setq cmd `(let ((org-inhibit-blocking t)
-			   (org-inhibit-logging 'note))
-		       (org-agenda-todo ,state))))
-
-	 ((memq action '(?- ?+))
-	  (setq tag (completing-read
+			 (mapcar #'list org-todo-keywords-1)))))
+	   (setq cmd `(lambda ()
+			(let ((org-inhibit-blocking t)
+			      (org-inhibit-logging 'note))
+			  (org-agenda-todo ,state))))))
+
+	((and (or ?- ?+) action)
+	 (let ((tag (completing-read
 		     (format "Tag to %s: " (if (eq action ?+) "add" "remove"))
 		     (with-current-buffer (marker-buffer (car entries))
 		       (delq nil
 			     (mapcar (lambda (x) (and (stringp (car x)) x))
-				     org-current-tag-alist)))))
-	  (setq cmd `(org-agenda-set-tags ,tag ,(if (eq action ?+) ''on ''off))))
-
-	 ((memq action '(?s ?d))
-	  (let* ((time
-		  (unless arg
-		    (org-read-date
-		     nil nil nil
-		     (if (eq action ?s) "(Re)Schedule to" "(Re)Set Deadline to")
-		     org-overriding-default-time)))
-		 (c1 (if (eq action ?s) 'org-agenda-schedule
-		       'org-agenda-deadline)))
-	    ;; Make sure to not prompt for a note when bulk
-	    ;; rescheduling as Org cannot cope with simultaneous
-	    ;; notes.  Besides, it could be annoying depending on the
-	    ;; number of items re-scheduled.
-	    (setq cmd `(eval '(let ((org-log-reschedule
-				     (and org-log-reschedule 'time))
-				    (org-log-redeadline
-				     (and org-log-redeadline 'time)))
-				(,c1 arg ,time))))))
-
-	 ((equal action ?S)
-	  (if (not (org-agenda-check-type nil 'agenda 'timeline 'todo))
-	      (user-error "Can't scatter tasks in \"%s\" agenda view" org-agenda-type)
-	    (let ((days (read-number
-			 (format "Scatter tasks across how many %sdays: "
-				 (if arg "week" "")) 7)))
-	      (setq cmd
-		    `(let ((distance (1+ (random ,days))))
-		       (if arg
-			   (let ((dist distance)
-				 (day-of-week
-				  (calendar-day-of-week
-				   (calendar-gregorian-from-absolute (org-today)))))
-			     (dotimes (i (1+ dist))
-			       (while (member day-of-week org-agenda-weekend-days)
-				 (cl-incf distance)
-				 (cl-incf day-of-week)
-				 (when (= day-of-week 7)
-				   (setq day-of-week 0)))
-			       (cl-incf day-of-week)
-			       (when (= day-of-week 7)
-				 (setq day-of-week 0)))))
-		       ;; silently fail when try to replan a sexp entry
-		       (condition-case nil
-			   (let* ((date (calendar-gregorian-from-absolute
-					 (+ (org-today) distance)))
-				  (time (encode-time 0 0 0 (nth 1 date) (nth 0 date)
-						     (nth 2 date))))
-			     (org-agenda-schedule nil time))
-			 (error nil)))))))
-
-	 ((assoc action org-agenda-bulk-custom-functions)
-	  (setq cmd (list (cadr (assoc action org-agenda-bulk-custom-functions)))
-		redo-at-end t))
-
-	 ((equal action ?f)
-	  (setq cmd (list (intern
-			   (completing-read "Function: "
-					    obarray 'fboundp t nil nil)))))
-
-	 (t (user-error "Invalid bulk action")))
-
-	;; Sort the markers, to make sure that parents are handled before children
-	(setq entries (sort entries
-			    (lambda (a b)
-			      (cond
-			       ((equal (marker-buffer a) (marker-buffer b))
-				(< (marker-position a) (marker-position b)))
-			       (t
-				(string< (buffer-name (marker-buffer a))
-					 (buffer-name (marker-buffer b))))))))
-
-	;; Now loop over all markers and apply cmd
-	(while (setq e (pop entries))
-	  (setq pos (text-property-any (point-min) (point-max) 'org-hd-marker e))
-	  (if (not pos)
-	      (progn (message "Skipping removed entry at %s" e)
-		     (setq cntskip (1+ cntskip)))
-	    (goto-char pos)
-	    (let (org-loop-over-headlines-in-active-region)
-	      (eval cmd))
-	    ;; `post-command-hook' is not run yet.  We make sure any
-	    ;; pending log note is processed.
-	    (when (or (memq 'org-add-log-note (default-value 'post-command-hook))
-		      (memq 'org-add-log-note post-command-hook))
-	      (org-add-log-note))
-	    (setq cnt (1+ cnt))))
+				     org-current-tag-alist))))))
+	   (setq cmd
+		 `(lambda ()
+		    (org-agenda-set-tags ,tag
+					 ,(if (eq action ?+) ''on ''off))))))
+
+	(?s
+	 (let ((time
+		(or arg
+		    (org-read-date nil nil nil "(Re)Schedule to"
+				   org-overriding-default-time))))
+	   ;; Make sure to not prompt for a note when bulk
+	   ;; rescheduling as Org cannot cope with simultaneous notes.
+	   ;; Besides, it could be annoying depending on the number of
+	   ;; items re-scheduled.
+	   (setq cmd
+		 `(lambda ()
+		    (let ((org-log-reschedule (and org-log-reschedule 'time)))
+		      (org-agenda-schedule arg ,time))))))
+	(?d
+	 (let ((time
+		(or arg
+		    (org-read-date nil nil nil "(Re)Set Deadline to"
+				   org-overriding-default-time))))
+	   ;; Make sure to not prompt for a note when bulk
+	   ;; rescheduling as Org cannot cope with simultaneous
+	   ;; notes.  Besides, it could be annoying depending on the
+	   ;; number of items re-scheduled.
+	   (setq cmd
+		 `(lambda ()
+		    (let ((org-log-redeadline (and org-log-redeadline 'time)))
+		      (org-agenda-deadline arg ,time))))))
+
+	(?S
+	 (unless (org-agenda-check-type nil 'agenda 'timeline 'todo)
+	   (user-error "Can't scatter tasks in \"%s\" agenda view" org-agenda-type))
+	 (let ((days (read-number
+		      (format "Scatter tasks across how many %sdays: "
+			      (if arg "week" ""))
+		      7)))
+	   (setq cmd
+		 `(lambda ()
+		    (let ((distance (1+ (random ,days))))
+		      (when arg
+			(let ((dist distance)
+			      (day-of-week
+			       (calendar-day-of-week
+				(calendar-gregorian-from-absolute (org-today)))))
+			  (dotimes (i (1+ dist))
+			    (while (member day-of-week org-agenda-weekend-days)
+			      (cl-incf distance)
+			      (cl-incf day-of-week)
+			      (when (= day-of-week 7)
+				(setq day-of-week 0)))
+			    (cl-incf day-of-week)
+			    (when (= day-of-week 7)
+			      (setq day-of-week 0)))))
+		      ;; Silently fail when try to replan a sexp entry.
+		      (ignore-errors
+			(let* ((date (calendar-gregorian-from-absolute
+				      (+ (org-today) distance)))
+			       (time (encode-time 0 0 0 (nth 1 date) (nth 0 date)
+						  (nth 2 date))))
+			  (org-agenda-schedule nil time))))))))
+
+	(?f
+	 (setq cmd
+	       (intern
+		(completing-read "Function: " obarray #'fboundp t nil nil))))
+
+	(action
+	 (pcase (assoc action org-agenda-bulk-custom-functions)
+	   (`(,_ ,f) (setq cmd f) (setq redo-at-end t))
+	   (_ (user-error "Invalid bulk action: %c" action)))))
+
+      ;; Sort the markers, to make sure that parents are handled
+      ;; before children.
+      (setq entries (sort entries
+			  (lambda (a b)
+			    (cond
+			     ((eq (marker-buffer a) (marker-buffer b))
+			      (< (marker-position a) (marker-position b)))
+			     (t
+			      (string< (buffer-name (marker-buffer a))
+				       (buffer-name (marker-buffer b))))))))
+
+      ;; Now loop over all markers and apply CMD.
+      (let ((processed 0)
+	    (skipped 0))
+	(dolist (e entries)
+	  (let ((pos (text-property-any (point-min) (point-max) 'org-hd-marker e)))
+	    (if (not pos)
+		(progn (message "Skipping removed entry at %s" e)
+		       (cl-incf skipped))
+	      (goto-char pos)
+	      (let (org-loop-over-headlines-in-active-region) (funcall cmd))
+	      ;; `post-command-hook' is not run yet.  We make sure any
+	      ;; pending log note is processed.
+	      (when (or (memq 'org-add-log-note (default-value 'post-command-hook))
+			(memq 'org-add-log-note post-command-hook))
+		(org-add-log-note))
+	      (cl-incf processed))))
 	(when redo-at-end (org-agenda-redo))
-	(unless org-agenda-persistent-marks
-	  (org-agenda-bulk-unmark-all))
+	(unless org-agenda-persistent-marks (org-agenda-bulk-unmark-all))
 	(message "Acted on %d entries%s%s"
-		 cnt
-		 (if (= cntskip 0)
+		 processed
+		 (if (= skipped 0)
 		     ""
 		   (format ", skipped %d (disappeared before their turn)"
-			   cntskip))
-		 (if (not org-agenda-persistent-marks)
-		     "" " (kept marked)"))))))
+			   skipped))
+		 (if (not org-agenda-persistent-marks) "" " (kept marked)"))))))
 
 (defun org-agenda-capture (&optional with-time)
   "Call `org-capture' with the date at point.