1 |
;;; nnwarchive.el --- interfacing with web archives |
;;; nnwarchive.el --- interfacing with web archives |
2 |
;; Copyright (C) 1999, 2000 Free Software Foundation, Inc. |
;; Copyright (C) 1999, 2000, 2003 Free Software Foundation, Inc. |
3 |
|
|
4 |
;; Author: Shenghuo Zhu <zsh@cs.rochester.edu> |
;; Author: Shenghuo Zhu <zsh@cs.rochester.edu> |
5 |
;; Keywords: news egroups mail-archive |
;; Keywords: news egroups mail-archive |
24 |
;;; Commentary: |
;;; Commentary: |
25 |
|
|
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 some functions of this backend to work. |
28 |
|
|
29 |
;; Todo: |
;; Todo: |
30 |
;; 1. To support more web archives. |
;; 1. To support more web archives. |
41 |
(require 'gnus-bcklg) |
(require 'gnus-bcklg) |
42 |
(require 'nnmail) |
(require 'nnmail) |
43 |
(require 'mm-util) |
(require 'mm-util) |
44 |
(require 'mail-source) |
(require 'mm-url) |
|
(eval-when-compile |
|
|
(ignore-errors |
|
|
(require 'w3) |
|
|
(require 'url) |
|
|
(require 'w3-forms) |
|
|
(require 'nnweb))) |
|
|
;; Report failure to find w3 at load time if appropriate. |
|
|
(eval '(progn |
|
|
(require 'w3) |
|
|
(require 'url) |
|
|
(require 'w3-forms) |
|
|
(require 'nnweb))) |
|
45 |
|
|
46 |
(nnoo-declare nnwarchive) |
(nnoo-declare nnwarchive) |
47 |
|
|
285 |
user-mail-address))) |
user-mail-address))) |
286 |
(setq nnwarchive-passwd |
(setq nnwarchive-passwd |
287 |
(or nnwarchive-passwd |
(or nnwarchive-passwd |
288 |
(mail-source-read-passwd |
(read-passwd |
289 |
(format "Password for %s at %s: " |
(format "Password for %s at %s: " |
290 |
nnwarchive-login server))))) |
nnwarchive-login server))))) |
291 |
(unless nnwarchive-groups |
(unless nnwarchive-groups |
348 |
(format " *nnwarchive %s %s*" nnwarchive-type server))))) |
(format " *nnwarchive %s %s*" nnwarchive-type server))))) |
349 |
(nnwarchive-set-default nnwarchive-type)) |
(nnwarchive-set-default nnwarchive-type)) |
350 |
|
|
|
(defun nnwarchive-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 nnwarchive-fetch-form (url pairs) |
|
|
(let ((url-request-data (nnwarchive-encode-www-form-urlencoded pairs)) |
|
|
(url-request-method "POST") |
|
|
(url-request-extra-headers |
|
|
'(("Content-type" . "application/x-www-form-urlencoded")))) |
|
|
(nnweb-insert url)) |
|
|
t) |
|
|
|
|
351 |
(defun nnwarchive-eval (expr) |
(defun nnwarchive-eval (expr) |
352 |
(cond |
(cond |
353 |
((consp expr) |
((consp expr) |
359 |
|
|
360 |
(defun nnwarchive-url (xurl) |
(defun nnwarchive-url (xurl) |
361 |
(mm-with-unibyte-current-buffer |
(mm-with-unibyte-current-buffer |
362 |
(let ((url-confirmation-func 'identity) |
(let ((url-confirmation-func 'identity) ;; Some hacks. |
363 |
(url-cookie-multiple-line nil)) |
(url-cookie-multiple-line nil)) |
364 |
(cond |
(cond |
365 |
((eq (car xurl) 'post) |
((eq (car xurl) 'post) |
366 |
(pop xurl) |
(pop xurl) |
367 |
(nnwarchive-fetch-form (car xurl) (nnwarchive-eval (cdr xurl)))) |
(mm-url-fetch-form (car xurl) (nnwarchive-eval (cdr xurl)))) |
368 |
(t |
(t |
369 |
(nnweb-insert (apply 'format (nnwarchive-eval xurl)))))))) |
(mm-url-insert (apply 'format (nnwarchive-eval xurl)))))))) |
370 |
|
|
371 |
(defun nnwarchive-generate-active () |
(defun nnwarchive-generate-active () |
372 |
(save-excursion |
(save-excursion |
441 |
article |
article |
442 |
(make-full-mail-header |
(make-full-mail-header |
443 |
article |
article |
444 |
(nnweb-decode-entities-string subject) |
(mm-url-decode-entities-string subject) |
445 |
(nnweb-decode-entities-string from) |
(mm-url-decode-entities-string from) |
446 |
date |
date |
447 |
(concat "<" group "%" |
(concat "<" group "%" |
448 |
(number-to-string article) |
(number-to-string article) |
461 |
(goto-char (point-min)) |
(goto-char (point-min)) |
462 |
(while (re-search-forward "<a[^>]+>\\([^<]+\\)</a>" nil t) |
(while (re-search-forward "<a[^>]+>\\([^<]+\\)</a>" nil t) |
463 |
(replace-match "\\1")) |
(replace-match "\\1")) |
464 |
(nnweb-decode-entities) |
(mm-url-decode-entities) |
465 |
(buffer-string)) |
(buffer-string)) |
466 |
|
|
467 |
(defun nnwarchive-egroups-xover-files (group articles) |
(defun nnwarchive-egroups-xover-files (group articles) |
521 |
subject (match-string 2)) |
subject (match-string 2)) |
522 |
(forward-line 1) |
(forward-line 1) |
523 |
(unless (assq article nnwarchive-headers) |
(unless (assq article nnwarchive-headers) |
524 |
(if (looking-at "<UL><LI><EM>From</EM>:\\([^&]+\\)<\\([^&]+\\)>") |
(if (looking-at "<UL><LI><EM>From</EM>: *\\([^<]*[^< ]\\) *<\\([^&]+\\)>") |
525 |
(progn |
(progn |
526 |
(setq from (match-string 1) |
(setq from (match-string 1) |
527 |
date (identity (match-string 2)))) |
date (identity (match-string 2)))) |
530 |
article |
article |
531 |
(make-full-mail-header |
(make-full-mail-header |
532 |
article |
article |
533 |
(nnweb-decode-entities-string subject) |
(mm-url-decode-entities-string subject) |
534 |
(nnweb-decode-entities-string from) |
(mm-url-decode-entities-string from) |
535 |
date |
date |
536 |
(format "<%05d%%%s>\n" (1- article) group) |
(format "<%05d%%%s>\n" (1- article) group) |
537 |
"" |
"" |
594 |
(when (search-forward "X-Head-End" nil t) |
(when (search-forward "X-Head-End" nil t) |
595 |
(beginning-of-line) |
(beginning-of-line) |
596 |
(narrow-to-region (point-min) (point)) |
(narrow-to-region (point-min) (point)) |
597 |
(nnweb-decode-entities) |
(mm-url-decode-entities) |
598 |
(goto-char (point-min)) |
(goto-char (point-min)) |
599 |
(while (search-forward "<!--X-" nil t) |
(while (search-forward "<!--X-" nil t) |
600 |
(replace-match "")) |
(replace-match "")) |
616 |
(search-forward "</ul>" nil t) |
(search-forward "</ul>" nil t) |
617 |
(end-of-line) |
(end-of-line) |
618 |
(narrow-to-region (point-min) (point)) |
(narrow-to-region (point-min) (point)) |
619 |
(nnweb-remove-markup) |
(mm-url-remove-markup) |
620 |
(nnweb-decode-entities) |
(mm-url-decode-entities) |
621 |
(goto-char (point-min)) |
(goto-char (point-min)) |
622 |
(delete-blank-lines) |
(delete-blank-lines) |
623 |
(when from |
(when from |
658 |
(delete-region (match-beginning 0) (match-end 0)) |
(delete-region (match-beginning 0) (match-end 0)) |
659 |
(save-restriction |
(save-restriction |
660 |
(narrow-to-region p (point)) |
(narrow-to-region p (point)) |
661 |
(nnweb-remove-markup) |
(mm-url-remove-markup) |
662 |
(nnweb-decode-entities) |
(mm-url-decode-entities) |
663 |
(goto-char (point-max))))) |
(goto-char (point-max))))) |
664 |
((looking-at "<P><A HREF=\"\\([^\"]+\\)") |
((looking-at "<P><A HREF=\"\\([^\"]+\\)") |
665 |
(setq url (match-string 1)) |
(setq url (match-string 1)) |
667 |
(progn (forward-line) (point))) |
(progn (forward-line) (point))) |
668 |
;; I hate to download the url encode it, then immediately |
;; I hate to download the url encode it, then immediately |
669 |
;; decode it. |
;; decode it. |
670 |
;; FixMe: Find a better solution to attach the URL. |
(insert "<#external" |
671 |
;; Maybe do some hack in external part of mml-generate-mim-1. |
" type=" |
672 |
(insert "<#part>" |
(or (and url |
673 |
"\n--\nExternal: \n" |
(string-match "\\.[^\\.]+$" url) |
674 |
(format "<URL:http://www.mail-archive.com/%s/%s>" |
(mailcap-extension-to-mime |
675 |
|
(match-string 0 url))) |
676 |
|
"application/octet-stream") |
677 |
|
(format " url=\"http://www.mail-archive.com/%s/%s\"" |
678 |
group url) |
group url) |
679 |
"\n--\n" |
">\n" |
680 |
"<#/part>") |
"<#/external>") |
681 |
(setq mime t)) |
(setq mime t)) |
682 |
(t |
(t |
683 |
(setq p (point)) |
(setq p (point)) |