パッチが漏れてた
パッチがわたってなかった
--- c:\tools\xyzzy\site-lisp\ht.l.0423 Thu Apr 23 16:40:16 2009
+++ c:\tools\xyzzy\site-lisp\ht.l Fri May 01 17:35:55 2009
@@ -21,11 +21,14 @@
(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-list-buffer* "*Entry List*")
+(defvar *hateda-entry-buffer* "*Entry List*")
(defvar *debug-mode* nil)
@@ -34,6 +37,14 @@
(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)))
@@ -52,13 +63,67 @@
;; 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* #\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 hatena-atompub ()
+(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*)
+ ;(erase-buffer *hateda-entry-buffer*)
+ (hateda-get-entry-list)
+ )
+
;; コンフィグ読み込み
(defun load-config ()
(junk::load-config-file *config-file*))
@@ -71,7 +136,7 @@
(setq len (length entry))
(msgbox "~A" len)
(setq cnt 0)
- (dolist (item entry); (reverse *hateda-entry-list*))
+ (dolist (item entry)
(dolist (element item)
(when (listp element)
(cond ((equal "link" (car element))
@@ -82,7 +147,8 @@
(setq title (caddr element)))
((equal "updated" (car element))
(setq updated (caddr element)))
- )))
+ )
+ ))
(push (list link updated title) *hateda-entry-list*)
)))
@@ -96,56 +162,70 @@
;; Change mode-line title from Diary
(let* ((title (xml-title head)))
(msgbox "~A" title)
- (make-local-variable 'mode-line-format)
(setq mode-line-format (format nil "%b - ~A" (cdr title))))
(update-mode-line)
)
(when entry
; (hateda-entry-format-list entry))))
(create-entry-list entry)
- (msgbox "~A" *hateda-entry-list*)
+ ;(msgbox "~A" *hateda-entry-list*)
(print-entry-list))))
;; エントリ一覧のバッファ出力
(defun print-entry-list ()
- ;; ToDo ここでdolistつかって出力行ごとにTAGをセットする
- (insert (format nil "~:{~* [~A] ~A~%~}" *hateda-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*))
+ (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-entry-format-list (entry)
- (if (atom entry)
- nil
- (let* ((element (car entry))
- (title (cadr (xml-title element)))
- (link (cdr (caar (xml-link element))))
- (content (cadr (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)))
- ))
-
-;; 初期化（ユーザーID、パスワードの取得、コレクションURLの生成）
-(defun init ()
- (load-config)
- (setq *hateda-entry-list* 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*))))
- (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-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)
+ (hateda-get-entry-list)
+ (message "削除しました")))))))
+
+;; 指定されたURLへDELETEを送る
+(defun hateda-delete-entry (deleteurl)
+ (atomm::atomm-delete-entry deleteurl
+ *hateda-user*
+ *hateda-password*))
;; エントリのポスト
(defun hateda-post-new (data url)
(when *debug-mode*
; (msgbox "~S" url)
- (msgbox "~S" data))
+ (msgbox "~S: ~A" data url))
; (msgbox "~A" "debug")
(atomm::atomm-post-entry url *hateda-user* *hateda-password* data)
)
@@ -154,15 +234,18 @@
(defun hateda-post ()
(interactive "p")
(load-config)
- (let ((title (read-string "Entry Title: "))
- (data (list
- (list
- "entry"
- '(("xmlns" . "http://purl.org/atom/ns#"))
- (cons "title" (cons nil (cons title nil)))
- (cons "content" (cons nil (cons (buffer-substring (point-min) (point-max)) nil)))
- ))))
- (msgbox "~S" data)
+ (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)
(hateda-post-new data *hateda-user-url*)
))
+;; 終了
+(defun hateda-finish ()
+ (interactive)
+ (delete-buffer *hateda-entry-buffer*))
|<<
*1241166320*[xyzzy][hatena-atompub]エントリ削除機能の追加
明日から連休だけど、自分の時間が取れる気がしないので今日のうちにがっつりやってみた。今回は
- エントリ一覧へのtag情報設定
- エントリ一覧で指定したエントリの削除
- キーバインド設定（未作成関数分も含む）
ってところ。でもエントリ削除後の再読み込みでバッファの中身とテキスト属性がクリアされてないんだよなぁ…何でだろう？
>||
--- ht.l.0423 Thu Apr 23 16:40:16 2009
+++ ht.l Fri May 01 17:24:12 2009
@@ -21,11 +21,14 @@
(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-list-buffer* "*Entry List*")
+(defvar *hateda-entry-buffer* "*Entry List*")
(defvar *debug-mode* nil)
@@ -34,6 +37,14 @@
(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)))
@@ -52,13 +63,66 @@
;; 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* #\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 hatena-atompub ()
+(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)
+ (setq *hateda-entry-list* 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*))))
+ (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*)
+ ;(erase-buffer *hateda-entry-buffer*)
+ (hateda-get-entry-list)
+ )
+
;; コンフィグ読み込み
(defun load-config ()
(junk::load-config-file *config-file*))
@@ -71,7 +135,7 @@
(setq len (length entry))
(msgbox "~A" len)
(setq cnt 0)
- (dolist (item entry); (reverse *hateda-entry-list*))
+ (dolist (item entry)
(dolist (element item)
(when (listp element)
(cond ((equal "link" (car element))
@@ -82,7 +146,8 @@
(setq title (caddr element)))
((equal "updated" (car element))
(setq updated (caddr element)))
- )))
+ )
+ ))
(push (list link updated title) *hateda-entry-list*)
)))
@@ -96,56 +161,71 @@
;; Change mode-line title from Diary
(let* ((title (xml-title head)))
(msgbox "~A" title)
- (make-local-variable 'mode-line-format)
(setq mode-line-format (format nil "%b - ~A" (cdr title))))
(update-mode-line)
)
(when entry
; (hateda-entry-format-list entry))))
(create-entry-list entry)
- (msgbox "~A" *hateda-entry-list*)
+ ;(msgbox "~A" *hateda-entry-list*)
(print-entry-list))))
;; エントリ一覧のバッファ出力
(defun print-entry-list ()
- ;; ToDo ここでdolistつかって出力行ごとにTAGをセットする
- (insert (format nil "~:{~* [~A] ~A~%~}" *hateda-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*))
+ (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-entry-format-list (entry)
- (if (atom entry)
- nil
- (let* ((element (car entry))
- (title (cadr (xml-title element)))
- (link (cdr (caar (xml-link element))))
- (content (cadr (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)))
- ))
-
-;; 初期化（ユーザーID、パスワードの取得、コレクションURLの生成）
-(defun init ()
- (load-config)
- (setq *hateda-entry-list* 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*))))
- (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-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)
+ (hateda-get-entry-list)
+ (message "削除しました")))))))
+
+;; 指定されたURLへDELETEを送る
+(defun hateda-delete-entry (deleteurl)
+ (atomm::atomm-delete-entry deleteurl
+ *hateda-user*
+ *hateda-password*))
;; エントリのポスト
(defun hateda-post-new (data url)
+ (msgbox "~A" data)
(when *debug-mode*
; (msgbox "~S" url)
- (msgbox "~S" data))
+ (msgbox "~S: ~A" data url))
; (msgbox "~A" "debug")
(atomm::atomm-post-entry url *hateda-user* *hateda-password* data)
)
@@ -154,15 +234,18 @@
(defun hateda-post ()
(interactive "p")
(load-config)
- (let ((title (read-string "Entry Title: "))
- (data (list
- (list
- "entry"
- '(("xmlns" . "http://purl.org/atom/ns#"))
- (cons "title" (cons nil (cons title nil)))
- (cons "content" (cons nil (cons (buffer-substring (point-min) (point-max)) nil)))
- ))))
- (msgbox "~S" data)
+ (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)
(hateda-post-new data *hateda-user-url*)
))
+;; 終了
+(defun hateda-finish ()
+ (interactive)
+ (delete-buffer *hateda-entry-buffer*))
