fixedpoint.jp - Remember The Milk から howm へ




Remember The Milk から howm へ

znz さんからお題を頂いたので、Remember The Milk に登録したタスクを howm の書式でインポートするプログラムを書きました。

アイディア:

出力例:

[2007-12-11]@ 帰省の切符を買う
[2007-12-23]@ [tag1,tag2] example (with due and tags)
[2007-12-27]@ 年賀状の投函
= 例1 (without due)
= [etc] 例2 (without due but tags)
= 例3 (without due or tags)
...

XML を howm の書式に変換するプログラム:

rtm2howm.scm
#!/usr/bin/env gosh
;; -*- conding: utf-8 -*-

(use gauche.charconv)
(use srfi-1)
(use sxml.ssax)
(use sxml.sxpath)

(define *rtm-output-encoding* "EUC-JP")
(define *rtm-namespace*
  '((atom  . "http://www.w3.org/2005/Atom")
    (xhtml . "http://www.w3.org/1999/xhtml")))

(define (entry->title entry)
  (and-let* ((t (assq 'atom:title (cdr entry))))
    (third t)))
(define entry->items (compose cdr third (lambda (entry) (assq 'atom:content (cdr entry)))))
(define (entry->due entry)
  (and-let* ((item (find (lambda (item) (string=? "rtm_due" (item->class item))) (entry->items entry))))
    (rxmatch-if (#/(\d+)[年\/-](\d+)[月\/-](\d+)[日\/-]/ (item->value item))
        (#f y m d)
      (apply format #f "~4,'0d-~2,'0d-~2,'0d" (map x->integer (list y m d)))
      #f)))
(define (find-tags items)
  (call/cc
   (lambda (cont)
     (for-each
      (lambda (item)
        (and-let* ((class (item->class item))
                   ((string=? "rtm_tags" class))
                   (v (item->value item)))
          (if (string=? v "なし")
              (cont #f)
              (cont (string-split v ", ")))))
      items)
     #f)))
(define entry->tags (compose find-tags entry->items))
(define item->class (compose second second second))
(define item->title (compose third third))
(define item->value (compose third fourth))

(define (entry->memo entry oport)
  (define (f str . params)
    (apply format oport (string-append str "\n") params))
  (let* ((title (entry->title entry))
         (due (entry->due entry))
         (tags (entry->tags entry))
         (cloud (if tags (format #f "[~a] " (string-join tags ",")) "")))
    (if due
        (f "[~a]@ ~a~a" due cloud title)
        (f "= ~a~a" cloud title))
    ))

(define (xml->howm iport oport)
  (let* ((proc (sxpath '(// atom:entry)))
         (tree (ssax:xml->sxml iport *rtm-namespace*))
         (entries (proc tree)))
    (for-each (cut entry->memo <> oport) entries)
    ))

(define (main args)
  (call-with-input-conversion (current-input-port)
    (lambda (iport)
      (call-with-output-conversion (current-output-port)
        (lambda (oport)
          (xml->howm iport oport))
        :encoding *rtm-output-encoding*))
    :encoding "*JP")
  0)

Emacs でのコマンドの定義:

rtm.el
(require 'w3m)

(defvar rtm-feed-url-prefix "https://www.rememberthemilk.com/atom/")
(defvar rtm-feed-content-type "application/atom+xml")
(defvar rtm-temporary-file-prefix "/tmp/rtm")
(defvar rtm-convert-program "/home/tabe/bin/rtm2howm.scm")

(defun rtm-retrieve (user)
  (interactive "sUser: ")
  (catch 'failed
    (let ((temp-file (make-temp-file rtm-temporary-file-prefix)))
      (unwind-protect
          (progn
            (set-file-modes temp-file ?\600)
            (with-temp-file temp-file
              (let ((content-type (w3m-retrieve (concat rtm-feed-url-prefix user "/") nil t)))
                (unless (equal rtm-feed-content-type content-type)
                  (throw 'failed (message "failed.")))))
            (call-process rtm-convert-program temp-file t t))
        (delete-file temp-file)
        ))))

動かすには:


© 2006,2007 Takeshi Abe