Changeset 38 for lang/elisp/twittering-mode/trunk
- Timestamp:
- 05/01/08 15:07:19 (17 years ago)
- Location:
- lang/elisp/twittering-mode/trunk
- Files:
-
- 2 modified
Legend:
- Unmodified
- Added
- Removed
-
lang/elisp/twittering-mode/trunk/ChangeLog
r11 r38 1 2008-05-01 Tsuyoshi CHO <Tsuyoshi.CHO+develop@Gmail.com> 2 3 * twittering-mode.el : 全体のコメント修正、以下の修正は大部分を 4 gan2さんが実施した 5 (twittering-mode-version): 新規関数 6 (twittering-timer): コメント追加 7 (twittering-scroll-mode, twittering-jojo-mode) 8 (twittering-icon-mode): Nicholas Riley <njriley@uiuc.edu>さんのパッ 9 チ採用、バッファローカル化 10 (list-push): 新規マクロ 11 (twittering-mode-map): キーバインド変更 12 (twittering-mode-hook): フック変数新規作成(以前から利用してたけど 13 定義がなかった) 14 (twittering-render-friends-timeline): Nicholas Riley 15 <njriley@uiuc.edu>さんのパッチ採用、ステータスの挿入正常化 16 (twittering-goto-next-status) 17 (twittering-get-next-username-face-pos) 18 (twittering-goto-previous-status) 19 (twittering-get-previous-username-face-pos) 20 (twittering-goto-next-status-of-user) 21 (twittering-goto-previous-status-of-user) 22 (twittering-get-username-at-pos, twit): 新規関数 23 1 24 2008-02-08 Tsuyoshi CHO <Tsuyoshi.CHO+develop@Gmail.com> 2 25 -
lang/elisp/twittering-mode/trunk/twittering-mode.el
r24 r38 7 7 ;; Tsuyoshi CHO <Tsuyoshi.CHO+develop@Gmail.com> 8 8 ;; Created: Sep 4, 2007 9 ;; Version: SVN-HEAD9 ;; Version: 0.4 10 10 ;; Keywords: twitter web 11 11 ;; URL: http://lambdarepos.svnrepository.com/share/trac.cgi/browser/lang/elisp/twittering-mode … … 46 46 (require 'parse-time) 47 47 48 (defconst twittering-mode-version "0.3") 48 (defconst twittering-mode-version "0.4") 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))) 49 58 50 59 (defvar twittering-mode-map (make-sparse-keymap)) 51 60 52 (defvar twittering-timer nil )61 (defvar twittering-timer nil "Timer object for timeline refreshing will be stored here. DO NOT SET VALUE MANUALLY.") 53 62 54 63 (defvar twittering-idle-time 20) … … 61 70 62 71 (defvar twittering-scroll-mode nil) 72 (make-variable-buffer-local 'twittering-scroll-mode) 63 73 64 74 (defvar twittering-jojo-mode nil) 75 (make-variable-buffer-local 'twittering-jojo-mode) 65 76 66 77 (defvar twittering-status-format nil) 67 78 (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 ; %# - id79 ;; %s - screen_name 80 ;; %S - name 81 ;; %i - profile_image 82 ;; %d - description 83 ;; %l - location 84 ;; %L - " [location]" 85 ;; %u - url 86 ;; %j - user.id 87 ;; %p - protected? 88 ;; %c - created_at (raw UTC string) 89 ;; %C{time-format-str} - created_at (formatted with time-format-str) 90 ;; %@ - X seconds ago 91 ;; %t - text 92 ;; %' - truncated 93 ;; %f - source 94 ;; %# - id 84 95 85 96 (defvar twittering-buffer "*twittering*") … … 107 118 (defun assocref (item alist) 108 119 (cdr (assoc item alist))) 120 (defmacro list-push (value listvar) 121 `(setq ,listvar (cons ,value ,listvar))) 109 122 110 123 ;;; Proxy … … 150 163 151 164 (defvar twittering-icon-mode nil "You MUST NOT CHANGE this variable directory. You should change through function'twittering-icon-mode'") 165 (make-variable-buffer-local 'twittering-icon-mode) 152 166 (defun twittering-icon-mode (&optional arg) 153 167 (interactive) … … 222 236 (define-key km [mouse-1] 'twittering-click) 223 237 (define-key km "\C-c\C-v" 'twittering-view-user-page) 224 (define-key km "j" 'next-line) 225 (define-key km "k" 'previous-line) 238 ;; (define-key km "j" 'next-line) 239 ;; (define-key km "k" 'previous-line) 240 (define-key km "j" 'twittering-goto-next-status) 241 (define-key km "k" 'twittering-goto-previous-status) 226 242 (define-key km "l" 'forward-char) 227 243 (define-key km "h" 'backward-char) … … 229 245 (define-key km "^" 'beginning-of-line-text) 230 246 (define-key km "$" 'end-of-line) 247 (define-key km "n" 'twittering-goto-next-status-of-user) 248 (define-key km "p" 'twittering-goto-previous-status-of-user) 231 249 (define-key km [backspace] 'backward-char) 232 250 (define-key km "G" 'end-of-buffer) 233 251 (define-key km "H" 'beginning-of-buffer) 252 (define-key km "i" 'twittering-icon-mode) 253 (define-key km "s" 'twittering-scroll-mode) 254 (define-key km "t" 'twittering-toggle-proxy) 234 255 (define-key km "\C-c\C-p" 'twittering-toggle-proxy) 235 256 nil)) … … 240 261 () 241 262 (setq twittering-mode-syntax-table (make-syntax-table)) 242 ; 263 ;; (modify-syntax-entry ? "" twittering-mode-syntax-table) 243 264 (modify-syntax-entry ?\" "w" twittering-mode-syntax-table) 244 265 ) 245 266 246 267 (defun twittering-mode-init-variables () 247 ; (make-variable-buffer-local 'variable)248 ; (setq variable nil)268 ;; (make-variable-buffer-local 'variable) 269 ;; (setq variable nil) 249 270 (font-lock-mode -1) 250 271 (defface twittering-username-face … … 280 301 281 302 (defvar twittering-mode-string "Twittering mode") 303 304 (defvar twittering-mode-hook nil 305 "Twittering-mode hook.") 282 306 283 307 (defun twittering-mode () … … 386 410 (setq buffer-read-only nil) 387 411 (erase-buffer) 388 (insert 389 (mapconcat (lambda (status) 390 (twittering-format-status status twittering-status-format)) 391 twittering-friends-timeline-data 392 "\n")) 412 (mapc (lambda (status) 413 (insert (twittering-format-status 414 status twittering-status-format)) 415 (fill-region-as-paragraph 416 (save-excursion (beginning-of-line) (point)) (point)) 417 (insert "\n")) 418 twittering-friends-timeline-data) 393 419 (if twittering-image-stack 394 420 (clear-image-cache)) … … 432 458 (setq c (string-to-char (match-string-no-properties 1 format-str))) 433 459 (if (> found-at cursor) 434 ( push (substring format-str cursor found-at) result)460 (list-push (substring format-str cursor found-at) result) 435 461 "|") 436 462 (setq cursor (match-end 1)) 437 463 438 464 (case c 439 ((?s) 440 ( push (attr 'user-screen-name) result))441 ((?S) 442 ( push (attr 'user-name) result))443 ((?i) 444 ( push (profile-image) result))445 ((?d) 446 ( push (attr 'user-description) result))447 ((?l) 448 ( push (attr 'user-location) result))449 ((?L) 465 ((?s) ; %s - screen_name 466 (list-push (attr 'user-screen-name) result)) 467 ((?S) ; %S - name 468 (list-push (attr 'user-name) result)) 469 ((?i) ; %i - profile_image 470 (list-push (profile-image) result)) 471 ((?d) ; %d - description 472 (list-push (attr 'user-description) result)) 473 ((?l) ; %l - location 474 (list-push (attr 'user-location) result)) 475 ((?L) ; %L - " [location]" 450 476 (let ((location (attr 'user-location))) 451 477 (unless (or (null location) (string= "" location)) 452 ( push (concat " [" location "]") result)) ))453 ((?u) 454 ( push (attr 'user-url) result))455 ((?j) 456 ( push (attr 'user-id) result))457 ((?p) 478 (list-push (concat " [" location "]") result)) )) 479 ((?u) ; %u - url 480 (list-push (attr 'user-url) result)) 481 ((?j) ; %j - user.id 482 (list-push (attr 'user-id) result)) 483 ((?p) ; %p - protected? 458 484 (let ((protected (attr 'user-protected))) 459 485 (when (string= "true" protected) 460 ( push "[x]" result))))461 ((?c) 462 ( push (attr 'created-at) result))463 ((?C) 464 ( push (twittering-local-strftime465 (or (match-string-no-properties 2 format-str) "%H:%M:%S")466 (attr 'created-at))467 result))468 ((?@) 486 (list-push "[x]" result)))) 487 ((?c) ; %c - created_at (raw UTC string) 488 (list-push (attr 'created-at) result)) 489 ((?C) ; %C{time-format-str} - created_at (formatted with time-format-str) 490 (list-push (twittering-local-strftime 491 (or (match-string-no-properties 2 format-str) "%H:%M:%S") 492 (attr 'created-at)) 493 result)) 494 ((?@) ; %@ - X seconds ago 469 495 (let ((created-at 470 496 (apply … … 474 500 (let ((secs (+ (* (- (car now) (car created-at)) 65536) 475 501 (- (cadr now) (cadr created-at))))) 476 ( push (cond ((< secs 5) "less than 5 seconds ago")477 478 479 480 481 482 483 (/ (+ secs 30) 60)))484 485 486 487 488 489 ((?t) 490 ( push;(clickable-text)502 (list-push (cond ((< secs 5) "less than 5 seconds ago") 503 ((< secs 10) "less than 10 seconds ago") 504 ((< secs 20) "less than 20 seconds ago") 505 ((< secs 30) "half a minute ago") 506 ((< secs 60) "less than a minute ago") 507 ((< secs 150) "1 minute ago") 508 ((< secs 2400) (format "%d minutes ago" 509 (/ (+ secs 30) 60))) 510 ((< secs 5400) "about 1 hour ago") 511 ((< secs 84600) (format "about %d hours ago" 512 (/ (+ secs 1800) 3600))) 513 (t (format-time-string "%I:%M %p %B %d, %Y" created-at))) 514 result)))) 515 ((?t) ; %t - text 516 (list-push ;(clickable-text) 491 517 (attr 'text) 492 518 result)) 493 ((?') 519 ((?') ; %' - truncated 494 520 (let ((truncated (attr 'truncated))) 495 521 (when (string= "true" truncated) 496 ( push "..." result))))497 ((?f) 498 ( push (attr 'source) result))499 ((?#) 500 ( push (attr 'id) result))522 (list-push "..." result)))) 523 ((?f) ; %f - source 524 (list-push (attr 'source) result)) 525 ((?#) ; %# - id 526 (list-push (attr 'id) result)) 501 527 (t 502 ( push (char-to-string c) result)))528 (list-push (char-to-string c) result))) 503 529 ) 504 ( push (substring format-str cursor) result)530 (list-push (substring format-str cursor) result) 505 531 (apply 'concat (nreverse result)) 506 532 ))) … … 540 566 (let ((nl "\r\n") 541 567 request) 542 (setq 568 (setq request 543 569 (concat "POST http://twitter.com/" method-class "/" method ".xml?" 544 570 (if parameters … … 576 602 (condition-case err-signal 577 603 (let ((header (twittering-get-response-header)) 578 ; (body (twittering-get-response-body)) not used now.604 ;; (body (twittering-get-response-body)) not used now. 579 605 (status nil)) 580 606 (string-match "HTTP/1\.1 \\([a-z0-9 ]+\\)\r?\n" header) … … 589 615 590 616 (defun twittering-get-response-header (&optional buffer) 591 "Ex tract HTTP response header from HTTP response.617 "Exract HTTP response header from HTTP response. 592 618 `buffer' may be a buffer or the name of an existing buffer. 593 619 If `buffer' is omitted, the value of `twittering-http-buffer' is used as `buffer'." … … 600 626 601 627 (defun twittering-get-response-body (&optional buffer) 602 "Ex tract HTTP response body from HTTP response, parse it as XML, and return a XML tree as list.628 "Exract HTTP response body from HTTP response, parse it as XML, and return a XML tree as list. 603 629 `buffer' may be a buffer or the name of an existing buffer. 604 630 If `buffer' is omitted, the value of `twittering-http-buffer' is used as `buffer'." … … 779 805 encoded-str cursor)) 780 806 (when (> found-at cursor) 781 ( push (substring encoded-str cursor found-at) result))807 (list-push (substring encoded-str cursor found-at) result)) 782 808 (let ((number-entity (match-string-no-properties 2 encoded-str)) 783 809 (letter-entity (match-string-no-properties 3 encoded-str))) 784 810 (cond (number-entity 785 ( push811 (list-push 786 812 (char-to-string 787 813 (twittering-ucs-to-char 788 814 (string-to-number number-entity))) result)) 789 815 (letter-entity 790 (cond ((string= "gt" letter-entity) ( push ">" result))791 ((string= "lt" letter-entity) ( push "<" result))792 (t push "?" result)))793 (t ( push "?" result)))816 (cond ((string= "gt" letter-entity) (list-push ">" result)) 817 ((string= "lt" letter-entity) (list-push "<" result)) 818 (t (list-push "?" result)))) 819 (t (list-push "?" result))) 794 820 (setq cursor (match-end 0)))) 795 ( push (substring encoded-str cursor) result)821 (list-push (substring encoded-str cursor) result) 796 822 (apply 'concat (nreverse result))) 797 823 "")) … … 926 952 (setq twittering-password (read-passwd "twittering-mode: ")))) 927 953 954 (defun twittering-goto-next-status () 955 "Go to next status." 956 (interactive) 957 (let ((pos)) 958 (setq pos (twittering-get-next-username-face-pos (point))) 959 (if pos 960 (goto-char pos) 961 (message "End of status.")))) 962 963 (defun twittering-get-next-username-face-pos (pos) 964 (interactive) 965 (let ((prop)) 966 (catch 'not-found 967 (while (and pos (not (eq prop twittering-username-face))) 968 (setq pos (next-single-property-change pos 'face)) 969 (when (eq pos nil) (throw 'not-found nil)) 970 (setq prop (get-text-property pos 'face))) 971 pos))) 972 973 (defun twittering-goto-previous-status () 974 "Go to previous status." 975 (interactive) 976 (let ((pos)) 977 (setq pos (twittering-get-previous-username-face-pos (point))) 978 (if pos 979 (goto-char pos) 980 (message "Start of status.")))) 981 982 (defun twittering-get-previous-username-face-pos (pos) 983 (interactive) 984 (let ((prop)) 985 (catch 'not-found 986 (while (and pos (not (eq prop twittering-username-face))) 987 (setq pos (previous-single-property-change pos 'face)) 988 (when (eq pos nil) (throw 'not-found nil)) 989 (setq prop (get-text-property pos 'face))) 990 pos))) 991 992 (defun twittering-goto-next-status-of-user () 993 "Go to next status of user." 994 (interactive) 995 (let ((user-name (twittering-get-username-at-pos (point))) 996 (pos (twittering-get-next-username-face-pos (point)))) 997 (while (and (not (eq pos nil)) 998 (not (equal (twittering-get-username-at-pos pos) user-name))) 999 (setq pos (twittering-get-next-username-face-pos pos))) 1000 (if pos 1001 (goto-char pos) 1002 (if user-name 1003 (message "End of %s's status." user-name) 1004 (message "Invalid user-name."))))) 1005 1006 (defun twittering-goto-previous-status-of-user () 1007 "Go to previous status of user." 1008 (interactive) 1009 (let ((user-name (twittering-get-username-at-pos (point))) 1010 (pos (twittering-get-previous-username-face-pos (point)))) 1011 (while (and (not (eq pos nil)) 1012 (not (equal (twittering-get-username-at-pos pos) user-name))) 1013 (setq pos (twittering-get-previous-username-face-pos pos))) 1014 (if pos 1015 (goto-char pos) 1016 (if user-name 1017 (message "Start of %s's status." user-name) 1018 (message "Invalid user-name."))))) 1019 1020 (defun twittering-get-username-at-pos (pos) 1021 (let ((start-pos pos) 1022 (end-pos)) 1023 (catch 'not-found 1024 (while (eq (get-text-property start-pos 'face) twittering-username-face) 1025 (setq start-pos (1- start-pos)) 1026 (when (or (eq start-pos nil) (eq start-pos 0)) (throw 'not-found nil))) 1027 (setq start-pos (1+ start-pos)) 1028 (setq end-pos (next-single-property-change pos 'face)) 1029 (buffer-substring start-pos end-pos)))) 1030 1031 ;;;###autoload 1032 (defun twit () 1033 "Start twittering-mode." 1034 (interactive) 1035 (twittering-mode)) 1036 928 1037 (provide 'twittering-mode) 929 1038 ;;; twittering.el ends here