Context Navigation

twittering-mode.el @ 29

Revision 29, 35.6 kB (checked in by gan2, 16 years ago)
message を status に名前変更

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

Download in other formats: