Context Navigation

wassr-mode.el @ 60

Revision 60, 30.7 kB (checked in by tsuyoshi, 16 years ago)
Version 0.3

Rev	Line
[54]	1	;;; wassr-mode.el --- Major mode for Wassr
[10]	2
[54]	3	;; Copyright (C) 2008 Tsuyoshi CHO
[10]	4
[57]	5	;; Author: Tsuyoshi CHO <Tsuyoshi.CHO+develop@Gmail.com>
[10]	6	;; Created: Sep 4, 2007
[60]	7	;; Version: 0.3
[54]	8	;; Keywords: wassr web
[57]	9	;; URL: http://lambdarepos.svnrepository.com/svn/share/lang/elisp/wassr-mode/trunk
[10]	10
	11	;; This file is free software; you can redistribute it and/or modify
	12	;; it under the terms of the GNU General Public License as published by
	13	;; the Free Software Foundation; either version 2, or (at your option)
	14	;; any later version.
	15
	16	;; This file is distributed in the hope that it will be useful,
	17	;; but WITHOUT ANY WARRANTY; without even the implied warranty of
	18	;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	19	;; GNU General Public License for more details.
	20
	21	;; You should have received a copy of the GNU General Public License
	22	;; along with GNU Emacs; see the file COPYING. If not, write to
	23	;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
	24	;; Boston, MA 02111-1307, USA.
	25
	26	;;; Commentary:
	27
[54]	28	;; wassr-mode.el based on wassr-mode.el is a major mode for Wassr.
[10]	29	;; You can check friends timeline, and update your status on Emacs.
	30
[11]	31	;;; Feature Request:
	32
[10]	33	;;; Code:
	34
	35	(require 'cl)
	36	(require 'xml)
	37	(require 'parse-time)
	38
[60]	39	(defconst wassr-mode-version "0.3")
[11]	40
[54]	41	(defun wassr-mode-version ()
	42	"Display a message for wassr-mode version."
[38]	43	(interactive)
	44	(let ((version-string
[54]	45	(format "wassr-mode-v%s" wassr-mode-version)))
[38]	46	(if (interactive-p)
	47	(message "%s" version-string)
	48	version-string)))
	49
[54]	50	(defvar wassr-mode-map (make-sparse-keymap))
[10]	51
[54]	52	(defvar wassr-timer nil "Timer object for timeline refreshing will be stored here. DO NOT SET VALUE MANUALLY.")
[10]	53
[54]	54	(defvar wassr-idle-time 20)
[10]	55
[54]	56	(defvar wassr-timer-interval 90)
[10]	57
[54]	58	(defvar wassr-username nil)
[10]	59
[54]	60	(defvar wassr-password nil)
[10]	61
[54]	62	(defvar wassr-scroll-mode nil)
	63	(make-variable-buffer-local 'wassr-scroll-mode)
[10]	64
[54]	65	(defvar wassr-jojo-mode nil)
	66	(make-variable-buffer-local 'wassr-jojo-mode)
[10]	67
[54]	68	(defvar wassr-status-format nil)
[57]	69	(setq wassr-status-format "%i %s, %@:\n %t // from %A")
[38]	70	;; %s - screen_name
[57]	71	;; %S - user_login_id
[38]	72	;; %i - profile_image
[57]	73	;; %a - areacode
	74	;; %A - areaname
	75	;; %u - link
	76	;; %p - photo-thumbnail-url
	77	;; %P - photo-url
	78	;; %x - protected?
	79	;; %c - epoch
	80	;; %C{time-format-str} - epoch (formatted with time-format-str)
[38]	81	;; %@ - X seconds ago
	82	;; %t - text
[57]	83	;; %T - html
[38]	84	;; %# - id
[10]	85
[54]	86	(defvar wassr-buffer "wassr")
[57]	87	(defconst wassr-api-server "api.wassr.jp")
[54]	88	(defun wassr-buffer ()
	89	(wassr-get-or-generate-buffer wassr-buffer))
[10]	90
[54]	91	(defvar wassr-http-buffer "wassr-http-buffer")
	92	(defun wassr-http-buffer ()
	93	(wassr-get-or-generate-buffer wassr-http-buffer))
[10]	94
[54]	95	(defvar wassr-friends-timeline-data nil)
[10]	96
[54]	97	(defvar wassr-username-face 'wassr-username-face)
	98	(defvar wassr-uri-face 'wassr-uri-face)
[10]	99
[54]	100	(defun wassr-get-or-generate-buffer (buffer)
[10]	101	(if (bufferp buffer)
	102	(if (buffer-live-p buffer)
	103	buffer
	104	(generate-new-buffer (buffer-name buffer)))
	105	(if (stringp buffer)
	106	(or (get-buffer buffer)
	107	(generate-new-buffer buffer)))))
	108
	109	(defun assocref (item alist)
[11]	110	(cdr (assoc item alist)))
[38]	111	(defmacro list-push (value listvar)
	112	`(setq ,listvar (cons ,value ,listvar)))
[10]	113
[11]	114	;;; Proxy
[54]	115	(defvar wassr-proxy-use nil)
	116	(defvar wassr-proxy-server nil)
	117	(defvar wassr-proxy-port 8080)
	118	(defvar wassr-proxy-user nil)
	119	(defvar wassr-proxy-password nil)
[11]	120
[54]	121	(defun wassr-toggle-proxy () ""
[11]	122	(interactive)
[54]	123	(setq wassr-proxy-use
	124	(not wassr-proxy-use))
[11]	125	(message "%s %s"
	126	"Use Proxy:"
[54]	127	(if wassr-proxy-use
[11]	128	"on" "off")))
	129
[54]	130	(defun wassr-user-agent-default-function ()
	131	"Wassr mode default User-Agent function."
[11]	132	(concat "Emacs/"
	133	(int-to-string emacs-major-version) "." (int-to-string
	134	emacs-minor-version)
	135	" "
[54]	136	"Wassr-mode/"
	137	wassr-mode-version))
[11]	138
[54]	139	(defvar wassr-user-agent-function 'wassr-user-agent-default-function)
[11]	140
[54]	141	(defun wassr-user-agent ()
[11]	142	"Return User-Agent header string."
[54]	143	(funcall wassr-user-agent-function))
[11]	144
[10]	145	;;; to show image files
	146
[54]	147	(defvar wassr-wget-buffer "wassr-wget-buffer")
	148	(defun wassr-wget-buffer ()
	149	(wassr-get-or-generate-buffer wassr-wget-buffer))
[10]	150
[54]	151	(defvar wassr-tmp-dir
	152	(expand-file-name (concat "wassr-mode-images-" (user-login-name))
[11]	153	temporary-file-directory))
[10]	154
[54]	155	(defvar wassr-icon-mode nil "You MUST NOT CHANGE this variable directory. You should change through function'wassr-icon-mode'")
	156	(make-variable-buffer-local 'wassr-icon-mode)
	157	(defun wassr-icon-mode (&optional arg)
[10]	158	(interactive)
[54]	159	(setq wassr-icon-mode
	160	(if wassr-icon-mode
[10]	161	(if (null arg)
	162	nil
	163	(> (prefix-numeric-value arg) 0))
	164	(when (or (null arg)
	165	(and arg (> (prefix-numeric-value arg) 0)))
[54]	166	(when (file-writable-p wassr-tmp-dir)
[11]	167	(progn
[54]	168	(if (not (file-directory-p wassr-tmp-dir))
	169	(make-directory wassr-tmp-dir))
[10]	170	t)))))
[54]	171	(wassr-render-friends-timeline))
[10]	172
[54]	173	(defun wassr-scroll-mode (&optional arg)
[10]	174	(interactive)
[54]	175	(setq wassr-scroll-mode
[11]	176	(if (null arg)
[54]	177	(not wassr-scroll-mode)
[11]	178	(> (prefix-numeric-value arg) 0))))
[10]	179
[54]	180	(defun wassr-jojo-mode (&optional arg)
[10]	181	(interactive)
[54]	182	(setq wassr-jojo-mode
[11]	183	(if (null arg)
[54]	184	(not wassr-jojo-mode)
[11]	185	(> (prefix-numeric-value arg) 0))))
[10]	186
[54]	187	(defvar wassr-image-stack nil)
[10]	188
[54]	189	(defun wassr-image-type (file-name)
[10]	190	(cond
	191	((string-match "\\.jpe?g" file-name) 'jpeg)
	192	((string-match "\\.png" file-name) 'png)
	193	((string-match "\\.gif" file-name) 'gif)
	194	(t nil)))
	195
[54]	196	(defun wassr-local-strftime (fmt string)
[10]	197	(format-time-string fmt ; like "%Y-%m-%d %H:%M:%S", shown in localtime
	198	(apply 'encode-time (parse-time-string string))))
	199
[54]	200	(defvar wassr-debug-mode nil)
	201	(defvar wassr-debug-buffer "debug")
	202	(defun wassr-debug-buffer ()
	203	(wassr-get-or-generate-buffer wassr-debug-buffer))
[10]	204	(defmacro debug-print (obj)
	205	(let ((obsym (gensym)))
	206	`(let ((,obsym ,obj))
[54]	207	(if wassr-debug-mode
	208	(with-current-buffer (wassr-debug-buffer)
[10]	209	(insert (prin1-to-string ,obsym))
	210	(newline)
	211	,obsym)
[11]	212	,obsym))))
[10]	213
[54]	214	(defun wassr-debug-mode ()
[10]	215	(interactive)
[54]	216	(setq wassr-debug-mode
	217	(not wassr-debug-mode))
	218	(message (if wassr-debug-mode "debug mode:on" "debug mode:off")))
[10]	219
[54]	220	(if wassr-mode-map
	221	(let ((km wassr-mode-map))
	222	(define-key km "\C-c\C-f" 'wassr-friends-timeline)
	223	(define-key km "\C-c\C-s" 'wassr-update-status-interactive)
	224	(define-key km "\C-c\C-e" 'wassr-erase-old-statuses)
	225	(define-key km "\C-m" 'wassr-enter)
	226	(define-key km "\C-c\C-l" 'wassr-update-lambda)
	227	(define-key km [mouse-1] 'wassr-click)
	228	(define-key km "\C-c\C-v" 'wassr-view-user-page)
[38]	229	;; (define-key km "j" 'next-line)
	230	;; (define-key km "k" 'previous-line)
[54]	231	(define-key km "j" 'wassr-goto-next-status)
	232	(define-key km "k" 'wassr-goto-previous-status)
[10]	233	(define-key km "l" 'forward-char)
	234	(define-key km "h" 'backward-char)
	235	(define-key km "0" 'beginning-of-line)
	236	(define-key km "^" 'beginning-of-line-text)
	237	(define-key km "$" 'end-of-line)
[54]	238	(define-key km "n" 'wassr-goto-next-status-of-user)
	239	(define-key km "p" 'wassr-goto-previous-status-of-user)
[10]	240	(define-key km [backspace] 'backward-char)
	241	(define-key km "G" 'end-of-buffer)
	242	(define-key km "H" 'beginning-of-buffer)
[54]	243	(define-key km "i" 'wassr-icon-mode)
	244	(define-key km "s" 'wassr-scroll-mode)
	245	(define-key km "t" 'wassr-toggle-proxy)
	246	(define-key km "\C-c\C-p" 'wassr-toggle-proxy)
[10]	247	nil))
	248
[54]	249	(defvar wassr-mode-syntax-table nil "")
[10]	250
[54]	251	(if wassr-mode-syntax-table
[10]	252	()
[54]	253	(setq wassr-mode-syntax-table (make-syntax-table))
	254	;; (modify-syntax-entry ? "" wassr-mode-syntax-table)
	255	(modify-syntax-entry ?\" "w" wassr-mode-syntax-table)
[10]	256	)
	257
[54]	258	(defun wassr-mode-init-variables ()
[38]	259	;; (make-variable-buffer-local 'variable)
	260	;; (setq variable nil)
[10]	261	(font-lock-mode -1)
[54]	262	(defface wassr-username-face
[10]	263	`((t nil)) "" :group 'faces)
[54]	264	(copy-face 'font-lock-string-face 'wassr-username-face)
	265	(set-face-attribute 'wassr-username-face nil :underline t)
	266	(defface wassr-uri-face
[10]	267	`((t nil)) "" :group 'faces)
[54]	268	(set-face-attribute 'wassr-uri-face nil :underline t)
	269	(add-to-list 'minor-mode-alist '(wassr-icon-mode " ws-icon"))
	270	(add-to-list 'minor-mode-alist '(wassr-scroll-mode " ws-scroll"))
	271	(add-to-list 'minor-mode-alist '(wassr-jojo-mode " ws-jojo"))
[10]	272	)
	273
	274	(defmacro case-string (str &rest clauses)
	275	`(cond
	276	,@(mapcar
	277	(lambda (clause)
	278	(let ((keylist (car clause))
	279	(body (cdr clause)))
	280	`(,(if (listp keylist)
	281	`(or ,@(mapcar (lambda (key) `(string-equal ,str ,key)) keylist))
	282	't)
	283	,@body)))
	284	clauses)))
	285
	286	;; If you use Emacs21, decode-char 'ucs will fail unless Mule-UCS is loaded.
	287	;; TODO: Show error messages if Emacs 21 without Mule-UCS
[54]	288	(defmacro wassr-ucs-to-char (num)
[10]	289	(if (functionp 'ucs-to-char)
	290	`(ucs-to-char ,num)
	291	`(decode-char 'ucs ,num)))
	292
[54]	293	(defvar wassr-mode-string "Wassr mode")
[11]	294
[54]	295	(defvar wassr-mode-hook nil
	296	"Wassr-mode hook.")
[38]	297
[54]	298	(defun wassr-mode ()
	299	"Major mode for Wassr"
[10]	300	(interactive)
[54]	301	(switch-to-buffer (wassr-buffer))
[10]	302	(kill-all-local-variables)
[54]	303	(wassr-mode-init-variables)
	304	(use-local-map wassr-mode-map)
	305	(setq major-mode 'wassr-mode)
	306	(setq mode-name wassr-mode-string)
	307	(set-syntax-table wassr-mode-syntax-table)
	308	(run-hooks 'wassr-mode-hook)
[10]	309	(font-lock-mode -1)
[54]	310	(wassr-start)
[10]	311	)
	312
	313	;;;
	314	;;; Basic HTTP functions
	315	;;;
	316
[59]	317	(defun wassr-http-get (method-class method type &optional sentinel)
[54]	318	(if (null sentinel) (setq sentinel 'wassr-http-get-default-sentinel))
[10]	319
	320	;; clear the buffer
	321	(save-excursion
[54]	322	(set-buffer (wassr-http-buffer))
[10]	323	(erase-buffer))
	324
[11]	325	(let (proc server port
[54]	326	(proxy-user wassr-proxy-user)
	327	(proxy-password wassr-proxy-password))
[10]	328	(condition-case nil
	329	(progn
[54]	330	(if (and wassr-proxy-use wassr-proxy-server)
	331	(setq server wassr-proxy-server
	332	port (if (integerp wassr-proxy-port)
	333	(int-to-string wassr-proxy-port)
	334	wassr-proxy-port))
[57]	335	(setq server wassr-api-server
[11]	336	port "80"))
[10]	337	(setq proc
	338	(open-network-stream
[54]	339	"network-connection-process" (wassr-http-buffer)
[11]	340	server (string-to-number port)))
[10]	341	(set-process-sentinel proc sentinel)
	342	(process-send-string
	343	proc
[11]	344	(let ((nl "\r\n")
	345	request)
	346	(setq request
[59]	347	(concat "GET http://" wassr-api-server "/" method-class "/"
	348	method "." type " HTTP/1.1" nl
[57]	349	"Host: " wassr-api-server nl
[54]	350	"User-Agent: " (wassr-user-agent) nl
[11]	351	"Authorization: Basic "
	352	(base64-encode-string
[54]	353	(concat wassr-username ":" (wassr-get-password)))
[11]	354	nl
	355	"Accept: text/xml"
	356	",application/xml"
	357	",application/xhtml+xml"
	358	",application/html;q=0.9"
	359	",text/plain;q=0.8"
	360	",image/png,/;q=0.5" nl
	361	"Accept-Charset: utf-8;q=0.7,*;q=0.7" nl
[57]	362	"Connection: Keep-Alive" nl
[54]	363	(when wassr-proxy-use
[11]	364	"Proxy-Connection: Keep-Alive" nl
	365	(when (and proxy-user proxy-password)
	366	(concat
	367	"Proxy-Authorization: Basic "
	368	(base64-encode-string
	369	(concat proxy-user ":"
	370	proxy-password))
	371	nl)))
[57]	372	nl))
[11]	373	(debug-print (concat "GET Request\n" request))
	374	request)))
[10]	375	(error
	376	(message "Failure: HTTP GET") nil))))
	377
[54]	378	(defun wassr-http-get-default-sentinel (proc stat &optional suc-msg)
	379	(let ((header (wassr-get-response-header))
	380	(body (wassr-get-response-body))
[11]	381	(status nil)
	382	)
	383	(if (string-match "HTTP/1\.[01] \$[a-z0-9 ]+\$\r?\n" header)
	384	(progn
	385	(setq status (match-string-no-properties 1 header))
	386	(case-string
	387	status
	388	(("200 OK")
	389	(mapcar
[54]	390	#'wassr-cache-status-datum
	391	(reverse (wassr-xmltree-to-status
[11]	392	body)))
[54]	393	(wassr-render-friends-timeline)
[11]	394	(message (if suc-msg suc-msg "Success: Get.")))
	395	(t (message status))))
	396	(message "Failure: Bad http response.")))
[10]	397	)
	398
[54]	399	(defun wassr-render-friends-timeline ()
	400	(with-current-buffer (wassr-buffer)
[10]	401	(let ((point (point))
	402	(end (point-max)))
	403	(setq buffer-read-only nil)
	404	(erase-buffer)
[38]	405	(mapc (lambda (status)
[54]	406	(insert (wassr-format-status
	407	status wassr-status-format))
[38]	408	(fill-region-as-paragraph
	409	(save-excursion (beginning-of-line) (point)) (point))
	410	(insert "\n"))
[54]	411	wassr-friends-timeline-data)
	412	(if wassr-image-stack
[10]	413	(clear-image-cache))
	414	(setq buffer-read-only t)
	415	(debug-print (current-buffer))
[54]	416	(goto-char (+ point (if wassr-scroll-mode (- (point-max) end) 0))))
[10]	417	))
	418
[54]	419	(defun wassr-format-status (status format-str)
[10]	420	(flet ((attr (key)
	421	(assocref key status))
	422	(profile-image
	423	()
	424	(let ((profile-image-url (attr 'user-profile-image-url))
	425	(icon-string "\n "))
	426	(if (string-match "/\$[^/?]+\$\$?:\\?\\\|$\$" profile-image-url)
	427	(let ((filename (match-string-no-properties 1 profile-image-url)))
	428	;; download icons if does not exist
[54]	429	(if (file-exists-p (concat wassr-tmp-dir
[10]	430	"/" filename))
	431	t
[54]	432	(add-to-list 'wassr-image-stack profile-image-url))
[10]	433
[54]	434	(when (and icon-string wassr-icon-mode)
[10]	435	(set-text-properties
	436	1 2 `(display
[54]	437	(image :type ,(wassr-image-type filename)
	438	:file ,(concat wassr-tmp-dir
[10]	439	"/"
	440	filename)))
	441	icon-string)
	442	icon-string)
	443	)))))
	444	(let ((cursor 0)
	445	(result ())
	446	c
	447	found-at)
	448	(setq cursor 0)
	449	(setq result '())
	450	(while (setq found-at (string-match "%\$C{\\([^}]+\$}\\\|[A-Za-z#@']\\)" format-str cursor))
	451	(setq c (string-to-char (match-string-no-properties 1 format-str)))
	452	(if (> found-at cursor)
[38]	453	(list-push (substring format-str cursor found-at) result)
[10]	454	"\|")
	455	(setq cursor (match-end 1))
	456
	457	(case c
[38]	458	((?s) ; %s - screen_name
	459	(list-push (attr 'user-screen-name) result))
	460	((?S) ; %S - name
[57]	461	(list-push (attr 'user-login-id) result))
[38]	462	((?i) ; %i - profile_image
	463	(list-push (profile-image) result))
[57]	464	((?a) ;
	465	(list-push (attr 'areacode) result))
	466	((?A) ;
	467	(list-push (attr 'areaname) result))
	468	((?u) ; %u - link
	469	(list-push (attr 'link) result))
	470	((?p) ; %u - link
	471	(list-push (attr 'photo-thumbnail-url) result))
	472	((?P) ; %u - link
	473	(list-push (attr 'photo-url) result))
	474	((?x) ; %p - protected?
[10]	475	(let ((protected (attr 'user-protected)))
	476	(when (string= "true" protected)
[38]	477	(list-push "[x]" result))))
[57]	478	((?c) ; %c - epoch (raw UTC string)
	479	(list-push (attr 'epoch) result))
	480	((?C) ; %C{time-format-str} - epoch (formatted with time-format-str)
	481	(list-push (attr 'epoch) result));;FIXME
[38]	482	((?@) ; %@ - X seconds ago
[57]	483	(list-push (attr 'epoch) result));;FIXME
[38]	484	((?t) ; %t - text
	485	(list-push ;(clickable-text)
[10]	486	(attr 'text)
	487	result))
[57]	488	((?T) ; %T - html
	489	(list-push ;(clickable-text)
	490	(attr 'html)
	491	result))
[38]	492	((?#) ; %# - id
[57]	493	(list-push (attr 'id) result))
[10]	494	(t
[38]	495	(list-push (char-to-string c) result)))
[10]	496	)
[38]	497	(list-push (substring format-str cursor) result)
[47]	498	(let ((formatted-status (apply 'concat (nreverse result))))
	499	(add-text-properties 0 (length formatted-status)
[59]	500	`(username ,(attr 'user-login-id))
[47]	501	formatted-status)
	502	formatted-status)
[10]	503	)))
	504
[54]	505	(defun wassr-http-post
[59]	506	(method-class method type &optional parameters contents sentinel)
[57]	507	"Send HTTP POST request to `wassr-api-server'
[10]	508
[54]	509	METHOD-CLASS must be one of Wassr API method classes(statuses, users or direct_messages).
	510	METHOD must be one of Wassr API method which belongs to METHOD-CLASS.
[10]	511	PARAMETERS is alist of URI parameters. ex) ((\"mode\" . \"view\") (\"page\" . \"6\")) => <URI>?mode=view&page=6"
[54]	512	(if (null sentinel) (setq sentinel 'wassr-http-post-default-sentinel))
[10]	513
	514	;; clear the buffer
	515	(save-excursion
[54]	516	(set-buffer (wassr-http-buffer))
[10]	517	(erase-buffer))
	518
[11]	519	(let (proc server port
[54]	520	(proxy-user wassr-proxy-user)
	521	(proxy-password wassr-proxy-password))
[10]	522	(progn
[54]	523	(if (and wassr-proxy-use wassr-proxy-server)
	524	(setq server wassr-proxy-server
	525	port (if (integerp wassr-proxy-port)
	526	(int-to-string wassr-proxy-port)
	527	wassr-proxy-port))
[57]	528	(setq server wassr-api-server
[11]	529	port "80"))
[10]	530	(setq proc
	531	(open-network-stream
[54]	532	"network-connection-process" (wassr-http-buffer)
[11]	533	server (string-to-number port)))
[10]	534	(set-process-sentinel proc sentinel)
	535	(process-send-string
	536	proc
[11]	537	(let ((nl "\r\n")
	538	request)
[38]	539	(setq request
[59]	540	(concat "POST http://" wassr-api-server "/" method-class "/"
	541	method "." type "?"
[11]	542	(if parameters
	543	(mapconcat
	544	(lambda (param-pair)
	545	(format "%s=%s"
[54]	546	(wassr-percent-encode (car param-pair))
	547	(wassr-percent-encode (cdr param-pair))))
[11]	548	parameters
	549	"&"))
	550	" HTTP/1.1" nl
[57]	551	"Host: " wassr-api-server nl
[54]	552	"User-Agent: " (wassr-user-agent) nl
[11]	553	"Authorization: Basic "
	554	(base64-encode-string
[54]	555	(concat wassr-username ":" (wassr-get-password)))
[11]	556	nl
	557	"Content-Type: text/plain" nl
	558	"Content-Length: 0" nl
[57]	559	"Connection: Keep-Alive" nl
[54]	560	(when wassr-proxy-use
[11]	561	"Proxy-Connection: Keep-Alive" nl
	562	(when (and proxy-user proxy-password)
	563	(concat
	564	"Proxy-Authorization: Basic "
	565	(base64-encode-string
	566	(concat proxy-user ":"
	567	proxy-password))
	568	nl)))
[57]	569	nl))
[11]	570	(debug-print (concat "POST Request\n" request))
	571	request)))))
[10]	572
[54]	573	(defun wassr-http-post-default-sentinel (proc stat &optional suc-msg)
[11]	574
[10]	575	(condition-case err-signal
[54]	576	(let ((header (wassr-get-response-header))
	577	;; (body (wassr-get-response-body)) not used now.
[10]	578	(status nil))
	579	(string-match "HTTP/1\.1 \$[a-z0-9 ]+\$\r?\n" header)
	580	(setq status (match-string-no-properties 1 header))
	581	(case-string status
	582	(("200 OK")
	583	(message (if suc-msg suc-msg "Success: Post")))
	584	(t (message status)))
	585	)
	586	(error (message (prin1-to-string err-signal))))
	587	)
	588
[54]	589	(defun wassr-get-response-header (&optional buffer)
[38]	590	"Exract HTTP response header from HTTP response.
[10]	591	`buffer' may be a buffer or the name of an existing buffer.
[54]	592	If `buffer' is omitted, the value of `wassr-http-buffer' is used as `buffer'."
[10]	593	(if (stringp buffer) (setq buffer (get-buffer buffer)))
[54]	594	(if (null buffer) (setq buffer (wassr-http-buffer)))
[10]	595	(save-excursion
	596	(set-buffer buffer)
	597	(let ((content (buffer-string)))
	598	(substring content 0 (string-match "\r?\n\r?\n" content)))))
	599
[54]	600	(defun wassr-get-response-body (&optional buffer)
[38]	601	"Exract HTTP response body from HTTP response, parse it as XML, and return a XML tree as list.
[10]	602	`buffer' may be a buffer or the name of an existing buffer.
[54]	603	If `buffer' is omitted, the value of `wassr-http-buffer' is used as `buffer'."
[10]	604	(if (stringp buffer) (setq buffer (get-buffer buffer)))
[54]	605	(if (null buffer) (setq buffer (wassr-http-buffer)))
[10]	606	(save-excursion
	607	(set-buffer buffer)
	608	(let ((content (buffer-string)))
	609	(let ((content (buffer-string)))
	610	(xml-parse-region (+ (string-match "\r?\n\r?\n" content)
	611	(length (match-string 0 content)))
	612	(point-max)))
	613	)))
	614
[54]	615	(defun wassr-cache-status-datum (status-datum &optional data-var)
	616	"Cache status datum into data-var(default wassr-friends-timeline-data)
[10]	617	If STATUS-DATUM is already in DATA-VAR, return nil. If not, return t."
	618	(if (null data-var)
[54]	619	(setf data-var 'wassr-friends-timeline-data))
[11]	620	(let ((id (cdr (assq 'id status-datum))))
[10]	621	(if (or (null (symbol-value data-var))
	622	(not (find-if
	623	(lambda (item)
	624	(eql id (cdr (assq 'id item))))
	625	(symbol-value data-var))))
	626	(progn
[54]	627	(if wassr-jojo-mode
	628	(wassr-update-jojo (cdr (assq 'user-screen-name status-datum))
[10]	629	(cdr (assq 'text status-datum))))
	630	(set data-var (cons status-datum (symbol-value data-var)))
	631	t)
	632	nil)))
	633
[54]	634	(defun wassr-status-to-status-datum (status)
[10]	635	(flet ((assq-get (item seq)
	636	(car (cddr (assq item seq)))))
	637	(let* ((status-data (cddr status))
[57]	638	html
	639	text
	640	epoch
	641	rid
	642	id
	643	user-login-id ;; user_login_id
	644	link
	645	photo-url ;; photo_url
	646	areacode
	647	areaname
	648	photo-thumbnail-url ;; photo_thumbnail_url
	649	reply-status-url ;; reply_status_url
	650	reply-user-login-id ;; reply_user_login_id
	651	reply-message ;; reply_message
	652	reply-user-nick ;; reply_user_nick
	653	slurl
[10]	654	(user-data (cddr (assq 'user status-data)))
[57]	655	user-protected ;; protected
	656	user-profile-image-url ;; profile_image_url
	657	user-screen-name ;; screen_name
[10]	658	regex-index)
[11]	659
[54]	660	(setq text (wassr-decode-html-entities
[10]	661	(assq-get 'text status-data)))
[57]	662	(setq html (wassr-decode-html-entities
	663	(assq-get 'html status-data)))
	664	(setq epoch (assq-get 'epoch status-data))
	665	(setq rid (assq-get 'rid status-data))
	666	(setq id (assq-get 'id status-data))
	667	(setq user-login-id (assq-get 'user_login_id status-data))
	668	(setq link (assq-get 'link status-data))
	669	(setq photo-url (assq-get 'photo_url status-data))
	670	(setq areacode (assq-get 'areacode status-data))
	671	(setq areaname (assq-get 'areaname status-data))
	672	(setq photo-thumbnail-url (assq-get 'photo_thumbnail_url status-data))
	673	(setq reply-status-url (assq-get 'reply_status_url status-data))
	674	(setq reply-user-login-id (assq-get 'reply_user_login_id status-data))
	675	(setq reply-message (assq-get 'reply_message status-data))
	676	(setq reply-user-nick (assq-get 'reply_user_nick status-data))
	677	(setq slurl (assq-get 'slurl status-data))
[54]	678	(setq user-screen-name (wassr-decode-html-entities
[10]	679	(assq-get 'screen_name user-data)))
	680	(setq user-profile-image-url (assq-get 'profile_image_url user-data))
	681	(setq user-protected (assq-get 'protected user-data))
	682
	683	;; make username clickable
[47]	684	(add-text-properties
[57]	685	0 (length user-login-id)
[47]	686	`(mouse-face highlight
[59]	687	uri ,(concat "http://wassr.jp/user/" user-login-id)
[54]	688	face wassr-username-face)
[57]	689	user-login-id)
[10]	690
[47]	691	;; make screen-name clickable
	692	(add-text-properties
	693	0 (length user-screen-name)
	694	`(mouse-face highlight
[54]	695	face wassr-username-face
[59]	696	uri ,(concat "http://wassr.jp/user/" user-login-id)
[54]	697	face wassr-username-face)
[47]	698	user-screen-name)
	699
[10]	700	;; make URI clickable
	701	(setq regex-index 0)
	702	(while regex-index
	703	(setq regex-index
	704	(string-match "@\$[_a-zA-Z0-9]+\$\\\|\$https?://[-_.!~*'()a-zA-Z0-9;/?:@&=+$,%#]+\$"
	705	text
	706	regex-index))
	707	(when regex-index
	708	(let* ((matched-string (match-string-no-properties 0 text))
	709	(screen-name (match-string-no-properties 1 text))
	710	(uri (match-string-no-properties 2 text)))
	711	(add-text-properties
	712	(if screen-name
	713	(+ 1 (match-beginning 0))
	714	(match-beginning 0))
	715	(match-end 0)
	716	(if screen-name
	717	`(mouse-face
	718	highlight
[54]	719	face wassr-uri-face
[57]	720	uri ,(concat "http://wassr.jp/user/" screen-name))
[10]	721	`(mouse-face highlight
[54]	722	face wassr-uri-face
[11]	723	uri ,uri))
[10]	724	text))
	725	(setq regex-index (match-end 0)) ))
	726
	727	(mapcar
	728	(lambda (sym)
	729	`(,sym . ,(symbol-value sym)))
[57]	730	'(html text epoch rid id user-login-id
	731	link photo-url areacode areaname
	732	photo-thumbnail-url
	733	reply-status-url
	734	reply-user-login-id
	735	reply-message
	736	reply-user-nick
	737	slurl
	738	user-protected
	739	user-profile-image-url
	740	user-screen-name
	741	)))))
[10]	742
[54]	743	(defun wassr-xmltree-to-status (xmltree)
	744	(mapcar #'wassr-status-to-status-datum
[10]	745	;; quirk to treat difference between xml.el in Emacs21 and Emacs22
	746	;; On Emacs22, there may be blank strings
	747	(let ((ret nil) (statuses (reverse (cddr (car xmltree)))))
	748	(while statuses
	749	(if (consp (car statuses))
	750	(setq ret (cons (car statuses) ret)))
	751	(setq statuses (cdr statuses)))
	752	ret)))
	753
[54]	754	(defun wassr-percent-encode (str &optional coding-system)
[10]	755	(if (or (null coding-system)
	756	(not (coding-system-p coding-system)))
	757	(setq coding-system 'utf-8))
	758	(mapconcat
	759	(lambda (c)
	760	(cond
[54]	761	((wassr-url-reserved-p c)
[10]	762	(char-to-string c))
	763	((eq c ? ) "+")
	764	(t (format "%%%x" c))))
	765	(encode-coding-string str coding-system)
	766	""))
	767
[54]	768	(defun wassr-url-reserved-p (ch)
[10]	769	(or (and (<= ?A ch) (<= ch ?z))
	770	(and (<= ?0 ch) (<= ch ?9))
	771	(eq ?. ch)
	772	(eq ?- ch)
	773	(eq ?_ ch)
	774	(eq ?~ ch)))
	775
[54]	776	(defun wassr-decode-html-entities (encoded-str)
[10]	777	(if encoded-str
	778	(let ((cursor 0)
	779	(found-at nil)
	780	(result '()))
	781	(while (setq found-at
	782	(string-match "&\$#\\([0-9]+\$\\\|\$[A-Za-z]+\$\\);"
	783	encoded-str cursor))
	784	(when (> found-at cursor)
[38]	785	(list-push (substring encoded-str cursor found-at) result))
[10]	786	(let ((number-entity (match-string-no-properties 2 encoded-str))
	787	(letter-entity (match-string-no-properties 3 encoded-str)))
	788	(cond (number-entity
[38]	789	(list-push
[10]	790	(char-to-string
[54]	791	(wassr-ucs-to-char
[10]	792	(string-to-number number-entity))) result))
	793	(letter-entity
[38]	794	(cond ((string= "gt" letter-entity) (list-push ">" result))
	795	((string= "lt" letter-entity) (list-push "<" result))
	796	(t (list-push "?" result))))
	797	(t (list-push "?" result)))
[10]	798	(setq cursor (match-end 0))))
[38]	799	(list-push (substring encoded-str cursor) result)
[10]	800	(apply 'concat (nreverse result)))
	801	""))
	802
[54]	803	(defun wassr-timer-action (func)
	804	(let ((buf (get-buffer wassr-buffer)))
[10]	805	(if (null buf)
[54]	806	(wassr-stop)
[10]	807	(funcall func)
	808	)))
	809
[54]	810	(defun wassr-update-status-if-not-blank (status)
[10]	811	(if (string-match "^\\s-\$?:@[-_a-z0-9]+\$?\\s-$" status)
	812	nil
[59]	813	(wassr-http-post "statuses" "update" "json"
[10]	814	`(("status" . ,status)
[54]	815	("source" . "ws-mode")))
[10]	816	t))
	817
[54]	818	(defun wassr-update-status-from-minibuffer (&optional init-str)
[10]	819	(if (null init-str) (setq init-str ""))
	820	(let ((status init-str) (not-posted-p t))
	821	(while not-posted-p
	822	(setq status (read-from-minibuffer "status: " status nil nil nil nil t))
	823	(setq not-posted-p
[54]	824	(not (wassr-update-status-if-not-blank status))))))
[10]	825
[54]	826	(defun wassr-update-lambda ()
[10]	827	(interactive)
[54]	828	(wassr-http-post
[59]	829	"statuses" "update" "json"
[10]	830	`(("status" . "\xd34b\xd22b\xd26f\xd224\xd224\xd268\xd34b")
[54]	831	("source" . "ws-mode"))))
[10]	832
[54]	833	(defun wassr-update-jojo (usr msg)
[10]	834	(if (string-match "\xde21\xd24b\$\xd22a\xe0b0\\\|\xdaae\xe6cd\$\xd24f\xd0d6\$[^\xd0d7]+\$\xd0d7\xd248\xdc40\xd226"
	835	msg)
[54]	836	(wassr-http-post
[59]	837	"statuses" "update" "json"
[10]	838	`(("status" . ,(concat
	839	"@" usr " "
	840	(match-string-no-properties 2 msg)
	841	"\xd0a1\xd24f\xd243!?"))
[54]	842	("source" . "ws-mode")))))
[10]	843
	844	;;;
	845	;;; Commands
	846	;;;
	847
[54]	848	(defun wassr-start (&optional action)
[10]	849	(interactive)
	850	(if (null action)
[54]	851	(setq action #'wassr-friends-timeline))
	852	(if wassr-timer
[10]	853	nil
[54]	854	(setq wassr-timer
[10]	855	(run-at-time "0 sec"
[54]	856	wassr-timer-interval
	857	#'wassr-timer-action action))))
[10]	858
[54]	859	(defun wassr-stop ()
[10]	860	(interactive)
[54]	861	(cancel-timer wassr-timer)
	862	(setq wassr-timer nil))
[10]	863
[54]	864	(defun wassr-friends-timeline ()
[10]	865	(interactive)
[54]	866	(let ((buf (get-buffer wassr-buffer)))
[10]	867	(if (not buf)
[54]	868	(wassr-stop)
[59]	869	(wassr-http-get "statuses" "friends_timeline" "xml")
[10]	870	))
	871
[54]	872	(if wassr-icon-mode
	873	(if wassr-image-stack
[10]	874	(let ((proc
	875	(apply
	876	#'start-process
	877	"wget-images"
[54]	878	(wassr-wget-buffer)
[10]	879	"wget"
[54]	880	(format "--directory-prefix=%s" wassr-tmp-dir)
[10]	881	"--no-clobber"
	882	"--quiet"
[54]	883	wassr-image-stack)))
[10]	884	(set-process-sentinel
	885	proc
	886	(lambda (proc stat)
	887	(clear-image-cache)
	888	(save-excursion
[54]	889	(set-buffer (wassr-wget-buffer))
[10]	890	)))))))
	891
[54]	892	(defun wassr-update-status-interactive ()
[10]	893	(interactive)
[54]	894	(wassr-update-status-from-minibuffer))
[10]	895
[54]	896	(defun wassr-erase-old-statuses ()
[10]	897	(interactive)
[54]	898	(setq wassr-friends-timeline-data nil)
[59]	899	(wassr-http-get "statuses" "friends_timeline" "xml"))
[10]	900
[54]	901	(defun wassr-click ()
[10]	902	(interactive)
	903	(let ((uri (get-text-property (point) 'uri)))
	904	(if uri
	905	(browse-url uri))))
	906
[54]	907	(defun wassr-enter ()
[10]	908	(interactive)
	909	(let ((username (get-text-property (point) 'username))
	910	(uri (get-text-property (point) 'uri)))
	911	(if username
[54]	912	(wassr-update-status-from-minibuffer (concat "@" username " "))
[10]	913	(if uri
	914	(browse-url uri)))))
	915
[54]	916	(defun wassr-view-user-page ()
[10]	917	(interactive)
	918	(let ((uri (get-text-property (point) 'uri)))
	919	(if uri
	920	(browse-url uri))))
	921
[54]	922	(defun wassr-reply-to-user ()
[10]	923	(interactive)
	924	(let ((username (get-text-property (point) 'username)))
	925	(if username
[54]	926	(wassr-update-status-from-minibuffer (concat "@" username " ")))))
[10]	927
[54]	928	(defun wassr-get-password ()
	929	(or wassr-password
	930	(setq wassr-password (read-passwd "wassr-mode: "))))
[11]	931
[54]	932	(defun wassr-goto-next-status ()
[38]	933	"Go to next status."
	934	(interactive)
	935	(let ((pos))
[54]	936	(setq pos (wassr-get-next-username-face-pos (point)))
[38]	937	(if pos
	938	(goto-char pos)
	939	(message "End of status."))))
	940
[54]	941	(defun wassr-get-next-username-face-pos (pos)
[38]	942	(interactive)
	943	(let ((prop))
	944	(catch 'not-found
[54]	945	(while (and pos (not (eq prop wassr-username-face)))
[38]	946	(setq pos (next-single-property-change pos 'face))
	947	(when (eq pos nil) (throw 'not-found nil))
	948	(setq prop (get-text-property pos 'face)))
	949	pos)))
	950
[54]	951	(defun wassr-goto-previous-status ()
[38]	952	"Go to previous status."
	953	(interactive)
	954	(let ((pos))
[54]	955	(setq pos (wassr-get-previous-username-face-pos (point)))
[38]	956	(if pos
	957	(goto-char pos)
	958	(message "Start of status."))))
	959
[54]	960	(defun wassr-get-previous-username-face-pos (pos)
[38]	961	(interactive)
	962	(let ((prop))
	963	(catch 'not-found
[54]	964	(while (and pos (not (eq prop wassr-username-face)))
[38]	965	(setq pos (previous-single-property-change pos 'face))
	966	(when (eq pos nil) (throw 'not-found nil))
	967	(setq prop (get-text-property pos 'face)))
	968	pos)))
	969
[54]	970	(defun wassr-goto-next-status-of-user ()
[38]	971	"Go to next status of user."
	972	(interactive)
[54]	973	(let ((user-name (wassr-get-username-at-pos (point)))
	974	(pos (wassr-get-next-username-face-pos (point))))
[38]	975	(while (and (not (eq pos nil))
[54]	976	(not (equal (wassr-get-username-at-pos pos) user-name)))
	977	(setq pos (wassr-get-next-username-face-pos pos)))
[38]	978	(if pos
	979	(goto-char pos)
	980	(if user-name
	981	(message "End of %s's status." user-name)
	982	(message "Invalid user-name.")))))
	983
[54]	984	(defun wassr-goto-previous-status-of-user ()
[38]	985	"Go to previous status of user."
	986	(interactive)
[54]	987	(let ((user-name (wassr-get-username-at-pos (point)))
	988	(pos (wassr-get-previous-username-face-pos (point))))
[38]	989	(while (and (not (eq pos nil))
[54]	990	(not (equal (wassr-get-username-at-pos pos) user-name)))
	991	(setq pos (wassr-get-previous-username-face-pos pos)))
[38]	992	(if pos
	993	(goto-char pos)
	994	(if user-name
	995	(message "Start of %s's status." user-name)
	996	(message "Invalid user-name.")))))
	997
[54]	998	(defun wassr-get-username-at-pos (pos)
[38]	999	(let ((start-pos pos)
	1000	(end-pos))
	1001	(catch 'not-found
[54]	1002	(while (eq (get-text-property start-pos 'face) wassr-username-face)
[38]	1003	(setq start-pos (1- start-pos))
	1004	(when (or (eq start-pos nil) (eq start-pos 0)) (throw 'not-found nil)))
	1005	(setq start-pos (1+ start-pos))
	1006	(setq end-pos (next-single-property-change pos 'face))
	1007	(buffer-substring start-pos end-pos))))
	1008
[54]	1009	(defun wassr-get-status-url (username id)
[47]	1010	"Generate status URL."
[57]	1011	(format "http://wassr.jp/user/%s/statuses/%" username id))
[47]	1012
[38]	1013	;;;###autoload
[54]	1014	(defun wassr ()
	1015	"Start wassr-mode."
[38]	1016	(interactive)
[54]	1017	(wassr-mode))
[38]	1018
[54]	1019	(provide 'wassr-mode)
	1020	;;; wassr.el ends here

Note: See TracBrowser for help on using the browser.

Context Navigation

root/lang/elisp/wassr-mode/trunk/wassr-mode.el @ 60

Download in other formats: