Context Navigation

twittering-mode.el @ 126

Revision 35, 32.5 kB (checked in by gan2, 17 years ago)
branches/tsuyoshi/ から twittering-mode.el をコピー

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

Note: See TracBrowser for help on using the browser.

Context Navigation

root/lang/elisp/twittering-mode/branches/gan2/twittering-mode.el @ 126

Download in other formats: