/[emacs]/emacs/lisp/gnus/webmail.el
ViewVC logotype

Diff of /emacs/lisp/gnus/webmail.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.3.16.1 by miles, Tue Oct 14 23:34:51 2003 UTC revision 1.3.16.2 by miles, Thu Sep 16 00:12:16 2004 UTC
# Line 1  Line 1 
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
# Line 48  Line 48 
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    
# Line 144  Line 139 
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))))
# Line 203  Line 196 
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)
# Line 228  Line 221 
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)
# Line 267  Line 235 
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."
# Line 317  Line 285 
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)
# Line 359  Line 327 
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))
# Line 461  Line 429 
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"))
# Line 494  Line 461 
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))
# Line 516  Line 482 
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)
# Line 551  Line 517 
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)
# Line 648  Line 613 
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))
# Line 666  Line 630 
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")
# Line 681  Line 644 
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")
# Line 776  Line 739 
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>")
# Line 806  Line 768 
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))
# Line 850  Line 811 
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)
# Line 934  Line 895 
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))
# Line 978  Line 938 
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)
# Line 1045  Line 1005 
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")))
# Line 1058  Line 1018 
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"
# Line 1095  Line 1055 
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
# Line 1126  Line 1085 
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 "\"")
# Line 1159  Line 1118 
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"))

Legend:
Removed from v.1.3.16.1  
changed lines
  Added in v.1.3.16.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26