26 |
;; Note: You need to have `url' (w3 0.46) or greater version |
;; Note: You need to have `url' (w3 0.46) or greater version |
27 |
;; installed for this backend to work. |
;; installed for this backend to work. |
28 |
|
|
29 |
;; Todo: |
;; Todo: |
30 |
;; 1. To support more web archives. |
;; 1. To support more web archives. |
31 |
;; 2. Generalize webmail to other MHonArc archive. |
;; 2. Generalize webmail to other MHonArc archive. |
32 |
|
|
60 |
(defvar nnwarchive-type-definition |
(defvar nnwarchive-type-definition |
61 |
'((egroups |
'((egroups |
62 |
(address . "www.egroups.com") |
(address . "www.egroups.com") |
63 |
(open-url |
(open-url |
64 |
"http://www.egroups.com/login.cgi?&login_email=%s&login_password=%s" |
"http://www.egroups.com/login.cgi?&login_email=%s&login_password=%s" |
65 |
nnwarchive-login nnwarchive-passwd) |
nnwarchive-login nnwarchive-passwd) |
66 |
(list-url |
(list-url |
67 |
"http://www.egroups.com/mygroups") |
"http://www.egroups.com/mygroups") |
68 |
(list-dissect . nnwarchive-egroups-list) |
(list-dissect . nnwarchive-egroups-list) |
69 |
(list-groups . nnwarchive-egroups-list-groups) |
(list-groups . nnwarchive-egroups-list-groups) |
70 |
(xover-url |
(xover-url |
71 |
"http://www.egroups.com/messages/%s/%d" group aux) |
"http://www.egroups.com/messages/%s/%d" group aux) |
72 |
(xover-last-url |
(xover-last-url |
73 |
"http://www.egroups.com/messages/%s/" group) |
"http://www.egroups.com/messages/%s/" group) |
74 |
(xover-page-size . 13) |
(xover-page-size . 13) |
75 |
(xover-dissect . nnwarchive-egroups-xover) |
(xover-dissect . nnwarchive-egroups-xover) |
76 |
(article-url |
(article-url |
77 |
"http://www.egroups.com/message/%s/%d?source=1" group article) |
"http://www.egroups.com/message/%s/%d?source=1" group article) |
78 |
(article-dissect . nnwarchive-egroups-article) |
(article-dissect . nnwarchive-egroups-article) |
79 |
(authentication . t) |
(authentication . t) |
82 |
(mail-archive |
(mail-archive |
83 |
(address . "www.mail-archive.com") |
(address . "www.mail-archive.com") |
84 |
(open-url) |
(open-url) |
85 |
(list-url |
(list-url |
86 |
"http://www.mail-archive.com/lists.html") |
"http://www.mail-archive.com/lists.html") |
87 |
(list-dissect . nnwarchive-mail-archive-list) |
(list-dissect . nnwarchive-mail-archive-list) |
88 |
(list-groups . nnwarchive-mail-archive-list-groups) |
(list-groups . nnwarchive-mail-archive-list-groups) |
89 |
(xover-url |
(xover-url |
90 |
"http://www.mail-archive.com/%s/mail%d.html" group aux) |
"http://www.mail-archive.com/%s/mail%d.html" group aux) |
91 |
(xover-last-url |
(xover-last-url |
92 |
"http://www.mail-archive.com/%s/maillist.html" group) |
"http://www.mail-archive.com/%s/maillist.html" group) |
93 |
(xover-page-size) |
(xover-page-size) |
94 |
(xover-dissect . nnwarchive-mail-archive-xover) |
(xover-dissect . nnwarchive-mail-archive-xover) |
95 |
(article-url |
(article-url |
96 |
"http://www.mail-archive.com/%s/msg%05d.html" group article1) |
"http://www.mail-archive.com/%s/msg%05d.html" group article1) |
97 |
(article-dissect . nnwarchive-mail-archive-article) |
(article-dissect . nnwarchive-mail-archive-article) |
98 |
(xover-files . nnwarchive-mail-archive-xover-files) |
(xover-files . nnwarchive-mail-archive-xover-files) |
163 |
(let ((defs (cdr (assq type nnwarchive-type-definition))) |
(let ((defs (cdr (assq type nnwarchive-type-definition))) |
164 |
def) |
def) |
165 |
(dolist (def defs) |
(dolist (def defs) |
166 |
(set (intern (concat "nnwarchive-" (symbol-name (car def)))) |
(set (intern (concat "nnwarchive-" (symbol-name (car def)))) |
167 |
(cdr def))))) |
(cdr def))))) |
168 |
|
|
169 |
(defmacro nnwarchive-backlog (&rest form) |
(defmacro nnwarchive-backlog (&rest form) |
170 |
`(let ((gnus-keep-backlog nnwarchive-keep-backlog) |
`(let ((gnus-keep-backlog nnwarchive-keep-backlog) |
171 |
(gnus-backlog-buffer |
(gnus-backlog-buffer |
172 |
(format " *nnwarchive backlog %s*" nnwarchive-address)) |
(format " *nnwarchive backlog %s*" nnwarchive-address)) |
173 |
(gnus-backlog-articles nnwarchive-backlog-articles) |
(gnus-backlog-articles nnwarchive-backlog-articles) |
174 |
(gnus-backlog-hashtb nnwarchive-backlog-hashtb)) |
(gnus-backlog-hashtb nnwarchive-backlog-hashtb)) |
183 |
(nnwarchive-backlog |
(nnwarchive-backlog |
184 |
(gnus-backlog-enter-article group number buffer))) |
(gnus-backlog-enter-article group number buffer))) |
185 |
|
|
186 |
(defun nnwarchive-get-article (article &optional group server buffer) |
(defun nnwarchive-get-article (article &optional group server buffer) |
187 |
(if (numberp article) |
(if (numberp article) |
188 |
(if (nnwarchive-backlog |
(if (nnwarchive-backlog |
189 |
(gnus-backlog-request-article group article |
(gnus-backlog-request-article group article |
190 |
(or buffer nntp-server-buffer))) |
(or buffer nntp-server-buffer))) |
191 |
(cons group article) |
(cons group article) |
192 |
(let (contents) |
(let (contents) |
298 |
(setq nnwarchive-passwd |
(setq nnwarchive-passwd |
299 |
(or nnwarchive-passwd |
(or nnwarchive-passwd |
300 |
(mail-source-read-passwd |
(mail-source-read-passwd |
301 |
(format "Password for %s at %s: " |
(format "Password for %s at %s: " |
302 |
nnwarchive-login server))))) |
nnwarchive-login server))))) |
303 |
(unless nnwarchive-groups |
(unless nnwarchive-groups |
304 |
(nnwarchive-read-groups)) |
(nnwarchive-read-groups)) |
322 |
(nnwarchive-open-server server))) |
(nnwarchive-open-server server))) |
323 |
|
|
324 |
(defun nnwarchive-read-groups () |
(defun nnwarchive-read-groups () |
325 |
(let ((file (expand-file-name (concat "groups-" nnwarchive-address) |
(let ((file (expand-file-name (concat "groups-" nnwarchive-address) |
326 |
nnwarchive-directory))) |
nnwarchive-directory))) |
327 |
(when (file-exists-p file) |
(when (file-exists-p file) |
328 |
(with-temp-buffer |
(with-temp-buffer |
331 |
(setq nnwarchive-groups (read (current-buffer))))))) |
(setq nnwarchive-groups (read (current-buffer))))))) |
332 |
|
|
333 |
(defun nnwarchive-write-groups () |
(defun nnwarchive-write-groups () |
334 |
(with-temp-file (expand-file-name (concat "groups-" nnwarchive-address) |
(with-temp-file (expand-file-name (concat "groups-" nnwarchive-address) |
335 |
nnwarchive-directory) |
nnwarchive-directory) |
336 |
(prin1 nnwarchive-groups (current-buffer)))) |
(prin1 nnwarchive-groups (current-buffer)))) |
337 |
|
|
338 |
(defun nnwarchive-init (server) |
(defun nnwarchive-init (server) |
339 |
"Initialize buffers and such." |
"Initialize buffers and such." |
340 |
(let ((type (intern server)) (defs nnwarchive-type-definition) def) |
(let ((type (intern server)) (defs nnwarchive-type-definition) def) |
341 |
(cond |
(cond |
342 |
((equal server "") |
((equal server "") |
343 |
(setq type nnwarchive-default-type)) |
(setq type nnwarchive-default-type)) |
344 |
((assq type nnwarchive-type-definition) t) |
((assq type nnwarchive-type-definition) t) |
390 |
(mm-with-unibyte-current-buffer |
(mm-with-unibyte-current-buffer |
391 |
(let ((url-confirmation-func 'identity) |
(let ((url-confirmation-func 'identity) |
392 |
(url-cookie-multiple-line nil)) |
(url-cookie-multiple-line nil)) |
393 |
(cond |
(cond |
394 |
((eq (car xurl) 'post) |
((eq (car xurl) 'post) |
395 |
(pop xurl) |
(pop xurl) |
396 |
(nnwarchive-fetch-form (car xurl) (nnwarchive-eval (cdr xurl)))) |
(nnwarchive-fetch-form (car xurl) (nnwarchive-eval (cdr xurl)))) |
397 |
(t |
(t |
398 |
(nnweb-insert (apply 'format (nnwarchive-eval xurl)))))))) |
(nnweb-insert (apply 'format (nnwarchive-eval xurl)))))))) |
399 |
|
|
400 |
(defun nnwarchive-generate-active () |
(defun nnwarchive-generate-active () |
401 |
(save-excursion |
(save-excursion |
402 |
(set-buffer nntp-server-buffer) |
(set-buffer nntp-server-buffer) |
420 |
(save-excursion |
(save-excursion |
421 |
(let (articles) |
(let (articles) |
422 |
(set-buffer nnwarchive-buffer) |
(set-buffer nnwarchive-buffer) |
423 |
(dolist (group groups) |
(dolist (group groups) |
424 |
(erase-buffer) |
(erase-buffer) |
425 |
(nnwarchive-url nnwarchive-xover-last-url) |
(nnwarchive-url nnwarchive-xover-last-url) |
426 |
(goto-char (point-min)) |
(goto-char (point-min)) |
427 |
(when (re-search-forward "of \\([0-9]+\\)[ \t\n\r]*</title>" nil t) |
(when (re-search-forward "of \\([0-9]+\\)[ \t\n\r]*</title>" nil t) |
428 |
(setq articles (string-to-number (match-string 1)))) |
(setq articles (string-to-number (match-string 1)))) |
429 |
(let ((elem (assoc group nnwarchive-groups))) |
(let ((elem (assoc group nnwarchive-groups))) |
430 |
(if elem |
(if elem |
431 |
(setcar (cdr elem) articles) |
(setcar (cdr elem) articles) |
441 |
(let ((case-fold-search t) |
(let ((case-fold-search t) |
442 |
group description elem articles) |
group description elem articles) |
443 |
(goto-char (point-min)) |
(goto-char (point-min)) |
444 |
(while |
(while |
445 |
(re-search-forward "href=\"/group/\\([^/\"\> ]+\\)" nil t) |
(re-search-forward "href=\"/group/\\([^/\"\> ]+\\)" nil t) |
446 |
(setq group (match-string 1) |
(setq group (match-string 1) |
447 |
description (match-string 2)) |
description (match-string 2)) |
469 |
(push (cons |
(push (cons |
470 |
article |
article |
471 |
(make-full-mail-header |
(make-full-mail-header |
472 |
article |
article |
473 |
(nnweb-decode-entities-string subject) |
(nnweb-decode-entities-string subject) |
474 |
(nnweb-decode-entities-string from) |
(nnweb-decode-entities-string from) |
475 |
date |
date |
476 |
(concat "<" group "%" |
(concat "<" group "%" |
477 |
(number-to-string article) |
(number-to-string article) |
478 |
"@egroup.com>") |
"@egroup.com>") |
479 |
"" |
"" |
480 |
0 0 "")) nnwarchive-headers)))) |
0 0 "")) nnwarchive-headers)))) |
523 |
(let ((elem (assoc group nnwarchive-headers-cache))) |
(let ((elem (assoc group nnwarchive-headers-cache))) |
524 |
(if elem |
(if elem |
525 |
(setcdr elem nnwarchive-headers) |
(setcdr elem nnwarchive-headers) |
526 |
(push (cons group nnwarchive-headers) |
(push (cons group nnwarchive-headers) |
527 |
nnwarchive-headers-cache))))))) |
nnwarchive-headers-cache))))))) |
528 |
|
|
529 |
(defun nnwarchive-mail-archive-list () |
(defun nnwarchive-mail-archive-list () |
558 |
(push (cons |
(push (cons |
559 |
article |
article |
560 |
(make-full-mail-header |
(make-full-mail-header |
561 |
article |
article |
562 |
(nnweb-decode-entities-string subject) |
(nnweb-decode-entities-string subject) |
563 |
(nnweb-decode-entities-string from) |
(nnweb-decode-entities-string from) |
564 |
date |
date |
608 |
(insert from-r13) |
(insert from-r13) |
609 |
(let ((message-caesar-translation-table |
(let ((message-caesar-translation-table |
610 |
(or nnwarchive-caesar-translation-table |
(or nnwarchive-caesar-translation-table |
611 |
(setq nnwarchive-caesar-translation-table |
(setq nnwarchive-caesar-translation-table |
612 |
(nnwarchive-make-caesar-translation-table))))) |
(nnwarchive-make-caesar-translation-table))))) |
613 |
(message-caesar-region (point-min) (point-max)) |
(message-caesar-region (point-min) (point-max)) |
614 |
(buffer-string))))) |
(buffer-string))))) |
615 |
|
|
616 |
(defun nnwarchive-mail-archive-article (group article) |
(defun nnwarchive-mail-archive-article (group article) |
617 |
(let (p refs url mime e |
(let (p refs url mime e |
618 |
from subject date id |
from subject date id |
619 |
done |
done |
620 |
(case-fold-search t)) |
(case-fold-search t)) |
621 |
(save-restriction |
(save-restriction |
630 |
(goto-char (point-min)) |
(goto-char (point-min)) |
631 |
(while (search-forward " -->" nil t) |
(while (search-forward " -->" nil t) |
632 |
(replace-match "")) |
(replace-match "")) |
633 |
(setq from |
(setq from |
634 |
(or (mail-fetch-field "from") |
(or (mail-fetch-field "from") |
635 |
(nnwarchive-from-r13 |
(nnwarchive-from-r13 |
636 |
(mail-fetch-field "from-r13")))) |
(mail-fetch-field "from-r13")))) |
637 |
(setq date (mail-fetch-field "date")) |
(setq date (mail-fetch-field "date")) |
638 |
(setq id (mail-fetch-field "message-id")) |
(setq id (mail-fetch-field "message-id")) |
667 |
(goto-char (point-max)) |
(goto-char (point-max)) |
668 |
(widen) |
(widen) |
669 |
(insert "\n")) |
(insert "\n")) |
670 |
(setq p (point)) |
(setq p (point)) |
671 |
(when (search-forward "X-Body-of-Message" nil t) |
(when (search-forward "X-Body-of-Message" nil t) |
672 |
(forward-line) |
(forward-line) |
673 |
(delete-region p (point)) |
(delete-region p (point)) |
679 |
(if (> (skip-chars-forward "\040\n\r\t") 0) |
(if (> (skip-chars-forward "\040\n\r\t") 0) |
680 |
(delete-region (point-min) (point))) |
(delete-region (point-min) (point))) |
681 |
(while (not (eobp)) |
(while (not (eobp)) |
682 |
(cond |
(cond |
683 |
((looking-at "<PRE>\r?\n?") |
((looking-at "<PRE>\r?\n?") |
684 |
(delete-region (match-beginning 0) (match-end 0)) |
(delete-region (match-beginning 0) (match-end 0)) |
685 |
(setq p (point)) |
(setq p (point)) |
686 |
(when (search-forward "</PRE>" nil t) |
(when (search-forward "</PRE>" nil t) |
692 |
(goto-char (point-max))))) |
(goto-char (point-max))))) |
693 |
((looking-at "<P><A HREF=\"\\([^\"]+\\)") |
((looking-at "<P><A HREF=\"\\([^\"]+\\)") |
694 |
(setq url (match-string 1)) |
(setq url (match-string 1)) |
695 |
(delete-region (match-beginning 0) |
(delete-region (match-beginning 0) |
696 |
(progn (forward-line) (point))) |
(progn (forward-line) (point))) |
697 |
;; I hate to download the url encode it, then immediately |
;; I hate to download the url encode it, then immediately |
698 |
;; decode it. |
;; decode it. |
699 |
;; FixMe: Find a better solution to attach the URL. |
;; FixMe: Find a better solution to attach the URL. |
700 |
;; Maybe do some hack in external part of mml-generate-mim-1. |
;; Maybe do some hack in external part of mml-generate-mim-1. |
701 |
(insert "<#part>" |
(insert "<#part>" |
702 |
"\n--\nExternal: \n" |
"\n--\nExternal: \n" |
703 |
(format "<URL:http://www.mail-archive.com/%s/%s>" |
(format "<URL:http://www.mail-archive.com/%s/%s>" |
704 |
group url) |
group url) |
705 |
"\n--\n" |
"\n--\n" |
706 |
"<#/part>") |
"<#/part>") |
709 |
(setq p (point)) |
(setq p (point)) |
710 |
(insert "<#part type=\"text/html\" disposition=inline>") |
(insert "<#part type=\"text/html\" disposition=inline>") |
711 |
(goto-char |
(goto-char |
712 |
(if (re-search-forward |
(if (re-search-forward |
713 |
"[\040\n\r\t]*<PRE>\\|[\040\n\r\t]*<P><A HREF=\"" |
"[\040\n\r\t]*<PRE>\\|[\040\n\r\t]*<P><A HREF=\"" |
714 |
nil t) |
nil t) |
715 |
(match-beginning 0) |
(match-beginning 0) |
716 |
(point-max))) |
(point-max))) |
736 |
(insert " " (pop refs))) |
(insert " " (pop refs))) |
737 |
(insert "\n")) |
(insert "\n")) |
738 |
(when mime |
(when mime |
739 |
(unless (looking-at "$") |
(unless (looking-at "$") |
740 |
(search-forward "\n\n" nil t) |
(search-forward "\n\n" nil t) |
741 |
(forward-line -1)) |
(forward-line -1)) |
742 |
(narrow-to-region (point) (point-max)) |
(narrow-to-region (point) (point-max)) |