Context Navigation

twittering-mode.el @ 28

Revision 28, 35.6 kB (checked in by gan2, 17 years ago)
RB-0.3 を gan2 にコピー

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

Note: See TracBrowser for help on using the browser.

Context Navigation

root/lang/elisp/twittering-mode/branches/gan2/twittering-mode.el @ 28

Download in other formats: