うどん駆動開発

org-modeのTODOをtoodledoにプッシュするelisp

emacs

iPhoneにMobileOrgが登場して，evernoteをやめてorg-modeを使っています．

また，スケジュール管理やTODO管理にはPocketInformantを使用中．

ところで，org-modeにはTODO管理をする機能が備わっています．となると，PocketInformantとも同期させたくなる．

PocketInformantは，TODOをWEB上のTODO管理システムであるtoodledoと同期することができます．つまり，org-modeとtoodledoを同期できたら，org-modeとPocketInformantを同期できるというわけです．

ということで，org-modeのTODOとtoodledoを同期するelisp，org-toodledoを開発中です．とりあえず出来ている部分だけ公開しようと思います．

org-modeからtoodledoにTODOを送信します．toodledoに登録済みのTODOは送信されません．

;; -*- Mode: Emacs-Lisp ; Coding: utf-8 -*-
;;
;; org-toodledo.el
(require 'md5)
(require 'xml-parse)
(require 'sexpath)

(defgroup org-toodledo nil
  "org toodledo"
  :group 'tools)

(defcustom unique-uid "nya-"
  ""
  :group 'org-toodledo
  :type 'string)

(defcustom password "mi-"
  ""
  :group 'org-toodledo
  :type 'string)

(defvar token nil)
(defvar key nil)


;;------------------------------------------------------------------------------
;; Authentication
;;------------------------------------------------------------------------------

;; tokenの取得
(defun toodledo-get-token (unique-uid)
  (toodledo-auth "api.toodledo.com" (concat
				     "/api.php?method=getToken;userid="
				     unique-uid)))
;; keyの取得
(defun toodledo-get-key (token)
  (md5 (md5 (concat (md5 password) token unique-uid))))

;; toodledo-get-tokenで使用
(defun toodledo-auth (server request-uri)
  (let ((buf (current-buffer))
	(proc nil)
	(token "a"))
    (with-temp-buffer
      (setq proc (open-network-stream
		  "test"
		  (current-buffer)
		  server
		  80))
      (set-process-coding-system proc 'binary 'binary)
      ;;(display-buffer (current-buffer))
      (process-send-string
       proc
       (format (concat
		"GET "
		request-uri
		" HTTP/1.0\r\n"
		"MINE-Version: 1.0\r\n"
		"\r\n")))
      (accept-process-output proc 5)
      (goto-char (point-min))
      (re-search-forward
       "<token>\\(.*\\)</token>" nil t)
      (setq token (match-string 1)))
    token))


;;------------------------------------------------------------------------------
;; Push
;;------------------------------------------------------------------------------

(defun org-toodledo-push ()
  (interactive)
  (when (string= token nil)
    ;; tokenの取得
    (setq token (toodledo-get-token unique-uid))
    ;; keyの取得
    (setq key (md5 (concat (md5 password) token unique-uid))))
  (let (properties
	title
	id
	url)
    (goto-char (point-min))
    (while (re-search-forward
	    "^\*+ TODO \\(\\[#.\\] \\)?\\([^\t\n]*\\)\t*\\([^\t]*\\)$" nil t)
      (setq url (concat "/api.php?method=addTask;key=" key ";"))
      
      ;;titleの取得
    (if (setq title (match-string-no-properties 2))
	(if (> (length title) 255)
	    (error "Over 255 character!\n")
	  (progn
	    (replace-regexp-in-string "&" "%26" title)
	    (replace-regexp-in-string ";" "%3B" title)
	    (setq url (concat url "title=" title ";")))))
      
      (setq properties (org-entry-properties (point) 'all))
      
      ;; idを持っているかどうか．
      (unless (setq id (cdr (assoc "ID" properties)))
	;; titleの取得
	(org-toodledo-get-tags-local properties url)
	(org-toodledo-get-startdate properties url)
	(org-toodledo-get-duedate properties url)
	(org-toodledo-get-priority properties url)
	(setq id (org-toodledo-http-push url id))
	(org-entry-put (point) "ID" id)))))

(defun org-toodledo-get-title-local (properties url)
  (let (title)
    (if (setq title (match-string-no-properties 2))
	(if (> (length title) 255)
	    (error "Over 255 character!\n")
	  (progn
	    (replace-regexp-in-string "&" "%26" title)
	    (replace-regexp-in-string ";" "%3B" title)
	    (setq url (concat url "title=" title ";")))))))

(defun org-toodledo-get-tags-local (properties tags)
  (let (tags)
    (if (setq tags (cdr (assoc "TAGS" properties)))
	(if (> (length tags) 64)
	    (error "Over 64character!\n")
	  (progn
	    (replace-regexp-in-string "&" "%26" title)
	    (replace-regexp-in-string ";" "%3B" title)
	    (replace-regexp-in-string ":" " " tags)
	    (setq url (concat url "tag=" tags ";")))))))

(defun org-toodledo-get-startdate (proeprties url)
  (let (startdate)
    (when (setq startdate (cdr (assoc "SCHEDULED" properties)))
      (string-match "\\(....-..-..\\) ." duedate)
      (setq url (concat url "startdate=" (match-string 1 startdate) ";")))))


(defun org-toodledo-get-duedate (properties url)
  (let (duedate)
    (when (setq duedate (cdr (assoc "DEADLINE" properties)))
      (string-match "\\(....-..-..\\) ." duedate)
      (setq url (concat url "duedate=" (match-string 1 duedate)";")))))

(defun org-toodledo-get-priority (properties url)
  (let (priority)
    (when (setq priority (cdr (assoc "PRIORITY" properties)))
      (cond ((string= priority "A") (setq priority (replace-regexp-in-string "A" "2" priority)))
	    ((string= priority "B") (setq priority (replace-regexp-in-string "B" "1" priority)))
	    ((string= priority "C") (setq priority (replace-regexp-in-string "C" "0" priority))))
      (setq url (concat url "priority=" priority)))))


(defun org-toodledo-http-push (request-uri id)
  (with-temp-buffer
    (let ((buf (current-buffer)))
      (setq proc (open-network-stream
		  "*temp*"
		  buf
		  "api.toodledo.com"
		  80))
      (set-process-coding-system proc 'binary 'binary)
      (display-buffer buf 'pop-up-window)
      (process-send-string
       proc
       (format (concat
		"GET "
		request-uri
		" HTTP/1.0\r\n"
		"MINE-Version: 1.0\r\n"
		"\r\n")))
      (accept-process-output proc 5)
      (goto-char (point-min))
      (goto-char (re-search-forward
		  "<added>\\(.*\\)</added>" nil t))
      (setq id (match-string 1)))))


(provide 'org-toodledo)

とりあえず動いているだけです．今後の予定としては，

• toodledoからTODOをorg-modeに登録する
• 削除に対応させる

位しか考えていません．

Permalink | コメント(0) | トラックバック(0) | 21:47