Context Navigation

twittering-mode.el @ 81

Revision 81, 36.1 kB (checked in by tsuyoshi, 15 years ago)
fix update target.

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

Note: See TracBrowser for help on using the browser.

Context Navigation

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

Download in other formats: