Initial import

Fri, 20 Feb 2009 09:10:17 -0500

author
Carlos Perilla <deepspawn@valkertown.org>
date
Fri, 20 Feb 2009 09:10:17 -0500
changeset 0
d1ea9fa54856
child 1
f524670023b3

Initial import

denting-mode.el file | annotate | diff | comparison | revisions
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/denting-mode.el	Fri Feb 20 09:10:17 2009 -0500
@@ -0,0 +1,1121 @@
+;;; denting-mode.el --- Major mode for Laconica
+
+;; Copyright (C) 2007 Yuto Hayamizu.
+;;               2008 Tsuyoshi CHO
+;;               2009 Carlos Perilla
+;; Author: Y. Hayamizu <y.hayamizu@gmail.com>
+;;         Tsuyoshi CHO <Tsuyoshi.CHO+develop@Gmail.com>
+;;         Carlos Perilla <deepspawn@valkertown.org>
+;; Created: Sep 4, 2007
+;; Keywords: laconica web
+;; Original URL: http://lambdarepos.svnrepository.com/share/trac.cgi/browser/lang/elisp/twittering-mode
+
+;; 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:
+
+;; denting-mode.el is a major mode for Laconica.
+;; You can check friends timeline, and update your status on Emacs.
+
+;;; Code:
+
+(require 'cl)
+(require 'xml)
+(require 'parse-time)
+
+(defconst denting-mode-version "0.7")
+(defgroup denting nil "Customize Denting Mode"
+  :tag "Laconica"
+  :group 'applications
+  )
+(defun denting-mode-version ()
+  "Display a message for denting-mode version."
+  (interactive)
+  (let ((version-string
+	 (format "denting-mode-v%s" denting-mode-version)))
+    (if (interactive-p)
+	(message "%s" version-string)
+      version-string)))
+
+(defcustom laconica-instance "identi.ca"
+  "Laconica instance that you want to use"
+  :type 'string
+  :group 'denting
+  )
+(defvar denting-mode-map (make-sparse-keymap))
+
+(defvar denting-timer nil "Timer object for timeline refreshing will be stored here. DO NOT SET VALUE MANUALLY."
+  )
+
+(defcustom denting-idle-time 20 "Idle time"
+  :type 'integer
+  :group 'denting
+  )
+
+(defcustom denting-timer-interval 90
+  "Update interval"
+  :type 'integer
+  :group 'denting
+  )
+
+(defcustom denting-username nil "Laconica Username"
+  :type 'string
+  :group 'denting
+  )
+
+(defcustom denting-password nil "Laconica Password"
+  :type 'string
+  :group 'denting
+  )
+
+(defvar denting-scroll-mode nil)
+(make-variable-buffer-local 'denting-scroll-mode)
+
+(defvar denting-jojo-mode nil)
+(make-variable-buffer-local 'denting-jojo-mode)
+
+(defcustom denting-status-format "%i %s,  %@:\n  %t // from %f%L" "The format used in the status updates"
+  :type 'string
+  :group 'denting
+)
+;; %s - screen_name
+;; %S - name
+;; %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)
+;; %@ - X seconds ago
+;; %t - text
+;; %' - truncated
+;; %f - source
+;; %# - id
+
+(defvar denting-buffer "*denting*")
+(defun denting-buffer ()
+  (denting-get-or-generate-buffer denting-buffer))
+
+(defvar denting-http-buffer "*denting-http-buffer*")
+(defun denting-http-buffer ()
+  (denting-get-or-generate-buffer denting-http-buffer))
+
+(defvar denting-friends-timeline-data nil)
+(defvar denting-friends-timeline-last-update nil)
+
+(defvar denting-username-face 'denting-username-face)
+(defvar denting-uri-face 'denting-uri-face)
+
+(defun denting-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 denting-proxy-use nil)
+(defvar denting-proxy-server nil)
+(defvar denting-proxy-port 8080)
+(defvar denting-proxy-user nil)
+(defvar denting-proxy-password nil)
+
+(defun denting-toggle-proxy () ""
+  (interactive)
+  (setq denting-proxy-use
+	(not denting-proxy-use))
+  (message "%s %s"
+	   "Use Proxy:"
+	   (if denting-proxy-use
+	       "on" "off")))
+
+(defun denting-user-agent-default-function ()
+  "Denting mode default User-Agent function."
+  (concat "Emacs/"
+	  (int-to-string emacs-major-version) "." (int-to-string
+						   emacs-minor-version)
+	  " "
+	  "denting-mode/"
+	  denting-mode-version))
+
+(defvar denting-user-agent-function 'denting-user-agent-default-function)
+
+(defun denting-user-agent ()
+  "Return User-Agent header string."
+  (funcall denting-user-agent-function))
+
+;;; to show image files
+
+(defvar denting-wget-buffer "*denting-wget-buffer*")
+(defun denting-wget-buffer ()
+  (denting-get-or-generate-buffer denting-wget-buffer))
+
+(defvar denting-tmp-dir
+  (expand-file-name (concat "emacs-images-" (user-login-name))
+		    temporary-file-directory))
+
+(defvar denting-icon-mode nil "You MUST NOT CHANGE this variable directory. You should change through function'denting-icon-mode'")
+(make-variable-buffer-local 'denting-icon-mode)
+(defun denting-icon-mode (&optional arg)
+  (interactive)
+  (setq denting-icon-mode
+	(if denting-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 denting-tmp-dir)
+	      (progn
+		(if (not (file-directory-p denting-tmp-dir))
+		    (make-directory denting-tmp-dir))
+		t)))))
+  (denting-render-friends-timeline))
+
+(defun denting-scroll-mode (&optional arg)
+  (interactive)
+  (setq denting-scroll-mode
+	(if (null arg)
+	    (not denting-scroll-mode)
+	  (> (prefix-numeric-value arg) 0))))
+
+(defun denting-jojo-mode (&optional arg)
+  (interactive)
+  (setq denting-jojo-mode
+	(if (null arg)
+	    (not denting-jojo-mode)
+	  (> (prefix-numeric-value arg) 0))))
+
+(defvar denting-image-stack nil)
+
+(defun denting-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 denting-setftime (fmt string uni)
+  (format-time-string fmt ; like "%Y-%m-%d %H:%M:%S"
+		      (apply 'encode-time (parse-time-string string))
+		      uni))
+(defun denting-local-strftime (fmt string)
+  (denting-setftime fmt string nil))
+(defun denting-global-strftime (fmt string)
+  (denting-setftime fmt string t))
+
+
+(defvar denting-debug-mode nil)
+(defvar denting-debug-buffer "*debug*")
+(defun denting-debug-buffer ()
+  (denting-get-or-generate-buffer denting-debug-buffer))
+(defmacro debug-print (obj)
+  (let ((obsym (gensym)))
+    `(let ((,obsym ,obj))
+       (if denting-debug-mode
+	   (with-current-buffer (denting-debug-buffer)
+	     (insert (prin1-to-string ,obsym))
+	     (newline)
+	     ,obsym)
+	 ,obsym))))
+
+(defun denting-debug-mode ()
+  (interactive)
+  (setq denting-debug-mode
+	(not denting-debug-mode))
+  (message (if denting-debug-mode "debug mode:on" "debug mode:off")))
+
+(if denting-mode-map
+    (let ((km denting-mode-map))
+      (define-key km "\C-c\C-f" 'denting-friends-timeline)
+      (define-key km "\C-c\C-s" 'denting-update-status-interactive)
+      (define-key km "\C-c\C-e" 'denting-erase-old-statuses)
+      (define-key km "\C-m" 'denting-enter)
+      (define-key km "\C-c\C-l" 'denting-update-lambda)
+      (define-key km [mouse-1] 'denting-click)
+      (define-key km "\C-c\C-v" 'denting-view-user-page)
+      ;; (define-key km "j" 'next-line)
+      ;; (define-key km "k" 'previous-line)
+      (define-key km "j" 'denting-goto-next-status)
+      (define-key km "k" 'denting-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" 'denting-goto-next-status-of-user)
+      (define-key km "p" 'denting-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" 'denting-icon-mode)
+      (define-key km "s" 'denting-scroll-mode)
+      (define-key km "t" 'denting-toggle-proxy)
+      (define-key km "\C-c\C-p" 'denting-toggle-proxy)
+      nil))
+
+(defvar denting-mode-syntax-table nil "")
+
+(if denting-mode-syntax-table
+    ()
+  (setq denting-mode-syntax-table (make-syntax-table))
+  ;; (modify-syntax-entry ?  "" denting-mode-syntax-table)
+  (modify-syntax-entry ?\" "w"  denting-mode-syntax-table)
+  )
+
+(defun denting-mode-init-variables ()
+  ;; (make-variable-buffer-local 'variable)
+  ;; (setq variable nil)
+  (font-lock-mode -1)
+  (defface denting-username-face
+    `((t nil)) "" :group 'faces)
+  (copy-face 'font-lock-string-face 'denting-username-face)
+  (set-face-attribute 'denting-username-face nil :underline t)
+  (defface denting-uri-face
+    `((t nil)) "" :group 'faces)
+  (set-face-attribute 'denting-uri-face nil :underline t)
+  (add-to-list 'minor-mode-alist '(denting-icon-mode " lac-icon"))
+  (add-to-list 'minor-mode-alist '(denting-scroll-mode " lac-scroll"))
+  (add-to-list 'minor-mode-alist '(denting-jojo-mode " lac-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 denting-ucs-to-char (num)
+  (if (functionp 'ucs-to-char)
+      `(ucs-to-char ,num)
+    `(decode-char 'ucs ,num)))
+
+(defvar denting-mode-string "Denting mode")
+
+(defvar denting-mode-hook nil
+  "Denting-mode hook.")
+
+(defun denting-mode ()
+  "Major mode for Laconica"
+  (interactive)
+  (switch-to-buffer (denting-buffer))
+  (kill-all-local-variables)
+  (denting-mode-init-variables)
+  (use-local-map denting-mode-map)
+  (setq major-mode 'denting-mode)
+  (setq mode-name denting-mode-string)
+  (set-syntax-table denting-mode-syntax-table)
+  (run-hooks 'denting-mode-hook)
+  (font-lock-mode -1)
+  (denting-start)
+  )
+
+;;;
+;;; Basic HTTP functions
+;;;
+
+(defun denting-http-get (method-class method &optional parameters sentinel)
+  (if (null sentinel) (setq sentinel 'denting-http-get-default-sentinel))
+
+  ;; clear the buffer
+  (save-excursion
+    (set-buffer (denting-http-buffer))
+    (erase-buffer))
+
+  (let (proc server port
+	     (proxy-user denting-proxy-user)
+	     (proxy-password denting-proxy-password))
+    (condition-case nil
+	(progn
+	  (if (and denting-proxy-use denting-proxy-server)
+	      (setq server denting-proxy-server
+		    port (if (integerp denting-proxy-port)
+			     (int-to-string denting-proxy-port)
+			   denting-proxy-port))
+	    (setq server laconica-instance
+		  port "80"))
+	  (setq proc
+		(open-network-stream
+		 "network-connection-process" (denting-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://" laconica-instance "/api/" method-class "/" method
+			   ".xml"
+			   (when parameters
+			     (concat "?"
+				     (mapconcat
+				      (lambda (param-pair)
+					(format "%s=%s"
+						(denting-percent-encode (car param-pair))
+						(denting-percent-encode (cdr param-pair))))
+				      parameters
+				      "&")))
+			   " HTTP/1.1" nl
+			   (concat "Host: " laconica-instance) nl
+			   "User-Agent: " (denting-user-agent) nl
+			   "Authorization: Basic "
+			   (base64-encode-string
+			    (concat (denting-get-username) ":" (denting-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
+			   (when denting-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 denting-http-get-default-sentinel (proc stat &optional suc-msg)
+  (let ((header (denting-get-response-header))
+	(body (denting-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
+	     #'denting-cache-status-datum
+	     (reverse (denting-xmltree-to-status
+		       body)))
+	    (denting-render-friends-timeline)
+	    (message (if suc-msg suc-msg "Success: Get.")))
+	   (t (message status))))
+      (message "Failure: Bad http response.")))
+  )
+
+(defun denting-render-friends-timeline ()
+  (with-current-buffer (denting-buffer)
+    (let ((point (point))
+	  (end (point-max)))
+      (setq buffer-read-only nil)
+      (erase-buffer)
+      (mapc (lambda (status)
+	      (insert (denting-format-status
+		       status denting-status-format))
+	      (fill-region-as-paragraph
+	       (save-excursion (beginning-of-line) (point)) (point))
+	      (insert "\n"))
+	    denting-friends-timeline-data)
+      (if denting-image-stack
+	  (clear-image-cache))
+      (setq buffer-read-only t)
+      (debug-print (current-buffer))
+      (goto-char (+ point (if denting-scroll-mode (- (point-max) end) 0))))
+    ))
+
+(defun denting-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 denting-tmp-dir
+					     "/" filename))
+		      t
+		    (add-to-list 'denting-image-stack profile-image-url))
+
+		  (when (and icon-string denting-icon-mode)
+		    (set-text-properties
+		     1 2 `(display
+			   (image :type ,(denting-image-type filename)
+				  :file ,(concat denting-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-name) 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?
+	   (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 (denting-local-strftime
+		       (or (match-string-no-properties 2 format-str) "%H:%M:%S")
+		       (attr 'created-at))
+		      result))
+	  ((?@)                         ; %@ - 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 (denting-get-status-url (attr 'user-screen-name) (attr 'id)))
+	       ;; make status url clickable
+	       (add-text-properties
+		0 (length time-string)
+		`(mouse-face highlight
+			     face denting-uri-face
+			     uri ,url)
+		time-string)
+	       (list-push time-string result))))
+	  ((?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))
+	  ((?#)                         ; %# - id
+	   (list-push (format "%d" (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 denting-http-post
+  (method-class method &optional parameters contents sentinel)
+  "Send HTTP POST request to laconica-instance
+
+METHOD-CLASS must be one of Laconica API method classes(statuses, users or direct_messages).
+METHOD must be one of Laconica 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 'denting-http-post-default-sentinel))
+
+  ;; clear the buffer
+  (save-excursion
+    (set-buffer (denting-http-buffer))
+    (erase-buffer))
+
+  (let (proc server port
+	     (proxy-user denting-proxy-user)
+	     (proxy-password denting-proxy-password))
+    (progn
+      (if (and denting-proxy-use denting-proxy-server)
+	  (setq server denting-proxy-server
+		port (if (integerp denting-proxy-port)
+			 (int-to-string denting-proxy-port)
+		       denting-proxy-port))
+	(setq server laconica-instance
+	      port "80"))
+      (setq proc
+	    (open-network-stream
+	     "network-connection-process" (denting-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://" laconica-instance "/api/" method-class "/" method ".xml"
+			(when parameters
+			  (concat "?"
+				  (mapconcat
+				   (lambda (param-pair)
+				     (format "%s=%s"
+					     (denting-percent-encode (car param-pair))
+					     (denting-percent-encode (cdr param-pair))))
+				   parameters
+				   "&")))
+			" HTTP/1.1" nl
+			(concat "Host: " laconica-instance) nl
+			"User-Agent: " (denting-user-agent) nl
+			"Authorization: Basic "
+			(base64-encode-string
+			 (concat (denting-get-username) ":" (denting-get-password)))
+			nl
+			"Content-Type: text/plain" nl
+			"Content-Length: 0" nl
+			(when denting-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 denting-http-post-default-sentinel (proc stat &optional suc-msg)
+
+  (condition-case err-signal
+      (let ((header (denting-get-response-header))
+	    ;; (body (denting-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 denting-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 `denting-http-buffer' is used as `buffer'."
+  (if (stringp buffer) (setq buffer (get-buffer buffer)))
+  (if (null buffer) (setq buffer (denting-http-buffer)))
+  (save-excursion
+    (set-buffer buffer)
+    (let ((content (buffer-string)))
+      (substring content 0 (string-match "\r?\n\r?\n" content)))))
+
+(defun denting-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 `denting-http-buffer' is used as `buffer'."
+  (if (stringp buffer) (setq buffer (get-buffer buffer)))
+  (if (null buffer) (setq buffer (denting-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 denting-cache-status-datum (status-datum &optional data-var)
+  "Cache status datum into data-var(default denting-friends-timeline-data)
+If STATUS-DATUM is already in DATA-VAR, return nil. If not, return t."
+  (if (null data-var)
+      (setf data-var 'denting-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 denting-jojo-mode
+	      (denting-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 denting-status-to-status-datum (status)
+  (flet ((assq-get (item seq)
+		   (car (cddr (assq item seq)))))
+    (let* ((status-data (cddr status))
+	   id text source created-at truncated
+	   (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
+	   regex-index)
+
+      (setq id (string-to-number (assq-get 'id status-data)))
+      (setq text (denting-decode-html-entities
+		  (assq-get 'text status-data)))
+      (setq source (denting-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 (denting-decode-html-entities
+		       (assq-get 'name user-data)))
+      (setq user-screen-name (denting-decode-html-entities
+			      (assq-get 'screen_name user-data)))
+      (setq user-location (denting-decode-html-entities
+			   (assq-get 'location user-data)))
+      (setq user-description (denting-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)
+       `(mouse-face highlight
+		    uri ,(concat "http://" laconica-instance "/" user-screen-name)
+		    face denting-username-face)
+       user-name)
+
+      ;; make screen-name clickable
+      (add-text-properties
+       0 (length user-screen-name)
+       `(mouse-face highlight
+		    face denting-username-face
+		    uri ,(concat "http://" laconica-instance "/" user-screen-name)
+		    face denting-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 denting-uri-face
+		   uri ,(concat "http://" laconica-instance "/" screen-name))
+	       `(mouse-face highlight
+			    face denting-uri-face
+			    uri ,uri))
+	     text))
+	  (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 denting-uri-face
+			  source ,source)
+	     source)
+	    ))
+
+      ;; save last update time
+      (setq denting-friends-timeline-last-update created-at)
+
+      (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)))))
+
+(defun denting-xmltree-to-status (xmltree)
+  (mapcar #'denting-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 denting-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
+      ((denting-url-reserved-p c)
+       (char-to-string c))
+      ((eq c ? ) "+")
+      (t (format "%%%x" c))))
+   (encode-coding-string str coding-system)
+   ""))
+
+(defun denting-url-reserved-p (ch)
+  (or (and (<= ?A ch) (<= ch ?z))
+      (and (<= ?0 ch) (<= ch ?9))
+      (eq ?. ch)
+      (eq ?- ch)
+      (eq ?_ ch)
+      (eq ?~ ch)))
+
+(defun denting-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
+		     (denting-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 denting-timer-action (func)
+  (let ((buf (get-buffer denting-buffer)))
+    (if (null buf)
+	(denting-stop)
+      (funcall func)
+      )))
+
+(defun denting-update-status-if-not-blank (status)
+  (if (string-match "^\\s-*\\(?:@[-_a-z0-9]+\\)?\\s-*$" status)
+      nil
+    (denting-http-post "statuses" "update"
+                       `(("status" . ,status)
+                         ("source" . "emacs")))
+    t))
+
+(defun denting-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 (denting-update-status-if-not-blank status))))))
+(defun denting-update-status-from-region (beg end)
+  (interactive "r")
+  (if (> (- end beg) 140) (setq end (+ beg 140)))
+  (if (< (- end beg) -140) (setq beg (+ end 140)))
+  (denting-update-status-if-not-blank (buffer-substring beg end)))
+;;  (let ((not-posted-p t))
+;;    (while not-posted-p
+;;      (setq not-posted-p (not (denting-update-status-if-not-blank (buffer-substring beg end)))))))
+(defun denting-update-lambda ()
+  (interactive)
+  (denting-http-post
+   "statuses" "update"
+   `(("status" . "\xd34b\xd22b\xd26f\xd224\xd224\xd268\xd34b")
+     ("source" . "emacs"))))
+
+(defun denting-update-jojo (usr msg)
+  (if (string-match "\xde21\xd24b\\(\xd22a\xe0b0\\|\xdaae\xe6cd\\)\xd24f\xd0d6\\([^\xd0d7]+\\)\xd0d7\xd248\xdc40\xd226"
+		    msg)
+      (denting-http-post
+       "statuses" "update"
+       `(("status" . ,(concat
+		       "@" usr " "
+		       (match-string-no-properties 2 msg)
+		       "\xd0a1\xd24f\xd243!?"))
+	 ("source" . "emacs")))))
+
+;;;
+;;; Commands
+;;;
+
+(defun denting-start (&optional action)
+  (interactive)
+  (if (null action)
+      (setq action #'denting-friends-timeline))
+  (if denting-timer
+      nil
+    (setq denting-timer
+	  (run-at-time "0 sec"
+		       denting-timer-interval
+		       #'denting-timer-action action))))
+
+(defun denting-stop ()
+  (interactive)
+  (cancel-timer denting-timer)
+  (setq denting-timer nil))
+
+(defun denting-friends-timeline ()
+  (interactive)
+  (let ((buf (get-buffer denting-buffer)))
+    (if (not buf)
+	(denting-stop)
+      (if (not denting-friends-timeline-last-update)
+          (denting-http-get "statuses" "friends_timeline")
+        (let* ((system-time-locale "C")
+               (since
+                (denting-global-strftime
+                 "%a, %d %b %Y %H:%M:%S GMT"
+                 denting-friends-timeline-last-update)))
+          (denting-http-get "statuses" "friends_timeline"
+                            `(("since" . ,since)))))))
+
+  (if denting-icon-mode
+      (if denting-image-stack
+	  (let ((proc
+		 (apply
+		  #'start-process
+		  "wget-images"
+		  (denting-wget-buffer)
+		  "wget"
+		  (format "--directory-prefix=%s" denting-tmp-dir)
+		  "--no-clobber"
+		  "--quiet"
+		  denting-image-stack)))
+	    (set-process-sentinel
+	     proc
+	     (lambda (proc stat)
+	       (clear-image-cache)
+	       (save-excursion
+		 (set-buffer (denting-wget-buffer))
+		 )))))))
+
+(defun denting-update-status-interactive ()
+  (interactive)
+  (denting-update-status-from-minibuffer))
+
+(defun denting-erase-old-statuses ()
+  (interactive)
+  (setq denting-friends-timeline-data nil)
+  (if (not denting-friends-timeline-last-update)
+      (denting-http-get "statuses" "friends_timeline")
+    (let* ((system-time-locale "C")
+	   (since
+            (denting-global-strftime
+             "%a, %d %b %Y %H:%M:%S GMT"
+             denting-friends-timeline-last-update)))
+      (denting-http-get "statuses" "friends_timeline"
+                        `(("since" . ,since))))))
+
+(defun denting-click ()
+  (interactive)
+  (let ((uri (get-text-property (point) 'uri)))
+    (if uri
+	(browse-url uri))))
+
+(defun denting-enter ()
+  (interactive)
+  (let ((username (get-text-property (point) 'username))
+	(uri (get-text-property (point) 'uri)))
+    (if username
+	(denting-update-status-from-minibuffer (concat "@" username " "))
+      (if uri
+	  (browse-url uri)))))
+
+(defun denting-view-user-page ()
+  (interactive)
+  (let ((uri (get-text-property (point) 'uri)))
+    (if uri
+	(browse-url uri))))
+
+(defun denting-reply-to-user ()
+  (interactive)
+  (let ((username (get-text-property (point) 'username)))
+    (if username
+	(denting-update-status-from-minibuffer (concat "@" username " ")))))
+
+(defun denting-get-password ()
+  "Ask for user password"
+  (or denting-password
+      (setq denting-password (read-passwd (concat laconica-instance "password: ")))))
+
+(defun denting-get-username ()
+  "Ask for user login"
+  (or denting-username
+      (setq denting-username (read-string (concat laconica-instance "username: ")))))
+
+(defun denting-goto-next-status ()
+  "Go to next status."
+  (interactive)
+  (let ((pos))
+    (setq pos (denting-get-next-username-face-pos (point)))
+    (if pos
+	(goto-char pos)
+      (message "End of status."))))
+
+(defun denting-get-next-username-face-pos (pos)
+  (interactive)
+  (let ((prop))
+    (catch 'not-found
+      (while (and pos (not (eq prop denting-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 denting-goto-previous-status ()
+  "Go to previous status."
+  (interactive)
+  (let ((pos))
+    (setq pos (denting-get-previous-username-face-pos (point)))
+    (if pos
+	(goto-char pos)
+      (message "Start of status."))))
+
+(defun denting-get-previous-username-face-pos (pos)
+  (interactive)
+  (let ((prop))
+    (catch 'not-found
+      (while (and pos (not (eq prop denting-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 denting-goto-next-status-of-user ()
+  "Go to next status of user."
+  (interactive)
+  (let ((user-name (denting-get-username-at-pos (point)))
+	(pos (denting-get-next-username-face-pos (point))))
+    (while (and (not (eq pos nil))
+		(not (equal (denting-get-username-at-pos pos) user-name)))
+      (setq pos (denting-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 denting-goto-previous-status-of-user ()
+  "Go to previous status of user."
+  (interactive)
+  (let ((user-name (denting-get-username-at-pos (point)))
+	(pos (denting-get-previous-username-face-pos (point))))
+    (while (and (not (eq pos nil))
+		(not (equal (denting-get-username-at-pos pos) user-name)))
+      (setq pos (denting-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 denting-get-username-at-pos (pos)
+  (let ((start-pos pos)
+	(end-pos))
+    (catch 'not-found
+      (while (eq (get-text-property start-pos 'face) denting-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 denting-get-status-url (username id)
+  "Generate status URL."
+  (format (concat "http://" laconica-instance "/%s/statuses/%d") username id))
+
+;;;###autoload
+(defun dent ()
+  "Start denting-mode."
+  (interactive)
+  (denting-mode))
+
+(provide 'denting-mode)
+;;; denting.el ends here

mercurial