Gregory Collins <[EMAIL PROTECTED]> writes:
> I saw that in the manual, but it isn't close enough to what I'm
> looking for -- it seems to do a shallow regexp split. The "do the
> right thing" lisp hack is probably a 30-minute job. I'll send a patch
> to the list when I get around to writing it.
The "probably a 30-minute job" statement was, in retrospect, complete
hubris on my part. It took me in total more like six hours to do this,
not in small part due to my unfamiliarity with Emacs lisp. I had to
teach many functions about section hierarchies, and added/reworked a lot
of logic to thread this information through the function call graph
starting with planner-copy-or-move-region.
I'm sure I missed a lot of opportunities to simplify this code. Comments
or improvements on the basic approach would be welcomed. The patch adds
a defcustom to planner.el to control the behaviour, which is to recreate
any task hierarchies you've defined in your daily pages when carrying
tasks forward. (N.B. this behaviour only applies to daily pages --- it's
assumed that moving a section hierarchy from a daily page to a project
page is generally a bad idea.)
Comments?
G.
If you've organized tasks hierarchically in a daily page, planner will
not duplicate your section structure when carrying those tasks forward
to a new daily page. This patch adds an option to planner to do that.
diff -r 6a946e913397 planner-multi.el
--- a/planner-multi.el Sun Sep 16 00:09:33 2007 -0400
+++ b/planner-multi.el Tue Sep 18 17:05:08 2007 -0400
@@ -209,8 +209,7 @@ Otherwise, put them before other pages o
(planner-multi-link-delete (planner-task-date info) links))))
-
-(defun planner-multi-copy-or-move-task (&optional date force)
+(defun planner-multi-copy-or-move-task (&optional date force section)
"Move the current task to DATE.
If this is the original task, it copies it instead of moving.
Most of the time, the original should be kept in a planning file,
@@ -218,6 +217,10 @@ regardless of status. It also works for
regardless of status. It also works for creating tasks from a
Note. Use `planner-replan-task' if you want to change the plan
page in order to get better completion.
+
+If SECTION is non-nil, then we'll place the task in that section
+on the destination daily page.
+
This function is the most complex aspect of planner.el."
(interactive (list (let ((planner-expand-name-favor-future-p
(or planner-expand-name-favor-future-p
@@ -254,7 +257,8 @@ This function is the most complex aspect
;; Delete from date page
(let ((old-date (planner-task-date info))
(links (planner-multi-split
- (planner-task-link-text info))))
+ (planner-task-link-text info)))
+ curpage cursection)
(when old-date
(planner-find-file (planner-link-base old-date))
(planner-find-task info)
@@ -264,20 +268,26 @@ This function is the most complex aspect
;; Update
(setq links (planner-multi-link-delete
(planner-task-date info) links))
+
+ ;; If this is a date page, find the right section.
+ (setq curpage (car links))
+ (setq cursection
+ (if (string-match planner-date-regexp curpage)
+ section nil))
(planner-find-file (planner-link-base (car links)))
(when date (setq links (cons date links)))
(if (planner-find-task info)
(delete-region (planner-line-beginning-position)
(min (point-max)
(1+ (planner-line-end-position))))
- (planner-seek-task-creation-point))
+ (planner-seek-task-creation-point cursection))
(insert (planner-format-task info nil nil nil nil
(planner-multi-make-link links))
"\n")
(forward-char -1)
;; Update all linked tasks
- (planner-update-task))))
- (planner-copy-or-move-task-basic date force))
+ (planner-update-task section))))
+ (planner-copy-or-move-task-basic date force section))
(when (planner-replan-task date) t))))
(defalias 'planner-copy-or-move-task 'planner-multi-copy-or-move-task)
@@ -371,21 +381,30 @@ With a prefix, provide the current link
(defalias 'planner-replan-task 'planner-multi-replan-task)
-(defun planner-multi-update-task ()
+(defun planner-multi-update-task (&optional section)
"Update the current task's priority and status on the linked page.
Tasks are considered the same if they have the same description.
This function allows you to force a task to be recreated if it
disappeared from the associated page.
+
+If SECTION is non-nil then the task will be placed in the
+appropriate section on the daily page.
Note that the text of the task must not change. If you want to be able
to update the task description, see planner-id.el."
(interactive)
(let* ((info (planner-current-task-info))
(links (planner-multi-task-link-as-list info))
- (new-pages (mapcar 'planner-link-base links)))
+ (new-pages (mapcar 'planner-link-base links))
+ curpage cursection)
;; Jump around
(with-planner-update-setup
(while links
+ (setq curpage (car links))
+ (setq cursection
+ (if (string-match planner-date-regexp curpage)
+ section nil))
+
(planner-find-file (planner-link-base (car links)))
(if (planner-find-task info)
;; Already there, so update only if changed
@@ -397,7 +416,7 @@ to update the task description, see plan
(planner-multi-task-link-as-list info)
new-pages)))
;; Not yet there, so add it
- (planner-seek-task-creation-point)
+ (planner-seek-task-creation-point cursection)
(insert (planner-multi-task-string info (planner-page-name)
(planner-multi-task-link-as-list info)
new-pages) "\n"))
diff -r 6a946e913397 planner.el
--- a/planner.el Sun Sep 16 00:09:33 2007 -0400
+++ b/planner.el Tue Sep 18 17:05:08 2007 -0400
@@ -599,6 +599,12 @@ If nil, do not carry unfinished tasks fo
(const :tag "Do not carry tasks forward" nil)
(integer :tag "Number of days to scan"))
:group 'planner-tasks)
+
+(defcustom planner-carry-forward-task-hierarchy nil
+ "If non-nil, any section hierarchy in `Tasks' you've defined in
+a daily page will be recreated when carrying tasks forward"
+ :type 'boolean
+ :group 'planner)
(defcustom planner-marks-regexp "[_oXDCP]"
"Regexp that matches status character for a task."
@@ -1597,45 +1603,119 @@ Return non-nil if SECTION was found."
(goto-char (planner-line-beginning-position)))))
(defun planner-seek-to-first (&optional section)
- "Positions the point at the specified SECTION, or Tasks if not specified."
+ "Positions the point at the specified SECTION, or
+`planner-default-section' if not specified. If SECTION is a list,
+then we look for a nested subsection."
(interactive)
- (unless section
- (setq section planner-default-section))
- (unless (stringp section)
+ (if (not section)
+ (setq section planner-default-section))
+ (when (symbolp section)
(setq section (cdr (assoc section planner-sections))))
+ (when (stringp section) (setq section (list section)))
+ (assert (listp section))
(widen)
- (goto-char (point-min))
- (if (re-search-forward (concat "^\\*\\s-+" section "\\(\\s-*?\\)$") nil t)
- (let ((old (point)) new)
- (forward-line 1)
- (if (re-search-forward "[^\\s-]" nil t)
- (progn
- (goto-char (planner-line-beginning-position))
- (unless (looking-at "^\\*\\s-")
- (setq new (point)))))
- (goto-char (or new old))
- (unless new
- (forward-line 1)
- (when (or (looking-at "^\\*\\s-+")
- (> (forward-line 1) 0)) (insert "\n"))
- (when (or (looking-at "^\\*\\s-+")
- (> (forward-line 1) 0)) (insert "\n"))
- (when (looking-at "^\\*\\s-+") (forward-line -1))))
- ;; Section not found, so create it.
- (funcall planner-create-section-function section)))
-
-(defun planner-create-at-top (section)
- "Create SECTION at top of file."
+ ;;; define helper functions
+ (let ((maybe-insert-line
+ (lambda ()
+ (unless (looking-at "^\\s-*$")
+ (insert "\n")
+ (forward-line -1)
+ (beginning-of-line))))
+
+ (skip-section-body
+ (lambda ()
+ (re-search-forward "^\\*+\\s-+" nil 1)
+ (beginning-of-line)
+ ;; skip whitespace
+ (forward-line -1)
+ (while (looking-at "^\\s-*$")
+ (forward-line -1))
+ (forward-line)
+ (beginning-of-line)))
+
+ (find-next-section
+ (lambda (depth)
+ (save-excursion
+ (progn (re-search-forward
+ (concat "^\\*\\{1," (int-to-string depth)
+ "\\}\\s-+.*$")
+ (point-max)
+ 1)
+ (beginning-of-line)
+ (point)))))
+
+ (f
+ (lambda (section depth)
+ ;; we'll be working with a progressively narrowed buffer
+ (goto-char (point-min))
+
+ (let ((re-section (concat "^\\*\\{"
+ (int-to-string depth)
+ "\\}\\s-+"
+ (car section)))
+ start end)
+ ;; look for section heading
+ (if (re-search-forward re-section nil t)
+ ;; found it
+ (progn
+ (beginning-of-line 2)
+ ;; are we searching deeper?
+ (if (cdr section)
+ (funcall skip-section-body)))
+ ;; didn't find section heading --- create it.
+ (funcall planner-create-section-function (car section) depth))
+
+ ;; ok, now point should be just after the section heading
+ ;; we're looking for. Narrow the buffer and (maybe)
+ ;; recurse.
+ (when (cdr section)
+ (setq start (point))
+ (setq end (funcall find-next-section depth))
+ (narrow-to-region start end)
+ (funcall f (cdr section) (1+ depth)))))))
+ (when section
+ (funcall f section 1)
+ ;; kill whitespace -- cuddle task bodies up to their section headings
+ (when (looking-at "^\\s-*$")
+ ;; call twice to really zap.
+ (delete-blank-lines)
+ (when (looking-at "^\\s-*$")
+ (delete-blank-lines)))
+ (when (not (looking-at "^\\#"))
+ (insert "\n")
+ (forward-line -1)))
+ (widen)))
+
+
+(defun planner-create-at-top (section &optional depth)
+ "Create SECTION at top of file, at subheading depth DEPTH. If
+DEPTH is nil, use 1."
+ (unless depth (setq depth 1))
(goto-char (point-min))
(let ((buffer-status (buffer-modified-p)))
- (insert "* " section "\n\n")
+ (insert (make-string depth ?*) " " section "\n")
+ (when (looking-at "^\\s-*$")
+ (delete-blank-lines)
+ (when (looking-at "^\\s-*$")
+ (delete-blank-lines)))
+ (beginning-of-line)
(set-buffer-modified-p buffer-status)))
-(defun planner-create-at-bottom (section)
- "Create SECTION at bottom of file."
+
+(defun planner-create-at-bottom (section &optional depth)
+ "Create SECTION at bottom of file, at subheading depth
+DEPTH. If DEPTH is nil, use 1."
+ (unless depth (setq depth 1))
(goto-char (point-max))
+ (insert "\n")
+ (beginning-of-line)
(let ((buffer-status (buffer-modified-p)))
- (insert "\n* " section "\n\n")
+ (when (looking-at "^\\s-*$")
+ (delete-blank-lines)
+ (when (looking-at "^\\s-*$")
+ (delete-blank-lines)))
+ (insert "\n" (make-string depth ?*) " " section "\n")
+ (beginning-of-line)
(set-buffer-modified-p buffer-status)))
;;;_ + Basic annotation
@@ -2044,6 +2124,117 @@ and LINK override TASK-INFO."
;;;_ + Scheduling
+
+(defun planner-make-section-tree (beg end)
+ "Scan buffer from BEG to END. Construct an easily searchable
+ forest of subsection headings in the region. The forest is a
+ list of trees having the form:
+
+ (char# depth title child-forest)
+
+ Returns the forest of sections."
+ (let
+ ((f
+ (lambda (beg end current-depth)
+ (catch 'result
+ (let ((start (if (< beg end) beg end))
+ (finish (if (< beg end) end beg))
+ (buffer (current-buffer))
+ (children nil))
+ (save-excursion
+ (save-restriction
+ ;; narrow the buffer to the section we're interested in
+ (narrow-to-region
+ (and (goto-char start) (planner-line-beginning-position))
+ (and (goto-char (1- finish))
+ (min (point-max) (1+ (planner-line-end-position)))))
+ (goto-char (point-min))
+
+ ;; loop through lines in the region
+ (while (not (eobp))
+ (goto-char (planner-line-beginning-position))
+ ;; are we looking at a section heading?
+ (if (looking-at "^\\([*]+\\) \\(.*\\)$")
+ ;; yes: split into constituent parts and recurse
+ (let* ((stars (match-string-no-properties 1))
+ (title (match-string-no-properties 2))
+ (depth (length stars))
+ (curpos (point))
+ (nextln (save-excursion (progn
+ (forward-line 1)
+ (point)))))
+
+ (if (<= depth current-depth)
+ ;; bomb out, we've reached a section heading
+ ;; at least as shallow as dad
+ (progn
+ (setq children (nreverse children))
+ (throw 'result (cons curpos children))))
+
+ ;; collect the forest of child sections
+ (let* ((retval (funcall f nextln end depth))
+ (endpos (car retval))
+ (its-children (cdr retval)))
+ (setq children
+ (cons (list curpos depth title its-children)
+ children))
+ (goto-char endpos)
+ )
+ )
+ ;; else -- next line
+ (forward-line 1)
+ )
+ )
+
+ ;; while loop is done. we reached the eof. return result.
+ (setq children (nreverse children))
+ (cons (point) children)
+ )))))))
+ (cdr (funcall f beg end 0))
+ )
+ )
+
+
+(defun planner-get-section-parents (pos section-forest)
+ "Search the SECTION-FOREST (made by a call to
+ `planner-make-section-tree') to determine what (sub)section
+ we're in at position POS. Returns a list indicating the section
+ hierarchy."
+ ;;; declare helper function
+ (let* ((f (lambda (pos forest current-depth section-list)
+ ;;; find first node in the forest with position > pos
+ (let* ((found-node
+ (let ((last-node nil)
+ (nodes forest))
+ (while nodes
+ (let* ((node (car nodes))
+ (npos (nth 0 node)))
+ (if (> npos pos)
+ ;;; kill search, we'll use last-node
+ (setq nodes nil)
+ (progn
+ (setq last-node node)
+ (setq nodes (cdr nodes))))))
+ last-node)))
+ ;;; did we find a node?
+ (if found-node
+ (let ((depth (nth 1 found-node))
+ (title (nth 2 found-node))
+ (children (nth 3 found-node)))
+ ;; if we skipped some parents then set them nil.
+ (while (< (1+ current-depth) depth)
+ (setq section-list (cons nil section-list)
+ current-depth (1+ current-depth)))
+
+ (if children
+ (funcall f pos children depth
+ (cons title section-list))
+ (cons title section-list)))
+ section-list)))))
+ (when section-forest
+ (reverse (funcall f pos section-forest 0 nil)))))
+
+
(defun planner-copy-or-move-region (beg end &optional date muffle-errors)
"Move all tasks from BEG to END to DATE.
If this is the original task, it copies it instead of moving.
@@ -2058,16 +2249,31 @@ reported."
(or planner-expand-name-favor-future-p
planner-task-dates-favor-future-p)))
(planner-read-date))))
- (let ((start (if (< beg end) beg end))
- (finish (if (< beg end) end beg))
- (buffer (current-buffer))
- (error-count 0)
- (count 0)
- (live-buffers (when (equal planner-tasks-file-behavior
- 'close)
- (buffer-list))))
- ;; Invoke planner-copy-or-move-task on each line in reverse
- (let ((planner-tasks-file-behavior nil))
+ (let* ((start (if (< beg end) beg end))
+ (finish (if (< beg end) end beg))
+ (buffer (current-buffer))
+ (error-count 0)
+ (old-planner-create-section-function planner-create-section-function)
+ (section-forest (if planner-carry-forward-task-hierarchy
+ (planner-make-section-tree start finish)
+ nil))
+ (count 0)
+ (live-buffers (when (equal planner-tasks-file-behavior
+ 'close)
+ (buffer-list))))
+ (setq planner-create-section-function 'planner-create-at-bottom)
+ ;; Invoke planner-copy-or-move-task on each line
+ (let ((planner-tasks-file-behavior nil)
+ (section-list nil)
+ (start-point (if planner-add-task-at-end-flag
+ (point-min)
+ (point-max)))
+ (cont-pred (if planner-add-task-at-end-flag
+ (lambda () (not (eobp)))
+ (lambda () (not (bobp)))))
+ (advance-function (if planner-add-task-at-end-flag
+ (lambda () (forward-line 1))
+ (lambda () (forward-line -1)))))
(save-excursion
(save-restriction
(narrow-to-region
@@ -2075,38 +2281,54 @@ reported."
(and (goto-char (1- finish))
(min (point-max)
(1+ (planner-line-end-position)))))
- (when planner-add-task-at-end-flag
- (reverse-region (point-min) (point-max)))
- (goto-char (point-max))
- (while (not (bobp))
+ (goto-char start-point)
+ ;; 2-pass -- collect list of destination sections for the
+ ;; tasks, then move them. Otherwise we'll delete the tasks,
+ ;; invalidating the section-forest.
+ (while (funcall cont-pred)
(goto-char (planner-line-beginning-position))
;; Non-completed or cancelled tasks only
(if (looking-at
"^#?\\([A-C]\\)\\([0-9]*\\)\\s-+\\([^XC\n]\\)\\s-+\\(.+\\)")
- (condition-case err
- (when (planner-copy-or-move-task date)
- (setq count (1+ count)))
- (error
- (unless (or muffle-errors (not (interactive-p)))
- (message
- "Error with %s: %s"
- (elt (planner-current-task-info) 4) err)
- (setq error-count (1+ error-count)))
- (forward-line -1)
- nil))
- (forward-line -1)))
- (when planner-add-task-at-end-flag
- (reverse-region (point-min) (point-max)))
+ (setq section-list
+ (cons (planner-get-section-parents (point)
+ section-forest)
+ section-list)))
+ (funcall advance-function))
+
+ (setq section-list (nreverse section-list))
+ (goto-char start-point)
+
+ ;; pass 2 -- actually move the tasks.
+ (while (funcall cont-pred)
+ (goto-char (planner-line-beginning-position))
+ (if (looking-at
+ "^#?\\([A-C]\\)\\([0-9]*\\)\\s-+\\([^XC\n]\\)\\s-+\\(.+\\)")
+ (progn
+ (condition-case err
+ (when (planner-copy-or-move-task date nil (car section-list))
+ (setq count (1+ count)))
+ (error
+ (unless (or muffle-errors (not (interactive-p)))
+ (message
+ "Error with %s: %s"
+ (elt (planner-current-task-info) 4) err)
+ (setq error-count (1+ error-count)))
+ (funcall advance-function)
+ nil))
+ (setq section-list (cdr section-list)))
+ (funcall advance-function)))
(when (and (not muffle-errors)
(not error-count)
(> error-count 0)
(interactive-p))
- (message (if (> error-count 1) "%d errors." "%d error.")
- error-count)))))
+ (message (if (> error-count 1) "%d errors." "%d error.")
+ error-count)))))
(when planner-tasks-file-behavior
(planner-save-buffers live-buffers))
(set-buffer buffer)
- count)) ; Return the number of tasks moved.
+ (setq planner-create-section-function old-planner-create-section-function)
+ count)) ; Return the number of tasks moved.
;;;_ + Navigation
@@ -3576,15 +3798,35 @@ With a prefix, provide the current link
"\n"))))))
(defalias 'planner-replan-task 'planner-replan-task-basic)
-(defun planner-seek-task-creation-point ()
- "Jump to point where task would be created."
- (planner-seek-to-first (cdr (assoc 'tasks planner-sections)))
- (when planner-add-task-at-end-flag
- (while (looking-at "^#")
- (forward-line))
- (unless (bolp) (insert "\n"))))
-
-(defun planner-copy-or-move-task-basic (&optional date force)
+
+(defun planner-seek-task-creation-point (&optional section)
+ "Jump to point where task would be created, in section
+SECTION. If SECTION is not specified, use (assoc 'tasks
+planner-sections)."
+ (unless section (setq section (cdr (assoc 'tasks planner-sections))))
+ (planner-seek-to-first section)
+ ;; seek to correct point, fixup whitespace.
+ (if planner-add-task-at-end-flag
+ (progn
+ (while (looking-at "^#")
+ (forward-line))
+ (beginning-of-line)
+ (when (looking-at "^\\s-*$")
+ (delete-blank-lines)
+ (when (looking-at "^\\s-*$")
+ (delete-blank-lines))
+ (insert "\n")
+ (forward-line -1))
+ (insert "\n")
+ (forward-line -1))
+ ;; add to top. add extra whitespace if we're looking at anything
+ ;; but a task.
+ (when (not (looking-at "^#"))
+ (insert "\n")
+ (forward-line -1))))
+
+
+(defun planner-copy-or-move-task-basic (&optional date force section)
"Move the current task to DATE.
If this is the original task, it copies it instead of moving.
Most of the time, the original should be kept in a planning file,
@@ -3592,6 +3834,10 @@ regardless of status. It also works for
regardless of status. It also works for creating tasks from a
Note. Use `planner-replan-task' if you want to change the plan
page in order to get better completion.
+
+If SECTION is non-nil, then we'll place the task in that section
+on the destination daily page.
+
This function is the most complex aspect of planner.el."
(interactive (list (let ((planner-expand-name-favor-future-p
(or planner-expand-name-favor-future-p
@@ -3637,13 +3883,14 @@ This function is the most complex aspect
(planner-goto date)
(when (or (not planner-copy-or-move-task-suppress-duplicates)
(and (not (planner-find-task task-info))))
- (planner-seek-task-creation-point)
+ (planner-seek-task-creation-point section)
(insert
(planner-format-task task-info
nil nil nil nil
(when plan-page
(planner-make-link plan-page)))
"\n")))
+
;; Update planner page
(when (and plan-page
(not (string-match planner-date-regexp plan-page)))
@@ -3665,7 +3912,6 @@ This function is the most complex aspect
(when planner-tasks-file-behavior
(planner-save-buffers live-buffers t)))
(when (planner-replan-task date) t)))
-(defalias 'planner-copy-or-move-task 'planner-copy-or-move-task-basic)
;;;_ + Deleting
@@ -3735,12 +3981,14 @@ This function is the most complex aspect
(goto-char (point))))
(defalias 'planner-edit-task-description 'planner-edit-task-description-basic)
-
-(defun planner-update-task-basic ()
+(defun planner-update-task-basic (&optional section)
"Update the current task's priority and status on the linked page.
Tasks are considered the same if they have the same description.
This function allows you to force a task to be recreated if it
disappeared from the associated page.
+
+If SECTION is non-nil then the task will be placed in the
+appropriate section on the daily page.
Note that the text of the task must not change. If you want to be able
to update the task description, see planner-id.el."
@@ -3753,7 +4001,8 @@ to update the task description, see plan
(planner-page-name))
(planner-task-plan task-info)
(planner-task-date task-info))))
- (original (planner-page-name)))
+ (original (planner-page-name))
+ cursection)
(unless task-info
(error "There is no task on the current line"))
;; (unless task-link
@@ -3770,14 +4019,17 @@ to update the task description, see plan
;; Not yet there, so add it
(when (planner-local-page-p task-link)
(planner-find-file task-link)
+ (setq cursection
+ (if (string-match planner-date-regexp task-link)
+ section nil))
+
(save-excursion
(save-restriction
- (planner-seek-task-creation-point)
+ (planner-seek-task-creation-point cursection)
(insert
(planner-format-task task-info nil nil nil nil
(planner-make-link original))
"\n"))))))))
-
(defalias 'planner-update-task 'planner-update-task-basic)
;;;_ + Prioritizing
_______________________________________________
Planner-el-discuss mailing list
[email protected]
https://mail.gna.org/listinfo/planner-el-discuss
