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

Revision 79, 30.8 kB (checked in by tsuyoshi, 16 years ago)

Add keybind in Major mode docstirng

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