Changeset 57 for lang/elisp/wassr-mode/trunk

Timestamp:

07/21/08 03:12:25 (16 years ago)

Author:

tsuyoshi

Message:

fix normal get proces.

Location:

lang/elisp/wassr-mode/trunk

Files:

• ChangeLog (modified) (1 diff)
• wassr-mode.el (modified) (19 diffs)

lang/elisp/wassr-mode/trunk/ChangeLog

@@ +1 @@
+2008-07-21  Tsuyoshi CHO  <Tsuyoshi.CHO+develop@Gmail.com>
+
+        * wassr-mode.el: コメント欄整理(一応)
+        (wassr-api-server): 新規定数
+        (wassr-http-get, wassr-http-post): 定数を利用するように調整、多い
+        改行削除、Connection: Keep-Aliveを追加
+        (wassr-status-format): 新フォーマット用に調整(未完)
+        (wassr-format-status): 同上
+        (wassr-status-to-status-datum): 同上
+        (wassr-get-status-url): URL文字列を調整
+
 2008-07-09  Tsuyoshi CHO  <Tsuyoshi.CHO+develop@Gmail.com>
 

lang/elisp/wassr-mode/trunk/wassr-mode.el

@@ -3 +3 @@
 ;; Copyright (C) 2008 Tsuyoshi CHO
 
-;; Author: Y. Hayamizu <y.hayamizu@gmail.com>
-;;         Tsuyoshi CHO <Tsuyoshi.CHO+develop@Gmail.com>
+;; Author: Tsuyoshi CHO <Tsuyoshi.CHO+develop@Gmail.com>
 ;; Created: Sep 4, 2007
 ;; Version: 0.4
 ;; Keywords: wassr web
-;; URL: 
+;; URL: http://lambdarepos.svnrepository.com/svn/share/lang/elisp/wassr-mode/trunk
 
 ;; This file is free software; you can redistribute it and/or modify
@@ -38 +37 @@
 (require 'parse-time)
 
-(defconst wassr-mode-version "0.1")
+(defconst wassr-mode-version "0.2")
 
 (defun wassr-mode-version ()
@@ -68 +67 @@
 
 (defvar wassr-status-format nil)
-(setq wassr-status-format "%i %s,  %@:\n  %t // from %f%L")
+(setq wassr-status-format "%i %s,  %@:\n  %t // from %A")
 ;; %s - screen_name
-;; %S - name
+;; %S - user_login_id
 ;; %i - profile_image
-;; %d - description
-;; %l - location
-;; %L - " [location]"
-;; %u - url
-;; %j - user.id
-;; %p - protected?
-;; %c - created_at (raw UTC string)
-;; %C{time-format-str} - created_at (formatted with time-format-str)
+;; %a - areacode
+;; %A - areaname
+;; %u - link
+;; %p - photo-thumbnail-url
+;; %P - photo-url
+;; %x - protected?
+;; %c - epoch
+;; %C{time-format-str} - epoch (formatted with time-format-str)
 ;; %@ - X seconds ago
 ;; %t - text
-;; %' - truncated
-;; %f - source
+;; %T - html
 ;; %# - id
 
 (defvar wassr-buffer "*wassr*")
+(defconst wassr-api-server "api.wassr.jp")
 (defun wassr-buffer ()
   (wassr-get-or-generate-buffer wassr-buffer))
@@ -334 +333 @@
                              (int-to-string wassr-proxy-port)
                            wassr-proxy-port))
-            (setq server "api.wassr.jp"
+            (setq server wassr-api-server
                   port "80"))
           (setq proc
@@ -346 +345 @@
                  request)
              (setq request
-                   (concat "GET http://api.wassr.jp/" method-class "/" method ".xml HTTP/1.1" nl
-                           "Host: api.wassr.jp" nl
+                   (concat "GET http://" wassr-api-server "/" method-class "/" method ".xml HTTP/1.1" nl
+                           "Host: " wassr-api-server  nl
                            "User-Agent: " (wassr-user-agent) nl
                            "Authorization: Basic "
@@ -360 +359 @@
                            ",image/png,*/*;q=0.5" nl
                            "Accept-Charset: utf-8;q=0.7,*;q=0.7" nl
+                           "Connection: Keep-Alive" nl
                            (when wassr-proxy-use
                              "Proxy-Connection: Keep-Alive" nl
@@ -369 +369 @@
                                          proxy-password))
                                 nl)))
-                           nl nl))
+                           nl))
              (debug-print (concat "GET Request\n" request))
              request)))
@@ -458 +458 @@
            (list-push (attr 'user-screen-name) result))
           ((?S)                         ; %S - name
-           (list-push (attr 'user-name) result))
+           (list-push (attr 'user-login-id) result))
           ((?i)                         ; %i - profile_image
            (list-push (profile-image) result))
-          ((?d)                         ; %d - description
-           (list-push (attr 'user-description) result))
-          ((?l)                         ; %l - location
-           (list-push (attr 'user-location) result))
-          ((?L)                         ; %L - " [location]"
-           (let ((location (attr 'user-location)))
-             (unless (or (null location) (string= "" location))
-               (list-push (concat " [" location "]") result)) ))
-          ((?u)                         ; %u - url
-           (list-push (attr 'user-url) result))
-          ((?j)                         ; %j - user.id
-           (list-push (format "%d" (attr 'user-id)) result))
-          ((?p)                         ; %p - protected?
+          ((?a)                         ;
+           (list-push (attr 'areacode) result))
+          ((?A)                         ;
+           (list-push (attr 'areaname) result))
+          ((?u)                         ; %u - link
+           (list-push (attr 'link) result))
+          ((?p)                         ; %u - link
+           (list-push (attr 'photo-thumbnail-url) result))
+          ((?P)                         ; %u - link
+           (list-push (attr 'photo-url) result))
+          ((?x)                         ; %p - protected?
            (let ((protected (attr 'user-protected)))
              (when (string= "true" protected)
                (list-push "[x]" result))))
-          ((?c)                     ; %c - created_at (raw UTC string)
-           (list-push (attr 'created-at) result))
-          ((?C) ; %C{time-format-str} - created_at (formatted with time-format-str)
-           (list-push (wassr-local-strftime
-                       (or (match-string-no-properties 2 format-str) "%H:%M:%S")
-                       (attr 'created-at))
-                      result))
+          ((?c)                     ; %c - epoch (raw UTC string)
+           (list-push (attr 'epoch) result))
+          ((?C) ; %C{time-format-str} - epoch (formatted with time-format-str)
+           (list-push (attr 'epoch) result));;FIXME
           ((?@)                         ; %@ - X seconds ago
-           (let ((created-at
-                  (apply
-                   'encode-time
-                   (parse-time-string (attr 'created-at))))
-                 (now (current-time)))
-             (let ((secs (+ (* (- (car now) (car created-at)) 65536)
-                            (- (cadr now) (cadr created-at))))
-                   time-string url)
-               (setq time-string
-                     (cond ((< secs 5) "less than 5 seconds ago")
-                           ((< secs 10) "less than 10 seconds ago")
-                           ((< secs 20) "less than 20 seconds ago")
-                           ((< secs 30) "half a minute ago")
-                           ((< secs 60) "less than a minute ago")
-                           ((< secs 150) "1 minute ago")
-                           ((< secs 2400) (format "%d minutes ago"
-                                                  (/ (+ secs 30) 60)))
-                           ((< secs 5400) "about 1 hour ago")
-                           ((< secs 84600) (format "about %d hours ago"
-                                                   (/ (+ secs 1800) 3600)))
-                           (t (format-time-string "%I:%M %p %B %d, %Y" created-at))))
-               (setq url (wassr-get-status-url (attr 'user-screen-name) (attr 'id)))
-               ;; make status url clickable
-               (add-text-properties
-                0 (length time-string)
-                `(mouse-face highlight
-                             face wassr-uri-face
-                             uri ,url)
-                time-string)
-               (list-push time-string result))))
+           (list-push (attr 'epoch) result));;FIXME
           ((?t)                         ; %t - text
            (list-push                   ;(clickable-text)
             (attr 'text)
             result))
-          ((?')                         ; %' - truncated
-           (let ((truncated (attr 'truncated)))
-             (when (string= "true" truncated)
-               (list-push "..." result))))
-          ((?f)                         ; %f - source
-           (list-push (attr 'source) result))
+          ((?T)                         ; %T - html
+           (list-push                   ;(clickable-text)
+            (attr 'html)
+            result))
           ((?#)                         ; %# - id
-           (list-push (format "%d" (attr 'id)) result))
+           (list-push (attr 'id) result))
           (t
            (list-push (char-to-string c) result)))
@@ -540 +504 @@
 (defun wassr-http-post
   (method-class method &optional parameters contents sentinel)
-  "Send HTTP POST request to api.wassr.jp
+  "Send HTTP POST request to `wassr-api-server'
 
 METHOD-CLASS must be one of Wassr API method classes(statuses, users or direct_messages).
@@ -561 +525 @@
                          (int-to-string wassr-proxy-port)
                        wassr-proxy-port))
-        (setq server "api.wassr.jp"
+        (setq server wassr-api-server
               port "80"))
       (setq proc
@@ -573 +537 @@
              request)
          (setq  request
-                (concat "POST http://api.wassr.jp/" method-class "/" method ".xml?"
+                (concat "POST http://" wassr-api-server  "/" method-class "/" method ".xml?"
                         (if parameters
                             (mapconcat
@@ -583 +547 @@
                              "&"))
                         " HTTP/1.1" nl
-                        "Host: api.wassr.jp" nl
+                        "Host: " wassr-api-server nl
                         "User-Agent: " (wassr-user-agent) nl
                         "Authorization: Basic "
@@ -591 +555 @@
                         "Content-Type: text/plain" nl
                         "Content-Length: 0" nl
+                        "Connection: Keep-Alive" nl
                         (when wassr-proxy-use
                           "Proxy-Connection: Keep-Alive" nl
@@ -600 +565 @@
                                       proxy-password))
                              nl)))
-                        nl nl))
+                        nl))
          (debug-print (concat "POST Request\n" request))
          request)))))
@@ -669 +634 @@
                    (car (cddr (assq item seq)))))
     (let* ((status-data (cddr status))
-           id text source created-at truncated
+           html
+           text
+           epoch
+           rid
+           id
+           user-login-id ;; user_login_id
+           link
+           photo-url ;; photo_url
+           areacode
+           areaname
+           photo-thumbnail-url ;; photo_thumbnail_url
+           reply-status-url ;; reply_status_url
+           reply-user-login-id ;; reply_user_login_id
+           reply-message ;; reply_message
+           reply-user-nick ;; reply_user_nick
+           slurl
            (user-data (cddr (assq 'user status-data)))
-           user-id user-name
-           user-screen-name
-           user-location
-           user-description
-           user-profile-image-url
-           user-url
-           user-protected
+           user-protected  ;; protected
+           user-profile-image-url ;; profile_image_url
+           user-screen-name ;; screen_name
            regex-index)
 
-      (setq id (string-to-number (assq-get 'id status-data)))
       (setq text (wassr-decode-html-entities
                   (assq-get 'text status-data)))
-      (setq source (wassr-decode-html-entities
-                    (assq-get 'source status-data)))
-      (setq created-at (assq-get 'created_at status-data))
-      (setq truncated (assq-get 'truncated status-data))
-      (setq user-id (string-to-number (assq-get 'id user-data)))
-      (setq user-name (wassr-decode-html-entities
-                       (assq-get 'name user-data)))
+      (setq html (wassr-decode-html-entities
+                  (assq-get 'html status-data)))
+      (setq epoch (assq-get 'epoch status-data))
+      (setq rid (assq-get 'rid status-data))
+      (setq id (assq-get 'id status-data))
+      (setq user-login-id (assq-get 'user_login_id status-data))
+      (setq link (assq-get 'link status-data))
+      (setq photo-url (assq-get 'photo_url status-data))
+      (setq areacode (assq-get 'areacode status-data))
+      (setq areaname (assq-get 'areaname status-data))
+      (setq photo-thumbnail-url (assq-get 'photo_thumbnail_url status-data))
+      (setq reply-status-url (assq-get 'reply_status_url status-data))
+      (setq reply-user-login-id (assq-get 'reply_user_login_id status-data))
+      (setq reply-message (assq-get 'reply_message status-data))
+      (setq reply-user-nick (assq-get 'reply_user_nick status-data))
+      (setq slurl (assq-get 'slurl status-data))
       (setq user-screen-name (wassr-decode-html-entities
                               (assq-get 'screen_name user-data)))
-      (setq user-location (wassr-decode-html-entities
-                           (assq-get 'location user-data)))
-      (setq user-description (wassr-decode-html-entities
-                              (assq-get 'description user-data)))
       (setq user-profile-image-url (assq-get 'profile_image_url user-data))
-      (setq user-url (assq-get 'url user-data))
       (setq user-protected (assq-get 'protected user-data))
 
       ;; make username clickable
       (add-text-properties
-       0 (length user-name)
+       0 (length user-login-id)
        `(mouse-face highlight
-                    uri ,(concat "http://api.wassr.jp/" user-screen-name)
+                    uri ,(concat "http://wassr.jp/user/" user-screen-name)
                     face wassr-username-face)
-       user-name)
+       user-login-id)
 
       ;; make screen-name clickable
@@ -713 +692 @@
        `(mouse-face highlight
                     face wassr-username-face
-                    uri ,(concat "http://api.wassr.jp/" user-screen-name)
+                    uri ,(concat "http://wassr.jp/user/" user-screen-name)
                     face wassr-username-face)
        user-screen-name)
@@ -737 +716 @@
                    highlight
                    face wassr-uri-face
-                   uri ,(concat "http://api.wassr.jp/" screen-name))
+                   uri ,(concat "http://wassr.jp/user/" screen-name))
                `(mouse-face highlight
                             face wassr-uri-face
@@ -744 +723 @@
           (setq regex-index (match-end 0)) ))
 
-
-      ;; make source pretty and clickable
-      (if (string-match "<a href=\"\\(.*\\)\">\\(.*\\)</a>" source)
-          (let ((uri (match-string-no-properties 1 source))
-                (caption (match-string-no-properties 2 source)))
-            (setq source caption)
-            (add-text-properties
-             0 (length source)
-             `(mouse-face highlight
-                          uri ,uri
-                          face wassr-uri-face
-                          source ,source)
-             source)
-            ))
-
       (mapcar
        (lambda (sym)
          `(,sym . ,(symbol-value sym)))
-       '(id text source created-at truncated
-            user-id user-name user-screen-name user-location
-            user-description
-            user-profile-image-url
-            user-url
-            user-protected)))))
+       '(html text epoch rid id user-login-id
+              link photo-url areacode areaname
+              photo-thumbnail-url
+              reply-status-url
+              reply-user-login-id
+              reply-message
+              reply-user-nick
+              slurl
+              user-protected
+              user-profile-image-url
+              user-screen-name
+              )))))
 
 (defun wassr-xmltree-to-status (xmltree)
@@ -1037 +1007 @@
 (defun wassr-get-status-url (username id)
   "Generate status URL."
-  (format "http://api.wassr.jp/%s/statuses/%d" username id))
+  (format "http://wassr.jp/user/%s/statuses/%" username id))
 
 ;;;###autoload