From 3870882c0f1444b1a96ded2de83186f874029ad9 Mon Sep 17 00:00:00 2001 From: yamaoka Date: Mon, 3 Dec 2001 22:32:41 +0000 Subject: [PATCH] Synch with Oort Gnus. --- lisp/ChangeLog | 13 ++ lisp/Makefile.in | 10 +- lisp/mm-extern.el | 4 +- lisp/mm-url.el | 329 ++++++++++++++++++++++++++++++++++++++++++++++++++ lisp/nnslashdot.el | 27 ++--- lisp/pop3.el | 13 +- texi/ChangeLog | 12 ++ texi/Makefile.in | 6 +- texi/emacs-mime.texi | 2 +- texi/infohack.el | 1 + 10 files changed, 386 insertions(+), 31 deletions(-) create mode 100644 lisp/mm-url.el diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 0fb6d70..5178600 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,16 @@ +2001-12-03 11:00:00 ShengHuo ZHU + + * pop3.el (pop3-munge-message-separator): Only use valid date. + From Michael Welsh Duggan . + + * Makefile.in: gnus-load.elc may not be generated. + +2001-12-03 09:00:00 ShengHuo ZHU + + * mm-url.el: New. + * nnslashdot.el: Use it. + * mm-extern.el (mm-extern-url): Use it. + 2001-12-01 15:00:00 ShengHuo ZHU * gnus-sum.el (gnus-summary-save-article): Nix diff --git a/lisp/Makefile.in b/lisp/Makefile.in index 0934d58..e6112f8 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -22,18 +22,18 @@ EXPORTING_FILES = $(EMACS_COMP) -f dgnushack-exporting-files 2>/dev/null # form instead. Because, as far as we know, FreeBSD's native make will # be discontinued if COMMAND returns a non-zero exit status. -all total: clean-some gnus-load.elc +all total: clean-some gnus-load.el $(EMACS_COMP) -f dgnushack-compile clean-some: rm -f *.elc gnus-load.el -warn: clean-some gnus-load.elc +warn: clean-some gnus-load.el $(EMACS_COMP) --eval '(dgnushack-compile t)' 2>&1 | egrep -v "variable G|inhibit-point-motion-hooks|coding-system|temp-results|variable gnus|variable nn|scroll-in-place|deactivate-mark|filladapt-mode|byte-code-function-p|print-quoted|ps-right-header|ps-left-header|article-inhibit|print-escape|ssl-program-arguments|message-log-max" # The "clever" rule is unsafe, since redefined macros are loaded from # .elc files, and not the .el file. -clever some: gnus-load.elc +clever some: gnus-load.el @if test -f $(srcdir)/gnus.elc; then \ echo \ "checking whether the all elc files should be recompiled..."; \ @@ -73,7 +73,7 @@ install-package-manifest: $(EMACS_COMP) -f dgnushack-install-package-manifest \ $(PACKAGEDIR) $(GNUS_PRODUCT_NAME) -compose-package: gnus-load.elc +compose-package: gnus-load.el $(EMACS_COMP) -f dgnushack-compose-package remove-extra-files-in-package: @@ -98,7 +98,7 @@ separately: pot: xpot -drgnus -r`cat ./version` *.el > rgnus.pot -gnus-load.el gnus-load.elc: +gnus-load.el: $(EMACS_COMP) -f dgnushack-make-cus-load $(srcdir) $(EMACS_COMP) -f dgnushack-make-auto-load $(srcdir) $(EMACS_COMP) -f dgnushack-make-load diff --git a/lisp/mm-extern.el b/lisp/mm-extern.el index 5ccd2e1..fef89ca 100644 --- a/lisp/mm-extern.el +++ b/lisp/mm-extern.el @@ -29,6 +29,7 @@ (require 'mm-util) (require 'mm-decode) +(require 'mm-url) (defvar mm-extern-function-alist '((local-file . mm-extern-local-file) @@ -55,14 +56,13 @@ (defun mm-extern-url (handle) (erase-buffer) - (require 'url) (let ((url (cdr (assq 'url (cdr (mm-handle-type handle))))) (name buffer-file-name) (coding-system-for-read mm-binary-coding-system)) (unless url (error "URL is not specified")) (mm-with-unibyte-current-buffer-mule4 - (url-insert-file-contents url)) + (mm-url-insert-file-contents url)) (mm-disable-multibyte-mule4) (setq buffer-file-name name))) diff --git a/lisp/mm-url.el b/lisp/mm-url.el new file mode 100644 index 0000000..39bf776 --- /dev/null +++ b/lisp/mm-url.el @@ -0,0 +1,329 @@ +;;; mm-url.el --- a wrapper of url functions/commands for Gnus +;; Copyright (C) 2001 Free Software Foundation, Inc. + +;; Author: Shenghuo Zhu + +;; 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 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. + +;;; Commentary: + +;; Some codes are stolen from w3 and url packages. Some are moved from +;; nnweb. + +;; TODO: Support POST, cookie. + +;;; Code: + +(require 'mm-util) + +(eval-when-compile (require 'cl)) + +(eval-and-compile + (autoload 'url-insert-file-contents "url-handlers")) + +(defgroup mm-url nil + "A wrapper of url package and external url command for Gnus." + :group 'gnus) + +(defcustom mm-url-use-external (not + (condition-case nil + (require 'url-handlers) + (error nil))) + "*If not-nil, use external grab program `mm-url-program'." + :type 'boolean + :group 'mm-url) + +(defvar mm-url-predefined-programs + '((wget "wget" "-q" "-O" "-") + (lynx "lynx" "-source") + (curl "curl"))) + +(defcustom mm-url-program + (cond + ((executable-find "wget") 'wget) + ((executable-find "lynx") 'lynx) + ((executable-find "curl") 'curl) + (t "GET")) + "The url grab program." + :type '(choice + (symbol :tag "wget" wget) + (symbol :tag "lynx" lynx) + (symbol :tag "curl" curl) + (string :tag "other")) + :group 'mm-url) + +(defcustom mm-url-arguments nil + "The arguments for `mm-url-program'." + :type '(repeat string) + :group 'mm-url) + +;; Stolen from w3. +(defvar mm-url-html-entities + '( + ;;(excl . 33) + (quot . 34) + ;;(num . 35) + ;;(dollar . 36) + ;;(percent . 37) + (amp . 38) + (rsquo . 39) ; should be U+8217 + ;;(apos . 39) + ;;(lpar . 40) + ;;(rpar . 41) + ;;(ast . 42) + ;;(plus . 43) + ;;(comma . 44) + ;;(period . 46) + ;;(colon . 58) + ;;(semi . 59) + (lt . 60) + ;;(equals . 61) + (gt . 62) + ;;(quest . 63) + ;;(commat . 64) + ;;(lsqb . 91) + ;;(rsqb . 93) + (uarr . 94) ; should be U+8593 + ;;(lowbar . 95) + (lsquo . 96) ; should be U+8216 + (lcub . 123) + ;;(verbar . 124) + (rcub . 125) + (tilde . 126) + (nbsp . 160) + (iexcl . 161) + (cent . 162) + (pound . 163) + (curren . 164) + (yen . 165) + (brvbar . 166) + (sect . 167) + (uml . 168) + (copy . 169) + (ordf . 170) + (laquo . 171) + (not . 172) + (shy . 173) + (reg . 174) + (macr . 175) + (deg . 176) + (plusmn . 177) + (sup2 . 178) + (sup3 . 179) + (acute . 180) + (micro . 181) + (para . 182) + (middot . 183) + (cedil . 184) + (sup1 . 185) + (ordm . 186) + (raquo . 187) + (frac14 . 188) + (frac12 . 189) + (frac34 . 190) + (iquest . 191) + (Agrave . 192) + (Aacute . 193) + (Acirc . 194) + (Atilde . 195) + (Auml . 196) + (Aring . 197) + (AElig . 198) + (Ccedil . 199) + (Egrave . 200) + (Eacute . 201) + (Ecirc . 202) + (Euml . 203) + (Igrave . 204) + (Iacute . 205) + (Icirc . 206) + (Iuml . 207) + (ETH . 208) + (Ntilde . 209) + (Ograve . 210) + (Oacute . 211) + (Ocirc . 212) + (Otilde . 213) + (Ouml . 214) + (times . 215) + (Oslash . 216) + (Ugrave . 217) + (Uacute . 218) + (Ucirc . 219) + (Uuml . 220) + (Yacute . 221) + (THORN . 222) + (szlig . 223) + (agrave . 224) + (aacute . 225) + (acirc . 226) + (atilde . 227) + (auml . 228) + (aring . 229) + (aelig . 230) + (ccedil . 231) + (egrave . 232) + (eacute . 233) + (ecirc . 234) + (euml . 235) + (igrave . 236) + (iacute . 237) + (icirc . 238) + (iuml . 239) + (eth . 240) + (ntilde . 241) + (ograve . 242) + (oacute . 243) + (ocirc . 244) + (otilde . 245) + (ouml . 246) + (divide . 247) + (oslash . 248) + (ugrave . 249) + (uacute . 250) + (ucirc . 251) + (uuml . 252) + (yacute . 253) + (thorn . 254) + (yuml . 255) + + ;; Special handling of these + (frac56 . "5/6") + (frac16 . "1/6") + (frac45 . "4/5") + (frac35 . "3/5") + (frac25 . "2/5") + (frac15 . "1/5") + (frac23 . "2/3") + (frac13 . "1/3") + (frac78 . "7/8") + (frac58 . "5/8") + (frac38 . "3/8") + (frac18 . "1/8") + + ;; The following 5 entities are not mentioned in the HTML 2.0 + ;; standard, nor in any other HTML proposed standard of which I + ;; am aware. I am not even sure they are ISO entity names. *** + ;; Hence, some arrangement should be made to give a bad HTML + ;; message when they are seen. + (ndash . 45) + (mdash . 45) + (emsp . 32) + (ensp . 32) + (sim . 126) + (le . "<=") + (agr . "alpha") + (rdquo . "''") + (ldquo . "``") + (trade . "(TM)") + ;; To be done + ;; (shy . ????) ; soft hyphen + ) + "*An assoc list of entity names and how to actually display them.") + +(defconst mm-url-unreserved-chars + '( + ?a ?b ?c ?d ?e ?f ?g ?h ?i ?j ?k ?l ?m ?n ?o ?p ?q ?r ?s ?t ?u ?v ?w ?x ?y ?z + ?A ?B ?C ?D ?E ?F ?G ?H ?I ?J ?K ?L ?M ?N ?O ?P ?Q ?R ?S ?T ?U ?V ?W ?X ?Y ?Z + ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9 + ?- ?_ ?. ?! ?~ ?* ?' ?\( ?\)) + "A list of characters that are _NOT_ reserved in the URL spec. +This is taken from RFC 2396.") + +(defun mm-url-insert-file-contents (url) + (if mm-url-use-external + (mm-url-insert-file-contents-external url) + (url-insert-file-contents url))) + +(defun mm-url-insert-file-contents-external (url) + (let (program args) + (if (symbolp mm-url-program) + (let ((item (cdr (assq mm-url-program mm-url-predefined-programs)))) + (setq program (car item) + args (append (cdr item) (list url)))) + (setq program mm-url-program + args (append mm-url-arguments (list url)))) + (apply 'call-process program nil t nil args))) + +(defun mm-url-insert (url &optional follow-refresh) + "Insert the contents from an URL in the current buffer. +If FOLLOW-REFRESH is non-nil, redirect refresh url in META." + (let ((name buffer-file-name)) + (if follow-refresh + (save-restriction + (narrow-to-region (point) (point)) + (mm-url-insert-file-contents url) + (goto-char (point-min)) + (when (re-search-forward + "]*URL=\\([^\"]+\\)\"" nil t) + (let ((url (match-string 1))) + (delete-region (point-min) (point-max)) + (mm-url-insert url t)))) + (mm-url-insert-file-contents url)) + (setq buffer-file-name name))) + +(defun mm-url-decode-entities () + "Decode all HTML entities." + (goto-char (point-min)) + (while (re-search-forward "&\\(#[0-9]+\\|[a-z]+\\);" nil t) + (let ((elem (if (eq (aref (match-string 1) 0) ?\#) + (let ((c + (string-to-number (substring + (match-string 1) 1)))) + (if (mm-char-or-char-int-p c) c 32)) + (or (cdr (assq (intern (match-string 1)) + mm-url-html-entities)) + ?#)))) + (unless (stringp elem) + (setq elem (char-to-string elem))) + (replace-match elem t t)))) + +(defun mm-url-decode-entities-string (string) + (with-temp-buffer + (insert string) + (mm-url-decode-entities) + (buffer-substring (point-min) (point-max)))) + +(defun mm-url-form-encode-xwfu (chunk) + "Escape characters in a string for application/x-www-form-urlencoded. +Blasphemous crap because someone didn't think %20 was good enough for encoding +spaces. Die Die Die." + ;; This will get rid of the 'attributes' specified by the file type, + ;; which are useless for an application/x-www-form-urlencoded form. + (if (consp chunk) + (setq chunk (cdr chunk))) + + (mapconcat + (lambda (char) + (cond + ((= char ? ) "+") + ((memq char mm-url-unreserved-chars) (char-to-string char)) + (t (upcase (format "%%%02x" char))))) + ;; Fixme: Should this actually be accepting multibyte? Is there a + ;; better way in XEmacs? + (if (featurep 'mule) + (encode-coding-string chunk + (if (fboundp 'find-coding-systems-string) + (car (find-coding-systems-string chunk)) + buffer-file-coding-system)) + chunk) + "")) + +(provide 'mm-url) + +;;; mm-url.el ends here diff --git a/lisp/nnslashdot.el b/lisp/nnslashdot.el index b411919..c04a6db 100644 --- a/lisp/nnslashdot.el +++ b/lisp/nnslashdot.el @@ -37,11 +37,7 @@ (require 'gnus) (require 'nnmail) (require 'mm-util) -(eval-when-compile - (ignore-errors - (require 'nnweb))) -;; Report failure to find w3 at load time if appropriate. -(eval '(require 'nnweb)) +(require 'mm-url) (nnoo-declare nnslashdot) @@ -106,12 +102,12 @@ (let ((case-fold-search t)) (erase-buffer) (when (= start 1) - (nnweb-insert (format nnslashdot-article-url + (mm-url-insert (format nnslashdot-article-url (nnslashdot-sid-strip sid)) t) (goto-char (point-min)) (re-search-forward "Posted by[ \t\r\n]+") (when (looking-at "\\(]+>\\)?[ \t\r\n]*\\([^<\r\n]+\\)") - (setq from (nnweb-decode-entities-string (match-string 2)))) + (setq from (mm-url-decode-entities-string (match-string 2)))) (search-forward "on ") (setq date (nnslashdot-date-to-date (buffer-substring (point) (1- (search-forward "<"))))) @@ -129,7 +125,7 @@ (setq start (if nnslashdot-threaded 2 (pop articles)))) (while (and start (<= start last)) (setq point (goto-char (point-max))) - (nnweb-insert + (mm-url-insert (format nnslashdot-comments-url (nnslashdot-sid-strip sid) nnslashdot-threshold 0 (- start 2)) @@ -155,19 +151,19 @@ (setq changed t)) (when (string-match "^Re: *" subject) (setq subject (concat "Re: " (substring subject (match-end 0))))) - (setq subject (nnweb-decode-entities-string subject)) + (setq subject (mm-url-decode-entities-string subject)) (search-forward "
") (if (looking-at "by[ \t\n]+]+>\\([^<]+\\)[ \t\n]*(\\(<[^>]+>\\)*\\([^<>)]+\\))") (progn (goto-char (- (match-end 0) 5)) (setq from (concat - (nnweb-decode-entities-string (match-string 1)) + (mm-url-decode-entities-string (match-string 1)) " <" (match-string 3) ">"))) (setq from "") (when (looking-at "by \\([^<>]*\\) on ") (goto-char (- (match-end 0) 5)) - (setq from (nnweb-decode-entities-string (match-string 1))))) + (setq from (mm-url-decode-entities-string (match-string 1))))) (search-forward " on ") (setq date (nnslashdot-date-to-date @@ -306,14 +302,14 @@ ;; First we do the Ultramode to get info on all the latest groups. (progn (mm-with-unibyte-buffer - (nnweb-insert nnslashdot-backslash-url t) + (mm-url-insert nnslashdot-backslash-url t) (goto-char (point-min)) (while (search-forward "" nil t) (narrow-to-region (point) (search-forward "")) (goto-char (point-min)) (re-search-forward "\\([^<]+\\)") (setq description - (nnweb-decode-entities-string (match-string 1))) + (mm-url-decode-entities-string (match-string 1))) (re-search-forward "\\([^<]+\\)") (setq sid (match-string 1)) (string-match "sid=\\([0-9/]+\\)\\(.shtml\\|$\\)" sid) @@ -331,14 +327,14 @@ (while (> (- nnslashdot-group-number number) 0) (mm-with-unibyte-buffer (let ((case-fold-search t)) - (nnweb-insert (format nnslashdot-active-url number) t) + (mm-url-insert (format nnslashdot-active-url number) t) (goto-char (point-min)) (while (re-search-forward "article.pl\\?sid=\\([^&]+\\).*\\([^<]+\\)" nil t) (setq sid (match-string 1) description - (nnweb-decode-entities-string (match-string 2))) + (mm-url-decode-entities-string (match-string 2))) (forward-line 1) (when (re-search-forward "\\([0-9]+\\)" nil t) (setq articles (string-to-number (match-string 1)))) @@ -359,6 +355,7 @@ t) (deffoo nnslashdot-request-post (&optional server) + (require 'nnweb) (nnslashdot-possibly-change-server nil server) (let ((sid (nnslashdot-sid-strip (message-fetch-field "newsgroups"))) (subject (message-fetch-field "subject")) diff --git a/lisp/pop3.el b/lisp/pop3.el index 86f045b..2c2136b 100644 --- a/lisp/pop3.el +++ b/lisp/pop3.el @@ -359,11 +359,14 @@ If NOW, use that time instead." (looking-at "\001\001\001\001\n") ; MMDF (looking-at "BABYL OPTIONS:") ; Babyl )) - (let ((from (mail-strip-quoted-names (mail-fetch-field "From"))) - (date (split-string (or (mail-fetch-field "Date") - (pop3-make-date)) - " ")) - (From_)) + (let* ((from (mail-strip-quoted-names (mail-fetch-field "From"))) + (tdate (mail-fetch-field "Date")) + (date (split-string (or (and tdate + (not (string= "" tdate)) + tdate) + (pop3-make-date)) + " ")) + (From_)) ;; sample date formats I have seen ;; Date: Tue, 9 Jul 1996 09:04:21 -0400 (EDT) ;; Date: 08 Jul 1996 23:22:24 -0400 diff --git a/texi/ChangeLog b/texi/ChangeLog index 353e3f7..350a696 100644 --- a/texi/ChangeLog +++ b/texi/ChangeLog @@ -1,3 +1,15 @@ +2001-12-03 10:00:00 ShengHuo ZHU + + * infohack.el (infohack): To process write-protected files safely, + make this buffer be writable after `find-file'. + From TSUCHIYA Masatoshi + +2001-12-03 08:00:00 ShengHuo ZHU + + * Makefile.in: Dependence. + + * emacs-mime.texi: Add coding header. + 2001-12-01 Simon Josefsson * gnus.texi (Group Line Specification, Summary Buffer Lines): diff --git a/texi/Makefile.in b/texi/Makefile.in index 3ced4b0..76428ac 100644 --- a/texi/Makefile.in +++ b/texi/Makefile.in @@ -111,7 +111,7 @@ makeinfo: texi2latex.elc: texi2latex.el srcdir=$(srcdir)/../lisp $(EMACSCOMP) -l $(srcdir)/../lisp/dgnushack.el --eval '(byte-compile-file "$(srcdir)/texi2latex.el")' -latex: gnus.latexi gnus-faq.latexi +latex: gnus.latexi gnus-faq.latexi message.latexi emacs-mime.latexi sieve.latexi gnus.latexi gnus-faq.latexi message.latexi emacs-mime.latexi sieve.latexi: $(srcdir)/gnus.texi $(srcdir)/gnus-faq.texi $(srcdir)/message.texi $(srcdir)/emacs-mime.texi $(srcdir)/sieve.texi texi2latex.elc srcdir=$(srcdir) $(EMACSCOMP) -l ./texi2latex.elc -f latexi-translate @@ -153,10 +153,10 @@ gnus.latexi gnus-faq.latexi message.latexi emacs-mime.latexi sieve.latexi: $(src TEXINPUTS=$(srcdir):$$TEXINPUTS $(PDFLATEX) gnus.tmplatexi mv gnus.pdf $@ -latexps: gnus.dvi-x +latexps: latex gnus.dvi-x TEXPICTS=$(srcdir) $(DVIPS) -t a4 -f $< > gnus.ps -latexpdf: gnus.pdf-x +latexpdf: latex gnus.pdf-x mv gnus.pdf-x gnus.pdf gnus-manual-a4.latexi: gnus.latexi diff --git a/texi/emacs-mime.texi b/texi/emacs-mime.texi index 4bebfa9..ee8af04 100644 --- a/texi/emacs-mime.texi +++ b/texi/emacs-mime.texi @@ -1,4 +1,4 @@ -\input texinfo @c -*-texinfo-*- +\input texinfo @c -*-texinfo-*- -*- coding: iso-latin-1 -*- @setfilename emacs-mime @settitle Emacs MIME Manual diff --git a/texi/infohack.el b/texi/infohack.el index cd9774e..17b1f68 100644 --- a/texi/infohack.el +++ b/texi/infohack.el @@ -41,6 +41,7 @@ (max-lisp-eval-depth (max max-lisp-eval-depth 600)) coding-system) (find-file file) + (setq buffer-read-only nil) (setq coding-system (if (boundp 'buffer-file-coding-system) buffer-file-coding-system file-coding-system)) -- 1.7.10.4