added cl-twit-repl/aliases etc

.gitignore

@@ -4,4 +4,5 @@
 *.abcl
 *.lx64fsl
 *.fasl
-*.ht
+*.ht
+*.alias

api/conditions.lisp

@@ -1,15 +1,15 @@
-(in-package :twitter)
+(in-package :cl-twitter)
 
 ;;
 ;; Errors
 ;;
 
 (define-condition twitter-api-condition (error)
   ((return-code :reader return-code :initarg :code)
-   (short    :reader short-message :initarg :short)
-   (long     :reader long-message  :initarg :long)
-   (request :reader request-message :initarg :request)
-   (uri      :reader request-uri :initarg :uri))
+   (short       :reader short-message :initarg :short)
+   (long        :reader long-message  :initarg :long)
+   (request     :reader request-message :initarg :request)
+   (uri         :reader request-uri :initarg :uri))
   (:report (lambda (c stream)
 	     (format stream "Error code ~A (~A): '~A'~%in request to ~A"
 		     (return-code c) (short-message c)
@@ -28,3 +28,11 @@
 
 
 
+(defmacro with-error-handler ((&key (verbose nil)) &rest body)
+  `(progn
+     (handler-case
+	 ,@body
+       (twitter-api-condition (c) 
+	 (when ,verbose (format t "twitter signaled an error : ~S : ~S ~%" (return-code c) (short-message c))))
+       (error (c)
+	 (when ,verbose (format t "an error occured : ~S ~%" c))))))

api/package.lisp

@@ -44,6 +44,7 @@
    #:retweet
    #:retweets
    #:retweeted-by
+   #:@mention
 
    ;; Trends resources
    #:trends

api/twitter-show.lisp

@@ -2,70 +2,80 @@
 
 (defvar *seperator* "--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------")
 
-(defgeneric show (obj))
 
-(defmethod show ( (obj t))
-  (format t "~&~1t~S~%" obj))
+(defgeneric show (obj &optional s ))
 
-(defmethod show ((obj cons))
-  (length (mapcar #'show obj)))
+(defmethod show ( (obj t) &optional (s *standard-output*))
+  (format s "~&~1t~S~%" obj))
 
-(defmethod show ((obj hash-table))
-  (maphash (lambda (k v) (show v)) obj))
+(defmethod show ((obj cons) &optional (s *standard-output*))
+  (length (mapcar (lambda (el) (show el s)) obj)))
 
-(defmethod show ((tweet tweet))
-  (format t "~&~150<~a~; ~a~>" (twitter-user-screen-name (tweet-user tweet)) (tweet-created-at tweet))
-  (format t "~&~A" (tweet-text tweet))
-  (format t "~&~A" *seperator*))
+(defmethod show ((obj hash-table) &optional (s *standard-output*))
+  (maphash (lambda (k v) (declare (ignore k)) (show v s)) obj))
 
-(defmethod show ((trend-list trend-list))
+(defmethod show ((tweet tweet) &optional (s *standard-output*))
+  (format s "~&~150<~a~; ~a~>" (twitter-user-screen-name (tweet-user tweet)) (tweet-created-at tweet))
+  (format s "~&~A" (tweet-text tweet))
+  (format s "~&~A" *seperator*))
+
+(defmethod show ((trend-list trend-list) &optional (s *standard-output*))
   (let ((location  (car (trend-list-locations trend-list)))
 	(trend-list (trend-list-trends    trend-list)))
     (dolist (trend trend-list)
-      (format t "~&~1t~A~40t~A~80t~A" (place-name location) (trend-name trend) (trend-url trend))
-      (format t "~&~A" *seperator*))))
+      (format s "~&~1t~A~40t~A~80t~A" (place-name location) (trend-name trend) (trend-url trend))
+      (format s "~&~A" *seperator*))))
 
-(defmethod show ((trend trend))
-  (format t "~&~120<~1t~a~; ~a~>" (trend-name trend) (trend-url trend))
-  (format t "~&~A" *seperator*))
+(defmethod show ((trend trend) &optional (s *standard-output*))
+  (format s "~&~120<~1t~a~; ~a~>" (trend-name trend) (trend-url trend))
+  (format s "~&~A" *seperator*))
 
-(defmethod show ((search-ref cl-twitter::search-ref))
-  (format t "~&~150<From: ~a~; To: ~a~>" (search-ref-from-user search-ref) (or (search-ref-to-user search-ref) ""))
-  (format t "~&~A" (search-ref-text search-ref))
-  (format t "~&~A" (search-ref-created-at search-ref))
-  (format t "~&~A" *seperator*))
+(defmethod show ((search-ref cl-twitter::search-ref) &optional (s *standard-output*))
+  (format s "~&~150<From: ~a~; To: ~a~>" (search-ref-from-user search-ref) (or (search-ref-to-user search-ref) ""))
+  (format s "~&~A" (search-ref-text search-ref))
+  (format s "~&~A" (search-ref-created-at search-ref))
+  (format s "~&~A" *seperator*))
 
-(defmethod show ((twitter-user twitter-user))
-  (format t "~&~1t~A ~30ttimezone : ~A ~70turl     : ~A ~140tcreated   : ~A" (twitter-user-screen-name twitter-user) (twitter-user-time-zone twitter-user) 
+(defmethod show ((twitter-user twitter-user) &optional (s *standard-output*))
+  (format s "~&~1t~A ~30ttimezone : ~A ~70turl     : ~A ~140tcreated   : ~A" (twitter-user-screen-name twitter-user) (twitter-user-time-zone twitter-user) 
 	  (twitter-user-url twitter-user) (twitter-user-created-at twitter-user) )
-  (format t "~&~1tname : ~S ~30tstatuses : ~A ~70tfriends : ~A ~120tfollowers : ~A ~140tfollowing : ~A" (twitter-user-name twitter-user) 
+  (format s "~&~1tname : ~S ~30tstatuses : ~A ~70tfriends : ~A ~120tfollowers : ~A ~140tfollowing : ~A" (twitter-user-name twitter-user) 
 	  (twitter-user-statuses-count twitter-user) (twitter-user-friends-count twitter-user) 
 	  (twitter-user-followers-count twitter-user) (twitter-user-following twitter-user)) 
-  (format t "~&~1t~A" (twitter-user-description twitter-user))
-  (format t "~&~A" *seperator*))
+  (format s "~&~1t~A" (twitter-user-description twitter-user))
+  (format s "~&~A" *seperator*))
+
+(defmethod show ((geo-place geo-place) &optional (s *standard-output*))
+  (format s "~&~1t~A~15t~A " (geo-place-place-type geo-place) (geo-place-full-name geo-place)) 
+  (format s "~80t~A" (geo-attribute-street-address (geo-place-attributes geo-place)))
+  (format s "~120t~A" (geo-place-country geo-place) )
+  (format s "~&~A" *seperator*))
 
-(defmethod show ((geo-place geo-place))
-  (format t "~&~1t~A~15t~A " (geo-place-place-type geo-place) (geo-place-full-name geo-place)) 
-  (format t "~80t~A" (geo-attribute-street-address (geo-place-attributes geo-place)))
-  (format t "~120t~A" (geo-place-country geo-place) )
-  (format t "~&~A" *seperator*))
+(defmethod show ((place place) &optional (s *standard-output*))
+  (format s "~&~1t~A~30t~A~60t~A" (place-name place) (place-type-name (place-placetype place))  (place-country place) )
+  (format s "~90twoeid : ~A~110tcoutry code : ~A" (place-woeid place) (place-countrycode place) )
+  (format s "~&~A" *seperator*))
 
-(defmethod show ((place place))
-  (format t "~&~1t~A~30t~A~60t~A" (place-name place) (place-type-name (place-placetype place))  (place-country place) )
-  (format t "~90twoeid : ~A~110tcoutry code : ~A" (place-woeid place) (place-countrycode place) )
-  (format t "~&~A" *seperator*))
+(defmethod show ((list-type list-type) &optional (s *standard-output*))
+  (format s "~&~1t~a~35t~a~90t~a" (list-type-slug list-type) (list-type-full-name list-type) (list-type-description list-type))
+  (format s "~&~90tid : ~a~100towner : ~a members : ~a mode :~a " (list-type-id list-type) (twitter-user-screen-name (list-type-user list-type)) (list-type-member-count list-type) (list-type-mode list-type) )
+  (format s "~&~A" *seperator*))
 
-(defmethod show ((list-type list-type))
-  (format t "~&~1t~a~35t~a~90t~a" (list-type-slug list-type) (list-type-full-name list-type) (list-type-description list-type))
-  (format t "~&~90tid : ~a~100towner : ~a members : ~a mode :~a " (list-type-id list-type) (twitter-user-screen-name (list-type-user list-type)) (list-type-member-count list-type) (list-type-mode list-type) )
-  (format t "~&~A" *seperator*))
 
+(defmethod show ((rate-limit rate-limit) &optional (s *standard-output*))
+  (format s "~&~1tremaining : ~A/~A ~20treset : ~A/current time : ~A ~67t[~A seconds]" (rate-limit-remaining-hits rate-limit) (rate-limit-hourly-limit rate-limit) 
+	  (rate-limit-reset-time rate-limit) (current-utc nil) (rate-limit-reset-time-in-seconds rate-limit) ))
+
 
-(defmethod show ((geo-places geo-places))
-  (mapcar #'show (geo-places-places geo-places)))
+(defmethod show ((geo-places geo-places) &optional (s *standard-output*))
+  (mapcar (lambda (el) (show el s)) (geo-places-places geo-places)))
 
-(defmethod show ((geo-result geo-result))
-  (show (geo-result-result geo-result)))
+(defmethod show ((geo-result geo-result) &optional (s *standard-output*))
+  (show (geo-result-result geo-result) s))
+
+(defmethod show ((cursor-user-lists cursor-user-lists) &optional (s *standard-output*))
+  (mapcar (lambda (el) (show el s)) (cursor-user-lists-lists cursor-user-lists)))
+
+
 
-(defmethod show ((cursor-user-lists cursor-user-lists))
-  (mapcar #'show (cursor-user-lists-lists cursor-user-lists)))
+

api/twitter-tweet-status.lisp

@@ -1,4 +1,4 @@
-(in-package :twitter)
+(in-package :cl-twitter)
 
 
 ;;
@@ -174,12 +174,19 @@
 	(error "Tweet updates must be less than 140 characters.  Length is ~A" (length newtext)))))
 
 (defun reply-to (tweet text &key (tiny-url-p t) (lat nil) (long nil) (place-id nil) (display-coordinates nil) (trim-user nil) (include-entities nil))
-  (send-tweet text :in-reply-to-status-id (tweet-id tweet) :tiny-url-p tiny-url-p :place-id place-id :lat lat :long long :display-coordinates display-coordinates :trim-user trim-user :include-entities include-entities))
+  (tweet text :in-reply-to-status-id (tweet-id tweet) :tiny-url-p tiny-url-p :place-id place-id :lat lat :long long :display-coordinates display-coordinates 
+	 :trim-user trim-user :include-entities include-entities))
 
 (defun @reply-to (tweet text &key (tiny-url-p t) (lat nil) (long nil) (place-id nil) (display-coordinates nil) (trim-user nil) (include-entities nil))
   (let ((fmt (format nil "@~A ~A" (twitter-user-screen-name (tweet-user tweet)) text)))
-    (send-tweet fmt :in-reply-to-status-id (tweet-id tweet) :tiny-url-p tiny-url-p :place-id place-id :lat lat :long long :display-coordinates display-coordinates :trim-user trim-user :include-entities include-entities)))
-
+    (tweet fmt :in-reply-to-status-id (tweet-id tweet) :tiny-url-p tiny-url-p :place-id place-id :lat lat :long long :display-coordinates display-coordinates 
+	   :trim-user trim-user :include-entities include-entities)))
+
+(defun @mention (name text &key (tiny-url-p t) (lat nil) (long nil) (place-id nil) (display-coordinates nil) (trim-user nil) (include-entities nil))
+  (let ((fmt (format nil "@~A ~A" (twitter-user-screen-name (show-user name)) text)))
+    (tweet fmt :tiny-url-p tiny-url-p :place-id place-id :lat lat :long long :display-coordinates display-coordinates :trim-user trim-user :include-entities include-entities)))
+
+
 (defun delete-tweet (tweet &key (trim-user nil) (include-entities nil))
   (delete-status (tweet-id tweet) :trim-user trim-user :include-entities include-entities))
 

api/twitter-vars.lisp

@@ -7,6 +7,10 @@
 ;; Main API
 ;;
 ;;    ("X-Twitter-Client-URL" . "http://common-lisp.net/project/cl-twitter/"))
+(defvar      *month-strings*         '("xx" "Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep" "Oct" "Nov" "Dec") "translate month to s string")
+(defvar      *day-of-week-strings*   '("Mon" "Tue" "Wed" "Thu" "Fri" "Sat" "Sun") "map day-of-the-week to a string")
+
+
 (defvar *twitter-app-uri*       "http://api.twitter.com/1/")
 (defvar *twitter-search-uri*    "http://search.twitter.com/")
 (defvar *twitter-oauth-uri*  "http://api.twitter.com/oauth/")   

api/utils.lisp

@@ -1,5 +1,15 @@
 (in-package :twitter)
 
+(defun day-of-week (i)
+  (nth i *day-of-week-strings*))
+
+(defun month (i)
+  (nth i *month-strings*))
+
+(defun current-utc (stream)
+  (multiple-value-bind (s m h date month year dow &rest args) (decode-universal-time (get-universal-time) 0)
+    (format stream "~A ~A ~A ~A:~A:~A ~A" (day-of-week dow) (month month) date h m s year)))
+
 (defun twitter-app-uri (method)
   (concatenate 'string *twitter-app-uri* method))
 

cl-twit-repl.asd

@@ -17,6 +17,7 @@
       :serial t
       :components ((:file "package")
 		   (:file "serialize-access")
+		   (:file "alias")
 		   (:file "cl-twit-repl")
 		   (:file "twitter"))))
     :depends-on (:cl-twitter))

cl-twit-repl/alias.lisp

@@ -0,0 +1,48 @@
+(in-package :cl-twit-repl)
+
+(defvar *alias-registry*   (make-hash-table :test 'equal))
+(defvar *alias-file-name*  "cl-twit-repl.alias")
+
+(defun alias-file ()
+  (default-access-path "alias/" *alias-file-name*))
+
+(defmacro testit (x y)
+  `(destructuring-bind (name (&rest args) &rest body) ',y
+     (format nil "(defun ~S (&rest args) (apply (~S  ~S   ~S  ) args)) " ',x name  args (car body))))
+
+(defmacro construct-alias-func (x y)
+  `(if (listp ,y)
+       (progn
+	 (if (equal (car ,y) 'lambda)
+	     (destructuring-bind (name (&rest args) &rest body) ,y
+	       (format nil "(defun ~S (&rest args) (apply (~S ~A ~S) args)) " ,x name  args (car body)))
+	     (destructuring-bind (fn &rest rest) ,y
+	       (format nil "(defun ~S (&rest args) (apply '~S  ~{ ~S ~} args))" ,x fn rest))))
+       (format nil "(defun ~S (&rest args) (apply '~S args))" ,x ,y)))
+
+(defmacro alias (&optional x y)
+  `(if ',x
+       (if ',y
+	   (eval (read (make-string-input-stream (cdr (setf (gethash ',x  *alias-registry*) (cons ',y (construct-alias-func ',x ',y)))))))
+	   (car (gethash ',x *alias-registry*)))
+       (maphash (lambda (k v) (format t "~1t~S ~20t=> ~25t~S~%" k  (car v))) *alias-registry*)))
+
+(defmacro unalias (&optional x)
+  `(if ',x
+       (progn (remhash ',x *alias-registry*)
+	      (fmakunbound ',x))
+       (progn (maphash (lambda (k v) (declare (ignore v)) (fmakunbound k)) *alias-registry*)
+	      (setf *alias-registry* (make-hash-table :test 'equal)))))
+
+(defun dump-alias ()
+  (with-open-file (stream (alias-file) :direction :output :if-exists :supersede)
+    (maphash (lambda (key lst) (format stream "~S~%" (list key lst))) *alias-registry*)))
+
+(defun read-alias ()
+  (when (probe-file (alias-file))
+    (with-open-file (stream (alias-file) :direction :input )
+      (do ((line (read stream nil) (read stream nil))) 
+	  ((null line))
+	(eval (read (make-string-input-stream (cdr (setf (gethash (car line)  *alias-registry*) (cadr line))))))))))
+
+

cl-twit-repl/cl-twit-repl.lisp

@@ -1,22 +1,45 @@
 (in-package :cl-twit-repl)
 
-(defun cursor ()
-  (if *twitter-user*
-      (format t "~&~A> " (twitter-user-screen-name *twitter-user*))
-      (format t "~&~A> " "not_authenticated")))
-
-(defun cl-twit-read ()
-  (read-from-string (read-line) nil nil))
+(defvar *consumer-key*       "9hOStbD2Zf7x0mUoo7cYBg"                     "The consumer key for cl-twit-repl, as listed on https://twitter.com/apps. Used for OAuth.")
+(defvar *consumer-secret*    "PWx9ZBZS9BVbesqlkoyiPzXtucmU7jaWe4ECcC30l0" "The consumer secret for cl-twit-repl, as listed on https://twitter.com/apps. Used for OAuth.")
+(defvar *saved-print-pprint-dispatch* ()                                  "saved version of the dispatch table")
+(defvar *saved-pprint-dispatch-cons*  (pprint-dispatch 'cons)             "saved version of the cons pp")
+(defvar *cl-twit-repl-stream*         *standard-output*                   "prefferred output stream for the twitter repl client")
 
-(defun cl-twit-eval (sexp)
-  (eval sexp))
+(defvar *twitter-types* (list 'tweet 'cl-twitter::geo-places 'cl-twitter::geo-place 'cl-twitter::place 'cl-twitter::list-type 'cl-twitter::geo-result 'twitter-user 'search-ref 'trend-list 
+			      'cl-twitter::rate-limit) "list of types in the twitter api for which we 're going to use the show method instead of the pp")
 
-(defun cl-twit-print (lst)
-  (format t "~S" (show lst)))
+(defun twitterp (obj)
+  (member (type-of obj) *twitter-types*))
+
+(defun pp-show (s o)
+  (if (or (twitterp o) (and (consp o) (twitterp (car o))) (hash-table-p o))
+      (show o (or *cl-twit-repl-stream* s))
+      (funcall *saved-pprint-dispatch-cons* s o)))
+
+(defun install-new-dispatchers ()
+  (mapcar (lambda (type) (set-pprint-dispatch type #'pp-show)) *twitter-types*))
 
 (defun cl-twit-repl ()
-  (cursor)
-  (let ((cmd (cl-twit-read)))
-    (unless (and (consp cmd) (eq (car cmd ) 'quit))
-      (cl-twit-print (cl-twit-eval cmd))
-      (cl-twit-repl))))
+  (use-package :cl-twitter)
+  (unless *alias-registry* (setf *alias-registry*   (make-hash-table :test 'equal)))
+  (read-alias)
+  (when (null *saved-print-pprint-dispatch*) (setf *saved-print-pprint-dispatch* (copy-pprint-dispatch)))
+  (set-pprint-dispatch 'cons         #'pp-show)
+  (set-pprint-dispatch 'hash-table   #'pp-show)
+  (install-new-dispatchers)
+  (unless (probe-file (access-file)) (repl-authenticate-user))
+  (cl-twitter::with-error-handler (:verbose nil)
+      (verify-credentials)))
+
+(defun done-twittering ()
+  (when *saved-print-pprint-dispatch* 
+    (setf *print-pprint-dispatch* *saved-print-pprint-dispatch*)
+    (setf *saved-print-pprint-dispatch* nil))
+  ;;order is important
+  (when *alias-registry* (dump-alias))
+  (setf *alias-registry*  nil)
+  (cl-twitter::with-error-handler (:verbose nil)
+    (end-session))
+  (setf *twitter-user* nil))
+

cl-twit-repl/package.lisp

@@ -8,8 +8,11 @@
    ;;--------------------
 
    #:*access-file*
+   #:alias
+   #:unalias
+   #:cl-twit-repl
+   #:done-twittering
 
-   ;; Interactive API
    #:authenticate-user
    #:authenticated-user
    #:*twitter-user*
@@ -20,10 +23,6 @@
    #:repl-authenticate-user
    #:get-authenticated-user
 
-   ;; I/O
-   #:print-tweets
-   #:get-tinyurl
-
    ))