From 96bd7b54fd0e8edb210e2012943e123fa58672e0 Mon Sep 17 00:00:00 2001 From: yamaoka Date: Wed, 23 Jan 2002 00:57:46 +0000 Subject: [PATCH] Synch with Oort Gnus. * gnus-sum.el (gnus-article-commands-menu): Bind "Html" to the command `gnus-article-wash-html'. (gnus-summary-article-menu): Ditto. (gnus-summary-wash-map): Bind "h" to the command `gnus-article-wash-html'. * gnus-art.el (gnus-article-treatment-menu): Bind "Treat html" to the command `gnus-article-wash-html'. * nnheader.el: Place mm- stuff and mail-parse stuff in front of the codes which use (or may use) them. --- ChangeLog | 14 ++ lisp/ChangeLog | 40 +++++ lisp/canlock.el | 14 +- lisp/dgnushack.el | 3 +- lisp/gnus-art.el | 41 +++-- lisp/gnus-fun.el | 3 +- lisp/gnus-sum.el | 2 + lisp/gnus.el | 3 +- lisp/mm-decode.el | 8 - lisp/mm-url.el | 17 +- lisp/nnheader.el | 472 +++++++++++++++++++++++++++-------------------------- lisp/nnmail.el | 4 +- lisp/nnweb.el | 20 +-- texi/ChangeLog | 4 + texi/gnus-ja.texi | 42 +++-- texi/gnus.texi | 38 +++-- 16 files changed, 413 insertions(+), 312 deletions(-) diff --git a/ChangeLog b/ChangeLog index bf0ac0d..800146e 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,17 @@ +2002-01-23 Katsumi Yamaoka + + * lisp/gnus-sum.el (gnus-article-commands-menu): Bind "Html" to + the command `gnus-article-wash-html'. + (gnus-summary-article-menu): Ditto. + (gnus-summary-wash-map): Bind "h" to the command + `gnus-article-wash-html'. + + * lisp/gnus-art.el (gnus-article-treatment-menu): Bind + "Treat html" to the command `gnus-article-wash-html'. + + * lisp/nnheader.el: Place mm- stuff and mail-parse stuff in front + of the codes which use (or may use) them. + 2002-01-21 ARISAWA Akihiro * lisp/gnus-art.el (gnus-article-display-traditional-message): Use diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 00159f5..9066373 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,43 @@ +2002-01-22 Lars Magne Ingebrigtsen + + * nnheader.el (nnheader-parse-overview-file): New function. + (nnheader-write-overview-file): New function. + +2002-01-21 Lars Magne Ingebrigtsen + + * gnus.el (gnus-group-fast-parameter): Check better if expansion + in wanted. + + * nnweb.el (nnweb-type-definition): Clean up. + +2002-01-21 Alastair Burt + + * gnus-art.el (gnus-mm-display-part): Make sure that the summary + buffer exists before jumping to it. + +2002-01-21 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-article-wash-html-with-w3): Made into own + function. + (article-wash-html): Use it. + (gnus-article-wash-function): New variable. + (gnus-article-wash-html-with-w3m): New function. + +2002-01-20 Bj,Av(Brn Torkelsson + + * dgnushack.el (dgnushack-compile): Compile smiley-ems for + XEmacs. + +2002-01-20 John H. Palmieri + + * gnus-fun.el (gnus-convert-image-to-gray-x-face): More standard + command line. + +2002-01-21 Simon Josefsson + + * canlock.el (base64-encode-string): Autoload it from base64. + (canlock-make-cancel-key): Base64 encode unibyte string. + 2002-01-20 Lars Magne Ingebrigtsen * nnfolder.el (nnfolder-request-accept-article): Unfold diff --git a/lisp/canlock.el b/lisp/canlock.el index 845095f..e8eb67c 100644 --- a/lisp/canlock.el +++ b/lisp/canlock.el @@ -46,6 +46,7 @@ (require 'cl)) (autoload 'sha1-binary "sha1-el") +(autoload 'base64-encode-string "base64") (defgroup canlock nil "The Cancel-Lock feature." @@ -154,12 +155,13 @@ If ARGS, PROMPT is used as an argument to `format'." (char-to-string (logxor 92 char))) password ""))) (base64-encode-string - (funcall canlock-sha1-function - (concat - opad - (funcall canlock-sha1-function - (concat ipad - (canlock-string-as-unibyte message-id)))))))) + (canlock-string-as-unibyte + (funcall canlock-sha1-function + (concat + opad + (funcall canlock-sha1-function + (concat ipad + (canlock-string-as-unibyte message-id))))))))) (defun canlock-narrow-to-header () "Narrow the buffer to the head of the message." diff --git a/lisp/dgnushack.el b/lisp/dgnushack.el index a8fa065..b08941d 100644 --- a/lisp/dgnushack.el +++ b/lisp/dgnushack.el @@ -491,7 +491,8 @@ Try to re-configure with --with-addpath=FLIM_PATH and run make again. '("gnus-bbdb.el"))) (unless (featurep 'xemacs) '("gnus-xmas.el" "messagexmas.el" "nnheaderxm.el" "smiley.el")) - (when (or (featurep 'xemacs) (<= emacs-major-version 20)) + (when (and (not (featurep 'xemacs)) + (<= emacs-major-version 20)) '("smiley-ems.el")) (when (and (fboundp 'base64-decode-string) (subrp (symbol-function 'base64-decode-string))) diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 82100c1..845b22b 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -1283,6 +1283,12 @@ It is a string, such as \"PGP\". If nil, ask user." :type 'string :group 'mime-security) +(defcustom gnus-article-wash-function 'gnus-article-wash-html-with-w3 + "Function used for converting HTML into text." + :type '(radio (function-item gnus-article-wash-html-with-w3) + (function-item gnus-article-wash-html-with-w3m)) + :group 'gnus-article) + ;;; Internal variables (defvar gnus-english-month-names @@ -2266,15 +2272,24 @@ If READ-CHARSET, ask for a coding system." (save-window-excursion (save-restriction (narrow-to-region (point) (point-max)) - (mm-setup-w3) - (let ((w3-strict-width (window-width)) - (url-standalone-mode t) - (w3-honor-stylesheets nil) - (w3-delay-image-loads t)) - (condition-case var - (w3-region (point-min) (point-max)) - (error)))))))) - + (funcall gnus-article-wash-function)))))) + +(defun gnus-article-wash-html-with-w3 () + "Wash the current buffer with w3." + (mm-setup-w3) + (let ((w3-strict-width (window-width)) + (url-standalone-mode t) + (w3-honor-stylesheets nil) + (w3-delay-image-loads t)) + (condition-case var + (w3-region (point-min) (point-max)) + (error)))) + +(defun gnus-article-wash-html-with-w3m () + "Wash the current buffer with w3m." + (shell-command-on-region + (point) (point-max) "w3m -T text/html" t t)) + (defun article-hide-list-identifiers () "Remove list identifies from the Subject header. The `gnus-list-identifiers' variable specifies what to do." @@ -3493,6 +3508,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is ["Treat overstrike" gnus-article-treat-overstrike t] ["Remove carriage return" gnus-article-remove-cr t] ["Remove leading whitespace" gnus-article-remove-leading-whitespace t] + ["Treat html" gnus-article-wash-html t] ["Decode HZ" gnus-article-decode-HZ t])) ;; Note "Commands" menu is defined in gnus-sum.el for consistency @@ -4365,8 +4381,11 @@ If no internal viewer is available, use an external viewer." (let ((window (selected-window)) (mail-parse-charset gnus-newsgroup-charset) (mail-parse-ignored-charsets - (save-excursion (set-buffer gnus-summary-buffer) - gnus-newsgroup-ignored-charsets))) + (if (gnus-buffer-live-p gnus-summary-buffer) + (save-excursion + (set-buffer gnus-summary-buffer) + gnus-newsgroup-ignored-charsets) + nil))) (save-excursion (unwind-protect (let ((win (gnus-get-buffer-window (current-buffer) t)) diff --git a/lisp/gnus-fun.el b/lisp/gnus-fun.el index d24124a..6cfd5d9 100644 --- a/lisp/gnus-fun.el +++ b/lisp/gnus-fun.el @@ -93,7 +93,8 @@ (insert (if (zerop (logand bits mask)) "0 " "1 "))) (shell-command-on-region (point-min) (point-max) - "pbmtoxbm | compface" + ;; the following is taken from xbmtoikon: + "pbmtoicon | sed '/^[ ]*[*\\\\/]/d; s/[ ]//g; s/,$//' | tr , '\\012' | sed 's/^0x//; s/^/0x/' | pr -l1 -t -w22 -3 -s, | sed 's/,*$/,/' | compface" (current-buffer) t) (push (buffer-string) x-faces)))) (dotimes (i (length x-faces)) diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 93576e8..fd2b481 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -1746,6 +1746,7 @@ increase the score of each group you read." "C" gnus-article-capitalize-sentences "c" gnus-article-remove-cr "Z" gnus-article-decode-HZ + "h" gnus-article-wash-html "f" gnus-article-display-x-face "l" gnus-summary-stop-page-breaking "r" gnus-summary-caesar-message @@ -1954,6 +1955,7 @@ increase the score of each group you read." ["Toggle header" gnus-summary-toggle-header t] ["Unfold headers" gnus-article-treat-unfold-headers t] ["Fold newsgroups" gnus-article-treat-fold-newsgroups t] + ["Html" gnus-article-wash-html t] ["Verify X-PGP-Sig" gnus-article-verify-x-pgp-sig t] ["HZ" gnus-article-decode-HZ t]) ("Output" diff --git a/lisp/gnus.el b/lisp/gnus.el index 92fdcda..5997d40 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -1467,6 +1467,7 @@ slower, and `std11-extract-address-components'." ("nnfolder" mail respool address) ("nngateway" post-mail address prompt-address physical-address) ("nnweb" none) + ("nngoogle" post) ("nnslashdot" post) ("nnultimate" none) ("nnrss" none) @@ -3004,7 +3005,7 @@ The function `gnus-group-find-parameter' will do that for you." symbol allow-list)) (when result ;; Expand if necessary. - (if (and (stringp result) (string-match "\\\\" result)) + (if (and (stringp result) (string-match "\\\\[0-9&]" result)) (setq result (gnus-expand-group-parameter (car head) result group))) ;; Exit the loop early. diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el index 4b401e8..7c85b3d 100644 --- a/lisp/mm-decode.el +++ b/lisp/mm-decode.el @@ -22,14 +22,6 @@ ;;; Commentary: -;; Jaap-Henk Hoepman (jhh@xs4all.nl): -;; -;; Added support for delayed destroy of external MIME viewers. All external -;; viewers for mime types in mm-keep-viewer-alive-types will remain active -;; after switching articles or groups, and will only be removed when exiting -;; gnus. -;; - ;;; Code: (require 'mail-parse) diff --git a/lisp/mm-url.el b/lisp/mm-url.el index 2ab90f1..6a1caa1 100644 --- a/lisp/mm-url.el +++ b/lisp/mm-url.el @@ -32,19 +32,20 @@ (eval-when-compile (require 'cl)) (require 'mm-util) +;;(require 'url) +(require 'w3) (eval-and-compile (autoload 'exec-installed-p "path-util") - (autoload 'url-insert-file-contents "url-handlers")) + ;;(autoload 'url-insert-file-contents "url-handlers") + (autoload 'url-insert-file-contents "url") + ) (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))) +(defcustom mm-url-use-external nil "*If not-nil, use external grab program `mm-url-program'." :type 'boolean :group 'mm-url) @@ -251,7 +252,7 @@ This is taken from RFC 2396.") (if (string-match "^file:/+" url) (insert-file-contents (substring url (1- (match-end 0)))) (mm-url-insert-file-contents-external url)) - (require 'url-handlers) + ;;(require 'url-handlers) (let ((name buffer-file-name)) (prog1 (url-insert-file-contents url) @@ -344,7 +345,7 @@ spaces. Die Die Die." (defun mm-url-fetch-form (url pairs) "Fetch a form from URL with PAIRS as the data using the POST method." - (require 'url-handlers) + ;;(require 'url-handlers) (let ((url-request-data (mm-url-encode-www-form-urlencoded pairs)) (url-request-method "POST") (url-request-extra-headers @@ -354,7 +355,7 @@ spaces. Die Die Die." t) (defun mm-url-fetch-simple (url content) - (require 'url-handlers) + ;;(require 'url-handlers) (let ((url-request-data content) (url-request-method "POST") (url-request-extra-headers diff --git a/lisp/nnheader.el b/lisp/nnheader.el index 8d7bc20..a00d718 100644 --- a/lisp/nnheader.el +++ b/lisp/nnheader.el @@ -103,6 +103,234 @@ This variable is a substitute for `mm-text-coding-system-for-write'.") (autoload 'gnus-point-at-eol "gnus-util") (autoload 'gnus-buffer-live-p "gnus-util")) +;; mm- stuff. +(unless (featurep 'mm-util) + (defun nnheader-image-load-path (&optional package) + (let (dir result) + (dolist (path load-path (nreverse result)) + (if (file-directory-p + (setq dir (concat (file-name-directory + (directory-file-name path)) + "etc/" (or package "gnus/")))) + (push dir result)) + (push path result)))) + (defalias 'mm-image-load-path 'nnheader-image-load-path) + + (defalias 'mm-read-coding-system + (if (or (and (featurep 'xemacs) + (<= (string-to-number emacs-version) 21.1)) + (boundp 'MULE)) + (lambda (prompt &optional default-coding-system) + (read-coding-system prompt)) + 'read-coding-system)) + + (defalias 'mm-multibyte-string-p + (if (fboundp 'multibyte-string-p) + 'multibyte-string-p + 'ignore)) + + (defalias 'mm-encode-coding-string 'encode-coding-string) + (defalias 'mm-decode-coding-string 'decode-coding-string) + + (defun nnheader-detect-coding-region (start end) + "Like 'detect-coding-region' except returning the best one." + (let ((coding-systems + (static-if (boundp 'MULE) + (code-detect-region (point) (point-max)) + (detect-coding-region (point) (point-max))))) + (or (car-safe coding-systems) + coding-systems))) + (defalias 'mm-detect-coding-region 'nnheader-detect-coding-region) + + (defun nnheader-detect-mime-charset-region (start end) + "Detect MIME charset of the text in the region between START and END." + (coding-system-to-mime-charset + (nnheader-detect-coding-region start end))) + (defalias 'mm-detect-mime-charset-region + 'nnheader-detect-mime-charset-region) + + (defmacro nnheader-with-unibyte-buffer (&rest forms) + "Create a temporary buffer, and evaluate FORMS there like `progn'. +Use unibyte mode for this." + `(let (default-enable-multibyte-characters mc-flag) + (with-temp-buffer ,@forms))) + (put 'nnheader-with-unibyte-buffer 'lisp-indent-function 0) + (put 'nnheader-with-unibyte-buffer 'edebug-form-spec '(body)) + (put 'mm-with-unibyte-buffer 'lisp-indent-function 0) + (put 'mm-with-unibyte-buffer 'edebug-form-spec '(body)) + (defalias 'mm-with-unibyte-buffer 'nnheader-with-unibyte-buffer)) + +;; mail-parse stuff. +(unless (featurep 'mail-parse) + (defun-maybe std11-narrow-to-field () + "Narrow the buffer to the header on the current line." + (forward-line 0) + (narrow-to-region (point) + (progn + (std11-field-end) + (when (eolp) (forward-line 1)) + (point))) + (goto-char (point-min))) + + (defalias 'mail-header-narrow-to-field 'std11-narrow-to-field) + + (defun mail-narrow-to-head () + "Narrow to the header section in the current buffer." + (narrow-to-region + (goto-char (point-min)) + (if (re-search-forward "^\r?$" nil 1) + (match-beginning 0) + (point-max))) + (goto-char (point-min))) + + (defun-maybe std11-fold-region (b e) + "Fold long lines in region B to E." + (save-restriction + (narrow-to-region b e) + (goto-char (point-min)) + (let ((break nil) + (qword-break nil) + (first t) + (bol (save-restriction + (widen) + (gnus-point-at-bol)))) + (while (not (eobp)) + (when (and (or break qword-break) + (> (- (point) bol) 76)) + (goto-char (or break qword-break)) + (setq break nil + qword-break nil) + (if (looking-at "[ \t]") + (insert "\n") + (insert "\n ")) + (setq bol (1- (point))) + ;; Don't break before the first non-LWSP characters. + (skip-chars-forward " \t") + (unless (eobp) + (forward-char 1))) + (cond + ((eq (char-after) ?\n) + (forward-char 1) + (setq bol (point) + break nil + qword-break nil) + (skip-chars-forward " \t") + (unless (or (eobp) (eq (char-after) ?\n)) + (forward-char 1))) + ((eq (char-after) ?\r) + (forward-char 1)) + ((memq (char-after) '(? ?\t)) + (skip-chars-forward " \t") + (if first + ;; Don't break just after the header name. + (setq first nil) + (setq break (1- (point))))) + ((not break) + (if (not (looking-at "=\\?[^=]")) + (if (eq (char-after) ?=) + (forward-char 1) + (skip-chars-forward "^ \t\n\r=")) + (setq qword-break (point)) + (skip-chars-forward "^ \t\n\r"))) + (t + (skip-chars-forward "^ \t\n\r")))) + (when (and (or break qword-break) + (> (- (point) bol) 76)) + (goto-char (or break qword-break)) + (setq break nil + qword-break nil) + (if (looking-at "[ \t]") + (insert "\n") + (insert "\n ")) + (setq bol (1- (point))) + ;; Don't break before the first non-LWSP characters. + (skip-chars-forward " \t") + (unless (eobp) + (forward-char 1)))))) + + (defun-maybe std11-fold-field () + "Fold the current line." + (save-excursion + (save-restriction + (std11-narrow-to-field) + (std11-fold-region (point-min) (point-max))))) + + (defalias 'mail-header-fold-field 'std11-fold-field) + + (defun-maybe std11-unfold-region (b e) + "Unfold lines in region B to E." + (save-restriction + (narrow-to-region b e) + (goto-char (point-min)) + (let ((bol (save-restriction + (widen) + (gnus-point-at-bol))) + (eol (gnus-point-at-eol)) + leading) + (forward-line 1) + (while (not (eobp)) + (looking-at "[ \t]*") + (setq leading (- (match-end 0) (match-beginning 0))) + (if (< (- (gnus-point-at-eol) bol leading) 76) + (progn + (goto-char eol) + (delete-region eol (progn + (skip-chars-forward " \t\n\r") + (1- (point))))) + (setq bol (gnus-point-at-bol))) + (setq eol (gnus-point-at-eol)) + (forward-line 1))))) + + (defun-maybe std11-unfold-field () + "Fold the current line." + (save-excursion + (save-restriction + (std11-narrow-to-field) + (std11-unfold-region (point-min) (point-max))))) + + (defalias 'mail-header-unfold-field 'std11-unfold-field) + + (defun-maybe std11-extract-addresses-components (string) + "Extract a list of full name and canonical address from STRING. Each +element looks like a list of the form (FULL-NAME CANONICAL-ADDRESS). +If no name can be extracted, FULL-NAME will be nil." + (when string + (mapcar (function + (lambda (structure) + (list (std11-full-name-string structure) + (std11-address-string structure)))) + (std11-parse-addresses-string (std11-unfold-string string))))) + + (defun mail-header-parse-addresses (string) + "Parse STRING and return a list of MAILBOX / DISPLAY-NAME pairs." + (mapcar (function + (lambda (components) + (cons (nth 1 components) (car components)))) + (std11-extract-addresses-components string))) + + (defun-maybe std11-field-value (&optional dont-include-last-newline) + "Return the value of the field at point. If the optional argument is +given, the return value will not contain the last newline." + (let ((begin (point)) + (inhibit-point-motion-hooks t) + start value) + (beginning-of-line) + (unless (eobp) + (while (and (memq (char-after) '(?\t ?\ )) + (zerop (forward-line -1)))) + (when (looking-at ".+:[\t\n ]+") + (goto-char (setq start (match-end 0))) + (forward-line 1) + (while (and (memq (char-after) '(?\t ?\ )) + (zerop (forward-line 1)))) + (when dont-include-last-newline + (skip-chars-backward "\t\n " start)) + (setq value (buffer-substring start (point))))) + (goto-char begin) + value)) + + (defalias 'mail-header-field-value 'std11-field-value)) + ;;; Header access macros. ;; These macros may look very much like the ones in GNUS 4.1. They @@ -424,6 +652,22 @@ This variable is a substitute for `mm-text-coding-system-for-write'.") (delete-char 1)) (forward-line 1))) +(defun nnheader-parse-overview-file (file) + "Parse FILE and return a list of headers." + (mm-with-unibyte-buffer + (nnheader-insert-file-contents file) + (goto-char (point-min)) + (let (headers) + (while (not (eobp)) + (push (nnheader-parse-nov) headers) + (forward-line 1)) + (nreverse headers)))) + +(defun nnheader-write-overview-file (file headers) + "Write HEADERS to FILE." + (with-temp-file file + (mapcar 'nnheader-insert-nov headers))) + (defun nnheader-insert-header (header) (insert "Subject: " (or (mail-header-subject header) "(none)") "\n" @@ -1183,234 +1427,6 @@ find-file-hooks, etc. (message "%s(Y/n) Yes" prompt) t))) -;; mm- stuff. -(unless (featurep 'mm-util) - (defun nnheader-image-load-path (&optional package) - (let (dir result) - (dolist (path load-path (nreverse result)) - (if (file-directory-p - (setq dir (concat (file-name-directory - (directory-file-name path)) - "etc/" (or package "gnus/")))) - (push dir result)) - (push path result)))) - (defalias 'mm-image-load-path 'nnheader-image-load-path) - - (defalias 'mm-read-coding-system - (if (or (and (featurep 'xemacs) - (<= (string-to-number emacs-version) 21.1)) - (boundp 'MULE)) - (lambda (prompt &optional default-coding-system) - (read-coding-system prompt)) - 'read-coding-system)) - - (defalias 'mm-multibyte-string-p - (if (fboundp 'multibyte-string-p) - 'multibyte-string-p - 'ignore)) - - (defalias 'mm-encode-coding-string 'encode-coding-string) - (defalias 'mm-decode-coding-string 'decode-coding-string) - - (defun nnheader-detect-coding-region (start end) - "Like 'detect-coding-region' except returning the best one." - (let ((coding-systems - (static-if (boundp 'MULE) - (code-detect-region (point) (point-max)) - (detect-coding-region (point) (point-max))))) - (or (car-safe coding-systems) - coding-systems))) - (defalias 'mm-detect-coding-region 'nnheader-detect-coding-region) - - (defun nnheader-detect-mime-charset-region (start end) - "Detect MIME charset of the text in the region between START and END." - (coding-system-to-mime-charset - (nnheader-detect-coding-region start end))) - (defalias 'mm-detect-mime-charset-region - 'nnheader-detect-mime-charset-region) - - (defmacro nnheader-with-unibyte-buffer (&rest forms) - "Create a temporary buffer, and evaluate FORMS there like `progn'. -Use unibyte mode for this." - `(let (default-enable-multibyte-characters mc-flag) - (with-temp-buffer ,@forms))) - (put 'nnheader-with-unibyte-buffer 'lisp-indent-function 0) - (put 'nnheader-with-unibyte-buffer 'edebug-form-spec '(body)) - (put 'mm-with-unibyte-buffer 'lisp-indent-function 0) - (put 'mm-with-unibyte-buffer 'edebug-form-spec '(body)) - (defalias 'mm-with-unibyte-buffer 'nnheader-with-unibyte-buffer)) - -;; mail-parse stuff. -(unless (featurep 'mail-parse) - (defun-maybe std11-narrow-to-field () - "Narrow the buffer to the header on the current line." - (forward-line 0) - (narrow-to-region (point) - (progn - (std11-field-end) - (when (eolp) (forward-line 1)) - (point))) - (goto-char (point-min))) - - (defalias 'mail-header-narrow-to-field 'std11-narrow-to-field) - - (defun mail-narrow-to-head () - "Narrow to the header section in the current buffer." - (narrow-to-region - (goto-char (point-min)) - (if (re-search-forward "^\r?$" nil 1) - (match-beginning 0) - (point-max))) - (goto-char (point-min))) - - (defun-maybe std11-fold-region (b e) - "Fold long lines in region B to E." - (save-restriction - (narrow-to-region b e) - (goto-char (point-min)) - (let ((break nil) - (qword-break nil) - (first t) - (bol (save-restriction - (widen) - (gnus-point-at-bol)))) - (while (not (eobp)) - (when (and (or break qword-break) - (> (- (point) bol) 76)) - (goto-char (or break qword-break)) - (setq break nil - qword-break nil) - (if (looking-at "[ \t]") - (insert "\n") - (insert "\n ")) - (setq bol (1- (point))) - ;; Don't break before the first non-LWSP characters. - (skip-chars-forward " \t") - (unless (eobp) - (forward-char 1))) - (cond - ((eq (char-after) ?\n) - (forward-char 1) - (setq bol (point) - break nil - qword-break nil) - (skip-chars-forward " \t") - (unless (or (eobp) (eq (char-after) ?\n)) - (forward-char 1))) - ((eq (char-after) ?\r) - (forward-char 1)) - ((memq (char-after) '(? ?\t)) - (skip-chars-forward " \t") - (if first - ;; Don't break just after the header name. - (setq first nil) - (setq break (1- (point))))) - ((not break) - (if (not (looking-at "=\\?[^=]")) - (if (eq (char-after) ?=) - (forward-char 1) - (skip-chars-forward "^ \t\n\r=")) - (setq qword-break (point)) - (skip-chars-forward "^ \t\n\r"))) - (t - (skip-chars-forward "^ \t\n\r")))) - (when (and (or break qword-break) - (> (- (point) bol) 76)) - (goto-char (or break qword-break)) - (setq break nil - qword-break nil) - (if (looking-at "[ \t]") - (insert "\n") - (insert "\n ")) - (setq bol (1- (point))) - ;; Don't break before the first non-LWSP characters. - (skip-chars-forward " \t") - (unless (eobp) - (forward-char 1)))))) - - (defun-maybe std11-fold-field () - "Fold the current line." - (save-excursion - (save-restriction - (std11-narrow-to-field) - (std11-fold-region (point-min) (point-max))))) - - (defalias 'mail-header-fold-field 'std11-fold-field) - - (defun-maybe std11-unfold-region (b e) - "Unfold lines in region B to E." - (save-restriction - (narrow-to-region b e) - (goto-char (point-min)) - (let ((bol (save-restriction - (widen) - (gnus-point-at-bol))) - (eol (gnus-point-at-eol)) - leading) - (forward-line 1) - (while (not (eobp)) - (looking-at "[ \t]*") - (setq leading (- (match-end 0) (match-beginning 0))) - (if (< (- (gnus-point-at-eol) bol leading) 76) - (progn - (goto-char eol) - (delete-region eol (progn - (skip-chars-forward " \t\n\r") - (1- (point))))) - (setq bol (gnus-point-at-bol))) - (setq eol (gnus-point-at-eol)) - (forward-line 1))))) - - (defun-maybe std11-unfold-field () - "Fold the current line." - (save-excursion - (save-restriction - (std11-narrow-to-field) - (std11-unfold-region (point-min) (point-max))))) - - (defalias 'mail-header-unfold-field 'std11-unfold-field) - - (defun-maybe std11-extract-addresses-components (string) - "Extract a list of full name and canonical address from STRING. Each -element looks like a list of the form (FULL-NAME CANONICAL-ADDRESS). -If no name can be extracted, FULL-NAME will be nil." - (when string - (mapcar (function - (lambda (structure) - (list (std11-full-name-string structure) - (std11-address-string structure)))) - (std11-parse-addresses-string (std11-unfold-string string))))) - - (defun mail-header-parse-addresses (string) - "Parse STRING and return a list of MAILBOX / DISPLAY-NAME pairs." - (mapcar (function - (lambda (components) - (cons (nth 1 components) (car components)))) - (std11-extract-addresses-components string))) - - (defun-maybe std11-field-value (&optional dont-include-last-newline) - "Return the value of the field at point. If the optional argument is -given, the return value will not contain the last newline." - (let ((begin (point)) - (inhibit-point-motion-hooks t) - start value) - (beginning-of-line) - (unless (eobp) - (while (and (memq (char-after) '(?\t ?\ )) - (zerop (forward-line -1)))) - (when (looking-at ".+:[\t\n ]+") - (goto-char (setq start (match-end 0))) - (forward-line 1) - (while (and (memq (char-after) '(?\t ?\ )) - (zerop (forward-line 1)))) - (when dont-include-last-newline - (skip-chars-backward "\t\n " start)) - (setq value (buffer-substring start (point))))) - (goto-char begin) - value)) - - (defalias 'mail-header-field-value 'std11-field-value)) - (when (featurep 'xemacs) (require 'nnheaderxm)) diff --git a/lisp/nnmail.el b/lisp/nnmail.el index d4df6ad..8e0838d 100644 --- a/lisp/nnmail.el +++ b/lisp/nnmail.el @@ -1023,8 +1023,8 @@ FUNC will be called with the group name to determine the article number." (or (funcall nnmail-split-methods) '("bogus")) (error - (nnheader-message 5 - "Error in `nnmail-split-methods'; using `bogus' mail group") + (nnheader-message + 5 "Error in `nnmail-split-methods'; using `bogus' mail group") (sit-for 1) '("bogus"))))) (setq split (gnus-remove-duplicates split)) diff --git a/lisp/nnweb.el b/lisp/nnweb.el index 3ce22fd..3ecbd27 100644 --- a/lisp/nnweb.el +++ b/lisp/nnweb.el @@ -38,6 +38,7 @@ (require 'nnmail) (require 'mm-util) (require 'mm-url) +(require 'url) (autoload 'w3-parse-buffer "w3-parse") (nnoo-declare nnweb) @@ -51,13 +52,9 @@ Valid types include `google', `dejanews', `dejanewsold', `reference', and `altavista'.") (defvar nnweb-type-definition - '( - (google - ;;(article . nnweb-google-wash-article) - ;;(id . "http://groups.google.com/groups?as_umsgid=%s") + '((google (article . ignore) (id . "http://groups.google.com/groups?selm=%s&output=gplain") - ;;(reference . nnweb-google-reference) (reference . identity) (map . nnweb-google-create-mapping) (search . nnweb-google-search) @@ -74,19 +71,6 @@ and `altavista'.") (search . nnweb-google-search) (address . "http://groups.google.com/groups") (identifier . nnweb-google-identity)) -;;; (dejanews -;;; (article . ignore) -;;; (id . "http://search.dejanews.com/msgid.xp?MID=%s&fmt=text") -;;; (map . nnweb-dejanews-create-mapping) -;;; (search . nnweb-dejanews-search) -;;; (address . "http://www.deja.com/=dnc/qs.xp") -;;; (identifier . nnweb-dejanews-identity)) -;;; (dejanewsold -;;; (article . ignore) -;;; (map . nnweb-dejanews-create-mapping) -;;; (search . nnweb-dejanewsold-search) -;;; (address . "http://www.deja.com/dnquery.xp") -;;; (identifier . nnweb-dejanews-identity)) (reference (article . nnweb-reference-wash-article) (map . nnweb-reference-create-mapping) diff --git a/texi/ChangeLog b/texi/ChangeLog index 5ffee4e..af06cf2 100644 --- a/texi/ChangeLog +++ b/texi/ChangeLog @@ -1,3 +1,7 @@ +2002-01-21 Lars Magne Ingebrigtsen + + * gnus.texi (Article Washing): Addition. + 2002-01-20 Lars Magne Ingebrigtsen * gnus.texi (Document Groups): Added info on more doc types. diff --git a/texi/gnus-ja.texi b/texi/gnus-ja.texi index 3831236..96a5ac4 100644 --- a/texi/gnus-ja.texi +++ b/texi/gnus-ja.texi @@ -2982,9 +2982,9 @@ Sieve $B$N(B @samp{IF} $B@)8f9=B$BN$,:n$i$l$^$9!#(B $B$k(B (@pxref{Sieve Commands}) $B$H$-$K!"0J2<$N(B Sieve $B%3!<%I$,:n$i$l$^$9(B: @example - if address \"sender\" \"sieve-admin@@extundo.com\" @{ - fileinto \"INBOX.list.sieve\"; - @} +if address \"sender\" \"sieve-admin@@extundo.com\" @{ + fileinto \"INBOX.list.sieve\"; +@} @end example Sieve $B8@8l$O(B RFC 3028 $B$G=R$Y$i$l$F$$$^$9!#(B@xref{Top, , Top, sieve, Emacs @@ -7980,14 +7980,29 @@ HZ $B$^$?$O(B HZP $B$r=hM}$7$^$9!#(BHZ ($B$^$?$O(B HZP) $B$OCf9q8l$N5-;v$ $B$K;H$o$l$k0lHLE*$JId9f$G$9!#$3$l$O(B @samp{~@{<:Ky2;S@{#,NpJ)l6HK!#~@}} $B$N(B $B$h$&$JE57?E*$JJ8;zNs$r:n$j$^$9!#(B -@c @item W h -@c @kindex W h (Summary) -@c @findex gnus-article-wash-html -@c Treat HTML (@code{gnus-article-wash-html}). -@c Note that the this is usually done automatically by Gnus if the message -@c in question has a @code{Content-Type} header that says that this type -@c has been done. -@c If a prefix is given, a charset will be asked for. +@item W h +@kindex W h ($B35N,(B) +@findex gnus-article-wash-html +HTML $B$r=hM}$7$^$9!#Ev3:%a%C%;!<%8$,(B HTML $B$G$"$k$3$H$r<((B +$B$9(B @code{Content-Type} $B%X%C%@!<$r;}$C$F$$$?$J$i$P!"$=$l$O(B gnus $B$K$h$C$F(B +$B<+F0E*$K9T$J$o$l$k$3$H$KCm0U$7$F2<$5$$!#(B + +$B@\F,<-$,M?$($i$l$k$H!"2?$NJ8;z=89g(B (charset) $B$H$7$F07$&$+$r?R$M$i$l$^$9!#(B + +@vindex gnus-article-wash-function +$B%G%#%U%)%k%H$G$O(B HTML $B$NJQ49$K(B w3 $B$r;H$$$^$9$,!"$3$l$OJQ(B +$B?t(B @code{gnus-article-wash-function} $B$G@)8f$5$l$^$9!#;H$&$3$H$,$G$-$k!"(B +$B$"$i$+$8$aMQ0U$5$l$?4X?t$O0J2<$NDL$j$G$9!#(B + +@table @code +@item gnus-article-wash-html-with-w3 +@findex gnus-article-wash-html-with-w3 +w3 $B$r;H$$$^$9(B ($B$3$l$,%G%#%U%)%k%H$G$9(B)$B!#(B + +@item gnus-article-wash-html-with-w3m +@findex gnus-article-wash-html-with-w3m +$B30It%W%m%0%i%`(B @samp{w3m} $B$r;H$$$^$9!#(B +@end table @item W b @kindex W b ($B35N,(B) @@ -9637,7 +9652,6 @@ Gnus $B$O%X%C%@!<$NJB$YBX$((B(sort)$B$b9T$$$^$9(B ($B$3$l$O%G%#%U%)%k%H$G9T @vindex gnus-show-mime @vindex gnus-article-display-method-for-mime -@vindex gnus-strict-mime @findex gnus-article-display-mime-message Gnus $B$O(B @code{gnus-article-display-method-for-mime} $B$K5-;v$r2!$7IU$1$k$3(B $B$H$G(B @sc{mime} $B$r07$$$^$9!#$3$N=i4|CM(B @@ -9647,9 +9661,7 @@ SEMI MIME-View $B$K4X$9$k>\$7$$>pJs$O!"%^%K%e%"%k$r;2>H$7$F$/$@$5$$(B ($B$^$@ $B$J$$$1$I(B (;_;))$B!#(B @sc{mime} $B$r>o$K;HMQ$7$?$1$l$P!"(B -@code{gnus-show-mime} $B$r(B @code{t} $B$K@_Dj$7$F$/$@$5$$!#$7$+$7!"(B -@code{gnus-strict-mime} $B$,(B @code{nil} $B0J30$G$"$l$P!"(B@sc{mime} $B=hM}$O5-;v(B -$BCf$K(B @sc{mime} $B%X%C%@!<$,$"$k$H$-$N$_;HMQ$5$l$^$9!#(B +@code{gnus-show-mime} $B$r(B @code{t} $B$K@_Dj$7$F$/$@$5$$!#(B @code{gnus-show-mime} $B$r@_Dj$7$F$$$k$H!"1?$,0-$$$H5-;v%P%C%U%!$K$O8N>c$7(B $B$?$h$&$J2hLL$,8+$($k$3$H$b$"$k$G$7$g$&!#$3$l$OHr$1$h$&$,$"$j$^$;$s!#(B diff --git a/texi/gnus.texi b/texi/gnus.texi index 06c1c33..dcc262a 100644 --- a/texi/gnus.texi +++ b/texi/gnus.texi @@ -2891,9 +2891,9 @@ translating the group parameter into a Sieve script (@pxref{Sieve Commands}) the following Sieve code is generated: @example - if address \"sender\" \"sieve-admin@@extundo.com\" @{ - fileinto \"INBOX.list.sieve\"; - @} +if address \"sender\" \"sieve-admin@@extundo.com\" @{ + fileinto \"INBOX.list.sieve\"; +@} @end example The Sieve language is described in RFC 3028. @xref{Top, , Top, sieve, @@ -8119,12 +8119,27 @@ makes strings look like @samp{~@{<:Ky2;S@{#,NpJ)l6HK!#~@}}. @item W h @kindex W h (Summary) @findex gnus-article-wash-html -Treat HTML (@code{gnus-article-wash-html}). -Note that the this is usually done automatically by Gnus if the message -in question has a @code{Content-Type} header that says that this type -has been done. +Treat HTML (@code{gnus-article-wash-html}). Note that the this is +usually done automatically by Gnus if the message in question has a +@code{Content-Type} header that says that the message is HTML. + If a prefix is given, a charset will be asked for. +@vindex gnus-article-wash-function +The default is to use w3 to convert the HTML, but this is controlled +by the @code{gnus-article-wash-function} variable. Pre-defined +functions you can use include: + +@table @code +@item gnus-article-wash-html-with-w3 +@findex gnus-article-wash-html-with-w3 +Use w3 (this is the default). + +@item gnus-article-wash-html-with-w3m +@findex gnus-article-wash-html-with-w3m +Use the external @samp{w3m} program. +@end table + @item W b @kindex W b (Summary) @findex gnus-article-add-buttons @@ -10119,7 +10134,6 @@ other naughty stuff in innocent-looking articles. @vindex gnus-show-mime @vindex gnus-article-display-method-for-mime -@vindex gnus-strict-mime @findex gnus-article-display-mime-message Gnus handles @sc{mime} by pushing the articles through @code{gnus-article-display-method-for-mime}, which is @@ -10129,11 +10143,9 @@ information on SEMI MIME-View, see its manual page (however it is not existed yet, sorry). Set @code{gnus-show-mime} to @code{t} if you want to use -@sc{mime} all the time. However, if @code{gnus-strict-mime} is -non-@code{nil}, the @sc{mime} method will only be used if there are -@sc{mime} headers in the article. If you have @code{gnus-show-mime} -set, then you'll see some unfortunate display glitches in the article -buffer. These can't be avoided. +@sc{mime} all the time. If you have @code{gnus-show-mime} set, then +you'll see some unfortunate display glitches in the article buffer. +These can't be avoided. In GNUS or Gnus, it might be best to just use the toggling functions from the summary buffer to avoid getting nasty surprises. (For instance, -- 1.7.10.4