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