Context Navigation

twittering-mode.el @ 25

Revision 25, 29.0 kB (checked in by hayamizu, 16 years ago)
replaced

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

Note: See TracBrowser for help on using the browser.

Context Navigation

root/lang/elisp/twittering-mode/branches/RB-0.3/twittering-mode.el @ 25

Download in other formats: