Context Navigation

twittering-mode.el @ 42

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

Note: See TracBrowser for help on using the browser.

Context Navigation

root/lang/elisp/twittering-mode/branches/RB-0.2/twittering-mode.el @ 42

Download in other formats: