elisp で Google Calendar から祝日を取ってきてみた

Emacs

elisp だけで取れるか試してみた。elisp で書かれた google client としては以下のものがあるみたい

本当は g-client 使った方が楽そうなんだけど、elisp だけの実装ということで、今回は googleaccount.el を使ってみる。

googleaccount.el へのパッチ

Emacs23 で googleaccount.el を使うと parse のとこがうまく動かなかったからまずはパッチを当てる。作者さんには報告済み。

@@ -105,10 +105,11 @@
 
 (defun googleaccount-parse-response (&optional buffer alist)
   "Add (string) key=value pairs found in BUFFER to ALIST, and return it."
+  (declare (special url-http-end-of-headers))
   (save-excursion
     (if buffer (set-buffer buffer))
-    ;; FIXME: bound the search at the first blank line
-    (while (re-search-backward "^\\([A-Za-z]+\\)=\\(.+\\)$" nil t)
+    (goto-char (1+ url-http-end-of-headers))
+    (while (re-search-forward "^\\([A-Za-z]+\\)=\\(.+\\)$" nil t)
       (setq alist (list* (cons (match-string 1) (match-string 2)) alist))))
   alist)
 
@@ -165,6 +166,7 @@
 See also `googleaccount-login'.
 "
   (let* ((rr (list
+              (cons "accountType" "HOSTED_OR_GOOGLE")
               (cons "Email" email)
               (cons "Passwd" passwd)
               (cons "service" service)

googleaccount.el の使い方

googleaccount.el の使い方は簡単。

(googleaccount-login service mail pass)

ってすると google api を利用するための Authentication ヘッダを返してくれる。あとは let で url-request-extra-headers をその値に束縛して url-retrieve。サービスの一覧は http://code.google.com/intl/ja/apis/gdata/faq.html#clientlogin を見ればのってる。

祝日を取ってくる

あとはこんなんを作って、M-x gcalendar で gcalendar-entries に日本の祝日が入る。

(require 'googleaccount)
(require 'url-http)
(require 'mail-parse)
(require 'cl)

(defvar gcalendar-feed-url "http://www.google.com/calendar/feeds/japanese__ja@holiday.calendar.google.com/private/full")
(defvar gcalendar-auth nil)
(defvar gcalendar-entries nil)

(defun gcalendar-auth ()
  (or gcalendar-auth
      (setq 
       gcalendar-auth
       (googleaccount-login
        "cl" 
        (read-string "google email: ")
        (read-passwd "google password: ")))))

(defun gcalendar ()
  (interactive)
  (setq gcalendar-entries nil)
  (gcalendar-retrieve gcalendar-feed-url 'gcalendar-parse-controller))

(defun gcalendar-retrieve (url callback &rest args)
  (let ((url-request-extra-headers
         (list (gcalendar-auth))))
    (url-retrieve url callback args)))

(defun gcalendar-parse-controller (status)
  (unwind-protect
      (progn
        (when (assq :error status)
          (apply 'signal (cdr (assq :error status))))
        (let ((parsed (gcalendar-parse)))
          (setq gcalendar-entries
                (append gcalendar-entries
                        (plist-get parsed :entries)))
          (if (plist-get parsed :next)
              (gcalendar-retrieve (plist-get parsed :next)
                                 'gcalendar-parse-controller)
            (message "Gcalendar Finished!!")
            (sit-for 1))))
    (kill-buffer (current-buffer))))

(defun gcalendar-parse ()
  (declare (special url-http-end-of-headers
                    url-http-content-type))
  (let ((charset 
         (mail-content-type-get 
          (mail-header-parse-content-type url-http-content-type)
          'charset))
        (buf (current-buffer))
        (beg (1+ url-http-end-of-headers))
        xml entries next)
    (with-temp-buffer
      (insert-buffer-substring buf beg)
      (decode-coding-region (point-min) (point-max) 
                            (intern-soft (downcase charset)))
      (setq xml (xml-parse-region (point-min) (point-max))))
    (setq entries 
          (mapcar
           (lambda (x) (list (assq 'title x) (assq 'gd:when x)))
           (mapcar
            'cdr
            (remove-if-not (lambda (x) (eq (car x) 'entry))
                           (cdr (assq 'feed xml))))))
    (setq next
          (find-if
           (lambda (x) (string= (cdr (assq 'rel x)) "next"))
           (mapcar
            'cadr
            (remove-if-not (lambda (x) (eq (car x) 'link))
                           (cdr (assq 'feed xml))))))
    (setq next (cdr (assq 'href next)))
    (list :entries entries :next next)))

なんとなく


今日はここまで。