Context Navigation

twittering-mode.el @ 11

Revision 11, 28.8 kB (checked in by tsuyoshi, 16 years ago)
Marge proxy,safe passowrd,safe image tmp dir,user-agent,mode string and treatment fix.

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

Note: See TracBrowser for help on using the browser.

Context Navigation

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

Download in other formats: