Context Navigation

twittering-mode.el @ 33

Revision 33, 37.3 kB (checked in by tsuyoshi, 16 years ago)
Fix j,k,n,p functions error.

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

Note: See TracBrowser for help on using the browser.

Context Navigation

root/lang/elisp/twittering-mode/branches/tsuyoshi/twittering-mode.el @ 33

Download in other formats: