Context Navigation

twittering-mode.el @ 48

Revision 48, 33.5 kB (checked in by tsuyoshi, 17 years ago)
upto 0.5

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

Note: See TracBrowser for help on using the browser.

Context Navigation

root/lang/elisp/twittering-mode/branches/tsuyoshi/twittering-mode.el @ 48

Download in other formats: