Changeset 28 for lang/elisp/twittering-mode
- Timestamp:
- 04/25/08 08:18:06 (18 years ago)
- Location:
- lang/elisp/twittering-mode/branches/gan2
- Files:
-
- 1 added
- 2 modified
- 1 copied
-
. (copied) (copied from lang/elisp/twittering-mode/branches/RB-0.3)
-
ChangeLog (modified) (1 diff)
-
TAGS (added)
-
twittering-mode.el (modified) (34 diffs)
Legend:
- Unmodified
- Added
- Removed
-
lang/elisp/twittering-mode/branches/gan2/ChangeLog
r25 r28 1 2008-04-25 gan2 <gan2.ruby@gmail.com> 2 3 * twittering-mode.el: next-line や previous-line は C-n や C-p でできるので j, k を隣接したメッセージの移動に変更 4 (twittering-next-message): 次のメッセージにジャンプする関数を定義 5 (twittering-next-username-face-pos): twittering-next-message が呼び出す関数を定義 6 (twittering-previous-message): 前のメッセージにジャンプする関数を定義 7 (twittering-previous-username-face-pos): twittering-previous-message が呼び出す関数を定義 8 (twittering-mode-map): j, k で次のメッセージと前のメッセージに移動するように変更 9 10 2008-04-23 gan2 <gan2.ruby@gmail.com> 11 12 * twittering-mode.el : RB-0.3 を gan2 にコピー. ソフトタブに統一 13 (twittering-mode-version): バージョンを表示する関数を定義 14 1 15 2008-03-15 Y. Hayamizu <haya@haya-laptop-ubuntu> 2 16 -
lang/elisp/twittering-mode/branches/gan2/twittering-mode.el
r25 r28 48 48 (defconst twittering-mode-version "0.3") 49 49 50 (defun twittering-mode-version () 51 "Display a message for twittering-mode version." 52 (interactive) 53 (let ((version-string 54 (format "twittering-mode-v%s" twittering-mode-version))) 55 (if (interactive-p) 56 (message "%s" version-string) 57 version-string))) 58 50 59 (defvar twittering-mode-map (make-sparse-keymap)) 51 60 … … 66 75 (defvar twittering-status-format nil) 67 76 (setq twittering-status-format "%i %s, %@:\n %t // from %f%L") 68 ; %s - screen_name69 ; %S - name70 ; %i - profile_image71 ; %d - description72 ; %l - location73 ; %L - " [location]"74 ; %u - url75 ; %j - user.id76 ; %p - protected?77 ; %c - created_at (raw UTC string)78 ; %C{time-format-str} - created_at (formatted with time-format-str)79 ; %@ - X seconds ago80 ; %t - text81 ; %' - truncated82 ; %f - source83 ; %# - id77 ;; %s - screen_name 78 ;; %S - name 79 ;; %i - profile_image 80 ;; %d - description 81 ;; %l - location 82 ;; %L - " [location]" 83 ;; %u - url 84 ;; %j - user.id 85 ;; %p - protected? 86 ;; %c - created_at (raw UTC string) 87 ;; %C{time-format-str} - created_at (formatted with time-format-str) 88 ;; %@ - X seconds ago 89 ;; %t - text 90 ;; %' - truncated 91 ;; %f - source 92 ;; %# - id 84 93 85 94 (defvar twittering-buffer "*twittering*") … … 99 108 (if (bufferp buffer) 100 109 (if (buffer-live-p buffer) 101 buffer102 (generate-new-buffer (buffer-name buffer)))110 buffer 111 (generate-new-buffer (buffer-name buffer))) 103 112 (if (stringp buffer) 104 (or (get-buffer buffer)105 (generate-new-buffer buffer)))))113 (or (get-buffer buffer) 114 (generate-new-buffer buffer))))) 106 115 107 116 (defun assocref (item alist) … … 120 129 (interactive) 121 130 (setq twittering-proxy-use 122 (not twittering-proxy-use))131 (not twittering-proxy-use)) 123 132 (message "%s %s" 124 "Use Proxy:"125 (if twittering-proxy-use126 "on" "off")))133 "Use Proxy:" 134 (if twittering-proxy-use 135 "on" "off"))) 127 136 128 137 (defun twittering-user-agent-default-function () 129 138 "Twittering mode default User-Agent function." 130 139 (concat "Emacs/" 131 (int-to-string emacs-major-version) "." (int-to-string132 emacs-minor-version)133 " "134 "Twittering-mode/"135 twittering-mode-version))140 (int-to-string emacs-major-version) "." (int-to-string 141 emacs-minor-version) 142 " " 143 "Twittering-mode/" 144 twittering-mode-version)) 136 145 137 146 (defvar twittering-user-agent-function 'twittering-user-agent-default-function) … … 149 158 (defvar twittering-tmp-dir 150 159 (expand-file-name (concat "twmode-images-" (user-login-name)) 151 temporary-file-directory))160 temporary-file-directory)) 152 161 153 162 (defvar twittering-icon-mode nil "You MUST NOT CHANGE this variable directory. You should change through function'twittering-icon-mode'") … … 155 164 (interactive) 156 165 (setq twittering-icon-mode 157 (if twittering-icon-mode158 (if (null arg)159 nil160 (> (prefix-numeric-value arg) 0))161 (when (or (null arg)162 (and arg (> (prefix-numeric-value arg) 0)))163 (when (file-writable-p twittering-tmp-dir)164 (progn165 (if (not (file-directory-p twittering-tmp-dir))166 (make-directory twittering-tmp-dir))167 t)))))166 (if twittering-icon-mode 167 (if (null arg) 168 nil 169 (> (prefix-numeric-value arg) 0)) 170 (when (or (null arg) 171 (and arg (> (prefix-numeric-value arg) 0))) 172 (when (file-writable-p twittering-tmp-dir) 173 (progn 174 (if (not (file-directory-p twittering-tmp-dir)) 175 (make-directory twittering-tmp-dir)) 176 t))))) 168 177 (twittering-render-friends-timeline)) 169 178 … … 171 180 (interactive) 172 181 (setq twittering-scroll-mode 173 (if (null arg)174 (not twittering-scroll-mode)175 (> (prefix-numeric-value arg) 0))))182 (if (null arg) 183 (not twittering-scroll-mode) 184 (> (prefix-numeric-value arg) 0)))) 176 185 177 186 (defun twittering-jojo-mode (&optional arg) 178 187 (interactive) 179 188 (setq twittering-jojo-mode 180 (if (null arg)181 (not twittering-jojo-mode)182 (> (prefix-numeric-value arg) 0))))189 (if (null arg) 190 (not twittering-jojo-mode) 191 (> (prefix-numeric-value arg) 0)))) 183 192 184 193 (defvar twittering-image-stack nil) … … 193 202 (defun twittering-local-strftime (fmt string) 194 203 (format-time-string fmt ; like "%Y-%m-%d %H:%M:%S", shown in localtime 195 (apply 'encode-time (parse-time-string string))))204 (apply 'encode-time (parse-time-string string)))) 196 205 197 206 (defvar twittering-debug-mode nil) … … 203 212 `(let ((,obsym ,obj)) 204 213 (if twittering-debug-mode 205 (with-current-buffer (twittering-debug-buffer)206 (insert (prin1-to-string ,obsym))207 (newline)208 ,obsym)209 ,obsym))))214 (with-current-buffer (twittering-debug-buffer) 215 (insert (prin1-to-string ,obsym)) 216 (newline) 217 ,obsym) 218 ,obsym)))) 210 219 211 220 (defun twittering-debug-mode () 212 221 (interactive) 213 222 (setq twittering-debug-mode 214 (not twittering-debug-mode))223 (not twittering-debug-mode)) 215 224 (message (if twittering-debug-mode "debug mode:on" "debug mode:off"))) 216 225 … … 224 233 (define-key km [mouse-1] 'twittering-click) 225 234 (define-key km "\C-c\C-v" 'twittering-view-user-page) 226 (define-key km "j" 'next-line) 227 (define-key km "k" 'previous-line) 235 ;; (define-key km "j" 'next-line) 236 ;; (define-key km "k" 'previous-line) 237 (define-key km "j" 'twittering-next-message) 238 (define-key km "k" 'twittering-previous-message) 228 239 (define-key km "l" 'forward-char) 229 240 (define-key km "h" 'backward-char) … … 242 253 () 243 254 (setq twittering-mode-syntax-table (make-syntax-table)) 244 ; (modify-syntax-entry ? "" twittering-mode-syntax-table)255 ;; (modify-syntax-entry ? "" twittering-mode-syntax-table) 245 256 (modify-syntax-entry ?\" "w" twittering-mode-syntax-table) 246 257 ) 247 258 248 259 (defun twittering-mode-init-variables () 249 ; (make-variable-buffer-local 'variable)250 ; (setq variable nil)260 ;; (make-variable-buffer-local 'variable) 261 ;; (setq variable nil) 251 262 (font-lock-mode -1) 252 263 (defface twittering-username-face … … 266 277 ,@(mapcar 267 278 (lambda (clause) 268 (let ((keylist (car clause))269 (body (cdr clause)))270 `(,(if (listp keylist)271 `(or ,@(mapcar (lambda (key) `(string-equal ,str ,key)) keylist))272 't)273 ,@body)))279 (let ((keylist (car clause)) 280 (body (cdr clause))) 281 `(,(if (listp keylist) 282 `(or ,@(mapcar (lambda (key) `(string-equal ,str ,key)) keylist)) 283 't) 284 ,@body))) 274 285 clauses))) 275 286 … … 311 322 312 323 (let (proc server port 313 (proxy-user twittering-proxy-user)314 (proxy-password twittering-proxy-password))324 (proxy-user twittering-proxy-user) 325 (proxy-password twittering-proxy-password)) 315 326 (condition-case nil 316 (progn317 (if (and twittering-proxy-use twittering-proxy-server)318 (setq server twittering-proxy-server319 port (if (integerp twittering-proxy-port)320 (int-to-string twittering-proxy-port)321 twittering-proxy-port))322 (setq server "twitter.com"323 port "80"))324 (setq proc325 (open-network-stream326 "network-connection-process" (twittering-http-buffer)327 server (string-to-number port)))328 (set-process-sentinel proc sentinel)329 (process-send-string330 proc331 (let ((nl "\r\n")332 request)333 (setq request334 (concat "GET http://twitter.com/" method-class "/" method ".xml HTTP/1.1" nl335 "Host: twitter.com" nl336 "User-Agent: " (twittering-user-agent) nl337 "Authorization: Basic "338 (base64-encode-string339 (concat twittering-username ":" (twittering-get-password)))340 nl341 "Accept: text/xml"342 ",application/xml"343 ",application/xhtml+xml"344 ",application/html;q=0.9"345 ",text/plain;q=0.8"346 ",image/png,*/*;q=0.5" nl347 "Accept-Charset: utf-8;q=0.7,*;q=0.7" nl348 (when twittering-proxy-use349 "Proxy-Connection: Keep-Alive" nl350 (when (and proxy-user proxy-password)351 (concat352 "Proxy-Authorization: Basic "353 (base64-encode-string354 (concat proxy-user ":"355 proxy-password))356 nl)))357 nl nl))358 (debug-print (concat "GET Request\n" request))359 request)))327 (progn 328 (if (and twittering-proxy-use twittering-proxy-server) 329 (setq server twittering-proxy-server 330 port (if (integerp twittering-proxy-port) 331 (int-to-string twittering-proxy-port) 332 twittering-proxy-port)) 333 (setq server "twitter.com" 334 port "80")) 335 (setq proc 336 (open-network-stream 337 "network-connection-process" (twittering-http-buffer) 338 server (string-to-number port))) 339 (set-process-sentinel proc sentinel) 340 (process-send-string 341 proc 342 (let ((nl "\r\n") 343 request) 344 (setq request 345 (concat "GET http://twitter.com/" method-class "/" method ".xml HTTP/1.1" nl 346 "Host: twitter.com" nl 347 "User-Agent: " (twittering-user-agent) nl 348 "Authorization: Basic " 349 (base64-encode-string 350 (concat twittering-username ":" (twittering-get-password))) 351 nl 352 "Accept: text/xml" 353 ",application/xml" 354 ",application/xhtml+xml" 355 ",application/html;q=0.9" 356 ",text/plain;q=0.8" 357 ",image/png,*/*;q=0.5" nl 358 "Accept-Charset: utf-8;q=0.7,*;q=0.7" nl 359 (when twittering-proxy-use 360 "Proxy-Connection: Keep-Alive" nl 361 (when (and proxy-user proxy-password) 362 (concat 363 "Proxy-Authorization: Basic " 364 (base64-encode-string 365 (concat proxy-user ":" 366 proxy-password)) 367 nl))) 368 nl nl)) 369 (debug-print (concat "GET Request\n" request)) 370 request))) 360 371 (error 361 372 (message "Failure: HTTP GET") nil)))) … … 363 374 (defun twittering-http-get-default-sentinel (proc stat &optional suc-msg) 364 375 (let ((header (twittering-get-response-header)) 365 (body (twittering-get-response-body))366 (status nil)367 )376 (body (twittering-get-response-body)) 377 (status nil) 378 ) 368 379 (if (string-match "HTTP/1\.[01] \\([a-z0-9 ]+\\)\r?\n" header) 369 (progn370 (setq status (match-string-no-properties 1 header))371 (case-string372 status373 (("200 OK")374 (mapcar375 #'twittering-cache-status-datum376 (reverse (twittering-xmltree-to-status377 body)))378 (twittering-render-friends-timeline)379 (message (if suc-msg suc-msg "Success: Get.")))380 (t (message status))))380 (progn 381 (setq status (match-string-no-properties 1 header)) 382 (case-string 383 status 384 (("200 OK") 385 (mapcar 386 #'twittering-cache-status-datum 387 (reverse (twittering-xmltree-to-status 388 body))) 389 (twittering-render-friends-timeline) 390 (message (if suc-msg suc-msg "Success: Get."))) 391 (t (message status)))) 381 392 (message "Failure: Bad http response."))) 382 393 ) … … 385 396 (with-current-buffer (twittering-buffer) 386 397 (let ((point (point)) 387 (end (point-max)))398 (end (point-max))) 388 399 (setq buffer-read-only nil) 389 400 (erase-buffer) 390 401 (insert 391 402 (mapconcat (lambda (status) 392 (twittering-format-status status twittering-status-format))393 twittering-friends-timeline-data394 "\n"))403 (twittering-format-status status twittering-status-format)) 404 twittering-friends-timeline-data 405 "\n")) 395 406 (if twittering-image-stack 396 (clear-image-cache))407 (clear-image-cache)) 397 408 (setq buffer-read-only t) 398 409 (debug-print (current-buffer)) … … 402 413 (defun twittering-format-status (status format-str) 403 414 (flet ((attr (key) 404 (assocref key status))405 (profile-image406 ()407 (let ((profile-image-url (attr 'user-profile-image-url))408 (icon-string "\n "))409 (if (string-match "/\\([^/?]+\\)\\(?:\\?\\|$\\)" profile-image-url)410 (let ((filename (match-string-no-properties 1 profile-image-url)))411 ;; download icons if does not exist412 (if (file-exists-p (concat twittering-tmp-dir413 "/" filename))414 t415 (add-to-list 'twittering-image-stack profile-image-url))416 417 (when (and icon-string twittering-icon-mode)418 (set-text-properties419 1 2 `(display420 (image :type ,(twittering-image-type filename)421 :file ,(concat twittering-tmp-dir422 "/"423 filename)))424 icon-string)425 icon-string)426 )))))415 (assocref key status)) 416 (profile-image 417 () 418 (let ((profile-image-url (attr 'user-profile-image-url)) 419 (icon-string "\n ")) 420 (if (string-match "/\\([^/?]+\\)\\(?:\\?\\|$\\)" profile-image-url) 421 (let ((filename (match-string-no-properties 1 profile-image-url))) 422 ;; download icons if does not exist 423 (if (file-exists-p (concat twittering-tmp-dir 424 "/" filename)) 425 t 426 (add-to-list 'twittering-image-stack profile-image-url)) 427 428 (when (and icon-string twittering-icon-mode) 429 (set-text-properties 430 1 2 `(display 431 (image :type ,(twittering-image-type filename) 432 :file ,(concat twittering-tmp-dir 433 "/" 434 filename))) 435 icon-string) 436 icon-string) 437 ))))) 427 438 (let ((cursor 0) 428 (result ())429 c430 found-at)439 (result ()) 440 c 441 found-at) 431 442 (setq cursor 0) 432 443 (setq result '()) 433 444 (while (setq found-at (string-match "%\\(C{\\([^}]+\\)}\\|[A-Za-z#@']\\)" format-str cursor)) 434 (setq c (string-to-char (match-string-no-properties 1 format-str)))435 (if (> found-at cursor)436 (list-push (substring format-str cursor found-at) result)437 "|")438 (setq cursor (match-end 1))439 440 (case c441 ((?s); %s - screen_name442 (list-push (attr 'user-screen-name) result))443 ((?S); %S - name444 (list-push (attr 'user-name) result))445 ((?i); %i - profile_image446 (list-push (profile-image) result))447 ((?d); %d - description448 (list-push (attr 'user-description) result))449 ((?l); %l - location450 (list-push (attr 'user-location) result))451 ((?L); %L - " [location]"452 (let ((location (attr 'user-location)))453 (unless (or (null location) (string= "" location))454 (list-push (concat " [" location "]") result)) ))455 ((?u); %u - url456 (list-push (attr 'user-url) result))457 ((?j); %j - user.id458 (list-push (attr 'user-id) result))459 ((?p); %p - protected?460 (let ((protected (attr 'user-protected)))461 (when (string= "true" protected)462 (list-push "[x]" result))))463 ((?c); %c - created_at (raw UTC string)464 (list-push (attr 'created-at) result))465 ((?C); %C{time-format-str} - created_at (formatted with time-format-str)466 (list-push (twittering-local-strftime467 (or (match-string-no-properties 2 format-str) "%H:%M:%S")468 (attr 'created-at))469 result))470 ((?@); %@ - X seconds ago471 (let ((created-at472 (apply473 'encode-time474 (parse-time-string (attr 'created-at))))475 (now (current-time)))476 (let ((secs (+ (* (- (car now) (car created-at)) 65536)477 (- (cadr now) (cadr created-at)))))478 (list-push (cond ((< secs 5) "less than 5 seconds ago")479 ((< secs 10) "less than 10 seconds ago")480 ((< secs 20) "less than 20 seconds ago")481 ((< secs 30) "half a minute ago")482 ((< secs 60) "less than a minute ago")483 ((< secs 150) "1 minute ago")484 ((< secs 2400) (format "%d minutes ago"485 (/ (+ secs 30) 60)))486 ((< secs 5400) "about 1 hour ago")487 ((< secs 84600) (format "about %d hours ago"488 (/ (+ secs 1800) 3600)))489 (t (format-time-string "%I:%M %p %B %d, %Y" created-at)))490 result))))491 ((?t); %t - text492 (list-push;(clickable-text)493 (attr 'text)494 result))495 ((?'); %' - truncated496 (let ((truncated (attr 'truncated)))497 (when (string= "true" truncated)498 (list-push "..." result))))499 ((?f); %f - source500 (list-push (attr 'source) result))501 ((?#); %# - id502 (list-push (attr 'id) result))503 (t504 (list-push (char-to-string c) result)))505 )445 (setq c (string-to-char (match-string-no-properties 1 format-str))) 446 (if (> found-at cursor) 447 (list-push (substring format-str cursor found-at) result) 448 "|") 449 (setq cursor (match-end 1)) 450 451 (case c 452 ((?s) ; %s - screen_name 453 (list-push (attr 'user-screen-name) result)) 454 ((?S) ; %S - name 455 (list-push (attr 'user-name) result)) 456 ((?i) ; %i - profile_image 457 (list-push (profile-image) result)) 458 ((?d) ; %d - description 459 (list-push (attr 'user-description) result)) 460 ((?l) ; %l - location 461 (list-push (attr 'user-location) result)) 462 ((?L) ; %L - " [location]" 463 (let ((location (attr 'user-location))) 464 (unless (or (null location) (string= "" location)) 465 (list-push (concat " [" location "]") result)) )) 466 ((?u) ; %u - url 467 (list-push (attr 'user-url) result)) 468 ((?j) ; %j - user.id 469 (list-push (attr 'user-id) result)) 470 ((?p) ; %p - protected? 471 (let ((protected (attr 'user-protected))) 472 (when (string= "true" protected) 473 (list-push "[x]" result)))) 474 ((?c) ; %c - created_at (raw UTC string) 475 (list-push (attr 'created-at) result)) 476 ((?C) ; %C{time-format-str} - created_at (formatted with time-format-str) 477 (list-push (twittering-local-strftime 478 (or (match-string-no-properties 2 format-str) "%H:%M:%S") 479 (attr 'created-at)) 480 result)) 481 ((?@) ; %@ - X seconds ago 482 (let ((created-at 483 (apply 484 'encode-time 485 (parse-time-string (attr 'created-at)))) 486 (now (current-time))) 487 (let ((secs (+ (* (- (car now) (car created-at)) 65536) 488 (- (cadr now) (cadr created-at))))) 489 (list-push (cond ((< secs 5) "less than 5 seconds ago") 490 ((< secs 10) "less than 10 seconds ago") 491 ((< secs 20) "less than 20 seconds ago") 492 ((< secs 30) "half a minute ago") 493 ((< secs 60) "less than a minute ago") 494 ((< secs 150) "1 minute ago") 495 ((< secs 2400) (format "%d minutes ago" 496 (/ (+ secs 30) 60))) 497 ((< secs 5400) "about 1 hour ago") 498 ((< secs 84600) (format "about %d hours ago" 499 (/ (+ secs 1800) 3600))) 500 (t (format-time-string "%I:%M %p %B %d, %Y" created-at))) 501 result)))) 502 ((?t) ; %t - text 503 (list-push ;(clickable-text) 504 (attr 'text) 505 result)) 506 ((?') ; %' - truncated 507 (let ((truncated (attr 'truncated))) 508 (when (string= "true" truncated) 509 (list-push "..." result)))) 510 ((?f) ; %f - source 511 (list-push (attr 'source) result)) 512 ((?#) ; %# - id 513 (list-push (attr 'id) result)) 514 (t 515 (list-push (char-to-string c) result))) 516 ) 506 517 (list-push (substring format-str cursor) result) 507 518 (apply 'concat (nreverse result)) … … 523 534 524 535 (let (proc server port 525 (proxy-user twittering-proxy-user)526 (proxy-password twittering-proxy-password))536 (proxy-user twittering-proxy-user) 537 (proxy-password twittering-proxy-password)) 527 538 (progn 528 539 (if (and twittering-proxy-use twittering-proxy-server) 529 (setq server twittering-proxy-server530 port (if (integerp twittering-proxy-port)531 (int-to-string twittering-proxy-port)532 twittering-proxy-port))533 (setq server "twitter.com"534 port "80"))540 (setq server twittering-proxy-server 541 port (if (integerp twittering-proxy-port) 542 (int-to-string twittering-proxy-port) 543 twittering-proxy-port)) 544 (setq server "twitter.com" 545 port "80")) 535 546 (setq proc 536 (open-network-stream537 "network-connection-process" (twittering-http-buffer)538 server (string-to-number port)))547 (open-network-stream 548 "network-connection-process" (twittering-http-buffer) 549 server (string-to-number port))) 539 550 (set-process-sentinel proc sentinel) 540 551 (process-send-string 541 552 proc 542 553 (let ((nl "\r\n") 543 request)544 (setqrequest545 (concat "POST http://twitter.com/" method-class "/" method ".xml?"546 (if parameters547 (mapconcat548 (lambda (param-pair)549 (format "%s=%s"550 (twittering-percent-encode (car param-pair))551 (twittering-percent-encode (cdr param-pair))))552 parameters553 "&"))554 " HTTP/1.1" nl555 "Host: twitter.com" nl556 "User-Agent: " (twittering-user-agent) nl557 "Authorization: Basic "558 (base64-encode-string559 (concat twittering-username ":" (twittering-get-password)))560 nl561 "Content-Type: text/plain" nl562 "Content-Length: 0" nl563 (when twittering-proxy-use564 "Proxy-Connection: Keep-Alive" nl565 (when (and proxy-user proxy-password)566 (concat567 "Proxy-Authorization: Basic "568 (base64-encode-string569 (concat proxy-user ":"570 proxy-password))571 nl)))572 nl nl))573 (debug-print (concat "POST Request\n" request))574 request)))))554 request) 555 (setq request 556 (concat "POST http://twitter.com/" method-class "/" method ".xml?" 557 (if parameters 558 (mapconcat 559 (lambda (param-pair) 560 (format "%s=%s" 561 (twittering-percent-encode (car param-pair)) 562 (twittering-percent-encode (cdr param-pair)))) 563 parameters 564 "&")) 565 " HTTP/1.1" nl 566 "Host: twitter.com" nl 567 "User-Agent: " (twittering-user-agent) nl 568 "Authorization: Basic " 569 (base64-encode-string 570 (concat twittering-username ":" (twittering-get-password))) 571 nl 572 "Content-Type: text/plain" nl 573 "Content-Length: 0" nl 574 (when twittering-proxy-use 575 "Proxy-Connection: Keep-Alive" nl 576 (when (and proxy-user proxy-password) 577 (concat 578 "Proxy-Authorization: Basic " 579 (base64-encode-string 580 (concat proxy-user ":" 581 proxy-password)) 582 nl))) 583 nl nl)) 584 (debug-print (concat "POST Request\n" request)) 585 request))))) 575 586 576 587 (defun twittering-http-post-default-sentinel (proc stat &optional suc-msg) … … 578 589 (condition-case err-signal 579 590 (let ((header (twittering-get-response-header)) 580 ; (body (twittering-get-response-body)) not used now.581 (status nil))582 (string-match "HTTP/1\.1 \\([a-z0-9 ]+\\)\r?\n" header)583 (setq status (match-string-no-properties 1 header))584 (case-string status585 (("200 OK")586 (message (if suc-msg suc-msg "Success: Post")))587 (t (message status)))588 )591 ;; (body (twittering-get-response-body)) not used now. 592 (status nil)) 593 (string-match "HTTP/1\.1 \\([a-z0-9 ]+\\)\r?\n" header) 594 (setq status (match-string-no-properties 1 header)) 595 (case-string status 596 (("200 OK") 597 (message (if suc-msg suc-msg "Success: Post"))) 598 (t (message status))) 599 ) 589 600 (error (message (prin1-to-string err-signal)))) 590 601 ) … … 611 622 (let ((content (buffer-string))) 612 623 (let ((content (buffer-string))) 613 (xml-parse-region (+ (string-match "\r?\n\r?\n" content)614 (length (match-string 0 content)))615 (point-max)))624 (xml-parse-region (+ (string-match "\r?\n\r?\n" content) 625 (length (match-string 0 content))) 626 (point-max))) 616 627 ))) 617 628 … … 623 634 (let ((id (cdr (assq 'id status-datum)))) 624 635 (if (or (null (symbol-value data-var)) 625 (not (find-if626 (lambda (item)627 (eql id (cdr (assq 'id item))))628 (symbol-value data-var))))629 (progn630 (if twittering-jojo-mode631 (twittering-update-jojo (cdr (assq 'user-screen-name status-datum))632 (cdr (assq 'text status-datum))))633 (set data-var (cons status-datum (symbol-value data-var)))634 t)636 (not (find-if 637 (lambda (item) 638 (eql id (cdr (assq 'id item)))) 639 (symbol-value data-var)))) 640 (progn 641 (if twittering-jojo-mode 642 (twittering-update-jojo (cdr (assq 'user-screen-name status-datum)) 643 (cdr (assq 'text status-datum)))) 644 (set data-var (cons status-datum (symbol-value data-var))) 645 t) 635 646 nil))) 636 647 637 648 (defun twittering-status-to-status-datum (status) 638 649 (flet ((assq-get (item seq) 639 (car (cddr (assq item seq)))))650 (car (cddr (assq item seq))))) 640 651 (let* ((status-data (cddr status)) 641 id text source created-at truncated642 (user-data (cddr (assq 'user status-data)))643 user-id user-name644 user-screen-name645 user-location646 user-description647 user-profile-image-url648 user-url649 user-protected650 regex-index)652 id text source created-at truncated 653 (user-data (cddr (assq 'user status-data))) 654 user-id user-name 655 user-screen-name 656 user-location 657 user-description 658 user-profile-image-url 659 user-url 660 user-protected 661 regex-index) 651 662 652 663 (setq id (string-to-number (assq-get 'id status-data))) 653 664 (setq text (twittering-decode-html-entities 654 (assq-get 'text status-data)))665 (assq-get 'text status-data))) 655 666 (setq source (twittering-decode-html-entities 656 (assq-get 'source status-data)))667 (assq-get 'source status-data))) 657 668 (setq created-at (assq-get 'created_at status-data)) 658 669 (setq truncated (assq-get 'truncated status-data)) 659 670 (setq user-id (string-to-number (assq-get 'id user-data))) 660 671 (setq user-name (twittering-decode-html-entities 661 (assq-get 'name user-data)))672 (assq-get 'name user-data))) 662 673 (setq user-screen-name (twittering-decode-html-entities 663 (assq-get 'screen_name user-data)))674 (assq-get 'screen_name user-data))) 664 675 (setq user-location (twittering-decode-html-entities 665 (assq-get 'location user-data)))676 (assq-get 'location user-data))) 666 677 (setq user-description (twittering-decode-html-entities 667 (assq-get 'description user-data)))678 (assq-get 'description user-data))) 668 679 (setq user-profile-image-url (assq-get 'profile_image_url user-data)) 669 680 (setq user-url (assq-get 'url user-data)) … … 672 683 ;; make username clickable 673 684 (add-text-properties 0 (length user-screen-name) 674 `(mouse-face highlight675 uri ,(concat "http://twitter.com/" user-screen-name)676 username ,user-screen-name677 face twittering-username-face)678 user-screen-name)685 `(mouse-face highlight 686 uri ,(concat "http://twitter.com/" user-screen-name) 687 username ,user-screen-name 688 face twittering-username-face) 689 user-screen-name) 679 690 680 691 ;; make URI clickable 681 692 (setq regex-index 0) 682 693 (while regex-index 683 (setq regex-index684 (string-match "@\\([_a-zA-Z0-9]+\\)\\|\\(https?://[-_.!~*'()a-zA-Z0-9;/?:@&=+$,%#]+\\)"685 text686 regex-index))687 (when regex-index688 (let* ((matched-string (match-string-no-properties 0 text))689 (screen-name (match-string-no-properties 1 text))690 (uri (match-string-no-properties 2 text)))691 (add-text-properties692 (if screen-name693 (+ 1 (match-beginning 0))694 (match-beginning 0))695 (match-end 0)696 (if screen-name697 `(mouse-face698 highlight699 face twittering-uri-face700 username ,screen-name701 uri ,(concat "http://twitter.com/" screen-name))702 `(mouse-face highlight703 face twittering-uri-face704 uri ,uri))705 text))706 (setq regex-index (match-end 0)) ))694 (setq regex-index 695 (string-match "@\\([_a-zA-Z0-9]+\\)\\|\\(https?://[-_.!~*'()a-zA-Z0-9;/?:@&=+$,%#]+\\)" 696 text 697 regex-index)) 698 (when regex-index 699 (let* ((matched-string (match-string-no-properties 0 text)) 700 (screen-name (match-string-no-properties 1 text)) 701 (uri (match-string-no-properties 2 text))) 702 (add-text-properties 703 (if screen-name 704 (+ 1 (match-beginning 0)) 705 (match-beginning 0)) 706 (match-end 0) 707 (if screen-name 708 `(mouse-face 709 highlight 710 face twittering-uri-face 711 username ,screen-name 712 uri ,(concat "http://twitter.com/" screen-name)) 713 `(mouse-face highlight 714 face twittering-uri-face 715 uri ,uri)) 716 text)) 717 (setq regex-index (match-end 0)) )) 707 718 708 719 ;; make screen-name clickable … … 710 721 0 (length user-screen-name) 711 722 `(mouse-face highlight 712 face twittering-username-face713 uri ,(concat "http://twitter.com/" user-screen-name)714 username ,user-screen-name)723 face twittering-username-face 724 uri ,(concat "http://twitter.com/" user-screen-name) 725 username ,user-screen-name) 715 726 user-screen-name) 716 727 717 728 ;; make source pretty and clickable 718 729 (if (string-match "<a href=\"\\(.*\\)\">\\(.*\\)</a>" source) 719 (let ((uri (match-string-no-properties 1 source))720 (caption (match-string-no-properties 2 source)))721 (setq source caption)722 (add-text-properties723 0 (length source)724 `(mouse-face highlight725 uri ,uri726 face twittering-uri-face727 source ,source)728 source)729 ))730 (let ((uri (match-string-no-properties 1 source)) 731 (caption (match-string-no-properties 2 source))) 732 (setq source caption) 733 (add-text-properties 734 0 (length source) 735 `(mouse-face highlight 736 uri ,uri 737 face twittering-uri-face 738 source ,source) 739 source) 740 )) 730 741 731 742 (mapcar 732 743 (lambda (sym) 733 `(,sym . ,(symbol-value sym)))744 `(,sym . ,(symbol-value sym))) 734 745 '(id text source created-at truncated 735 user-id user-name user-screen-name user-location736 user-description737 user-profile-image-url738 user-url739 user-protected)))))746 user-id user-name user-screen-name user-location 747 user-description 748 user-profile-image-url 749 user-url 750 user-protected))))) 740 751 741 752 (defun twittering-xmltree-to-status (xmltree) 742 753 (mapcar #'twittering-status-to-status-datum 743 ;; quirk to treat difference between xml.el in Emacs21 and Emacs22744 ;; On Emacs22, there may be blank strings745 (let ((ret nil) (statuses (reverse (cddr (car xmltree)))))746 (while statuses747 (if (consp (car statuses))748 (setq ret (cons (car statuses) ret)))749 (setq statuses (cdr statuses)))750 ret)))754 ;; quirk to treat difference between xml.el in Emacs21 and Emacs22 755 ;; On Emacs22, there may be blank strings 756 (let ((ret nil) (statuses (reverse (cddr (car xmltree))))) 757 (while statuses 758 (if (consp (car statuses)) 759 (setq ret (cons (car statuses) ret))) 760 (setq statuses (cdr statuses))) 761 ret))) 751 762 752 763 (defun twittering-percent-encode (str &optional coding-system) 753 764 (if (or (null coding-system) 754 (not (coding-system-p coding-system)))765 (not (coding-system-p coding-system))) 755 766 (setq coding-system 'utf-8)) 756 767 (mapconcat … … 775 786 (if encoded-str 776 787 (let ((cursor 0) 777 (found-at nil)778 (result '()))779 (while (setq found-at780 (string-match "&\\(#\\([0-9]+\\)\\|\\([A-Za-z]+\\)\\);"781 encoded-str cursor))782 (when (> found-at cursor)783 (list-push (substring encoded-str cursor found-at) result))784 (let ((number-entity (match-string-no-properties 2 encoded-str))785 (letter-entity (match-string-no-properties 3 encoded-str)))786 (cond (number-entity787 (list-push788 (char-to-string789 (twittering-ucs-to-char790 (string-to-number number-entity))) result))791 (letter-entity792 (cond ((string= "gt" letter-entity) (list-push ">" result))793 ((string= "lt" letter-entity) (list-push "<" result))794 (t (list-push "?" result))))795 (t (list-push "?" result)))796 (setq cursor (match-end 0))))797 (list-push (substring encoded-str cursor) result)798 (apply 'concat (nreverse result)))788 (found-at nil) 789 (result '())) 790 (while (setq found-at 791 (string-match "&\\(#\\([0-9]+\\)\\|\\([A-Za-z]+\\)\\);" 792 encoded-str cursor)) 793 (when (> found-at cursor) 794 (list-push (substring encoded-str cursor found-at) result)) 795 (let ((number-entity (match-string-no-properties 2 encoded-str)) 796 (letter-entity (match-string-no-properties 3 encoded-str))) 797 (cond (number-entity 798 (list-push 799 (char-to-string 800 (twittering-ucs-to-char 801 (string-to-number number-entity))) result)) 802 (letter-entity 803 (cond ((string= "gt" letter-entity) (list-push ">" result)) 804 ((string= "lt" letter-entity) (list-push "<" result)) 805 (t (list-push "?" result)))) 806 (t (list-push "?" result))) 807 (setq cursor (match-end 0)))) 808 (list-push (substring encoded-str cursor) result) 809 (apply 'concat (nreverse result))) 799 810 "")) 800 811 … … 802 813 (let ((buf (get-buffer twittering-buffer))) 803 814 (if (null buf) 804 (twittering-stop)815 (twittering-stop) 805 816 (funcall func) 806 817 ))) … … 810 821 nil 811 822 (twittering-http-post "statuses" "update" 812 `(("status" . ,status)813 ("source" . "twmode")))823 `(("status" . ,status) 824 ("source" . "twmode"))) 814 825 t)) 815 826 … … 820 831 (setq status (read-from-minibuffer "status: " status nil nil nil nil t)) 821 832 (setq not-posted-p 822 (not (twittering-update-status-if-not-blank status))))))833 (not (twittering-update-status-if-not-blank status)))))) 823 834 824 835 (defun twittering-update-lambda () … … 831 842 (defun twittering-update-jojo (usr msg) 832 843 (if (string-match "\xde21\xd24b\\(\xd22a\xe0b0\\|\xdaae\xe6cd\\)\xd24f\xd0d6\\([^\xd0d7]+\\)\xd0d7\xd248\xdc40\xd226" 833 msg)844 msg) 834 845 (twittering-http-post 835 846 "statuses" "update" 836 847 `(("status" . ,(concat 837 "@" usr " "838 (match-string-no-properties 2 msg)839 "\xd0a1\xd24f\xd243!?"))840 ("source" . "twmode")))))848 "@" usr " " 849 (match-string-no-properties 2 msg) 850 "\xd0a1\xd24f\xd243!?")) 851 ("source" . "twmode"))))) 841 852 842 853 ;;; … … 851 862 nil 852 863 (setq twittering-timer 853 (run-at-time "0 sec"854 twittering-timer-interval855 #'twittering-timer-action action))))864 (run-at-time "0 sec" 865 twittering-timer-interval 866 #'twittering-timer-action action)))) 856 867 857 868 (defun twittering-stop () … … 864 875 (let ((buf (get-buffer twittering-buffer))) 865 876 (if (not buf) 866 (twittering-stop)877 (twittering-stop) 867 878 (twittering-http-get "statuses" "friends_timeline") 868 879 )) … … 870 881 (if twittering-icon-mode 871 882 (if twittering-image-stack 872 (let ((proc873 (apply874 #'start-process875 "wget-images"876 (twittering-wget-buffer)877 "wget"878 (format "--directory-prefix=%s" twittering-tmp-dir)879 "--no-clobber"880 "--quiet"881 twittering-image-stack)))882 (set-process-sentinel883 proc884 (lambda (proc stat)885 (clear-image-cache)886 (save-excursion887 (set-buffer (twittering-wget-buffer))888 )))))))883 (let ((proc 884 (apply 885 #'start-process 886 "wget-images" 887 (twittering-wget-buffer) 888 "wget" 889 (format "--directory-prefix=%s" twittering-tmp-dir) 890 "--no-clobber" 891 "--quiet" 892 twittering-image-stack))) 893 (set-process-sentinel 894 proc 895 (lambda (proc stat) 896 (clear-image-cache) 897 (save-excursion 898 (set-buffer (twittering-wget-buffer)) 899 ))))))) 889 900 890 901 (defun twittering-update-status-interactive () … … 901 912 (let ((uri (get-text-property (point) 'uri))) 902 913 (if uri 903 (browse-url uri))))914 (browse-url uri)))) 904 915 905 916 (defun twittering-enter () 906 917 (interactive) 907 918 (let ((username (get-text-property (point) 'username)) 908 (uri (get-text-property (point) 'uri)))919 (uri (get-text-property (point) 'uri))) 909 920 (if username 910 (twittering-update-status-from-minibuffer (concat "@" username " "))921 (twittering-update-status-from-minibuffer (concat "@" username " ")) 911 922 (if uri 912 (browse-url uri)))))923 (browse-url uri))))) 913 924 914 925 (defun twittering-view-user-page () … … 916 927 (let ((uri (get-text-property (point) 'uri))) 917 928 (if uri 918 (browse-url uri))))929 (browse-url uri)))) 919 930 920 931 (defun twittering-reply-to-user () … … 922 933 (let ((username (get-text-property (point) 'username))) 923 934 (if username 924 (twittering-update-status-from-minibuffer (concat "@" username " ")))))935 (twittering-update-status-from-minibuffer (concat "@" username " "))))) 925 936 926 937 (defun twittering-get-password () … … 928 939 (setq twittering-password (read-passwd "twittering-mode: ")))) 929 940 941 (defun twittering-next-message () 942 "Go to next message." 943 (interactive) 944 (let ((pos)) 945 (setq pos (twittering-next-username-face-pos (point))) 946 (when pos 947 (goto-char pos)))) 948 949 (defun twittering-next-username-face-pos (pos) 950 (interactive) 951 (let ((prop)) 952 (while (not (eq prop twittering-username-face)) 953 (setq pos (next-single-property-change pos 'face)) 954 (setq prop (get-text-property pos 'face))) 955 pos)) 956 957 (defun twittering-previous-message () 958 "Go to previous message." 959 (interactive) 960 (let ((pos)) 961 (setq pos (twittering-previous-username-face-pos (point))) 962 (when pos 963 (goto-char pos)))) 964 965 (defun twittering-previous-username-face-pos (pos) 966 (interactive) 967 (let ((prop)) 968 (while (not (eq prop twittering-username-face)) 969 (setq pos (previous-single-property-change pos 'face)) 970 (setq prop (get-text-property pos 'face))) 971 pos)) 972 930 973 (provide 'twittering-mode) 931 974 ;;; twittering.el ends here
