Context Navigation

wassr-mode.el @ 79

Revision 79, 30.8 kB (checked in by tsuyoshi, 16 years ago)
Add keybind in Major mode docstirng

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

Note: See TracBrowser for help on using the browser.

Context Navigation

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

Download in other formats: