Skip to content
This repository was archived by the owner on Mar 30, 2023. It is now read-only.

Commit 31abdae

Browse files
author
hokorobi
committed
add twitter-mode.
1 parent 3bc43fa commit 31abdae

File tree

9 files changed

+2427
-0
lines changed

9 files changed

+2427
-0
lines changed

‎site-lisp/twitter/LICENSE.txt

Lines changed: 32 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,32 @@
1+
twitter-mode
2+
3+
Copyright (C) 2008 Masashi Hattori
4+
All rights reserved.
5+
6+
Redistribution and use in source and binary forms, with or without
7+
modification, are permitted provided that the following conditions
8+
are met:
9+
10+
1. Redistributions of source code must retain the above copyright
11+
notice, this list of conditions and the following disclaimer.
12+
13+
2. Redistributions in binary form must reproduce the above copyright
14+
notice, this list of conditions and the following disclaimer in
15+
the documentation and/or other materials provided with the
16+
distribution.
17+
18+
3. The name of the author may not be used to endorse or promote
19+
products derived from this software without specific prior
20+
written permission.
21+
22+
THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
23+
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
24+
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
25+
PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
26+
DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
27+
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
28+
OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
29+
HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
30+
STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
31+
ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
32+
POSSIBILITY OF SUCH DAMAGE.

‎site-lisp/twitter/api-json.l

Lines changed: 341 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,341 @@
1+
;;; -*- Mode: Lisp; Package: EDITOR -*-
2+
;;;
3+
;;; This file is not part of xyzzy.
4+
;;;
5+
; $Id: api.l 813 2008-07-02 04:11:30Z torihat $
6+
;
7+
; twitter/api-json.l
8+
;
9+
; by HATTORI Masashi
10+
11+
(eval-when (:compile-toplevel :load-toplevel :execute)
12+
(require "twitter/api")
13+
(require "json"))
14+
15+
(provide "twitter/api-json")
16+
17+
(in-package "twitter")
18+
19+
(setq *error-filename* "error.json")
20+
21+
(defun parse-file (file)
22+
(json:json-decode-file file))
23+
24+
(defun parse-twstatus (data)
25+
(let (status)
26+
(setq status (make-twstatus))
27+
(dolist (c data)
28+
(let ((cn (car c))
29+
(cc (cdr c)))
30+
(cond ((equal cn "created_at")
31+
(setf (twstatus-created_at status) (parse-twdate cc))
32+
)
33+
((equal cn "id")
34+
(when cc
35+
(setf (twstatus-id status) cc))
36+
)
37+
((equal cn "text")
38+
(setf (twstatus-text status) cc)
39+
)
40+
((equal cn "source")
41+
(setf (twstatus-source status) cc)
42+
(setf (twstatus-source_name status) (parse-twsourcename cc))
43+
(setf (twstatus-source_url status) (parse-twsourceurl cc))
44+
)
45+
((equal cn "truncated")
46+
(setf (twstatus-truncated status) cc)
47+
)
48+
((equal cn "user")
49+
(setf (twstatus-user status) (parse-twuser cc))
50+
)
51+
)))
52+
status))
53+
54+
(defun parse-twdirect (data)
55+
(let (status)
56+
(setq status (make-twdirect))
57+
(dolist (c data)
58+
(let ((cn (car c))
59+
(cc (cdr c)))
60+
(cond ((equal cn "created_at")
61+
(setf (twdirect-created_at status) (parse-twdate cc))
62+
)
63+
((equal cn "id")
64+
(when cc
65+
(setf (twdirect-id status) cc))
66+
)
67+
((equal cn "sender_id")
68+
(when cc
69+
(setf (twdirect-sender_id status) cc))
70+
)
71+
((equal cn "recipient_id")
72+
(when cc
73+
(setf (twdirect-recipient_id status) cc))
74+
)
75+
((equal cn "text")
76+
(setf (twdirect-text status) cc)
77+
)
78+
((equal cn "sender_screen_name")
79+
(setf (twdirect-sender_screen_name status) cc)
80+
)
81+
((equal cn "recipient_screen_name")
82+
(setf (twdirect-recipient_screen_name status) cc)
83+
)
84+
((equal cn "sender")
85+
(setf (twdirect-sender status) (parse-twuser cc cn))
86+
)
87+
((equal cn "recipient")
88+
(setf (twdirect-recipient status) (parse-twuser cc cn))
89+
)
90+
)))
91+
status))
92+
93+
(defun parse-twuser (data &optional (tagname "user"))
94+
(let (user)
95+
(setq user (make-twuser))
96+
(dolist (c data)
97+
(let ((cn (car c))
98+
(cc (cdr c)))
99+
(cond ((equal cn "id")
100+
(when cc
101+
(setf (twuser-id user) cc))
102+
)
103+
((equal cn "name")
104+
(setf (twuser-name user) cc)
105+
)
106+
((equal cn "screen_name")
107+
(setf (twuser-screen_name user) cc)
108+
)
109+
((equal cn "location")
110+
(setf (twuser-location user) cc)
111+
)
112+
((equal cn "description")
113+
(setf (twuser-description user) cc)
114+
)
115+
((equal cn "profile_image_url")
116+
(setf (twuser-profile_image_url user) cc)
117+
)
118+
((equal cn "url")
119+
(setf (twuser-url user) cc)
120+
)
121+
((equal cn "protected")
122+
(setf (twuser-protected user) cc)
123+
)
124+
((equal cn "status")
125+
(setf (twuser-status user) (parse-twstatus cc)))
126+
)))
127+
user))
128+
129+
(defun parse-twsearch (data)
130+
(let (obj)
131+
(setq obj (make-twsearch))
132+
(dolist (c data)
133+
(let ((cn (car c))
134+
(cc (cdr c)))
135+
(cond ((equal cn "created_at")
136+
(setf (twsearch-created_at obj) (parse-created_at cc))
137+
)
138+
((equal cn "id")
139+
(when cc
140+
(setf (twsearch-id obj) cc))
141+
)
142+
((equal cn "text")
143+
(setf (twsearch-text obj) cc)
144+
)
145+
((equal cn "source")
146+
(setf (twsearch-source obj) cc)
147+
)
148+
((equal cn "profile_image_url")
149+
(setf (twsearch-profile_image_url obj) cc)
150+
)
151+
((equal cn "to_user_id")
152+
(setf (twsearch-to_user_id obj) cc)
153+
)
154+
((equal cn "from_user")
155+
(setf (twsearch-from_user obj) cc)
156+
)
157+
((equal cn "from_user_id")
158+
(setf (twsearch-from_user_id obj) cc)
159+
)
160+
((equal cn "iso_language_code")
161+
(setf (twsearch-iso_language_code obj) cc)
162+
)
163+
)))
164+
obj))
165+
166+
(defun parse-statuses (data)
167+
(let (statuses)
168+
(twdebug "~S" data)
169+
(when (or (stringp (car data))
170+
(stringp (car (car data))))
171+
(setq data (list data)))
172+
(dolist (c data)
173+
(let ((s (parse-twstatus c)))
174+
(when s
175+
(push s statuses))))
176+
(nreverse statuses)))
177+
178+
(defun parse-users (data)
179+
(let* (users)
180+
(twdebug "~S" data)
181+
(dolist (c data)
182+
(let ((s (parse-twuser c)))
183+
(when s
184+
(push s users))))
185+
(nreverse users)))
186+
187+
(defun parse-direct_messages (data)
188+
(let* (msgs)
189+
(twdebug "~S" data)
190+
(when (or (stringp (car data))
191+
(stringp (car (car data))))
192+
(setq data (list data)))
193+
(dolist (c data)
194+
(let ((s (parse-twdirect c)))
195+
(when s
196+
(push s msgs))))
197+
(nreverse msgs)))
198+
199+
(defun parse-search-result (data)
200+
(let (msgs
201+
(tname (car (car data)))
202+
(results (cdr (car data)))
203+
(query (cdr data)))
204+
(twdebug "~S" data)
205+
(dolist (c results)
206+
(let ((s (parse-twsearch c)))
207+
(when s
208+
(push s msgs))))
209+
(nreverse msgs)))
210+
211+
(defun parse-trends-result (data)
212+
(let (trends)
213+
(twdebug "~S" data)
214+
(dolist (d data)
215+
(let ((key (car d))
216+
(val (cdr d)))
217+
(when (equal key "trends")
218+
(dolist (c val)
219+
(when (listp c)
220+
(let ((name (cdr (assoc "name" c :test #'equal))))
221+
(when name
222+
(push name trends)))))
223+
)))
224+
(nreverse trends)))
225+
226+
(defun parse-error (data)
227+
(let ((msg "unknown."))
228+
(twdebug "~S" data)
229+
(dolist (c data)
230+
(let ((cname (car c))
231+
(ccont (cdr c)))
232+
(when (equal cname "error")
233+
(setq msg ccont))))
234+
msg))
235+
236+
(defun read-error ()
237+
(let ((file (error-file)))
238+
(when (file-exist-p file)
239+
(parse-error (parse-file file)))))
240+
241+
(defun fetch-statuses (url tmpfile headers &optional force)
242+
(multiple-value-bind (status response-headers)
243+
(http-download-file url tmpfile force :headers headers)
244+
(let (data)
245+
(twdebug "~S~%~S~%~S~%~{~S~%~}" url tmpfile status response-headers)
246+
(cond ((equal status "200")
247+
(when (file-exist-p tmpfile)
248+
(setq data (parse-file tmpfile)))
249+
(values t status (parse-statuses data)))
250+
(t
251+
(values nil status (read-error)))))))
252+
253+
(defun fetch-search-result (url tmpfile headers &optional force)
254+
(multiple-value-bind (status response-headers)
255+
(http-download-file url tmpfile force :headers headers)
256+
(let (data)
257+
(twdebug "~S~%~S~%~S~%~{~S~%~}" url tmpfile status response-headers)
258+
(cond ((equal status "200")
259+
(when (file-exist-p tmpfile)
260+
(setq data (parse-file tmpfile)))
261+
(values t status (parse-search-result data)))
262+
(t
263+
(values nil status (read-error)))))))
264+
265+
(defun fetch-trends-result (url tmpfile headers &optional force)
266+
(multiple-value-bind (status response-headers)
267+
(http-download-file url tmpfile force :headers headers)
268+
(let (data)
269+
(twdebug "~S~%~S~%~S~%~{~S~%~}" url tmpfile status response-headers)
270+
(cond ((equal status "200")
271+
(when (file-exist-p tmpfile)
272+
(setq data (parse-file tmpfile)))
273+
(values t status (parse-trends-result data)))
274+
(t
275+
(values nil status (read-error)))))))
276+
277+
(defun url-public_timeline ()
278+
(concat *api-url-root*
279+
"statuses/"
280+
"public_timeline.json"))
281+
282+
(defun url-user_timeline (&optional target)
283+
(concat *api-url-root*
284+
"statuses/"
285+
(if target
286+
(format nil "user_timeline/~A.json" target)
287+
"user_timeline.json")))
288+
289+
(defun url-friends_timeline (&optional target)
290+
(concat *api-url-root*
291+
"statuses/"
292+
(if target
293+
(format nil "friends_timeline/~A.json" target)
294+
"friends_timeline.json")))
295+
(defun url-replies_timeline ()
296+
(concat *api-url-root*
297+
"statuses/"
298+
"replies.json"))
299+
300+
(defun url-direct_messages ()
301+
(concat *api-url-root*
302+
"direct_messages.json"))
303+
304+
(defun url-friends (&optional target)
305+
(concat *api-url-root*
306+
"statuses/"
307+
(if target
308+
(format nil "friends/~A.json" target)
309+
"friends.json")))
310+
311+
(defun url-followers ()
312+
(concat *api-url-root*
313+
"statuses/"
314+
"followers.json"))
315+
316+
(defun url-update ()
317+
(concat *api-url-root*
318+
"statuses/"
319+
"update.json"))
320+
321+
(defun url-direct_message ()
322+
(concat *api-url-root*
323+
"direct_messages/"
324+
"new.json"))
325+
326+
(defun url-search (query)
327+
(concat *search-url-root*
328+
""
329+
"search.json"
330+
(format nil "?rpp=~D~@[&lang=~A~]&q="
331+
(min *summary-search-max*
332+
*search-max-number*)
333+
*search-lang*)
334+
(si:www-url-encode
335+
(convert-encoding-from-internal *encoding-utf8n* query))
336+
))
337+
338+
(defun url-trends ()
339+
(concat *search-url-root*
340+
""
341+
"trends.json"))

0 commit comments

Comments
 (0)