Context Navigation

twittering-mode.el @ 47

Revision 47, 33.5 kB (checked in by tsuyoshi, 16 years ago)
update 0.5 : twittering-mode

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
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	(let ((formatted-status (apply 'concat (nreverse result))))
542	(add-text-properties 0 (length formatted-status)
543	`(username ,(attr 'user-screen-name))
544	formatted-status)
545	formatted-status)
546	)))
547
548	(defun twittering-http-post
549	(method-class method &optional parameters contents sentinel)
550	"Send HTTP POST request to twitter.com
551
552	METHOD-CLASS must be one of Twitter API method classes(statuses, users or direct_messages).
553	METHOD must be one of Twitter API method which belongs to METHOD-CLASS.
554	PARAMETERS is alist of URI parameters. ex) ((\"mode\" . \"view\") (\"page\" . \"6\")) => <URI>?mode=view&page=6"
555	(if (null sentinel) (setq sentinel 'twittering-http-post-default-sentinel))
556
557	;; clear the buffer
558	(save-excursion
559	(set-buffer (twittering-http-buffer))
560	(erase-buffer))
561
562	(let (proc server port
563	(proxy-user twittering-proxy-user)
564	(proxy-password twittering-proxy-password))
565	(progn
566	(if (and twittering-proxy-use twittering-proxy-server)
567	(setq server twittering-proxy-server
568	port (if (integerp twittering-proxy-port)
569	(int-to-string twittering-proxy-port)
570	twittering-proxy-port))
571	(setq server "twitter.com"
572	port "80"))
573	(setq proc
574	(open-network-stream
575	"network-connection-process" (twittering-http-buffer)
576	server (string-to-number port)))
577	(set-process-sentinel proc sentinel)
578	(process-send-string
579	proc
580	(let ((nl "\r\n")
581	request)
582	(setq request
583	(concat "POST http://twitter.com/" method-class "/" method ".xml?"
584	(if parameters
585	(mapconcat
586	(lambda (param-pair)
587	(format "%s=%s"
588	(twittering-percent-encode (car param-pair))
589	(twittering-percent-encode (cdr param-pair))))
590	parameters
591	"&"))
592	" HTTP/1.1" nl
593	"Host: twitter.com" nl
594	"User-Agent: " (twittering-user-agent) nl
595	"Authorization: Basic "
596	(base64-encode-string
597	(concat twittering-username ":" (twittering-get-password)))
598	nl
599	"Content-Type: text/plain" nl
600	"Content-Length: 0" nl
601	(when twittering-proxy-use
602	"Proxy-Connection: Keep-Alive" nl
603	(when (and proxy-user proxy-password)
604	(concat
605	"Proxy-Authorization: Basic "
606	(base64-encode-string
607	(concat proxy-user ":"
608	proxy-password))
609	nl)))
610	nl nl))
611	(debug-print (concat "POST Request\n" request))
612	request)))))
613
614	(defun twittering-http-post-default-sentinel (proc stat &optional suc-msg)
615
616	(condition-case err-signal
617	(let ((header (twittering-get-response-header))
618	;; (body (twittering-get-response-body)) not used now.
619	(status nil))
620	(string-match "HTTP/1\.1 \$[a-z0-9 ]+\$\r?\n" header)
621	(setq status (match-string-no-properties 1 header))
622	(case-string status
623	(("200 OK")
624	(message (if suc-msg suc-msg "Success: Post")))
625	(t (message status)))
626	)
627	(error (message (prin1-to-string err-signal))))
628	)
629
630	(defun twittering-get-response-header (&optional buffer)
631	"Exract HTTP response header from HTTP response.
632	`buffer' may be a buffer or the name of an existing buffer.
633	If `buffer' is omitted, the value of `twittering-http-buffer' is used as `buffer'."
634	(if (stringp buffer) (setq buffer (get-buffer buffer)))
635	(if (null buffer) (setq buffer (twittering-http-buffer)))
636	(save-excursion
637	(set-buffer buffer)
638	(let ((content (buffer-string)))
639	(substring content 0 (string-match "\r?\n\r?\n" content)))))
640
641	(defun twittering-get-response-body (&optional buffer)
642	"Exract HTTP response body from HTTP response, parse it as XML, and return a XML tree as list.
643	`buffer' may be a buffer or the name of an existing buffer.
644	If `buffer' is omitted, the value of `twittering-http-buffer' is used as `buffer'."
645	(if (stringp buffer) (setq buffer (get-buffer buffer)))
646	(if (null buffer) (setq buffer (twittering-http-buffer)))
647	(save-excursion
648	(set-buffer buffer)
649	(let ((content (buffer-string)))
650	(let ((content (buffer-string)))
651	(xml-parse-region (+ (string-match "\r?\n\r?\n" content)
652	(length (match-string 0 content)))
653	(point-max)))
654	)))
655
656	(defun twittering-cache-status-datum (status-datum &optional data-var)
657	"Cache status datum into data-var(default twittering-friends-timeline-data)
658	If STATUS-DATUM is already in DATA-VAR, return nil. If not, return t."
659	(if (null data-var)
660	(setf data-var 'twittering-friends-timeline-data))
661	(let ((id (cdr (assq 'id status-datum))))
662	(if (or (null (symbol-value data-var))
663	(not (find-if
664	(lambda (item)
665	(eql id (cdr (assq 'id item))))
666	(symbol-value data-var))))
667	(progn
668	(if twittering-jojo-mode
669	(twittering-update-jojo (cdr (assq 'user-screen-name status-datum))
670	(cdr (assq 'text status-datum))))
671	(set data-var (cons status-datum (symbol-value data-var)))
672	t)
673	nil)))
674
675	(defun twittering-status-to-status-datum (status)
676	(flet ((assq-get (item seq)
677	(car (cddr (assq item seq)))))
678	(let* ((status-data (cddr status))
679	id text source created-at truncated
680	(user-data (cddr (assq 'user status-data)))
681	user-id user-name
682	user-screen-name
683	user-location
684	user-description
685	user-profile-image-url
686	user-url
687	user-protected
688	regex-index)
689
690	(setq id (string-to-number (assq-get 'id status-data)))
691	(setq text (twittering-decode-html-entities
692	(assq-get 'text status-data)))
693	(setq source (twittering-decode-html-entities
694	(assq-get 'source status-data)))
695	(setq created-at (assq-get 'created_at status-data))
696	(setq truncated (assq-get 'truncated status-data))
697	(setq user-id (string-to-number (assq-get 'id user-data)))
698	(setq user-name (twittering-decode-html-entities
699	(assq-get 'name user-data)))
700	(setq user-screen-name (twittering-decode-html-entities
701	(assq-get 'screen_name user-data)))
702	(setq user-location (twittering-decode-html-entities
703	(assq-get 'location user-data)))
704	(setq user-description (twittering-decode-html-entities
705	(assq-get 'description user-data)))
706	(setq user-profile-image-url (assq-get 'profile_image_url user-data))
707	(setq user-url (assq-get 'url user-data))
708	(setq user-protected (assq-get 'protected user-data))
709
710	;; make username clickable
711	(add-text-properties
712	0 (length user-name)
713	`(mouse-face highlight
714	uri ,(concat "http://twitter.com/" user-screen-name)
715	face twittering-username-face)
716	user-name)
717
718	;; make screen-name clickable
719	(add-text-properties
720	0 (length user-screen-name)
721	`(mouse-face highlight
722	face twittering-username-face
723	uri ,(concat "http://twitter.com/" user-screen-name)
724	face twittering-username-face)
725	user-screen-name)
726
727	;; make URI clickable
728	(setq regex-index 0)
729	(while regex-index
730	(setq regex-index
731	(string-match "@\$[_a-zA-Z0-9]+\$\\\|\$https?://[-_.!~*'()a-zA-Z0-9;/?:@&=+$,%#]+\$"
732	text
733	regex-index))
734	(when regex-index
735	(let* ((matched-string (match-string-no-properties 0 text))
736	(screen-name (match-string-no-properties 1 text))
737	(uri (match-string-no-properties 2 text)))
738	(add-text-properties
739	(if screen-name
740	(+ 1 (match-beginning 0))
741	(match-beginning 0))
742	(match-end 0)
743	(if screen-name
744	`(mouse-face
745	highlight
746	face twittering-uri-face
747	uri ,(concat "http://twitter.com/" screen-name))
748	`(mouse-face highlight
749	face twittering-uri-face
750	uri ,uri))
751	text))
752	(setq regex-index (match-end 0)) ))
753
754
755	;; make source pretty and clickable
756	(if (string-match "<a href=\"\$.\$\">\$.\$</a>" source)
757	(let ((uri (match-string-no-properties 1 source))
758	(caption (match-string-no-properties 2 source)))
759	(setq source caption)
760	(add-text-properties
761	0 (length source)
762	`(mouse-face highlight
763	uri ,uri
764	face twittering-uri-face
765	source ,source)
766	source)
767	))
768
769	(mapcar
770	(lambda (sym)
771	`(,sym . ,(symbol-value sym)))
772	'(id text source created-at truncated
773	user-id user-name user-screen-name user-location
774	user-description
775	user-profile-image-url
776	user-url
777	user-protected)))))
778
779	(defun twittering-xmltree-to-status (xmltree)
780	(mapcar #'twittering-status-to-status-datum
781	;; quirk to treat difference between xml.el in Emacs21 and Emacs22
782	;; On Emacs22, there may be blank strings
783	(let ((ret nil) (statuses (reverse (cddr (car xmltree)))))
784	(while statuses
785	(if (consp (car statuses))
786	(setq ret (cons (car statuses) ret)))
787	(setq statuses (cdr statuses)))
788	ret)))
789
790	(defun twittering-percent-encode (str &optional coding-system)
791	(if (or (null coding-system)
792	(not (coding-system-p coding-system)))
793	(setq coding-system 'utf-8))
794	(mapconcat
795	(lambda (c)
796	(cond
797	((twittering-url-reserved-p c)
798	(char-to-string c))
799	((eq c ? ) "+")
800	(t (format "%%%x" c))))
801	(encode-coding-string str coding-system)
802	""))
803
804	(defun twittering-url-reserved-p (ch)
805	(or (and (<= ?A ch) (<= ch ?z))
806	(and (<= ?0 ch) (<= ch ?9))
807	(eq ?. ch)
808	(eq ?- ch)
809	(eq ?_ ch)
810	(eq ?~ ch)))
811
812	(defun twittering-decode-html-entities (encoded-str)
813	(if encoded-str
814	(let ((cursor 0)
815	(found-at nil)
816	(result '()))
817	(while (setq found-at
818	(string-match "&\$#\\([0-9]+\$\\\|\$[A-Za-z]+\$\\);"
819	encoded-str cursor))
820	(when (> found-at cursor)
821	(list-push (substring encoded-str cursor found-at) result))
822	(let ((number-entity (match-string-no-properties 2 encoded-str))
823	(letter-entity (match-string-no-properties 3 encoded-str)))
824	(cond (number-entity
825	(list-push
826	(char-to-string
827	(twittering-ucs-to-char
828	(string-to-number number-entity))) result))
829	(letter-entity
830	(cond ((string= "gt" letter-entity) (list-push ">" result))
831	((string= "lt" letter-entity) (list-push "<" result))
832	(t (list-push "?" result))))
833	(t (list-push "?" result)))
834	(setq cursor (match-end 0))))
835	(list-push (substring encoded-str cursor) result)
836	(apply 'concat (nreverse result)))
837	""))
838
839	(defun twittering-timer-action (func)
840	(let ((buf (get-buffer twittering-buffer)))
841	(if (null buf)
842	(twittering-stop)
843	(funcall func)
844	)))
845
846	(defun twittering-update-status-if-not-blank (status)
847	(if (string-match "^\\s-\$?:@[-_a-z0-9]+\$?\\s-$" status)
848	nil
849	(twittering-http-post "statuses" "update"
850	`(("status" . ,status)
851	("source" . "twmode")))
852	t))
853
854	(defun twittering-update-status-from-minibuffer (&optional init-str)
855	(if (null init-str) (setq init-str ""))
856	(let ((status init-str) (not-posted-p t))
857	(while not-posted-p
858	(setq status (read-from-minibuffer "status: " status nil nil nil nil t))
859	(setq not-posted-p
860	(not (twittering-update-status-if-not-blank status))))))
861
862	(defun twittering-update-lambda ()
863	(interactive)
864	(twittering-http-post
865	"statuses" "update"
866	`(("status" . "\xd34b\xd22b\xd26f\xd224\xd224\xd268\xd34b")
867	("source" . "twmode"))))
868
869	(defun twittering-update-jojo (usr msg)
870	(if (string-match "\xde21\xd24b\$\xd22a\xe0b0\\\|\xdaae\xe6cd\$\xd24f\xd0d6\$[^\xd0d7]+\$\xd0d7\xd248\xdc40\xd226"
871	msg)
872	(twittering-http-post
873	"statuses" "update"
874	`(("status" . ,(concat
875	"@" usr " "
876	(match-string-no-properties 2 msg)
877	"\xd0a1\xd24f\xd243!?"))
878	("source" . "twmode")))))
879
880	;;;
881	;;; Commands
882	;;;
883
884	(defun twittering-start (&optional action)
885	(interactive)
886	(if (null action)
887	(setq action #'twittering-friends-timeline))
888	(if twittering-timer
889	nil
890	(setq twittering-timer
891	(run-at-time "0 sec"
892	twittering-timer-interval
893	#'twittering-timer-action action))))
894
895	(defun twittering-stop ()
896	(interactive)
897	(cancel-timer twittering-timer)
898	(setq twittering-timer nil))
899
900	(defun twittering-friends-timeline ()
901	(interactive)
902	(let ((buf (get-buffer twittering-buffer)))
903	(if (not buf)
904	(twittering-stop)
905	(twittering-http-get "statuses" "friends_timeline")
906	))
907
908	(if twittering-icon-mode
909	(if twittering-image-stack
910	(let ((proc
911	(apply
912	#'start-process
913	"wget-images"
914	(twittering-wget-buffer)
915	"wget"
916	(format "--directory-prefix=%s" twittering-tmp-dir)
917	"--no-clobber"
918	"--quiet"
919	twittering-image-stack)))
920	(set-process-sentinel
921	proc
922	(lambda (proc stat)
923	(clear-image-cache)
924	(save-excursion
925	(set-buffer (twittering-wget-buffer))
926	)))))))
927
928	(defun twittering-update-status-interactive ()
929	(interactive)
930	(twittering-update-status-from-minibuffer))
931
932	(defun twittering-erase-old-statuses ()
933	(interactive)
934	(setq twittering-friends-timeline-data nil)
935	(twittering-http-get "statuses" "friends_timeline"))
936
937	(defun twittering-click ()
938	(interactive)
939	(let ((uri (get-text-property (point) 'uri)))
940	(if uri
941	(browse-url uri))))
942
943	(defun twittering-enter ()
944	(interactive)
945	(let ((username (get-text-property (point) 'username))
946	(uri (get-text-property (point) 'uri)))
947	(if username
948	(twittering-update-status-from-minibuffer (concat "@" username " "))
949	(if uri
950	(browse-url uri)))))
951
952	(defun twittering-view-user-page ()
953	(interactive)
954	(let ((uri (get-text-property (point) 'uri)))
955	(if uri
956	(browse-url uri))))
957
958	(defun twittering-reply-to-user ()
959	(interactive)
960	(let ((username (get-text-property (point) 'username)))
961	(if username
962	(twittering-update-status-from-minibuffer (concat "@" username " ")))))
963
964	(defun twittering-get-password ()
965	(or twittering-password
966	(setq twittering-password (read-passwd "twittering-mode: "))))
967
968	(defun twittering-goto-next-status ()
969	"Go to next status."
970	(interactive)
971	(let ((pos))
972	(setq pos (twittering-get-next-username-face-pos (point)))
973	(if pos
974	(goto-char pos)
975	(message "End of status."))))
976
977	(defun twittering-get-next-username-face-pos (pos)
978	(interactive)
979	(let ((prop))
980	(catch 'not-found
981	(while (and pos (not (eq prop twittering-username-face)))
982	(setq pos (next-single-property-change pos 'face))
983	(when (eq pos nil) (throw 'not-found nil))
984	(setq prop (get-text-property pos 'face)))
985	pos)))
986
987	(defun twittering-goto-previous-status ()
988	"Go to previous status."
989	(interactive)
990	(let ((pos))
991	(setq pos (twittering-get-previous-username-face-pos (point)))
992	(if pos
993	(goto-char pos)
994	(message "Start of status."))))
995
996	(defun twittering-get-previous-username-face-pos (pos)
997	(interactive)
998	(let ((prop))
999	(catch 'not-found
1000	(while (and pos (not (eq prop twittering-username-face)))
1001	(setq pos (previous-single-property-change pos 'face))
1002	(when (eq pos nil) (throw 'not-found nil))
1003	(setq prop (get-text-property pos 'face)))
1004	pos)))
1005
1006	(defun twittering-goto-next-status-of-user ()
1007	"Go to next status of user."
1008	(interactive)
1009	(let ((user-name (twittering-get-username-at-pos (point)))
1010	(pos (twittering-get-next-username-face-pos (point))))
1011	(while (and (not (eq pos nil))
1012	(not (equal (twittering-get-username-at-pos pos) user-name)))
1013	(setq pos (twittering-get-next-username-face-pos pos)))
1014	(if pos
1015	(goto-char pos)
1016	(if user-name
1017	(message "End of %s's status." user-name)
1018	(message "Invalid user-name.")))))
1019
1020	(defun twittering-goto-previous-status-of-user ()
1021	"Go to previous status of user."
1022	(interactive)
1023	(let ((user-name (twittering-get-username-at-pos (point)))
1024	(pos (twittering-get-previous-username-face-pos (point))))
1025	(while (and (not (eq pos nil))
1026	(not (equal (twittering-get-username-at-pos pos) user-name)))
1027	(setq pos (twittering-get-previous-username-face-pos pos)))
1028	(if pos
1029	(goto-char pos)
1030	(if user-name
1031	(message "Start of %s's status." user-name)
1032	(message "Invalid user-name.")))))
1033
1034	(defun twittering-get-username-at-pos (pos)
1035	(let ((start-pos pos)
1036	(end-pos))
1037	(catch 'not-found
1038	(while (eq (get-text-property start-pos 'face) twittering-username-face)
1039	(setq start-pos (1- start-pos))
1040	(when (or (eq start-pos nil) (eq start-pos 0)) (throw 'not-found nil)))
1041	(setq start-pos (1+ start-pos))
1042	(setq end-pos (next-single-property-change pos 'face))
1043	(buffer-substring start-pos end-pos))))
1044
1045	(defun twittering-get-status-url (username id)
1046	"Generate status URL."
1047	(format "http://twitter.com/%s/statuses/%d" username id))
1048
1049	;;;###autoload
1050	(defun twit ()
1051	"Start twittering-mode."
1052	(interactive)
1053	(twittering-mode))
1054
1055	(provide 'twittering-mode)
1056	;;; twittering.el ends here

Note: See TracBrowser for help on using the browser.

Context Navigation

root/lang/elisp/twittering-mode/trunk/twittering-mode.el @ 47

Download in other formats: