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