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