Permalink
Switch branches/tags
Nothing to show
Find file
Fetching contributors…
Cannot retrieve contributors at this time
930 lines (831 sloc) 28.8 KB
;;; twittering-mode.el --- Major mode for Twitter
;; Copyright (C) 2007 Yuto Hayamizu.
;; 2008 Tsuyoshi CHO
;; Author: Y. Hayamizu <y.hayamizu@gmail.com>
;; Tsuyoshi CHO <Tsuyoshi.CHO+develop@Gmail.com>
;; Created: Sep 4, 2007
;; Version: SVN-HEAD
;; Keywords: twitter web
;; URL: http://lambdarepos.svnrepository.com/share/trac.cgi/browser/lang/elisp/twittering-mode
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;; twittering-mode.el is a major mode for Twitter.
;; You can check friends timeline, and update your status on Emacs.
;;; Feature Request:
;; URL : http://twitter.com/d00dle/statuses/577876082
;; URL : http://twitter.com/d00dle/statuses/577879732
;; * Status Input from Popup buffer and C-cC-c to POST.
;; * Mark fav(star)
;; URL : http://code.nanigac.com/source/view/419
;; * update status for region
;;; Code:
(require 'cl)
(require 'xml)
(require 'parse-time)
(defconst twittering-mode-version "0.3")
(defvar twittering-mode-map (make-sparse-keymap))
(defvar twittering-timer nil)
(defvar twittering-idle-time 20)
(defvar twittering-timer-interval 90)
(defvar twittering-username nil)
(defvar twittering-password nil)
(defvar twittering-scroll-mode nil)
(defvar twittering-jojo-mode nil)
(defvar twittering-status-format nil)
(setq twittering-status-format "%i %s, %@:\n %t // from %f%L\n")
; %s - screen_name
; %S - name
; %i - profile_image
; %d - description
; %l - location
; %L - " [location]"
; %u - url
; %j - user.id
; %p - protected?
; %c - created_at (raw UTC string)
; %C{time-format-str} - created_at (formatted with time-format-str)
; %@ - X seconds ago
; %t - text
; %' - truncated
; %f - source
; %# - id
(defvar twittering-buffer "*twittering*")
(defun twittering-buffer ()
(twittering-get-or-generate-buffer twittering-buffer))
(defvar twittering-http-buffer " *twittering-http-buffer*")
(defun twittering-http-buffer ()
(twittering-get-or-generate-buffer twittering-http-buffer))
(defvar twittering-friends-timeline-data nil)
(defvar twittering-username-face 'twittering-username-face)
(defvar twittering-uri-face 'twittering-uri-face)
(defun twittering-get-or-generate-buffer (buffer)
(if (bufferp buffer)
(if (buffer-live-p buffer)
buffer
(generate-new-buffer (buffer-name buffer)))
(if (stringp buffer)
(or (get-buffer buffer)
(generate-new-buffer buffer)))))
(defun assocref (item alist)
(cdr (assoc item alist)))
;;; Proxy
(defvar twittering-proxy-use nil)
(defvar twittering-proxy-server nil)
(defvar twittering-proxy-port 8080)
(defvar twittering-proxy-user nil)
(defvar twittering-proxy-password nil)
(defun twittering-toggle-proxy () ""
(interactive)
(setq twittering-proxy-use
(not twittering-proxy-use))
(message "%s %s"
"Use Proxy:"
(if twittering-proxy-use
"on" "off")))
(defun twittering-user-agent-default-function ()
"Twittering mode default User-Agent function."
(concat "Emacs/"
(int-to-string emacs-major-version) "." (int-to-string
emacs-minor-version)
" "
"Twittering-mode/"
twittering-mode-version))
(defvar twittering-user-agent-function 'twittering-user-agent-default-function)
(defun twittering-user-agent ()
"Return User-Agent header string."
(funcall twittering-user-agent-function))
;;; to show image files
(defvar twittering-wget-buffer "*twittering-wget-buffer*")
(defun twittering-wget-buffer ()
(twittering-get-or-generate-buffer twittering-wget-buffer))
(defvar twittering-tmp-dir
(expand-file-name (concat "twmode-images-" (user-login-name))
temporary-file-directory))
(defvar twittering-icon-mode nil "You MUST NOT CHANGE this variable directory. You should change through function'twittering-icon-mode'")
(defun twittering-icon-mode (&optional arg)
(interactive)
(setq twittering-icon-mode
(if twittering-icon-mode
(if (null arg)
nil
(> (prefix-numeric-value arg) 0))
(when (or (null arg)
(and arg (> (prefix-numeric-value arg) 0)))
(when (file-writable-p twittering-tmp-dir)
(progn
(if (not (file-directory-p twittering-tmp-dir))
(make-directory twittering-tmp-dir))
t)))))
(twittering-render-friends-timeline))
(defun twittering-scroll-mode (&optional arg)
(interactive)
(setq twittering-scroll-mode
(if (null arg)
(not twittering-scroll-mode)
(> (prefix-numeric-value arg) 0))))
(defun twittering-jojo-mode (&optional arg)
(interactive)
(setq twittering-jojo-mode
(if (null arg)
(not twittering-jojo-mode)
(> (prefix-numeric-value arg) 0))))
(defvar twittering-image-stack nil)
(defun twittering-image-type (file-name)
(cond
((string-match "\\.jpe?g" file-name) 'jpeg)
((string-match "\\.png" file-name) 'png)
((string-match "\\.gif" file-name) 'gif)
(t nil)))
(defun twittering-local-strftime (fmt string)
(format-time-string fmt ; like "%Y-%m-%d %H:%M:%S", shown in localtime
(apply 'encode-time (parse-time-string string))))
(defvar twittering-debug-mode nil)
(defvar twittering-debug-buffer "*debug*")
(defun twittering-debug-buffer ()
(twittering-get-or-generate-buffer twittering-debug-buffer))
(defmacro debug-print (obj)
(let ((obsym (gensym)))
`(let ((,obsym ,obj))
(if twittering-debug-mode
(with-current-buffer (twittering-debug-buffer)
(insert (prin1-to-string ,obsym))
(newline)
,obsym)
,obsym))))
(defun twittering-debug-mode ()
(interactive)
(setq twittering-debug-mode
(not twittering-debug-mode))
(message (if twittering-debug-mode "debug mode:on" "debug mode:off")))
(if twittering-mode-map
(let ((km twittering-mode-map))
(define-key km "\C-c\C-f" 'twittering-friends-timeline)
(define-key km "\C-c\C-s" 'twittering-update-status-interactive)
(define-key km "\C-c\C-e" 'twittering-erase-old-statuses)
(define-key km "\C-m" 'twittering-enter)
(define-key km "\C-c\C-l" 'twittering-update-lambda)
(define-key km [mouse-1] 'twittering-click)
(define-key km "\C-c\C-v" 'twittering-view-user-page)
(define-key km "j" 'next-line)
(define-key km "k" 'previous-line)
(define-key km "l" 'forward-char)
(define-key km "h" 'backward-char)
(define-key km "0" 'beginning-of-line)
(define-key km "^" 'beginning-of-line-text)
(define-key km "$" 'end-of-line)
(define-key km [backspace] 'backward-char)
(define-key km "G" 'end-of-buffer)
(define-key km "H" 'beginning-of-buffer)
(define-key km "\C-c\C-p" 'twittering-toggle-proxy)
nil))
(defvar twittering-mode-syntax-table nil "")
(if twittering-mode-syntax-table
()
(setq twittering-mode-syntax-table (make-syntax-table))
; (modify-syntax-entry ? "" twittering-mode-syntax-table)
(modify-syntax-entry ?\" "w" twittering-mode-syntax-table)
)
(defun twittering-mode-init-variables ()
;(make-variable-buffer-local 'variable)
;(setq variable nil)
(font-lock-mode -1)
(defface twittering-username-face
`((t nil)) "" :group 'faces)
(copy-face 'font-lock-string-face 'twittering-username-face)
(set-face-attribute 'twittering-username-face nil :underline t)
(defface twittering-uri-face
`((t nil)) "" :group 'faces)
(set-face-attribute 'twittering-uri-face nil :underline t)
(add-to-list 'minor-mode-alist '(twittering-icon-mode " tw-icon"))
(add-to-list 'minor-mode-alist '(twittering-scroll-mode " tw-scroll"))
(add-to-list 'minor-mode-alist '(twittering-jojo-mode " tw-jojo"))
)
(defmacro case-string (str &rest clauses)
`(cond
,@(mapcar
(lambda (clause)
(let ((keylist (car clause))
(body (cdr clause)))
`(,(if (listp keylist)
`(or ,@(mapcar (lambda (key) `(string-equal ,str ,key)) keylist))
't)
,@body)))
clauses)))
;; If you use Emacs21, decode-char 'ucs will fail unless Mule-UCS is loaded.
;; TODO: Show error messages if Emacs 21 without Mule-UCS
(defmacro twittering-ucs-to-char (num)
(if (functionp 'ucs-to-char)
`(ucs-to-char ,num)
`(decode-char 'ucs ,num)))
(defvar twittering-mode-string "Twittering mode")
(defun twittering-mode ()
"Major mode for Twitter"
(interactive)
(switch-to-buffer (twittering-buffer))
(kill-all-local-variables)
(twittering-mode-init-variables)
(use-local-map twittering-mode-map)
(setq major-mode 'twittering-mode)
(setq mode-name twittering-mode-string)
(set-syntax-table twittering-mode-syntax-table)
(run-hooks 'twittering-mode-hook)
(font-lock-mode -1)
(twittering-start)
)
;;;
;;; Basic HTTP functions
;;;
(defun twittering-http-get (method-class method &optional sentinel)
(if (null sentinel) (setq sentinel 'twittering-http-get-default-sentinel))
;; clear the buffer
(save-excursion
(set-buffer (twittering-http-buffer))
(erase-buffer))
(let (proc server port
(proxy-user twittering-proxy-user)
(proxy-password twittering-proxy-password))
(condition-case nil
(progn
(if (and twittering-proxy-use twittering-proxy-server)
(setq server twittering-proxy-server
port (if (integerp twittering-proxy-port)
(int-to-string twittering-proxy-port)
twittering-proxy-port))
(setq server "twitter.com"
port "80"))
(setq proc
(open-network-stream
"network-connection-process" (twittering-http-buffer)
server (string-to-number port)))
(set-process-sentinel proc sentinel)
(process-send-string
proc
(let ((nl "\r\n")
request)
(setq request
(concat "GET http://twitter.com/" method-class "/" method ".xml HTTP/1.1" nl
"Host: twitter.com" nl
"User-Agent: " (twittering-user-agent) nl
"Authorization: Basic "
(base64-encode-string
(concat twittering-username ":" (twittering-get-password)))
nl
"Accept: text/xml"
",application/xml"
",application/xhtml+xml"
",application/html;q=0.9"
",text/plain;q=0.8"
",image/png,*/*;q=0.5" nl
"Accept-Charset: utf-8;q=0.7,*;q=0.7" nl
(when twittering-proxy-use
"Proxy-Connection: Keep-Alive" nl
(when (and proxy-user proxy-password)
(concat
"Proxy-Authorization: Basic "
(base64-encode-string
(concat proxy-user ":"
proxy-password))
nl)))
nl nl))
(debug-print (concat "GET Request\n" request))
request)))
(error
(message "Failure: HTTP GET") nil))))
(defun twittering-http-get-default-sentinel (proc stat &optional suc-msg)
(let ((header (twittering-get-response-header))
(body (twittering-get-response-body))
(status nil)
)
(if (string-match "HTTP/1\.[01] \\([a-z0-9 ]+\\)\r?\n" header)
(progn
(setq status (match-string-no-properties 1 header))
(case-string
status
(("200 OK")
(mapcar
#'twittering-cache-status-datum
(reverse (twittering-xmltree-to-status
body)))
(twittering-render-friends-timeline)
(message (if suc-msg suc-msg "Success: Get.")))
(t (message status))))
(message "Failure: Bad http response.")))
)
(defun twittering-render-friends-timeline ()
(with-current-buffer (twittering-buffer)
(let ((point (point))
(end (point-max)))
(setq buffer-read-only nil)
(erase-buffer)
(insert
(mapconcat (lambda (status)
(twittering-format-status status twittering-status-format))
twittering-friends-timeline-data
"\n"))
(if twittering-image-stack
(clear-image-cache))
(setq buffer-read-only t)
(debug-print (current-buffer))
(goto-char (+ point (if twittering-scroll-mode (- (point-max) end) 0))))
))
(defun twittering-format-status (status format-str)
(flet ((attr (key)
(assocref key status))
(profile-image
()
(let ((profile-image-url (attr 'user-profile-image-url))
(icon-string "\n "))
(if (string-match "/\\([^/?]+\\)\\(?:\\?\\|$\\)" profile-image-url)
(let ((filename (match-string-no-properties 1 profile-image-url)))
;; download icons if does not exist
(if (file-exists-p (concat twittering-tmp-dir
"/" filename))
t
(add-to-list 'twittering-image-stack profile-image-url))
(when (and icon-string twittering-icon-mode)
(set-text-properties
1 2 `(display
(image :type ,(twittering-image-type filename)
:file ,(concat twittering-tmp-dir
"/"
filename)))
icon-string)
icon-string)
)))))
(let ((cursor 0)
(result ())
c
found-at)
(setq cursor 0)
(setq result '())
(while (setq found-at (string-match "%\\(C{\\([^}]+\\)}\\|[A-Za-z#@']\\)" format-str cursor))
(setq c (string-to-char (match-string-no-properties 1 format-str)))
(if (> found-at cursor)
(push (substring format-str cursor found-at) result)
"|")
(setq cursor (match-end 1))
(case c
((?s) ; %s - screen_name
(push (attr 'user-screen-name) result))
((?S) ; %S - name
(push (attr 'user-name) result))
((?i) ; %i - profile_image
(push (profile-image) result))
((?d) ; %d - description
(push (attr 'user-description) result))
((?l) ; %l - location
(push (attr 'user-location) result))
((?L) ; %L - " [location]"
(let ((location (attr 'user-location)))
(unless (or (null location) (string= "" location))
(push (concat " [" location "]") result)) ))
((?u) ; %u - url
(push (attr 'user-url) result))
((?j) ; %j - user.id
(push (attr 'user-id) result))
((?p) ; %p - protected?
(let ((protected (attr 'user-protected)))
(when (string= "true" protected)
(push "[x]" result))))
((?c) ; %c - created_at (raw UTC string)
(push (attr 'created-at) result))
((?C) ; %C{time-format-str} - created_at (formatted with time-format-str)
(push (twittering-local-strftime
(or (match-string-no-properties 2 format-str) "%H:%M:%S")
(attr 'created-at))
result))
((?@) ; %@ - X seconds ago
(let ((created-at
(apply
'encode-time
(parse-time-string (attr 'created-at))))
(now (current-time)))
(let ((secs (+ (* (- (car now) (car created-at)) 65536)
(- (cadr now) (cadr created-at)))))
(push (cond ((< secs 5) "less than 5 seconds ago")
((< secs 10) "less than 10 seconds ago")
((< secs 20) "less than 20 seconds ago")
((< secs 30) "half a minute ago")
((< secs 60) "less than a minute ago")
((< secs 150) "1 minute ago")
((< secs 2400) (format "%d minutes ago"
(/ (+ secs 30) 60)))
((< secs 5400) "about 1 hour ago")
((< secs 84600) (format "about %d hours ago"
(/ (+ secs 1800) 3600)))
(t (format-time-string "%I:%M %p %B %d, %Y" created-at)))
result))))
((?t) ; %t - text
(push ;(clickable-text)
(attr 'text)
result))
((?') ; %' - truncated
(let ((truncated (attr 'truncated)))
(when (string= "true" truncated)
(push "..." result))))
((?f) ; %f - source
(push (attr 'source) result))
((?#) ; %# - id
(push (attr 'id) result))
(t
(push (char-to-string c) result)))
)
(push (substring format-str cursor) result)
(apply 'concat (nreverse result))
)))
(defun twittering-http-post
(method-class method &optional parameters contents sentinel)
"Send HTTP POST request to twitter.com
METHOD-CLASS must be one of Twitter API method classes(statuses, users or direct_messages).
METHOD must be one of Twitter API method which belongs to METHOD-CLASS.
PARAMETERS is alist of URI parameters. ex) ((\"mode\" . \"view\") (\"page\" . \"6\")) => <URI>?mode=view&page=6"
(if (null sentinel) (setq sentinel 'twittering-http-post-default-sentinel))
;; clear the buffer
(save-excursion
(set-buffer (twittering-http-buffer))
(erase-buffer))
(let (proc server port
(proxy-user twittering-proxy-user)
(proxy-password twittering-proxy-password))
(progn
(if (and twittering-proxy-use twittering-proxy-server)
(setq server twittering-proxy-server
port (if (integerp twittering-proxy-port)
(int-to-string twittering-proxy-port)
twittering-proxy-port))
(setq server "twitter.com"
port "80"))
(setq proc
(open-network-stream
"network-connection-process" (twittering-http-buffer)
server (string-to-number port)))
(set-process-sentinel proc sentinel)
(process-send-string
proc
(let ((nl "\r\n")
request)
(setq request
(concat "POST http://twitter.com/" method-class "/" method ".xml?"
(if parameters
(mapconcat
(lambda (param-pair)
(format "%s=%s"
(twittering-percent-encode (car param-pair))
(twittering-percent-encode (cdr param-pair))))
parameters
"&"))
" HTTP/1.1" nl
"Host: twitter.com" nl
"User-Agent: " (twittering-user-agent) nl
"Authorization: Basic "
(base64-encode-string
(concat twittering-username ":" (twittering-get-password)))
nl
"Content-Type: text/plain" nl
"Content-Length: 0" nl
(when twittering-proxy-use
"Proxy-Connection: Keep-Alive" nl
(when (and proxy-user proxy-password)
(concat
"Proxy-Authorization: Basic "
(base64-encode-string
(concat proxy-user ":"
proxy-password))
nl)))
nl nl))
(debug-print (concat "POST Request\n" request))
request)))))
(defun twittering-http-post-default-sentinel (proc stat &optional suc-msg)
(condition-case err-signal
(let ((header (twittering-get-response-header))
; (body (twittering-get-response-body)) not used now.
(status nil))
(string-match "HTTP/1\.1 \\([a-z0-9 ]+\\)\r?\n" header)
(setq status (match-string-no-properties 1 header))
(case-string status
(("200 OK")
(message (if suc-msg suc-msg "Success: Post")))
(t (message status)))
)
(error (message (prin1-to-string err-signal))))
)
(defun twittering-get-response-header (&optional buffer)
"Extract HTTP response header from HTTP response.
`buffer' may be a buffer or the name of an existing buffer.
If `buffer' is omitted, the value of `twittering-http-buffer' is used as `buffer'."
(if (stringp buffer) (setq buffer (get-buffer buffer)))
(if (null buffer) (setq buffer (twittering-http-buffer)))
(save-excursion
(set-buffer buffer)
(let ((content (buffer-string)))
(substring content 0 (string-match "\r?\n\r?\n" content)))))
(defun twittering-get-response-body (&optional buffer)
"Extract HTTP response body from HTTP response, parse it as XML, and return a XML tree as list.
`buffer' may be a buffer or the name of an existing buffer.
If `buffer' is omitted, the value of `twittering-http-buffer' is used as `buffer'."
(if (stringp buffer) (setq buffer (get-buffer buffer)))
(if (null buffer) (setq buffer (twittering-http-buffer)))
(save-excursion
(set-buffer buffer)
(let ((content (buffer-string)))
(let ((content (buffer-string)))
(xml-parse-region (+ (string-match "\r?\n\r?\n" content)
(length (match-string 0 content)))
(point-max)))
)))
(defun twittering-cache-status-datum (status-datum &optional data-var)
"Cache status datum into data-var(default twittering-friends-timeline-data)
If STATUS-DATUM is already in DATA-VAR, return nil. If not, return t."
(if (null data-var)
(setf data-var 'twittering-friends-timeline-data))
(let ((id (cdr (assq 'id status-datum))))
(if (or (null (symbol-value data-var))
(not (find-if
(lambda (item)
(eql id (cdr (assq 'id item))))
(symbol-value data-var))))
(progn
(if twittering-jojo-mode
(twittering-update-jojo (cdr (assq 'user-screen-name status-datum))
(cdr (assq 'text status-datum))))
(set data-var (cons status-datum (symbol-value data-var)))
t)
nil)))
(defun twittering-status-to-status-datum (status)
(flet ((assq-get (item seq)
(car (cddr (assq item seq)))))
(let* ((status-data (cddr status))
id text source created-at truncated
(user-data (cddr (assq 'user status-data)))
user-id user-name
user-screen-name
user-location
user-description
user-profile-image-url
user-url
user-protected
regex-index)
(setq id (string-to-number (assq-get 'id status-data)))
(setq text (twittering-decode-html-entities
(assq-get 'text status-data)))
(setq source (twittering-decode-html-entities
(assq-get 'source status-data)))
(setq created-at (assq-get 'created_at status-data))
(setq truncated (assq-get 'truncated status-data))
(setq user-id (string-to-number (assq-get 'id user-data)))
(setq user-name (twittering-decode-html-entities
(assq-get 'name user-data)))
(setq user-screen-name (twittering-decode-html-entities
(assq-get 'screen_name user-data)))
(setq user-location (twittering-decode-html-entities
(assq-get 'location user-data)))
(setq user-description (twittering-decode-html-entities
(assq-get 'description user-data)))
(setq user-profile-image-url (assq-get 'profile_image_url user-data))
(setq user-url (assq-get 'url user-data))
(setq user-protected (assq-get 'protected user-data))
;; make username clickable
(add-text-properties 0 (length user-screen-name)
`(mouse-face highlight
uri ,(concat "http://twitter.com/" user-screen-name)
username ,user-screen-name
face twittering-username-face)
user-screen-name)
;; make URI clickable
(setq regex-index 0)
(while regex-index
(setq regex-index
(string-match "@\\([_a-zA-Z0-9]+\\)\\|\\(https?://[-_.!~*'()a-zA-Z0-9;/?:@&=+$,%#]+\\)"
text
regex-index))
(when regex-index
(let* ((matched-string (match-string-no-properties 0 text))
(screen-name (match-string-no-properties 1 text))
(uri (match-string-no-properties 2 text)))
(add-text-properties
(if screen-name
(+ 1 (match-beginning 0))
(match-beginning 0))
(match-end 0)
(if screen-name
`(mouse-face
highlight
face twittering-uri-face
username ,screen-name
uri ,(concat "http://twitter.com/" screen-name))
`(mouse-face highlight
face twittering-uri-face
uri ,uri))
text))
(setq regex-index (match-end 0)) ))
;; make screen-name clickable
(add-text-properties
0 (length user-screen-name)
`(mouse-face highlight
face twittering-username-face
uri ,(concat "http://twitter.com/" user-screen-name)
username ,user-screen-name)
user-screen-name)
;; make source pretty and clickable
(if (string-match "<a href=\"\\(.*\\)\">\\(.*\\)</a>" source)
(let ((uri (match-string-no-properties 1 source))
(caption (match-string-no-properties 2 source)))
(setq source caption)
(add-text-properties
0 (length source)
`(mouse-face highlight
uri ,uri
face twittering-uri-face
source ,source)
source)
))
(mapcar
(lambda (sym)
`(,sym . ,(symbol-value sym)))
'(id text source created-at truncated
user-id user-name user-screen-name user-location
user-description
user-profile-image-url
user-url
user-protected)))))
(defun twittering-xmltree-to-status (xmltree)
(mapcar #'twittering-status-to-status-datum
;; quirk to treat difference between xml.el in Emacs21 and Emacs22
;; On Emacs22, there may be blank strings
(let ((ret nil) (statuses (reverse (cddr (car xmltree)))))
(while statuses
(if (consp (car statuses))
(setq ret (cons (car statuses) ret)))
(setq statuses (cdr statuses)))
ret)))
(defun twittering-percent-encode (str &optional coding-system)
(if (or (null coding-system)
(not (coding-system-p coding-system)))
(setq coding-system 'utf-8))
(mapconcat
(lambda (c)
(cond
((twittering-url-reserved-p c)
(char-to-string c))
((eq c ? ) "+")
(t (format "%%%x" c))))
(encode-coding-string str coding-system)
""))
(defun twittering-url-reserved-p (ch)
(or (and (<= ?A ch) (<= ch ?z))
(and (<= ?0 ch) (<= ch ?9))
(eq ?. ch)
(eq ?- ch)
(eq ?_ ch)
(eq ?~ ch)))
(defun twittering-decode-html-entities (encoded-str)
(if encoded-str
(let ((cursor 0)
(found-at nil)
(result '()))
(while (setq found-at
(string-match "&\\(#\\([0-9]+\\)\\|\\([A-Za-z]+\\)\\);"
encoded-str cursor))
(when (> found-at cursor)
(push (substring encoded-str cursor found-at) result))
(let ((number-entity (match-string-no-properties 2 encoded-str))
(letter-entity (match-string-no-properties 3 encoded-str)))
(cond (number-entity
(push
(char-to-string
(twittering-ucs-to-char
(string-to-number number-entity))) result))
(letter-entity
(cond ((string= "gt" letter-entity) (push ">" result))
((string= "lt" letter-entity) (push "<" result))
(t push "?" result)))
(t (push "?" result)))
(setq cursor (match-end 0))))
(push (substring encoded-str cursor) result)
(apply 'concat (nreverse result)))
""))
(defun twittering-timer-action (func)
(let ((buf (get-buffer twittering-buffer)))
(if (null buf)
(twittering-stop)
(funcall func)
)))
(defun twittering-update-status-if-not-blank (status)
(if (string-match "^\\s-*\\(?:@[-_a-z0-9]+\\)?\\s-*$" status)
nil
(twittering-http-post "statuses" "update"
`(("status" . ,status)
("source" . "twmode")))
t))
(defun twittering-update-status-from-minibuffer (&optional init-str)
(if (null init-str) (setq init-str ""))
(let ((status init-str) (not-posted-p t))
(while not-posted-p
(setq status (read-from-minibuffer "status: " status nil nil nil nil t))
(setq not-posted-p
(not (twittering-update-status-if-not-blank status))))))
(defun twittering-update-lambda ()
(interactive)
(twittering-http-post
"statuses" "update"
`(("status" . "\xd34b\xd22b\xd26f\xd224\xd224\xd268\xd34b")
("source" . "twmode"))))
(defun twittering-update-jojo (usr msg)
(if (string-match "\xde21\xd24b\\(\xd22a\xe0b0\\|\xdaae\xe6cd\\)\xd24f\xd0d6\\([^\xd0d7]+\\)\xd0d7\xd248\xdc40\xd226"
msg)
(twittering-http-post
"statuses" "update"
`(("status" . ,(concat
"@" usr " "
(match-string-no-properties 2 msg)
"\xd0a1\xd24f\xd243!?"))
("source" . "twmode")))))
;;;
;;; Commands
;;;
(defun twittering-start (&optional action)
(interactive)
(if (null action)
(setq action #'twittering-friends-timeline))
(if twittering-timer
nil
(setq twittering-timer
(run-at-time "0 sec"
twittering-timer-interval
#'twittering-timer-action action))))
(defun twittering-stop ()
(interactive)
(cancel-timer twittering-timer)
(setq twittering-timer nil))
(defun twittering-friends-timeline ()
(interactive)
(let ((buf (get-buffer twittering-buffer)))
(if (not buf)
(twittering-stop)
(twittering-http-get "statuses" "friends_timeline")
))
(if twittering-icon-mode
(if twittering-image-stack
(let ((proc
(apply
#'start-process
"wget-images"
(twittering-wget-buffer)
"wget"
(format "--directory-prefix=%s" twittering-tmp-dir)
"--no-clobber"
"--quiet"
twittering-image-stack)))
(set-process-sentinel
proc
(lambda (proc stat)
(clear-image-cache)
(save-excursion
(set-buffer (twittering-wget-buffer))
)))))))
(defun twittering-update-status-interactive ()
(interactive)
(twittering-update-status-from-minibuffer))
(defun twittering-erase-old-statuses ()
(interactive)
(setq twittering-friends-timeline-data nil)
(twittering-http-get "statuses" "friends_timeline"))
(defun twittering-click ()
(interactive)
(let ((uri (get-text-property (point) 'uri)))
(if uri
(browse-url uri))))
(defun twittering-enter ()
(interactive)
(let ((username (get-text-property (point) 'username))
(uri (get-text-property (point) 'uri)))
(if username
(twittering-update-status-from-minibuffer (concat "@" username " "))
(if uri
(browse-url uri)))))
(defun twittering-view-user-page ()
(interactive)
(let ((uri (get-text-property (point) 'uri)))
(if uri
(browse-url uri))))
(defun twittering-reply-to-user ()
(interactive)
(let ((username (get-text-property (point) 'username)))
(if username
(twittering-update-status-from-minibuffer (concat "@" username " ")))))
(defun twittering-get-password ()
(or twittering-password
(setq twittering-password (read-passwd "twittering-mode: "))))
(provide 'twittering-mode)
;;; twittering.el ends here