;;; wassr-mode.el --- Major mode for Wassr

;; Copyright (C) 2008 Tsuyoshi CHO

;; Author: Tsuyoshi CHO <Tsuyoshi.CHO+develop@Gmail.com>
;; Created: Sep 4, 2007
;; Version: 0.4
;; Keywords: wassr web
;; URL: http://lambdarepos.svnrepository.com/svn/share/lang/elisp/wassr-mode/trunk

;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; wassr-mode.el based on wassr-mode.el is a major mode for Wassr.
;; You can check friends timeline, and update your status on Emacs.

;;; Feature Request:

;;; Code:

(require 'cl)
(require 'xml)
(require 'parse-time)

(defconst wassr-mode-version "0.2")

(defun wassr-mode-version ()
  "Display a message for wassr-mode version."
  (interactive)
  (let ((version-string
	 (format "wassr-mode-v%s" wassr-mode-version)))
    (if (interactive-p)
	(message "%s" version-string)
      version-string)))

(defvar wassr-mode-map (make-sparse-keymap))

(defvar wassr-timer nil "Timer object for timeline refreshing will be stored here. DO NOT SET VALUE MANUALLY.")

(defvar wassr-idle-time 20)

(defvar wassr-timer-interval 90)

(defvar wassr-username nil)

(defvar wassr-password nil)

(defvar wassr-scroll-mode nil)
(make-variable-buffer-local 'wassr-scroll-mode)

(defvar wassr-jojo-mode nil)
(make-variable-buffer-local 'wassr-jojo-mode)

(defvar wassr-status-format nil)
(setq wassr-status-format "%i %s,  %@:\n  %t // from %A")
;; %s - screen_name
;; %S - user_login_id
;; %i - profile_image
;; %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
;; %T - html
;; %# - id

(defvar wassr-buffer "*wassr*")
(defconst wassr-api-server "api.wassr.jp")
(defun wassr-buffer ()
  (wassr-get-or-generate-buffer wassr-buffer))

(defvar wassr-http-buffer "*wassr-http-buffer*")
(defun wassr-http-buffer ()
  (wassr-get-or-generate-buffer wassr-http-buffer))

(defvar wassr-friends-timeline-data nil)

(defvar wassr-username-face 'wassr-username-face)
(defvar wassr-uri-face 'wassr-uri-face)

(defun wassr-get-or-generate-buffer (buffer)
  (if (bufferp buffer)
      (if (buffer-live-p buffer)
	  buffer
	(generate-new-buffer (buffer-name buffer)))
    (if (stringp buffer)
	(or (get-buffer buffer)
	    (generate-new-buffer buffer)))))

(defun assocref (item alist)
  (cdr (assoc item alist)))
(defmacro list-push (value listvar)
  `(setq ,listvar (cons ,value ,listvar)))

;;; Proxy
(defvar wassr-proxy-use nil)
(defvar wassr-proxy-server nil)
(defvar wassr-proxy-port 8080)
(defvar wassr-proxy-user nil)
(defvar wassr-proxy-password nil)

(defun wassr-toggle-proxy () ""
  (interactive)
  (setq wassr-proxy-use
	(not wassr-proxy-use))
  (message "%s %s"
	   "Use Proxy:"
	   (if wassr-proxy-use
	       "on" "off")))

(defun wassr-user-agent-default-function ()
  "Wassr mode default User-Agent function."
  (concat "Emacs/"
	  (int-to-string emacs-major-version) "." (int-to-string
						   emacs-minor-version)
	  " "
	  "Wassr-mode/"
	  wassr-mode-version))

(defvar wassr-user-agent-function 'wassr-user-agent-default-function)

(defun wassr-user-agent ()
  "Return User-Agent header string."
  (funcall wassr-user-agent-function))

;;; to show image files

(defvar wassr-wget-buffer "*wassr-wget-buffer*")
(defun wassr-wget-buffer ()
  (wassr-get-or-generate-buffer wassr-wget-buffer))

(defvar wassr-tmp-dir
  (expand-file-name (concat "wassr-mode-images-" (user-login-name))
		    temporary-file-directory))

(defvar wassr-icon-mode nil "You MUST NOT CHANGE this variable directory. You should change through function'wassr-icon-mode'")
(make-variable-buffer-local 'wassr-icon-mode)
(defun wassr-icon-mode (&optional arg)
  (interactive)
  (setq wassr-icon-mode
	(if wassr-icon-mode
	    (if (null arg)
		nil
	      (> (prefix-numeric-value arg) 0))
	  (when (or (null arg)
		    (and arg (> (prefix-numeric-value arg) 0)))
	    (when (file-writable-p wassr-tmp-dir)
	      (progn
		(if (not (file-directory-p wassr-tmp-dir))
		    (make-directory wassr-tmp-dir))
		t)))))
  (wassr-render-friends-timeline))

(defun wassr-scroll-mode (&optional arg)
  (interactive)
  (setq wassr-scroll-mode
	(if (null arg)
	    (not wassr-scroll-mode)
	  (> (prefix-numeric-value arg) 0))))

(defun wassr-jojo-mode (&optional arg)
  (interactive)
  (setq wassr-jojo-mode
	(if (null arg)
	    (not wassr-jojo-mode)
	  (> (prefix-numeric-value arg) 0))))

(defvar wassr-image-stack nil)

(defun wassr-image-type (file-name)
  (cond
   ((string-match "\\.jpe?g" file-name) 'jpeg)
   ((string-match "\\.png" file-name) 'png)
   ((string-match "\\.gif" file-name) 'gif)
   (t nil)))

(defun wassr-local-strftime (fmt string)
  (format-time-string fmt ; like "%Y-%m-%d %H:%M:%S", shown in localtime
		      (apply 'encode-time (parse-time-string string))))

(defvar wassr-debug-mode nil)
(defvar wassr-debug-buffer "*debug*")
(defun wassr-debug-buffer ()
  (wassr-get-or-generate-buffer wassr-debug-buffer))
(defmacro debug-print (obj)
  (let ((obsym (gensym)))
    `(let ((,obsym ,obj))
       (if wassr-debug-mode
	   (with-current-buffer (wassr-debug-buffer)
	     (insert (prin1-to-string ,obsym))
	     (newline)
	     ,obsym)
	 ,obsym))))

(defun wassr-debug-mode ()
  (interactive)
  (setq wassr-debug-mode
	(not wassr-debug-mode))
  (message (if wassr-debug-mode "debug mode:on" "debug mode:off")))

(if wassr-mode-map
    (let ((km wassr-mode-map))
      (define-key km "\C-c\C-f" 'wassr-friends-timeline)
      (define-key km "\C-c\C-s" 'wassr-update-status-interactive)
      (define-key km "\C-c\C-e" 'wassr-erase-old-statuses)
      (define-key km "\C-m" 'wassr-enter)
      (define-key km "\C-c\C-l" 'wassr-update-lambda)
      (define-key km [mouse-1] 'wassr-click)
      (define-key km "\C-c\C-v" 'wassr-view-user-page)
      ;; (define-key km "j" 'next-line)
      ;; (define-key km "k" 'previous-line)
      (define-key km "j" 'wassr-goto-next-status)
      (define-key km "k" 'wassr-goto-previous-status)
      (define-key km "l" 'forward-char)
      (define-key km "h" 'backward-char)
      (define-key km "0" 'beginning-of-line)
      (define-key km "^" 'beginning-of-line-text)
      (define-key km "$" 'end-of-line)
      (define-key km "n" 'wassr-goto-next-status-of-user)
      (define-key km "p" 'wassr-goto-previous-status-of-user)
      (define-key km [backspace] 'backward-char)
      (define-key km "G" 'end-of-buffer)
      (define-key km "H" 'beginning-of-buffer)
      (define-key km "i" 'wassr-icon-mode)
      (define-key km "s" 'wassr-scroll-mode)
      (define-key km "t" 'wassr-toggle-proxy)
      (define-key km "\C-c\C-p" 'wassr-toggle-proxy)
      nil))

(defvar wassr-mode-syntax-table nil "")

(if wassr-mode-syntax-table
    ()
  (setq wassr-mode-syntax-table (make-syntax-table))
  ;; (modify-syntax-entry ?  "" wassr-mode-syntax-table)
  (modify-syntax-entry ?\" "w"  wassr-mode-syntax-table)
  )

(defun wassr-mode-init-variables ()
  ;; (make-variable-buffer-local 'variable)
  ;; (setq variable nil)
  (font-lock-mode -1)
  (defface wassr-username-face
    `((t nil)) "" :group 'faces)
  (copy-face 'font-lock-string-face 'wassr-username-face)
  (set-face-attribute 'wassr-username-face nil :underline t)
  (defface wassr-uri-face
    `((t nil)) "" :group 'faces)
  (set-face-attribute 'wassr-uri-face nil :underline t)
  (add-to-list 'minor-mode-alist '(wassr-icon-mode " ws-icon"))
  (add-to-list 'minor-mode-alist '(wassr-scroll-mode " ws-scroll"))
  (add-to-list 'minor-mode-alist '(wassr-jojo-mode " ws-jojo"))
  )

(defmacro case-string (str &rest clauses)
  `(cond
    ,@(mapcar
       (lambda (clause)
	 (let ((keylist (car clause))
	       (body (cdr clause)))
	   `(,(if (listp keylist)
		  `(or ,@(mapcar (lambda (key) `(string-equal ,str ,key)) keylist))
		't)
	     ,@body)))
       clauses)))

;; If you use Emacs21, decode-char 'ucs will fail unless Mule-UCS is loaded.
;; TODO: Show error messages if Emacs 21 without Mule-UCS
(defmacro wassr-ucs-to-char (num)
  (if (functionp 'ucs-to-char)
      `(ucs-to-char ,num)
    `(decode-char 'ucs ,num)))

(defvar wassr-mode-string "Wassr mode")

(defvar wassr-mode-hook nil
  "Wassr-mode hook.")

(defun wassr-mode ()
  "Major mode for Wassr"
  (interactive)
  (switch-to-buffer (wassr-buffer))
  (kill-all-local-variables)
  (wassr-mode-init-variables)
  (use-local-map wassr-mode-map)
  (setq major-mode 'wassr-mode)
  (setq mode-name wassr-mode-string)
  (set-syntax-table wassr-mode-syntax-table)
  (run-hooks 'wassr-mode-hook)
  (font-lock-mode -1)
  (wassr-start)
  )

;;;
;;; Basic HTTP functions
;;;

(defun wassr-http-get (method-class method &optional sentinel)
  (if (null sentinel) (setq sentinel 'wassr-http-get-default-sentinel))

  ;; clear the buffer
  (save-excursion
    (set-buffer (wassr-http-buffer))
    (erase-buffer))

  (let (proc server port
	     (proxy-user wassr-proxy-user)
	     (proxy-password wassr-proxy-password))
    (condition-case nil
	(progn
	  (if (and wassr-proxy-use wassr-proxy-server)
	      (setq server wassr-proxy-server
		    port (if (integerp wassr-proxy-port)
			     (int-to-string wassr-proxy-port)
			   wassr-proxy-port))
	    (setq server wassr-api-server
		  port "80"))
	  (setq proc
		(open-network-stream
		 "network-connection-process" (wassr-http-buffer)
		 server (string-to-number port)))
	  (set-process-sentinel proc sentinel)
	  (process-send-string
	   proc
	   (let ((nl "\r\n")
		 request)
	     (setq request
		   (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 "
			   (base64-encode-string
			    (concat wassr-username ":" (wassr-get-password)))
			   nl
			   "Accept: text/xml"
			   ",application/xml"
			   ",application/xhtml+xml"
			   ",application/html;q=0.9"
			   ",text/plain;q=0.8"
			   ",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
			     (when (and proxy-user proxy-password)
			       (concat
				"Proxy-Authorization: Basic "
				(base64-encode-string
				 (concat proxy-user ":"
					 proxy-password))
				nl)))
			   nl))
	     (debug-print (concat "GET Request\n" request))
	     request)))
      (error
       (message "Failure: HTTP GET") nil))))

(defun wassr-http-get-default-sentinel (proc stat &optional suc-msg)
  (let ((header (wassr-get-response-header))
	(body (wassr-get-response-body))
	(status nil)
	)
    (if (string-match "HTTP/1\.[01] \\([a-z0-9 ]+\\)\r?\n" header)
	(progn
	  (setq status (match-string-no-properties 1 header))
	  (case-string
	   status
	   (("200 OK")
	    (mapcar
	     #'wassr-cache-status-datum
	     (reverse (wassr-xmltree-to-status
		       body)))
	    (wassr-render-friends-timeline)
	    (message (if suc-msg suc-msg "Success: Get.")))
	   (t (message status))))
      (message "Failure: Bad http response.")))
  )

(defun wassr-render-friends-timeline ()
  (with-current-buffer (wassr-buffer)
    (let ((point (point))
	  (end (point-max)))
      (setq buffer-read-only nil)
      (erase-buffer)
      (mapc (lambda (status)
	      (insert (wassr-format-status
		       status wassr-status-format))
	      (fill-region-as-paragraph
	       (save-excursion (beginning-of-line) (point)) (point))
	      (insert "\n"))
	    wassr-friends-timeline-data)
      (if wassr-image-stack
	  (clear-image-cache))
      (setq buffer-read-only t)
      (debug-print (current-buffer))
      (goto-char (+ point (if wassr-scroll-mode (- (point-max) end) 0))))
    ))

(defun wassr-format-status (status format-str)
  (flet ((attr (key)
	       (assocref key status))
	 (profile-image
	  ()
	  (let ((profile-image-url (attr 'user-profile-image-url))
		(icon-string "\n  "))
	    (if (string-match "/\\([^/?]+\\)\\(?:\\?\\|$\\)" profile-image-url)
		(let ((filename (match-string-no-properties 1 profile-image-url)))
		  ;; download icons if does not exist
		  (if (file-exists-p (concat wassr-tmp-dir
					     "/" filename))
		      t
		    (add-to-list 'wassr-image-stack profile-image-url))

		  (when (and icon-string wassr-icon-mode)
		    (set-text-properties
		     1 2 `(display
			   (image :type ,(wassr-image-type filename)
				  :file ,(concat wassr-tmp-dir
						 "/"
						 filename)))
		     icon-string)
		    icon-string)
		  )))))
    (let ((cursor 0)
	  (result ())
	  c
	  found-at)
      (setq cursor 0)
      (setq result '())
      (while (setq found-at (string-match "%\\(C{\\([^}]+\\)}\\|[A-Za-z#@']\\)" format-str cursor))
	(setq c (string-to-char (match-string-no-properties 1 format-str)))
	(if (> found-at cursor)
	    (list-push (substring format-str cursor found-at) result)
	  "|")
	(setq cursor (match-end 1))

	(case c
	  ((?s)                         ; %s - screen_name
	   (list-push (attr 'user-screen-name) result))
	  ((?S)                         ; %S - name
	   (list-push (attr 'user-login-id) result))
	  ((?i)                         ; %i - profile_image
	   (list-push (profile-image) result))
	  ((?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 - 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
	   (list-push (attr 'epoch) result));;FIXME
	  ((?t)                         ; %t - text
	   (list-push                   ;(clickable-text)
	    (attr 'text)
	    result))
	  ((?T)                         ; %T - html
	   (list-push                   ;(clickable-text)
	    (attr 'html)
	    result))
	  ((?#)                         ; %# - id
	   (list-push (attr 'id) result))
	  (t
	   (list-push (char-to-string c) result)))
	)
      (list-push (substring format-str cursor) result)
      (let ((formatted-status (apply 'concat (nreverse result))))
	(add-text-properties 0 (length formatted-status)
			     `(username ,(attr 'user-screen-name))
			     formatted-status)
	formatted-status)
      )))

(defun wassr-http-post
  (method-class method &optional parameters contents sentinel)
  "Send HTTP POST request to `wassr-api-server'

METHOD-CLASS must be one of Wassr API method classes(statuses, users or direct_messages).
METHOD must be one of Wassr API method which belongs to METHOD-CLASS.
PARAMETERS is alist of URI parameters. ex) ((\"mode\" . \"view\") (\"page\" . \"6\")) => <URI>?mode=view&page=6"
  (if (null sentinel) (setq sentinel 'wassr-http-post-default-sentinel))

  ;; clear the buffer
  (save-excursion
    (set-buffer (wassr-http-buffer))
    (erase-buffer))

  (let (proc server port
	     (proxy-user wassr-proxy-user)
	     (proxy-password wassr-proxy-password))
    (progn
      (if (and wassr-proxy-use wassr-proxy-server)
	  (setq server wassr-proxy-server
		port (if (integerp wassr-proxy-port)
			 (int-to-string wassr-proxy-port)
		       wassr-proxy-port))
	(setq server wassr-api-server
	      port "80"))
      (setq proc
	    (open-network-stream
	     "network-connection-process" (wassr-http-buffer)
	     server (string-to-number port)))
      (set-process-sentinel proc sentinel)
      (process-send-string
       proc
       (let ((nl "\r\n")
	     request)
	 (setq  request
		(concat "POST http://" wassr-api-server  "/" method-class "/" method ".xml?"
			(if parameters
			    (mapconcat
			     (lambda (param-pair)
			       (format "%s=%s"
				       (wassr-percent-encode (car param-pair))
				       (wassr-percent-encode (cdr param-pair))))
			     parameters
			     "&"))
			" HTTP/1.1" nl
			"Host: " wassr-api-server nl
			"User-Agent: " (wassr-user-agent) nl
			"Authorization: Basic "
			(base64-encode-string
			 (concat wassr-username ":" (wassr-get-password)))
			nl
			"Content-Type: text/plain" nl
			"Content-Length: 0" nl
			"Connection: Keep-Alive" nl
			(when wassr-proxy-use
			  "Proxy-Connection: Keep-Alive" nl
			  (when (and proxy-user proxy-password)
			    (concat
			     "Proxy-Authorization: Basic "
			     (base64-encode-string
			      (concat proxy-user ":"
				      proxy-password))
			     nl)))
			nl))
	 (debug-print (concat "POST Request\n" request))
	 request)))))

(defun wassr-http-post-default-sentinel (proc stat &optional suc-msg)

  (condition-case err-signal
      (let ((header (wassr-get-response-header))
	    ;; (body (wassr-get-response-body)) not used now.
	    (status nil))
	(string-match "HTTP/1\.1 \\([a-z0-9 ]+\\)\r?\n" header)
	(setq status (match-string-no-properties 1 header))
	(case-string status
		     (("200 OK")
		      (message (if suc-msg suc-msg "Success: Post")))
		     (t (message status)))
	)
    (error (message (prin1-to-string err-signal))))
  )

(defun wassr-get-response-header (&optional buffer)
  "Exract HTTP response header from HTTP response.
`buffer' may be a buffer or the name of an existing buffer.
 If `buffer' is omitted, the value of `wassr-http-buffer' is used as `buffer'."
  (if (stringp buffer) (setq buffer (get-buffer buffer)))
  (if (null buffer) (setq buffer (wassr-http-buffer)))
  (save-excursion
    (set-buffer buffer)
    (let ((content (buffer-string)))
      (substring content 0 (string-match "\r?\n\r?\n" content)))))

(defun wassr-get-response-body (&optional buffer)
  "Exract HTTP response body from HTTP response, parse it as XML, and return a XML tree as list.
`buffer' may be a buffer or the name of an existing buffer.
 If `buffer' is omitted, the value of `wassr-http-buffer' is used as `buffer'."
  (if (stringp buffer) (setq buffer (get-buffer buffer)))
  (if (null buffer) (setq buffer (wassr-http-buffer)))
  (save-excursion
    (set-buffer buffer)
    (let ((content (buffer-string)))
      (let ((content (buffer-string)))
	(xml-parse-region (+ (string-match "\r?\n\r?\n" content)
			     (length (match-string 0 content)))
			  (point-max)))
      )))

(defun wassr-cache-status-datum (status-datum &optional data-var)
  "Cache status datum into data-var(default wassr-friends-timeline-data)
If STATUS-DATUM is already in DATA-VAR, return nil. If not, return t."
  (if (null data-var)
      (setf data-var 'wassr-friends-timeline-data))
  (let ((id (cdr (assq 'id status-datum))))
    (if (or (null (symbol-value data-var))
	    (not (find-if
		  (lambda (item)
		    (eql id (cdr (assq 'id item))))
		  (symbol-value data-var))))
	(progn
	  (if wassr-jojo-mode
	      (wassr-update-jojo (cdr (assq 'user-screen-name status-datum))
				      (cdr (assq 'text status-datum))))
	  (set data-var (cons status-datum (symbol-value data-var)))
	  t)
      nil)))

(defun wassr-status-to-status-datum (status)
  (flet ((assq-get (item seq)
		   (car (cddr (assq item seq)))))
    (let* ((status-data (cddr status))
	   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-protected  ;; protected
	   user-profile-image-url ;; profile_image_url
	   user-screen-name ;; screen_name
	   regex-index)

      (setq text (wassr-decode-html-entities
		  (assq-get 'text status-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-profile-image-url (assq-get 'profile_image_url user-data))
      (setq user-protected (assq-get 'protected user-data))

      ;; make username clickable
      (add-text-properties
       0 (length user-login-id)
       `(mouse-face highlight
		    uri ,(concat "http://wassr.jp/user/" user-screen-name)
		    face wassr-username-face)
       user-login-id)

      ;; make screen-name clickable
      (add-text-properties
       0 (length user-screen-name)
       `(mouse-face highlight
		    face wassr-username-face
		    uri ,(concat "http://wassr.jp/user/" user-screen-name)
		    face wassr-username-face)
       user-screen-name)

      ;; make URI clickable
      (setq regex-index 0)
      (while regex-index
	(setq regex-index
	      (string-match "@\\([_a-zA-Z0-9]+\\)\\|\\(https?://[-_.!~*'()a-zA-Z0-9;/?:@&=+$,%#]+\\)"
			    text
			    regex-index))
	(when regex-index
	  (let* ((matched-string (match-string-no-properties 0 text))
		 (screen-name (match-string-no-properties 1 text))
		 (uri (match-string-no-properties 2 text)))
	    (add-text-properties
	     (if screen-name
		 (+ 1 (match-beginning 0))
	       (match-beginning 0))
	     (match-end 0)
	     (if screen-name
		 `(mouse-face
		   highlight
		   face wassr-uri-face
		   uri ,(concat "http://wassr.jp/user/" screen-name))
	       `(mouse-face highlight
			    face wassr-uri-face
			    uri ,uri))
	     text))
	  (setq regex-index (match-end 0)) ))

      (mapcar
       (lambda (sym)
	 `(,sym . ,(symbol-value sym)))
       '(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)
  (mapcar #'wassr-status-to-status-datum
	  ;; quirk to treat difference between xml.el in Emacs21 and Emacs22
	  ;; On Emacs22, there may be blank strings
	  (let ((ret nil) (statuses (reverse (cddr (car xmltree)))))
	    (while statuses
	      (if (consp (car statuses))
		  (setq ret (cons (car statuses) ret)))
	      (setq statuses (cdr statuses)))
	    ret)))

(defun wassr-percent-encode (str &optional coding-system)
  (if (or (null coding-system)
	  (not (coding-system-p coding-system)))
      (setq coding-system 'utf-8))
  (mapconcat
   (lambda (c)
     (cond
      ((wassr-url-reserved-p c)
       (char-to-string c))
      ((eq c ? ) "+")
      (t (format "%%%x" c))))
   (encode-coding-string str coding-system)
   ""))

(defun wassr-url-reserved-p (ch)
  (or (and (<= ?A ch) (<= ch ?z))
      (and (<= ?0 ch) (<= ch ?9))
      (eq ?. ch)
      (eq ?- ch)
      (eq ?_ ch)
      (eq ?~ ch)))

(defun wassr-decode-html-entities (encoded-str)
  (if encoded-str
      (let ((cursor 0)
	    (found-at nil)
	    (result '()))
	(while (setq found-at
		     (string-match "&\\(#\\([0-9]+\\)\\|\\([A-Za-z]+\\)\\);"
				   encoded-str cursor))
	  (when (> found-at cursor)
	    (list-push (substring encoded-str cursor found-at) result))
	  (let ((number-entity (match-string-no-properties 2 encoded-str))
		(letter-entity (match-string-no-properties 3 encoded-str)))
	    (cond (number-entity
		   (list-push
		    (char-to-string
		     (wassr-ucs-to-char
		      (string-to-number number-entity))) result))
		  (letter-entity
		   (cond ((string= "gt" letter-entity) (list-push ">" result))
			 ((string= "lt" letter-entity) (list-push "<" result))
			 (t (list-push "?" result))))
		  (t (list-push "?" result)))
	    (setq cursor (match-end 0))))
	(list-push (substring encoded-str cursor) result)
	(apply 'concat (nreverse result)))
    ""))

(defun wassr-timer-action (func)
  (let ((buf (get-buffer wassr-buffer)))
    (if (null buf)
	(wassr-stop)
      (funcall func)
      )))

(defun wassr-update-status-if-not-blank (status)
  (if (string-match "^\\s-*\\(?:@[-_a-z0-9]+\\)?\\s-*$" status)
      nil
    (wassr-http-post "statuses" "update"
			  `(("status" . ,status)
			    ("source" . "ws-mode")))
    t))

(defun wassr-update-status-from-minibuffer (&optional init-str)
  (if (null init-str) (setq init-str ""))
  (let ((status init-str) (not-posted-p t))
    (while not-posted-p
      (setq status (read-from-minibuffer "status: " status nil nil nil nil t))
      (setq not-posted-p
	    (not (wassr-update-status-if-not-blank status))))))

(defun wassr-update-lambda ()
  (interactive)
  (wassr-http-post
   "statuses" "update"
   `(("status" . "\xd34b\xd22b\xd26f\xd224\xd224\xd268\xd34b")
     ("source" . "ws-mode"))))

(defun wassr-update-jojo (usr msg)
  (if (string-match "\xde21\xd24b\\(\xd22a\xe0b0\\|\xdaae\xe6cd\\)\xd24f\xd0d6\\([^\xd0d7]+\\)\xd0d7\xd248\xdc40\xd226"
		    msg)
      (wassr-http-post
       "statuses" "update"
       `(("status" . ,(concat
		       "@" usr " "
		       (match-string-no-properties 2 msg)
		       "\xd0a1\xd24f\xd243!?"))
	 ("source" . "ws-mode")))))

;;;
;;; Commands
;;;

(defun wassr-start (&optional action)
  (interactive)
  (if (null action)
      (setq action #'wassr-friends-timeline))
  (if wassr-timer
      nil
    (setq wassr-timer
	  (run-at-time "0 sec"
		       wassr-timer-interval
		       #'wassr-timer-action action))))

(defun wassr-stop ()
  (interactive)
  (cancel-timer wassr-timer)
  (setq wassr-timer nil))

(defun wassr-friends-timeline ()
  (interactive)
  (let ((buf (get-buffer wassr-buffer)))
    (if (not buf)
	(wassr-stop)
      (wassr-http-get "statuses" "friends_timeline")
      ))

  (if wassr-icon-mode
      (if wassr-image-stack
	  (let ((proc
		 (apply
		  #'start-process
		  "wget-images"
		  (wassr-wget-buffer)
		  "wget"
		  (format "--directory-prefix=%s" wassr-tmp-dir)
		  "--no-clobber"
		  "--quiet"
		  wassr-image-stack)))
	    (set-process-sentinel
	     proc
	     (lambda (proc stat)
	       (clear-image-cache)
	       (save-excursion
		 (set-buffer (wassr-wget-buffer))
		 )))))))

(defun wassr-update-status-interactive ()
  (interactive)
  (wassr-update-status-from-minibuffer))

(defun wassr-erase-old-statuses ()
  (interactive)
  (setq wassr-friends-timeline-data nil)
  (wassr-http-get "statuses" "friends_timeline"))

(defun wassr-click ()
  (interactive)
  (let ((uri (get-text-property (point) 'uri)))
    (if uri
	(browse-url uri))))

(defun wassr-enter ()
  (interactive)
  (let ((username (get-text-property (point) 'username))
	(uri (get-text-property (point) 'uri)))
    (if username
	(wassr-update-status-from-minibuffer (concat "@" username " "))
      (if uri
	  (browse-url uri)))))

(defun wassr-view-user-page ()
  (interactive)
  (let ((uri (get-text-property (point) 'uri)))
    (if uri
	(browse-url uri))))

(defun wassr-reply-to-user ()
  (interactive)
  (let ((username (get-text-property (point) 'username)))
    (if username
	(wassr-update-status-from-minibuffer (concat "@" username " ")))))

(defun wassr-get-password ()
  (or wassr-password
      (setq wassr-password (read-passwd "wassr-mode: "))))

(defun wassr-goto-next-status ()
  "Go to next status."
  (interactive)
  (let ((pos))
    (setq pos (wassr-get-next-username-face-pos (point)))
    (if pos
	(goto-char pos)
      (message "End of status."))))

(defun wassr-get-next-username-face-pos (pos)
  (interactive)
  (let ((prop))
    (catch 'not-found
      (while (and pos (not (eq prop wassr-username-face)))
	(setq pos (next-single-property-change pos 'face))
	(when (eq pos nil) (throw 'not-found nil))
	(setq prop (get-text-property pos 'face)))
      pos)))

(defun wassr-goto-previous-status ()
  "Go to previous status."
  (interactive)
  (let ((pos))
    (setq pos (wassr-get-previous-username-face-pos (point)))
    (if pos
	(goto-char pos)
      (message "Start of status."))))

(defun wassr-get-previous-username-face-pos (pos)
  (interactive)
  (let ((prop))
    (catch 'not-found
      (while (and pos (not (eq prop wassr-username-face)))
	(setq pos (previous-single-property-change pos 'face))
	(when (eq pos nil) (throw 'not-found nil))
	(setq prop (get-text-property pos 'face)))
      pos)))

(defun wassr-goto-next-status-of-user ()
  "Go to next status of user."
  (interactive)
  (let ((user-name (wassr-get-username-at-pos (point)))
	(pos (wassr-get-next-username-face-pos (point))))
    (while (and (not (eq pos nil))
		(not (equal (wassr-get-username-at-pos pos) user-name)))
      (setq pos (wassr-get-next-username-face-pos pos)))
    (if pos
	(goto-char pos)
      (if user-name
	  (message "End of %s's status." user-name)
	(message "Invalid user-name.")))))

(defun wassr-goto-previous-status-of-user ()
  "Go to previous status of user."
  (interactive)
  (let ((user-name (wassr-get-username-at-pos (point)))
	(pos (wassr-get-previous-username-face-pos (point))))
    (while (and (not (eq pos nil))
		(not (equal (wassr-get-username-at-pos pos) user-name)))
      (setq pos (wassr-get-previous-username-face-pos pos)))
    (if pos
	(goto-char pos)
      (if user-name
	  (message "Start of %s's status." user-name)
	(message "Invalid user-name.")))))

(defun wassr-get-username-at-pos (pos)
  (let ((start-pos pos)
	(end-pos))
    (catch 'not-found
      (while (eq (get-text-property start-pos 'face) wassr-username-face)
	(setq start-pos (1- start-pos))
	(when (or (eq start-pos nil) (eq start-pos 0)) (throw 'not-found nil)))
      (setq start-pos (1+ start-pos))
      (setq end-pos (next-single-property-change pos 'face))
      (buffer-substring start-pos end-pos))))

(defun wassr-get-status-url (username id)
  "Generate status URL."
  (format "http://wassr.jp/user/%s/statuses/%" username id))

;;;###autoload
(defun wassr ()
  "Start wassr-mode."
  (interactive)
  (wassr-mode))

(provide 'wassr-mode)
;;; wassr.el ends here