Muse で書いて Blogger にポストするプログラム

sak さんがコメントをくれたのでドキュメントを書きました。sak さんきっかけありがとうございます。

概要

とにかく Emacs から Blogger に投稿したかった。どうせなら Muse で書きたかった。simple-hatena-mode とかうらやましかった。というわけで作ってみたものです。

できること。

• 新規投稿
• 投稿したものの修正

めんどうなところ

• Slime 経由なので M-x slime とか事前にしておく必要がある。
• 新規投稿後、元ファイルの末尾に post-id をくっつけるので、Emacs 上で再読み込みする必要がある。
• カテゴリにはまだ対応してない。
• Web 上で編集したものとローカルの Muse ファイルの同期はとれない。Muse -> Web の一方通行。
• slime の repl バッファを見てないと、投稿が完了したかどうか分からない;)

必要なもの

• Emacs
• Emacs Muse
• SBCL
• SLIME
• Drakma
• CL-PPCRE
• S-XML

Drakma等は asdf-install を使って次のようにインストールするのが簡単だと思います。他には clbuild を使う方法もあります。

CL-USER> (require :asdf-install)
("ASDF-INSTALL")
CL-USER> (asdf-install:install :drakma)
Install where?
1) System-wide install:
   System in /usr/lib/sbcl/site-systems/
   Files in /usr/lib/sbcl/site/
2) Personal installation:
   System in /home/ancient/.sbcl/systems/
   Files in /home/ancient/.sbcl/site/
 --> 2

ここで 2 を入力してください。

No key found for key id 0x#1=595FF045057958C6.  Try some command like
  gpg  --recv-keys 0x#1#
   [Condition of type ASDF-INSTALL::KEY-NOT-FOUND]

Restarts:
 0: [SKIP-GPG-CHECK] Don't check GPG signature for this package
 1: [ABORT] Return to SLIME's top level.
 2: [TERMINATE-THREAD] Terminate this thread (#<THREAD "repl-thread" {10034FE621}>)

みたいなのが表示されたら 0 を入力してください。あと同様に cl-ppcre 等をインストールしてください。

(asdf-install:install :cl-ppcre)
(asdf-install:install :s-xml)

インストール

取得

最新バージョンを Subversion で取得します。dot.blogger.lisp を ~/.blogger.lisp にコピーします。

$ mkdir ~/lisp
$ cd ~/lisp
$ svn checkout http://cl-blogger.googlecode.com/svn/trunk/ blogger
$ cd blogger
$ cp dot.blogger.lisp ~/.blogger.lisp

~/.blogger.lisp の編集

~/.blogger.lisp を編集します。

設定内容は次のとおりです。

*author*

投稿ユーザ名

*email*

投稿ユーザ email

*passwd*

Blogger のパスワード

*blog-id*

ブログID

ブログIDは Blogger のソースを表示すると次のような個所があると思いますので、"blogId=" の後のものを指定してください。

<link rel="EditURI" type="application/rsd+xml" title="RSD" href="http://www.blogger.com/rsd.g?blogID=1096313046657120208" />

asdf:*central-registry* への追加

~/.sbclrc 等で asdf:*central-registry* に blogger.asdのあるディレクトリを追加してください。

(pushnew (merge-pathnames #p"lisp/blogger/" (user-homedir-pathname))
         asdf:*central-registry*
         :test #'equal)

~/.emacs の編集

~/.emacs に次の2行を追加してください。

(setq load-path (cons (expand-file-name "~/lisp/blogger") load-path))
(autoload 'blogger-post "blogger" "Blogger Post" t)

使い方

まず M-x slime 等で Slime を起動しておいてください。

Muse の書式で投稿内容を編集してください。

1行目は "#title" で始めてください。投稿の際にタイトルとして使います。

; labels: で始まる行にコンマ区切りでラベルを指定することができます。

#title 題名

投稿内容。。。
 ; labels: ブログ, Common Lisp

↑ ; labels: は行頭に記述してください。;の前にスペースは入れないでください。(Muse で example タグの中に "; " で始まる行を書くにはどうすればいいんだろう？)

M-x blogger-post で投稿します。

投稿後には Muse ファイルの末尾にポストIDを追加しますので、投稿後に再編集する場合はC-x C-v などで Muse ファイルを再読込してください。

末尾のポストIDを保持するために次のような行が付加されます。

 ; post-id 3534792244000900117

上記のようなポストIDの行があると M-x blogger-post は既存エントリの置き換えになります。

[Common Lisp][Drakma] Drakma 使用時の注意事項

はてなと同じ内容だけど Muse で書いて投稿してみるテスト。

Drakma を使うときの注意事項。

• *drakma-default-external-format* で external-format を指定しておく。
• text/* 以外の Content-Type をテキストとして扱いたいときは、*text-content-types* に追加する。
• Content-Length は省略すると文字数でカウントされるため、バイト数で明示的に指定する。かならずしも、そうでもないらしい。。。

(use-package :drakma)

;; UTF-8
(setq *drakma-default-external-format* :utf-8)

;; application/atom+xml をバイナリではなくテキストとして扱う。
(pushnew (cons "application" "atom+xml") *text-content-types*
         :test #'equal)

;; Content-Length はバイトサイズで指定する。
(http-request "http://www.example.com/"
              :method :post
              :content post-data
              :content-length (length (sb-ext:string-to-octets
                                       post-data :external-format :utf-8)))

Muse では * が強調指定なのでスペシャル変数がめんどうなことになる。literal タグで囲まないといけない。

<literal>*drakma-default-external-format*</literal>

はてなスターを付けてみた。でもはずそうかな。

試しにクリックしてみる。

でも、うまくいかないな。User Name を入れてサブミットすると、「すでにログインされています」というはてなのサイトに遷移後、自動的のはてなのトップサイトに遷移してしまう。なんでだろう？

なんかだめだからはずしちゃおうかな。

はずした。

[Common Lisp] Emacs Muse で書いて、Common Lisp 経由で Blogger に投稿する

とにかく Emacs から Blogger に投稿したかった。どうせなら Muse で書きたかった。simple-hatena-mode とかうらやましかった。というわけで作ってみた。

できること。

• 新規投稿
• 投稿したものの修正

めんどうなところ

• Slime 経由なので M-x slime とか事前にしておく必要がある。
• 新規投稿後、元ファイルの末尾に post-id をくっつけるので、Emacs 上で再読み込みする必要がある。
• カテゴリにはまだ対応してない。
• Web 上で編集したものとローカルの Muse ファイルの同期はとれない。Muse -> Web の一方通行。
• slime の repl バッファを見てないと、投稿が完了したかどうか分からない;)

これで随分と快適になった。howm で Muse を使うようにしているので、howm でメモをとり、まとまったらそのまま Blogger にポストできる。はてなに移行した理由の半分くらいがなくなった。Muse なら htmlize で Emacs の表示そのままソースに色が付くしね。

ちょっと量が多いが載っける。

blogger.asd

;;;; -*- Mode: LISP; -*-
(asdf:defsystem :blogger
  :version "0.0.0"
  :serial t
  :components ((:file "packages")
               (:file "blogger"))
  :depends-on (drakma cl-ppcre cl-interpol s-xml))

packages.lisp

(defpackage :blogger
    (:use :cl :drakma :cl-ppcre)
  (:export :post))

blogger.lisp

(in-package :blogger)

(defvar *author* nil)
(defvar *email* nil)
(defvar *passwd* nil)
(defvar *blog-id* nil)

(defvar *blogger* nil)

(load (merge-pathnames #p".blogger.lisp" (user-homedir-pathname)))

;; CL-INTERPOL を使う
(cl-interpol:enable-interpol-syntax)

;; Drakma の設定
;; UTF-8
(setq *drakma-default-external-format* :utf-8)
;; application/atom+xml をバイナリではなくテキストとして扱う。
(pushnew (cons "application" "atom+xml") drakma:*text-content-types*
         :test #'equal)

;; s-xml
;; ネームスペースを使わない
(setf s-xml:*ignore-namespaces* t)

(defclass blogger ()
  ((sid :initform nil :accessor sid)
   (lsid :initform nil :accessor lsid)
   (auth :initform nil :accessor auth)
   (blog-id :initform *blog-id* :accessor blog-id)
   (author :initform *author* :accessor author)
   (email :initform *email* :accessor email)
   (passwd :initform *passwd* :accessor passwd)
   (latest-entry :initform nil :accessor latest-entry)))

(defmethod login-parameters ((blogger blogger))
  `(("Email" . ,(email blogger))
    ("Passwd" . ,(passwd blogger))
    ("service" . "blogger")
    ("source" . "tahara-lisp-1")))


(defmethod login ((blogger blogger))
  (register-groups-bind (sid lsid auth)
      ((create-scanner "^SID=(.*)\\nLSID=(.*)\\nAuth=(.*)$" :multi-line-mode t)
       (http-request "https://www.google.com/accounts/ClientLogin"
                     :method :post
                     :parameters (login-parameters blogger)))
    (or auth (error "loign failed."))
    (setf (sid blogger) sid
          (lsid blogger) lsid
          (auth blogger) auth)))

(defmethod request ((blogger blogger) url &rest rest)
  (apply #'http-request
         url
         :additional-headers
         `(("Authorization"
            . ,#?"GoogleLogin auth=${(auth blogger)}"))
         rest))

(defmethod list-of-blogs ((blogger blogger))
  (request blogger "http://www.blogger.com/feeds/default/blogs"))

(defmethod retrive-posts ((blogger blogger))
  (request
   blogger
   #?"http://www.blogger.com/feeds/${(blog-id blogger)}/posts/default"))

(defmethod retrive-entry ((blogger blogger) entry-id)
  (let ((res (request
              blogger
              #?"http://www.blogger.com/feeds/${(blog-id blogger)}/posts/default/${entry-id}")))
    (print res)
    (setf (latest-entry blogger) (s-xml:parse-xml-string res))))



(defmethod send-entry ((blogger blogger) url method post-data)
  (print post-data)
  (let ((res (request blogger
                      url
                      :method method
                      :content-type "application/atom+xml"
                      :content-length
                      (length (sb-ext:string-to-octets
                               post-data :external-format :utf-8))
                      :content post-data)))
    (print res)
    (setf (latest-entry blogger) (s-xml:parse-xml-string res))))

(defmethod post-entry ((blogger blogger) title contents)
  (let*
      ((url #?"http://www.blogger.com/feeds/${(blog-id blogger)}/posts/default")
       (post-data #?"<entry xmlns='http://www.w3.org/2005/Atom'>
  <title type='text'>${title}</title>
  <content type='xhtml'>${contents}</content>
  <author>
    <name>${(author blogger)}</name>
    <email>${(email blogger)}</email>
  </author>
</entry>"))
    (send-entry blogger url :post post-data)))

(defmethod edit-entry ((blogger blogger) title content)
  (replace-title blogger title)
  (replace-content blogger content)
  (let ((post-data (s-xml:print-xml-string (latest-entry blogger ))))
    (send-entry blogger
                (print (edit-href blogger))
                :put
                post-data)))

(defmethod replace-xml ((blogger blogger) tag text)
  (setf (cdr (find tag (latest-entry blogger) :key #'find-key))
        (list text)))

(defmethod replace-title ((blogger blogger) title)
  (replace-xml blogger :|title| title))

(defmethod replace-content ((blogger blogger) content)
  (replace-xml blogger :|content| content))

(defmethod edit-href ((blogger blogger))
  (second
   (member :|href|
           (car
            (find '(:|link| :|rel| "edit")
                  (latest-entry blogger)
                  :key #'(lambda (x)
                           (and (consp (car x))
                                (=  (length (car x)) 7)
                                (subseq (car x) 0 3)))
                  :test #'equal)))))

(defun find-key (x)
  (and (consp (car x)) (caar x)))

(defmethod delete-entry ((blogger blogger))
  (request blogger (edit-href blogger) :method :delete))


(defun get-additional-info (muse-file)
  (let (title post-id)
    (with-open-file (in muse-file)
      (loop for l = (read-line in nil nil)
            while l
            do (progn
                 (register-groups-bind (ttl)
                     ("^#title\\s*(.+)" l)
                   (setf title ttl))
                 (register-groups-bind (pstid)
                     ("^; post-id (.+)" l)
                   (setf post-id pstid)))))
    (values title post-id)))

(defun html-file (muse-file)
  (let ((file (make-pathname :directory "tmp"
                             :type "html"
                             :defaults muse-file)))
    (if (probe-file file)
      file
      (make-pathname :directory "tmp"
                     :type #?"${(pathname-type muse-file)}.html"
                     :defaults muse-file))))

(defun get-content-from-file (file)
  (with-output-to-string (out)
    (with-open-file (in file)
      (loop for line = (read-line in nil nil)
            with pre-p = nil
            while line
            do (progn
                 (write-string line out)
                 (cond ((eql 0 (search "<pre" line))
                        (setf pre-p t))
                       ((eql 0 (search "</pre>" line))
                        (setf pre-p nil))
                       (t
                        (when pre-p (terpri out)))))))))

(defun add-post-id-to-file (muse-file)
  (register-groups-bind (post-id) (".*/(.*)" (edit-href *blogger*))
    (let ((content (with-output-to-string (out)
                     (with-open-file (in muse-file)
                       (loop for c = (read-char in nil nil)
                             while c
                             do (write-char c out))))))
      (with-open-file (out muse-file :direction :output :if-exists :supersede)
        (write-string content out)
        (format out "~&; post-id ~a~%" post-id)))))

;;;; api
(defun post (muse-file)
  (setf *blogger* (make-instance 'blogger))
  (login *blogger*)
  (let ((content (get-content-from-file (html-file muse-file))))
    (multiple-value-bind (title post-id) (get-additional-info muse-file)
      (if post-id
        ;; 修正
        (progn
          (retrive-entry *blogger* post-id)
          (edit-entry *blogger* title content))
        ;; 新規
        (progn
          (post-entry *blogger* title content)
          (add-post-id-to-file muse-file)))))
  *blogger*)

blogger.el Slime で同じように funcall read-from-string している理由がようやくわかった。read 時点では blogger パッケージはまだ存在しないからだ。

;; Blogger 用のスタイル
(setq muse-blogger-markup-strings
      (copy-tree muse-html-markup-strings))

(mapcar #'(lambda (arg)
            (rplacd (assoc (car arg) muse-blogger-markup-strings)
                    (cdr arg)))
        '((section           . "<h3>")
          (section-end       . "</h3>")
          (subsection        . "<h4>")
          (subsection-end    . "</h4>")
          (subsubsection     . "<h5>")
          (subsubsection-end . "</h5>")
          (section-other     . "<h6>")
          (section-other-end . "</h6>")
          (begin-example     . "<pre class='src'>")))
(muse-derive-style
 "blogger" "html"
 :header  ""
 :footer  ""
 :strings 'muse-blogger-markup-strings
 )

(defun blogger-post ()
  (interactive)
  (save-buffer)
  (muse-publish-this-file (muse-style "blogger") "/tmp" t)
  (slime-repl-send-string
   (format "(progn (require :blogger) (funcall (read-from-string \"blogger:post\") #p\"%s\"))"
           (buffer-file-name))))

~/.blogger.lisp

;; -*- lisp -*-
(in-package :blogger)

(setf *author*  "Your name"
      *email*   "your-email@gmail.com"
      *passwd*  "password"
      *blog-id* "1096313046657120208")

~/.emacs

;;;; blogger
(add-path (expand-file-name "~/letter/lisp/lib/blogger"))
(autoload 'blogger-post "blogger" "Blogger Post" t)

忘れられる

何度言っても忘れられるのはどうしてなんだろう？
軽く見られてるのかな？

誕生日プレゼント

タッチパッド GP415UB を買った。
誕生日プレゼントで買ってもらったのかな？

これで会社でも、ここの2枚目の写真の状態になれる。
これをひざの上において使うのがいいのさ。

新しいかめさん

新しいかめさん注文してもらちゃった♪
http://www.vshopu.com/ad_GP415UB/index.html
また鉱物粘土を調達しないと。

娘ハッカーデビュー

5歳にしてハッカーデビュー。といっても Squeak を触っただけだけど。
まずは 1 + 1 とかあらかじめ入力しておいて リンゴ+p を押させる。
「ほら、2って出てきたでしょう。」
「うん。」
「好きな数字を押してごらん。」
「なんでもいいの？」
「なんでもいいよ。」
最初に押した数字は0。
いきない0を押すとはなかなかつわものだな、と思いつつ見てるとどんどん数字を入力していく
「もう一回5を押してもいいの？」
と二回目の5を押す前にきいてきた。
「何回でもいいよ。」
ずいぶん長い数字を押したあと + を入力させる。
で次また数字を入力しはじめるが今度は 201 と短めの数字の入力した。
リンゴ+p を押させる。
「これが答えだね。」
「うん。。。これね電話番号になってるの。」
よく見ると最初に0から入力した数字が実家の電話番号になっている。
あぁ、このこはあなどれないな、と思った。

次は Squeak でのお絵描き。
ホイミスライムを描く娘。
できあがったホイミスライムをクリックするたびに「ワハハ」と言いながら45°ずつ回転するようにしてやる。
すると母子ともに大喜び。

「ワハハ」と言いながら回転するホイムスラムが夢に出ませんように。

Emacs 番号をふる。query-replace-regexp-eval が便利

aaa
bbb
ccc
を
1. aaa
2. bbb
3. ccc
と頭に番号をふっていきたい場合、Emacs だと
リージョンを指定して C-x n n で narrow-to-region
M-x query-replace-regexp-eval
^
(format "%d. " (1+ replace-count))
!
C-x n w でリージョンを戻す。
かしら。
ファイル全体とか数行までなら、rarrow-to-region はいらないけど。
query-replace-regexp-eval はとても便利。

娘のピアノの発表会

娘の初めてのピアノの発表会。
先生は「落ちついて弾いていましたね。」と。たしかに。
なかなかいい音を出していたのではないかな。
よくがんばった。
来年はきっと連れ合いも発表会に出るだろう。

ケヤキ並木

ケヤキ並木の南側のカヤキがいっせいに葉をしげらせだした。
大好きな季節だ。