christopherjwhite / org-toodledo

Emacs enhancement for syncing org-mode tasks with Toodledlo
83 stars 16 forks source link

Feature Request / Suggestion -- user-post-sync-function #29

Closed lawlist closed 10 years ago

lawlist commented 10 years ago

As a feature request, please consider adding the option for a custom user-post-sync-function -- the option would default to nil, unless the user chooses to implement such a function. The option could be added at the following two (2) specific locations in the org-toodledo.el script -- i.e., line 1361; and, line 1375. The custom function is needed at these two (2) specific locations, because there are two (2) possible conditions for a successful run, and because the custom function should not run if errors occur during the synchronization process.

       ((= 0 tot)
        (org-toodledo-info "Sync complete, no changes")
        (sit-for org-toodledo-sync-message-time)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

        (user-post-sync-function) ;; lawlist-add

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

       )

       ((= errors 0)
        (org-toodledo-info (concat (format "Sync complete, %d changes: " tot)
                                   (if (> (+ imod idel) 0) 
                                       (concat "recv " 
                                               (if (> imod 0) (format "%d mod " imod))
                                               (if (> idel 0) (format "%d del " idel))
                                               (if (> (+ onew omod odel) 0) ", ")))
                                   (if (> (+ onew omod odel) 0) 
                                       (concat "sent " 
                                               (if (> onew 0) (format "%d new " onew))
                                               (if (> omod 0) (format "%d mod " omod))
                                               (if (> odel 0) (format "%d del " odel))))))
        (sit-for org-toodledo-sync-message-time)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

        (user-post-sync-function) ;; lawlist-add

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

       )

I have been using the above-mentioned custom modification since day one. My experience with org-toodledo-folder-support-mode has never been good -- i.e., it is unreliable. Instead, I choose to have ToodledoFolder property drawers for every task and then I use org-archive-subtree with a backward search and refile every task underneath the appropriate heading.

Here is a sample:

(defun user-post-sync-function ()
(interactive)
  (setq buffer-read-only nil)
  (lawlist-refile-tasks)
  (lawlist-heading-events)
  (lawlist-refile-events)
  (lawlist-heading-undated)
  (lawlist-refile-undated)
  (lawlist-heading-done)
  (lawlist-refile-done)
  (lawlist-heading-contacts)
  (lawlist-refile-contacts)
  (carry-forward-uncompleted-tasks)
  (make-active-today)
  (lawlist-sort)
  (lawlist-org-cleanup)
  (save-buffer)
  (org-cycle-hide-drawers 'all)
  (hs-hide-all)
  (setq buffer-read-only t) )

(setq org-global-properties '(("ToodledoFolder_ALL". "TASKS EVENTS UNDATED DONE")))
(setq org-default-properties (cons "ToodledoFolder" org-default-properties))

(setq org-highest-priority ?A)
(setq org-lowest-priority ?E)
(setq org-default-priority ?A)

(setq org-todo-keywords
  (quote ((sequence "Active(a)" "Next Action(n)" "Reference(r)"  "Someday(s)" "Delegated(d)" "|" "None(N)") )))

(setq org-toodledo-status-to-org-map '(
    ("Active" . "Active")
    ("None" . "None")
    ("Next Action" . "Next Action")
    ("Planning" . "Planning")
    ("Delegated" . "Delegated")
    ("Waiting" . "Waiting")
    ("Someday" . "Someday")
    ("Hold" . "Hold")
    ("Postponed" . "Postponed")
    ("Canceled" . "Canceled")
    ("Reference" . "Reference") ))

(defun lawlist-heading-events (&optional default-heading)
  (let ((item default-heading)
        result)
    (unless item
      (condition-case nil
          (progn 
            (org-back-to-heading t)
            (setq item "EVENTS") )))
    (when item
      (goto-char (point-min))
      (unless (re-search-forward (format "^\*+[ \t]* %s" (regexp-quote item)) nil t)
              (goto-char (point-max))
              (insert (concat "* " item "\n\n"))))))

(defun lawlist-heading-undated (&optional default-heading)
  (let ((item default-heading)
        result)
    (unless item
      (condition-case nil
          (progn 
            (org-back-to-heading t)
            (setq item "UNDATED") )))
    (when item
      (goto-char (point-min))
      (unless (re-search-forward (format "^\*+[ \t]* %s" (regexp-quote item)) nil t)
              (goto-char (point-max))
              (insert (concat "* " item "\n\n"))))))

(defun lawlist-heading-done (&optional default-heading)
  (let ((item default-heading)
        result)
    (unless item
      (condition-case nil
          (progn 
            (org-back-to-heading t)
            (setq item "DONE") )))
    (when item
      (goto-char (point-min))
      (unless (re-search-forward (format "^\*+[ \t]* %s" (regexp-quote item)) nil t)
              (goto-char (point-max))
              (insert (concat "* " item "\n\n"))))))

(defun lawlist-heading-contacts (&optional default-heading)
  (let ((item default-heading)
        result)
    (unless item
      (condition-case nil
          (progn 
            (org-back-to-heading t)
            (setq item "CONTACTS") )))
    (when item
      (goto-char (point-min))
      (unless (re-search-forward (format "^\*+[ \t]* %s" (regexp-quote item)) nil t)
              (goto-char (point-max))
              (insert (concat "* " item "\n\n"))))))

(defun lawlist-refile-tasks ()
(interactive)
  (setq org-archive-save-context-info nil)
  ;; (setq org-archive-location "/Users/HOME/.0.data/*TODO*::* TASKS")
  (setq org-archive-location "::* TASKS")
  (goto-char (point-max))
  (while (re-search-backward "^\*\* \\(Active\\|Next Action\\)" nil t)
    (org-archive-subtree) ))

(defun lawlist-refile-events ()
(interactive)
  (setq org-archive-save-context-info nil)
  ;; (setq org-archive-location "/Users/HOME/.0.data/*TODO*::* EVENTS")
  (setq org-archive-location "::* EVENTS")
  (goto-char (point-max))
  (while (re-search-backward "^\*\* \\(Reference\\)" nil t)
    (org-archive-subtree)))

(defun lawlist-refile-undated ()
(interactive)
  (setq org-archive-save-context-info nil)
  ;; (setq org-archive-location "/Users/HOME/.0.data/*TODO*::* UNDATED")
  (setq org-archive-location "::* UNDATED")
  (goto-char (point-max))
  (while (re-search-backward "^\*\* \\(Postponed\\|Waiting\\|Hold\\|Planning\\|Someday\\)" nil t)
    (org-archive-subtree)))

(defun lawlist-refile-done ()
(interactive)
  (setq org-archive-save-context-info nil)
  ;; (setq org-archive-location "/Users/HOME/.0.data/*TODO*::* DONE")
  (setq org-archive-location "::* DONE")
  (goto-char (point-max))
  (while (re-search-backward "^\*\* \\(Canceled\\|None\\)" nil t)
    (org-archive-subtree)))

(defun lawlist-refile-contacts ()
(interactive)
  (setq org-archive-save-context-info nil)
  ;; (setq org-archive-location "/Users/HOME/.0.data/*TODO*::* CONTACTS")
  (setq org-archive-location "::* CONTACTS")
  (goto-char (point-max))
  (while (re-search-backward "^\*\* \\(Delegated\\)" nil t)
    (org-archive-subtree)))

(defvar from-state nil)
(defvar to-state nil)

(defun carry-forward-uncompleted-tasks ()
"Carry forward uncompleted tasks."
(interactive)
  (goto-char (point-min))
  (while (re-search-forward "^\*\* Active" nil t)
    (unless (org-at-heading-p)
      (org-back-to-heading))
    (let* (
        (element (org-element-at-point))
        (todo-state (org-element-property :todo-keyword element))
        (deadline
          (ignore-errors ;; avoids throwing an error message if there is no deadline.
          (time-to-days
          (org-time-string-to-time
          (org-element-property :deadline element) ))))
        (today (time-to-days (current-time)))
        (title (org-element-property :raw-value element)) )
      (setq from-state "Active")
      (setq to-state "Active")
      (if (and
            deadline
            (> today deadline) ;; condition -- deadline is overdue
            (string= todo-state from-state) ) ;; condition -- todo-state equals from-state
        (org-deadline nil ".") ))))

(defun make-active-today ()
"Change task from Next Action to Active if deadline is less than or equal to today."
(interactive)
  (goto-char (point-min))
  (while (re-search-forward "^\*\* Next Action" nil t)
    (unless (org-at-heading-p)
      (org-back-to-heading))
    (let* (
        (element (org-element-at-point))
        (todo-state (org-element-property :todo-keyword element))
        (deadline
          (ignore-errors ;; avoids throwing an error message if there is no deadline.
          (time-to-days
          (org-time-string-to-time
          (org-element-property :deadline element) ))))
        (today (time-to-days (current-time)))
        (title (org-element-property :raw-value element)) )
      (setq from-state "Next Action")
      (setq to-state "Active")
      (if (and
        deadline
        (>= today deadline) ;; condition -- deadline less than or equal to today
        (string= todo-state from-state) ) ;; condition -- todo-state equals from-state
          (progn ;; Process following list if conditions were met.
            (org-deadline nil ".")
            (org-todo to-state) )))))

(defun delete-trailing-blank-lines-at-end-of-file ()
  "Deletes all blank lines at the end of the file, even the last one"
(interactive)
  (save-excursion
    (save-restriction
      (widen)
      (goto-char (point-max))
      (delete-blank-lines)
      (let ((trailnewlines (abs (skip-chars-backward "\n\t"))))
        (if (> trailnewlines 0)
          (delete-char trailnewlines))))))

(defun lawlist-org-cleanup ()
(interactive)
  (replace-regexp "\n+\\*\\* " "\n\n** " nil (point-min) (point-max))
  (replace-regexp "\n+\\* " "\n\n\n* " nil (point-min) (point-max))
  (replace-regexp "\n\t\s*" "\n   " nil (point-min) (point-max))
  (replace-regexp "\n:" "\n   :" nil (point-min) (point-max))
  (replace-regexp "\nCLOSED" "\n   CLOSED" nil (point-min) (point-max))
  (delete-trailing-blank-lines-at-end-of-file) )

(defun lawlist-sort ()
  (interactive)
  (goto-char (point-min))
  (while
    (re-search-forward "^\* " nil t) ;; sorts the whole kitten caboodle
    (goto-char (match-beginning 0))
    (condition-case err
      (progn
        (org-sort-entries t ?a)
        (org-sort-entries t ?o)
        (org-sort-entries t ?p)
        (org-sort-entries t ?t)
        (forward-line))
      (error nil) ))
  (goto-char (point-min))
  (while
    (re-search-forward "^\* DONE" nil t)
    (goto-char (match-beginning 0))
    (condition-case err
      (progn
        (org-sort-entries t ?a)
        (org-sort-entries t ?o)
        (org-sort-entries t ?p)
        (forward-line))
      (error nil) )))

(defun lawlist-org-mode-forward-sexp-func-tasks (arg)
  "Move over ARG balanced blocks to be used by hs-minor-mode."
  (dotimes (number arg)
    (let ((counter 0))
      (catch 'done
        (while t
          (setq case-fold-search nil)
          (search-forward-regexp "\\(CLOSED:\\|DEADLINE:\\|[*][*] Someday\\|[*] TASKS\\)\\|:END:")
          (setq counter (+ counter (if (looking-back "\\(CLOSED:\\|DEADLINE:\\|[*][*] Someday\\|[*] TASKS\\)") 1 -1)))
          (when (= counter 0) (throw 'done t)))))))
(add-to-list 'hs-special-modes-alist '(org-mode "\\(CLOSED:\\|DEADLINE:\\|[*][*] Someday\\|[*] TASKS\\)" ":END:" nil
  lawlist-org-mode-forward-sexp-func-tasks))
christopherjwhite commented 10 years ago

This is a good suggestion. To make it a bit more generic, what do you think of always calling the sync function (even with an error), but the function gets called with the list for counters.

Basically it would look like this at the end:

(let* ((imod (length server-edit-tasks))
       (idel (length server-delete-tasks))
       (onew new-tasks-count)
       (omod (length edit-tasks))
       (odel (length delete-tasks))
       (tot (+ imod idel onew omod odel)))

  (when (called-interactively-p 'interactive)
       ... generate the right message...
     )

  (when org-toodledo-post-sync-func
      (funcall org-toodledo-post-sync-func tot imod idel onew omod odel errors))
  (list tot imod idel onew omod odel errors))

This ensures it's always called even when non-interactive. (You're version is inside the interactive section).

christopherjwhite commented 10 years ago

Also -- can you give me an idea of the problems you were having with folder mode?

lawlist commented 10 years ago

(setq org-toodledo-folder-support-mode nil)

On rare occasion, I encounter errors during synchronization -- the local and server windows display what seems to be the exact same version of the task and I am not sure why I am being asked to choose one version or the other. My normal way of dealing with this is to do a complete restore to the Toodledo server from the most recent backup *.xml file and then populate a new blank org file with a complete restoration of everything on the Toodledo server. My best guess is that there may have been something wrong with the format of one or more of my tasks -- e.g., manually edited a time stamp incorrectly and the day of the week does not match the date.

Due to the rare error that occurs during synchronization, I had a concern that org-toodledo-post-sync-func should be aborted (or at least have the option / confirmation to abort) under such a circumstance. Errors were reported during the synchronization process . . . do you wish to proceed with org-toodledo-post-sync-func . . . Yes or No ?

lawlist commented 10 years ago

(setq org-toodledo-folder-support-mode 'heading)

I believe the problem with folder mode is that I did not find a way to reliably populate a blank org file when several folders and multiple tasks exist on the server. Many tasks previously assigned to one particular folder ended up being reassigned to a different folder.

My knowledge has increased slightly since the initial testing was done with folder mode, so it is possible I could write a org-toodledo-post-sync-func to deal with this issue. However, that would take quite a bit of work.

In my opinion, it is very useful to be able to populate a blank org file with everything on the server.

EDIT:   As I think more about this, I don't think a org-toodledo-post-sync-func could fix the problem with org-toodledo-folder-support-mode when populating a blank org file with several existing folders / tasks on the Toodledo server.

christopherjwhite commented 10 years ago

I added support via a new custom variable org-toodledo-post-sync-hook. It calls the hook(s) after org-toodledo-sync complete, success or failure. The hook function is passed a list of numbers indicated what was accomplished, including errors. This can be used to decide if the hook should still be run.

Example:

(add-hook 'org-toodledo-post-sync-hook 
      (lambda (result)
        (message "My post-sync hook: %S" result)))

This will call the function and generate a message like:

My post-sync hook 1: (1 0 0 0 1 0 0)
lawlist commented 10 years ago

Thank you very much -- I'm looking forward to using this new feature -- greatly appreciated !