Context Navigation

twittering-mode.el @ 50

Revision 50, 35.3 kB (checked in by tsuyoshi, 16 years ago)
fix param

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

Download in other formats: