Context Navigation

twittering-mode.el @ 10

Revision 10, 25.6 kB (checked in by hayamizu, 16 years ago)
lang/elisp/twittering-mode: Initial import

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

Note: See TracBrowser for help on using the browser.

Context Navigation

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

Download in other formats: