Context Navigation

twittering-mode.el @ 38

Revision 38, 32.9 kB (checked in by tsuyoshi, 16 years ago)
Update to 0.4.

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

Note: See TracBrowser for help on using the browser.

Context Navigation

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

Download in other formats: