Agenda: Refile and bulk action

This commit implements refiling directly from the agenda.

It also implements a mechanism for selecting a number of entries in
the agenda and then executing a command on all of them.  Possible
actions include archive, refile, todo state setting, and more.

doc/ChangeLog

@@ -1,3 +1,10 @@
+2009-06-24  Carsten Dominik  <carsten.dominik@gmail.com>
+
+	* orgcard.tex: Document bulk action.
+
+	* org.texi (Agenda commands): Document bulk action and remote
+	refiling.
+
 2009-06-17  Carsten Dominik  <carsten.dominik@gmail.com>
 
 	* org.texi (Clocking work time): Document the key to update effort

doc/org.texi

@@ -7075,6 +7075,10 @@ to it in the original Org file.  If the text to be deleted remotely
 is longer than one line, the kill needs to be confirmed by the user.  See
 variable @code{org-agenda-confirm-kill}.
 @c
+@kindex C-c C-w
+@item C-c C-w
+Refile the entry at point.
+@c
 @kindex a
 @item a
 Toggle the ARCHIVE tag for the current headline.
@@ -7200,6 +7204,31 @@ Cancel the currently running clock.
 @item J
 Jump to the running clock in another window.
 
+@tsubheading{Bulk remote editing selected entries}
+@cindex remote editing, bulk, from agenda
+
+@kindex s
+@item s
+Mark the entry at point for bulk editing.  If the entry is already marked,
+remove the mark from it.  With double prefix, remove all marks.
+
+@kindex B
+@item B
+Bulk action: Act on all marked entries in the agenda.  This will prompt for
+another key to select the action to be applied:
+@example
+r  @r{Prompt for a single refile target and move all entries.  The entries}
+   @r{will no longer be in the agenda, refresh (@kbd{g}) to bring them back.}
+$  @r{Archive all selected entries.}
+A  @r{Archive entries by moving them to their respective archive siblings.}
+t  @r{Change TODO state.  This prompts for a single TODO keyword and}
+   @r{changes the state of all selected entries, bypasing blocking and}
+   @r{suppressig logging notes (but not time stamps).}
++  @r{Add a tag to all selected entries.}
+-  @r{Remove a tag from all selected entries.}
+@end example
+
+
 @tsubheading{Calendar commands}
 @cindex calendar commands, from agenda
 @kindex c

doc/orgcard.tex

@@ -650,20 +650,20 @@ after  ``{\tt :}'', and dictionary words elsewhere.
 \key{change state of current TODO item}{t}
 \key{kill item and source}{C-k}
 \key{archive the subtree (file/tag/sibling)}{\$ / a / A}
+\key{refile the subtree}{C-c C-w}
 \key{show tags of current headline}{T}
 \key{set tags for current headline/region}{:}
-\key{set priority of current item}{p}
+\key{set / compute priority of current item}{p / P}
 \key{raise/lower priority of current item}{S-UP/DOWN$^3$}
-\key{display weighted priority of current item}{P}
 \key{run an attachment command}{C-c C-a}
 \key{schedule/set deadline for this item}{C-c C-s/d}
 \key{change timestamp to one day earlier/later}{S-LEFT/RIGHT$^3$}
 \key{change timestamp to today}{>}
 \key{insert new entry into diary}{i}
-
 \newcolumn
 \key{start/stop/cancel the clock on current item}{I / O / X}
 \key{jump to running clock entry}{J}
+\key{select for / execute bulk action}{s / B}
 
 {\bf Misc}
 

lisp/ChangeLog

@@ -1,3 +1,15 @@
+2009-06-24  Carsten Dominik  <carsten.dominik@gmail.com>
+
+	* org-agenda.el (org-agenda-mode): Reset list of marks.
+	(org-agenda-mode-map): Define new keys for refile and bulk action.
+	(org-agenda-menu): Add menu itesm for refile and bulk action.
+	(org-agenda-refile): New function.
+	(org-agenda-set-tags): Optional arguments TAG and ONOFF.
+	(org-agenda-marked-entries): New variable.
+	(org-agenda-bulk-select, org-agenda-remove-bulk-action-overlays)
+	(org-agenda-remove-all-bulk-action-marks)
+	(org-agenda-bulk-action): New functions/commands.
+
 2009-06-23  Carsten Dominik  <carsten.dominik@gmail.com>
 
 	* org-exp.el (org-get-file-contents): Protect org-like lines in

lisp/org-agenda.el

@@ -1246,7 +1246,8 @@ The following commands are available:
   (interactive)
   (kill-all-local-variables)
   (setq org-agenda-undo-list nil
-	org-agenda-pending-undo-list nil)
+	org-agenda-pending-undo-list nil
+	org-agenda-marked-entries nil)
   (setq major-mode 'org-agenda-mode)
   ;; Keep global-font-lock-mode from turning on font-lock-mode
   (org-set-local 'font-lock-global-modes (list 'not major-mode))
@@ -1292,6 +1293,9 @@ The following commands are available:
 (org-defkey org-agenda-mode-map "\C-k"     'org-agenda-kill)
 (org-defkey org-agenda-mode-map "\C-c$"    'org-agenda-archive)
 (org-defkey org-agenda-mode-map "\C-c\C-x\C-s" 'org-agenda-archive)
+(org-defkey org-agenda-mode-map "\C-c\C-w" 'org-agenda-refile)
+(org-defkey org-agenda-mode-map "s"        'org-agenda-bulk-select)
+(org-defkey org-agenda-mode-map "B"        'org-agenda-bulk-action)
 (org-defkey org-agenda-mode-map "\C-c\C-x!" 'org-reload)
 (org-defkey org-agenda-mode-map "$"        'org-agenda-archive)
 (org-defkey org-agenda-mode-map "A"        'org-agenda-archive-to-archive-sibling)
@@ -1342,7 +1346,6 @@ The following commands are available:
 (org-defkey org-agenda-mode-map "q" 'org-agenda-quit)
 (org-defkey org-agenda-mode-map "x" 'org-agenda-exit)
 (org-defkey org-agenda-mode-map "\C-x\C-w" 'org-write-agenda)
-(org-defkey org-agenda-mode-map "s" 'org-save-all-org-buffers)
 (org-defkey org-agenda-mode-map "\C-x\C-s" 'org-save-all-org-buffers)
 (org-defkey org-agenda-mode-map "P" 'org-agenda-show-priority)
 (org-defkey org-agenda-mode-map "T" 'org-agenda-show-tags)
@@ -1407,11 +1410,17 @@ The following commands are available:
     ["Tree to indirect frame" org-agenda-tree-to-indirect-buffer t]
     "--"
     ["Cycle TODO" org-agenda-todo t]
-    ("Archive"
+    ("Archive and Refile"
      ["Toggle ARCHIVE tag" org-agenda-toggle-archive-tag t]
      ["Move to archive sibling" org-agenda-archive-to-archive-sibling t]
-     ["Archive subtree" org-agenda-archive t])
+     ["Archive subtree" org-agenda-archive t]
+     ["Refile" org-agenda-refile t])
     ["Delete subtree" org-agenda-kill t]
+    ("Bulk action"
+     ["Toggle mark entry" org-agenda-bulk-select t]
+     ["Act on all marked" org-agenda-bulk-action t]
+     ["Unmark all entries" org-agenda-remove-all-bulk-action-marks :active t :keys "C-u s"])
+    "--"
     ["Add note" org-agenda-add-note t]
     "--"
     ["Goto Today" org-agenda-goto-today (org-agenda-check-type nil 'agenda 'timeline)]
@@ -2826,9 +2835,9 @@ given in `org-agenda-start-on-weekday'."
 				 'org-agenda-date))
 	    (put-text-property s (1- (point)) 'org-date-line t)
 	    (put-text-property s (1- (point)) 'org-day-cnt day-cnt)
- 	    (when todayp
- 	      (put-text-property s (1- (point)) 'org-today t)
- 	      (put-text-property s (1- (point)) 'face 'org-agenda-date-today))
+	    (when todayp
+	      (put-text-property s (1- (point)) 'org-today t)
+	      (put-text-property s (1- (point)) 'face 'org-agenda-date-today))
 	    (if rtnall (insert
 			(org-finalize-agenda-entries
 			 (org-agenda-add-time-grid-maybe
@@ -5361,6 +5370,28 @@ If this information is not given, the function uses the tree at point."
 	      (delete-region (point-at-bol) (1+ (point-at-eol)))))
 	  (beginning-of-line 0))))))
 
+(defun org-agenda-refile (&optional goto rfloc)
+  "Refile the item at point."
+  (interactive "P")
+  (let* ((marker (or (get-text-property (point) 'org-hd-marker)
+		     (org-agenda-error)))
+	 (buffer (marker-buffer marker))
+	 (pos (marker-position marker))
+	 (rfloc (or rfloc
+		    (org-refile-get-location
+		     (if goto "Goto: " "Refile to: ") buffer
+		     org-refile-allow-creating-parent-nodes))))
+    (with-current-buffer buffer
+      (save-excursion
+	(save-restriction
+	  (widen)
+	  (goto-char marker)
+	  (org-remove-subtree-entries-from-agenda)
+	  (org-refile goto buffer rfloc))))))
+
+
+
+
 (defun org-agenda-open-link ()
   "Follow the link in the current line, if any."
   (interactive)
@@ -5721,7 +5752,7 @@ the same tree node, and the headline of the tree node in the Org-mode file."
       (beginning-of-line 1))))
 
 ;; FIXME: should fix the tags property of the agenda line.
-(defun org-agenda-set-tags ()
+(defun org-agenda-set-tags (&optional tag onoff)
   "Set tags for the current headline."
   (interactive)
   (org-agenda-check-no-diary)
@@ -5744,7 +5775,9 @@ the same tree node, and the headline of the tree node in the Org-mode file."
 	    (and (outline-next-heading)
 		 (org-flag-heading nil)))   ; show the next heading
 	  (goto-char pos)
-	  (call-interactively 'org-set-tags)
+	  (if tag
+	      (org-toggle-tag tag onoff)
+	    (call-interactively 'org-set-tags))
 	  (end-of-line 1)
 	  (setq newhead (org-get-heading)))
 	(org-agenda-change-all-lines newhead hdmarker)
@@ -6197,6 +6230,119 @@ This is a command that has to be installed in `calendar-mode-map'."
       (princ s))
     (org-fit-window-to-buffer (get-buffer-window "*Dates*"))))
 
+;;; Bulk commands
+
+(defvar org-agenda-marked-entries nil
+  "List of markers that refer to marked entries in the agenda.")
+
+(defun org-agenda-bulk-select (&optional remove-all)
+  "Toggle marking the entry at point for future bulk action.
+With `C-u' prefix arg, run an action for all marked entries.
+With double `C-u C-u' prefix arg, remove all marks."
+  (interactive "P")
+  (if remove-all
+      (org-agenda-remove-all-bulk-action-marks)
+    (org-agenda-check-no-diary)
+    (let* ((m (get-text-property (point) 'org-hd-marker))
+	   ov)
+      (if (eq (get-char-property (point-at-bol) 'type)
+	      'org-marked-entry-overlay)
+	  (progn
+	    (org-agenda-remove-bulk-action-overlays
+	     (point-at-bol) (+ 2 (point-at-bol)))
+	    (setq org-agenda-marked-entries
+		  (delete (get-text-property (point-at-bol) 'org-hd-marker)
+			  org-agenda-marked-entries)))
+	(unless m (error "Nothing to mark at point"))
+	(push m org-agenda-marked-entries)
+	(setq ov (org-make-overlay (point-at-bol) (+ 2 (point-at-bol))))
+	(org-overlay-display ov ">>"
+			     (org-get-todo-face "TODO")
+			     'evaporate)
+	(org-overlay-put ov 'type 'org-marked-entry-overlay)
+	(beginning-of-line 2)))))
+
+(defun org-agenda-remove-bulk-action-overlays (&optional beg end)
+  "Remove the mark overlays between BEG and END in the agenda buffer.
+BEG and END default to the buffer limits.
+
+This only removes the overlays, it does not remove the markers
+from the list in `org-agenda-marked-entries'."
+  (interactive)
+  (mapc (lambda (ov)
+	  (and (eq (org-overlay-get ov 'type) 'org-marked-entry-overlay)
+	       (org-delete-overlay ov)))
+	(org-overlays-in (or beg (point-min)) (or end (point-max)))))
+
+(defun org-agenda-remove-all-bulk-action-marks ()
+  "Remove all marks in the agenda buffer.
+This will remove the markers, and the overlays."
+  (interactive)
+  (mapc (lambda (m) (move-marker m nil)) org-agenda-marked-entries)
+  (setq org-agenda-marked-entries nil)
+  (org-agenda-remove-bulk-action-overlays (point-min) (point-max)))
+
+(defun org-agenda-bulk-action ()
+  "Execute an remote-editing action on all marked entries."
+  (interactive)
+  (unless org-agenda-marked-entries
+    (error "No entries are marked"))
+  (message "Action: [r]efile [$]archive [A]rch-to-sib [t]odo [+]tag [-]tag")
+  (let* ((action (read-char-exclusive))
+	 (entries (reverse org-agenda-marked-entries))
+	 cmd rfloc state e (cnt 0))
+    (cond
+     ((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 org-agenda-marked-entries))
+		   org-refile-allow-creating-parent-nodes))
+      (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))))
+     
+     ((equal action ?t)
+      (setq state (org-ido-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 (org-ido-completing-read
+		 (format "Tag to %s: " (if (eq action ?+) "add" "remove"))
+		 (with-current-buffer (marker-buffer (car entries))
+		   (delq nil
+			 (mapcar (lambda (x)
+				   (if (stringp (car x)) x)) org-tag-alist)))))
+      (setq cmd `(org-agenda-set-tags ,tag ,(if (eq action ?+) ''on ''off))))
+     
+     (t (error "Invalid bulk action")))
+    
+    ;; Now loop over all markers and apply cmd
+    (while (setq e (pop entries))
+      (goto-char
+       (or (text-property-any (point-min) (point-max) 'org-hd-marker e)
+	   (error "Cannot find entry for marker %s" e)))
+      (eval cmd)
+      (setq org-agenda-marked-entries (delete e org-agenda-marked-entries))
+      (setq cnt (1+ cnt)))
+    (setq org-agenda-marked-entries nil)
+    (org-agenda-remove-all-bulk-action-marks)
+    (message "Acted on %d entries" cnt)))
+
 ;;; Appointment reminders
 
 (defvar appt-time-msg-list)

lisp/org.el

@@ -8384,7 +8384,7 @@ on the system \"/user@host:\"."
 Note that this is still *before* the stuff will be removed from
 the *old* location.")
 
-(defun org-refile (&optional goto default-buffer)
+(defun org-refile (&optional goto default-buffer rfloc)
   "Move the entry at point to another heading.
 The list of target headings is compiled using the information in
 `org-refile-targets', which see.  This list is created before each use
@@ -8404,6 +8404,8 @@ not actually move anything.
 With a double prefix `C-u C-u', go to the location where the last refiling
 operation has put the subtree.
 
+RFLOC can be a refile location obtained in a different way.
+
 See also `org-refile-use-outline-path' and `org-completion-use-ido'"
   (interactive "P")
   (let* ((cbuf (current-buffer))
@@ -8419,9 +8421,10 @@ See also `org-refile-use-outline-path' and `org-completion-use-ido'"
 	    (error "The region is not a (sequence of) subtree(s)")))
     (if (equal goto '(16))
 	(org-refile-goto-last-stored)
-      (when (setq it (org-refile-get-location
-		      (if goto "Goto: " "Refile to: ") default-buffer
-		      org-refile-allow-creating-parent-nodes))
+      (when (setq it (or rfloc
+			 (org-refile-get-location
+			  (if goto "Goto: " "Refile to: ") default-buffer
+			  org-refile-allow-creating-parent-nodes)))
 	(setq file (nth 1 it)
 	      re (nth 2 it)
 	      pos (nth 3 it))
@@ -9141,11 +9144,13 @@ For calling through lisp, arg is also interpreted in the following way:
 				(not (member this org-done-keywords))))
 	  (and logging (org-local-logging logging))
 	  (when (and (or org-todo-log-states org-log-done)
-		     (not org-inhibit-logging)
+		     (not (eq org-inhibit-logging t))
 		     (not (memq arg '(nextset previousset))))
 	    ;; we need to look at recording a time and note
 	    (setq dolog (or (nth 1 (assoc state org-todo-log-states))
 			    (nth 2 (assoc this org-todo-log-states))))
+	    (if (and (eq dolog 'note) (eq org-inhibit-logging 'note))
+		(setq dolog 'time))
 	    (when (and state
 		       (member state org-not-done-keywords)
 		       (not (member this org-not-done-keywords)))