1 |
;;; webmail.el --- interface of web mail |
;;; webmail.el --- interface of web mail |
2 |
;; Copyright (C) 1999, 2000, 2001 Free Software Foundation, Inc. |
;; Copyright (C) 1999, 2000, 2001, 2004 Free Software Foundation, Inc. |
3 |
|
|
4 |
;; Author: Shenghuo Zhu <zsh@cs.rochester.edu> |
;; Author: Shenghuo Zhu <zsh@cs.rochester.edu> |
5 |
;; Keywords: hotmail netaddress my-deja netscape |
;; Keywords: hotmail netaddress my-deja netscape |
48 |
(require 'gnus) |
(require 'gnus) |
49 |
(require 'nnmail) |
(require 'nnmail) |
50 |
(require 'mm-util) |
(require 'mm-util) |
51 |
|
(require 'mm-url) |
52 |
(require 'mml) |
(require 'mml) |
53 |
(eval-when-compile |
(eval-when-compile |
54 |
(ignore-errors |
(ignore-errors |
|
(require 'w3) |
|
55 |
(require 'url) |
(require 'url) |
56 |
(require 'url-cookie) |
(require 'url-cookie))) |
|
(require 'w3-forms) |
|
|
(require 'nnweb))) |
|
57 |
;; Report failure to find w3 at load time if appropriate. |
;; Report failure to find w3 at load time if appropriate. |
58 |
(eval '(progn |
(eval '(progn |
|
(require 'w3) |
|
59 |
(require 'url) |
(require 'url) |
60 |
(require 'url-cookie) |
(require 'url-cookie))) |
|
(require 'w3-forms) |
|
|
(require 'nnweb))) |
|
61 |
|
|
62 |
;;; |
;;; |
63 |
|
|
139 |
(my-deja |
(my-deja |
140 |
(paranoid cookie post) |
(paranoid cookie post) |
141 |
(address . "www.my-deja.com") |
(address . "www.my-deja.com") |
142 |
(open-url "http://www.deja.com/my/pr.xp") |
;;(open-snarf . webmail-my-deja-open) |
|
(open-snarf . webmail-my-deja-open) |
|
143 |
(login-url |
(login-url |
144 |
content |
content |
145 |
("%s" webmail-aux) |
("http://mydeja.google.com/cgi-bin/deja/maillogin.py") |
146 |
"member_name=%s&pw=%s&go=&priv_opt_MyDeja99=" |
"userid=%s&password=%s" |
147 |
user password) |
user password) |
|
(list-url "http://www.deja.com/rg_gotomail.xp") |
|
148 |
(list-snarf . webmail-my-deja-list) |
(list-snarf . webmail-my-deja-list) |
149 |
(article-snarf . webmail-my-deja-article) |
(article-snarf . webmail-my-deja-article) |
150 |
(trash-url webmail-aux id)))) |
(trash-url webmail-aux id)))) |
196 |
(insert "\n---------------- A bug at " str " ------------------\n") |
(insert "\n---------------- A bug at " str " ------------------\n") |
197 |
(mapcar #'(lambda (sym) |
(mapcar #'(lambda (sym) |
198 |
(if (boundp sym) |
(if (boundp sym) |
199 |
(pp `(setq ,sym ',(eval sym)) (current-buffer)))) |
(gnus-pp `(setq ,sym ',(eval sym))))) |
200 |
'(webmail-type user)) |
'(webmail-type user)) |
201 |
(insert "---------------- webmail buffer ------------------\n\n") |
(insert "---------------- webmail buffer ------------------\n\n") |
202 |
(insert-buffer-substring webmail-buffer) |
(insert-buffer-substring webmail-buffer) |
221 |
(set (intern (concat "webmail-" (symbol-name var))) (cdr pair)) |
(set (intern (concat "webmail-" (symbol-name var))) (cdr pair)) |
222 |
(set (intern (concat "webmail-" (symbol-name var))) nil))))) |
(set (intern (concat "webmail-" (symbol-name var))) nil))))) |
223 |
|
|
|
(defun webmail-encode-www-form-urlencoded (pairs) |
|
|
"Return PAIRS encoded for forms." |
|
|
(mapconcat |
|
|
(function |
|
|
(lambda (data) |
|
|
(concat (w3-form-encode-xwfu (car data)) "=" |
|
|
(w3-form-encode-xwfu (cdr data))))) |
|
|
pairs "&")) |
|
|
|
|
|
(defun webmail-fetch-simple (url content) |
|
|
(let ((url-request-data content) |
|
|
(url-request-method "POST") |
|
|
(url-request-extra-headers |
|
|
'(("Content-type" . "application/x-www-form-urlencoded")))) |
|
|
(nnweb-insert url)) |
|
|
t) |
|
|
|
|
|
(defun webmail-fetch-form (url pairs) |
|
|
(let ((url-request-data (webmail-encode-www-form-urlencoded pairs)) |
|
|
(url-request-method "POST") |
|
|
(url-request-extra-headers |
|
|
'(("Content-type" . "application/x-www-form-urlencoded")))) |
|
|
(nnweb-insert url)) |
|
|
t) |
|
|
|
|
224 |
(defun webmail-eval (expr) |
(defun webmail-eval (expr) |
225 |
(cond |
(cond |
226 |
((consp expr) |
((consp expr) |
235 |
(cond |
(cond |
236 |
((eq (car xurl) 'content) |
((eq (car xurl) 'content) |
237 |
(pop xurl) |
(pop xurl) |
238 |
(webmail-fetch-simple (if (stringp (car xurl)) |
(mm-url-fetch-simple (if (stringp (car xurl)) |
239 |
(car xurl) |
(car xurl) |
240 |
(apply 'format (webmail-eval (car xurl)))) |
(apply 'format (webmail-eval (car xurl)))) |
241 |
(apply 'format (webmail-eval (cdr xurl))))) |
(apply 'format (webmail-eval (cdr xurl))))) |
242 |
((eq (car xurl) 'post) |
((eq (car xurl) 'post) |
243 |
(pop xurl) |
(pop xurl) |
244 |
(webmail-fetch-form (car xurl) (webmail-eval (cdr xurl)))) |
(mm-url-fetch-form (car xurl) (webmail-eval (cdr xurl)))) |
245 |
(t |
(t |
246 |
(nnweb-insert (apply 'format (webmail-eval xurl))))))) |
(mm-url-insert (apply 'format (webmail-eval xurl))))))) |
247 |
|
|
248 |
(defun webmail-init () |
(defun webmail-init () |
249 |
"Initialize buffers and such." |
"Initialize buffers and such." |
285 |
(let ((url (match-string 1))) |
(let ((url (match-string 1))) |
286 |
(erase-buffer) |
(erase-buffer) |
287 |
(mm-with-unibyte-current-buffer |
(mm-with-unibyte-current-buffer |
288 |
(nnweb-insert url))) |
(mm-url-insert url))) |
289 |
(goto-char (point-min)))) |
(goto-char (point-min)))) |
290 |
|
|
291 |
(defun webmail-fetch (file subtype user password) |
(defun webmail-fetch (file subtype user password) |
327 |
(message "Fetching mail #%d..." (setq n (1+ n))) |
(message "Fetching mail #%d..." (setq n (1+ n))) |
328 |
(erase-buffer) |
(erase-buffer) |
329 |
(mm-with-unibyte-current-buffer |
(mm-with-unibyte-current-buffer |
330 |
(nnweb-insert (cdr item))) |
(mm-url-insert (cdr item))) |
331 |
(setq id (car item)) |
(setq id (car item)) |
332 |
(if webmail-article-snarf |
(if webmail-article-snarf |
333 |
(funcall webmail-article-snarf file id)) |
(funcall webmail-article-snarf file id)) |
429 |
(if (not (search-forward "</pre>" nil t)) |
(if (not (search-forward "</pre>" nil t)) |
430 |
(webmail-error "article@3.1")) |
(webmail-error "article@3.1")) |
431 |
(delete-region (match-beginning 0) (point-max)) |
(delete-region (match-beginning 0) (point-max)) |
432 |
(nnweb-remove-markup) |
(mm-url-remove-markup) |
433 |
(let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities))) |
(mm-url-decode-entities-nbsp) |
|
(nnweb-decode-entities)) |
|
434 |
(goto-char (point-min)) |
(goto-char (point-min)) |
435 |
(while (re-search-forward "\r\n?" nil t) |
(while (re-search-forward "\r\n?" nil t) |
436 |
(replace-match "\n")) |
(replace-match "\n")) |
461 |
(setq p (match-beginning 0)) |
(setq p (match-beginning 0)) |
462 |
(search-forward "</a>" nil t) |
(search-forward "</a>" nil t) |
463 |
(delete-region p (match-end 0))) |
(delete-region p (match-end 0))) |
464 |
(nnweb-remove-markup) |
(mm-url-remove-markup) |
465 |
(let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities))) |
(mm-url-decode-entities-nbsp) |
|
(nnweb-decode-entities)) |
|
466 |
(goto-char (point-min)) |
(goto-char (point-min)) |
467 |
(delete-blank-lines) |
(delete-blank-lines) |
468 |
(goto-char (point-min)) |
(goto-char (point-min)) |
482 |
(delete-region p (match-end 0)) |
(delete-region p (match-end 0)) |
483 |
(save-excursion |
(save-excursion |
484 |
(set-buffer (generate-new-buffer " *webmail-att*")) |
(set-buffer (generate-new-buffer " *webmail-att*")) |
485 |
(nnweb-insert attachment) |
(mm-url-insert attachment) |
486 |
(push (current-buffer) webmail-buffer-list) |
(push (current-buffer) webmail-buffer-list) |
487 |
(setq bufname (buffer-name))) |
(setq bufname (buffer-name))) |
488 |
(setq mime t) |
(setq mime t) |
517 |
(goto-char (match-end 0)) |
(goto-char (match-end 0)) |
518 |
(if (looking-at "$") (forward-char)) |
(if (looking-at "$") (forward-char)) |
519 |
(delete-region (point-min) (point)) |
(delete-region (point-min) (point)) |
520 |
(nnweb-remove-markup) |
(mm-url-remove-markup) |
521 |
(let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities))) |
(mm-url-decode-entities-nbsp) |
|
(nnweb-decode-entities)) |
|
522 |
nil) |
nil) |
523 |
(t |
(t |
524 |
(setq mime t) |
(setq mime t) |
613 |
(setq p (match-beginning 0)) |
(setq p (match-beginning 0)) |
614 |
(search-forward "</a>" nil t) |
(search-forward "</a>" nil t) |
615 |
(delete-region p (match-end 0))) |
(delete-region p (match-end 0))) |
616 |
(nnweb-remove-markup) |
(mm-url-remove-markup) |
617 |
(let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities))) |
(mm-url-decode-entities-nbsp) |
|
(nnweb-decode-entities)) |
|
618 |
(goto-char (point-min)) |
(goto-char (point-min)) |
619 |
(delete-blank-lines) |
(delete-blank-lines) |
620 |
(goto-char (point-max)) |
(goto-char (point-max)) |
630 |
(if (not (search-forward "</table>" nil t)) |
(if (not (search-forward "</table>" nil t)) |
631 |
(webmail-error "article@5")) |
(webmail-error "article@5")) |
632 |
(narrow-to-region p (match-end 0)) |
(narrow-to-region p (match-end 0)) |
633 |
(nnweb-remove-markup) |
(mm-url-remove-markup) |
634 |
(let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities))) |
(mm-url-decode-entities-nbsp) |
|
(nnweb-decode-entities)) |
|
635 |
(goto-char (point-min)) |
(goto-char (point-min)) |
636 |
(delete-blank-lines) |
(delete-blank-lines) |
637 |
(setq ct (mail-fetch-field "content-type") |
(setq ct (mail-fetch-field "content-type") |
644 |
(widen) |
(widen) |
645 |
(save-excursion |
(save-excursion |
646 |
(set-buffer (generate-new-buffer " *webmail-att*")) |
(set-buffer (generate-new-buffer " *webmail-att*")) |
647 |
(nnweb-insert (concat webmail-aux attachment)) |
(mm-url-insert (concat webmail-aux attachment)) |
648 |
(push (current-buffer) webmail-buffer-list) |
(push (current-buffer) webmail-buffer-list) |
649 |
(setq bufname (buffer-name))) |
(setq bufname (buffer-name))) |
650 |
(insert "<#part") |
(insert "<#part") |
739 |
(goto-char (point-min)) |
(goto-char (point-min)) |
740 |
(while (re-search-forward "<br>" nil t) |
(while (re-search-forward "<br>" nil t) |
741 |
(replace-match "\n")) |
(replace-match "\n")) |
742 |
(nnweb-remove-markup) |
(mm-url-remove-markup) |
743 |
(let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities))) |
(mm-url-decode-entities-nbsp) |
|
(nnweb-decode-entities)) |
|
744 |
nil) |
nil) |
745 |
(t |
(t |
746 |
(insert "<#part type=\"text/html\" disposition=inline>") |
(insert "<#part type=\"text/html\" disposition=inline>") |
768 |
(goto-char (point-min)) |
(goto-char (point-min)) |
769 |
(while (search-forward "<b>" nil t) |
(while (search-forward "<b>" nil t) |
770 |
(replace-match "\n")) |
(replace-match "\n")) |
771 |
(nnweb-remove-markup) |
(mm-url-remove-markup) |
772 |
(let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities))) |
(mm-url-decode-entities-nbsp) |
|
(nnweb-decode-entities)) |
|
773 |
(goto-char (point-min)) |
(goto-char (point-min)) |
774 |
(delete-blank-lines) |
(delete-blank-lines) |
775 |
(goto-char (point-min)) |
(goto-char (point-min)) |
811 |
(let (bufname);; Attachment |
(let (bufname);; Attachment |
812 |
(save-excursion |
(save-excursion |
813 |
(set-buffer (generate-new-buffer " *webmail-att*")) |
(set-buffer (generate-new-buffer " *webmail-att*")) |
814 |
(nnweb-insert (concat (car webmail-open-url) attachment)) |
(mm-url-insert (concat (car webmail-open-url) attachment)) |
815 |
(push (current-buffer) webmail-buffer-list) |
(push (current-buffer) webmail-buffer-list) |
816 |
(setq bufname (buffer-name))) |
(setq bufname (buffer-name))) |
817 |
(insert "<#part type=" type) |
(insert "<#part type=" type) |
895 |
(goto-char (point-min)) |
(goto-char (point-min)) |
896 |
(while (search-forward "<b>" nil t) |
(while (search-forward "<b>" nil t) |
897 |
(replace-match "\n")) |
(replace-match "\n")) |
898 |
(nnweb-remove-markup) |
(mm-url-remove-markup) |
899 |
(let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities))) |
(mm-url-decode-entities-nbsp) |
|
(nnweb-decode-entities)) |
|
900 |
(goto-char (point-min)) |
(goto-char (point-min)) |
901 |
(delete-blank-lines) |
(delete-blank-lines) |
902 |
(goto-char (point-min)) |
(goto-char (point-min)) |
938 |
(let (bufname);; Attachment |
(let (bufname);; Attachment |
939 |
(save-excursion |
(save-excursion |
940 |
(set-buffer (generate-new-buffer " *webmail-att*")) |
(set-buffer (generate-new-buffer " *webmail-att*")) |
941 |
(nnweb-insert (concat (car webmail-open-url) attachment)) |
(mm-url-insert (concat (car webmail-open-url) attachment)) |
942 |
(push (current-buffer) webmail-buffer-list) |
(push (current-buffer) webmail-buffer-list) |
943 |
(setq bufname (buffer-name))) |
(setq bufname (buffer-name))) |
944 |
(insert "<#part type=" type) |
(insert "<#part type=" type) |
1005 |
(defun webmail-my-deja-open () |
(defun webmail-my-deja-open () |
1006 |
(webmail-refresh-redirect) |
(webmail-refresh-redirect) |
1007 |
(goto-char (point-min)) |
(goto-char (point-min)) |
1008 |
(if (re-search-forward "action=\"\\([^\"]+login_confirm\\.xp[^\"]*\\)\"" |
(if (re-search-forward "action=\"\\([^\"]+maillogin\\.py[^\"]*\\)\"" |
1009 |
nil t) |
nil t) |
1010 |
(setq webmail-aux (match-string 1)) |
(setq webmail-aux (match-string 1)) |
1011 |
(webmail-error "open@1"))) |
(webmail-error "open@1"))) |
1018 |
(let ((url (match-string 1))) |
(let ((url (match-string 1))) |
1019 |
(setq base (match-string 2)) |
(setq base (match-string 2)) |
1020 |
(erase-buffer) |
(erase-buffer) |
1021 |
(nnweb-insert url))) |
(mm-url-insert url))) |
1022 |
(goto-char (point-min)) |
(goto-char (point-min)) |
1023 |
(when (re-search-forward |
(when (re-search-forward |
1024 |
"(\\([0-9]+\\) Message.?-[^>]*\\([0-9]+\\) New" |
"(\\([0-9]+\\) Message.?-[^>]*\\([0-9]+\\) New" |
1055 |
(match-beginning 0) |
(match-beginning 0) |
1056 |
(point-max))) |
(point-max))) |
1057 |
(goto-char (point-min)) |
(goto-char (point-min)) |
1058 |
(nnweb-remove-markup) |
(mm-url-remove-markup) |
1059 |
(let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities))) |
(mm-url-decode-entities-nbsp) |
|
(nnweb-decode-entities)) |
|
1060 |
(goto-char (point-max)))) |
(goto-char (point-max)))) |
1061 |
((looking-at "[\t\040\r\n]*<TABLE") |
((looking-at "[\t\040\r\n]*<TABLE") |
1062 |
(save-restriction |
(save-restriction |
1085 |
(delete-region (point-min) (point-max)) |
(delete-region (point-min) (point-max)) |
1086 |
(save-excursion |
(save-excursion |
1087 |
(set-buffer (generate-new-buffer " *webmail-att*")) |
(set-buffer (generate-new-buffer " *webmail-att*")) |
1088 |
(nnweb-insert url) |
(mm-url-insert url) |
1089 |
(push (current-buffer) webmail-buffer-list) |
(push (current-buffer) webmail-buffer-list) |
1090 |
(setq bufname (buffer-name))) |
(setq bufname (buffer-name))) |
1091 |
(insert "<#part type=\"" type "\"") |
(insert "<#part type=\"" type "\"") |
1118 |
(narrow-to-region (point-min) (point)) |
(narrow-to-region (point-min) (point)) |
1119 |
(while (search-forward "\r\n" nil t) |
(while (search-forward "\r\n" nil t) |
1120 |
(replace-match "\n")) |
(replace-match "\n")) |
1121 |
(nnweb-remove-markup) |
(mm-url-remove-markup) |
1122 |
(let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities))) |
(mm-url-decode-entities-nbsp) |
|
(nnweb-decode-entities)) |
|
1123 |
(goto-char (point-min)) |
(goto-char (point-min)) |
1124 |
(while (re-search-forward "\n\n+" nil t) |
(while (re-search-forward "\n\n+" nil t) |
1125 |
(replace-match "\n")) |
(replace-match "\n")) |