Context Navigation

wassr-mode.el @ 57

Revision 57, 30.7 kB (checked in by tsuyoshi, 16 years ago)
fix normal get proces.

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
[38]	7	;; Version: 0.4
[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
[57]	39	(defconst wassr-mode-version "0.2")
[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
[54]	317	(defun wassr-http-get (method-class method &optional sentinel)
	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
[57]	347	(concat "GET http://" wassr-api-server "/" method-class "/" method ".xml HTTP/1.1" nl
	348	"Host: " wassr-api-server nl
[54]	349	"User-Agent: " (wassr-user-agent) nl
[11]	350	"Authorization: Basic "
	351	(base64-encode-string
[54]	352	(concat wassr-username ":" (wassr-get-password)))
[11]	353	nl
	354	"Accept: text/xml"
	355	",application/xml"
	356	",application/xhtml+xml"
	357	",application/html;q=0.9"
	358	",text/plain;q=0.8"
	359	",image/png,/;q=0.5" nl
	360	"Accept-Charset: utf-8;q=0.7,*;q=0.7" nl
[57]	361	"Connection: Keep-Alive" nl
[54]	362	(when wassr-proxy-use
[11]	363	"Proxy-Connection: Keep-Alive" nl
	364	(when (and proxy-user proxy-password)
	365	(concat
	366	"Proxy-Authorization: Basic "
	367	(base64-encode-string
	368	(concat proxy-user ":"
	369	proxy-password))
	370	nl)))
[57]	371	nl))
[11]	372	(debug-print (concat "GET Request\n" request))
	373	request)))
[10]	374	(error
	375	(message "Failure: HTTP GET") nil))))
	376
[54]	377	(defun wassr-http-get-default-sentinel (proc stat &optional suc-msg)
	378	(let ((header (wassr-get-response-header))
	379	(body (wassr-get-response-body))
[11]	380	(status nil)
	381	)
	382	(if (string-match "HTTP/1\.[01] \$[a-z0-9 ]+\$\r?\n" header)
	383	(progn
	384	(setq status (match-string-no-properties 1 header))
	385	(case-string
	386	status
	387	(("200 OK")
	388	(mapcar
[54]	389	#'wassr-cache-status-datum
	390	(reverse (wassr-xmltree-to-status
[11]	391	body)))
[54]	392	(wassr-render-friends-timeline)
[11]	393	(message (if suc-msg suc-msg "Success: Get.")))
	394	(t (message status))))
	395	(message "Failure: Bad http response.")))
[10]	396	)
	397
[54]	398	(defun wassr-render-friends-timeline ()
	399	(with-current-buffer (wassr-buffer)
[10]	400	(let ((point (point))
	401	(end (point-max)))
	402	(setq buffer-read-only nil)
	403	(erase-buffer)
[38]	404	(mapc (lambda (status)
[54]	405	(insert (wassr-format-status
	406	status wassr-status-format))
[38]	407	(fill-region-as-paragraph
	408	(save-excursion (beginning-of-line) (point)) (point))
	409	(insert "\n"))
[54]	410	wassr-friends-timeline-data)
	411	(if wassr-image-stack
[10]	412	(clear-image-cache))
	413	(setq buffer-read-only t)
	414	(debug-print (current-buffer))
[54]	415	(goto-char (+ point (if wassr-scroll-mode (- (point-max) end) 0))))
[10]	416	))
	417
[54]	418	(defun wassr-format-status (status format-str)
[10]	419	(flet ((attr (key)
	420	(assocref key status))
	421	(profile-image
	422	()
	423	(let ((profile-image-url (attr 'user-profile-image-url))
	424	(icon-string "\n "))
	425	(if (string-match "/\$[^/?]+\$\$?:\\?\\\|$\$" profile-image-url)
	426	(let ((filename (match-string-no-properties 1 profile-image-url)))
	427	;; download icons if does not exist
[54]	428	(if (file-exists-p (concat wassr-tmp-dir
[10]	429	"/" filename))
	430	t
[54]	431	(add-to-list 'wassr-image-stack profile-image-url))
[10]	432
[54]	433	(when (and icon-string wassr-icon-mode)
[10]	434	(set-text-properties
	435	1 2 `(display
[54]	436	(image :type ,(wassr-image-type filename)
	437	:file ,(concat wassr-tmp-dir
[10]	438	"/"
	439	filename)))
	440	icon-string)
	441	icon-string)
	442	)))))
	443	(let ((cursor 0)
	444	(result ())
	445	c
	446	found-at)
	447	(setq cursor 0)
	448	(setq result '())
	449	(while (setq found-at (string-match "%\$C{\\([^}]+\$}\\\|[A-Za-z#@']\\)" format-str cursor))
	450	(setq c (string-to-char (match-string-no-properties 1 format-str)))
	451	(if (> found-at cursor)
[38]	452	(list-push (substring format-str cursor found-at) result)
[10]	453	"\|")
	454	(setq cursor (match-end 1))
	455
	456	(case c
[38]	457	((?s) ; %s - screen_name
	458	(list-push (attr 'user-screen-name) result))
	459	((?S) ; %S - name
[57]	460	(list-push (attr 'user-login-id) result))
[38]	461	((?i) ; %i - profile_image
	462	(list-push (profile-image) result))
[57]	463	((?a) ;
	464	(list-push (attr 'areacode) result))
	465	((?A) ;
	466	(list-push (attr 'areaname) result))
	467	((?u) ; %u - link
	468	(list-push (attr 'link) result))
	469	((?p) ; %u - link
	470	(list-push (attr 'photo-thumbnail-url) result))
	471	((?P) ; %u - link
	472	(list-push (attr 'photo-url) result))
	473	((?x) ; %p - protected?
[10]	474	(let ((protected (attr 'user-protected)))
	475	(when (string= "true" protected)
[38]	476	(list-push "[x]" result))))
[57]	477	((?c) ; %c - epoch (raw UTC string)
	478	(list-push (attr 'epoch) result))
	479	((?C) ; %C{time-format-str} - epoch (formatted with time-format-str)
	480	(list-push (attr 'epoch) result));;FIXME
[38]	481	((?@) ; %@ - X seconds ago
[57]	482	(list-push (attr 'epoch) result));;FIXME
[38]	483	((?t) ; %t - text
	484	(list-push ;(clickable-text)
[10]	485	(attr 'text)
	486	result))
[57]	487	((?T) ; %T - html
	488	(list-push ;(clickable-text)
	489	(attr 'html)
	490	result))
[38]	491	((?#) ; %# - id
[57]	492	(list-push (attr 'id) result))
[10]	493	(t
[38]	494	(list-push (char-to-string c) result)))
[10]	495	)
[38]	496	(list-push (substring format-str cursor) result)
[47]	497	(let ((formatted-status (apply 'concat (nreverse result))))
	498	(add-text-properties 0 (length formatted-status)
	499	`(username ,(attr 'user-screen-name))
	500	formatted-status)
	501	formatted-status)
[10]	502	)))
	503
[54]	504	(defun wassr-http-post
[10]	505	(method-class method &optional parameters contents sentinel)
[57]	506	"Send HTTP POST request to `wassr-api-server'
[10]	507
[54]	508	METHOD-CLASS must be one of Wassr API method classes(statuses, users or direct_messages).
	509	METHOD must be one of Wassr API method which belongs to METHOD-CLASS.
[10]	510	PARAMETERS is alist of URI parameters. ex) ((\"mode\" . \"view\") (\"page\" . \"6\")) => <URI>?mode=view&page=6"
[54]	511	(if (null sentinel) (setq sentinel 'wassr-http-post-default-sentinel))
[10]	512
	513	;; clear the buffer
	514	(save-excursion
[54]	515	(set-buffer (wassr-http-buffer))
[10]	516	(erase-buffer))
	517
[11]	518	(let (proc server port
[54]	519	(proxy-user wassr-proxy-user)
	520	(proxy-password wassr-proxy-password))
[10]	521	(progn
[54]	522	(if (and wassr-proxy-use wassr-proxy-server)
	523	(setq server wassr-proxy-server
	524	port (if (integerp wassr-proxy-port)
	525	(int-to-string wassr-proxy-port)
	526	wassr-proxy-port))
[57]	527	(setq server wassr-api-server
[11]	528	port "80"))
[10]	529	(setq proc
	530	(open-network-stream
[54]	531	"network-connection-process" (wassr-http-buffer)
[11]	532	server (string-to-number port)))
[10]	533	(set-process-sentinel proc sentinel)
	534	(process-send-string
	535	proc
[11]	536	(let ((nl "\r\n")
	537	request)
[38]	538	(setq request
[57]	539	(concat "POST http://" wassr-api-server "/" method-class "/" method ".xml?"
[11]	540	(if parameters
	541	(mapconcat
	542	(lambda (param-pair)
	543	(format "%s=%s"
[54]	544	(wassr-percent-encode (car param-pair))
	545	(wassr-percent-encode (cdr param-pair))))
[11]	546	parameters
	547	"&"))
	548	" HTTP/1.1" nl
[57]	549	"Host: " wassr-api-server nl
[54]	550	"User-Agent: " (wassr-user-agent) nl
[11]	551	"Authorization: Basic "
	552	(base64-encode-string
[54]	553	(concat wassr-username ":" (wassr-get-password)))
[11]	554	nl
	555	"Content-Type: text/plain" nl
	556	"Content-Length: 0" nl
[57]	557	"Connection: Keep-Alive" nl
[54]	558	(when wassr-proxy-use
[11]	559	"Proxy-Connection: Keep-Alive" nl
	560	(when (and proxy-user proxy-password)
	561	(concat
	562	"Proxy-Authorization: Basic "
	563	(base64-encode-string
	564	(concat proxy-user ":"
	565	proxy-password))
	566	nl)))
[57]	567	nl))
[11]	568	(debug-print (concat "POST Request\n" request))
	569	request)))))
[10]	570
[54]	571	(defun wassr-http-post-default-sentinel (proc stat &optional suc-msg)
[11]	572
[10]	573	(condition-case err-signal
[54]	574	(let ((header (wassr-get-response-header))
	575	;; (body (wassr-get-response-body)) not used now.
[10]	576	(status nil))
	577	(string-match "HTTP/1\.1 \$[a-z0-9 ]+\$\r?\n" header)
	578	(setq status (match-string-no-properties 1 header))
	579	(case-string status
	580	(("200 OK")
	581	(message (if suc-msg suc-msg "Success: Post")))
	582	(t (message status)))
	583	)
	584	(error (message (prin1-to-string err-signal))))
	585	)
	586
[54]	587	(defun wassr-get-response-header (&optional buffer)
[38]	588	"Exract HTTP response header from HTTP response.
[10]	589	`buffer' may be a buffer or the name of an existing buffer.
[54]	590	If `buffer' is omitted, the value of `wassr-http-buffer' is used as `buffer'."
[10]	591	(if (stringp buffer) (setq buffer (get-buffer buffer)))
[54]	592	(if (null buffer) (setq buffer (wassr-http-buffer)))
[10]	593	(save-excursion
	594	(set-buffer buffer)
	595	(let ((content (buffer-string)))
	596	(substring content 0 (string-match "\r?\n\r?\n" content)))))
	597
[54]	598	(defun wassr-get-response-body (&optional buffer)
[38]	599	"Exract HTTP response body from HTTP response, parse it as XML, and return a XML tree as list.
[10]	600	`buffer' may be a buffer or the name of an existing buffer.
[54]	601	If `buffer' is omitted, the value of `wassr-http-buffer' is used as `buffer'."
[10]	602	(if (stringp buffer) (setq buffer (get-buffer buffer)))
[54]	603	(if (null buffer) (setq buffer (wassr-http-buffer)))
[10]	604	(save-excursion
	605	(set-buffer buffer)
	606	(let ((content (buffer-string)))
	607	(let ((content (buffer-string)))
	608	(xml-parse-region (+ (string-match "\r?\n\r?\n" content)
	609	(length (match-string 0 content)))
	610	(point-max)))
	611	)))
	612
[54]	613	(defun wassr-cache-status-datum (status-datum &optional data-var)
	614	"Cache status datum into data-var(default wassr-friends-timeline-data)
[10]	615	If STATUS-DATUM is already in DATA-VAR, return nil. If not, return t."
	616	(if (null data-var)
[54]	617	(setf data-var 'wassr-friends-timeline-data))
[11]	618	(let ((id (cdr (assq 'id status-datum))))
[10]	619	(if (or (null (symbol-value data-var))
	620	(not (find-if
	621	(lambda (item)
	622	(eql id (cdr (assq 'id item))))
	623	(symbol-value data-var))))
	624	(progn
[54]	625	(if wassr-jojo-mode
	626	(wassr-update-jojo (cdr (assq 'user-screen-name status-datum))
[10]	627	(cdr (assq 'text status-datum))))
	628	(set data-var (cons status-datum (symbol-value data-var)))
	629	t)
	630	nil)))
	631
[54]	632	(defun wassr-status-to-status-datum (status)
[10]	633	(flet ((assq-get (item seq)
	634	(car (cddr (assq item seq)))))
	635	(let* ((status-data (cddr status))
[57]	636	html
	637	text
	638	epoch
	639	rid
	640	id
	641	user-login-id ;; user_login_id
	642	link
	643	photo-url ;; photo_url
	644	areacode
	645	areaname
	646	photo-thumbnail-url ;; photo_thumbnail_url
	647	reply-status-url ;; reply_status_url
	648	reply-user-login-id ;; reply_user_login_id
	649	reply-message ;; reply_message
	650	reply-user-nick ;; reply_user_nick
	651	slurl
[10]	652	(user-data (cddr (assq 'user status-data)))
[57]	653	user-protected ;; protected
	654	user-profile-image-url ;; profile_image_url
	655	user-screen-name ;; screen_name
[10]	656	regex-index)
[11]	657
[54]	658	(setq text (wassr-decode-html-entities
[10]	659	(assq-get 'text status-data)))
[57]	660	(setq html (wassr-decode-html-entities
	661	(assq-get 'html status-data)))
	662	(setq epoch (assq-get 'epoch status-data))
	663	(setq rid (assq-get 'rid status-data))
	664	(setq id (assq-get 'id status-data))
	665	(setq user-login-id (assq-get 'user_login_id status-data))
	666	(setq link (assq-get 'link status-data))
	667	(setq photo-url (assq-get 'photo_url status-data))
	668	(setq areacode (assq-get 'areacode status-data))
	669	(setq areaname (assq-get 'areaname status-data))
	670	(setq photo-thumbnail-url (assq-get 'photo_thumbnail_url status-data))
	671	(setq reply-status-url (assq-get 'reply_status_url status-data))
	672	(setq reply-user-login-id (assq-get 'reply_user_login_id status-data))
	673	(setq reply-message (assq-get 'reply_message status-data))
	674	(setq reply-user-nick (assq-get 'reply_user_nick status-data))
	675	(setq slurl (assq-get 'slurl status-data))
[54]	676	(setq user-screen-name (wassr-decode-html-entities
[10]	677	(assq-get 'screen_name user-data)))
	678	(setq user-profile-image-url (assq-get 'profile_image_url user-data))
	679	(setq user-protected (assq-get 'protected user-data))
	680
	681	;; make username clickable
[47]	682	(add-text-properties
[57]	683	0 (length user-login-id)
[47]	684	`(mouse-face highlight
[57]	685	uri ,(concat "http://wassr.jp/user/" user-screen-name)
[54]	686	face wassr-username-face)
[57]	687	user-login-id)
[10]	688
[47]	689	;; make screen-name clickable
	690	(add-text-properties
	691	0 (length user-screen-name)
	692	`(mouse-face highlight
[54]	693	face wassr-username-face
[57]	694	uri ,(concat "http://wassr.jp/user/" user-screen-name)
[54]	695	face wassr-username-face)
[47]	696	user-screen-name)
	697
[10]	698	;; make URI clickable
	699	(setq regex-index 0)
	700	(while regex-index
	701	(setq regex-index
	702	(string-match "@\$[_a-zA-Z0-9]+\$\\\|\$https?://[-_.!~*'()a-zA-Z0-9;/?:@&=+$,%#]+\$"
	703	text
	704	regex-index))
	705	(when regex-index
	706	(let* ((matched-string (match-string-no-properties 0 text))
	707	(screen-name (match-string-no-properties 1 text))
	708	(uri (match-string-no-properties 2 text)))
	709	(add-text-properties
	710	(if screen-name
	711	(+ 1 (match-beginning 0))
	712	(match-beginning 0))
	713	(match-end 0)
	714	(if screen-name
	715	`(mouse-face
	716	highlight
[54]	717	face wassr-uri-face
[57]	718	uri ,(concat "http://wassr.jp/user/" screen-name))
[10]	719	`(mouse-face highlight
[54]	720	face wassr-uri-face
[11]	721	uri ,uri))
[10]	722	text))
	723	(setq regex-index (match-end 0)) ))
	724
	725	(mapcar
	726	(lambda (sym)
	727	`(,sym . ,(symbol-value sym)))
[57]	728	'(html text epoch rid id user-login-id
	729	link photo-url areacode areaname
	730	photo-thumbnail-url
	731	reply-status-url
	732	reply-user-login-id
	733	reply-message
	734	reply-user-nick
	735	slurl
	736	user-protected
	737	user-profile-image-url
	738	user-screen-name
	739	)))))
[10]	740
[54]	741	(defun wassr-xmltree-to-status (xmltree)
	742	(mapcar #'wassr-status-to-status-datum
[10]	743	;; quirk to treat difference between xml.el in Emacs21 and Emacs22
	744	;; On Emacs22, there may be blank strings
	745	(let ((ret nil) (statuses (reverse (cddr (car xmltree)))))
	746	(while statuses
	747	(if (consp (car statuses))
	748	(setq ret (cons (car statuses) ret)))
	749	(setq statuses (cdr statuses)))
	750	ret)))
	751
[54]	752	(defun wassr-percent-encode (str &optional coding-system)
[10]	753	(if (or (null coding-system)
	754	(not (coding-system-p coding-system)))
	755	(setq coding-system 'utf-8))
	756	(mapconcat
	757	(lambda (c)
	758	(cond
[54]	759	((wassr-url-reserved-p c)
[10]	760	(char-to-string c))
	761	((eq c ? ) "+")
	762	(t (format "%%%x" c))))
	763	(encode-coding-string str coding-system)
	764	""))
	765
[54]	766	(defun wassr-url-reserved-p (ch)
[10]	767	(or (and (<= ?A ch) (<= ch ?z))
	768	(and (<= ?0 ch) (<= ch ?9))
	769	(eq ?. ch)
	770	(eq ?- ch)
	771	(eq ?_ ch)
	772	(eq ?~ ch)))
	773
[54]	774	(defun wassr-decode-html-entities (encoded-str)
[10]	775	(if encoded-str
	776	(let ((cursor 0)
	777	(found-at nil)
	778	(result '()))
	779	(while (setq found-at
	780	(string-match "&\$#\\([0-9]+\$\\\|\$[A-Za-z]+\$\\);"
	781	encoded-str cursor))
	782	(when (> found-at cursor)
[38]	783	(list-push (substring encoded-str cursor found-at) result))
[10]	784	(let ((number-entity (match-string-no-properties 2 encoded-str))
	785	(letter-entity (match-string-no-properties 3 encoded-str)))
	786	(cond (number-entity
[38]	787	(list-push
[10]	788	(char-to-string
[54]	789	(wassr-ucs-to-char
[10]	790	(string-to-number number-entity))) result))
	791	(letter-entity
[38]	792	(cond ((string= "gt" letter-entity) (list-push ">" result))
	793	((string= "lt" letter-entity) (list-push "<" result))
	794	(t (list-push "?" result))))
	795	(t (list-push "?" result)))
[10]	796	(setq cursor (match-end 0))))
[38]	797	(list-push (substring encoded-str cursor) result)
[10]	798	(apply 'concat (nreverse result)))
	799	""))
	800
[54]	801	(defun wassr-timer-action (func)
	802	(let ((buf (get-buffer wassr-buffer)))
[10]	803	(if (null buf)
[54]	804	(wassr-stop)
[10]	805	(funcall func)
	806	)))
	807
[54]	808	(defun wassr-update-status-if-not-blank (status)
[10]	809	(if (string-match "^\\s-\$?:@[-_a-z0-9]+\$?\\s-$" status)
	810	nil
[54]	811	(wassr-http-post "statuses" "update"
[10]	812	`(("status" . ,status)
[54]	813	("source" . "ws-mode")))
[10]	814	t))
	815
[54]	816	(defun wassr-update-status-from-minibuffer (&optional init-str)
[10]	817	(if (null init-str) (setq init-str ""))
	818	(let ((status init-str) (not-posted-p t))
	819	(while not-posted-p
	820	(setq status (read-from-minibuffer "status: " status nil nil nil nil t))
	821	(setq not-posted-p
[54]	822	(not (wassr-update-status-if-not-blank status))))))
[10]	823
[54]	824	(defun wassr-update-lambda ()
[10]	825	(interactive)
[54]	826	(wassr-http-post
[10]	827	"statuses" "update"
	828	`(("status" . "\xd34b\xd22b\xd26f\xd224\xd224\xd268\xd34b")
[54]	829	("source" . "ws-mode"))))
[10]	830
[54]	831	(defun wassr-update-jojo (usr msg)
[10]	832	(if (string-match "\xde21\xd24b\$\xd22a\xe0b0\\\|\xdaae\xe6cd\$\xd24f\xd0d6\$[^\xd0d7]+\$\xd0d7\xd248\xdc40\xd226"
	833	msg)
[54]	834	(wassr-http-post
[10]	835	"statuses" "update"
	836	`(("status" . ,(concat
	837	"@" usr " "
	838	(match-string-no-properties 2 msg)
	839	"\xd0a1\xd24f\xd243!?"))
[54]	840	("source" . "ws-mode")))))
[10]	841
	842	;;;
	843	;;; Commands
	844	;;;
	845
[54]	846	(defun wassr-start (&optional action)
[10]	847	(interactive)
	848	(if (null action)
[54]	849	(setq action #'wassr-friends-timeline))
	850	(if wassr-timer
[10]	851	nil
[54]	852	(setq wassr-timer
[10]	853	(run-at-time "0 sec"
[54]	854	wassr-timer-interval
	855	#'wassr-timer-action action))))
[10]	856
[54]	857	(defun wassr-stop ()
[10]	858	(interactive)
[54]	859	(cancel-timer wassr-timer)
	860	(setq wassr-timer nil))
[10]	861
[54]	862	(defun wassr-friends-timeline ()
[10]	863	(interactive)
[54]	864	(let ((buf (get-buffer wassr-buffer)))
[10]	865	(if (not buf)
[54]	866	(wassr-stop)
	867	(wassr-http-get "statuses" "friends_timeline")
[10]	868	))
	869
[54]	870	(if wassr-icon-mode
	871	(if wassr-image-stack
[10]	872	(let ((proc
	873	(apply
	874	#'start-process
	875	"wget-images"
[54]	876	(wassr-wget-buffer)
[10]	877	"wget"
[54]	878	(format "--directory-prefix=%s" wassr-tmp-dir)
[10]	879	"--no-clobber"
	880	"--quiet"
[54]	881	wassr-image-stack)))
[10]	882	(set-process-sentinel
	883	proc
	884	(lambda (proc stat)
	885	(clear-image-cache)
	886	(save-excursion
[54]	887	(set-buffer (wassr-wget-buffer))
[10]	888	)))))))
	889
[54]	890	(defun wassr-update-status-interactive ()
[10]	891	(interactive)
[54]	892	(wassr-update-status-from-minibuffer))
[10]	893
[54]	894	(defun wassr-erase-old-statuses ()
[10]	895	(interactive)
[54]	896	(setq wassr-friends-timeline-data nil)
	897	(wassr-http-get "statuses" "friends_timeline"))
[10]	898
[54]	899	(defun wassr-click ()
[10]	900	(interactive)
	901	(let ((uri (get-text-property (point) 'uri)))
	902	(if uri
	903	(browse-url uri))))
	904
[54]	905	(defun wassr-enter ()
[10]	906	(interactive)
	907	(let ((username (get-text-property (point) 'username))
	908	(uri (get-text-property (point) 'uri)))
	909	(if username
[54]	910	(wassr-update-status-from-minibuffer (concat "@" username " "))
[10]	911	(if uri
	912	(browse-url uri)))))
	913
[54]	914	(defun wassr-view-user-page ()
[10]	915	(interactive)
	916	(let ((uri (get-text-property (point) 'uri)))
	917	(if uri
	918	(browse-url uri))))
	919
[54]	920	(defun wassr-reply-to-user ()
[10]	921	(interactive)
	922	(let ((username (get-text-property (point) 'username)))
	923	(if username
[54]	924	(wassr-update-status-from-minibuffer (concat "@" username " ")))))
[10]	925
[54]	926	(defun wassr-get-password ()
	927	(or wassr-password
	928	(setq wassr-password (read-passwd "wassr-mode: "))))
[11]	929
[54]	930	(defun wassr-goto-next-status ()
[38]	931	"Go to next status."
	932	(interactive)
	933	(let ((pos))
[54]	934	(setq pos (wassr-get-next-username-face-pos (point)))
[38]	935	(if pos
	936	(goto-char pos)
	937	(message "End of status."))))
	938
[54]	939	(defun wassr-get-next-username-face-pos (pos)
[38]	940	(interactive)
	941	(let ((prop))
	942	(catch 'not-found
[54]	943	(while (and pos (not (eq prop wassr-username-face)))
[38]	944	(setq pos (next-single-property-change pos 'face))
	945	(when (eq pos nil) (throw 'not-found nil))
	946	(setq prop (get-text-property pos 'face)))
	947	pos)))
	948
[54]	949	(defun wassr-goto-previous-status ()
[38]	950	"Go to previous status."
	951	(interactive)
	952	(let ((pos))
[54]	953	(setq pos (wassr-get-previous-username-face-pos (point)))
[38]	954	(if pos
	955	(goto-char pos)
	956	(message "Start of status."))))
	957
[54]	958	(defun wassr-get-previous-username-face-pos (pos)
[38]	959	(interactive)
	960	(let ((prop))
	961	(catch 'not-found
[54]	962	(while (and pos (not (eq prop wassr-username-face)))
[38]	963	(setq pos (previous-single-property-change pos 'face))
	964	(when (eq pos nil) (throw 'not-found nil))
	965	(setq prop (get-text-property pos 'face)))
	966	pos)))
	967
[54]	968	(defun wassr-goto-next-status-of-user ()
[38]	969	"Go to next status of user."
	970	(interactive)
[54]	971	(let ((user-name (wassr-get-username-at-pos (point)))
	972	(pos (wassr-get-next-username-face-pos (point))))
[38]	973	(while (and (not (eq pos nil))
[54]	974	(not (equal (wassr-get-username-at-pos pos) user-name)))
	975	(setq pos (wassr-get-next-username-face-pos pos)))
[38]	976	(if pos
	977	(goto-char pos)
	978	(if user-name
	979	(message "End of %s's status." user-name)
	980	(message "Invalid user-name.")))))
	981
[54]	982	(defun wassr-goto-previous-status-of-user ()
[38]	983	"Go to previous status of user."
	984	(interactive)
[54]	985	(let ((user-name (wassr-get-username-at-pos (point)))
	986	(pos (wassr-get-previous-username-face-pos (point))))
[38]	987	(while (and (not (eq pos nil))
[54]	988	(not (equal (wassr-get-username-at-pos pos) user-name)))
	989	(setq pos (wassr-get-previous-username-face-pos pos)))
[38]	990	(if pos
	991	(goto-char pos)
	992	(if user-name
	993	(message "Start of %s's status." user-name)
	994	(message "Invalid user-name.")))))
	995
[54]	996	(defun wassr-get-username-at-pos (pos)
[38]	997	(let ((start-pos pos)
	998	(end-pos))
	999	(catch 'not-found
[54]	1000	(while (eq (get-text-property start-pos 'face) wassr-username-face)
[38]	1001	(setq start-pos (1- start-pos))
	1002	(when (or (eq start-pos nil) (eq start-pos 0)) (throw 'not-found nil)))
	1003	(setq start-pos (1+ start-pos))
	1004	(setq end-pos (next-single-property-change pos 'face))
	1005	(buffer-substring start-pos end-pos))))
	1006
[54]	1007	(defun wassr-get-status-url (username id)
[47]	1008	"Generate status URL."
[57]	1009	(format "http://wassr.jp/user/%s/statuses/%" username id))
[47]	1010
[38]	1011	;;;###autoload
[54]	1012	(defun wassr ()
	1013	"Start wassr-mode."
[38]	1014	(interactive)
[54]	1015	(wassr-mode))
[38]	1016
[54]	1017	(provide 'wassr-mode)
	1018	;;; wassr.el ends here

Note: See TracBrowser for help on using the browser.

Context Navigation

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

Download in other formats: