Twitterクライアント

ちょっと脱線して見たくなったので
HTTPがしゃべれるならTwitterのクライアントが作れるはずだと思い作る。

既に結構やっている人がいるようだ。
http://cadr.g.hatena.ne.jp/g000001/?word=twitter&.submit=%E6%A4%9C%E7%B4%A2
http://read-eval-print.blogspot.com/2007/12/common-lisp-twitter-api.html

twitter自体の情報は
http://usy.jp/twitter/index.php?Twitter%20API

上の情報もあり簡単に作れた。
大変だったのはLtkの部分。
うまいレイアウトにするのが面倒臭かった。
pack関連については、要復習。

ソースコードは続きを読むで。

(asdf:operate 'asdf:load-op :ltk :verbose nil)
(asdf:operate 'asdf:load-op :drakma :verbose nil)
(asdf:operate 'asdf:load-op :cl-json :verbose nil)

(eval-when (:compile-toplevel :load-toplevel :execute)
  (require :drakma)
  (require :cl-json)
  (require :ltk)
  )
(defpackage :ltk-user
  (:use :common-lisp :ltk  :drakma))
(in-package :ltk-user)

;; 文字コードは UTF-8 で
(setf drakma:*drakma-default-external-format* :utf-8)
;; ボディを文字列で取得するために、テキストとして判定される Content-Type を追加
(pushnew '("application" . "json") drakma:*text-content-types* :test #'equal)
(defparameter *basic-authorization*
  (with-open-file (in (merge-pathnames #p".twitter.lsp" (user-homedir-pathname)))
		  (read in))
  "Basic 認証のパラメータを取得する。~/.twitter.lisp の中身は (\"username\" \"password\")")

;;公開コメント？を読む
(defun public-timeline ()
  "public_timeline を取得する。"
  (json:decode-json-from-string
   (drakma:http-request "http://twitter.com/statuses/public_timeline.json"
                        :basic-authorization *basic-authorization*)))
;;友人のコメントを読む
(defun friends-timeline ()
  "public_timeline を取得する。"
  (json:decode-json-from-string
   (drakma:http-request "http://twitter.com/statuses/friends_timeline.json"
                        :basic-authorization *basic-authorization*)))
;;自分のステータスを更新
(defun update (message)
  "statusを更新する。"
  (drakma:http-request "http://twitter.com/statuses/update.json"
		       :basic-authorization *basic-authorization*
		       :method :post
		       :parameters `(("status" . ,message))))

(defmacro select (accessor data)
  "各フィールドへ assoc でアクセスするマクロ。"
  `(reduce #'(lambda (acc key)
               `(cdr (assoc ,key ,acc)))
           ,accessor
           :initial-value ,data))

(defmacro select2 (accessor data)
  `(reduce #'(lambda (acc key)
               (cdr (assoc key acc)))
           ,accessor
           :initial-value ,data))

(defmacro with-selector (fields from &body body)
  (let ((data (gensym)))
    `(let ((,data ,from))
       (let ,(mapcar #'(lambda (x)
                         (list (car x) (select (cdr x) data)))
                     fields)
         ,@body))))

(defun get-friends-timeline ()
 (loop for each in (friends-timeline)
       collect (cons (select2 '(:user :name) each)  (select2 '(:text) each))))

(defun test ()
  (format t "hello~%")
  (after '5 #'test))

(let 
    ((username-list (mapcar #'car (get-friends-timeline)))
     (messages-list (mapcar #'cdr (get-friends-timeline))))
  (with-ltk ()
	    (wm-title *tk* "twitterクライアント")
	    (set-geometry-wh *tk* 1024 600)
	    (bind *tk* "<Alt-q>" (lambda (event) (setf *exit-mainloop* t)))
	    (let*
		((lbl1 (make-instance 'label :text "ここに入力してね♪"))
		 (input (make-instance 'entry))
		 (messages (mapcar #'(lambda (n)
				       (make-instance 'message :width 1024
                                             :text (format nil "~A:~A" (nth n username-list) (nth n messages-list) )))
				   '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 )  ))
		 (btn (make-instance 'button  :master nil  :text "更新"
				     :command #'(lambda ()
						  (setq username-list (mapcar #'car (get-friends-timeline)))
						  (setq messages-list (mapcar #'cdr (get-friends-timeline)))
						  (dolist (i '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 ) t)
						    (setf (text (nth i messages))
                                                      (format nil "~A:~A" (nth i username-list) (nth i messages-list) )))
						  messages-list
						  ))))
	      (pack (list lbl1 btn input messages ) :anchor :w)
	      ;;	      (after '5 #'test)
	      )))