Context Navigation

twittering-mode.el @ 80

Revision 80, 36.1 kB (checked in by tsuyoshi, 16 years ago)
Add new methods. public_timeline,replies,user_timeline and some treat code.

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

Note: See TracBrowser for help on using the browser.

Context Navigation

root/lang/elisp/twittering-mode/trunk/twittering-mode.el @ 80

Download in other formats: