hatena-atompub ver0.0.2

いくつか機能追加が完了したので、バージョン番号あげて全ソース貼り付け。もう少しきれいに書かないといけない気がするけど、そこは今後の課題にしよう。

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; はてな AtomPub を使用してはてなダイアリーを編集する
;;
;; version：0.0.2
;; 作者   ：arashi77（http://d.hatena.ne.jp/arashi77/）
;;
;; 依存ライブラリ：xml-paraser-modoki, atom-modoki, junk-lib
;;
;; 使用方法：
;;  - ht.lをload-libraryする
;;  - M-x hatena-atompub を実行する
;;  - config.lが無ければはてなユーザーID, パスワードを聞いてくるので入力
;;  - エントリ一覧が取得される
;;  -- エントリにカーソルを合わせて d でエントリの削除
;;  -- c で新規エントリ編集バッファオープン。はてな記法で入力後 C-c C-c でポスト
;;  -- r で最新のエントリ一覧を取得
;;  - q で終了
;; 
;; TODO:
;;  - 選択したエントリの内容を表示できるようにする
;;  - 選択したエントリの編集ができるようにする
;;
;; History
;;
;; 0.0.2: ・エントリ一覧（1ページ分＝20項目）を取得して表示するようにした
;;        ・エントリ一覧からエントリを削除可能にした
;;        ・新規エントリのポストができるようにした
;;        ・最新のエントリ一覧を取得できるようにした
;;
;; 0.0.1: 新規作成
;;        実行したバッファの中身をまるまる投稿する機能のみ。
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(provide "hatena-atompub")

(require "atomm/publish")

(defvar *hatena-atompub-mode-map* nil)

(defvar *hateda-user* nil)
(defvar *hateda-password* nil)
(defvar *hateda-user-url* nil)
(defvar *hateda-entry-attribute-related* nil)

(defvar *hateda-entry-buffer* "*Hatena::Diary*")
(defvar *hateda-edit-buffer*  "*Entry*")

(defvar *debug-mode* nil)

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

(defvar *hateda-entry-list* nil)

;; 取得したエントリから必要なものを格納する構造体
(defstruct hateda_entry
  link              ; メンバURI
  title             ; タイトル
  updated)          ; updated

(provide "hatena-atompub")

;; 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

;;
;; キーバインドの設定
;;
(unless *hatena-atompub-mode-map*
  (setq *hatena-atompub-mode-map* (make-sparse-keymap))
  (define-key *hatena-atompub-mode-map* #\SPC          'hateda-show-content)
  (define-key *hatena-atompub-mode-map* #\r            'hateda-get-entry-list)
  (define-key *hatena-atompub-mode-map* #\c            'hateda-create-entry)
  (define-key *hatena-atompub-mode-map* #\e            'hateda-edit-entry)
  (define-key *hatena-atompub-mode-map* #\d            'hateda-delete)
  (define-key *hatena-atompub-mode-map* #\q            'hateda-finish)
  )



;;
;; アプリケーション起動
;;
(defun user::hatena-atompub ()
  (interactive)
  (when (find-buffer *hateda-entry-buffer*)
    (set-buffer *hateda-entry-buffer*)
    (return-from user::hatena-atompub))
  (init)
  )

;; 初期化（ユーザーID、パスワードの取得、コレクションURLの生成）
(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-entry-buffer*))
  (setq need-not-save t)
  (setq buffer-read-only t)
  (setq kept-undo-information nil)
  (setq auto-save nil)
  (set-local-window-flags (selected-buffer)
			  *window-flag-line-number* nil)
  (set-local-window-flags (selected-buffer)
			  *window-flag-newline* nil)
  (set-local-window-flags (selected-buffer)
			  *window-flag-eof* nil)
  (set-local-window-flags (selected-buffer)
			  *window-flag-cursor-line* t)
  (set-local-window-flags (selected-buffer)
			  *window-flag-vscroll-bar* nil)
;  (set-local-window-flags (selected-buffer)
;			  *window-flag-ruler* nil)
  (set-local-window-flags (selected-buffer)
			  *window-flag-just-inverse* t)
  (set-buffer-fold-width nil)
  (make-local-variable 'mode-line-format)
  (make-local-variable 'title-bar-format)

  (use-keymap *hatena-atompub-mode-map*)
  (hateda-get-entry-list)
  )

;; コンフィグ読み込み
(defun load-config ()
  (junk::load-config-file *config-file*))

;; エントリ一覧をリストで格納
(defun create-entry-list (entry)
  (setq *hateda-entry-list* nil)
  (let* ((link nil)
	 (title nil)
	 (content nil))
    (setq cnt 0)
    (dolist (item entry)
      (dolist (element item)
	(when (listp element)
	  (cond ((equal "link" (car element))
		 (if (equal "edit" (cdr (assoc "rel" (cadr element) :test 'string=)))
		     (setq link (cdr (assoc "href" (cadr element) :test 'string=)))
		   ))
		((equal "title" (car element))
		 (setq title (caddr element)))
		((equal "updated" (car element))
		 (setq updated (caddr element)))
		)
	  ))
      (push (list link updated title) *hateda-entry-list*)
      )))

;; エントリ一覧の取得
(defun hateda-get-entry-list ()
  (interactive)
  (multiple-value-bind (head entry)
	  (atomm::atomm-get-feed *hateda-user-url* *hateda-user* *hateda-password*)
	(when head
	  (when *debug-mode*
	    (msgbox "~A" head))
	  ;; Change mode-line title from Diary
	  (let* ((title (xml-title head)))
		(when *debug-mode*
		  (msgbox "~A" title))
	    ;(setq mode-line-format (format nil "%b - ~A" (cdr title))))
	    (setq mode-line-format (format nil "--%*- %b ~A [%k:%l] %P %f" (cdr title))))
	  (update-mode-line)
	  )
	(when entry
;	  (hateda-entry-format-list entry))))
	  (create-entry-list entry)
	  ;(msgbox "~A" *hateda-entry-list*)
	  (print-entry-list))))

;; エントリ一覧のバッファ出力
(defun print-entry-list ()
  (junk::modify-read-only-buffer
      (progn
	(clear-all-text-attributes)
	(erase-buffer (selected-buffer))
	
	;; dolistつかって出力行ごとにTAGにhateda_entry構造体をセットする
	(dolist (column (reverse *hateda-entry-list*))
	  (setq str_entry (make-hateda_entry))
	  (setf (hateda_entry-link str_entry) (car column))
	  (setf (hateda_entry-updated str_entry) (cadr column))
	  (setf (hateda_entry-title str_entry) (caddr column))
	  (apply #'set-text-attribute
		 (point)
		 (progn
		   (insert (format nil "[~A] ~A~%" (cadr column) (caddr column)))
		   (point))
		 ;(car column)
		 str_entry
		 *hateda-entry-attribute-related*))
	(when *debug-mode*
	  (msgbox "~A" (list-text-attributes)))
	)))

;; 現在のpointからtag情報を取得する
(defun hatena-atompub-current-tag ()
  (multiple-value-bind (from to tag foreground background bold underline strike-out prefix extend)
      (find-text-attribute-point (point))
    (progn
      tag)))

;; エントリの削除
(defun hateda-delete ()
  (interactive)
  (let ((tag (hatena-atompub-current-tag)))
    (when (hateda_entry-p tag)
      (let ((url (hateda_entry-link tag)))
	(when (and url
		   (yes-or-no-p "~@Aを削除しますか？"
				(hateda_entry-title tag)))
	  (when (hateda-delete-entry url)
	    (sleep-for 2) ; 削除の反映を2秒waitする
	    (hateda-get-entry-list)
	    (message "削除しました")))))))

;;
;; 新規エントリの作成
;;
(defun hateda-create-entry ()
  (interactive)
  (set-buffer (get-buffer-create *hateda-edit-buffer*))
  (local-set-key '(#\C-c #\C-c) 'hateda-post)
  )

;; エントリのポスト
(defun hateda-post-new (data url)
  (when *debug-mode*
	;	  (msgbox "~S" url)
    (msgbox "~S: ~A" data url))
  ;	(msgbox "~A" "debug")
  (atomm::atomm-post-entry url *hateda-user* *hateda-password* data)
  )

;; 新規エントリの投稿
(defun hateda-post ()
  (interactive "p")
  (load-config)
  (if (equal (buffer-name (selected-buffer)) *hateda-edit-buffer*)
      (let* ((title (read-string "Entry Title: "))
	     (data (list
		    (list "entry"
			  (list (cons "xmlns" "http://purl.org/atom/ns#"))
			  (list "title" nil title)
			  (list "content" nil (buffer-substring (point-min) (point-max))))
		    )))
	;    (msgbox "~S" data)
	(when (hateda-post-new data *hateda-user-url*)
	  (delete-buffer *hateda-edit-buffer*)
	  (sleep-for 2)
	  (hateda-get-entry-list))
	)
    ))

;; 指定されたURLへDELETEを送る
(defun hateda-delete-entry (deleteurl)
  (atomm::atomm-delete-entry deleteurl
			     *hateda-user*
			     *hateda-password*))

;; 終了
(defun hateda-finish ()
  (interactive)
  (delete-buffer *hateda-entry-buffer*))