2008/04/30

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

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

概要

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

できること。

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

めんどうなところ

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

必要なもの

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 は既存エントリの置き換えになります。

2008/04/29

[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)

2008/04/28

忘れられる

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

2008/04/26

誕生日プレゼント

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

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

2008/04/23

新しいかめさん

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

2008/04/16

娘ハッカーデビュー

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

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

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

2008/04/13

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 はとても便利。

2008/04/06

娘のピアノの発表会

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

2008/04/02

ケヤキ並木

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