Changeset 28 for lang/elisp

Show
Ignore:
Timestamp:
04/25/08 08:18:06 (17 years ago)
Author:
gan2
Message:

RB-0.3 を gan2 にコピー

Location:
lang/elisp/twittering-mode/branches/gan2
Files:
1 added
2 modified
1 copied

Legend:

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

    r25 r28  
     12008-04-25  gan2  <gan2.ruby@gmail.com> 
     2 
     3        * twittering-mode.el: next-line や previous-line は C-n や C-p でできるので j, k を隣接したメッセージの移動に変更 
     4        (twittering-next-message): 次のメッセージにジャンプする関数を定義 
     5        (twittering-next-username-face-pos): twittering-next-message が呼び出す関数を定義 
     6        (twittering-previous-message): 前のメッセージにジャンプする関数を定義 
     7        (twittering-previous-username-face-pos): twittering-previous-message が呼び出す関数を定義 
     8        (twittering-mode-map): j, k で次のメッセージと前のメッセージに移動するように変更 
     9 
     102008-04-23  gan2  <gan2.ruby@gmail.com> 
     11 
     12        * twittering-mode.el : RB-0.3 を gan2 にコピー. ソフトタブに統一 
     13        (twittering-mode-version): バージョンを表示する関数を定義 
     14 
    1152008-03-15  Y. Hayamizu  <haya@haya-laptop-ubuntu> 
    216 
  • lang/elisp/twittering-mode/branches/gan2/twittering-mode.el

    r25 r28  
    4848(defconst twittering-mode-version "0.3") 
    4949 
     50(defun twittering-mode-version () 
     51  "Display a message for twittering-mode version." 
     52  (interactive) 
     53  (let ((version-string 
     54         (format "twittering-mode-v%s" twittering-mode-version))) 
     55    (if (interactive-p) 
     56        (message "%s" version-string) 
     57      version-string))) 
     58 
    5059(defvar twittering-mode-map (make-sparse-keymap)) 
    5160 
     
    6675(defvar twittering-status-format nil) 
    6776(setq twittering-status-format "%i %s,  %@:\n  %t // from %f%L") 
    68 ; %s - screen_name 
    69 ; %S - name 
    70 ; %i - profile_image 
    71 ; %d - description 
    72 ; %l - location 
    73 ; %L - " [location]" 
    74 ; %u - url 
    75 ; %j - user.id 
    76 ; %p - protected? 
    77 ; %c - created_at (raw UTC string) 
    78 ; %C{time-format-str} - created_at (formatted with time-format-str) 
    79 ; %@ - X seconds ago 
    80 ; %t - text 
    81 ; %' - truncated 
    82 ; %f - source 
    83 ; %# - id 
     77;; %s - screen_name 
     78;; %S - name 
     79;; %i - profile_image 
     80;; %d - description 
     81;; %l - location 
     82;; %L - " [location]" 
     83;; %u - url 
     84;; %j - user.id 
     85;; %p - protected? 
     86;; %c - created_at (raw UTC string) 
     87;; %C{time-format-str} - created_at (formatted with time-format-str) 
     88;; %@ - X seconds ago 
     89;; %t - text 
     90;; %' - truncated 
     91;; %f - source 
     92;; %# - id 
    8493 
    8594(defvar twittering-buffer "*twittering*") 
     
    99108  (if (bufferp buffer) 
    100109      (if (buffer-live-p buffer) 
    101           buffer 
    102         (generate-new-buffer (buffer-name buffer))) 
     110          buffer 
     111        (generate-new-buffer (buffer-name buffer))) 
    103112    (if (stringp buffer) 
    104         (or (get-buffer buffer) 
    105             (generate-new-buffer buffer))))) 
     113        (or (get-buffer buffer) 
     114            (generate-new-buffer buffer))))) 
    106115 
    107116(defun assocref (item alist) 
     
    120129  (interactive) 
    121130  (setq twittering-proxy-use 
    122         (not twittering-proxy-use)) 
     131        (not twittering-proxy-use)) 
    123132  (message "%s %s" 
    124            "Use Proxy:" 
    125            (if twittering-proxy-use 
    126                "on" "off"))) 
     133           "Use Proxy:" 
     134           (if twittering-proxy-use 
     135               "on" "off"))) 
    127136 
    128137(defun twittering-user-agent-default-function () 
    129138  "Twittering mode default User-Agent function." 
    130139  (concat "Emacs/" 
    131           (int-to-string emacs-major-version) "." (int-to-string 
    132                                                    emacs-minor-version) 
    133           " " 
    134           "Twittering-mode/" 
    135           twittering-mode-version)) 
     140          (int-to-string emacs-major-version) "." (int-to-string 
     141                                                   emacs-minor-version) 
     142          " " 
     143          "Twittering-mode/" 
     144          twittering-mode-version)) 
    136145 
    137146(defvar twittering-user-agent-function 'twittering-user-agent-default-function) 
     
    149158(defvar twittering-tmp-dir 
    150159  (expand-file-name (concat "twmode-images-" (user-login-name)) 
    151                     temporary-file-directory)) 
     160                    temporary-file-directory)) 
    152161 
    153162(defvar twittering-icon-mode nil "You MUST NOT CHANGE this variable directory. You should change through function'twittering-icon-mode'") 
     
    155164  (interactive) 
    156165  (setq twittering-icon-mode 
    157         (if twittering-icon-mode 
    158             (if (null arg) 
    159                 nil 
    160               (> (prefix-numeric-value arg) 0)) 
    161           (when (or (null arg) 
    162                     (and arg (> (prefix-numeric-value arg) 0))) 
    163             (when (file-writable-p twittering-tmp-dir) 
    164               (progn 
    165                 (if (not (file-directory-p twittering-tmp-dir)) 
    166                     (make-directory twittering-tmp-dir)) 
    167                 t))))) 
     166        (if twittering-icon-mode 
     167            (if (null arg) 
     168                nil 
     169              (> (prefix-numeric-value arg) 0)) 
     170          (when (or (null arg) 
     171                    (and arg (> (prefix-numeric-value arg) 0))) 
     172            (when (file-writable-p twittering-tmp-dir) 
     173              (progn 
     174                (if (not (file-directory-p twittering-tmp-dir)) 
     175                    (make-directory twittering-tmp-dir)) 
     176                t))))) 
    168177  (twittering-render-friends-timeline)) 
    169178 
     
    171180  (interactive) 
    172181  (setq twittering-scroll-mode 
    173         (if (null arg) 
    174             (not twittering-scroll-mode) 
    175           (> (prefix-numeric-value arg) 0)))) 
     182        (if (null arg) 
     183            (not twittering-scroll-mode) 
     184          (> (prefix-numeric-value arg) 0)))) 
    176185 
    177186(defun twittering-jojo-mode (&optional arg) 
    178187  (interactive) 
    179188  (setq twittering-jojo-mode 
    180         (if (null arg) 
    181             (not twittering-jojo-mode) 
    182           (> (prefix-numeric-value arg) 0)))) 
     189        (if (null arg) 
     190            (not twittering-jojo-mode) 
     191          (> (prefix-numeric-value arg) 0)))) 
    183192 
    184193(defvar twittering-image-stack nil) 
     
    193202(defun twittering-local-strftime (fmt string) 
    194203  (format-time-string fmt ; like "%Y-%m-%d %H:%M:%S", shown in localtime 
    195                       (apply 'encode-time (parse-time-string string)))) 
     204                      (apply 'encode-time (parse-time-string string)))) 
    196205 
    197206(defvar twittering-debug-mode nil) 
     
    203212    `(let ((,obsym ,obj)) 
    204213       (if twittering-debug-mode 
    205            (with-current-buffer (twittering-debug-buffer) 
    206              (insert (prin1-to-string ,obsym)) 
    207              (newline) 
    208              ,obsym) 
    209         ,obsym)))) 
     214           (with-current-buffer (twittering-debug-buffer) 
     215             (insert (prin1-to-string ,obsym)) 
     216             (newline) 
     217             ,obsym) 
     218        ,obsym)))) 
    210219 
    211220(defun twittering-debug-mode () 
    212221  (interactive) 
    213222  (setq twittering-debug-mode 
    214         (not twittering-debug-mode)) 
     223        (not twittering-debug-mode)) 
    215224  (message (if twittering-debug-mode "debug mode:on" "debug mode:off"))) 
    216225 
     
    224233      (define-key km [mouse-1] 'twittering-click) 
    225234      (define-key km "\C-c\C-v" 'twittering-view-user-page) 
    226       (define-key km "j" 'next-line) 
    227       (define-key km "k" 'previous-line) 
     235      ;; (define-key km "j" 'next-line) 
     236      ;; (define-key km "k" 'previous-line) 
     237      (define-key km "j" 'twittering-next-message) 
     238      (define-key km "k" 'twittering-previous-message) 
    228239      (define-key km "l" 'forward-char) 
    229240      (define-key km "h" 'backward-char) 
     
    242253    () 
    243254  (setq twittering-mode-syntax-table (make-syntax-table)) 
    244   ;  (modify-syntax-entry ?  "" twittering-mode-syntax-table) 
     255  ;; (modify-syntax-entry ?  "" twittering-mode-syntax-table) 
    245256  (modify-syntax-entry ?\" "w"  twittering-mode-syntax-table) 
    246257  ) 
    247258 
    248259(defun twittering-mode-init-variables () 
    249   ;(make-variable-buffer-local 'variable) 
    250   ;(setq variable nil) 
     260  ;; (make-variable-buffer-local 'variable) 
     261  ;; (setq variable nil) 
    251262  (font-lock-mode -1) 
    252263  (defface twittering-username-face 
     
    266277    ,@(mapcar 
    267278       (lambda (clause) 
    268         (let ((keylist (car clause)) 
    269                (body (cdr clause))) 
    270            `(,(if (listp keylist) 
    271                   `(or ,@(mapcar (lambda (key) `(string-equal ,str ,key)) keylist)) 
    272                 't) 
    273              ,@body))) 
     279        (let ((keylist (car clause)) 
     280               (body (cdr clause))) 
     281           `(,(if (listp keylist) 
     282                  `(or ,@(mapcar (lambda (key) `(string-equal ,str ,key)) keylist)) 
     283                't) 
     284             ,@body))) 
    274285       clauses))) 
    275286 
     
    311322 
    312323  (let (proc server port 
    313              (proxy-user twittering-proxy-user) 
    314              (proxy-password twittering-proxy-password)) 
     324             (proxy-user twittering-proxy-user) 
     325             (proxy-password twittering-proxy-password)) 
    315326    (condition-case nil 
    316         (progn 
    317           (if (and twittering-proxy-use twittering-proxy-server) 
    318               (setq server twittering-proxy-server 
    319                     port (if (integerp twittering-proxy-port) 
    320                              (int-to-string twittering-proxy-port) 
    321                            twittering-proxy-port)) 
    322             (setq server "twitter.com" 
    323                   port "80")) 
    324           (setq proc 
    325                 (open-network-stream 
    326                 "network-connection-process" (twittering-http-buffer) 
    327                 server (string-to-number port))) 
    328           (set-process-sentinel proc sentinel) 
    329           (process-send-string 
    330            proc 
    331            (let ((nl "\r\n") 
    332                 request) 
    333              (setq request 
    334                    (concat "GET http://twitter.com/" method-class "/" method ".xml HTTP/1.1" nl 
    335                            "Host: twitter.com" nl 
    336                            "User-Agent: " (twittering-user-agent) nl 
    337                            "Authorization: Basic " 
    338                            (base64-encode-string 
    339                             (concat twittering-username ":" (twittering-get-password))) 
    340                            nl 
    341                            "Accept: text/xml" 
    342                            ",application/xml" 
    343                            ",application/xhtml+xml" 
    344                            ",application/html;q=0.9" 
    345                            ",text/plain;q=0.8" 
    346                            ",image/png,*/*;q=0.5" nl 
    347                            "Accept-Charset: utf-8;q=0.7,*;q=0.7" nl 
    348                            (when twittering-proxy-use 
    349                              "Proxy-Connection: Keep-Alive" nl 
    350                              (when (and proxy-user proxy-password) 
    351                                (concat 
    352                                 "Proxy-Authorization: Basic " 
    353                                 (base64-encode-string 
    354                                 (concat proxy-user ":" 
    355                                         proxy-password)) 
    356                                 nl))) 
    357                            nl nl)) 
    358              (debug-print (concat "GET Request\n" request)) 
    359              request))) 
     327        (progn 
     328          (if (and twittering-proxy-use twittering-proxy-server) 
     329              (setq server twittering-proxy-server 
     330                    port (if (integerp twittering-proxy-port) 
     331                             (int-to-string twittering-proxy-port) 
     332                           twittering-proxy-port)) 
     333            (setq server "twitter.com" 
     334                  port "80")) 
     335          (setq proc 
     336                (open-network-stream 
     337                "network-connection-process" (twittering-http-buffer) 
     338                server (string-to-number port))) 
     339          (set-process-sentinel proc sentinel) 
     340          (process-send-string 
     341           proc 
     342           (let ((nl "\r\n") 
     343                request) 
     344             (setq request 
     345                   (concat "GET http://twitter.com/" method-class "/" method ".xml HTTP/1.1" nl 
     346                           "Host: twitter.com" nl 
     347                           "User-Agent: " (twittering-user-agent) nl 
     348                           "Authorization: Basic " 
     349                           (base64-encode-string 
     350                            (concat twittering-username ":" (twittering-get-password))) 
     351                           nl 
     352                           "Accept: text/xml" 
     353                           ",application/xml" 
     354                           ",application/xhtml+xml" 
     355                           ",application/html;q=0.9" 
     356                           ",text/plain;q=0.8" 
     357                           ",image/png,*/*;q=0.5" nl 
     358                           "Accept-Charset: utf-8;q=0.7,*;q=0.7" nl 
     359                           (when twittering-proxy-use 
     360                             "Proxy-Connection: Keep-Alive" nl 
     361                             (when (and proxy-user proxy-password) 
     362                               (concat 
     363                                "Proxy-Authorization: Basic " 
     364                                (base64-encode-string 
     365                                (concat proxy-user ":" 
     366                                        proxy-password)) 
     367                                nl))) 
     368                           nl nl)) 
     369             (debug-print (concat "GET Request\n" request)) 
     370             request))) 
    360371      (error 
    361372       (message "Failure: HTTP GET") nil)))) 
     
    363374(defun twittering-http-get-default-sentinel (proc stat &optional suc-msg) 
    364375  (let ((header (twittering-get-response-header)) 
    365         (body (twittering-get-response-body)) 
    366         (status nil) 
    367         ) 
     376        (body (twittering-get-response-body)) 
     377        (status nil) 
     378        ) 
    368379    (if (string-match "HTTP/1\.[01] \\([a-z0-9 ]+\\)\r?\n" header) 
    369         (progn 
    370           (setq status (match-string-no-properties 1 header)) 
    371           (case-string 
    372            status 
    373            (("200 OK") 
    374             (mapcar 
    375              #'twittering-cache-status-datum 
    376              (reverse (twittering-xmltree-to-status 
    377                        body))) 
    378             (twittering-render-friends-timeline) 
    379             (message (if suc-msg suc-msg "Success: Get."))) 
    380            (t (message status)))) 
     380        (progn 
     381          (setq status (match-string-no-properties 1 header)) 
     382          (case-string 
     383           status 
     384           (("200 OK") 
     385            (mapcar 
     386             #'twittering-cache-status-datum 
     387             (reverse (twittering-xmltree-to-status 
     388                       body))) 
     389            (twittering-render-friends-timeline) 
     390            (message (if suc-msg suc-msg "Success: Get."))) 
     391           (t (message status)))) 
    381392      (message "Failure: Bad http response."))) 
    382393  ) 
     
    385396  (with-current-buffer (twittering-buffer) 
    386397    (let ((point (point)) 
    387           (end (point-max))) 
     398          (end (point-max))) 
    388399      (setq buffer-read-only nil) 
    389400      (erase-buffer) 
    390401      (insert 
    391402       (mapconcat (lambda (status) 
    392                     (twittering-format-status status twittering-status-format)) 
    393                   twittering-friends-timeline-data 
    394                   "\n")) 
     403                    (twittering-format-status status twittering-status-format)) 
     404                  twittering-friends-timeline-data 
     405                  "\n")) 
    395406      (if twittering-image-stack 
    396           (clear-image-cache)) 
     407          (clear-image-cache)) 
    397408      (setq buffer-read-only t) 
    398409      (debug-print (current-buffer)) 
     
    402413(defun twittering-format-status (status format-str) 
    403414  (flet ((attr (key) 
    404                (assocref key status)) 
    405         (profile-image 
    406           () 
    407           (let ((profile-image-url (attr 'user-profile-image-url)) 
    408                 (icon-string "\n  ")) 
    409             (if (string-match "/\\([^/?]+\\)\\(?:\\?\\|$\\)" profile-image-url) 
    410                 (let ((filename (match-string-no-properties 1 profile-image-url))) 
    411                   ;; download icons if does not exist 
    412                   (if (file-exists-p (concat twittering-tmp-dir 
    413                                              "/" filename)) 
    414                       t 
    415                     (add-to-list 'twittering-image-stack profile-image-url)) 
    416  
    417                   (when (and icon-string twittering-icon-mode) 
    418                     (set-text-properties 
    419                      1 2 `(display 
    420                            (image :type ,(twittering-image-type filename) 
    421                                   :file ,(concat twittering-tmp-dir 
    422                                                 "/" 
    423                                                 filename))) 
    424                      icon-string) 
    425                     icon-string) 
    426                   ))))) 
     415               (assocref key status)) 
     416        (profile-image 
     417          () 
     418          (let ((profile-image-url (attr 'user-profile-image-url)) 
     419                (icon-string "\n  ")) 
     420            (if (string-match "/\\([^/?]+\\)\\(?:\\?\\|$\\)" profile-image-url) 
     421                (let ((filename (match-string-no-properties 1 profile-image-url))) 
     422                  ;; download icons if does not exist 
     423                  (if (file-exists-p (concat twittering-tmp-dir 
     424                                             "/" filename)) 
     425                      t 
     426                    (add-to-list 'twittering-image-stack profile-image-url)) 
     427 
     428                  (when (and icon-string twittering-icon-mode) 
     429                    (set-text-properties 
     430                     1 2 `(display 
     431                           (image :type ,(twittering-image-type filename) 
     432                                  :file ,(concat twittering-tmp-dir 
     433                                                "/" 
     434                                                filename))) 
     435                     icon-string) 
     436                    icon-string) 
     437                  ))))) 
    427438    (let ((cursor 0) 
    428           (result ()) 
    429           c 
    430           found-at) 
     439          (result ()) 
     440          c 
     441          found-at) 
    431442      (setq cursor 0) 
    432443      (setq result '()) 
    433444      (while (setq found-at (string-match "%\\(C{\\([^}]+\\)}\\|[A-Za-z#@']\\)" format-str cursor)) 
    434         (setq c (string-to-char (match-string-no-properties 1 format-str))) 
    435         (if (> found-at cursor) 
    436             (list-push (substring format-str cursor found-at) result) 
    437           "|") 
    438         (setq cursor (match-end 1)) 
    439  
    440         (case c 
    441           ((?s)                         ; %s - screen_name 
    442            (list-push (attr 'user-screen-name) result)) 
    443           ((?S)                         ; %S - name 
    444            (list-push (attr 'user-name) result)) 
    445           ((?i)                         ; %i - profile_image 
    446            (list-push (profile-image) result)) 
    447           ((?d)                         ; %d - description 
    448            (list-push (attr 'user-description) result)) 
    449           ((?l)                         ; %l - location 
    450            (list-push (attr 'user-location) result)) 
    451           ((?L)                         ; %L - " [location]" 
    452            (let ((location (attr 'user-location))) 
    453              (unless (or (null location) (string= "" location)) 
    454                (list-push (concat " [" location "]") result)) )) 
    455           ((?u)                         ; %u - url 
    456            (list-push (attr 'user-url) result)) 
    457           ((?j)                         ; %j - user.id 
    458            (list-push (attr 'user-id) result)) 
    459           ((?p)                         ; %p - protected? 
    460            (let ((protected (attr 'user-protected))) 
    461              (when (string= "true" protected) 
    462                (list-push "[x]" result)))) 
    463           ((?c)                     ; %c - created_at (raw UTC string) 
    464            (list-push (attr 'created-at) result)) 
    465           ((?C) ; %C{time-format-str} - created_at (formatted with time-format-str) 
    466            (list-push (twittering-local-strftime 
    467                   (or (match-string-no-properties 2 format-str) "%H:%M:%S") 
    468                   (attr 'created-at)) 
    469                 result)) 
    470           ((?@)                         ; %@ - X seconds ago 
    471            (let ((created-at 
    472                   (apply 
    473                    'encode-time 
    474                    (parse-time-string (attr 'created-at)))) 
    475                 (now (current-time))) 
    476              (let ((secs (+ (* (- (car now) (car created-at)) 65536) 
    477                             (- (cadr now) (cadr created-at))))) 
    478                (list-push (cond ((< secs 5) "less than 5 seconds ago") 
    479                            ((< secs 10) "less than 10 seconds ago") 
    480                            ((< secs 20) "less than 20 seconds ago") 
    481                            ((< secs 30) "half a minute ago") 
    482                            ((< secs 60) "less than a minute ago") 
    483                            ((< secs 150) "1 minute ago") 
    484                            ((< secs 2400) (format "%d minutes ago" 
    485                                                   (/ (+ secs 30) 60))) 
    486                            ((< secs 5400) "about 1 hour ago") 
    487                            ((< secs 84600) (format "about %d hours ago" 
    488                                                    (/ (+ secs 1800) 3600))) 
    489                            (t (format-time-string "%I:%M %p %B %d, %Y" created-at))) 
    490                      result)))) 
    491           ((?t)                         ; %t - text 
    492            (list-push                   ;(clickable-text) 
    493             (attr 'text) 
    494             result)) 
    495           ((?')                         ; %' - truncated 
    496            (let ((truncated (attr 'truncated))) 
    497              (when (string= "true" truncated) 
    498                (list-push "..." result)))) 
    499           ((?f)                         ; %f - source 
    500            (list-push (attr 'source) result)) 
    501           ((?#)                         ; %# - id 
    502            (list-push (attr 'id) result)) 
    503           (t 
    504            (list-push (char-to-string c) result))) 
    505         ) 
     445        (setq c (string-to-char (match-string-no-properties 1 format-str))) 
     446        (if (> found-at cursor) 
     447            (list-push (substring format-str cursor found-at) result) 
     448          "|") 
     449        (setq cursor (match-end 1)) 
     450 
     451        (case c 
     452          ((?s)                         ; %s - screen_name 
     453           (list-push (attr 'user-screen-name) result)) 
     454          ((?S)                         ; %S - name 
     455           (list-push (attr 'user-name) result)) 
     456          ((?i)                         ; %i - profile_image 
     457           (list-push (profile-image) result)) 
     458          ((?d)                         ; %d - description 
     459           (list-push (attr 'user-description) result)) 
     460          ((?l)                         ; %l - location 
     461           (list-push (attr 'user-location) result)) 
     462          ((?L)                         ; %L - " [location]" 
     463           (let ((location (attr 'user-location))) 
     464             (unless (or (null location) (string= "" location)) 
     465               (list-push (concat " [" location "]") result)) )) 
     466          ((?u)                         ; %u - url 
     467           (list-push (attr 'user-url) result)) 
     468          ((?j)                         ; %j - user.id 
     469           (list-push (attr 'user-id) result)) 
     470          ((?p)                         ; %p - protected? 
     471           (let ((protected (attr 'user-protected))) 
     472             (when (string= "true" protected) 
     473               (list-push "[x]" result)))) 
     474          ((?c)                     ; %c - created_at (raw UTC string) 
     475           (list-push (attr 'created-at) result)) 
     476          ((?C) ; %C{time-format-str} - created_at (formatted with time-format-str) 
     477           (list-push (twittering-local-strftime 
     478                       (or (match-string-no-properties 2 format-str) "%H:%M:%S") 
     479                       (attr 'created-at)) 
     480                      result)) 
     481          ((?@)                         ; %@ - X seconds ago 
     482           (let ((created-at 
     483                  (apply 
     484                   'encode-time 
     485                   (parse-time-string (attr 'created-at)))) 
     486                (now (current-time))) 
     487             (let ((secs (+ (* (- (car now) (car created-at)) 65536) 
     488                            (- (cadr now) (cadr created-at))))) 
     489               (list-push (cond ((< secs 5) "less than 5 seconds ago") 
     490                                ((< secs 10) "less than 10 seconds ago") 
     491                                ((< secs 20) "less than 20 seconds ago") 
     492                                ((< secs 30) "half a minute ago") 
     493                                ((< secs 60) "less than a minute ago") 
     494                                ((< secs 150) "1 minute ago") 
     495                                ((< secs 2400) (format "%d minutes ago" 
     496                                                       (/ (+ secs 30) 60))) 
     497                                ((< secs 5400) "about 1 hour ago") 
     498                                ((< secs 84600) (format "about %d hours ago" 
     499                                                        (/ (+ secs 1800) 3600))) 
     500                                (t (format-time-string "%I:%M %p %B %d, %Y" created-at))) 
     501                          result)))) 
     502          ((?t)                         ; %t - text 
     503           (list-push                   ;(clickable-text) 
     504            (attr 'text) 
     505            result)) 
     506          ((?')                         ; %' - truncated 
     507           (let ((truncated (attr 'truncated))) 
     508             (when (string= "true" truncated) 
     509               (list-push "..." result)))) 
     510          ((?f)                         ; %f - source 
     511           (list-push (attr 'source) result)) 
     512          ((?#)                         ; %# - id 
     513           (list-push (attr 'id) result)) 
     514          (t 
     515           (list-push (char-to-string c) result))) 
     516        ) 
    506517      (list-push (substring format-str cursor) result) 
    507518      (apply 'concat (nreverse result)) 
     
    523534 
    524535  (let (proc server port 
    525              (proxy-user twittering-proxy-user) 
    526              (proxy-password twittering-proxy-password)) 
     536             (proxy-user twittering-proxy-user) 
     537             (proxy-password twittering-proxy-password)) 
    527538    (progn 
    528539      (if (and twittering-proxy-use twittering-proxy-server) 
    529           (setq server twittering-proxy-server 
    530                 port (if (integerp twittering-proxy-port) 
    531                         (int-to-string twittering-proxy-port) 
    532                        twittering-proxy-port)) 
    533         (setq server "twitter.com" 
    534               port "80")) 
     540          (setq server twittering-proxy-server 
     541                port (if (integerp twittering-proxy-port) 
     542                        (int-to-string twittering-proxy-port) 
     543                       twittering-proxy-port)) 
     544        (setq server "twitter.com" 
     545              port "80")) 
    535546      (setq proc 
    536             (open-network-stream 
    537              "network-connection-process" (twittering-http-buffer) 
    538              server (string-to-number port))) 
     547            (open-network-stream 
     548             "network-connection-process" (twittering-http-buffer) 
     549             server (string-to-number port))) 
    539550      (set-process-sentinel proc sentinel) 
    540551      (process-send-string 
    541552       proc 
    542553       (let ((nl "\r\n") 
    543              request) 
    544          (setq  request 
    545                 (concat "POST http://twitter.com/" method-class "/" method ".xml?" 
    546                         (if parameters 
    547                             (mapconcat 
    548                              (lambda (param-pair) 
    549                                (format "%s=%s" 
    550                                        (twittering-percent-encode (car param-pair)) 
    551                                        (twittering-percent-encode (cdr param-pair)))) 
    552                              parameters 
    553                              "&")) 
    554                         " HTTP/1.1" nl 
    555                         "Host: twitter.com" nl 
    556                         "User-Agent: " (twittering-user-agent) nl 
    557                         "Authorization: Basic " 
    558                         (base64-encode-string 
    559                         (concat twittering-username ":" (twittering-get-password))) 
    560                         nl 
    561                         "Content-Type: text/plain" nl 
    562                         "Content-Length: 0" nl 
    563                         (when twittering-proxy-use 
    564                           "Proxy-Connection: Keep-Alive" nl 
    565                           (when (and proxy-user proxy-password) 
    566                             (concat 
    567                              "Proxy-Authorization: Basic " 
    568                              (base64-encode-string 
    569                               (concat proxy-user ":" 
    570                                       proxy-password)) 
    571                              nl))) 
    572                         nl nl)) 
    573         (debug-print (concat "POST Request\n" request)) 
    574         request))))) 
     554             request) 
     555         (setq  request 
     556                (concat "POST http://twitter.com/" method-class "/" method ".xml?" 
     557                        (if parameters 
     558                            (mapconcat 
     559                             (lambda (param-pair) 
     560                               (format "%s=%s" 
     561                                       (twittering-percent-encode (car param-pair)) 
     562                                       (twittering-percent-encode (cdr param-pair)))) 
     563                             parameters 
     564                             "&")) 
     565                        " HTTP/1.1" nl 
     566                        "Host: twitter.com" nl 
     567                        "User-Agent: " (twittering-user-agent) nl 
     568                        "Authorization: Basic " 
     569                        (base64-encode-string 
     570                        (concat twittering-username ":" (twittering-get-password))) 
     571                        nl 
     572                        "Content-Type: text/plain" nl 
     573                        "Content-Length: 0" nl 
     574                        (when twittering-proxy-use 
     575                          "Proxy-Connection: Keep-Alive" nl 
     576                          (when (and proxy-user proxy-password) 
     577                            (concat 
     578                             "Proxy-Authorization: Basic " 
     579                             (base64-encode-string 
     580                              (concat proxy-user ":" 
     581                                      proxy-password)) 
     582                             nl))) 
     583                        nl nl)) 
     584        (debug-print (concat "POST Request\n" request)) 
     585        request))))) 
    575586 
    576587(defun twittering-http-post-default-sentinel (proc stat &optional suc-msg) 
     
    578589  (condition-case err-signal 
    579590      (let ((header (twittering-get-response-header)) 
    580             ; (body (twittering-get-response-body)) not used now. 
    581             (status nil)) 
    582         (string-match "HTTP/1\.1 \\([a-z0-9 ]+\\)\r?\n" header) 
    583         (setq status (match-string-no-properties 1 header)) 
    584         (case-string status 
    585                      (("200 OK") 
    586                       (message (if suc-msg suc-msg "Success: Post"))) 
    587                      (t (message status))) 
    588         ) 
     591            ;; (body (twittering-get-response-body)) not used now. 
     592            (status nil)) 
     593        (string-match "HTTP/1\.1 \\([a-z0-9 ]+\\)\r?\n" header) 
     594        (setq status (match-string-no-properties 1 header)) 
     595        (case-string status 
     596                     (("200 OK") 
     597                      (message (if suc-msg suc-msg "Success: Post"))) 
     598                     (t (message status))) 
     599        ) 
    589600    (error (message (prin1-to-string err-signal)))) 
    590601  ) 
     
    611622    (let ((content (buffer-string))) 
    612623      (let ((content (buffer-string))) 
    613         (xml-parse-region (+ (string-match "\r?\n\r?\n" content) 
    614                              (length (match-string 0 content))) 
    615                           (point-max))) 
     624        (xml-parse-region (+ (string-match "\r?\n\r?\n" content) 
     625                             (length (match-string 0 content))) 
     626                          (point-max))) 
    616627      ))) 
    617628 
     
    623634  (let ((id (cdr (assq 'id status-datum)))) 
    624635    (if (or (null (symbol-value data-var)) 
    625             (not (find-if 
    626                   (lambda (item) 
    627                     (eql id (cdr (assq 'id item)))) 
    628                   (symbol-value data-var)))) 
    629         (progn 
    630           (if twittering-jojo-mode 
    631               (twittering-update-jojo (cdr (assq 'user-screen-name status-datum)) 
    632                                       (cdr (assq 'text status-datum)))) 
    633           (set data-var (cons status-datum (symbol-value data-var))) 
    634           t) 
     636            (not (find-if 
     637                  (lambda (item) 
     638                    (eql id (cdr (assq 'id item)))) 
     639                  (symbol-value data-var)))) 
     640        (progn 
     641          (if twittering-jojo-mode 
     642              (twittering-update-jojo (cdr (assq 'user-screen-name status-datum)) 
     643                                      (cdr (assq 'text status-datum)))) 
     644          (set data-var (cons status-datum (symbol-value data-var))) 
     645          t) 
    635646      nil))) 
    636647 
    637648(defun twittering-status-to-status-datum (status) 
    638649  (flet ((assq-get (item seq) 
    639                    (car (cddr (assq item seq))))) 
     650                   (car (cddr (assq item seq))))) 
    640651    (let* ((status-data (cddr status)) 
    641            id text source created-at truncated 
    642            (user-data (cddr (assq 'user status-data))) 
    643            user-id user-name 
    644            user-screen-name 
    645            user-location 
    646            user-description 
    647            user-profile-image-url 
    648            user-url 
    649            user-protected 
    650            regex-index) 
     652           id text source created-at truncated 
     653           (user-data (cddr (assq 'user status-data))) 
     654           user-id user-name 
     655           user-screen-name 
     656           user-location 
     657           user-description 
     658           user-profile-image-url 
     659           user-url 
     660           user-protected 
     661           regex-index) 
    651662 
    652663      (setq id (string-to-number (assq-get 'id status-data))) 
    653664      (setq text (twittering-decode-html-entities 
    654                   (assq-get 'text status-data))) 
     665                  (assq-get 'text status-data))) 
    655666      (setq source (twittering-decode-html-entities 
    656                     (assq-get 'source status-data))) 
     667                    (assq-get 'source status-data))) 
    657668      (setq created-at (assq-get 'created_at status-data)) 
    658669      (setq truncated (assq-get 'truncated status-data)) 
    659670      (setq user-id (string-to-number (assq-get 'id user-data))) 
    660671      (setq user-name (twittering-decode-html-entities 
    661                        (assq-get 'name user-data))) 
     672                       (assq-get 'name user-data))) 
    662673      (setq user-screen-name (twittering-decode-html-entities 
    663                               (assq-get 'screen_name user-data))) 
     674                              (assq-get 'screen_name user-data))) 
    664675      (setq user-location (twittering-decode-html-entities 
    665                            (assq-get 'location user-data))) 
     676                           (assq-get 'location user-data))) 
    666677      (setq user-description (twittering-decode-html-entities 
    667                               (assq-get 'description user-data))) 
     678                              (assq-get 'description user-data))) 
    668679      (setq user-profile-image-url (assq-get 'profile_image_url user-data)) 
    669680      (setq user-url (assq-get 'url user-data)) 
     
    672683      ;; make username clickable 
    673684      (add-text-properties 0 (length user-screen-name) 
    674                            `(mouse-face highlight 
    675                                         uri ,(concat "http://twitter.com/" user-screen-name) 
    676                                         username ,user-screen-name 
    677                                         face twittering-username-face) 
    678                            user-screen-name) 
     685                           `(mouse-face highlight 
     686                                        uri ,(concat "http://twitter.com/" user-screen-name) 
     687                                        username ,user-screen-name 
     688                                        face twittering-username-face) 
     689                           user-screen-name) 
    679690 
    680691      ;; make URI clickable 
    681692      (setq regex-index 0) 
    682693      (while regex-index 
    683         (setq regex-index 
    684               (string-match "@\\([_a-zA-Z0-9]+\\)\\|\\(https?://[-_.!~*'()a-zA-Z0-9;/?:@&=+$,%#]+\\)" 
    685                             text 
    686                             regex-index)) 
    687         (when regex-index 
    688           (let* ((matched-string (match-string-no-properties 0 text)) 
    689                 (screen-name (match-string-no-properties 1 text)) 
    690                 (uri (match-string-no-properties 2 text))) 
    691             (add-text-properties 
    692              (if screen-name 
    693                 (+ 1 (match-beginning 0)) 
    694                (match-beginning 0)) 
    695              (match-end 0) 
    696              (if screen-name 
    697                 `(mouse-face 
    698                    highlight 
    699                    face twittering-uri-face 
    700                    username ,screen-name 
    701                    uri ,(concat "http://twitter.com/" screen-name)) 
    702                `(mouse-face highlight 
    703                             face twittering-uri-face 
    704                             uri ,uri)) 
    705              text)) 
    706           (setq regex-index (match-end 0)) )) 
     694        (setq regex-index 
     695              (string-match "@\\([_a-zA-Z0-9]+\\)\\|\\(https?://[-_.!~*'()a-zA-Z0-9;/?:@&=+$,%#]+\\)" 
     696                            text 
     697                            regex-index)) 
     698        (when regex-index 
     699          (let* ((matched-string (match-string-no-properties 0 text)) 
     700                (screen-name (match-string-no-properties 1 text)) 
     701                (uri (match-string-no-properties 2 text))) 
     702            (add-text-properties 
     703             (if screen-name 
     704                (+ 1 (match-beginning 0)) 
     705               (match-beginning 0)) 
     706             (match-end 0) 
     707             (if screen-name 
     708                `(mouse-face 
     709                   highlight 
     710                   face twittering-uri-face 
     711                   username ,screen-name 
     712                   uri ,(concat "http://twitter.com/" screen-name)) 
     713               `(mouse-face highlight 
     714                            face twittering-uri-face 
     715                            uri ,uri)) 
     716             text)) 
     717          (setq regex-index (match-end 0)) )) 
    707718 
    708719      ;; make screen-name clickable 
     
    710721       0 (length user-screen-name) 
    711722       `(mouse-face highlight 
    712                     face twittering-username-face 
    713                     uri ,(concat "http://twitter.com/" user-screen-name) 
    714                     username ,user-screen-name) 
     723                    face twittering-username-face 
     724                    uri ,(concat "http://twitter.com/" user-screen-name) 
     725                    username ,user-screen-name) 
    715726       user-screen-name) 
    716727 
    717728      ;; make source pretty and clickable 
    718729      (if (string-match "<a href=\"\\(.*\\)\">\\(.*\\)</a>" source) 
    719           (let ((uri (match-string-no-properties 1 source)) 
    720                 (caption (match-string-no-properties 2 source))) 
    721             (setq source caption) 
    722             (add-text-properties 
    723              0 (length source) 
    724              `(mouse-face highlight 
    725                           uri ,uri 
    726                           face twittering-uri-face 
    727                           source ,source) 
    728              source) 
    729             )) 
     730          (let ((uri (match-string-no-properties 1 source)) 
     731                (caption (match-string-no-properties 2 source))) 
     732            (setq source caption) 
     733            (add-text-properties 
     734             0 (length source) 
     735             `(mouse-face highlight 
     736                          uri ,uri 
     737                          face twittering-uri-face 
     738                          source ,source) 
     739             source) 
     740            )) 
    730741 
    731742      (mapcar 
    732743       (lambda (sym) 
    733         `(,sym . ,(symbol-value sym))) 
     744        `(,sym . ,(symbol-value sym))) 
    734745       '(id text source created-at truncated 
    735             user-id user-name user-screen-name user-location 
    736             user-description 
    737             user-profile-image-url 
    738             user-url 
    739             user-protected))))) 
     746            user-id user-name user-screen-name user-location 
     747            user-description 
     748            user-profile-image-url 
     749            user-url 
     750            user-protected))))) 
    740751 
    741752(defun twittering-xmltree-to-status (xmltree) 
    742753  (mapcar #'twittering-status-to-status-datum 
    743           ;; quirk to treat difference between xml.el in Emacs21 and Emacs22 
    744           ;; On Emacs22, there may be blank strings 
    745           (let ((ret nil) (statuses (reverse (cddr (car xmltree))))) 
    746             (while statuses 
    747               (if (consp (car statuses)) 
    748                   (setq ret (cons (car statuses) ret))) 
    749               (setq statuses (cdr statuses))) 
    750             ret))) 
     754          ;; quirk to treat difference between xml.el in Emacs21 and Emacs22 
     755          ;; On Emacs22, there may be blank strings 
     756          (let ((ret nil) (statuses (reverse (cddr (car xmltree))))) 
     757            (while statuses 
     758              (if (consp (car statuses)) 
     759                  (setq ret (cons (car statuses) ret))) 
     760              (setq statuses (cdr statuses))) 
     761            ret))) 
    751762 
    752763(defun twittering-percent-encode (str &optional coding-system) 
    753764  (if (or (null coding-system) 
    754           (not (coding-system-p coding-system))) 
     765          (not (coding-system-p coding-system))) 
    755766      (setq coding-system 'utf-8)) 
    756767  (mapconcat 
     
    775786  (if encoded-str 
    776787      (let ((cursor 0) 
    777             (found-at nil) 
    778             (result '())) 
    779         (while (setq found-at 
    780                      (string-match "&\\(#\\([0-9]+\\)\\|\\([A-Za-z]+\\)\\);" 
    781                                    encoded-str cursor)) 
    782           (when (> found-at cursor) 
    783             (list-push (substring encoded-str cursor found-at) result)) 
    784           (let ((number-entity (match-string-no-properties 2 encoded-str)) 
    785                 (letter-entity (match-string-no-properties 3 encoded-str))) 
    786             (cond (number-entity 
    787                    (list-push 
    788                     (char-to-string 
    789                      (twittering-ucs-to-char 
    790                       (string-to-number number-entity))) result)) 
    791                   (letter-entity 
    792                    (cond ((string= "gt" letter-entity) (list-push ">" result)) 
    793                         ((string= "lt" letter-entity) (list-push "<" result)) 
    794                         (t (list-push "?" result)))) 
    795                   (t (list-push "?" result))) 
    796             (setq cursor (match-end 0)))) 
    797         (list-push (substring encoded-str cursor) result) 
    798         (apply 'concat (nreverse result))) 
     788            (found-at nil) 
     789            (result '())) 
     790        (while (setq found-at 
     791                     (string-match "&\\(#\\([0-9]+\\)\\|\\([A-Za-z]+\\)\\);" 
     792                                   encoded-str cursor)) 
     793          (when (> found-at cursor) 
     794            (list-push (substring encoded-str cursor found-at) result)) 
     795          (let ((number-entity (match-string-no-properties 2 encoded-str)) 
     796                (letter-entity (match-string-no-properties 3 encoded-str))) 
     797            (cond (number-entity 
     798                   (list-push 
     799                    (char-to-string 
     800                     (twittering-ucs-to-char 
     801                      (string-to-number number-entity))) result)) 
     802                  (letter-entity 
     803                   (cond ((string= "gt" letter-entity) (list-push ">" result)) 
     804                        ((string= "lt" letter-entity) (list-push "<" result)) 
     805                        (t (list-push "?" result)))) 
     806                  (t (list-push "?" result))) 
     807            (setq cursor (match-end 0)))) 
     808        (list-push (substring encoded-str cursor) result) 
     809        (apply 'concat (nreverse result))) 
    799810    "")) 
    800811 
     
    802813  (let ((buf (get-buffer twittering-buffer))) 
    803814    (if (null buf) 
    804         (twittering-stop) 
     815        (twittering-stop) 
    805816      (funcall func) 
    806817      ))) 
     
    810821      nil 
    811822    (twittering-http-post "statuses" "update" 
    812                           `(("status" . ,status) 
    813                             ("source" . "twmode"))) 
     823                          `(("status" . ,status) 
     824                            ("source" . "twmode"))) 
    814825    t)) 
    815826 
     
    820831      (setq status (read-from-minibuffer "status: " status nil nil nil nil t)) 
    821832      (setq not-posted-p 
    822             (not (twittering-update-status-if-not-blank status)))))) 
     833            (not (twittering-update-status-if-not-blank status)))))) 
    823834 
    824835(defun twittering-update-lambda () 
     
    831842(defun twittering-update-jojo (usr msg) 
    832843  (if (string-match "\xde21\xd24b\\(\xd22a\xe0b0\\|\xdaae\xe6cd\\)\xd24f\xd0d6\\([^\xd0d7]+\\)\xd0d7\xd248\xdc40\xd226" 
    833                     msg) 
     844                    msg) 
    834845      (twittering-http-post 
    835846       "statuses" "update" 
    836847       `(("status" . ,(concat 
    837                        "@" usr " " 
    838                        (match-string-no-properties 2 msg) 
    839                        "\xd0a1\xd24f\xd243!?")) 
    840         ("source" . "twmode"))))) 
     848                       "@" usr " " 
     849                       (match-string-no-properties 2 msg) 
     850                       "\xd0a1\xd24f\xd243!?")) 
     851        ("source" . "twmode"))))) 
    841852 
    842853;;; 
     
    851862      nil 
    852863    (setq twittering-timer 
    853           (run-at-time "0 sec" 
    854                        twittering-timer-interval 
    855                        #'twittering-timer-action action)))) 
     864          (run-at-time "0 sec" 
     865                       twittering-timer-interval 
     866                       #'twittering-timer-action action)))) 
    856867 
    857868(defun twittering-stop () 
     
    864875  (let ((buf (get-buffer twittering-buffer))) 
    865876    (if (not buf) 
    866         (twittering-stop) 
     877        (twittering-stop) 
    867878      (twittering-http-get "statuses" "friends_timeline") 
    868879      )) 
     
    870881  (if twittering-icon-mode 
    871882      (if twittering-image-stack 
    872           (let ((proc 
    873                 (apply 
    874                   #'start-process 
    875                   "wget-images" 
    876                   (twittering-wget-buffer) 
    877                   "wget" 
    878                   (format "--directory-prefix=%s" twittering-tmp-dir) 
    879                   "--no-clobber" 
    880                   "--quiet" 
    881                   twittering-image-stack))) 
    882             (set-process-sentinel 
    883              proc 
    884              (lambda (proc stat) 
    885                (clear-image-cache) 
    886                (save-excursion 
    887                 (set-buffer (twittering-wget-buffer)) 
    888                 ))))))) 
     883          (let ((proc 
     884                (apply 
     885                  #'start-process 
     886                  "wget-images" 
     887                  (twittering-wget-buffer) 
     888                  "wget" 
     889                  (format "--directory-prefix=%s" twittering-tmp-dir) 
     890                  "--no-clobber" 
     891                  "--quiet" 
     892                  twittering-image-stack))) 
     893            (set-process-sentinel 
     894             proc 
     895             (lambda (proc stat) 
     896               (clear-image-cache) 
     897               (save-excursion 
     898                (set-buffer (twittering-wget-buffer)) 
     899                ))))))) 
    889900 
    890901(defun twittering-update-status-interactive () 
     
    901912  (let ((uri (get-text-property (point) 'uri))) 
    902913    (if uri 
    903         (browse-url uri)))) 
     914        (browse-url uri)))) 
    904915 
    905916(defun twittering-enter () 
    906917  (interactive) 
    907918  (let ((username (get-text-property (point) 'username)) 
    908         (uri (get-text-property (point) 'uri))) 
     919        (uri (get-text-property (point) 'uri))) 
    909920    (if username 
    910         (twittering-update-status-from-minibuffer (concat "@" username " ")) 
     921        (twittering-update-status-from-minibuffer (concat "@" username " ")) 
    911922      (if uri 
    912           (browse-url uri))))) 
     923          (browse-url uri))))) 
    913924 
    914925(defun twittering-view-user-page () 
     
    916927  (let ((uri (get-text-property (point) 'uri))) 
    917928    (if uri 
    918         (browse-url uri)))) 
     929        (browse-url uri)))) 
    919930 
    920931(defun twittering-reply-to-user () 
     
    922933  (let ((username (get-text-property (point) 'username))) 
    923934    (if username 
    924         (twittering-update-status-from-minibuffer (concat "@" username " "))))) 
     935        (twittering-update-status-from-minibuffer (concat "@" username " "))))) 
    925936 
    926937(defun twittering-get-password () 
     
    928939      (setq twittering-password (read-passwd "twittering-mode: ")))) 
    929940 
     941(defun twittering-next-message () 
     942  "Go to next message." 
     943  (interactive) 
     944  (let ((pos)) 
     945    (setq pos (twittering-next-username-face-pos (point))) 
     946    (when pos 
     947      (goto-char pos)))) 
     948 
     949(defun twittering-next-username-face-pos (pos) 
     950  (interactive) 
     951  (let ((prop)) 
     952    (while (not (eq prop twittering-username-face)) 
     953      (setq pos (next-single-property-change pos 'face)) 
     954      (setq prop (get-text-property pos 'face))) 
     955    pos)) 
     956 
     957(defun twittering-previous-message () 
     958  "Go to previous message." 
     959  (interactive) 
     960  (let ((pos)) 
     961    (setq pos (twittering-previous-username-face-pos (point))) 
     962    (when pos 
     963      (goto-char pos)))) 
     964 
     965(defun twittering-previous-username-face-pos (pos) 
     966  (interactive) 
     967  (let ((prop)) 
     968    (while (not (eq prop twittering-username-face)) 
     969      (setq pos (previous-single-property-change pos 'face)) 
     970      (setq prop (get-text-property pos 'face))) 
     971    pos)) 
     972 
    930973(provide 'twittering-mode) 
    931974;;; twittering.el ends here