X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fwebmail.el;h=a234cee1251b48a1bfade0a86843625e6eeb21f4;hb=103453e82aacefcc174d8ae45a7c880a14667d0c;hp=32d89fc921b8ea626f73f5b5bbca7a0ca2c389a6;hpb=dafdd77e2f11cd50443750b5edae672c0b8ea1a3;p=gnus diff --git a/lisp/webmail.el b/lisp/webmail.el index 32d89fc92..a234cee12 100644 --- a/lisp/webmail.el +++ b/lisp/webmail.el @@ -1,25 +1,25 @@ ;;; webmail.el --- interface of web mail -;; Copyright (C) 1999, 2000, 2001 Free Software Foundation, Inc. + +;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, +;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. ;; Author: Shenghuo Zhu ;; Keywords: hotmail netaddress my-deja netscape ;; This file is part of GNU Emacs. -;; GNU Emacs 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. +;; GNU Emacs 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 3 of the License, or +;; (at your option) any later version. -;; GNU Emacs 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. +;; GNU Emacs 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. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -48,21 +48,16 @@ (require 'gnus) (require 'nnmail) (require 'mm-util) +(require 'mm-url) (require 'mml) (eval-when-compile (ignore-errors - (require 'w3) (require 'url) - (require 'url-cookie) - (require 'w3-forms) - (require 'nnweb))) + (require 'url-cookie))) ;; Report failure to find w3 at load time if appropriate. (eval '(progn - (require 'w3) (require 'url) - (require 'url-cookie) - (require 'w3-forms) - (require 'nnweb))) + (require 'url-cookie))) ;;; @@ -144,14 +139,12 @@ (my-deja (paranoid cookie post) (address . "www.my-deja.com") - (open-url "http://www.deja.com/my/pr.xp") - (open-snarf . webmail-my-deja-open) + ;;(open-snarf . webmail-my-deja-open) (login-url content - ("%s" webmail-aux) - "member_name=%s&pw=%s&go=&priv_opt_MyDeja99=" + ("http://mydeja.google.com/cgi-bin/deja/maillogin.py") + "userid=%s&password=%s" user password) - (list-url "http://www.deja.com/rg_gotomail.xp") (list-snarf . webmail-my-deja-list) (article-snarf . webmail-my-deja-article) (trash-url webmail-aux id)))) @@ -201,10 +194,9 @@ (defun webmail-debug (str) (with-temp-buffer (insert "\n---------------- A bug at " str " ------------------\n") - (mapcar #'(lambda (sym) - (if (boundp sym) - (pp `(setq ,sym ',(eval sym)) (current-buffer)))) - '(webmail-type user)) + (dolist (sym '(webmail-type user)) + (if (boundp sym) + (gnus-pp `(setq ,sym ',(eval sym))))) (insert "---------------- webmail buffer ------------------\n\n") (insert-buffer-substring webmail-buffer) (insert "\n---------------- end of buffer ------------------\n\n") @@ -228,31 +220,6 @@ (set (intern (concat "webmail-" (symbol-name var))) (cdr pair)) (set (intern (concat "webmail-" (symbol-name var))) nil))))) -(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) - (defun webmail-eval (expr) (cond ((consp expr) @@ -267,15 +234,15 @@ (cond ((eq (car xurl) 'content) (pop xurl) - (webmail-fetch-simple (if (stringp (car xurl)) + (mm-url-fetch-simple (if (stringp (car xurl)) (car xurl) (apply 'format (webmail-eval (car xurl)))) (apply 'format (webmail-eval (cdr xurl))))) ((eq (car xurl) 'post) (pop xurl) - (webmail-fetch-form (car xurl) (webmail-eval (cdr xurl)))) + (mm-url-fetch-form (car xurl) (webmail-eval (cdr xurl)))) (t - (nnweb-insert (apply 'format (webmail-eval xurl))))))) + (mm-url-insert (apply 'format (webmail-eval xurl))))))) (defun webmail-init () "Initialize buffers and such." @@ -317,7 +284,7 @@ (let ((url (match-string 1))) (erase-buffer) (mm-with-unibyte-current-buffer - (nnweb-insert url))) + (mm-url-insert url))) (goto-char (point-min)))) (defun webmail-fetch (file subtype user password) @@ -359,7 +326,7 @@ (message "Fetching mail #%d..." (setq n (1+ n))) (erase-buffer) (mm-with-unibyte-current-buffer - (nnweb-insert (cdr item))) + (mm-url-insert (cdr item))) (setq id (car item)) (if webmail-article-snarf (funcall webmail-article-snarf file id)) @@ -461,9 +428,8 @@ (if (not (search-forward "" nil t)) (webmail-error "article@3.1")) (delete-region (match-beginning 0) (point-max)) - (nnweb-remove-markup) - (let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities))) - (nnweb-decode-entities)) + (mm-url-remove-markup) + (mm-url-decode-entities-nbsp) (goto-char (point-min)) (while (re-search-forward "\r\n?" nil t) (replace-match "\n")) @@ -494,9 +460,8 @@ (setq p (match-beginning 0)) (search-forward "" nil t) (delete-region p (match-end 0))) - (nnweb-remove-markup) - (let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities))) - (nnweb-decode-entities)) + (mm-url-remove-markup) + (mm-url-decode-entities-nbsp) (goto-char (point-min)) (delete-blank-lines) (goto-char (point-min)) @@ -516,7 +481,7 @@ (delete-region p (match-end 0)) (save-excursion (set-buffer (generate-new-buffer " *webmail-att*")) - (nnweb-insert attachment) + (mm-url-insert attachment) (push (current-buffer) webmail-buffer-list) (setq bufname (buffer-name))) (setq mime t) @@ -551,9 +516,8 @@ (goto-char (match-end 0)) (if (looking-at "$") (forward-char)) (delete-region (point-min) (point)) - (nnweb-remove-markup) - (let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities))) - (nnweb-decode-entities)) + (mm-url-remove-markup) + (mm-url-decode-entities-nbsp) nil) (t (setq mime t) @@ -648,9 +612,8 @@ (setq p (match-beginning 0)) (search-forward "" nil t) (delete-region p (match-end 0))) - (nnweb-remove-markup) - (let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities))) - (nnweb-decode-entities)) + (mm-url-remove-markup) + (mm-url-decode-entities-nbsp) (goto-char (point-min)) (delete-blank-lines) (goto-char (point-max)) @@ -666,13 +629,12 @@ (if (not (search-forward "" nil t)) (webmail-error "article@5")) (narrow-to-region p (match-end 0)) - (nnweb-remove-markup) - (let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities))) - (nnweb-decode-entities)) + (mm-url-remove-markup) + (mm-url-decode-entities-nbsp) (goto-char (point-min)) (delete-blank-lines) (setq ct (mail-fetch-field "content-type") - ctl (ignore-errors (mail-header-parse-content-type ct)) + ctl (and ct (mail-header-parse-content-type ct)) ;;cte (mail-fetch-field "content-transfer-encoding") cd (mail-fetch-field "content-disposition") description (mail-fetch-field "content-description") @@ -681,7 +643,7 @@ (widen) (save-excursion (set-buffer (generate-new-buffer " *webmail-att*")) - (nnweb-insert (concat webmail-aux attachment)) + (mm-url-insert (concat webmail-aux attachment)) (push (current-buffer) webmail-buffer-list) (setq bufname (buffer-name))) (insert "<#part") @@ -776,9 +738,8 @@ (goto-char (point-min)) (while (re-search-forward "
" nil t) (replace-match "\n")) - (nnweb-remove-markup) - (let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities))) - (nnweb-decode-entities)) + (mm-url-remove-markup) + (mm-url-decode-entities-nbsp) nil) (t (insert "<#part type=\"text/html\" disposition=inline>") @@ -806,9 +767,8 @@ (goto-char (point-min)) (while (search-forward "" nil t) (replace-match "\n")) - (nnweb-remove-markup) - (let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities))) - (nnweb-decode-entities)) + (mm-url-remove-markup) + (mm-url-decode-entities-nbsp) (goto-char (point-min)) (delete-blank-lines) (goto-char (point-min)) @@ -850,7 +810,7 @@ (let (bufname);; Attachment (save-excursion (set-buffer (generate-new-buffer " *webmail-att*")) - (nnweb-insert (concat (car webmail-open-url) attachment)) + (mm-url-insert (concat (car webmail-open-url) attachment)) (push (current-buffer) webmail-buffer-list) (setq bufname (buffer-name))) (insert "<#part type=" type) @@ -934,9 +894,8 @@ (goto-char (point-min)) (while (search-forward "" nil t) (replace-match "\n")) - (nnweb-remove-markup) - (let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities))) - (nnweb-decode-entities)) + (mm-url-remove-markup) + (mm-url-decode-entities-nbsp) (goto-char (point-min)) (delete-blank-lines) (goto-char (point-min)) @@ -978,7 +937,7 @@ (let (bufname);; Attachment (save-excursion (set-buffer (generate-new-buffer " *webmail-att*")) - (nnweb-insert (concat (car webmail-open-url) attachment)) + (mm-url-insert (concat (car webmail-open-url) attachment)) (push (current-buffer) webmail-buffer-list) (setq bufname (buffer-name))) (insert "<#part type=" type) @@ -1045,7 +1004,7 @@ (defun webmail-my-deja-open () (webmail-refresh-redirect) (goto-char (point-min)) - (if (re-search-forward "action=\"\\([^\"]+login_confirm\\.xp[^\"]*\\)\"" + (if (re-search-forward "action=\"\\([^\"]+maillogin\\.py[^\"]*\\)\"" nil t) (setq webmail-aux (match-string 1)) (webmail-error "open@1"))) @@ -1058,7 +1017,7 @@ (let ((url (match-string 1))) (setq base (match-string 2)) (erase-buffer) - (nnweb-insert url))) + (mm-url-insert url))) (goto-char (point-min)) (when (re-search-forward "(\\([0-9]+\\) Message.?-[^>]*\\([0-9]+\\) New" @@ -1095,9 +1054,8 @@ (match-beginning 0) (point-max))) (goto-char (point-min)) - (nnweb-remove-markup) - (let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities))) - (nnweb-decode-entities)) + (mm-url-remove-markup) + (mm-url-decode-entities-nbsp) (goto-char (point-max)))) ((looking-at "[\t\040\r\n]*