自作lisp 本日の作業結果

昨日からの変更点。いろんなところからコードを真似させてもらいながら作ってるので理解にも時間がかかってなかなか大変。
とりあえず今日は取得したデータを新規に作成したバッファに書き出す方法を知った。うーんなるほど。

--- ht.l.0415   Wed Apr 15 16:57:35 2009
+++ ht.l        Thu Apr 16 16:24:01 2009
@@ -23,24 +23,91 @@

 (defvar *hateda-user* nil)
 (defvar *hateda-password* nil)
+(defvar *hateda-user-url* nil)
+
+(defvar *hateda-list-buffer* "Entry List")

 (defvar *debug-mode* nil)

 (defvar *base-directory* "~/.hateda-atompub")
 (defvar *config-file* (merge-pathnames "config.l" *base-directory*))

+;; macro定義 start
+(defmacro xml-value (key list)
+  `(cdr (assoc ,key ,list :test #'equal)))
+
+(defmacro xml-title (list)
+  `(xml-value "title" ,list))
+
+(defmacro xml-link (list)
+  `(xml-value "link" ,list))
+
+(defmacro xml-updated (list)
+  `(xml-value "updated" ,list))
+
+(defmacro xml-content (list)
+  `(xml-value "content" ,list))
+;; macro定義 end
+
+(defun hateda-mode ()
+  (interactive)
+  (init)
+  )
+
 (defun load-config ()
   (junk::load-config-file *config-file*))

+(defun hateda-get-entry-list ()
+  (interactive)
+  (multiple-value-bind (head entry)
+         (atomm::atomm-get-feed *hateda-user-url* *hateda-user* *hateda-password*)
+       (when head
+         (msgbox "~A" head)
+         ;; Change mode-line title from Diary
+         (let* ((title (xml-title head)))
+               (msgbox "~A" title)
+               (setq mode-line-format (format nil "%b - ~A" (cdr title))))
+         (update-mode-line)
+         )
+       (when entry
+         (hateda-entry-format-list entry)
+         )
+       )
+  )
+
+(defun hateda-entry-format-list (entry)
+  (if (atom entry)
+         nil
+       (let ((element (car entry)))
+         (setq title (cdr (xml-title element)))
+         (setq link (cdr (caar (xml-link element))))
+         (setq content (cdr (xml-content element)))
+         (insert (format nil "\n~A:~A:~A\n" title link content))
+         (when *debug-mode*
+               (msgbox "~A:~A:~A" title link content))
+         (hateda-entry-format-list (cdr entry)))
+       )
+  )
+(defun init ()
+  (load-config)
+  (while (not *hateda-user*)
+       (setq *hateda-user* (read-string "はてな Username: ")))
+  (while (not *hateda-password*)
+       (setq *hateda-password* (junk::read-password
+                                                        (format nil "Password (~A): " *hateda-user*))))
+  (setq *hateda-user-url* (format nil "http://d.hatena.ne.jp/~A/atom/blog" *hateda-user*))
+  (set-buffer (get-buffer-create *hateda-list-buffer*))
+  (erase-buffer *hateda-list-buffer*)
+  (hateda-get-entry-list)
+  )
+
 (defun hateda-post (data)
-  (let ((url nil))
-       (setq url (format nil "http://d.hatena.ne.jp/~A/atom/blog" *hateda-user*))
-       (when *debug-mode*
-;        (msgbox "~S" url)
-         (msgbox "~S" data))
-;      (msgbox "~A" "debug")
-       (atomm::atomm-post-entry url *hateda-user* *hateda-password* data)
-       ))
+  (when *debug-mode*
+       ;         (msgbox "~S" url)
+       (msgbox "~S" data))
+  ;    (msgbox "~A" "debug")
+  (atomm::atomm-post-entry *hateda-user-url* *hateda-user* *hateda-password* data)
+  )

 (defun hateda-post-entry ()
   (interactive "p")
@@ -53,12 +120,6 @@
                                 (cons "title" (cons nil (cons title nil)))
                                 (cons "content" (cons nil (cons (buffer-substring (point-min) (point-max)) nil)))
                                 )))
-       (while (not *hateda-user*)
-         (setq *hateda-user* (read-string "はてな Username: ")))
-       (while (not *hateda-password*)
-         (setq *hateda-password* (junk::read-password
-                                               (format nil "Password (~A): " *hateda-user*))))
-
        (hateda-post data)
        ))