Context Navigation

twittering-mode.el @ 40

Revision 40, 33.4 kB (checked in by tsuyoshi, 16 years ago)
Fix id/user-id formatting problem. append created-time clicable url(status).

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

Download in other formats: