Context Navigation

twittering-mode.el @ 61

Revision 61, 34.7 kB (checked in by tsuyoshi, 16 years ago)
Commit test twittering-mode for 'since' support

Line
1	;;; twittering-mode.el --- Major mode for Twitter
2
3	;; Copyright (C) 2007 Yuto Hayamizu.
4	;; 2008 Tsuyoshi CHO
5
6	;; Author: Y. Hayamizu <y.hayamizu@gmail.com>
7	;; Tsuyoshi CHO <Tsuyoshi.CHO+develop@Gmail.com>
8	;; Created: Sep 4, 2007
9	;; Version: 0.4
10	;; Keywords: twitter web
11	;; URL: http://lambdarepos.svnrepository.com/share/trac.cgi/browser/lang/elisp/twittering-mode
12
13	;; This file is free software; you can redistribute it and/or modify
14	;; it under the terms of the GNU General Public License as published by
15	;; the Free Software Foundation; either version 2, or (at your option)
16	;; any later version.
17
18	;; This file is distributed in the hope that it will be useful,
19	;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20	;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21	;; GNU General Public License for more details.
22
23	;; You should have received a copy of the GNU General Public License
24	;; along with GNU Emacs; see the file COPYING. If not, write to
25	;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
26	;; Boston, MA 02111-1307, USA.
27
28	;;; Commentary:
29
30	;; twittering-mode.el is a major mode for Twitter.
31	;; You can check friends timeline, and update your status on Emacs.
32
33	;;; Feature Request:
34
35	;; URL : http://twitter.com/d00dle/statuses/577876082
36	;; URL : http://twitter.com/d00dle/statuses/577879732
37	;; * Status Input from Popup buffer and C-cC-c to POST.
38	;; * Mark fav(star)
39	;; URL : http://code.nanigac.com/source/view/419
40	;; * update status for region
41
42	;;; Code:
43
44	(require 'cl)
45	(require 'xml)
46	(require 'parse-time)
47
48	(defconst twittering-mode-version "0.5")
49
50	(defun twittering-mode-version ()
51	"Display a message for twittering-mode version."
52	(interactive)
53	(let ((version-string
54	(format "twittering-mode-v%s" twittering-mode-version)))
55	(if (interactive-p)
56	(message "%s" version-string)
57	version-string)))
58
59	(defvar twittering-mode-map (make-sparse-keymap))
60
61	(defvar twittering-timer nil "Timer object for timeline refreshing will be stored here. DO NOT SET VALUE MANUALLY.")
62
63	(defvar twittering-idle-time 20)
64
65	(defvar twittering-timer-interval 90)
66
67	(defvar twittering-username nil)
68
69	(defvar twittering-password nil)
70
71	(defvar twittering-scroll-mode nil)
72	(make-variable-buffer-local 'twittering-scroll-mode)
73
74	(defvar twittering-jojo-mode nil)
75	(make-variable-buffer-local 'twittering-jojo-mode)
76
77	(defvar twittering-status-format nil)
78	(setq twittering-status-format "%i %s, %@:\n %t // from %f%L")
79	;; %s - screen_name
80	;; %S - name
81	;; %i - profile_image
82	;; %d - description
83	;; %l - location
84	;; %L - " [location]"
85	;; %u - url
86	;; %j - user.id
87	;; %p - protected?
88	;; %c - created_at (raw UTC string)
89	;; %C{time-format-str} - created_at (formatted with time-format-str)
90	;; %@ - X seconds ago
91	;; %t - text
92	;; %' - truncated
93	;; %f - source
94	;; %# - id
95
96	(defvar twittering-buffer "twittering")
97	(defun twittering-buffer ()
98	(twittering-get-or-generate-buffer twittering-buffer))
99
100	(defvar twittering-http-buffer "twittering-http-buffer")
101	(defun twittering-http-buffer ()
102	(twittering-get-or-generate-buffer twittering-http-buffer))
103
104	(defvar twittering-friends-timeline-data nil)
105	(defvar twittering-friends-timeline-last-update nil)
106
107	(defvar twittering-username-face 'twittering-username-face)
108	(defvar twittering-uri-face 'twittering-uri-face)
109
110	(defun twittering-get-or-generate-buffer (buffer)
111	(if (bufferp buffer)
112	(if (buffer-live-p buffer)
113	buffer
114	(generate-new-buffer (buffer-name buffer)))
115	(if (stringp buffer)
116	(or (get-buffer buffer)
117	(generate-new-buffer buffer)))))
118
119	(defun assocref (item alist)
120	(cdr (assoc item alist)))
121	(defmacro list-push (value listvar)
122	`(setq ,listvar (cons ,value ,listvar)))
123
124	;;; Proxy
125	(defvar twittering-proxy-use nil)
126	(defvar twittering-proxy-server nil)
127	(defvar twittering-proxy-port 8080)
128	(defvar twittering-proxy-user nil)
129	(defvar twittering-proxy-password nil)
130
131	(defun twittering-toggle-proxy () ""
132	(interactive)
133	(setq twittering-proxy-use
134	(not twittering-proxy-use))
135	(message "%s %s"
136	"Use Proxy:"
137	(if twittering-proxy-use
138	"on" "off")))
139
140	(defun twittering-user-agent-default-function ()
141	"Twittering mode default User-Agent function."
142	(concat "Emacs/"
143	(int-to-string emacs-major-version) "." (int-to-string
144	emacs-minor-version)
145	" "
146	"Twittering-mode/"
147	twittering-mode-version))
148
149	(defvar twittering-user-agent-function 'twittering-user-agent-default-function)
150
151	(defun twittering-user-agent ()
152	"Return User-Agent header string."
153	(funcall twittering-user-agent-function))
154
155	;;; to show image files
156
157	(defvar twittering-wget-buffer "twittering-wget-buffer")
158	(defun twittering-wget-buffer ()
159	(twittering-get-or-generate-buffer twittering-wget-buffer))
160
161	(defvar twittering-tmp-dir
162	(expand-file-name (concat "twmode-images-" (user-login-name))
163	temporary-file-directory))
164
165	(defvar twittering-icon-mode nil "You MUST NOT CHANGE this variable directory. You should change through function'twittering-icon-mode'")
166	(make-variable-buffer-local 'twittering-icon-mode)
167	(defun twittering-icon-mode (&optional arg)
168	(interactive)
169	(setq twittering-icon-mode
170	(if twittering-icon-mode
171	(if (null arg)
172	nil
173	(> (prefix-numeric-value arg) 0))
174	(when (or (null arg)
175	(and arg (> (prefix-numeric-value arg) 0)))
176	(when (file-writable-p twittering-tmp-dir)
177	(progn
178	(if (not (file-directory-p twittering-tmp-dir))
179	(make-directory twittering-tmp-dir))
180	t)))))
181	(twittering-render-friends-timeline))
182
183	(defun twittering-scroll-mode (&optional arg)
184	(interactive)
185	(setq twittering-scroll-mode
186	(if (null arg)
187	(not twittering-scroll-mode)
188	(> (prefix-numeric-value arg) 0))))
189
190	(defun twittering-jojo-mode (&optional arg)
191	(interactive)
192	(setq twittering-jojo-mode
193	(if (null arg)
194	(not twittering-jojo-mode)
195	(> (prefix-numeric-value arg) 0))))
196
197	(defvar twittering-image-stack nil)
198
199	(defun twittering-image-type (file-name)
200	(cond
201	((string-match "\\.jpe?g" file-name) 'jpeg)
202	((string-match "\\.png" file-name) 'png)
203	((string-match "\\.gif" file-name) 'gif)
204	(t nil)))
205
206	(defun twittering-setftime (fmt string uni)
207	(format-time-string fmt ; like "%Y-%m-%d %H:%M:%S"
208	(apply 'encode-time (parse-time-string string))
209	uni))
210	(defun twittering-local-strftime (fmt string)
211	(twittering-setftime fmt string nil))
212	(defun twittering-global-strftime (fmt string)
213	(twittering-setftime fmt string t))
214
215
216	(defvar twittering-debug-mode nil)
217	(defvar twittering-debug-buffer "debug")
218	(defun twittering-debug-buffer ()
219	(twittering-get-or-generate-buffer twittering-debug-buffer))
220	(defmacro debug-print (obj)
221	(let ((obsym (gensym)))
222	`(let ((,obsym ,obj))
223	(if twittering-debug-mode
224	(with-current-buffer (twittering-debug-buffer)
225	(insert (prin1-to-string ,obsym))
226	(newline)
227	,obsym)
228	,obsym))))
229
230	(defun twittering-debug-mode ()
231	(interactive)
232	(setq twittering-debug-mode
233	(not twittering-debug-mode))
234	(message (if twittering-debug-mode "debug mode:on" "debug mode:off")))
235
236	(if twittering-mode-map
237	(let ((km twittering-mode-map))
238	(define-key km "\C-c\C-f" 'twittering-friends-timeline)
239	(define-key km "\C-c\C-s" 'twittering-update-status-interactive)
240	(define-key km "\C-c\C-e" 'twittering-erase-old-statuses)
241	(define-key km "\C-m" 'twittering-enter)
242	(define-key km "\C-c\C-l" 'twittering-update-lambda)
243	(define-key km [mouse-1] 'twittering-click)
244	(define-key km "\C-c\C-v" 'twittering-view-user-page)
245	;; (define-key km "j" 'next-line)
246	;; (define-key km "k" 'previous-line)
247	(define-key km "j" 'twittering-goto-next-status)
248	(define-key km "k" 'twittering-goto-previous-status)
249	(define-key km "l" 'forward-char)
250	(define-key km "h" 'backward-char)
251	(define-key km "0" 'beginning-of-line)
252	(define-key km "^" 'beginning-of-line-text)
253	(define-key km "$" 'end-of-line)
254	(define-key km "n" 'twittering-goto-next-status-of-user)
255	(define-key km "p" 'twittering-goto-previous-status-of-user)
256	(define-key km [backspace] 'backward-char)
257	(define-key km "G" 'end-of-buffer)
258	(define-key km "H" 'beginning-of-buffer)
259	(define-key km "i" 'twittering-icon-mode)
260	(define-key km "s" 'twittering-scroll-mode)
261	(define-key km "t" 'twittering-toggle-proxy)
262	(define-key km "\C-c\C-p" 'twittering-toggle-proxy)
263	nil))
264
265	(defvar twittering-mode-syntax-table nil "")
266
267	(if twittering-mode-syntax-table
268	()
269	(setq twittering-mode-syntax-table (make-syntax-table))
270	;; (modify-syntax-entry ? "" twittering-mode-syntax-table)
271	(modify-syntax-entry ?\" "w" twittering-mode-syntax-table)
272	)
273
274	(defun twittering-mode-init-variables ()
275	;; (make-variable-buffer-local 'variable)
276	;; (setq variable nil)
277	(font-lock-mode -1)
278	(defface twittering-username-face
279	`((t nil)) "" :group 'faces)
280	(copy-face 'font-lock-string-face 'twittering-username-face)
281	(set-face-attribute 'twittering-username-face nil :underline t)
282	(defface twittering-uri-face
283	`((t nil)) "" :group 'faces)
284	(set-face-attribute 'twittering-uri-face nil :underline t)
285	(add-to-list 'minor-mode-alist '(twittering-icon-mode " tw-icon"))
286	(add-to-list 'minor-mode-alist '(twittering-scroll-mode " tw-scroll"))
287	(add-to-list 'minor-mode-alist '(twittering-jojo-mode " tw-jojo"))
288	)
289
290	(defmacro case-string (str &rest clauses)
291	`(cond
292	,@(mapcar
293	(lambda (clause)
294	(let ((keylist (car clause))
295	(body (cdr clause)))
296	`(,(if (listp keylist)
297	`(or ,@(mapcar (lambda (key) `(string-equal ,str ,key)) keylist))
298	't)
299	,@body)))
300	clauses)))
301
302	;; If you use Emacs21, decode-char 'ucs will fail unless Mule-UCS is loaded.
303	;; TODO: Show error messages if Emacs 21 without Mule-UCS
304	(defmacro twittering-ucs-to-char (num)
305	(if (functionp 'ucs-to-char)
306	`(ucs-to-char ,num)
307	`(decode-char 'ucs ,num)))
308
309	(defvar twittering-mode-string "Twittering mode")
310
311	(defvar twittering-mode-hook nil
312	"Twittering-mode hook.")
313
314	(defun twittering-mode ()
315	"Major mode for Twitter"
316	(interactive)
317	(switch-to-buffer (twittering-buffer))
318	(kill-all-local-variables)
319	(twittering-mode-init-variables)
320	(use-local-map twittering-mode-map)
321	(setq major-mode 'twittering-mode)
322	(setq mode-name twittering-mode-string)
323	(set-syntax-table twittering-mode-syntax-table)
324	(run-hooks 'twittering-mode-hook)
325	(font-lock-mode -1)
326	(twittering-start)
327	)
328
329	;;;
330	;;; Basic HTTP functions
331	;;;
332
333	(defun twittering-http-get (method-class method &optional parameters sentinel)
334	(if (null sentinel) (setq sentinel 'twittering-http-get-default-sentinel))
335
336	;; clear the buffer
337	(save-excursion
338	(set-buffer (twittering-http-buffer))
339	(erase-buffer))
340
341	(let (proc server port
342	(proxy-user twittering-proxy-user)
343	(proxy-password twittering-proxy-password))
344	(condition-case nil
345	(progn
346	(if (and twittering-proxy-use twittering-proxy-server)
347	(setq server twittering-proxy-server
348	port (if (integerp twittering-proxy-port)
349	(int-to-string twittering-proxy-port)
350	twittering-proxy-port))
351	(setq server "twitter.com"
352	port "80"))
353	(setq proc
354	(open-network-stream
355	"network-connection-process" (twittering-http-buffer)
356	server (string-to-number port)))
357	(set-process-sentinel proc sentinel)
358	(process-send-string
359	proc
360	(let ((nl "\r\n")
361	request)
362	(setq request
363	(concat "GET http://twitter.com/" method-class "/" method
364	".xml"
365	(when parameters
366	(concat "?"
367	(mapconcat
368	(lambda (param-pair)
369	(format "%s=%s"
370	(twittering-percent-encode (car param-pair))
371	(twittering-percent-encode (cdr param-pair))))
372	parameters
373	"&")))
374	" HTTP/1.1" nl
375	"Host: twitter.com" nl
376	"User-Agent: " (twittering-user-agent) nl
377	"Authorization: Basic "
378	(base64-encode-string
379	(concat twittering-username ":" (twittering-get-password)))
380	nl
381	"Accept: text/xml"
382	",application/xml"
383	",application/xhtml+xml"
384	",application/html;q=0.9"
385	",text/plain;q=0.8"
386	",image/png,/;q=0.5" nl
387	"Accept-Charset: utf-8;q=0.7,*;q=0.7" nl
388	(when twittering-proxy-use
389	"Proxy-Connection: Keep-Alive" nl
390	(when (and proxy-user proxy-password)
391	(concat
392	"Proxy-Authorization: Basic "
393	(base64-encode-string
394	(concat proxy-user ":"
395	proxy-password))
396	nl)))
397	nl))
398	(debug-print (concat "GET Request\n" request))
399	request)))
400	(error
401	(message "Failure: HTTP GET") nil))))
402
403	(defun twittering-http-get-default-sentinel (proc stat &optional suc-msg)
404	(let ((header (twittering-get-response-header))
405	(body (twittering-get-response-body))
406	(status nil)
407	)
408	(if (string-match "HTTP/1\.[01] \$[a-z0-9 ]+\$\r?\n" header)
409	(progn
410	(setq status (match-string-no-properties 1 header))
411	(case-string
412	status
413	(("200 OK")
414	(mapcar
415	#'twittering-cache-status-datum
416	(reverse (twittering-xmltree-to-status
417	body)))
418	(twittering-render-friends-timeline)
419	(message (if suc-msg suc-msg "Success: Get.")))
420	(t (message status))))
421	(message "Failure: Bad http response.")))
422	)
423
424	(defun twittering-render-friends-timeline ()
425	(with-current-buffer (twittering-buffer)
426	(let ((point (point))
427	(end (point-max)))
428	(setq buffer-read-only nil)
429	(erase-buffer)
430	(mapc (lambda (status)
431	(insert (twittering-format-status
432	status twittering-status-format))
433	(fill-region-as-paragraph
434	(save-excursion (beginning-of-line) (point)) (point))
435	(insert "\n"))
436	twittering-friends-timeline-data)
437	(if twittering-image-stack
438	(clear-image-cache))
439	(setq buffer-read-only t)
440	(debug-print (current-buffer))
441	(goto-char (+ point (if twittering-scroll-mode (- (point-max) end) 0))))
442	))
443
444	(defun twittering-format-status (status format-str)
445	(flet ((attr (key)
446	(assocref key status))
447	(profile-image
448	()
449	(let ((profile-image-url (attr 'user-profile-image-url))
450	(icon-string "\n "))
451	(if (string-match "/\$[^/?]+\$\$?:\\?\\\|$\$" profile-image-url)
452	(let ((filename (match-string-no-properties 1 profile-image-url)))
453	;; download icons if does not exist
454	(if (file-exists-p (concat twittering-tmp-dir
455	"/" filename))
456	t
457	(add-to-list 'twittering-image-stack profile-image-url))
458
459	(when (and icon-string twittering-icon-mode)
460	(set-text-properties
461	1 2 `(display
462	(image :type ,(twittering-image-type filename)
463	:file ,(concat twittering-tmp-dir
464	"/"
465	filename)))
466	icon-string)
467	icon-string)
468	)))))
469	(let ((cursor 0)
470	(result ())
471	c
472	found-at)
473	(setq cursor 0)
474	(setq result '())
475	(while (setq found-at (string-match "%\$C{\\([^}]+\$}\\\|[A-Za-z#@']\\)" format-str cursor))
476	(setq c (string-to-char (match-string-no-properties 1 format-str)))
477	(if (> found-at cursor)
478	(list-push (substring format-str cursor found-at) result)
479	"\|")
480	(setq cursor (match-end 1))
481
482	(case c
483	((?s) ; %s - screen_name
484	(list-push (attr 'user-screen-name) result))
485	((?S) ; %S - name
486	(list-push (attr 'user-name) result))
487	((?i) ; %i - profile_image
488	(list-push (profile-image) result))
489	((?d) ; %d - description
490	(list-push (attr 'user-description) result))
491	((?l) ; %l - location
492	(list-push (attr 'user-location) result))
493	((?L) ; %L - " [location]"
494	(let ((location (attr 'user-location)))
495	(unless (or (null location) (string= "" location))
496	(list-push (concat " [" location "]") result)) ))
497	((?u) ; %u - url
498	(list-push (attr 'user-url) result))
499	((?j) ; %j - user.id
500	(list-push (format "%d" (attr 'user-id)) result))
501	((?p) ; %p - protected?
502	(let ((protected (attr 'user-protected)))
503	(when (string= "true" protected)
504	(list-push "[x]" result))))
505	((?c) ; %c - created_at (raw UTC string)
506	(list-push (attr 'created-at) result))
507	((?C) ; %C{time-format-str} - created_at (formatted with time-format-str)
508	(list-push (twittering-local-strftime
509	(or (match-string-no-properties 2 format-str) "%H:%M:%S")
510	(attr 'created-at))
511	result))
512	((?@) ; %@ - X seconds ago
513	(let ((created-at
514	(apply
515	'encode-time
516	(parse-time-string (attr 'created-at))))
517	(now (current-time)))
518	(let ((secs (+ (* (- (car now) (car created-at)) 65536)
519	(- (cadr now) (cadr created-at))))
520	time-string url)
521	(setq time-string
522	(cond ((< secs 5) "less than 5 seconds ago")
523	((< secs 10) "less than 10 seconds ago")
524	((< secs 20) "less than 20 seconds ago")
525	((< secs 30) "half a minute ago")
526	((< secs 60) "less than a minute ago")
527	((< secs 150) "1 minute ago")
528	((< secs 2400) (format "%d minutes ago"
529	(/ (+ secs 30) 60)))
530	((< secs 5400) "about 1 hour ago")
531	((< secs 84600) (format "about %d hours ago"
532	(/ (+ secs 1800) 3600)))
533	(t (format-time-string "%I:%M %p %B %d, %Y" created-at))))
534	(setq url (twittering-get-status-url (attr 'user-screen-name) (attr 'id)))
535	;; make status url clickable
536	(add-text-properties
537	0 (length time-string)
538	`(mouse-face highlight
539	face twittering-uri-face
540	uri ,url)
541	time-string)
542	(list-push time-string result))))
543	((?t) ; %t - text
544	(list-push ;(clickable-text)
545	(attr 'text)
546	result))
547	((?') ; %' - truncated
548	(let ((truncated (attr 'truncated)))
549	(when (string= "true" truncated)
550	(list-push "..." result))))
551	((?f) ; %f - source
552	(list-push (attr 'source) result))
553	((?#) ; %# - id
554	(list-push (format "%d" (attr 'id)) result))
555	(t
556	(list-push (char-to-string c) result)))
557	)
558	(list-push (substring format-str cursor) result)
559	(let ((formatted-status (apply 'concat (nreverse result))))
560	(add-text-properties 0 (length formatted-status)
561	`(username ,(attr 'user-screen-name))
562	formatted-status)
563	formatted-status)
564	)))
565
566	(defun twittering-http-post
567	(method-class method &optional parameters contents sentinel)
568	"Send HTTP POST request to twitter.com
569
570	METHOD-CLASS must be one of Twitter API method classes(statuses, users or direct_messages).
571	METHOD must be one of Twitter API method which belongs to METHOD-CLASS.
572	PARAMETERS is alist of URI parameters. ex) ((\"mode\" . \"view\") (\"page\" . \"6\")) => <URI>?mode=view&page=6"
573	(if (null sentinel) (setq sentinel 'twittering-http-post-default-sentinel))
574
575	;; clear the buffer
576	(save-excursion
577	(set-buffer (twittering-http-buffer))
578	(erase-buffer))
579
580	(let (proc server port
581	(proxy-user twittering-proxy-user)
582	(proxy-password twittering-proxy-password))
583	(progn
584	(if (and twittering-proxy-use twittering-proxy-server)
585	(setq server twittering-proxy-server
586	port (if (integerp twittering-proxy-port)
587	(int-to-string twittering-proxy-port)
588	twittering-proxy-port))
589	(setq server "twitter.com"
590	port "80"))
591	(setq proc
592	(open-network-stream
593	"network-connection-process" (twittering-http-buffer)
594	server (string-to-number port)))
595	(set-process-sentinel proc sentinel)
596	(process-send-string
597	proc
598	(let ((nl "\r\n")
599	request)
600	(setq request
601	(concat "POST http://twitter.com/" method-class "/" method ".xml"
602	(when parameters
603	(concat "?"
604	(mapconcat
605	(lambda (param-pair)
606	(format "%s=%s"
607	(twittering-percent-encode (car param-pair))
608	(twittering-percent-encode (cdr param-pair))))
609	parameters
610	"&")))
611	" HTTP/1.1" nl
612	"Host: twitter.com" nl
613	"User-Agent: " (twittering-user-agent) nl
614	"Authorization: Basic "
615	(base64-encode-string
616	(concat twittering-username ":" (twittering-get-password)))
617	nl
618	"Content-Type: text/plain" nl
619	"Content-Length: 0" nl
620	(when twittering-proxy-use
621	"Proxy-Connection: Keep-Alive" nl
622	(when (and proxy-user proxy-password)
623	(concat
624	"Proxy-Authorization: Basic "
625	(base64-encode-string
626	(concat proxy-user ":"
627	proxy-password))
628	nl)))
629	nl))
630	(debug-print (concat "POST Request\n" request))
631	request)))))
632
633	(defun twittering-http-post-default-sentinel (proc stat &optional suc-msg)
634
635	(condition-case err-signal
636	(let ((header (twittering-get-response-header))
637	;; (body (twittering-get-response-body)) not used now.
638	(status nil))
639	(string-match "HTTP/1\.1 \$[a-z0-9 ]+\$\r?\n" header)
640	(setq status (match-string-no-properties 1 header))
641	(case-string status
642	(("200 OK")
643	(message (if suc-msg suc-msg "Success: Post")))
644	(t (message status)))
645	)
646	(error (message (prin1-to-string err-signal))))
647	)
648
649	(defun twittering-get-response-header (&optional buffer)
650	"Exract HTTP response header from HTTP response.
651	`buffer' may be a buffer or the name of an existing buffer.
652	If `buffer' is omitted, the value of `twittering-http-buffer' is used as `buffer'."
653	(if (stringp buffer) (setq buffer (get-buffer buffer)))
654	(if (null buffer) (setq buffer (twittering-http-buffer)))
655	(save-excursion
656	(set-buffer buffer)
657	(let ((content (buffer-string)))
658	(substring content 0 (string-match "\r?\n\r?\n" content)))))
659
660	(defun twittering-get-response-body (&optional buffer)
661	"Exract HTTP response body from HTTP response, parse it as XML, and return a XML tree as list.
662	`buffer' may be a buffer or the name of an existing buffer.
663	If `buffer' is omitted, the value of `twittering-http-buffer' is used as `buffer'."
664	(if (stringp buffer) (setq buffer (get-buffer buffer)))
665	(if (null buffer) (setq buffer (twittering-http-buffer)))
666	(save-excursion
667	(set-buffer buffer)
668	(let ((content (buffer-string)))
669	(let ((content (buffer-string)))
670	(xml-parse-region (+ (string-match "\r?\n\r?\n" content)
671	(length (match-string 0 content)))
672	(point-max)))
673	)))
674
675	(defun twittering-cache-status-datum (status-datum &optional data-var)
676	"Cache status datum into data-var(default twittering-friends-timeline-data)
677	If STATUS-DATUM is already in DATA-VAR, return nil. If not, return t."
678	(if (null data-var)
679	(setf data-var 'twittering-friends-timeline-data))
680	(let ((id (cdr (assq 'id status-datum))))
681	(if (or (null (symbol-value data-var))
682	(not (find-if
683	(lambda (item)
684	(eql id (cdr (assq 'id item))))
685	(symbol-value data-var))))
686	(progn
687	(if twittering-jojo-mode
688	(twittering-update-jojo (cdr (assq 'user-screen-name status-datum))
689	(cdr (assq 'text status-datum))))
690	(set data-var (cons status-datum (symbol-value data-var)))
691	t)
692	nil)))
693
694	(defun twittering-status-to-status-datum (status)
695	(flet ((assq-get (item seq)
696	(car (cddr (assq item seq)))))
697	(let* ((status-data (cddr status))
698	id text source created-at truncated
699	(user-data (cddr (assq 'user status-data)))
700	user-id user-name
701	user-screen-name
702	user-location
703	user-description
704	user-profile-image-url
705	user-url
706	user-protected
707	regex-index)
708
709	(setq id (string-to-number (assq-get 'id status-data)))
710	(setq text (twittering-decode-html-entities
711	(assq-get 'text status-data)))
712	(setq source (twittering-decode-html-entities
713	(assq-get 'source status-data)))
714	(setq created-at (assq-get 'created_at status-data))
715	(setq truncated (assq-get 'truncated status-data))
716	(setq user-id (string-to-number (assq-get 'id user-data)))
717	(setq user-name (twittering-decode-html-entities
718	(assq-get 'name user-data)))
719	(setq user-screen-name (twittering-decode-html-entities
720	(assq-get 'screen_name user-data)))
721	(setq user-location (twittering-decode-html-entities
722	(assq-get 'location user-data)))
723	(setq user-description (twittering-decode-html-entities
724	(assq-get 'description user-data)))
725	(setq user-profile-image-url (assq-get 'profile_image_url user-data))
726	(setq user-url (assq-get 'url user-data))
727	(setq user-protected (assq-get 'protected user-data))
728
729	;; make username clickable
730	(add-text-properties
731	0 (length user-name)
732	`(mouse-face highlight
733	uri ,(concat "http://twitter.com/" user-screen-name)
734	face twittering-username-face)
735	user-name)
736
737	;; make screen-name clickable
738	(add-text-properties
739	0 (length user-screen-name)
740	`(mouse-face highlight
741	face twittering-username-face
742	uri ,(concat "http://twitter.com/" user-screen-name)
743	face twittering-username-face)
744	user-screen-name)
745
746	;; make URI clickable
747	(setq regex-index 0)
748	(while regex-index
749	(setq regex-index
750	(string-match "@\$[_a-zA-Z0-9]+\$\\\|\$https?://[-_.!~*'()a-zA-Z0-9;/?:@&=+$,%#]+\$"
751	text
752	regex-index))
753	(when regex-index
754	(let* ((matched-string (match-string-no-properties 0 text))
755	(screen-name (match-string-no-properties 1 text))
756	(uri (match-string-no-properties 2 text)))
757	(add-text-properties
758	(if screen-name
759	(+ 1 (match-beginning 0))
760	(match-beginning 0))
761	(match-end 0)
762	(if screen-name
763	`(mouse-face
764	highlight
765	face twittering-uri-face
766	uri ,(concat "http://twitter.com/" screen-name))
767	`(mouse-face highlight
768	face twittering-uri-face
769	uri ,uri))
770	text))
771	(setq regex-index (match-end 0)) ))
772
773
774	;; make source pretty and clickable
775	(if (string-match "<a href=\"\$.\$\">\$.\$</a>" source)
776	(let ((uri (match-string-no-properties 1 source))
777	(caption (match-string-no-properties 2 source)))
778	(setq source caption)
779	(add-text-properties
780	0 (length source)
781	`(mouse-face highlight
782	uri ,uri
783	face twittering-uri-face
784	source ,source)
785	source)
786	))
787
788	;; save last update time
789	(setq twittering-friends-timeline-last-update created-at)
790
791	(mapcar
792	(lambda (sym)
793	`(,sym . ,(symbol-value sym)))
794	'(id text source created-at truncated
795	user-id user-name user-screen-name user-location
796	user-description
797	user-profile-image-url
798	user-url
799	user-protected)))))
800
801	(defun twittering-xmltree-to-status (xmltree)
802	(mapcar #'twittering-status-to-status-datum
803	;; quirk to treat difference between xml.el in Emacs21 and Emacs22
804	;; On Emacs22, there may be blank strings
805	(let ((ret nil) (statuses (reverse (cddr (car xmltree)))))
806	(while statuses
807	(if (consp (car statuses))
808	(setq ret (cons (car statuses) ret)))
809	(setq statuses (cdr statuses)))
810	ret)))
811
812	(defun twittering-percent-encode (str &optional coding-system)
813	(if (or (null coding-system)
814	(not (coding-system-p coding-system)))
815	(setq coding-system 'utf-8))
816	(mapconcat
817	(lambda (c)
818	(cond
819	((twittering-url-reserved-p c)
820	(char-to-string c))
821	((eq c ? ) "+")
822	(t (format "%%%x" c))))
823	(encode-coding-string str coding-system)
824	""))
825
826	(defun twittering-url-reserved-p (ch)
827	(or (and (<= ?A ch) (<= ch ?z))
828	(and (<= ?0 ch) (<= ch ?9))
829	(eq ?. ch)
830	(eq ?- ch)
831	(eq ?_ ch)
832	(eq ?~ ch)))
833
834	(defun twittering-decode-html-entities (encoded-str)
835	(if encoded-str
836	(let ((cursor 0)
837	(found-at nil)
838	(result '()))
839	(while (setq found-at
840	(string-match "&\$#\\([0-9]+\$\\\|\$[A-Za-z]+\$\\);"
841	encoded-str cursor))
842	(when (> found-at cursor)
843	(list-push (substring encoded-str cursor found-at) result))
844	(let ((number-entity (match-string-no-properties 2 encoded-str))
845	(letter-entity (match-string-no-properties 3 encoded-str)))
846	(cond (number-entity
847	(list-push
848	(char-to-string
849	(twittering-ucs-to-char
850	(string-to-number number-entity))) result))
851	(letter-entity
852	(cond ((string= "gt" letter-entity) (list-push ">" result))
853	((string= "lt" letter-entity) (list-push "<" result))
854	(t (list-push "?" result))))
855	(t (list-push "?" result)))
856	(setq cursor (match-end 0))))
857	(list-push (substring encoded-str cursor) result)
858	(apply 'concat (nreverse result)))
859	""))
860
861	(defun twittering-timer-action (func)
862	(let ((buf (get-buffer twittering-buffer)))
863	(if (null buf)
864	(twittering-stop)
865	(funcall func)
866	)))
867
868	(defun twittering-update-status-if-not-blank (status)
869	(if (string-match "^\\s-\$?:@[-_a-z0-9]+\$?\\s-$" status)
870	nil
871	(twittering-http-post "statuses" "update"
872	`(("status" . ,status)
873	("source" . "twmode")))
874	t))
875
876	(defun twittering-update-status-from-minibuffer (&optional init-str)
877	(if (null init-str) (setq init-str ""))
878	(let ((status init-str) (not-posted-p t))
879	(while not-posted-p
880	(setq status (read-from-minibuffer "status: " status nil nil nil nil t))
881	(setq not-posted-p
882	(not (twittering-update-status-if-not-blank status))))))
883
884	(defun twittering-update-lambda ()
885	(interactive)
886	(twittering-http-post
887	"statuses" "update"
888	`(("status" . "\xd34b\xd22b\xd26f\xd224\xd224\xd268\xd34b")
889	("source" . "twmode"))))
890
891	(defun twittering-update-jojo (usr msg)
892	(if (string-match "\xde21\xd24b\$\xd22a\xe0b0\\\|\xdaae\xe6cd\$\xd24f\xd0d6\$[^\xd0d7]+\$\xd0d7\xd248\xdc40\xd226"
893	msg)
894	(twittering-http-post
895	"statuses" "update"
896	`(("status" . ,(concat
897	"@" usr " "
898	(match-string-no-properties 2 msg)
899	"\xd0a1\xd24f\xd243!?"))
900	("source" . "twmode")))))
901
902	;;;
903	;;; Commands
904	;;;
905
906	(defun twittering-start (&optional action)
907	(interactive)
908	(if (null action)
909	(setq action #'twittering-friends-timeline))
910	(if twittering-timer
911	nil
912	(setq twittering-timer
913	(run-at-time "0 sec"
914	twittering-timer-interval
915	#'twittering-timer-action action))))
916
917	(defun twittering-stop ()
918	(interactive)
919	(cancel-timer twittering-timer)
920	(setq twittering-timer nil))
921
922	(defun twittering-friends-timeline ()
923	(interactive)
924	(let ((buf (get-buffer twittering-buffer)))
925	(if (not buf)
926	(twittering-stop)
927	(if (not twittering-friends-timeline-last-update)
928	(twittering-http-get "statuses" "friends_timeline")
929	(let* ((system-time-locale "C")
930	(since
931	(twittering-global-strftime
932	"%a, %d %b %Y %H:%M:%S GMT"
933	twittering-friends-timeline-last-update)))
934	(twittering-http-get "statuses" "friends_timeline"
935	`(("since" . ,since)))))))
936
937	(if twittering-icon-mode
938	(if twittering-image-stack
939	(let ((proc
940	(apply
941	#'start-process
942	"wget-images"
943	(twittering-wget-buffer)
944	"wget"
945	(format "--directory-prefix=%s" twittering-tmp-dir)
946	"--no-clobber"
947	"--quiet"
948	twittering-image-stack)))
949	(set-process-sentinel
950	proc
951	(lambda (proc stat)
952	(clear-image-cache)
953	(save-excursion
954	(set-buffer (twittering-wget-buffer))
955	)))))))
956
957	(defun twittering-update-status-interactive ()
958	(interactive)
959	(twittering-update-status-from-minibuffer))
960
961	(defun twittering-erase-old-statuses ()
962	(interactive)
963	(setq twittering-friends-timeline-data nil)
964	(if (not twittering-friends-timeline-last-update)
965	(twittering-http-get "statuses" "friends_timeline")
966	(let* ((system-time-locale "C")
967	(since
968	(twittering-global-strftime
969	"%a, %d %b %Y %H:%M:%S GMT"
970	twittering-friends-timeline-last-update)))
971	(twittering-http-get "statuses" "friends_timeline"
972	`(("since" . ,since))))))
973
974	(defun twittering-click ()
975	(interactive)
976	(let ((uri (get-text-property (point) 'uri)))
977	(if uri
978	(browse-url uri))))
979
980	(defun twittering-enter ()
981	(interactive)
982	(let ((username (get-text-property (point) 'username))
983	(uri (get-text-property (point) 'uri)))
984	(if username
985	(twittering-update-status-from-minibuffer (concat "@" username " "))
986	(if uri
987	(browse-url uri)))))
988
989	(defun twittering-view-user-page ()
990	(interactive)
991	(let ((uri (get-text-property (point) 'uri)))
992	(if uri
993	(browse-url uri))))
994
995	(defun twittering-reply-to-user ()
996	(interactive)
997	(let ((username (get-text-property (point) 'username)))
998	(if username
999	(twittering-update-status-from-minibuffer (concat "@" username " ")))))
1000
1001	(defun twittering-get-password ()
1002	(or twittering-password
1003	(setq twittering-password (read-passwd "twittering-mode: "))))
1004
1005	(defun twittering-goto-next-status ()
1006	"Go to next status."
1007	(interactive)
1008	(let ((pos))
1009	(setq pos (twittering-get-next-username-face-pos (point)))
1010	(if pos
1011	(goto-char pos)
1012	(message "End of status."))))
1013
1014	(defun twittering-get-next-username-face-pos (pos)
1015	(interactive)
1016	(let ((prop))
1017	(catch 'not-found
1018	(while (and pos (not (eq prop twittering-username-face)))
1019	(setq pos (next-single-property-change pos 'face))
1020	(when (eq pos nil) (throw 'not-found nil))
1021	(setq prop (get-text-property pos 'face)))
1022	pos)))
1023
1024	(defun twittering-goto-previous-status ()
1025	"Go to previous status."
1026	(interactive)
1027	(let ((pos))
1028	(setq pos (twittering-get-previous-username-face-pos (point)))
1029	(if pos
1030	(goto-char pos)
1031	(message "Start of status."))))
1032
1033	(defun twittering-get-previous-username-face-pos (pos)
1034	(interactive)
1035	(let ((prop))
1036	(catch 'not-found
1037	(while (and pos (not (eq prop twittering-username-face)))
1038	(setq pos (previous-single-property-change pos 'face))
1039	(when (eq pos nil) (throw 'not-found nil))
1040	(setq prop (get-text-property pos 'face)))
1041	pos)))
1042
1043	(defun twittering-goto-next-status-of-user ()
1044	"Go to next status of user."
1045	(interactive)
1046	(let ((user-name (twittering-get-username-at-pos (point)))
1047	(pos (twittering-get-next-username-face-pos (point))))
1048	(while (and (not (eq pos nil))
1049	(not (equal (twittering-get-username-at-pos pos) user-name)))
1050	(setq pos (twittering-get-next-username-face-pos pos)))
1051	(if pos
1052	(goto-char pos)
1053	(if user-name
1054	(message "End of %s's status." user-name)
1055	(message "Invalid user-name.")))))
1056
1057	(defun twittering-goto-previous-status-of-user ()
1058	"Go to previous status of user."
1059	(interactive)
1060	(let ((user-name (twittering-get-username-at-pos (point)))
1061	(pos (twittering-get-previous-username-face-pos (point))))
1062	(while (and (not (eq pos nil))
1063	(not (equal (twittering-get-username-at-pos pos) user-name)))
1064	(setq pos (twittering-get-previous-username-face-pos pos)))
1065	(if pos
1066	(goto-char pos)
1067	(if user-name
1068	(message "Start of %s's status." user-name)
1069	(message "Invalid user-name.")))))
1070
1071	(defun twittering-get-username-at-pos (pos)
1072	(let ((start-pos pos)
1073	(end-pos))
1074	(catch 'not-found
1075	(while (eq (get-text-property start-pos 'face) twittering-username-face)
1076	(setq start-pos (1- start-pos))
1077	(when (or (eq start-pos nil) (eq start-pos 0)) (throw 'not-found nil)))
1078	(setq start-pos (1+ start-pos))
1079	(setq end-pos (next-single-property-change pos 'face))
1080	(buffer-substring start-pos end-pos))))
1081
1082	(defun twittering-get-status-url (username id)
1083	"Generate status URL."
1084	(format "http://twitter.com/%s/statuses/%d" username id))
1085
1086	;;;###autoload
1087	(defun twit ()
1088	"Start twittering-mode."
1089	(interactive)
1090	(twittering-mode))
1091
1092	(provide 'twittering-mode)
1093	;;; twittering.el ends here

Note: See TracBrowser for help on using the browser.

Context Navigation

root/lang/elisp/twittering-mode/branches/tsuyoshi/twittering-mode.el @ 61

Download in other formats: