Changeset 11 for lang/elisp/twittering-mode/trunk
- Timestamp:
- 02/07/08 15:57:59 (17 years ago)
- Location:
- lang/elisp/twittering-mode/trunk
- Files:
-
- 2 modified
Legend:
- Unmodified
- Added
- Removed
-
lang/elisp/twittering-mode/trunk/ChangeLog
r10 r11 1 2008-02-08 Tsuyoshi CHO <Tsuyoshi.CHO+develop@Gmail.com> 2 3 * twittering-mode.el : 全体的に整形、Proxy、Safe Password、 4 User-Agent、Major mode stringを対応。Version 0.3 5 (twittering-mode-version): 暫定のバージョン定数を定義 6 (twittering-proxy-use): プロキシ関係設定を導入 from <http://d.hatena.ne.jp/lurdan/20080108/1199775387> 7 (twittering-proxy-server): 同上 8 (twittering-proxy-port, twittering-proxy-user): 同上 9 (twittering-proxy-password): 同上 10 (twittering-toggle-proxy): 同上 11 (twittering-user-agent-default-function): 同上 12 (twittering-user-agent-default-function): デフォルトUser-Agent生成関数 13 (twittering-user-agent-function): User-Agent生成関数指定変数を導入 14 (twittering-user-agent): 内部でのUser-Agent生成関数 15 (twittering-tmp-dir): ユーザー固有のImageTmpDirを生成 from <http://d.hatena.ne.jp/odz/20071021/1192957783> 16 (twittering-mode-map): プロキシの有効無効のキーバインド定義 17 (twittering-mode-string): メジャーモード文字列を変数定義 18 (twittering-mode): メジャーモード開始時に文字列を設定 19 (twittering-http-get): プロキシ、User-Agentによる処理を追加 20 (twittering-http-post): 同上 21 (twittering-get-password): パスワードを動的に確認する関数を定義 22 1 23 2007-10-14 Y. Hayamizu <haya@haya-laptop-ubuntu> 2 24 -
lang/elisp/twittering-mode/trunk/twittering-mode.el
r10 r11 2 2 3 3 ;; Copyright (C) 2007 Yuto Hayamizu. 4 ;; 2008 Tsuyoshi CHO 4 5 5 6 ;; Author: Y. Hayamizu <y.hayamizu@gmail.com> 7 ;; Tsuyoshi CHO <Tsuyoshi.CHO+develop@Gmail.com> 6 8 ;; Created: Sep 4, 2007 7 9 ;; Version: SVN-HEAD 8 10 ;; Keywords: twitter web 9 ;; URL: http:// hayamin.com/11 ;; URL: http://lambdarepos.svnrepository.com/share/trac.cgi/browser/lang/elisp/twittering-mode 10 12 11 13 ;; This file is free software; you can redistribute it and/or modify … … 29 31 ;; You can check friends timeline, and update your status on Emacs. 30 32 33 ;;; Feature Request: 34 35 ;; URL : http://twitter.com/d00dle/statuses/577876082 36 ;; URL : http://twitter.com/d00dle/statuses/577879732 37 ;; * Status Input from Popup buffer and C-cC-c to POST. 38 ;; * Mark fav(star) 39 ;; URL : http://code.nanigac.com/source/view/419 40 ;; * update status for region 41 31 42 ;;; Code: 32 43 … … 34 45 (require 'xml) 35 46 (require 'parse-time) 47 48 (defconst twittering-mode-version "0.3") 36 49 37 50 (defvar twittering-mode-map (make-sparse-keymap)) … … 93 106 94 107 (defun assocref (item alist) 95 (cdr (assoc item alist))) 96 97 ;;; 108 (cdr (assoc item alist))) 109 110 ;;; Proxy 111 (defvar twittering-proxy-use nil) 112 (defvar twittering-proxy-server nil) 113 (defvar twittering-proxy-port 8080) 114 (defvar twittering-proxy-user nil) 115 (defvar twittering-proxy-password nil) 116 117 (defun twittering-toggle-proxy () "" 118 (interactive) 119 (setq twittering-proxy-use 120 (not twittering-proxy-use)) 121 (message "%s %s" 122 "Use Proxy:" 123 (if twittering-proxy-use 124 "on" "off"))) 125 126 (defun twittering-user-agent-default-function () 127 "Twittering mode default User-Agent function." 128 (concat "Emacs/" 129 (int-to-string emacs-major-version) "." (int-to-string 130 emacs-minor-version) 131 " " 132 "Twittering-mode/" 133 twittering-mode-version)) 134 135 (defvar twittering-user-agent-function 'twittering-user-agent-default-function) 136 137 (defun twittering-user-agent () 138 "Return User-Agent header string." 139 (funcall twittering-user-agent-function)) 140 98 141 ;;; to show image files 99 142 … … 102 145 (twittering-get-or-generate-buffer twittering-wget-buffer)) 103 146 104 (defvar twittering-tmp-dir "/tmp/twmode-images") 147 (defvar twittering-tmp-dir 148 (expand-file-name (concat "twmode-images-" (user-login-name)) 149 temporary-file-directory)) 105 150 106 151 (defvar twittering-icon-mode nil "You MUST NOT CHANGE this variable directory. You should change through function'twittering-icon-mode'") … … 115 160 (and arg (> (prefix-numeric-value arg) 0))) 116 161 (when (file-writable-p twittering-tmp-dir) 117 (progn 162 (progn 118 163 (if (not (file-directory-p twittering-tmp-dir)) 119 164 (make-directory twittering-tmp-dir)) … … 124 169 (interactive) 125 170 (setq twittering-scroll-mode 126 127 (not twittering-scroll-mode)128 171 (if (null arg) 172 (not twittering-scroll-mode) 173 (> (prefix-numeric-value arg) 0)))) 129 174 130 175 (defun twittering-jojo-mode (&optional arg) 131 176 (interactive) 132 177 (setq twittering-jojo-mode 133 134 (not twittering-jojo-mode)135 178 (if (null arg) 179 (not twittering-jojo-mode) 180 (> (prefix-numeric-value arg) 0)))) 136 181 137 182 (defvar twittering-image-stack nil) … … 160 205 (newline) 161 206 ,obsym) 162 207 ,obsym)))) 163 208 164 209 (defun twittering-debug-mode () … … 187 232 (define-key km "G" 'end-of-buffer) 188 233 (define-key km "H" 'beginning-of-buffer) 234 (define-key km "\C-c\C-p" 'twittering-toggle-proxy) 189 235 nil)) 190 236 … … 194 240 () 195 241 (setq twittering-mode-syntax-table (make-syntax-table)) 196 ; (modify-syntax-entry ? "" twittering-mode-syntax-table)242 ; (modify-syntax-entry ? "" twittering-mode-syntax-table) 197 243 (modify-syntax-entry ?\" "w" twittering-mode-syntax-table) 198 244 ) … … 233 279 `(decode-char 'ucs ,num))) 234 280 281 (defvar twittering-mode-string "Twittering mode") 282 235 283 (defun twittering-mode () 236 284 "Major mode for Twitter" … … 241 289 (use-local-map twittering-mode-map) 242 290 (setq major-mode 'twittering-mode) 243 (setq mode-name "Twittering mode")291 (setq mode-name twittering-mode-string) 244 292 (set-syntax-table twittering-mode-syntax-table) 245 293 (run-hooks 'twittering-mode-hook) … … 260 308 (erase-buffer)) 261 309 262 (let (proc) 310 (let (proc server port 311 (proxy-user twittering-proxy-user) 312 (proxy-password twittering-proxy-password)) 263 313 (condition-case nil 264 314 (progn 315 (if (and twittering-proxy-use twittering-proxy-server) 316 (setq server twittering-proxy-server 317 port (if (integerp twittering-proxy-port) 318 (int-to-string twittering-proxy-port) 319 twittering-proxy-port)) 320 (setq server "twitter.com" 321 port "80")) 265 322 (setq proc 266 323 (open-network-stream 267 324 "network-connection-process" (twittering-http-buffer) 268 "twitter.com" 80))325 server (string-to-number port))) 269 326 (set-process-sentinel proc sentinel) 270 327 (process-send-string 271 328 proc 272 (let ((nl "\r\n")) 273 (concat "GET /" method-class "/" method ".xml HTTP/1.1" nl 274 "Host: twitter.com" nl 275 "Authorization: Basic " 276 (base64-encode-string 277 (concat twittering-username ":" twittering-password)) 278 nl 279 "Accept: text/xml" 280 ",application/xml" 281 ",application/xhtml+xml" 282 ",application/html;q=0.9" 283 ",text/plain;q=0.8" 284 ",image/png,*/*;q=0.5" nl 285 "Accept-Charset: utf-8;q=0.7,*;q=0.7" 286 nl nl)))) 329 (let ((nl "\r\n") 330 request) 331 (setq request 332 (concat "GET http://twitter.com/" method-class "/" method ".xml HTTP/1.1" nl 333 "Host: twitter.com" nl 334 "User-Agent: " (twittering-user-agent) nl 335 "Authorization: Basic " 336 (base64-encode-string 337 (concat twittering-username ":" (twittering-get-password))) 338 nl 339 "Accept: text/xml" 340 ",application/xml" 341 ",application/xhtml+xml" 342 ",application/html;q=0.9" 343 ",text/plain;q=0.8" 344 ",image/png,*/*;q=0.5" nl 345 "Accept-Charset: utf-8;q=0.7,*;q=0.7" nl 346 (when twittering-proxy-use 347 "Proxy-Connection: Keep-Alive" nl 348 (when (and proxy-user proxy-password) 349 (concat 350 "Proxy-Authorization: Basic " 351 (base64-encode-string 352 (concat proxy-user ":" 353 proxy-password)) 354 nl))) 355 nl nl)) 356 (debug-print (concat "GET Request\n" request)) 357 request))) 287 358 (error 288 359 (message "Failure: HTTP GET") nil)))) … … 290 361 (defun twittering-http-get-default-sentinel (proc stat &optional suc-msg) 291 362 (let ((header (twittering-get-response-header)) 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 363 (body (twittering-get-response-body)) 364 (status nil) 365 ) 366 (if (string-match "HTTP/1\.[01] \\([a-z0-9 ]+\\)\r?\n" header) 367 (progn 368 (setq status (match-string-no-properties 1 header)) 369 (case-string 370 status 371 (("200 OK") 372 (mapcar 373 #'twittering-cache-status-datum 374 (reverse (twittering-xmltree-to-status 375 body))) 376 (twittering-render-friends-timeline) 377 (message (if suc-msg suc-msg "Success: Get."))) 378 (t (message status)))) 379 (message "Failure: Bad http response."))) 309 380 ) 310 381 … … 449 520 (erase-buffer)) 450 521 451 (let (proc) 522 (let (proc server port 523 (proxy-user twittering-proxy-user) 524 (proxy-password twittering-proxy-password)) 452 525 (progn 526 (if (and twittering-proxy-use twittering-proxy-server) 527 (setq server twittering-proxy-server 528 port (if (integerp twittering-proxy-port) 529 (int-to-string twittering-proxy-port) 530 twittering-proxy-port)) 531 (setq server "twitter.com" 532 port "80")) 453 533 (setq proc 454 534 (open-network-stream 455 535 "network-connection-process" (twittering-http-buffer) 456 "twitter.com" 80))536 server (string-to-number port))) 457 537 (set-process-sentinel proc sentinel) 458 538 (process-send-string 459 539 proc 460 (let ((nl "\r\n")) 461 (concat "POST /" method-class "/" method ".xml?" 462 (if parameters 463 (mapconcat 464 (lambda (param-pair) 465 (format "%s=%s" 466 (twittering-percent-encode (car param-pair)) 467 (twittering-percent-encode (cdr param-pair)))) 468 parameters 469 "&")) 470 " HTTP/1.1" nl 471 "Host: twitter.com" nl 472 "Authorization: Basic " 473 (base64-encode-string 474 (concat twittering-username ":" twittering-password)) 475 nl 476 "Content-Type: text/plain" nl 477 "Content-Length: 0" nl 478 nl nl)))))) 540 (let ((nl "\r\n") 541 request) 542 (setq request 543 (concat "POST http://twitter.com/" method-class "/" method ".xml?" 544 (if parameters 545 (mapconcat 546 (lambda (param-pair) 547 (format "%s=%s" 548 (twittering-percent-encode (car param-pair)) 549 (twittering-percent-encode (cdr param-pair)))) 550 parameters 551 "&")) 552 " HTTP/1.1" nl 553 "Host: twitter.com" nl 554 "User-Agent: " (twittering-user-agent) nl 555 "Authorization: Basic " 556 (base64-encode-string 557 (concat twittering-username ":" (twittering-get-password))) 558 nl 559 "Content-Type: text/plain" nl 560 "Content-Length: 0" nl 561 (when twittering-proxy-use 562 "Proxy-Connection: Keep-Alive" nl 563 (when (and proxy-user proxy-password) 564 (concat 565 "Proxy-Authorization: Basic " 566 (base64-encode-string 567 (concat proxy-user ":" 568 proxy-password)) 569 nl))) 570 nl nl)) 571 (debug-print (concat "POST Request\n" request)) 572 request))))) 479 573 480 574 (defun twittering-http-post-default-sentinel (proc stat &optional suc-msg) 481 575 482 576 (condition-case err-signal 483 577 (let ((header (twittering-get-response-header)) … … 525 619 (if (null data-var) 526 620 (setf data-var 'twittering-friends-timeline-data)) 527 (let ((id (cdr (assq 'id status-datum)))) 621 (let ((id (cdr (assq 'id status-datum)))) 528 622 (if (or (null (symbol-value data-var)) 529 623 (not (find-if … … 553 647 user-protected 554 648 regex-index) 555 649 556 650 (setq id (string-to-number (assq-get 'id status-data))) 557 (setq text (twittering-decode-html-entities 651 (setq text (twittering-decode-html-entities 558 652 (assq-get 'text status-data))) 559 (setq source (twittering-decode-html-entities 653 (setq source (twittering-decode-html-entities 560 654 (assq-get 'source status-data))) 561 655 (setq created-at (assq-get 'created_at status-data)) … … 564 658 (setq user-name (twittering-decode-html-entities 565 659 (assq-get 'name user-data))) 566 (setq user-screen-name (twittering-decode-html-entities 660 (setq user-screen-name (twittering-decode-html-entities 567 661 (assq-get 'screen_name user-data))) 568 662 (setq user-location (twittering-decode-html-entities … … 605 699 uri ,(concat "http://twitter.com/" screen-name)) 606 700 `(mouse-face highlight 607 face twittering-uri-face608 uri ,uri))701 face twittering-uri-face 702 uri ,uri)) 609 703 text)) 610 704 (setq regex-index (match-end 0)) )) … … 627 721 0 (length source) 628 722 `(mouse-face highlight 629 630 631 723 uri ,uri 724 face twittering-uri-face 725 source ,source) 632 726 source) 633 727 )) … … 828 922 (twittering-update-status-from-minibuffer (concat "@" username " "))))) 829 923 924 (defun twittering-get-password () 925 (or twittering-password 926 (setq twittering-password (read-passwd "twittering-mode: ")))) 927 830 928 (provide 'twittering-mode) 831 929 ;;; twittering.el ends here