Synch with Gnus.

[elisp/gnus.git-] / lisp / webmail.el

diff --git a/lisp/webmail.el b/lisp/webmail.el
index d7eb667..38638ef 100644 (file)
--- a/lisp/webmail.el
+++ b/lisp/webmail.el
@@ -23,6 +23,9 @@
 
 ;;; Commentary:
 
+;; Note: Now mail.yahoo.com provides POP3 service, the webmail
+;; fetching is not going to be supported.
+
 ;; Note: You need to have `url' and `w3' installed for this backend to
 ;; work. `w3' must be 4.0pre46+one-line-cookie patch or standalone
 ;; `url'.
@@ -74,8 +77,8 @@
      (login-url
       "http://%s/cgi-bin/dologin?login=%s&passwd=%s&enter=Sign+in&sec=no&curmbox=ACTIVE&_lang=&js=yes&id=2&tw=-10000&beta="
       webmail-aux user password)
-     (login-snarf . webmail-hotmail-login)
-     (list-url "%s" webmail-aux)
+     ;;(login-snarf . webmail-hotmail-login)
+     ;;(list-url "%s" webmail-aux)
      (list-snarf . webmail-hotmail-list)
      (article-snarf . webmail-hotmail-article)
      (trash-url 
@@ -275,7 +278,7 @@
       (webmail-fetch-form (car xurl) (webmail-eval (cdr xurl))))
      (t
       (nnweb-insert (apply 'format (webmail-eval xurl)))))))
-  
+
 (defun webmail-init ()
   "Initialize buffers and such."
   (if (gnus-buffer-live-p webmail-buffer)
@@ -311,7 +314,7 @@
   "Redirect refresh url in META."
   (goto-char (point-min))
   (while (re-search-forward 
-         "HTTP-EQUIV=\"Refresh\"[^>]*URL=\\([^\"]+\\)\""
+         "<meta[ \t\r\n]*http-equiv=\"Refresh\"[^>]*URL=\\([^\"]+\\)\""
          nil t)
     (let ((url (match-string 1)))
       (erase-buffer)
@@ -334,6 +337,7 @@
          (url-confirmation-func (if (memq 'post webmail-paranoid)
                                     'webmail-url-confirmation-func
                                   url-confirmation-func))
+         (url-http-silence-on-insecure-redirection t)
          url-cookie-storage url-cookie-secure-storage
          url-cookie-confirmation
          item id (n 0))
@@ -403,7 +407,7 @@
       (webmail-error "login@1"))
     (goto-char (point-min))
     (if (re-search-forward 
-        "\\(/cgi-bin/HoTMaiL\\?[^\"]*curmbox=ACTIVE[^\"]*\\)" nil t)
+        "\\(/cgi-bin/HoTMaiL\\?[^\"]*a=b[^\"]*\\)" nil t)
        (setq webmail-aux (concat "http://" site (match-string 1)))
       (webmail-error "login@2"))))
 
@@ -451,14 +455,18 @@
       (webmail-error "article@3.1"))
   (delete-region (match-beginning 0) (point-max))
   (nnweb-remove-markup)
-  (nnweb-decode-entities)
+  (let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities)))
+    (nnweb-decode-entities))
   (goto-char (point-min))
   (while (re-search-forward "\r\n?" nil t)
     (replace-match "\n"))
   (goto-char (point-min))
   (insert "\n\n")
   (if (not (looking-at "\n*From "))
-      (insert "From nobody " (current-time-string) "\n"))
+      (insert "From nobody " (current-time-string) "\n")
+    (forward-line))
+  (insert "X-Gnus-Webmail: " (symbol-value 'user)
+         "@" (symbol-name webmail-type) "\n")
   (mm-append-to-file (point-min) (point-max) file))
 
 (defun webmail-hotmail-article-old (file id)
@@ -480,7 +488,8 @@
        (search-forward "</a>" nil t)
        (delete-region p (match-end 0)))
       (nnweb-remove-markup)
-      (nnweb-decode-entities)
+      (let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities)))
+       (nnweb-decode-entities))
       (goto-char (point-min))
       (delete-blank-lines)
       (goto-char (point-min))
@@ -536,7 +545,8 @@
            (if (looking-at "$") (forward-char))
            (delete-region (point-min) (point))
            (nnweb-remove-markup)
-           (nnweb-decode-entities)
+           (let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities)))
+             (nnweb-decode-entities))
            nil)
           (t
            (setq mime t)
@@ -550,8 +560,10 @@
       (goto-char (point-min))
       ;; Some blank line to seperate mails.
       (insert "\n\nFrom nobody " (current-time-string) "\n")
+      (insert "X-Gnus-Webmail: " (symbol-value 'user)
+             "@" (symbol-name webmail-type) "\n")
       (if id
-         (insert (format "Message-ID: <%s@hotmail.com>\n" id)))
+         (insert (format "X-Message-ID: <%s@hotmail.com>\n" id)))
       (unless (looking-at "$") 
        (if (search-forward "\n\n" nil t)
            (forward-line -1)
@@ -630,7 +642,8 @@
        (search-forward "</a>" nil t)
        (delete-region p (match-end 0)))
       (nnweb-remove-markup)
-      (nnweb-decode-entities)
+      (let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities)))
+       (nnweb-decode-entities))
       (goto-char (point-min))
       (delete-blank-lines)
       (goto-char (point-max))
@@ -647,7 +660,8 @@
              (webmail-error "article@5"))
          (narrow-to-region p (match-end 0))
          (nnweb-remove-markup)
-         (nnweb-decode-entities)
+         (let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities)))
+           (nnweb-decode-entities))
          (goto-char (point-min))
          (delete-blank-lines)
          (setq ct (mail-fetch-field "content-type")
@@ -677,8 +691,10 @@
       (goto-char (point-min))
       ;; Some blank line to seperate mails.
       (insert "\n\nFrom nobody " (current-time-string) "\n")
+      (insert "X-Gnus-Webmail: " (symbol-value 'user)
+             "@" (symbol-name webmail-type) "\n")
       (if id
-         (insert (format "Message-ID: <%s@yahoo.com>\n" id)))
+         (insert (format "X-Message-ID: <%s@yahoo.com>\n" id)))
       (unless (looking-at "$") 
        (if (search-forward "\n\n" nil t)
            (forward-line -1)
@@ -718,6 +734,7 @@
     (webmail-error "login@1")))
 
 (defun webmail-netaddress-list ()
+  (webmail-refresh-redirect)
   (let (item id)
     (goto-char (point-min))
     (when (re-search-forward 
@@ -750,7 +767,8 @@
     (while (re-search-forward "<br>" nil t)
       (replace-match "\n"))
     (nnweb-remove-markup)
-    (nnweb-decode-entities) 
+    (let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities)))
+      (nnweb-decode-entities))
     nil)
    (t
     (insert "<#part type=\"text/html\" disposition=inline>")
@@ -759,6 +777,7 @@
     t)))
 
 (defun webmail-netaddress-article (file id)
+  (webmail-refresh-redirect)
   (let (p p1 attachment count mime type)
     (save-restriction
       (webmail-encode-8bit)
@@ -778,7 +797,8 @@
       (while (search-forward "<b>" nil t)
        (replace-match "\n"))
       (nnweb-remove-markup)
-      (nnweb-decode-entities)
+      (let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities)))
+       (nnweb-decode-entities))
       (goto-char (point-min))
       (delete-blank-lines)
       (goto-char (point-min))
@@ -847,8 +867,10 @@
       (goto-char (point-min))
       ;; Some blank line to seperate mails.
       (insert "\n\nFrom nobody " (current-time-string) "\n")
+      (insert "X-Gnus-Webmail: " (symbol-value 'user)
+             "@" (symbol-name webmail-type) "\n")
       (if id
-         (insert (format "Message-ID: <%s@%s>\n" id webmail-address)))
+         (insert (format "X-Message-ID: <%s@%s>\n" id webmail-address)))
       (unless (looking-at "$") 
        (if (search-forward "\n\n" nil t)
            (forward-line -1)
@@ -903,7 +925,8 @@
       (while (search-forward "<b>" nil t)
        (replace-match "\n"))
       (nnweb-remove-markup)
-      (nnweb-decode-entities)
+      (let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities)))
+       (nnweb-decode-entities))
       (goto-char (point-min))
       (delete-blank-lines)
       (goto-char (point-min))
@@ -972,8 +995,10 @@
       (goto-char (point-min))
       ;; Some blank line to seperate mails.
       (insert "\n\nFrom nobody " (current-time-string) "\n")
+      (insert "X-Gnus-Webmail: " (symbol-value 'user)
+             "@" (symbol-name webmail-type) "\n")
       (if id
-         (insert (format "Message-ID: <%s@%s>\n" id webmail-address)))
+         (insert (format "X-Message-ID: <%s@%s>\n" id webmail-address)))
       (unless (looking-at "$") 
        (if (search-forward "\n\n" nil t)
            (forward-line -1)
@@ -1052,6 +1077,8 @@
       (replace-match "\n"))
     (goto-char (point-min))
     (insert "\n\nFrom nobody " (current-time-string) "\n")
+    (insert "X-Gnus-Webmail: " (symbol-value 'user)
+           "@" (symbol-name webmail-type) "\n")
     (mm-append-to-file (point-min) (point-max) file)))
 
 (provide 'webmail)