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