Changeset 35 for lang

Show
Ignore:
Timestamp:
04/27/08 09:00:02 (17 years ago)
Author:
gan2
Message:

branches/tsuyoshi/ から twittering-mode.el をコピー

Files:
1 modified

Legend:

Unmodified
Added
Removed
  • lang/elisp/twittering-mode/branches/gan2/twittering-mode.el

    r31 r35  
    5252  (interactive) 
    5353  (let ((version-string 
    54         (format "twittering-mode-v%s" twittering-mode-version))) 
     54        (format "twittering-mode-v%s" twittering-mode-version))) 
    5555    (if (interactive-p) 
    56         (message "%s" version-string) 
     56        (message "%s" version-string) 
    5757      version-string))) 
    5858 
     
    108108  (if (bufferp buffer) 
    109109      (if (buffer-live-p buffer) 
    110           buffer 
    111         (generate-new-buffer (buffer-name buffer))) 
     110          buffer 
     111        (generate-new-buffer (buffer-name buffer))) 
    112112    (if (stringp buffer) 
    113         (or (get-buffer buffer) 
    114             (generate-new-buffer buffer))))) 
     113        (or (get-buffer buffer) 
     114            (generate-new-buffer buffer))))) 
    115115 
    116116(defun assocref (item alist) 
     
    129129  (interactive) 
    130130  (setq twittering-proxy-use 
    131         (not twittering-proxy-use)) 
     131        (not twittering-proxy-use)) 
    132132  (message "%s %s" 
    133            "Use Proxy:" 
    134            (if twittering-proxy-use 
    135                "on" "off"))) 
     133           "Use Proxy:" 
     134           (if twittering-proxy-use 
     135               "on" "off"))) 
    136136 
    137137(defun twittering-user-agent-default-function () 
    138138  "Twittering mode default User-Agent function." 
    139139  (concat "Emacs/" 
    140           (int-to-string emacs-major-version) "." (int-to-string 
    141                                                    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)) 
    145145 
    146146(defvar twittering-user-agent-function 'twittering-user-agent-default-function) 
     
    158158(defvar twittering-tmp-dir 
    159159  (expand-file-name (concat "twmode-images-" (user-login-name)) 
    160                     temporary-file-directory)) 
     160                    temporary-file-directory)) 
    161161 
    162162(defvar twittering-icon-mode nil "You MUST NOT CHANGE this variable directory. You should change through function'twittering-icon-mode'") 
     
    164164  (interactive) 
    165165  (setq twittering-icon-mode 
    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))))) 
     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))))) 
    177177  (twittering-render-friends-timeline)) 
    178178 
     
    180180  (interactive) 
    181181  (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)))) 
    185185 
    186186(defun twittering-jojo-mode (&optional arg) 
    187187  (interactive) 
    188188  (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)))) 
    192192 
    193193(defvar twittering-image-stack nil) 
     
    202202(defun twittering-local-strftime (fmt string) 
    203203  (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)))) 
    205205 
    206206(defvar twittering-debug-mode nil) 
     
    212212    `(let ((,obsym ,obj)) 
    213213       (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)))) 
    219219 
    220220(defun twittering-debug-mode () 
    221221  (interactive) 
    222222  (setq twittering-debug-mode 
    223         (not twittering-debug-mode)) 
     223        (not twittering-debug-mode)) 
    224224  (message (if twittering-debug-mode "debug mode:on" "debug mode:off"))) 
    225225 
     
    247247      (define-key km "G" 'end-of-buffer) 
    248248      (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) 
    249252      (define-key km "\C-c\C-p" 'twittering-toggle-proxy) 
    250253      nil)) 
     
    279282    ,@(mapcar 
    280283       (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))) 
    287290       clauses))) 
    288291 
     
    324327 
    325328  (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)) 
    328331    (condition-case nil 
    329         (progn 
    330           (if (and twittering-proxy-use twittering-proxy-server) 
    331               (setq server twittering-proxy-server 
    332                     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 proc 
    338                 (open-network-stream 
    339                 "network-connection-process" (twittering-http-buffer) 
    340                 server (string-to-number port))) 
    341           (set-process-sentinel proc sentinel) 
    342           (process-send-string 
    343            proc 
    344            (let ((nl "\r\n") 
    345                 request) 
    346              (setq request 
    347                    (concat "GET http://twitter.com/" method-class "/" method ".xml HTTP/1.1" nl 
    348                            "Host: twitter.com" nl 
    349                            "User-Agent: " (twittering-user-agent) nl 
    350                            "Authorization: Basic " 
    351                            (base64-encode-string 
    352                             (concat twittering-username ":" (twittering-get-password))) 
    353                            nl 
    354                            "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" nl 
    360                            "Accept-Charset: utf-8;q=0.7,*;q=0.7" nl 
    361                            (when twittering-proxy-use 
    362                              "Proxy-Connection: Keep-Alive" nl 
    363                              (when (and proxy-user proxy-password) 
    364                                (concat 
    365                                 "Proxy-Authorization: Basic " 
    366                                 (base64-encode-string 
    367                                 (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))) 
    373376      (error 
    374377       (message "Failure: HTTP GET") nil)))) 
     
    376379(defun twittering-http-get-default-sentinel (proc stat &optional suc-msg) 
    377380  (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        ) 
    381384    (if (string-match "HTTP/1\.[01] \\([a-z0-9 ]+\\)\r?\n" header) 
    382         (progn 
    383           (setq status (match-string-no-properties 1 header)) 
    384           (case-string 
    385            status 
    386            (("200 OK") 
    387             (mapcar 
    388              #'twittering-cache-status-datum 
    389              (reverse (twittering-xmltree-to-status 
    390                        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)))) 
    394397      (message "Failure: Bad http response."))) 
    395398  ) 
     
    398401  (with-current-buffer (twittering-buffer) 
    399402    (let ((point (point)) 
    400           (end (point-max))) 
     403          (end (point-max))) 
    401404      (setq buffer-read-only nil) 
    402405      (erase-buffer) 
    403406      (insert 
    404407       (mapconcat (lambda (status) 
    405                     (twittering-format-status status twittering-status-format)) 
    406                   twittering-friends-timeline-data 
    407                   "\n")) 
     408                    (twittering-format-status status twittering-status-format)) 
     409                  twittering-friends-timeline-data 
     410                  "\n")) 
    408411      (if twittering-image-stack 
    409           (clear-image-cache)) 
     412          (clear-image-cache)) 
    410413      (setq buffer-read-only t) 
    411414      (debug-print (current-buffer)) 
     
    415418(defun twittering-format-status (status format-str) 
    416419  (flet ((attr (key) 
    417                (assocref key status)) 
    418         (profile-image 
    419           () 
    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 exist 
    425                   (if (file-exists-p (concat twittering-tmp-dir 
    426                                              "/" filename)) 
    427                       t 
    428                     (add-to-list 'twittering-image-stack profile-image-url)) 
    429  
    430                   (when (and icon-string twittering-icon-mode) 
    431                     (set-text-properties 
    432                      1 2 `(display 
    433                            (image :type ,(twittering-image-type filename) 
    434                                   :file ,(concat twittering-tmp-dir 
    435                                                 "/" 
    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                  ))))) 
    440443    (let ((cursor 0) 
    441           (result ()) 
    442           c 
    443           found-at) 
     444          (result ()) 
     445          c 
     446          found-at) 
    444447      (setq cursor 0) 
    445448      (setq result '()) 
    446449      (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 c 
    454           ((?s)                         ; %s - screen_name 
    455            (list-push (attr 'user-screen-name) result)) 
    456           ((?S)                         ; %S - name 
    457            (list-push (attr 'user-name) result)) 
    458           ((?i)                         ; %i - profile_image 
    459            (list-push (profile-image) result)) 
    460           ((?d)                         ; %d - description 
    461            (list-push (attr 'user-description) result)) 
    462           ((?l)                         ; %l - location 
    463            (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 - url 
    469            (list-push (attr 'user-url) result)) 
    470           ((?j)                         ; %j - user.id 
    471            (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-strftime 
    480                        (or (match-string-no-properties 2 format-str) "%H:%M:%S") 
    481                        (attr 'created-at)) 
    482                       result)) 
    483           ((?@)                         ; %@ - X seconds ago 
    484            (let ((created-at 
    485                   (apply 
    486                    'encode-time 
    487                    (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 - text 
    505            (list-push                   ;(clickable-text) 
    506             (attr 'text) 
    507             result)) 
    508           ((?')                         ; %' - truncated 
    509            (let ((truncated (attr 'truncated))) 
    510              (when (string= "true" truncated) 
    511                (list-push "..." result)))) 
    512           ((?f)                         ; %f - source 
    513            (list-push (attr 'source) result)) 
    514           ((?#)                         ; %# - id 
    515            (list-push (attr 'id) result)) 
    516           (t 
    517            (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        ) 
    519522      (list-push (substring format-str cursor) result) 
    520523      (apply 'concat (nreverse result)) 
     
    536539 
    537540  (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)) 
    540543    (progn 
    541544      (if (and twittering-proxy-use twittering-proxy-server) 
    542           (setq server twittering-proxy-server 
    543                 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")) 
    548551      (setq proc 
    549             (open-network-stream 
    550              "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))) 
    552555      (set-process-sentinel proc sentinel) 
    553556      (process-send-string 
    554557       proc 
    555558       (let ((nl "\r\n") 
    556              request) 
    557         (setq  request 
    558                 (concat "POST http://twitter.com/" method-class "/" method ".xml?" 
    559                         (if parameters 
    560                             (mapconcat 
    561                              (lambda (param-pair) 
    562                                (format "%s=%s" 
    563                                        (twittering-percent-encode (car param-pair)) 
    564                                        (twittering-percent-encode (cdr param-pair)))) 
    565                              parameters 
    566                              "&")) 
    567                         " HTTP/1.1" nl 
    568                         "Host: twitter.com" nl 
    569                         "User-Agent: " (twittering-user-agent) nl 
    570                         "Authorization: Basic " 
    571                         (base64-encode-string 
    572                         (concat twittering-username ":" (twittering-get-password))) 
    573                         nl 
    574                         "Content-Type: text/plain" nl 
    575                         "Content-Length: 0" nl 
    576                         (when twittering-proxy-use 
    577                           "Proxy-Connection: Keep-Alive" nl 
    578                           (when (and proxy-user proxy-password) 
    579                             (concat 
    580                              "Proxy-Authorization: Basic " 
    581                              (base64-encode-string 
    582                               (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))))) 
    588591 
    589592(defun twittering-http-post-default-sentinel (proc stat &optional suc-msg) 
     
    591594  (condition-case err-signal 
    592595      (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 status 
    598                      (("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        ) 
    602605    (error (message (prin1-to-string err-signal)))) 
    603606  ) 
     
    624627    (let ((content (buffer-string))) 
    625628      (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))) 
    629632      ))) 
    630633 
     
    636639  (let ((id (cdr (assq 'id status-datum)))) 
    637640    (if (or (null (symbol-value data-var)) 
    638             (not (find-if 
    639                   (lambda (item) 
    640                     (eql id (cdr (assq 'id item)))) 
    641                   (symbol-value data-var)))) 
    642         (progn 
    643           (if twittering-jojo-mode 
    644               (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) 
    648651      nil))) 
    649652 
    650653(defun twittering-status-to-status-datum (status) 
    651654  (flet ((assq-get (item seq) 
    652                    (car (cddr (assq item seq))))) 
     655                   (car (cddr (assq item seq))))) 
    653656    (let* ((status-data (cddr status)) 
    654            id text source created-at truncated 
    655            (user-data (cddr (assq 'user status-data))) 
    656            user-id user-name 
    657            user-screen-name 
    658            user-location 
    659            user-description 
    660            user-profile-image-url 
    661            user-url 
    662            user-protected 
    663            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) 
    664667 
    665668      (setq id (string-to-number (assq-get 'id status-data))) 
    666669      (setq text (twittering-decode-html-entities 
    667                   (assq-get 'text status-data))) 
     670                  (assq-get 'text status-data))) 
    668671      (setq source (twittering-decode-html-entities 
    669                     (assq-get 'source status-data))) 
     672                    (assq-get 'source status-data))) 
    670673      (setq created-at (assq-get 'created_at status-data)) 
    671674      (setq truncated (assq-get 'truncated status-data)) 
    672675      (setq user-id (string-to-number (assq-get 'id user-data))) 
    673676      (setq user-name (twittering-decode-html-entities 
    674                        (assq-get 'name user-data))) 
     677                       (assq-get 'name user-data))) 
    675678      (setq user-screen-name (twittering-decode-html-entities 
    676                               (assq-get 'screen_name user-data))) 
     679                              (assq-get 'screen_name user-data))) 
    677680      (setq user-location (twittering-decode-html-entities 
    678                            (assq-get 'location user-data))) 
     681                           (assq-get 'location user-data))) 
    679682      (setq user-description (twittering-decode-html-entities 
    680                               (assq-get 'description user-data))) 
     683                              (assq-get 'description user-data))) 
    681684      (setq user-profile-image-url (assq-get 'profile_image_url user-data)) 
    682685      (setq user-url (assq-get 'url user-data)) 
     
    685688      ;; make username clickable 
    686689      (add-text-properties 0 (length user-screen-name) 
    687                            `(mouse-face highlight 
    688                                         uri ,(concat "http://twitter.com/" user-screen-name) 
    689                                         username ,user-screen-name 
    690                                         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) 
    692695 
    693696      ;; make URI clickable 
    694697      (setq regex-index 0) 
    695698      (while regex-index 
    696         (setq regex-index 
    697               (string-match "@\\([_a-zA-Z0-9]+\\)\\|\\(https?://[-_.!~*'()a-zA-Z0-9;/?:@&=+$,%#]+\\)" 
    698                             text 
    699                             regex-index)) 
    700         (when regex-index 
    701           (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-properties 
    705              (if screen-name 
    706                 (+ 1 (match-beginning 0)) 
    707                (match-beginning 0)) 
    708              (match-end 0) 
    709              (if screen-name 
    710                 `(mouse-face 
    711                    highlight 
    712                    face twittering-uri-face 
    713                    username ,screen-name 
    714                    uri ,(concat "http://twitter.com/" screen-name)) 
    715                `(mouse-face highlight 
    716                             face twittering-uri-face 
    717                             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)) )) 
    720723 
    721724      ;; make screen-name clickable 
     
    723726       0 (length user-screen-name) 
    724727       `(mouse-face highlight 
    725                     face twittering-username-face 
    726                     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) 
    728731       user-screen-name) 
    729732 
    730733      ;; make source pretty and clickable 
    731734      (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-properties 
    736              0 (length source) 
    737              `(mouse-face highlight 
    738                           uri ,uri 
    739                           face twittering-uri-face 
    740                           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            )) 
    743746 
    744747      (mapcar 
    745748       (lambda (sym) 
    746         `(,sym . ,(symbol-value sym))) 
     749        `(,sym . ,(symbol-value sym))) 
    747750       '(id text source created-at truncated 
    748             user-id user-name user-screen-name user-location 
    749             user-description 
    750             user-profile-image-url 
    751             user-url 
    752             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))))) 
    753756 
    754757(defun twittering-xmltree-to-status (xmltree) 
    755758  (mapcar #'twittering-status-to-status-datum 
    756           ;; quirk to treat difference between xml.el in Emacs21 and Emacs22 
    757           ;; On Emacs22, there may be blank strings 
    758           (let ((ret nil) (statuses (reverse (cddr (car xmltree))))) 
    759             (while statuses 
    760               (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))) 
    764767 
    765768(defun twittering-percent-encode (str &optional coding-system) 
    766769  (if (or (null coding-system) 
    767           (not (coding-system-p coding-system))) 
     770          (not (coding-system-p coding-system))) 
    768771      (setq coding-system 'utf-8)) 
    769772  (mapconcat 
     
    788791  (if encoded-str 
    789792      (let ((cursor 0) 
    790             (found-at nil) 
    791             (result '())) 
    792         (while (setq found-at 
    793                      (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-entity 
    800                    (list-push 
    801                     (char-to-string 
    802                      (twittering-ucs-to-char 
    803                       (string-to-number number-entity))) result)) 
    804                   (letter-entity 
    805                    (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))) 
    812815    "")) 
    813816 
     
    815818  (let ((buf (get-buffer twittering-buffer))) 
    816819    (if (null buf) 
    817         (twittering-stop) 
     820        (twittering-stop) 
    818821      (funcall func) 
    819822      ))) 
     
    823826      nil 
    824827    (twittering-http-post "statuses" "update" 
    825                           `(("status" . ,status) 
    826                             ("source" . "twmode"))) 
     828                          `(("status" . ,status) 
     829                            ("source" . "twmode"))) 
    827830    t)) 
    828831 
     
    833836      (setq status (read-from-minibuffer "status: " status nil nil nil nil t)) 
    834837      (setq not-posted-p 
    835             (not (twittering-update-status-if-not-blank status)))))) 
     838            (not (twittering-update-status-if-not-blank status)))))) 
    836839 
    837840(defun twittering-update-lambda () 
     
    844847(defun twittering-update-jojo (usr msg) 
    845848  (if (string-match "\xde21\xd24b\\(\xd22a\xe0b0\\|\xdaae\xe6cd\\)\xd24f\xd0d6\\([^\xd0d7]+\\)\xd0d7\xd248\xdc40\xd226" 
    846                     msg) 
     849                    msg) 
    847850      (twittering-http-post 
    848851       "statuses" "update" 
    849852       `(("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"))))) 
    854857 
    855858;;; 
     
    864867      nil 
    865868    (setq twittering-timer 
    866           (run-at-time "0 sec" 
    867                        twittering-timer-interval 
    868                        #'twittering-timer-action action)))) 
     869          (run-at-time "0 sec" 
     870                       twittering-timer-interval 
     871                       #'twittering-timer-action action)))) 
    869872 
    870873(defun twittering-stop () 
     
    877880  (let ((buf (get-buffer twittering-buffer))) 
    878881    (if (not buf) 
    879         (twittering-stop) 
     882        (twittering-stop) 
    880883      (twittering-http-get "statuses" "friends_timeline") 
    881884      )) 
     
    883886  (if twittering-icon-mode 
    884887      (if twittering-image-stack 
    885           (let ((proc 
    886                 (apply 
    887                   #'start-process 
    888                   "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-sentinel 
    896              proc 
    897              (lambda (proc stat) 
    898                (clear-image-cache) 
    899                (save-excursion 
    900                 (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                ))))))) 
    902905 
    903906(defun twittering-update-status-interactive () 
     
    914917  (let ((uri (get-text-property (point) 'uri))) 
    915918    (if uri 
    916         (browse-url uri)))) 
     919        (browse-url uri)))) 
    917920 
    918921(defun twittering-enter () 
    919922  (interactive) 
    920923  (let ((username (get-text-property (point) 'username)) 
    921         (uri (get-text-property (point) 'uri))) 
     924        (uri (get-text-property (point) 'uri))) 
    922925    (if username 
    923         (twittering-update-status-from-minibuffer (concat "@" username " ")) 
     926        (twittering-update-status-from-minibuffer (concat "@" username " ")) 
    924927      (if uri 
    925           (browse-url uri))))) 
     928          (browse-url uri))))) 
    926929 
    927930(defun twittering-view-user-page () 
     
    929932  (let ((uri (get-text-property (point) 'uri))) 
    930933    (if uri 
    931         (browse-url uri)))) 
     934        (browse-url uri)))) 
    932935 
    933936(defun twittering-reply-to-user () 
     
    935938  (let ((username (get-text-property (point) 'username))) 
    936939    (if username 
    937         (twittering-update-status-from-minibuffer (concat "@" username " "))))) 
     940        (twittering-update-status-from-minibuffer (concat "@" username " "))))) 
    938941 
    939942(defun twittering-get-password () 
     
    946949  (let ((pos)) 
    947950    (setq pos (twittering-get-next-username-face-pos (point))) 
    948     (when pos 
    949       (goto-char pos)))) 
     951    (if pos 
     952        (goto-char pos) 
     953      (message "End of status.")))) 
    950954 
    951955(defun twittering-get-next-username-face-pos (pos) 
    952956  (interactive) 
    953957  (let ((prop)) 
    954     (while (not (eq prop twittering-username-face)) 
    955       (setq pos (next-single-property-change pos 'face)) 
    956       (setq prop (get-text-property pos 'face))) 
     958    (catch 'not-found 
     959      (while (and pos (not (eq prop twittering-username-face))) 
     960        (setq pos (next-single-property-change pos 'face)) 
     961        (when (eq pos nil) (throw 'not-found 0)) 
     962        (setq prop (get-text-property pos 'face)))) 
    957963    pos)) 
    958964 
     
    962968  (let ((pos)) 
    963969    (setq pos (twittering-get-previous-username-face-pos (point))) 
    964     (when pos 
    965       (goto-char pos)))) 
     970    (if pos 
     971        (goto-char pos) 
     972      (message "Start of status.")))) 
    966973 
    967974(defun twittering-get-previous-username-face-pos (pos) 
    968975  (interactive) 
    969976  (let ((prop)) 
    970     (while (not (eq prop twittering-username-face)) 
    971       (setq pos (previous-single-property-change pos 'face)) 
    972       (setq prop (get-text-property pos 'face))) 
     977    (catch 'not-found 
     978      (while (and pos (not (eq prop twittering-username-face))) 
     979        (setq pos (previous-single-property-change pos 'face)) 
     980        (when (eq pos nil) (throw 'not-found 0)) 
     981        (setq prop (get-text-property pos 'face)))) 
    973982    pos)) 
    974983 
     
    977986  (interactive) 
    978987  (let ((user-name (twittering-get-username-at-pos (point))) 
    979         (pos (twittering-get-next-username-face-pos (point)))) 
    980     (while (not (equal (twittering-get-username-at-pos pos) user-name)) 
    981       (setq pos (twittering-get-next-username-face-pos pos))) 
    982     (goto-char pos))) 
     988        (pos (twittering-get-next-username-face-pos (point)))) 
     989    (catch 'not-found 
     990      (while (not (equal (twittering-get-username-at-pos pos) user-name)) 
     991        (setq pos (twittering-get-next-username-face-pos pos)) 
     992        (when (eq pos nil) (throw 'not-found 0)))) 
     993    (if pos 
     994        (goto-char pos) 
     995      (message "End of %s's status." user-name)))) 
    983996 
    984997(defun twittering-goto-previous-status-of-user () 
     
    986999  (interactive) 
    9871000  (let ((user-name (twittering-get-username-at-pos (point))) 
    988         (pos (twittering-get-previous-username-face-pos (point)))) 
    989     (while (not (equal (twittering-get-username-at-pos pos) user-name)) 
    990       (setq pos (twittering-get-previous-username-face-pos pos))) 
    991     (goto-char pos))) 
     1001        (pos (twittering-get-previous-username-face-pos (point)))) 
     1002    (catch 'not-found 
     1003      (while (not (equal (twittering-get-username-at-pos pos) user-name)) 
     1004        (setq pos (twittering-get-previous-username-face-pos pos)) 
     1005        (when (eq pos nil) (throw 'not-found 0)))) 
     1006    (if pos 
     1007        (goto-char pos) 
     1008      (message "Start of %s's status." user-name)))) 
    9921009 
    9931010(defun twittering-get-username-at-pos (pos) 
    9941011  (let ((start-pos pos) 
    995         (end-pos)) 
     1012        (end-pos)) 
    9961013    (while (eq (get-text-property start-pos 'face) twittering-username-face) 
    9971014      (setq start-pos (1- start-pos))) 
     
    10001017    (buffer-substring start-pos end-pos))) 
    10011018 
     1019;;;###autoload 
     1020(defun twit () 
     1021  "Start twittering-mode." 
     1022  (interactive) 
     1023  (twittering-mode)) 
     1024 
    10021025(provide 'twittering-mode) 
    10031026;;; twittering.el ends here