From: yamaoka Date: Wed, 7 Jul 1999 23:32:24 +0000 (+0000) Subject: Sync up with Pterodactyl Gnus v0.93. X-Git-Tag: et-gnus-6_11_07-00 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=193b0a084eb84d1514d725a3a11f0e85137510ad;p=elisp%2Fgnus.git- Sync up with Pterodactyl Gnus v0.93. --- diff --git a/ChangeLog b/ChangeLog index 9366f60..7ce5452 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,17 @@ +1999-07-07 Katsumi Yamaoka + + * lisp/gnus.el (gnus-version-number): Update to 6.11.07. + + * texi/{gnus.texi,gnus-ja.texi,ChangeLog}: Sync up with Pterodactyl + Gnus v0.93. + + * lisp/{pop3.el,nnmail.el,mml.el,mm-view.el,mm-uu.el,mm-util.el, + mm-decode.el,message.el,gnus-util.el,gnus-sum.el,gnus-start.el, + gnus-srvr.el,gnus-score.el,gnus-mlspl.el,gnus-art.el,gnus-agent.el, + ChangeLog}: Sync up with Pterodactyl Gnus v0.93. + + * README.T-gnus: Update for T-gnus 6.11.07. + 1999-07-06 Katsumi Yamaoka * lisp/gnus.el (gnus-version-number): Update to 6.11.06. diff --git a/README.T-gnus b/README.T-gnus index 793696a..bde2447 100644 --- a/README.T-gnus +++ b/README.T-gnus @@ -27,6 +27,6 @@ NEWS: * T-gnus 6.11 - this is based on Pterodactyl Gnus. - The latest T-gnus is T-gnus 6.11.06 (Based on pgnus-0.92). + The latest T-gnus is T-gnus 6.11.07 (Based on pgnus-0.93). It requires SEMI/WEMI-1.13, the latest FLIM-1.13, and the latest APEL (9.20 or later). diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 2633f89..826fa9f 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,70 @@ +Wed Jul 7 13:09:51 1999 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.93 is released. + +1999-07-07 10:41:11 Stainless Steel Rat + + * pop3.el: New version. + +1999-07-05 Simon Josefsson + + * gnus-srvr.el (gnus-browse-foreign-server): Use read. + +1999-07-07 10:37:26 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-mime-display-alternative): Do treatment. + +1999-07-06 Shenghuo ZHU + + * gnus-util.el (gnus-write-active-file): Use real name. + + * gnus-agent.el (gnus-agent-expire): Update active file + method by method. + +1999-07-06 Shenghuo ZHU + + * nndraft.el (nndraft-request-article): Use difference + coding-systems for queue and drafts. + + * gnus-sum.el (gnus-summary-setup-default-charset): Special-case + nndraft:drafts. + + * mm-util.el (mm-auto-save-coding-system): New coding system. + + * message.el (message-draft-coding-system): Use it. + +1999-07-06 Shenghuo ZHU + + * mm-uu.el: More customizable and less aggressive. + +1999-07-07 07:53:23 Lars Magne Ingebrigtsen + + * gnus-start.el (gnus-groups-to-gnus-format): Only gnus-active + when plugged. + + * mml.el (mml-generate-mime-1): Don't insert nofile files. + (mml-insert-mml-markup): Accept a nofile. + (mml-insert-mime): Insert nofile. + + * gnus-art.el (gnus-treat-strip-blank-lines): Removed. + + * mm-decode.el (mm-handle-media-type): New function. + (mm-handle-media-supertype): New function. + (mm-handle-media-subtype): New function. + Use new functions throughout. "/")) + +1999-05-18 03:03:50 Katsumi Yamaoka + + * gnus-art.el (gnus-treat-predicate): Typo. + +1999-07-07 06:21:36 Lars Magne Ingebrigtsen + + * gnus-score.el (gnus-summary-score-entry): Made un-interactive. + +1999-07-06 17:57:16 Lars Magne Ingebrigtsen + + * gnus-art.el (article-date-ut): UT! Default it! + Tue Jul 6 10:59:24 1999 Lars Magne Ingebrigtsen * gnus.el: Pterodactyl Gnus v0.92 is released. diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el index e2a20a3..9c366ef 100644 --- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -1370,8 +1370,9 @@ The following commands are available: (insert-file-contents-as-coding-system gnus-agent-file-coding-system (gnus-agent-lib-file "active")) (gnus-active-to-gnus-format - nil (setq orig (gnus-make-hashtable - (count-lines (point-min) (point-max)))))) + gnus-command-method + (setq orig (gnus-make-hashtable + (count-lines (point-min) (point-max)))))) (let ((expiry-hashtb (gnus-make-hashtable 1023))) (gnus-agent-open-history) (set-buffer diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 2ab7476..c43f496 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -842,13 +842,6 @@ See the manual for details." :group 'gnus-article-treat :type gnus-article-treat-custom) -(defcustom gnus-treat-strip-blank-lines nil - "Strip all blank lines. -Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." - :group 'gnus-article-treat - :type gnus-article-treat-custom) - (defcustom gnus-treat-overstrike t "Treat overstrike highlighting. Valid values are nil, t, `head', `last', an integer or a predicate. @@ -959,7 +952,6 @@ See the manual for details." gnus-article-strip-leading-blank-lines) (gnus-treat-strip-multiple-blank-lines gnus-article-strip-multiple-blank-lines) - (gnus-treat-strip-blank-lines gnus-article-strip-blank-lines) (gnus-treat-overstrike gnus-article-treat-overstrike) (gnus-treat-buttonize-head gnus-article-add-buttons-to-head) (gnus-treat-display-smileys gnus-smiley-display) @@ -3247,7 +3239,7 @@ value of the variable `gnus-show-mime' is non-nil." (gnus-treat-article nil id (1- (length gnus-article-mime-handles)) - (car (mm-handle-type handle)))))) + (mm-handle-media-type handle))))) (select-window window)))) (goto-char point) (delete-region (gnus-point-at-bol) (progn (forward-line 1) (point))) @@ -3268,7 +3260,7 @@ value of the variable `gnus-show-mime' is non-nil." (mail-content-type-get (mm-handle-disposition handle) 'filename) "")) - (gnus-tmp-type (car (mm-handle-type handle))) + (gnus-tmp-type (mm-handle-media-type handle)) (gnus-tmp-description (mail-decode-encoded-word-string (or (mm-handle-description handle) ""))) @@ -3403,7 +3395,7 @@ value of the variable `gnus-show-mime' is non-nil." (mapcar 'gnus-mime-display-part handles)) (defun gnus-mime-display-single (handle) - (let ((type (car (mm-handle-type handle))) + (let ((type (mm-handle-media-type handle)) (ignored gnus-ignored-mime-types) (not-attachment t) (move nil) @@ -3422,8 +3414,7 @@ value of the variable `gnus-show-mime' is non-nil." (or (mm-inlined-p handle) (mm-automatic-external-display-p type))) (setq display t) - (when (equal (car (split-string type "/")) - "text") + (when (equal (mm-handle-media-supertype handle) "text") (setq text t))) (let ((id (1+ (length gnus-article-mime-handle-alist)))) (push (cons id handle) gnus-article-mime-handle-alist) @@ -3459,7 +3450,7 @@ value of the variable `gnus-show-mime' is non-nil." (gnus-treat-article nil (length gnus-article-mime-handle-alist) (1- (length gnus-article-mime-handles)) - (car (mm-handle-type handle)))))))))) + (mm-handle-media-type handle))))))))) (defun gnus-unbuttonized-mime-type-p (type) "Say whether TYPE is to be unbuttonized." @@ -3526,9 +3517,7 @@ value of the variable `gnus-show-mime' is non-nil." (progn (insert (format "(%c) %-18s" (if (equal handle preferred) ?* ? ) - (if (stringp (car handle)) - (car handle) - (car (mm-handle-type handle))))) + (mm-handle-media-type handle))) (point)) `(gnus-callback (lambda (handles) @@ -3555,7 +3544,15 @@ value of the variable `gnus-show-mime' is non-nil." (mail-parse-ignored-charsets (save-excursion (set-buffer gnus-summary-buffer) gnus-newsgroup-ignored-charsets))) - (mm-display-part preferred))) + (mm-display-part preferred) + ;; Do highlighting. + (save-excursion + (save-restriction + (narrow-to-region (car begend) (point-max)) + (gnus-treat-article + nil (length gnus-article-mime-handle-alist) + (1- (length gnus-article-mime-handles)) + (mm-handle-media-type handle)))))) (goto-char (point-max)) (setcdr begend (point-marker))))) (when ibegend @@ -4070,8 +4067,6 @@ groups." (set-buffer gnus-article-buffer) (gnus-article-edit-mode) (funcall start-func) - ;;(gnus-article-delete-text-of-type 'annotation) - ;;(gnus-set-text-properties (point-min) (point-max) nil) (gnus-configure-windows 'edit-article) (setq gnus-article-edit-done-function exit-func) (setq gnus-prev-winconf winconf) diff --git a/lisp/gnus-mlspl.el b/lisp/gnus-mlspl.el index 7582da4..eacdd13 100644 --- a/lisp/gnus-mlspl.el +++ b/lisp/gnus-mlspl.el @@ -1,4 +1,4 @@ -;;; gnus-mlsplt.el --- a group params-based mail splitting mechanism +;;; gnus-mlspl.el --- a group params-based mail splitting mechanism ;; Copyright (C) 1998,1999 Free Software Foundation, Inc. ;; Author: Alexandre Oliva @@ -24,58 +24,62 @@ (require 'gnus-group) (require 'nnmail) -(defvar gnus-mlsplt-updated-hook nil +(defvar gnus-mlsplit-updated-hook nil "Hook called just after nnmail-split-fancy is updated by -gnus-mlsplt-update") +gnus-mlsplit-update") -(defvar gnus-mlsplt-default-catch-all-group "mail.misc" - "Group used by gnus-mlsplt and -gnus-mlsplt-update as default catch-all group") +(defvar gnus-mlsplit-default-catch-all-group "mail.misc" + "Group used by gnus-mlsplit and +gnus-mlsplit-update as default catch-all group") -(defun gnus-mlsplt-setup (&optional auto-update catch-all) +;;;###autoload +(defun gnus-mlsplit-setup (&optional auto-update catch-all) "Sets things up so that nnmail-split-fancy is used for mail splitting, and defines the variable nnmail-split-fancy according with group parameters. if AUTO-UPDATE is non-nil (prefix argument accepted, if called interactive), makes sure nnmail-split-fancy is re-computed before getting new mail, -by adding gnus-mlsplt-update to nnmail-pre-get-new-mail-hook." +by adding gnus-mlsplit-update to nnmail-pre-get-new-mail-hook." (interactive "P") (setq nnmail-split-methods 'nnmail-split-fancy) (when catch-all - (setq gnus-mlsplt-default-catch-all-group catch-all)) - (gnus-mlsplt-update) + (setq gnus-mlsplit-default-catch-all-group catch-all)) + (gnus-mlsplit-update) (when auto-update - (add-hook 'nnmail-pre-get-new-mail-hook 'gnus-mlsplt-update))) + (add-hook 'nnmail-pre-get-new-mail-hook 'gnus-mlsplit-update))) -(defun gnus-mlsplt-update (&optional catch-all) +;;;###autoload +(defun gnus-mlsplit-update (&optional catch-all) "Computes nnmail-split-fancy from group params, by calling -\(gnus-mlsplt-fancy nil nil DEFAULTGROUP)" +\(gnus-mlsplit-fancy nil nil DEFAULTGROUP)" (interactive) (setq nnmail-split-fancy - (gnus-mlsplt-fancy - nil nil (or catch-all gnus-mlsplt-default-catch-all-group))) - (run-hooks 'gnus-mlsplt-updated-hook) + (gnus-mlsplit-fancy + nil nil (or catch-all gnus-mlsplit-default-catch-all-group))) + (run-hooks 'gnus-mlsplit-updated-hook) ) -(defun gnus-mlsplt () +;;;###autoload +(defun gnus-mlsplit () "Uses information from group parameters in order to split mail. -See gnus-mlsplt-fancy for more information. +See gnus-mlsplit-fancy for more information. If no group is defined as catch-all, the value of -gnus-mlsplt-default-catch-all-group is used. +gnus-mlsplit-default-catch-all-group is used. -gnus-mlsplt is a valid value for nnmail-split-methods." +gnus-mlsplit is a valid value for nnmail-split-methods." (let (nnmail-split-fancy) - (gnus-mlsplt-update - gnus-mlsplt-default-catch-all-group) + (gnus-mlsplit-update + gnus-mlsplit-default-catch-all-group) (nnmail-split-fancy))) -(defun gnus-mlsplt-fancy +;;;###autoload +(defun gnus-mlsplit-fancy (&optional groups no-crosspost catch-all) "Uses information from group parameters in order to split mail. It can be embedded into nnmail-split-fancy lists with the SPLIT -\(: gnus-mlsplt-fancy GROUPS NO-CROSSPOST CATCH-ALL\) +\(: gnus-mlsplit-fancy GROUPS NO-CROSSPOST CATCH-ALL\) GROUPS may be a regular expression or a list of group names, that will be used to select candidate groups. If it is ommited or nil, all @@ -112,7 +116,7 @@ nnml:mail.foo: nnml:mail.others: \((split-spec . catch-all)) -Calling (gnus-mlsplt-fancy nil nil \"mail.misc\") returns: +Calling (gnus-mlsplit-fancy nil nil \"mail.misc\") returns: \(| (& (any \"\\\\(bar@femail\\\\.com\\\\|.*@femail\\\\.com\\\\)\" \"nnml:mail.bar\") @@ -195,4 +199,4 @@ Calling (gnus-mlsplt-fancy nil nil \"mail.misc\") returns: (setq split (list '| split catch-all))) split)) -(provide 'gnus-mlsplt) +(provide 'gnus-mlspl) diff --git a/lisp/gnus-score.el b/lisp/gnus-score.el index 7baf55c..8a39075 100644 --- a/lisp/gnus-score.el +++ b/lisp/gnus-score.el @@ -802,7 +802,6 @@ used as score." (defun gnus-summary-score-entry (header match type score date &optional prompt silent extra) - (interactive) "Enter score file entry. HEADER is the header being scored. MATCH is the string we are looking for. diff --git a/lisp/gnus-srvr.el b/lisp/gnus-srvr.el index 0ae565a..7d15a9f 100644 --- a/lisp/gnus-srvr.el +++ b/lisp/gnus-srvr.el @@ -592,11 +592,9 @@ The following commands are available: (goto-char (point-min)) (unless (string= gnus-ignored-newsgroups "") (delete-matching-lines gnus-ignored-newsgroups)) - (while (re-search-forward - "\\(^[^ \t]+\\)[ \t]+[0-9]+[ \t]+[0-9]+" nil t) - (goto-char (match-end 1)) + (while (and (not (eobp)) (forward-line)) (ignore-errors - (push (cons (match-string 1) + (push (cons (read cur) (max 0 (- (1+ (read cur)) (read cur)))) groups))))) (setq groups (sort groups diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el index dc2a4e3..eca5c70 100644 --- a/lisp/gnus-start.el +++ b/lisp/gnus-start.el @@ -371,7 +371,7 @@ This hook is called as the first thing when Gnus is started." (defcustom gnus-after-getting-new-news-hook (when (gnus-boundp 'display-time-timer) '(display-time-event-handler)) - "*A hook run after Gnus checks for new news." + "*A hook run after Gnus checks for new news when Gnus is already running." :group 'gnus-group-new :type 'hook) @@ -1832,7 +1832,7 @@ newsgroup." (gnus-group-prefixed-name "" method)))) ;; Let the Gnus agent save the active file. - (if (and gnus-agent real-active) + (if (and gnus-agent real-active gnus-plugged) (progn (gnus-agent-save-groups method) (gnus-active-to-gnus-format method hashtb nil real-active)) diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 35dd853..4dd7d05 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -8957,8 +8957,8 @@ If REVERSE, save parts that do not match TYPE." (mapcar (lambda (h) (gnus-summary-save-parts-1 type dir h reverse)) (cdr handle)) (when (if reverse - (not (string-match type (car (mm-handle-type handle)))) - (string-match type (car (mm-handle-type handle)))) + (not (string-match type (mm-handle-media-type handle))) + (string-match type (mm-handle-media-type handle))) (let ((file (expand-file-name (file-name-nondirectory (or @@ -9431,6 +9431,8 @@ If REVERSE, save parts that do not match TYPE." (defun gnus-summary-setup-default-charset () "Setup newsgroup default charset." + (if (equal gnus-newsgroup-name "nndraft:drafts") + (setq gnus-newsgroup-charset nil) (let* ((name (and gnus-newsgroup-name (gnus-group-real-name gnus-newsgroup-name))) (ignored-charsets @@ -9463,7 +9465,7 @@ If REVERSE, save parts that do not match TYPE." charset))) gnus-default-charset)) (set (make-local-variable 'gnus-newsgroup-ignored-charsets) - ignored-charsets))) + ignored-charsets)))) ;;; ;;; Mime Commands diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el index 7adedd6..182cf17 100644 --- a/lisp/gnus-util.el +++ b/lisp/gnus-util.el @@ -988,7 +988,8 @@ ARG is passed to the first function." (boundp sym) (symbol-value sym)) (insert (format "%s %d %d y\n" - (symbol-name sym) (cdr (symbol-value sym)) + (gnus-group-real-name (symbol-name sym)) + (cdr (symbol-value sym)) (car (symbol-value sym)))))) hashtb)))) (defun gnus-write-active-file-as-coding-system (coding-system file hashtb) @@ -1000,7 +1001,8 @@ ARG is passed to the first function." (boundp sym) (symbol-value sym)) (insert (format "%s %d %d y\n" - (symbol-name sym) (cdr (symbol-value sym)) + (gnus-group-real-name (symbol-name sym)) + (cdr (symbol-value sym)) (car (symbol-value sym)))))) hashtb)))) ) diff --git a/lisp/gnus.el b/lisp/gnus.el index 2cb8c28..020aef3 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -266,13 +266,13 @@ is restarted, and sometimes reloaded." (defconst gnus-product-name "ET-gnus" "Product name of this version of gnus.") -(defconst gnus-version-number "6.11.06" +(defconst gnus-version-number "6.11.07" "Version number for this version of gnus.") (defconst gnus-revision-number "00" "Revision number for this version of gnus.") -(defconst gnus-original-version-number "0.92" +(defconst gnus-original-version-number "0.93" "Version number for this version of Gnus.") (provide 'running-pterodactyl-gnus-0_73-or-later) @@ -1814,7 +1814,9 @@ use the article treating faculties instead. Is is described in Info node gnus-unplugged gnus-agentize gnus-agent-batch) ("gnus-vm" :interactive t gnus-summary-save-in-vm gnus-summary-save-article-vm) - ("gnus-draft" :interactive t gnus-draft-mode gnus-group-send-drafts)))) + ("gnus-draft" :interactive t gnus-draft-mode gnus-group-send-drafts) + ("gnus-mlspl" gnus-mlsplit gnus-mlsplit-fancy) + ("gnus-mlspl" :interactive t gnus-mlsplit-setup gnus-mlsplit-update)))) ;;; gnus-sum.el thingies diff --git a/lisp/message.el b/lisp/message.el index 83d83b1..d21fe7b 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -1052,7 +1052,7 @@ The cdr of ech entry is a function for applying the face to a region.") ((boundp 'MULE) '*junet*) ((not (fboundp 'find-coding-system)) nil) ((find-coding-system 'emacs-mule) - (if (string-match "nt\\|windows" system-configuration) + (if (memq system-type '(windows-nt ms-dos ms-windows)) 'emacs-mule-dos 'emacs-mule)) ((find-coding-system 'escape-quoted) 'escape-quoted) ((find-coding-system 'no-conversion) 'no-conversion) diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el index 3edcf57..6c70505 100644 --- a/lisp/mm-decode.el +++ b/lisp/mm-decode.el @@ -34,6 +34,14 @@ `(nth 0 ,handle)) (defmacro mm-handle-type (handle) `(nth 1 ,handle)) +(defsubst mm-handle-media-type (handle) + (if (stringp (car handle)) + (car handle) + (car (mm-handle-type handle)))) +(defsubst mm-handle-media-supertype (handle) + (car (split-string (mm-handle-media-type handle) "/"))) +(defsubst mm-handle-media-subtype (handle) + (cadr (split-string (mm-handle-media-type handle) "/"))) (defmacro mm-handle-encoding (handle) `(nth 2 ,handle)) (defmacro mm-handle-undisplayer (handle) @@ -269,7 +277,7 @@ external if displayed external." (mailcap-parse-mailcaps) (if (mm-handle-displayed-p handle) (mm-remove-part handle) - (let* ((type (car (mm-handle-type handle))) + (let* ((type (mm-handle-media-type handle)) (method (mailcap-mime-info type))) (if (mm-inlined-p handle) (progn @@ -309,7 +317,7 @@ external if displayed external." (let ((mm (current-buffer)) (non-viewer (assoc "non-viewer" (mailcap-mime-info - (car (mm-handle-type handle)) t)))) + (mm-handle-media-type handle)) t))) (unwind-protect (if method (funcall method) @@ -324,7 +332,7 @@ external if displayed external." (mm-handle-disposition handle) 'filename)) (needsterm (assoc "needsterm" (mailcap-mime-info - (car (mm-handle-type handle)) t))) + (mm-handle-media-type handle)) t)) process file buffer) ;; We create a private sub-directory where we store our files. (make-directory dir) @@ -407,7 +415,7 @@ external if displayed external." (mm-handle-set-undisplayer handle nil)))) (defun mm-display-inline (handle) - (let* ((type (car (mm-handle-type handle))) + (let* ((type (mm-handle-media-type handle)) (function (cadr (assoc type mm-inline-media-tests)))) (funcall function handle) (goto-char (point-min)))) @@ -415,7 +423,7 @@ external if displayed external." (defun mm-inlinable-p (handle) "Say whether HANDLE can be displayed inline." (let ((alist mm-inline-media-tests) - (type (car (mm-handle-type handle))) + (type (mm-handle-media-type handle)) test) (while alist (when (equal type (caar alist)) @@ -428,7 +436,7 @@ external if displayed external." (defun mm-automatic-display-p (handle) "Say whether the user wants HANDLE to be displayed automatically." (let ((methods mm-automatic-display) - (type (car (mm-handle-type handle))) + (type (mm-handle-media-type handle)) method result) (while (setq method (pop methods)) (when (and (string-match method type) @@ -440,7 +448,7 @@ external if displayed external." (defun mm-inlined-p (handle) "Say whether the user wants HANDLE to be displayed automatically." (let ((methods mm-inlined-types) - (type (car (mm-handle-type handle))) + (type (mm-handle-media-type handle)) method result) (while (setq method (pop methods)) (when (and (string-match method type) @@ -452,7 +460,7 @@ external if displayed external." (defun mm-attachment-override-p (handle) "Say whether HANDLE should have attachment behavior overridden." (let ((types mm-attachment-override-types) - (type (car (mm-handle-type handle))) + (type (mm-handle-media-type handle)) ty) (catch 'found (while (setq ty (pop types)) @@ -495,13 +503,12 @@ external if displayed external." "Insert the contents of HANDLE in the current buffer." (let ((cur (current-buffer))) (save-excursion - (if (member (car (split-string (car (mm-handle-type handle)) "/")) - '("text" "message")) + (if (member (mm-handle-media-supertype handle) '("text" "message")) (with-temp-buffer (insert-buffer-substring (mm-handle-buffer handle)) (mm-decode-content-transfer-encoding (mm-handle-encoding handle) - (car (mm-handle-type handle))) + (mm-handle-media-type handle)) (let ((temp (current-buffer))) (set-buffer cur) (insert-buffer-substring temp))) @@ -509,7 +516,7 @@ external if displayed external." (insert-buffer-substring (mm-handle-buffer handle)) (mm-decode-content-transfer-encoding (mm-handle-encoding handle) - (car (mm-handle-type handle))) + (mm-handle-media-type handle)) (let ((temp (current-buffer))) (set-buffer cur) (insert-buffer-substring temp))))))) @@ -541,8 +548,7 @@ external if displayed external." ;; Now every coding system is 100% binary within mm-with-unibyte-buffer ;; Is text still special? (let ((coding-system-for-write - (if (equal "text" (car (split-string - (car (mm-handle-type handle)) "/"))) + (if (equal "text" (mm-handle-media-supertype handle)) buffer-file-coding-system 'binary)) ;; Don't re-compress .gz & al. Arguably we should make @@ -550,7 +556,7 @@ external if displayed external." ;; ange-ftp which it's reasonable to use here. (inhibit-file-name-operation 'write-region) (inhibit-file-name-handlers - (if (equal (car (mm-handle-type handle)) + (if (equal (mm-handle-media-type handle) "application/octet-stream") (cons 'jka-compr-handler inhibit-file-name-handlers) inhibit-file-name-handlers))) @@ -567,7 +573,7 @@ external if displayed external." (defun mm-interactively-view-part (handle) "Display HANDLE using METHOD." - (let* ((type (car (mm-handle-type handle))) + (let* ((type (mm-handle-media-type handle)) (methods (mapcar (lambda (i) (list (cdr (assoc 'viewer i)))) (mailcap-mime-info type 'all))) @@ -582,18 +588,15 @@ external if displayed external." (while (setq p (pop prec)) (setq h handles) (while h - (setq type - (if (stringp (caar h)) - (caar h) - (car (mm-handle-type (car h))))) (setq handle (car h)) + (setq type (mm-handle-media-type handle)) (when (and (equal p type) - (mm-automatic-display-p (car h)) - (or (stringp (caar h)) - (not (mm-handle-disposition (car h))) - (equal (car (mm-handle-disposition (car h))) + (mm-automatic-display-p handle) + (or (stringp (car handle)) + (not (mm-handle-disposition handle)) + (equal (car (mm-handle-disposition handle)) "inline"))) - (setq result (car h) + (setq result handle h nil prec nil)) (pop h))) @@ -602,7 +605,8 @@ external if displayed external." (defun mm-preferred-alternative-precedence (handles) "Return the precedence based on HANDLES and mm-discouraged-alternatives." (let ((seq (nreverse (mapcar (lambda (h) - (car (mm-handle-type h))) handles)))) + (mm-handle-media-type h)) + handles)))) (dolist (disc (reverse mm-discouraged-alternatives)) (dolist (elem (copy-sequence seq)) (when (string-match disc elem) @@ -615,7 +619,7 @@ external if displayed external." (defun mm-get-image (handle) "Return an image instance based on HANDLE." - (let ((type (cadr (split-string (car (mm-handle-type handle)) "/"))) + (let ((type (mm-handle-media-subtype handle)) spec) ;; Allow some common translations. (setq type diff --git a/lisp/mm-util.el b/lisp/mm-util.el index 161d2ca..0fa5e3c 100644 --- a/lisp/mm-util.el +++ b/lisp/mm-util.el @@ -118,6 +118,18 @@ (x-ctext . ctext)) "A mapping from invalid charset names to the real charset names.") +(defconst mm-auto-save-coding-system + (cond + ((memq 'emacs-mule (mm-get-coding-system-list)) + (if (memq system-type '(windows-nt ms-dos ms-windows)) + 'emacs-mule-dos 'emacs-mule)) + ((memq 'escape-quoted (mm-get-coding-system-list)) + 'escape-quoted) + ((memq 'no-conversion (mm-get-coding-system-list)) + 'no-conversion) + (t nil)) + "Coding system of auto save file.") + ;;; Internal variables: ;;; Functions: diff --git a/lisp/mm-uu.el b/lisp/mm-uu.el index e360071..c3991c3 100644 --- a/lisp/mm-uu.el +++ b/lisp/mm-uu.el @@ -51,29 +51,40 @@ (defconst mm-uu-postscript-begin-line "^%!PS-") (defconst mm-uu-postscript-end-line "^%%EOF$") -(defconst mm-uu-uu-begin-line "^begin[ \t]+[0-7][0-7][0-7][ \t]+\\(.*\\)$") +(defconst mm-uu-uu-begin-line "^begin[ \t]+[0-7][0-7][0-7][ \t]+") (defconst mm-uu-uu-end-line "^end[ \t]*$") -(defvar mm-uu-decode-function 'uudecode-decode-region) + +(defcustom mm-uu-decode-function 'uudecode-decode-region + "*Function to uudecode. +Internal function is done in elisp by default, therefore decoding may +appear to be horribly slow . You can make Gnus use the external Unix +decoder, such as uudecode." + :type '(choice (item :tag "internal" uudecode-decode-region) + (item :tag "external" uudecode-decode-region-external)) + :group 'gnus-article-mime) (defconst mm-uu-binhex-begin-line "^:...............................................................$") (defconst mm-uu-binhex-end-line ":$") -(defvar mm-uu-binhex-decode-function 'binhex-decode-region) + +(defcustom mm-uu-binhex-decode-function 'binhex-decode-region + "*Function to binhex decode. +Internal function is done in elisp by default, therefore decoding may +appear to be horribly slow . You can make Gnus use the external Unix +decoder, such as hexbin." + :type '(choice (item :tag "internal" binhex-decode-region) + (item :tag "external" binhex-decode-region-external)) + :group 'gnus-article-mime) (defconst mm-uu-shar-begin-line "^#! */bin/sh") -(defconst mm-uu-shar-end-line "^exit 0") +(defconst mm-uu-shar-end-line "^exit 0\\|^$") ;;; Thanks to Edward J. Sabol and ;;; Peter von der Ah\'e -(defconst mm-uu-forward-begin-line "^-+ \\(Start of \\)?Forwarded message") +(defconst mm-uu-forward-begin-line "^-+ \\(?:Start of \\)?Forwarded message") (defconst mm-uu-forward-end-line "^-+ End of forwarded message") -(defconst mm-uu-begin-line - (concat mm-uu-postscript-begin-line "\\|" - mm-uu-uu-begin-line "\\|" - mm-uu-binhex-begin-line "\\|" - mm-uu-shar-begin-line "\\|" - mm-uu-forward-begin-line)) +(defvar mm-uu-begin-line nil) (defconst mm-uu-identifier-alist '((?% . postscript) (?b . uu) (?: . binhex) (?# . shar) @@ -83,6 +94,39 @@ "The default disposition of uu parts. This can be either \"inline\" or \"attachment\".") +(defun mm-uu-configure-p (key val) + (member (cons key val) mm-uu-configure-list)) + +(defun mm-uu-configure (&optional symbol value) + (if symbol (set-default symbol value)) + (setq mm-uu-begin-line nil) + (mapcar '(lambda (type) + (if (mm-uu-configure-p type 'disabled) + nil + (setq mm-uu-begin-line + (concat mm-uu-begin-line + (if mm-uu-begin-line "\\|") + (symbol-value + (intern (concat "mm-uu-" (symbol-name type) + "-begin-line"))))))) + '(uu postscript binhex shar forward))) + +(defcustom mm-uu-configure-list nil + "A list of mm-uu configuration. +To disable dissecting shar codes, for instance, add +`(shar . disabled)' to this list." + :type '(repeat (cons + (choice (item postscript) + (item uu) + (item binhex) + (item shar) + (item forward)) + (choice (item disabled)))) + :group 'gnus-article-mime + :set 'mm-uu-configure) + +(mm-uu-configure) + ;;;### autoload (defun mm-uu-dissect () @@ -111,20 +155,22 @@ This can be either \"inline\" or \"attachment\".") (list (cons 'charset charset))))) (while (re-search-forward mm-uu-begin-line nil t) (setq start-char (match-beginning 0)) - (forward-line) ;; in case of failure - (setq start-char-1 (point)) (setq type (cdr (assq (aref (match-string 0) 0) mm-uu-identifier-alist))) (setq file-name - (if (eq type 'uu) + (if (and (eq type 'uu) + (looking-at "\\(.+\\)$")) (and (match-string 1) (let ((nnheader-file-name-translation-alist '((?/ . ?,) (? . ?_) (?* . ?_) (?$ . ?_)))) (nnheader-translate-file-chars (match-string 1)))))) + (forward-line) ;; in case of failure + (setq start-char-1 (point)) (setq end-line (symbol-value (intern (concat "mm-uu-" (symbol-name type) "-end-line")))) - (when (re-search-forward end-line nil t) + (when (and (re-search-forward end-line nil t) + (not (eq (match-beginning 0) (match-end 0)))) (setq end-char-1 (match-beginning 0)) (forward-line) (setq end-char (point)) @@ -191,14 +237,16 @@ This can be either \"inline\" or \"attachment\".") (forward-line) (let (type end-line result (case-fold-search t)) - (while (and (not result) (re-search-forward mm-uu-begin-line nil t)) + (while (and mm-uu-begin-line + (not result) (re-search-forward mm-uu-begin-line nil t)) (forward-line) (setq type (cdr (assq (aref (match-string 0) 0) mm-uu-identifier-alist))) (setq end-line (symbol-value (intern (concat "mm-uu-" (symbol-name type) "-end-line")))) - (if (re-search-forward end-line nil t) + (if (and (re-search-forward end-line nil t) + (not (eq (match-beginning 0) (match-end 0)))) (setq result t))) result))) diff --git a/lisp/mm-view.el b/lisp/mm-view.el index a4ef24e..c2131a7 100644 --- a/lisp/mm-view.el +++ b/lisp/mm-view.el @@ -66,7 +66,7 @@ (setq mm-w3-setup t))) (defun mm-inline-text (handle) - (let ((type (cadr (split-string (car (mm-handle-type handle)) "/"))) + (let ((type (mm-handle-media-subtype handle)) text buffer-read-only) (cond ((equal type "html") diff --git a/lisp/mml.el b/lisp/mml.el index f70efc6..286c8e4 100644 --- a/lisp/mml.el +++ b/lisp/mml.el @@ -207,7 +207,8 @@ (cond ((cdr (assq 'buffer cont)) (insert-buffer-substring (cdr (assq 'buffer cont)))) - ((setq filename (cdr (assq 'filename cont))) + ((and (setq filename (cdr (assq 'filename cont))) + (not (equal (cdr (assq 'nofile cont)) "yes"))) (mm-insert-file-contents filename)) (t (save-restriction @@ -226,7 +227,8 @@ (cond ((cdr (assq 'buffer cont)) (insert-buffer-substring (cdr (assq 'buffer cont)))) - ((setq filename (cdr (assq 'filename cont))) + ((and (setq filename (cdr (assq 'filename cont))) + (not (equal (cdr (assq 'nofile cont)) "yes"))) (mm-insert-file-contents filename)) (t (insert (cdr (assq 'contents cont))))) @@ -299,7 +301,8 @@ (cond ((cdr (assq 'buffer cont)) (insert-buffer-substring (cdr (assq 'buffer cont)))) - ((setq filename (cdr (assq 'filename cont))) + ((and (setq filename (cdr (assq 'filename cont))) + (not (equal (cdr (assq 'nofile cont)) "yes"))) (mm-insert-file-contents filename)) (t (insert (cdr (assq 'contents cont))))) @@ -434,15 +437,13 @@ (let (textp buffer) ;; Determine type and stuff. (unless (stringp (car handle)) - (unless (setq textp (equal - (car (split-string - (car (mm-handle-type handle)) "/")) - "text")) + (unless (setq textp (equal (mm-handle-media-supertype handle) + "text")) (save-excursion (set-buffer (setq buffer (generate-new-buffer " *mml*"))) (mm-insert-part handle)))) (unless no-markup - (mml-insert-mml-markup handle buffer)) + (mml-insert-mml-markup handle buffer textp)) (cond ((stringp (car handle)) (mapcar 'mml-insert-mime (cdr handle)) @@ -453,12 +454,12 @@ (t (insert "<#/part>\n"))))) -(defun mml-insert-mml-markup (handle &optional buffer) +(defun mml-insert-mml-markup (handle &optional buffer nofile) "Take a MIME handle and insert an MML tag." (if (stringp (car handle)) - (insert "<#multipart type=" (cadr (split-string (car handle) "/")) + (insert "<#multipart type=" (mm-handle-media-subtype handle) ">\n") - (insert "<#part type=" (car (mm-handle-type handle))) + (insert "<#part type=" (mm-handle-media-type handle)) (dolist (elem (append (cdr (mm-handle-type handle)) (cdr (mm-handle-disposition handle)))) (insert " " (symbol-name (car elem)) "=\"" (cdr elem) "\"")) @@ -466,9 +467,10 @@ (insert " disposition=" (car (mm-handle-disposition handle)))) (when buffer (insert " buffer=\"" (buffer-name buffer) "\"")) + (when nofile + (insert " nofile=yes")) (when (mm-handle-description handle) (insert " description=\"" (mm-handle-description handle) "\"")) - (equal (split-string (car (mm-handle-type handle)) "/") "text") (insert ">\n"))) (defun mml-insert-parameter (&rest parameters) diff --git a/lisp/nnmail.el b/lisp/nnmail.el index 2d5225f..7d98d8c 100644 --- a/lisp/nnmail.el +++ b/lisp/nnmail.el @@ -1127,40 +1127,40 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." (setq value (cdr (assq value nnmail-split-abbrev-alist)))) (while (and (goto-char end-point) (re-search-backward (cdr cached-pair) nil t)) - (when nnmail-split-tracing - (push (cdr cached-pair) nnmail-split-trace)) - (let ((split-rest (cddr split)) - (end (match-end 0)) - ;; The searched regexp is \(\(FIELD\).*\)\(VALUE\). So, - ;; start-of-value is the the point just before the - ;; beginning of the value, whereas after-header-name is - ;; the point just after the field name. - (start-of-value (match-end 1)) - (after-header-name (match-end 2))) + (when nnmail-split-tracing + (push (cdr cached-pair) nnmail-split-trace)) + (let ((split-rest (cddr split)) + (end (match-end 0)) + ;; The searched regexp is \(\(FIELD\).*\)\(VALUE\). So, + ;; start-of-value is the the point just before the + ;; beginning of the value, whereas after-header-name is + ;; the point just after the field name. + (start-of-value (match-end 1)) + (after-header-name (match-end 2))) ;; Start the next search just before the beginning of the ;; VALUE match. (setq end-point (1- start-of-value)) - ;; Handle - RESTRICTs - (while (eq (car split-rest) '-) - ;; RESTRICT must start after-header-name and - ;; end after start-of-value, so that, for - ;; (any "foo" - "x-foo" "foo.list") - ;; we do not exclude foo.list just because - ;; the header is: ``To: x-foo, foo'' - (goto-char end) - (if (and (re-search-backward (cadr split-rest) - after-header-name t) - (> (match-end 0) start-of-value)) - (setq split-rest nil) - (setq split-rest (cddr split-rest)))) - (when split-rest - (goto-char end) - (let ((value (nth 1 split))) - (if (symbolp value) - (setq value (cdr (assq value nnmail-split-abbrev-alist)))) - ;; Someone might want to do a \N sub on this match, so get the - ;; correct match positions. - (re-search-backward value start-of-value)) + ;; Handle - RESTRICTs + (while (eq (car split-rest) '-) + ;; RESTRICT must start after-header-name and + ;; end after start-of-value, so that, for + ;; (any "foo" - "x-foo" "foo.list") + ;; we do not exclude foo.list just because + ;; the header is: ``To: x-foo, foo'' + (goto-char end) + (if (and (re-search-backward (cadr split-rest) + after-header-name t) + (> (match-end 0) start-of-value)) + (setq split-rest nil) + (setq split-rest (cddr split-rest)))) + (when split-rest + (goto-char end) + (let ((value (nth 1 split))) + (if (symbolp value) + (setq value (cdr (assq value nnmail-split-abbrev-alist)))) + ;; Someone might want to do a \N sub on this match, so get the + ;; correct match positions. + (re-search-backward value start-of-value)) (dolist (sp (nnmail-split-it (car split-rest))) (unless (memq sp split-result) (push sp split-result)))))) diff --git a/lisp/pop3.el b/lisp/pop3.el index 6b3b2b0..bb0902a 100644 --- a/lisp/pop3.el +++ b/lisp/pop3.el @@ -1,6 +1,6 @@ ;;; pop3.el --- Post Office Protocol (RFC 1460) interface -;; Copyright (C) 1996,1997,1998 Free Software Foundation, Inc. +;; Copyright (C) 1996-1999 Free Software Foundation, Inc. ;; Author: Richard L. Pieri ;; Keywords: mail, pop3 @@ -94,24 +94,25 @@ Used for APOP authentication.") (pop3-pass process)) (t (error "Invalid POP3 authentication scheme."))) (setq message-count (car (pop3-stat process))) - (while (<= n message-count) - (message (format "Retrieving message %d of %d from %s..." - n message-count pop3-mailhost)) - (pop3-retr process n crashbuf) - (save-excursion - (set-buffer crashbuf) - (write-region-as-binary (point-min) (point-max) - crashbox 'append 'nomesg) - (set-buffer (process-buffer process)) - (while (> (buffer-size) 5000) - (goto-char (point-min)) - (forward-line 50) - (delete-region (point-min) (point)))) - (pop3-dele process n) - (setq n (+ 1 n)) - (if pop3-debug (sit-for 1) (sit-for 0.1)) - ) - (pop3-quit process) + (unwind-protect + (while (<= n message-count) + (message (format "Retrieving message %d of %d from %s..." + n message-count pop3-mailhost)) + (pop3-retr process n crashbuf) + (save-excursion + (set-buffer crashbuf) + (write-region-as-binary (point-min) (point-max) + crashbox 'append 'nomesg) + (set-buffer (process-buffer process)) + (while (> (buffer-size) 5000) + (goto-char (point-min)) + (forward-line 50) + (delete-region (point-min) (point)))) + (pop3-dele process n) + (setq n (+ 1 n)) + (if pop3-debug (sit-for 1) (sit-for 0.1)) + ) + (pop3-quit process)) (kill-buffer crashbuf) ) t) @@ -127,11 +128,13 @@ Returns the process associated with the connection." (erase-buffer) (setq pop3-read-point (point-min)) ) - (setq process - (cond ((eq pop3-connection-type 'ssl) - (pop3-open-ssl-stream "POP" process-buffer mailhost port)) - (t - (open-network-stream-as-binary "POP" process-buffer mailhost port)))) + (setq + process + (cond + ((eq pop3-connection-type 'ssl) + (pop3-open-ssl-stream "POP" process-buffer mailhost port)) + (t + (open-network-stream-as-binary "POP" process-buffer mailhost port)))) (let ((response (pop3-read-response process t))) (setq pop3-timestamp (substring response (or (string-match "<" response) 0) diff --git a/texi/ChangeLog b/texi/ChangeLog index 82e9ed7..893bd16 100644 --- a/texi/ChangeLog +++ b/texi/ChangeLog @@ -1,3 +1,7 @@ +1999-07-07 10:26:59 Robin S. Socha + + * gnus.texi (Scoring Tips): Typo. + 1999-07-06 11:41:59 Lars Magne Ingebrigtsen * gnus.texi (Mail Source Specifiers): Fix. diff --git a/texi/gnus-ja.texi b/texi/gnus-ja.texi index a196c04..fdae084 100644 --- a/texi/gnus-ja.texi +++ b/texi/gnus-ja.texi @@ -8302,9 +8302,11 @@ Gnus $B$O30$X=P$F9T$/A4$F$N%a%C%;!<%8$K!"0l$D$+$=$l0J>e$N$=$N%5!<%P!<$N%0%k!<( $B@-L>$OJ8;zNs$G$"$k;v$b$G$-$^$9!#$=$N>l9g$O!"$3$l$O%X%C%@!$H$7$F;H$o$l!"(B $B$=$NCM$,5-;v$N%X%C%@!<$KA^F~$5$l$^$9!#(B -$BB0@-CM$OJ8;zNs(B ($B$=$N$^$^;H$o$l$^$9(B)$B!"4X?t(B ($BJV$jCM$,;H$o$l$^$9(B)$B!"JQ?t(B ($B$=(B -$B$NCM$,;H$o$l$^$9(B)$B!"%j%9%H(B ($B$=$l$O(B @code{$BI>2A(B} $B$5$l$F!"JV$jCM$,;H$o$l$^$9(B) -$B$G$"$k;v$,$G$-$^$9!#(B +$BB0@-CM$OJ8;zNs(B ($B$=$N$^$^;H$o$l$^$9(B)$B!"0z?t$NL5$$4X?t(B ($BJV$jCM$,;H$o$l$^$9(B)$B!"(B +$BJQ?t(B ($B$=$NCM$,;H$o$l$^$9(B) $B$^$?$O%j%9%H(B ($B$=$l$O(B @code{$BI>2A(B} $B$5$l$F!"JV$j(B +$BCM$,;H$o$l$^$9(B) $B$G$"$k;v$,$G$-$^$9!#4X?t$O%;%C%H%"%C%W$5$l$?%a%C%;!<%8(B +$B%P%C%U%!$G8F$P$l(B (@code{eval} $B$5$l(B) $B$^$9!#8=:_$N5-;v$N%X%C%@!<$OJQ?t(B +@code{message-reply-headers} $B$+$iF@$i$l$^$9!#(B $B$b$7!":n@.$7$h$&$H$7$F$$$k%a%C%;!<%8$,%K%e!<%95-;v$+%a!<%k%a%C%;!<%8$G$"(B $B$k$+$rD4$Y$?$$$H$-$O!"(B2$B$D$N4X?t(B @code{message-news-p} $B$H(B diff --git a/texi/gnus.texi b/texi/gnus.texi index fdb7278..050776d 100644 --- a/texi/gnus.texi +++ b/texi/gnus.texi @@ -7023,7 +7023,7 @@ positives. @vindex gnus-signature-limit @code{gnus-signature-limit} provides a limit to what is considered a -signature. +signature when displaying articles. @enumerate @item @@ -8453,7 +8453,6 @@ group. @item gnus-treat-strip-trailing-blank-lines @item gnus-treat-strip-leading-blank-lines @item gnus-treat-strip-multiple-blank-lines -@item gnus-treat-strip-blank-lines @item gnus-treat-overstrike @item gnus-treat-display-xface @item gnus-treat-display-smileys @@ -8934,9 +8933,12 @@ attribute name can also be a string. In that case, this will be used as a header name, and the value will be inserted in the headers of the article. -The attribute value can be a string (used verbatim), a function (the -return value will be used), a variable (its value will be used) or a -list (it will be @code{eval}ed and the return value will be used). +The attribute value can be a string (used verbatim), a function with +zero arguments (the return value will be used), a variable (its value +will be used) or a list (it will be @code{eval}ed and the return value +will be used). The functions and sexps are called/@code{eval}ed in the +message buffer that is being set up. The headers of the current article +are available through the @code{message-reply-headers} variable. If you wish to check whether the message you are about to compose is meant to be a news article or a mail message, you can check the values @@ -14129,7 +14131,7 @@ will be fetched @emph{twice}. If you want to match a bit on the the matches. @item Marking as read -You will probably want to mark articles that has a score below a certain +You will probably want to mark articles that have scores below a certain number as read. This is most easily achieved by putting the following in your @file{all.SCORE} file: @lisp