From ea42fdd601ccdb6580a1d47059ceb7f636696211 Mon Sep 17 00:00:00 2001 From: yamaoka Date: Sun, 9 Dec 2001 23:47:03 +0000 Subject: [PATCH] Synch with Oort Gnus. --- ChangeLog | 5 + lisp/ChangeLog | 37 ++++++++ lisp/dgnushack.el | 11 +-- lisp/gnus-art.el | 32 ------- lisp/gnus-group.el | 3 +- lisp/gnus-sum.el | 12 ++- lisp/gnus-util.el | 32 +++++++ lisp/lpath.el | 8 +- lisp/mm-url.el | 75 ++++++++++++--- lisp/nnheader.el | 43 +++++---- lisp/nnlistserv.el | 17 ++-- lisp/nnmail.el | 58 ++++++++++++ lisp/nnrss.el | 5 +- lisp/nnslashdot.el | 3 +- lisp/nnultimate.el | 16 ++-- lisp/nnwarchive.el | 58 +++--------- lisp/nnweb.el | 263 ++++++++++++++++++---------------------------------- lisp/nnwfm.el | 19 ++-- lisp/webmail.el | 108 +++++++-------------- texi/ChangeLog | 4 + texi/gnus-ja.texi | 21 +++++ texi/gnus.texi | 20 ++++ 22 files changed, 450 insertions(+), 400 deletions(-) diff --git a/ChangeLog b/ChangeLog index ea9e84f..e01a8ab 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2001-12-09 Katsumi Yamaoka + + * lisp/nnheader.el (mm-multibyte-string-p): Alias to + `multibyte-string-p' or `ignore'. + 2001-12-09 TSUCHIYA Masatoshi * lisp/gnus-namazu.el (gnus-namazu-summary-buffer-name): New diff --git a/lisp/ChangeLog b/lisp/ChangeLog index d728874..3424624 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,40 @@ +2001-12-09 08:00:00 ShengHuo ZHU + + * gnus-sum.el (gnus-summary-buffer-name): Decode group name. + * gnus-group.el (gnus-group-name-decode): Decode unibyte + strings only. + From TSUCHIYA Masatoshi + +2001-12-08 Nevin Kapur + + * nnmail.el (nnmail-fancy-expiry-targets): New variable. + (nnmail-fancy-expiry-target): Use it. + Suggestions from Simon Josefsson . + +2001-12-07 14:00:00 ShengHuo ZHU + + * gnus-sum.el (gnus-summary-show-article): Recount lines if not exist. + +2001-12-07 10:00:00 ShengHuo ZHU + + * nnwfm.el (nnwfm-create-mapping): Use gnus-url-unhex-string. + + * gnus-util.el (gnus-url-unhex-string): Move here. + +2001-12-07 09:00:00 ShengHuo ZHU + + * nnrss.el (nnrss-decode-entities-unibyte-string): Use + mm-url-decode-entities-nbsp. + + * nnlistserv.el, nnultimate.el, nnwarchive.el, nnweb.el, + webmail.el, nnwfm.el: Use mm-url. + + * mm-url.el (mm-url-fetch-form): Move from nnweb. + (mm-url-remove-markup): Move from nnweb. + (mm-url-fetch-simple): Move from webmail. + + * nnslashdot.el (nnslashdot-request-post): mm-url-fetch-form. + 2001-12-07 01:00:00 ShengHuo ZHU * gnus-sum.el (gnus-summary-print-truncate-and-quote): New. diff --git a/lisp/dgnushack.el b/lisp/dgnushack.el index 34aab07..e8a371c 100644 --- a/lisp/dgnushack.el +++ b/lisp/dgnushack.el @@ -440,10 +440,10 @@ Try to re-configure with --with-addpath=FLIM_PATH and run make again. (progn (require 'shimbun) nil) (error '("nnshimbun.el"))) (unless (or (condition-case code - (require 'w3-forms) + (require 'w3-parse) (error (message "No w3: %s %s retrying..." code - (locate-library "w3-forms")) + (locate-library "w3-parse")) nil)) ;; Maybe mis-configured Makefile is used (e.g. ;; configured for FSFmacs but XEmacs is running). @@ -451,19 +451,18 @@ Try to re-configure with --with-addpath=FLIM_PATH and run make again. (copy-sequence load-path)))) (if (let ((load-path lp)) (condition-case nil - (require 'w3-forms) + (require 'w3-parse) (error nil))) ;; If success, fix `load-path' for compiling. (progn (setq load-path lp) (message " => fixed; W3DIR=%s" (file-name-directory - (locate-library "w3-forms"))) + (locate-library "w3-parse"))) t) (message " => ignored") nil))) - '("nnweb.el" "nnlistserv.el" "nnultimate.el" - "nnwarchive.el" "webmail.el" "nnwfm.el")) + '("nnultimate.el" "webmail.el" "nnwfm.el")) (condition-case code (progn (require 'mh-e) nil) (error diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 5251553..b55806b 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -5795,38 +5795,6 @@ specified by `gnus-button-alist'." (setq retval (cons (list key val) retval))))) retval)) -(defun gnus-url-unhex (x) - (if (> x ?9) - (if (>= x ?a) - (+ 10 (- x ?a)) - (+ 10 (- x ?A))) - (- x ?0))) - -(defun gnus-url-unhex-string (str &optional allow-newlines) - "Remove %XXX embedded spaces, etc in a url. -If optional second argument ALLOW-NEWLINES is non-nil, then allow the -decoding of carriage returns and line feeds in the string, which is normally -forbidden in URL encoding." - (setq str (or (nnheader-replace-chars-in-string str ?+ ? ) "")) - (let ((tmp "") - (case-fold-search t)) - (while (string-match "%[0-9a-f][0-9a-f]" str) - (let* ((start (match-beginning 0)) - (ch1 (gnus-url-unhex (elt str (+ start 1)))) - (code (+ (* 16 ch1) - (gnus-url-unhex (elt str (+ start 2)))))) - (setq tmp (concat - tmp (substring str 0 start) - (cond - (allow-newlines - (char-to-string code)) - ((or (= code ?\n) (= code ?\r)) - " ") - (t (char-to-string code)))) - str (substring str (match-end 0))))) - (setq tmp (concat tmp str)) - tmp)) - (defun gnus-url-mailto (url) ;; Send mail to someone (when (string-match "mailto:/*\\(.*\\)" url) diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el index 9958b38..304899b 100644 --- a/lisp/gnus-group.el +++ b/lisp/gnus-group.el @@ -1039,7 +1039,8 @@ The following commands are available: result))) (defun gnus-group-name-decode (string charset) - (if (and string charset (featurep 'mule)) + (if (and string charset (featurep 'mule) + (not (mm-multibyte-string-p string))) (decode-coding-string string charset) string)) diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 4413b19..bf1cbdd 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -2779,7 +2779,7 @@ display only a single character." (defun gnus-summary-buffer-name (group) "Return the summary buffer name of GROUP." - (concat "*Summary " group "*")) + (concat "*Summary " (gnus-group-decoded-name group) "*")) (defun gnus-summary-setup-buffer (group) "Initialize summary buffer." @@ -8036,16 +8036,22 @@ without any article massaging functions being run." (gnus-newsgroup-ignored-charsets 'gnus-all)) (gnus-summary-select-article nil 'force) (let ((deps gnus-newsgroup-dependencies) - head header) + head header lines) (save-excursion (set-buffer gnus-original-article-buffer) (save-restriction (message-narrow-to-head) - (setq head (buffer-string))) + (setq head (buffer-string)) + (goto-char (point-min)) + (unless (re-search-forward "^lines:[ \t]\\([0-9]+\\)" nil t) + (goto-char (point-max)) + (widen) + (setq lines (1- (count-lines (point) (point-max)))))) (with-temp-buffer (insert (format "211 %d Article retrieved.\n" (cdr gnus-article-current))) (insert head) + (if lines (insert (format "Lines: %d\n" lines))) (insert ".\n") (let ((nntp-server-buffer (current-buffer))) (setq header (car (gnus-get-newsgroup-headers deps t)))))) diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el index 8b4f687..e2246d4 100644 --- a/lisp/gnus-util.el +++ b/lisp/gnus-util.el @@ -1207,6 +1207,38 @@ sure of changing the value of `foo'." If you find some problem with the directory separator character, try \"[/\\\\\]\" for some systems.") +(defun gnus-url-unhex (x) + (if (> x ?9) + (if (>= x ?a) + (+ 10 (- x ?a)) + (+ 10 (- x ?A))) + (- x ?0))) + +(defun gnus-url-unhex-string (str &optional allow-newlines) + "Remove %XXX embedded spaces, etc in a url. +If optional second argument ALLOW-NEWLINES is non-nil, then allow the +decoding of carriage returns and line feeds in the string, which is normally +forbidden in URL encoding." + (setq str (or (mm-subst-char-in-string ?+ ? str) "")) + (let ((tmp "") + (case-fold-search t)) + (while (string-match "%[0-9a-f][0-9a-f]" str) + (let* ((start (match-beginning 0)) + (ch1 (gnus-url-unhex (elt str (+ start 1)))) + (code (+ (* 16 ch1) + (gnus-url-unhex (elt str (+ start 2)))))) + (setq tmp (concat + tmp (substring str 0 start) + (cond + (allow-newlines + (char-to-string code)) + ((or (= code ?\n) (= code ?\r)) + " ") + (t (char-to-string code)))) + str (substring str (match-end 0))))) + (setq tmp (concat tmp str)) + tmp)) + (provide 'gnus-util) ;;; gnus-util.el ends here diff --git a/lisp/lpath.el b/lisp/lpath.el index 5a7299b..3d50f72 100644 --- a/lisp/lpath.el +++ b/lisp/lpath.el @@ -13,6 +13,7 @@ (maybe-fbind '(babel-fetch babel-wash create-image decode-coding-string display-graphic-p + replace-regexp-in-string bbdb-complete-name display-time-event-handler find-image font-create-object gnus-mule-get-coding-system @@ -70,6 +71,7 @@ make-overlay mouse-minibuffer-check mouse-movement-p mouse-scroll-subr overlay-buffer overlay-end overlay-get overlay-lists overlay-put + overlays-in overlay-start posn-point posn-window read-event read-event run-with-idle-timer set-buffer-multibyte set-char-table-range @@ -114,15 +116,15 @@ (let ((functions-variables (cond ((featurep 'xemacs) - '((replace-regexp-in-string))) + nil) ((>= emacs-major-version 21) '((function-max-args smiley-encode-buffer))) ((boundp 'MULE) '((coding-system-get compose-mail file-name-extension find-coding-systems-for-charsets find-coding-systems-region - function-max-args get-charset-property replace-regexp-in-string - shell-command-to-string smiley-encode-buffer))) + function-max-args get-charset-property shell-command-to-string + smiley-encode-buffer))) (t '((function-max-args smiley-encode-buffer)))))) (maybe-fbind (car functions-variables)) diff --git a/lisp/mm-url.el b/lisp/mm-url.el index fb86298..ba32df4 100644 --- a/lisp/mm-url.el +++ b/lisp/mm-url.el @@ -251,7 +251,11 @@ 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)) - (url-insert-file-contents url))) + (require 'url-handlers) + (let ((name buffer-file-name)) + (prog1 + (url-insert-file-contents url) + (setq buffer-file-name name))))) (defun mm-url-insert-file-contents-external (url) (let (program args) @@ -266,19 +270,17 @@ This is taken from RFC 2396.") (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))) + (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))) (defun mm-url-decode-entities () "Decode all HTML entities." @@ -296,6 +298,11 @@ If FOLLOW-REFRESH is non-nil, redirect refresh url in META." (setq elem (char-to-string elem))) (replace-match elem t t)))) +(defun mm-url-decode-entities-nbsp () + "Decode all HTML entities and   to a space." + (let ((mm-url-html-entities (cons '(nbsp . 32) mm-url-html-entities))) + (mm-url-decode-entities))) + (defun mm-url-decode-entities-string (string) (with-temp-buffer (insert string) @@ -327,6 +334,46 @@ spaces. Die Die Die." chunk) "")) +(defun mm-url-encode-www-form-urlencoded (pairs) + "Return PAIRS encoded for forms." + (mapconcat + (lambda (data) + (concat (mm-url-form-encode-xwfu (car data)) "=" + (mm-url-form-encode-xwfu (cdr data)))) + pairs "&")) + +(defun mm-url-fetch-form (url pairs) + "Fetch a form from URL with PAIRS as the data using the POST method." + (require 'url-handlers) + (let ((url-request-data (mm-url-encode-www-form-urlencoded pairs)) + (url-request-method "POST") + (url-request-extra-headers + '(("Content-type" . "application/x-www-form-urlencoded")))) + (url-insert-file-contents url) + (setq buffer-file-name nil)) + t) + +(defun mm-url-fetch-simple (url content) + (require 'url-handlers) + (let ((url-request-data content) + (url-request-method "POST") + (url-request-extra-headers + '(("Content-type" . "application/x-www-form-urlencoded")))) + (url-insert-file-contents url) + (setq buffer-file-name nil)) + t) + +(defun mm-url-remove-markup () + "Remove all HTML markup, leaving just plain text." + (goto-char (point-min)) + (while (search-forward "" nil t) + (point-max)))) + (goto-char (point-min)) + (while (re-search-forward "<[^>]+>" nil t) + (replace-match "" t t))) + (provide 'mm-url) ;;; mm-url.el ends here diff --git a/lisp/nnheader.el b/lisp/nnheader.el index 8e641a4..3850d1e 100644 --- a/lisp/nnheader.el +++ b/lisp/nnheader.el @@ -1183,24 +1183,31 @@ find-file-hooks, etc. (message "%s(Y/n) Yes" prompt) t))) -(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)) +(eval-and-compile + (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)))) (when (featurep 'xemacs) (require 'nnheaderxm)) diff --git a/lisp/nnlistserv.el b/lisp/nnlistserv.el index bcbbf80..3098bf0 100644 --- a/lisp/nnlistserv.el +++ b/lisp/nnlistserv.el @@ -24,18 +24,13 @@ ;;; Commentary: -;; Note: You need to have `url' and `w3' installed for this -;; backend to work. - ;;; Code: (eval-when-compile (require 'cl)) (require 'nnoo) -(eval-when-compile - (ignore-errors - (require 'nnweb)) ; requires W3 - (autoload 'url-insert-file-contents "nnweb")) +(require 'mm-url) +(require 'nnweb) (nnoo-declare nnlistserv nnweb) @@ -98,7 +93,7 @@ (when (funcall (nnweb-definition 'search) page) ;; Go through all the article hits on this page. (goto-char (point-min)) - (nnweb-decode-entities) + (mm-url-decode-entities) (goto-char (point-min)) (while (re-search-forward "^
  • *\\([^\\>]+\\) *<[^>]+>\\([^>]+\\)<" nil t) (setq url (match-string 1) @@ -124,7 +119,7 @@ (let ((case-fold-search t) (headers '(sent name email subject id)) sent name email subject id) - (nnweb-decode-entities) + (mm-url-decode-entities) (while headers (goto-char (point-min)) (re-search-forward (format "" nil t) - (point-max)))) - (goto-char (point-min)) - (while (re-search-forward "<[^>]+>" nil t) - (replace-match "" t t))) - -(defun nnweb-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)) - (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)) - (nnweb-insert url t)))) - (url-insert-file-contents url)) - (setq buffer-file-name name))) - (defun nnweb-parse-find (type parse &optional maxdepth) "Find the element of TYPE in PARSE." (catch 'found diff --git a/lisp/nnwfm.el b/lisp/nnwfm.el index eb29f0c..b361c6d 100644 --- a/lisp/nnwfm.el +++ b/lisp/nnwfm.el @@ -37,11 +37,9 @@ (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) +(require 'nnweb) +(autoload 'w3-parse-buffer "w3-parse") (nnoo-declare nnwfm) @@ -117,7 +115,7 @@ (erase-buffer) (setq subject (nth 2 (assq (car elem) topics)) thread-id (nth 0 (assq (car elem) topics))) - (nnweb-insert + (mm-url-insert (concat nnwfm-address (format "Item.asp?GroupID=%d&ThreadID=%d" sid thread-id))) @@ -217,7 +215,7 @@ (deffoo nnwfm-request-list (&optional server) (nnwfm-possibly-change-server nil server) (mm-with-unibyte-buffer - (nnweb-insert + (mm-url-insert (if (string-match "/$" nnwfm-address) (concat nnwfm-address "Group.asp") nnwfm-address)) @@ -280,7 +278,7 @@ (while furls (erase-buffer) (push (car furls) fetched-urls) - (nnweb-insert (pop furls)) + (mm-url-insert (pop furls)) (goto-char (point-min)) (while (re-search-forward " wr(" nil t) (forward-char -1) @@ -300,12 +298,13 @@ (when (re-search-forward "href=\"\\(Thread.*DateLast=\\([^\"]+\\)\\)" nil t) (setq url (match-string 1) - time (nnwfm-date-to-time (url-unhex-string (match-string 2)))) + time (nnwfm-date-to-time (gnus-url-unhex-string + (match-string 2)))) (when (and (nnwfm-new-threads-p group time) (not (member (setq url (concat nnwfm-address - (nnweb-decode-entities-string url))) + (mm-url-decode-entities-string url))) fetched-urls))) (push url furls)))) ;; The main idea here is to map Gnus article numbers to diff --git a/lisp/webmail.el b/lisp/webmail.el index 0bd06e6..ab82462 100644 --- a/lisp/webmail.el +++ b/lisp/webmail.el @@ -48,21 +48,16 @@ (require 'gnus) (require 'nnmail) (require 'mm-util) +(require 'mm-url) (require 'mml) (eval-when-compile (ignore-errors - (require 'w3) (require 'url) - (require 'url-cookie) - (require 'w3-forms) - (require 'nnweb))) + (require 'url-cookie))) ;; Report failure to find w3 at load time if appropriate. (eval '(progn - (require 'w3) (require 'url) - (require 'url-cookie) - (require 'w3-forms) - (require 'nnweb))) + (require 'url-cookie))) ;;; @@ -226,31 +221,6 @@ (set (intern (concat "webmail-" (symbol-name var))) (cdr pair)) (set (intern (concat "webmail-" (symbol-name var))) nil))))) -(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) - (defun webmail-eval (expr) (cond ((consp expr) @@ -265,15 +235,15 @@ (cond ((eq (car xurl) 'content) (pop xurl) - (webmail-fetch-simple (if (stringp (car xurl)) + (mm-url-fetch-simple (if (stringp (car xurl)) (car xurl) (apply 'format (webmail-eval (car xurl)))) (apply 'format (webmail-eval (cdr xurl))))) ((eq (car xurl) 'post) (pop xurl) - (webmail-fetch-form (car xurl) (webmail-eval (cdr xurl)))) + (mm-url-fetch-form (car xurl) (webmail-eval (cdr xurl)))) (t - (nnweb-insert (apply 'format (webmail-eval xurl))))))) + (mm-url-insert (apply 'format (webmail-eval xurl))))))) (defun webmail-init () "Initialize buffers and such." @@ -315,7 +285,7 @@ (let ((url (match-string 1))) (erase-buffer) (mm-with-unibyte-current-buffer - (nnweb-insert url))) + (mm-url-insert url))) (goto-char (point-min)))) (defun webmail-fetch (file subtype user password) @@ -357,7 +327,7 @@ (message "Fetching mail #%d..." (setq n (1+ n))) (erase-buffer) (mm-with-unibyte-current-buffer - (nnweb-insert (cdr item))) + (mm-url-insert (cdr item))) (setq id (car item)) (if webmail-article-snarf (funcall webmail-article-snarf file id)) @@ -459,9 +429,8 @@ (if (not (search-forward "" nil t)) (webmail-error "article@3.1")) (delete-region (match-beginning 0) (point-max)) - (nnweb-remove-markup) - (let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities))) - (nnweb-decode-entities)) + (mm-url-remove-markup) + (mm-url-decode-entities-nbsp) (goto-char (point-min)) (while (re-search-forward "\r\n?" nil t) (replace-match "\n")) @@ -492,9 +461,8 @@ (setq p (match-beginning 0)) (search-forward "" nil t) (delete-region p (match-end 0))) - (nnweb-remove-markup) - (let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities))) - (nnweb-decode-entities)) + (mm-url-remove-markup) + (mm-url-decode-entities-nbsp) (goto-char (point-min)) (delete-blank-lines) (goto-char (point-min)) @@ -514,7 +482,7 @@ (delete-region p (match-end 0)) (save-excursion (set-buffer (generate-new-buffer " *webmail-att*")) - (nnweb-insert attachment) + (mm-url-insert attachment) (push (current-buffer) webmail-buffer-list) (setq bufname (buffer-name))) (setq mime t) @@ -549,9 +517,8 @@ (goto-char (match-end 0)) (if (looking-at "$") (forward-char)) (delete-region (point-min) (point)) - (nnweb-remove-markup) - (let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities))) - (nnweb-decode-entities)) + (mm-url-remove-markup) + (mm-url-decode-entities-nbsp) nil) (t (setq mime t) @@ -646,9 +613,8 @@ (setq p (match-beginning 0)) (search-forward "" nil t) (delete-region p (match-end 0))) - (nnweb-remove-markup) - (let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities))) - (nnweb-decode-entities)) + (mm-url-remove-markup) + (mm-url-decode-entities-nbsp) (goto-char (point-min)) (delete-blank-lines) (goto-char (point-max)) @@ -664,9 +630,8 @@ (if (not (search-forward "" nil t)) (webmail-error "article@5")) (narrow-to-region p (match-end 0)) - (nnweb-remove-markup) - (let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities))) - (nnweb-decode-entities)) + (mm-url-remove-markup) + (mm-url-decode-entities-nbsp) (goto-char (point-min)) (delete-blank-lines) (setq ct (mail-fetch-field "content-type") @@ -679,7 +644,7 @@ (widen) (save-excursion (set-buffer (generate-new-buffer " *webmail-att*")) - (nnweb-insert (concat webmail-aux attachment)) + (mm-url-insert (concat webmail-aux attachment)) (push (current-buffer) webmail-buffer-list) (setq bufname (buffer-name))) (insert "<#part") @@ -774,9 +739,8 @@ (goto-char (point-min)) (while (re-search-forward "
    " nil t) (replace-match "\n")) - (nnweb-remove-markup) - (let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities))) - (nnweb-decode-entities)) + (mm-url-remove-markup) + (mm-url-decode-entities-nbsp) nil) (t (insert "<#part type=\"text/html\" disposition=inline>") @@ -804,9 +768,8 @@ (goto-char (point-min)) (while (search-forward "" nil t) (replace-match "\n")) - (nnweb-remove-markup) - (let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities))) - (nnweb-decode-entities)) + (mm-url-remove-markup) + (mm-url-decode-entities-nbsp) (goto-char (point-min)) (delete-blank-lines) (goto-char (point-min)) @@ -848,7 +811,7 @@ (let (bufname);; Attachment (save-excursion (set-buffer (generate-new-buffer " *webmail-att*")) - (nnweb-insert (concat (car webmail-open-url) attachment)) + (mm-url-insert (concat (car webmail-open-url) attachment)) (push (current-buffer) webmail-buffer-list) (setq bufname (buffer-name))) (insert "<#part type=" type) @@ -932,9 +895,8 @@ (goto-char (point-min)) (while (search-forward "" nil t) (replace-match "\n")) - (nnweb-remove-markup) - (let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities))) - (nnweb-decode-entities)) + (mm-url-remove-markup) + (mm-url-decode-entities-nbsp) (goto-char (point-min)) (delete-blank-lines) (goto-char (point-min)) @@ -976,7 +938,7 @@ (let (bufname);; Attachment (save-excursion (set-buffer (generate-new-buffer " *webmail-att*")) - (nnweb-insert (concat (car webmail-open-url) attachment)) + (mm-url-insert (concat (car webmail-open-url) attachment)) (push (current-buffer) webmail-buffer-list) (setq bufname (buffer-name))) (insert "<#part type=" type) @@ -1056,7 +1018,7 @@ (let ((url (match-string 1))) (setq base (match-string 2)) (erase-buffer) - (nnweb-insert url))) + (mm-url-insert url))) (goto-char (point-min)) (when (re-search-forward "(\\([0-9]+\\) Message.?-[^>]*\\([0-9]+\\) New" @@ -1093,9 +1055,8 @@ (match-beginning 0) (point-max))) (goto-char (point-min)) - (nnweb-remove-markup) - (let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities))) - (nnweb-decode-entities)) + (mm-url-remove-markup) + (mm-url-decode-entities-nbsp) (goto-char (point-max)))) ((looking-at "[\t\040\r\n]* + + * gnus.texi (Expiring Mail): Add. + 2001-12-05 Kai Gro,A_(Bjohann * gnus.texi (Splitting in IMAP): Typo. From Colin Marquardt diff --git a/texi/gnus-ja.texi b/texi/gnus-ja.texi index 4238f38..ebc17d8 100644 --- a/texi/gnus-ja.texi +++ b/texi/gnus-ja.texi @@ -12449,6 +12449,27 @@ Gnus $B$O5-;v$,$I$N%0%k!<%W$KB0$7$F$$$k$+$K4p$E$$$F!"$=$l$,$I$N$/$i$$@8B8(B (setq nnmail-expiry-target "nnml:expired") @end lisp +@findex nnmail-fancy-expiry-target +@vindex nnmail-fancy-expiry-targets +gnus $B$K$OJQ?t(B @code{nnmail-fancy-expiry-targets} $B$K=>$C$F%a!<%k$r4|8B@Z(B +$B$l>C5n$9$k$?$a$N4X?t(B @code{nnmail-fancy-expiry-target} $B$,$"$j$^$9!#$3$l(B +$B$ONc$G$9(B: + +@lisp + (setq nnmail-expiry-target 'nnmail-fancy-expiry-target + nnmail-fancy-expiry-targets + '((to-from "boss" "nnfolder:Work") + ("subject" "IMPORTANT" "nnfolder:IMPORTANT.%Y.%b") + ("from" ".*" "nnfolder:Archive-%Y"))) +@end lisp + +$B$3$N@_Dj$K$h$C$F!"BjL>$K(B @code{IMPORTANT} $B$r;}$A!"(B +@code{YYYY} $BG/(B @code{MMM} $B7n$KH/?.$5$l$?$$$+$J$k%a!<%k$b!"%0%k!<(B +$B%W(B @code{nnfolder:IMPORTANT.YYYY.MMM} $B$K4|8B@Z$l>C5n(B ($BLuCm(B: $BC5n$5$l$^$9!#$=$l0J30$N$9$Y$F$N(B +$B%a!<%k$O(B @code{nnfolder:Archive-YYYY} $B$K4|8B@Z$l>C5n$5$l$^$9!#(B + @vindex nnmail-keep-last-article @code{nnmail-keep-last-article} $B$,(B @code{nil} $B$G$J$$$H!"(Bgnus $B$O%a!<%k%K%e!<(B $B%9%0%k!<%W$N:G8e$N5-;v$r7h$7$F4|8B@Z$l>C5n$7$^$;$s!#$3$l$O(B procmail $B$NMx(B diff --git a/texi/gnus.texi b/texi/gnus.texi index 68295df..ca0e1c6 100644 --- a/texi/gnus.texi +++ b/texi/gnus.texi @@ -13049,6 +13049,26 @@ Here's an example for specifying a group name: (setq nnmail-expiry-target "nnml:expired") @end lisp +@findex nnmail-fancy-expiry-target +@vindex nnmail-fancy-expiry-targets +Gnus provides a function @code{nnmail-fancy-expiry-target} which will +expire mail to groups according to the variable +@code{nnmail-fancy-expiry-targets}. Here's an example: + +@lisp + (setq nnmail-expiry-target 'nnmail-fancy-expiry-target + nnmail-fancy-expiry-targets + '((to-from "boss" "nnfolder:Work") + ("subject" "IMPORTANT" "nnfolder:IMPORTANT.%Y.%b") + ("from" ".*" "nnfolder:Archive-%Y"))) +@end lisp + +With this setup, any mail that has @code{IMPORTANT} in its Subject +header and was sent in the year @code{YYYY} and month @code{MMM}, will +get expired to the group @code{nnfolder:IMPORTANT.YYYY.MMM}. If its +From or To header contains the string @code{boss}, it will get expired +to @code{nnfolder:Work}. All other mail will get expired to +@code{nnfolder:Archive-YYYY}. @vindex nnmail-keep-last-article If @code{nnmail-keep-last-article} is non-@code{nil}, Gnus will never -- 1.7.10.4