Context Navigation

twittering-mode.el @ 77

Revision 77, 34.7 kB (checked in by tsuyoshi, 15 years ago)
Fix Major mode docstring : add keybinding

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

Note: See TracBrowser for help on using the browser.

Context Navigation

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

Download in other formats: