Changeset 34 for lang/elisp/twittering-mode
- Timestamp:
- 04/27/08 06:36:40 (18 years ago)
- Files:
-
- 1 modified
Legend:
- Unmodified
- Added
- Removed
-
lang/elisp/twittering-mode/branches/tsuyoshi/twittering-mode.el
r33 r34 52 52 (interactive) 53 53 (let ((version-string 54 (format "twittering-mode-v%s" twittering-mode-version)))54 (format "twittering-mode-v%s" twittering-mode-version))) 55 55 (if (interactive-p) 56 (message "%s" version-string)56 (message "%s" version-string) 57 57 version-string))) 58 58 … … 108 108 (if (bufferp buffer) 109 109 (if (buffer-live-p buffer) 110 buffer111 (generate-new-buffer (buffer-name buffer)))110 buffer 111 (generate-new-buffer (buffer-name buffer))) 112 112 (if (stringp buffer) 113 (or (get-buffer buffer)114 (generate-new-buffer buffer)))))113 (or (get-buffer buffer) 114 (generate-new-buffer buffer))))) 115 115 116 116 (defun assocref (item alist) … … 129 129 (interactive) 130 130 (setq twittering-proxy-use 131 (not twittering-proxy-use))131 (not twittering-proxy-use)) 132 132 (message "%s %s" 133 "Use Proxy:"134 (if twittering-proxy-use135 "on" "off")))133 "Use Proxy:" 134 (if twittering-proxy-use 135 "on" "off"))) 136 136 137 137 (defun twittering-user-agent-default-function () 138 138 "Twittering mode default User-Agent function." 139 139 (concat "Emacs/" 140 (int-to-string emacs-major-version) "." (int-to-string141 emacs-minor-version)142 " "143 "Twittering-mode/"144 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)) 145 145 146 146 (defvar twittering-user-agent-function 'twittering-user-agent-default-function) … … 158 158 (defvar twittering-tmp-dir 159 159 (expand-file-name (concat "twmode-images-" (user-login-name)) 160 temporary-file-directory))160 temporary-file-directory)) 161 161 162 162 (defvar twittering-icon-mode nil "You MUST NOT CHANGE this variable directory. You should change through function'twittering-icon-mode'") … … 164 164 (interactive) 165 165 (setq twittering-icon-mode 166 (if twittering-icon-mode167 (if (null arg)168 nil169 (> (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 (progn174 (if (not (file-directory-p twittering-tmp-dir))175 (make-directory twittering-tmp-dir))176 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))))) 177 177 (twittering-render-friends-timeline)) 178 178 … … 180 180 (interactive) 181 181 (setq twittering-scroll-mode 182 (if (null arg)183 (not twittering-scroll-mode)184 (> (prefix-numeric-value arg) 0))))182 (if (null arg) 183 (not twittering-scroll-mode) 184 (> (prefix-numeric-value arg) 0)))) 185 185 186 186 (defun twittering-jojo-mode (&optional arg) 187 187 (interactive) 188 188 (setq twittering-jojo-mode 189 (if (null arg)190 (not twittering-jojo-mode)191 (> (prefix-numeric-value arg) 0))))189 (if (null arg) 190 (not twittering-jojo-mode) 191 (> (prefix-numeric-value arg) 0)))) 192 192 193 193 (defvar twittering-image-stack nil) … … 202 202 (defun twittering-local-strftime (fmt string) 203 203 (format-time-string fmt ; like "%Y-%m-%d %H:%M:%S", shown in localtime 204 (apply 'encode-time (parse-time-string string))))204 (apply 'encode-time (parse-time-string string)))) 205 205 206 206 (defvar twittering-debug-mode nil) … … 212 212 `(let ((,obsym ,obj)) 213 213 (if twittering-debug-mode 214 (with-current-buffer (twittering-debug-buffer)215 (insert (prin1-to-string ,obsym))216 (newline)217 ,obsym)218 ,obsym))))214 (with-current-buffer (twittering-debug-buffer) 215 (insert (prin1-to-string ,obsym)) 216 (newline) 217 ,obsym) 218 ,obsym)))) 219 219 220 220 (defun twittering-debug-mode () 221 221 (interactive) 222 222 (setq twittering-debug-mode 223 (not twittering-debug-mode))223 (not twittering-debug-mode)) 224 224 (message (if twittering-debug-mode "debug mode:on" "debug mode:off"))) 225 225 … … 247 247 (define-key km "G" 'end-of-buffer) 248 248 (define-key km "H" 'beginning-of-buffer) 249 (define-key km "i" 'twittering-icon-mode) 250 (define-key km "s" 'twittering-scroll-mode) 251 (define-key km "t" 'twittering-toggle-proxy) 249 252 (define-key km "\C-c\C-p" 'twittering-toggle-proxy) 250 253 nil)) … … 279 282 ,@(mapcar 280 283 (lambda (clause) 281 (let ((keylist (car clause))282 (body (cdr clause)))283 `(,(if (listp keylist)284 `(or ,@(mapcar (lambda (key) `(string-equal ,str ,key)) keylist))285 't)286 ,@body)))284 (let ((keylist (car clause)) 285 (body (cdr clause))) 286 `(,(if (listp keylist) 287 `(or ,@(mapcar (lambda (key) `(string-equal ,str ,key)) keylist)) 288 't) 289 ,@body))) 287 290 clauses))) 288 291 … … 324 327 325 328 (let (proc server port 326 (proxy-user twittering-proxy-user)327 (proxy-password twittering-proxy-password))329 (proxy-user twittering-proxy-user) 330 (proxy-password twittering-proxy-password)) 328 331 (condition-case nil 329 (progn330 (if (and twittering-proxy-use twittering-proxy-server)331 (setq server twittering-proxy-server332 port (if (integerp twittering-proxy-port)333 (int-to-string twittering-proxy-port)334 twittering-proxy-port))335 (setq server "twitter.com"336 port "80"))337 (setq proc338 (open-network-stream339 "network-connection-process" (twittering-http-buffer)340 server (string-to-number port)))341 (set-process-sentinel proc sentinel)342 (process-send-string343 proc344 (let ((nl "\r\n")345 request)346 (setq request347 (concat "GET http://twitter.com/" method-class "/" method ".xml HTTP/1.1" nl348 "Host: twitter.com" nl349 "User-Agent: " (twittering-user-agent) nl350 "Authorization: Basic "351 (base64-encode-string352 (concat twittering-username ":" (twittering-get-password)))353 nl354 "Accept: text/xml"355 ",application/xml"356 ",application/xhtml+xml"357 ",application/html;q=0.9"358 ",text/plain;q=0.8"359 ",image/png,*/*;q=0.5" nl360 "Accept-Charset: utf-8;q=0.7,*;q=0.7" nl361 (when twittering-proxy-use362 "Proxy-Connection: Keep-Alive" nl363 (when (and proxy-user proxy-password)364 (concat365 "Proxy-Authorization: Basic "366 (base64-encode-string367 (concat proxy-user ":"368 proxy-password))369 nl)))370 nl nl))371 (debug-print (concat "GET Request\n" request))372 request)))332 (progn 333 (if (and twittering-proxy-use twittering-proxy-server) 334 (setq server twittering-proxy-server 335 port (if (integerp twittering-proxy-port) 336 (int-to-string twittering-proxy-port) 337 twittering-proxy-port)) 338 (setq server "twitter.com" 339 port "80")) 340 (setq proc 341 (open-network-stream 342 "network-connection-process" (twittering-http-buffer) 343 server (string-to-number port))) 344 (set-process-sentinel proc sentinel) 345 (process-send-string 346 proc 347 (let ((nl "\r\n") 348 request) 349 (setq request 350 (concat "GET http://twitter.com/" method-class "/" method ".xml HTTP/1.1" nl 351 "Host: twitter.com" nl 352 "User-Agent: " (twittering-user-agent) nl 353 "Authorization: Basic " 354 (base64-encode-string 355 (concat twittering-username ":" (twittering-get-password))) 356 nl 357 "Accept: text/xml" 358 ",application/xml" 359 ",application/xhtml+xml" 360 ",application/html;q=0.9" 361 ",text/plain;q=0.8" 362 ",image/png,*/*;q=0.5" nl 363 "Accept-Charset: utf-8;q=0.7,*;q=0.7" nl 364 (when twittering-proxy-use 365 "Proxy-Connection: Keep-Alive" nl 366 (when (and proxy-user proxy-password) 367 (concat 368 "Proxy-Authorization: Basic " 369 (base64-encode-string 370 (concat proxy-user ":" 371 proxy-password)) 372 nl))) 373 nl nl)) 374 (debug-print (concat "GET Request\n" request)) 375 request))) 373 376 (error 374 377 (message "Failure: HTTP GET") nil)))) … … 376 379 (defun twittering-http-get-default-sentinel (proc stat &optional suc-msg) 377 380 (let ((header (twittering-get-response-header)) 378 (body (twittering-get-response-body))379 (status nil)380 )381 (body (twittering-get-response-body)) 382 (status nil) 383 ) 381 384 (if (string-match "HTTP/1\.[01] \\([a-z0-9 ]+\\)\r?\n" header) 382 (progn383 (setq status (match-string-no-properties 1 header))384 (case-string385 status386 (("200 OK")387 (mapcar388 #'twittering-cache-status-datum389 (reverse (twittering-xmltree-to-status390 body)))391 (twittering-render-friends-timeline)392 (message (if suc-msg suc-msg "Success: Get.")))393 (t (message status))))385 (progn 386 (setq status (match-string-no-properties 1 header)) 387 (case-string 388 status 389 (("200 OK") 390 (mapcar 391 #'twittering-cache-status-datum 392 (reverse (twittering-xmltree-to-status 393 body))) 394 (twittering-render-friends-timeline) 395 (message (if suc-msg suc-msg "Success: Get."))) 396 (t (message status)))) 394 397 (message "Failure: Bad http response."))) 395 398 ) … … 398 401 (with-current-buffer (twittering-buffer) 399 402 (let ((point (point)) 400 (end (point-max)))403 (end (point-max))) 401 404 (setq buffer-read-only nil) 402 405 (erase-buffer) 403 406 (insert 404 407 (mapconcat (lambda (status) 405 (twittering-format-status status twittering-status-format))406 twittering-friends-timeline-data407 "\n"))408 (twittering-format-status status twittering-status-format)) 409 twittering-friends-timeline-data 410 "\n")) 408 411 (if twittering-image-stack 409 (clear-image-cache))412 (clear-image-cache)) 410 413 (setq buffer-read-only t) 411 414 (debug-print (current-buffer)) … … 415 418 (defun twittering-format-status (status format-str) 416 419 (flet ((attr (key) 417 (assocref key status))418 (profile-image419 ()420 (let ((profile-image-url (attr 'user-profile-image-url))421 (icon-string "\n "))422 (if (string-match "/\\([^/?]+\\)\\(?:\\?\\|$\\)" profile-image-url)423 (let ((filename (match-string-no-properties 1 profile-image-url)))424 ;; download icons if does not exist425 (if (file-exists-p (concat twittering-tmp-dir426 "/" filename))427 t428 (add-to-list 'twittering-image-stack profile-image-url))429 430 (when (and icon-string twittering-icon-mode)431 (set-text-properties432 1 2 `(display433 (image :type ,(twittering-image-type filename)434 :file ,(concat twittering-tmp-dir435 "/"436 filename)))437 icon-string)438 icon-string)439 )))))420 (assocref key status)) 421 (profile-image 422 () 423 (let ((profile-image-url (attr 'user-profile-image-url)) 424 (icon-string "\n ")) 425 (if (string-match "/\\([^/?]+\\)\\(?:\\?\\|$\\)" profile-image-url) 426 (let ((filename (match-string-no-properties 1 profile-image-url))) 427 ;; download icons if does not exist 428 (if (file-exists-p (concat twittering-tmp-dir 429 "/" filename)) 430 t 431 (add-to-list 'twittering-image-stack profile-image-url)) 432 433 (when (and icon-string twittering-icon-mode) 434 (set-text-properties 435 1 2 `(display 436 (image :type ,(twittering-image-type filename) 437 :file ,(concat twittering-tmp-dir 438 "/" 439 filename))) 440 icon-string) 441 icon-string) 442 ))))) 440 443 (let ((cursor 0) 441 (result ())442 c443 found-at)444 (result ()) 445 c 446 found-at) 444 447 (setq cursor 0) 445 448 (setq result '()) 446 449 (while (setq found-at (string-match "%\\(C{\\([^}]+\\)}\\|[A-Za-z#@']\\)" format-str cursor)) 447 (setq c (string-to-char (match-string-no-properties 1 format-str)))448 (if (> found-at cursor)449 (list-push (substring format-str cursor found-at) result)450 "|")451 (setq cursor (match-end 1))452 453 (case c454 ((?s) ; %s - screen_name455 (list-push (attr 'user-screen-name) result))456 ((?S) ; %S - name457 (list-push (attr 'user-name) result))458 ((?i) ; %i - profile_image459 (list-push (profile-image) result))460 ((?d) ; %d - description461 (list-push (attr 'user-description) result))462 ((?l) ; %l - location463 (list-push (attr 'user-location) result))464 ((?L) ; %L - " [location]"465 (let ((location (attr 'user-location)))466 (unless (or (null location) (string= "" location))467 (list-push (concat " [" location "]") result)) ))468 ((?u) ; %u - url469 (list-push (attr 'user-url) result))470 ((?j) ; %j - user.id471 (list-push (attr 'user-id) result))472 ((?p) ; %p - protected?473 (let ((protected (attr 'user-protected)))474 (when (string= "true" protected)475 (list-push "[x]" result))))476 ((?c) ; %c - created_at (raw UTC string)477 (list-push (attr 'created-at) result))478 ((?C) ; %C{time-format-str} - created_at (formatted with time-format-str)479 (list-push (twittering-local-strftime480 (or (match-string-no-properties 2 format-str) "%H:%M:%S")481 (attr 'created-at))482 result))483 ((?@) ; %@ - X seconds ago484 (let ((created-at485 (apply486 'encode-time487 (parse-time-string (attr 'created-at))))488 (now (current-time)))489 (let ((secs (+ (* (- (car now) (car created-at)) 65536)490 (- (cadr now) (cadr created-at)))))491 (list-push (cond ((< secs 5) "less than 5 seconds ago")492 ((< secs 10) "less than 10 seconds ago")493 ((< secs 20) "less than 20 seconds ago")494 ((< secs 30) "half a minute ago")495 ((< secs 60) "less than a minute ago")496 ((< secs 150) "1 minute ago")497 ((< secs 2400) (format "%d minutes ago"498 (/ (+ secs 30) 60)))499 ((< secs 5400) "about 1 hour ago")500 ((< secs 84600) (format "about %d hours ago"501 (/ (+ secs 1800) 3600)))502 (t (format-time-string "%I:%M %p %B %d, %Y" created-at)))503 result))))504 ((?t) ; %t - text505 (list-push ;(clickable-text)506 (attr 'text)507 result))508 ((?') ; %' - truncated509 (let ((truncated (attr 'truncated)))510 (when (string= "true" truncated)511 (list-push "..." result))))512 ((?f) ; %f - source513 (list-push (attr 'source) result))514 ((?#) ; %# - id515 (list-push (attr 'id) result))516 (t517 (list-push (char-to-string c) result)))518 )450 (setq c (string-to-char (match-string-no-properties 1 format-str))) 451 (if (> found-at cursor) 452 (list-push (substring format-str cursor found-at) result) 453 "|") 454 (setq cursor (match-end 1)) 455 456 (case c 457 ((?s) ; %s - screen_name 458 (list-push (attr 'user-screen-name) result)) 459 ((?S) ; %S - name 460 (list-push (attr 'user-name) result)) 461 ((?i) ; %i - profile_image 462 (list-push (profile-image) result)) 463 ((?d) ; %d - description 464 (list-push (attr 'user-description) result)) 465 ((?l) ; %l - location 466 (list-push (attr 'user-location) result)) 467 ((?L) ; %L - " [location]" 468 (let ((location (attr 'user-location))) 469 (unless (or (null location) (string= "" location)) 470 (list-push (concat " [" location "]") result)) )) 471 ((?u) ; %u - url 472 (list-push (attr 'user-url) result)) 473 ((?j) ; %j - user.id 474 (list-push (attr 'user-id) result)) 475 ((?p) ; %p - protected? 476 (let ((protected (attr 'user-protected))) 477 (when (string= "true" protected) 478 (list-push "[x]" result)))) 479 ((?c) ; %c - created_at (raw UTC string) 480 (list-push (attr 'created-at) result)) 481 ((?C) ; %C{time-format-str} - created_at (formatted with time-format-str) 482 (list-push (twittering-local-strftime 483 (or (match-string-no-properties 2 format-str) "%H:%M:%S") 484 (attr 'created-at)) 485 result)) 486 ((?@) ; %@ - X seconds ago 487 (let ((created-at 488 (apply 489 'encode-time 490 (parse-time-string (attr 'created-at)))) 491 (now (current-time))) 492 (let ((secs (+ (* (- (car now) (car created-at)) 65536) 493 (- (cadr now) (cadr created-at))))) 494 (list-push (cond ((< secs 5) "less than 5 seconds ago") 495 ((< secs 10) "less than 10 seconds ago") 496 ((< secs 20) "less than 20 seconds ago") 497 ((< secs 30) "half a minute ago") 498 ((< secs 60) "less than a minute ago") 499 ((< secs 150) "1 minute ago") 500 ((< secs 2400) (format "%d minutes ago" 501 (/ (+ secs 30) 60))) 502 ((< secs 5400) "about 1 hour ago") 503 ((< secs 84600) (format "about %d hours ago" 504 (/ (+ secs 1800) 3600))) 505 (t (format-time-string "%I:%M %p %B %d, %Y" created-at))) 506 result)))) 507 ((?t) ; %t - text 508 (list-push ;(clickable-text) 509 (attr 'text) 510 result)) 511 ((?') ; %' - truncated 512 (let ((truncated (attr 'truncated))) 513 (when (string= "true" truncated) 514 (list-push "..." result)))) 515 ((?f) ; %f - source 516 (list-push (attr 'source) result)) 517 ((?#) ; %# - id 518 (list-push (attr 'id) result)) 519 (t 520 (list-push (char-to-string c) result))) 521 ) 519 522 (list-push (substring format-str cursor) result) 520 523 (apply 'concat (nreverse result)) … … 536 539 537 540 (let (proc server port 538 (proxy-user twittering-proxy-user)539 (proxy-password twittering-proxy-password))541 (proxy-user twittering-proxy-user) 542 (proxy-password twittering-proxy-password)) 540 543 (progn 541 544 (if (and twittering-proxy-use twittering-proxy-server) 542 (setq server twittering-proxy-server543 port (if (integerp twittering-proxy-port)544 (int-to-string twittering-proxy-port)545 twittering-proxy-port))546 (setq server "twitter.com"547 port "80"))545 (setq server twittering-proxy-server 546 port (if (integerp twittering-proxy-port) 547 (int-to-string twittering-proxy-port) 548 twittering-proxy-port)) 549 (setq server "twitter.com" 550 port "80")) 548 551 (setq proc 549 (open-network-stream550 "network-connection-process" (twittering-http-buffer)551 server (string-to-number port)))552 (open-network-stream 553 "network-connection-process" (twittering-http-buffer) 554 server (string-to-number port))) 552 555 (set-process-sentinel proc sentinel) 553 556 (process-send-string 554 557 proc 555 558 (let ((nl "\r\n") 556 request)557 (setq request558 (concat "POST http://twitter.com/" method-class "/" method ".xml?"559 (if parameters560 (mapconcat561 (lambda (param-pair)562 (format "%s=%s"563 (twittering-percent-encode (car param-pair))564 (twittering-percent-encode (cdr param-pair))))565 parameters566 "&"))567 " HTTP/1.1" nl568 "Host: twitter.com" nl569 "User-Agent: " (twittering-user-agent) nl570 "Authorization: Basic "571 (base64-encode-string572 (concat twittering-username ":" (twittering-get-password)))573 nl574 "Content-Type: text/plain" nl575 "Content-Length: 0" nl576 (when twittering-proxy-use577 "Proxy-Connection: Keep-Alive" nl578 (when (and proxy-user proxy-password)579 (concat580 "Proxy-Authorization: Basic "581 (base64-encode-string582 (concat proxy-user ":"583 proxy-password))584 nl)))585 nl nl))586 (debug-print (concat "POST Request\n" request))587 request)))))559 request) 560 (setq request 561 (concat "POST http://twitter.com/" method-class "/" method ".xml?" 562 (if parameters 563 (mapconcat 564 (lambda (param-pair) 565 (format "%s=%s" 566 (twittering-percent-encode (car param-pair)) 567 (twittering-percent-encode (cdr param-pair)))) 568 parameters 569 "&")) 570 " HTTP/1.1" nl 571 "Host: twitter.com" nl 572 "User-Agent: " (twittering-user-agent) nl 573 "Authorization: Basic " 574 (base64-encode-string 575 (concat twittering-username ":" (twittering-get-password))) 576 nl 577 "Content-Type: text/plain" nl 578 "Content-Length: 0" nl 579 (when twittering-proxy-use 580 "Proxy-Connection: Keep-Alive" nl 581 (when (and proxy-user proxy-password) 582 (concat 583 "Proxy-Authorization: Basic " 584 (base64-encode-string 585 (concat proxy-user ":" 586 proxy-password)) 587 nl))) 588 nl nl)) 589 (debug-print (concat "POST Request\n" request)) 590 request))))) 588 591 589 592 (defun twittering-http-post-default-sentinel (proc stat &optional suc-msg) … … 591 594 (condition-case err-signal 592 595 (let ((header (twittering-get-response-header)) 593 ;; (body (twittering-get-response-body)) not used now.594 (status nil))595 (string-match "HTTP/1\.1 \\([a-z0-9 ]+\\)\r?\n" header)596 (setq status (match-string-no-properties 1 header))597 (case-string status598 (("200 OK")599 (message (if suc-msg suc-msg "Success: Post")))600 (t (message status)))601 )596 ;; (body (twittering-get-response-body)) not used now. 597 (status nil)) 598 (string-match "HTTP/1\.1 \\([a-z0-9 ]+\\)\r?\n" header) 599 (setq status (match-string-no-properties 1 header)) 600 (case-string status 601 (("200 OK") 602 (message (if suc-msg suc-msg "Success: Post"))) 603 (t (message status))) 604 ) 602 605 (error (message (prin1-to-string err-signal)))) 603 606 ) … … 624 627 (let ((content (buffer-string))) 625 628 (let ((content (buffer-string))) 626 (xml-parse-region (+ (string-match "\r?\n\r?\n" content)627 (length (match-string 0 content)))628 (point-max)))629 (xml-parse-region (+ (string-match "\r?\n\r?\n" content) 630 (length (match-string 0 content))) 631 (point-max))) 629 632 ))) 630 633 … … 636 639 (let ((id (cdr (assq 'id status-datum)))) 637 640 (if (or (null (symbol-value data-var)) 638 (not (find-if639 (lambda (item)640 (eql id (cdr (assq 'id item))))641 (symbol-value data-var))))642 (progn643 (if twittering-jojo-mode644 (twittering-update-jojo (cdr (assq 'user-screen-name status-datum))645 (cdr (assq 'text status-datum))))646 (set data-var (cons status-datum (symbol-value data-var)))647 t)641 (not (find-if 642 (lambda (item) 643 (eql id (cdr (assq 'id item)))) 644 (symbol-value data-var)))) 645 (progn 646 (if twittering-jojo-mode 647 (twittering-update-jojo (cdr (assq 'user-screen-name status-datum)) 648 (cdr (assq 'text status-datum)))) 649 (set data-var (cons status-datum (symbol-value data-var))) 650 t) 648 651 nil))) 649 652 650 653 (defun twittering-status-to-status-datum (status) 651 654 (flet ((assq-get (item seq) 652 (car (cddr (assq item seq)))))655 (car (cddr (assq item seq))))) 653 656 (let* ((status-data (cddr status)) 654 id text source created-at truncated655 (user-data (cddr (assq 'user status-data)))656 user-id user-name657 user-screen-name658 user-location659 user-description660 user-profile-image-url661 user-url662 user-protected663 regex-index)657 id text source created-at truncated 658 (user-data (cddr (assq 'user status-data))) 659 user-id user-name 660 user-screen-name 661 user-location 662 user-description 663 user-profile-image-url 664 user-url 665 user-protected 666 regex-index) 664 667 665 668 (setq id (string-to-number (assq-get 'id status-data))) 666 669 (setq text (twittering-decode-html-entities 667 (assq-get 'text status-data)))670 (assq-get 'text status-data))) 668 671 (setq source (twittering-decode-html-entities 669 (assq-get 'source status-data)))672 (assq-get 'source status-data))) 670 673 (setq created-at (assq-get 'created_at status-data)) 671 674 (setq truncated (assq-get 'truncated status-data)) 672 675 (setq user-id (string-to-number (assq-get 'id user-data))) 673 676 (setq user-name (twittering-decode-html-entities 674 (assq-get 'name user-data)))677 (assq-get 'name user-data))) 675 678 (setq user-screen-name (twittering-decode-html-entities 676 (assq-get 'screen_name user-data)))679 (assq-get 'screen_name user-data))) 677 680 (setq user-location (twittering-decode-html-entities 678 (assq-get 'location user-data)))681 (assq-get 'location user-data))) 679 682 (setq user-description (twittering-decode-html-entities 680 (assq-get 'description user-data)))683 (assq-get 'description user-data))) 681 684 (setq user-profile-image-url (assq-get 'profile_image_url user-data)) 682 685 (setq user-url (assq-get 'url user-data)) … … 685 688 ;; make username clickable 686 689 (add-text-properties 0 (length user-screen-name) 687 `(mouse-face highlight688 uri ,(concat "http://twitter.com/" user-screen-name)689 username ,user-screen-name690 face twittering-username-face)691 user-screen-name)690 `(mouse-face highlight 691 uri ,(concat "http://twitter.com/" user-screen-name) 692 username ,user-screen-name 693 face twittering-username-face) 694 user-screen-name) 692 695 693 696 ;; make URI clickable 694 697 (setq regex-index 0) 695 698 (while regex-index 696 (setq regex-index697 (string-match "@\\([_a-zA-Z0-9]+\\)\\|\\(https?://[-_.!~*'()a-zA-Z0-9;/?:@&=+$,%#]+\\)"698 text699 regex-index))700 (when regex-index701 (let* ((matched-string (match-string-no-properties 0 text))702 (screen-name (match-string-no-properties 1 text))703 (uri (match-string-no-properties 2 text)))704 (add-text-properties705 (if screen-name706 (+ 1 (match-beginning 0))707 (match-beginning 0))708 (match-end 0)709 (if screen-name710 `(mouse-face711 highlight712 face twittering-uri-face713 username ,screen-name714 uri ,(concat "http://twitter.com/" screen-name))715 `(mouse-face highlight716 face twittering-uri-face717 uri ,uri))718 text))719 (setq regex-index (match-end 0)) ))699 (setq regex-index 700 (string-match "@\\([_a-zA-Z0-9]+\\)\\|\\(https?://[-_.!~*'()a-zA-Z0-9;/?:@&=+$,%#]+\\)" 701 text 702 regex-index)) 703 (when regex-index 704 (let* ((matched-string (match-string-no-properties 0 text)) 705 (screen-name (match-string-no-properties 1 text)) 706 (uri (match-string-no-properties 2 text))) 707 (add-text-properties 708 (if screen-name 709 (+ 1 (match-beginning 0)) 710 (match-beginning 0)) 711 (match-end 0) 712 (if screen-name 713 `(mouse-face 714 highlight 715 face twittering-uri-face 716 username ,screen-name 717 uri ,(concat "http://twitter.com/" screen-name)) 718 `(mouse-face highlight 719 face twittering-uri-face 720 uri ,uri)) 721 text)) 722 (setq regex-index (match-end 0)) )) 720 723 721 724 ;; make screen-name clickable … … 723 726 0 (length user-screen-name) 724 727 `(mouse-face highlight 725 face twittering-username-face726 uri ,(concat "http://twitter.com/" user-screen-name)727 username ,user-screen-name)728 face twittering-username-face 729 uri ,(concat "http://twitter.com/" user-screen-name) 730 username ,user-screen-name) 728 731 user-screen-name) 729 732 730 733 ;; make source pretty and clickable 731 734 (if (string-match "<a href=\"\\(.*\\)\">\\(.*\\)</a>" source) 732 (let ((uri (match-string-no-properties 1 source))733 (caption (match-string-no-properties 2 source)))734 (setq source caption)735 (add-text-properties736 0 (length source)737 `(mouse-face highlight738 uri ,uri739 face twittering-uri-face740 source ,source)741 source)742 ))735 (let ((uri (match-string-no-properties 1 source)) 736 (caption (match-string-no-properties 2 source))) 737 (setq source caption) 738 (add-text-properties 739 0 (length source) 740 `(mouse-face highlight 741 uri ,uri 742 face twittering-uri-face 743 source ,source) 744 source) 745 )) 743 746 744 747 (mapcar 745 748 (lambda (sym) 746 `(,sym . ,(symbol-value sym)))749 `(,sym . ,(symbol-value sym))) 747 750 '(id text source created-at truncated 748 user-id user-name user-screen-name user-location749 user-description750 user-profile-image-url751 user-url752 user-protected)))))751 user-id user-name user-screen-name user-location 752 user-description 753 user-profile-image-url 754 user-url 755 user-protected))))) 753 756 754 757 (defun twittering-xmltree-to-status (xmltree) 755 758 (mapcar #'twittering-status-to-status-datum 756 ;; quirk to treat difference between xml.el in Emacs21 and Emacs22757 ;; On Emacs22, there may be blank strings758 (let ((ret nil) (statuses (reverse (cddr (car xmltree)))))759 (while statuses760 (if (consp (car statuses))761 (setq ret (cons (car statuses) ret)))762 (setq statuses (cdr statuses)))763 ret)))759 ;; quirk to treat difference between xml.el in Emacs21 and Emacs22 760 ;; On Emacs22, there may be blank strings 761 (let ((ret nil) (statuses (reverse (cddr (car xmltree))))) 762 (while statuses 763 (if (consp (car statuses)) 764 (setq ret (cons (car statuses) ret))) 765 (setq statuses (cdr statuses))) 766 ret))) 764 767 765 768 (defun twittering-percent-encode (str &optional coding-system) 766 769 (if (or (null coding-system) 767 (not (coding-system-p coding-system)))770 (not (coding-system-p coding-system))) 768 771 (setq coding-system 'utf-8)) 769 772 (mapconcat … … 788 791 (if encoded-str 789 792 (let ((cursor 0) 790 (found-at nil)791 (result '()))792 (while (setq found-at793 (string-match "&\\(#\\([0-9]+\\)\\|\\([A-Za-z]+\\)\\);"794 encoded-str cursor))795 (when (> found-at cursor)796 (list-push (substring encoded-str cursor found-at) result))797 (let ((number-entity (match-string-no-properties 2 encoded-str))798 (letter-entity (match-string-no-properties 3 encoded-str)))799 (cond (number-entity800 (list-push801 (char-to-string802 (twittering-ucs-to-char803 (string-to-number number-entity))) result))804 (letter-entity805 (cond ((string= "gt" letter-entity) (list-push ">" result))806 ((string= "lt" letter-entity) (list-push "<" result))807 (t (list-push "?" result))))808 (t (list-push "?" result)))809 (setq cursor (match-end 0))))810 (list-push (substring encoded-str cursor) result)811 (apply 'concat (nreverse result)))793 (found-at nil) 794 (result '())) 795 (while (setq found-at 796 (string-match "&\\(#\\([0-9]+\\)\\|\\([A-Za-z]+\\)\\);" 797 encoded-str cursor)) 798 (when (> found-at cursor) 799 (list-push (substring encoded-str cursor found-at) result)) 800 (let ((number-entity (match-string-no-properties 2 encoded-str)) 801 (letter-entity (match-string-no-properties 3 encoded-str))) 802 (cond (number-entity 803 (list-push 804 (char-to-string 805 (twittering-ucs-to-char 806 (string-to-number number-entity))) result)) 807 (letter-entity 808 (cond ((string= "gt" letter-entity) (list-push ">" result)) 809 ((string= "lt" letter-entity) (list-push "<" result)) 810 (t (list-push "?" result)))) 811 (t (list-push "?" result))) 812 (setq cursor (match-end 0)))) 813 (list-push (substring encoded-str cursor) result) 814 (apply 'concat (nreverse result))) 812 815 "")) 813 816 … … 815 818 (let ((buf (get-buffer twittering-buffer))) 816 819 (if (null buf) 817 (twittering-stop)820 (twittering-stop) 818 821 (funcall func) 819 822 ))) … … 823 826 nil 824 827 (twittering-http-post "statuses" "update" 825 `(("status" . ,status)826 ("source" . "twmode")))828 `(("status" . ,status) 829 ("source" . "twmode"))) 827 830 t)) 828 831 … … 833 836 (setq status (read-from-minibuffer "status: " status nil nil nil nil t)) 834 837 (setq not-posted-p 835 (not (twittering-update-status-if-not-blank status))))))838 (not (twittering-update-status-if-not-blank status)))))) 836 839 837 840 (defun twittering-update-lambda () … … 844 847 (defun twittering-update-jojo (usr msg) 845 848 (if (string-match "\xde21\xd24b\\(\xd22a\xe0b0\\|\xdaae\xe6cd\\)\xd24f\xd0d6\\([^\xd0d7]+\\)\xd0d7\xd248\xdc40\xd226" 846 msg)849 msg) 847 850 (twittering-http-post 848 851 "statuses" "update" 849 852 `(("status" . ,(concat 850 "@" usr " "851 (match-string-no-properties 2 msg)852 "\xd0a1\xd24f\xd243!?"))853 ("source" . "twmode")))))853 "@" usr " " 854 (match-string-no-properties 2 msg) 855 "\xd0a1\xd24f\xd243!?")) 856 ("source" . "twmode"))))) 854 857 855 858 ;;; … … 864 867 nil 865 868 (setq twittering-timer 866 (run-at-time "0 sec"867 twittering-timer-interval868 #'twittering-timer-action action))))869 (run-at-time "0 sec" 870 twittering-timer-interval 871 #'twittering-timer-action action)))) 869 872 870 873 (defun twittering-stop () … … 877 880 (let ((buf (get-buffer twittering-buffer))) 878 881 (if (not buf) 879 (twittering-stop)882 (twittering-stop) 880 883 (twittering-http-get "statuses" "friends_timeline") 881 884 )) … … 883 886 (if twittering-icon-mode 884 887 (if twittering-image-stack 885 (let ((proc886 (apply887 #'start-process888 "wget-images"889 (twittering-wget-buffer)890 "wget"891 (format "--directory-prefix=%s" twittering-tmp-dir)892 "--no-clobber"893 "--quiet"894 twittering-image-stack)))895 (set-process-sentinel896 proc897 (lambda (proc stat)898 (clear-image-cache)899 (save-excursion900 (set-buffer (twittering-wget-buffer))901 )))))))888 (let ((proc 889 (apply 890 #'start-process 891 "wget-images" 892 (twittering-wget-buffer) 893 "wget" 894 (format "--directory-prefix=%s" twittering-tmp-dir) 895 "--no-clobber" 896 "--quiet" 897 twittering-image-stack))) 898 (set-process-sentinel 899 proc 900 (lambda (proc stat) 901 (clear-image-cache) 902 (save-excursion 903 (set-buffer (twittering-wget-buffer)) 904 ))))))) 902 905 903 906 (defun twittering-update-status-interactive () … … 914 917 (let ((uri (get-text-property (point) 'uri))) 915 918 (if uri 916 (browse-url uri))))919 (browse-url uri)))) 917 920 918 921 (defun twittering-enter () 919 922 (interactive) 920 923 (let ((username (get-text-property (point) 'username)) 921 (uri (get-text-property (point) 'uri)))924 (uri (get-text-property (point) 'uri))) 922 925 (if username 923 (twittering-update-status-from-minibuffer (concat "@" username " "))926 (twittering-update-status-from-minibuffer (concat "@" username " ")) 924 927 (if uri 925 (browse-url uri)))))928 (browse-url uri))))) 926 929 927 930 (defun twittering-view-user-page () … … 929 932 (let ((uri (get-text-property (point) 'uri))) 930 933 (if uri 931 (browse-url uri))))934 (browse-url uri)))) 932 935 933 936 (defun twittering-reply-to-user () … … 935 938 (let ((username (get-text-property (point) 'username))) 936 939 (if username 937 (twittering-update-status-from-minibuffer (concat "@" username " ")))))940 (twittering-update-status-from-minibuffer (concat "@" username " "))))) 938 941 939 942 (defun twittering-get-password () … … 983 986 (interactive) 984 987 (let ((user-name (twittering-get-username-at-pos (point))) 985 (pos (twittering-get-next-username-face-pos (point))))988 (pos (twittering-get-next-username-face-pos (point)))) 986 989 (catch 'not-found 987 990 (while (not (equal (twittering-get-username-at-pos pos) user-name)) … … 996 999 (interactive) 997 1000 (let ((user-name (twittering-get-username-at-pos (point))) 998 (pos (twittering-get-previous-username-face-pos (point))))1001 (pos (twittering-get-previous-username-face-pos (point)))) 999 1002 (catch 'not-found 1000 1003 (while (not (equal (twittering-get-username-at-pos pos) user-name)) … … 1007 1010 (defun twittering-get-username-at-pos (pos) 1008 1011 (let ((start-pos pos) 1009 (end-pos))1012 (end-pos)) 1010 1013 (while (eq (get-text-property start-pos 'face) twittering-username-face) 1011 1014 (setq start-pos (1- start-pos))) … … 1014 1017 (buffer-substring start-pos end-pos))) 1015 1018 1019 ;;;###autoload 1020 (defun twit () 1021 "Start twittering-mode." 1022 (interactive) 1023 (twittering-mode)) 1024 1016 1025 (provide 'twittering-mode) 1017 1026 ;;; twittering.el ends here
