From a526b7eba49c81420c8caed38c3bafe0e20cdecb Mon Sep 17 00:00:00 2001 From: yamaoka Date: Wed, 7 Jul 1999 21:54:19 +0000 Subject: [PATCH] Importing Pterodactyl Gnus v0.93. --- lisp/ChangeLog | 67 ++++++++++++++++++++++++++++++++++++++++++ lisp/gnus-agent.el | 11 +++---- lisp/gnus-art.el | 43 ++++++++++++--------------- lisp/gnus-mlspl.el | 56 ++++++++++++++++++----------------- lisp/gnus-score.el | 1 - lisp/gnus-srvr.el | 6 ++-- lisp/gnus-start.el | 4 +-- lisp/gnus-sum.el | 8 +++-- lisp/gnus-util.el | 3 +- lisp/gnus.el | 6 ++-- lisp/message.el | 9 +----- lisp/mm-decode.el | 58 ++++++++++++++++++++----------------- lisp/mm-util.el | 12 ++++++++ lisp/mm-uu.el | 82 +++++++++++++++++++++++++++++++++++++++++----------- lisp/mm-view.el | 2 +- lisp/mml.el | 26 +++++++++-------- lisp/nndraft.el | 7 +++-- lisp/nnmail.el | 62 +++++++++++++++++++-------------------- lisp/pop3.el | 39 +++++++++++++------------ texi/ChangeLog | 4 +++ texi/gnus.texi | 20 +++++++------ texi/message.texi | 6 ++-- 22 files changed, 335 insertions(+), 197 deletions(-) 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 dd15f05..b0a543c 100644 --- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -1364,13 +1364,14 @@ The following commands are available: history overview file histories elem art nov-file low info unreads marked article orig lowest highest) (save-excursion - (with-temp-buffer - (insert-file-contents file) - (gnus-active-to-gnus-format - nil (setq orig (gnus-make-hashtable - (count-lines (point-min) (point-max)))))) (setq overview (gnus-get-buffer-create " *expire overview*")) (while (setq gnus-command-method (pop methods)) + (with-temp-buffer + (insert-file-contents (gnus-agent-lib-file "active")) + (gnus-active-to-gnus-format + 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 dfc53fc..90505b8 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -818,13 +818,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. @@ -926,7 +919,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) @@ -1826,9 +1818,9 @@ should replace the \"Date:\" one, or should be added below it." (delete-region (progn (beginning-of-line) (point)) (progn (forward-line 1) (point)))) (setq newline nil)) - (if (re-search-forward tdate-regexp nil t) - (forward-line 1)) - (insert (article-make-date-line date type)) + (when (re-search-forward tdate-regexp nil t) + (forward-line 1)) + (insert (article-make-date-line date (or type 'ut))) (when newline (insert "\n") (forward-line -1)) @@ -2925,7 +2917,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." (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))) @@ -2946,7 +2938,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." (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) ""))) @@ -3081,7 +3073,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." (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) @@ -3100,8 +3092,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." (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) @@ -3137,7 +3128,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." (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." @@ -3204,9 +3195,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." (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) @@ -3233,7 +3222,15 @@ If ALL-HEADERS is non-nil, no headers are hidden." (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 @@ -3750,8 +3747,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) @@ -4463,7 +4458,7 @@ For example: ((eq pred 'or) (apply 'gnus-or (mapcar 'gnus-treat-predicate val))) ((eq pred 'and) - (apply 'gnus-and (mapcar 'gnus-tread-predicate val))) + (apply 'gnus-and (mapcar 'gnus-treat-predicate val))) ((eq pred 'not) (not (gnus-treat-predicate val))) ((eq pred 'typep) 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 f45c011..b9565bd 100644 --- a/lisp/gnus-score.el +++ b/lisp/gnus-score.el @@ -768,7 +768,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 a34d7c8..d3c68a3 100644 --- a/lisp/gnus-start.el +++ b/lisp/gnus-start.el @@ -369,7 +369,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) @@ -1828,7 +1828,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 ca9bc37..2b175b6 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -8936,8 +8936,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 @@ -9284,6 +9284,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 @@ -9316,7 +9318,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 45b2dd8..350926c 100644 --- a/lisp/gnus-util.el +++ b/lisp/gnus-util.el @@ -944,7 +944,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 113b27b..6aa4bf9 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -260,7 +260,7 @@ is restarted, and sometimes reloaded." :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) -(defconst gnus-version-number "0.92" +(defconst gnus-version-number "0.93" "Version number for this version of Gnus.") (defconst gnus-version (format "Pterodactyl Gnus v%s" gnus-version-number) @@ -1760,7 +1760,9 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") 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 7e4bbdb..7b4525c 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -861,14 +861,7 @@ The cdr of ech entry is a function for applying the face to a region.") "Coding system to encode outgoing mail.") (defvar message-draft-coding-system - (cond - ((not (fboundp 'coding-system-p)) nil) - ((coding-system-p 'emacs-mule) - (if (string-match "nt\\|windows" system-configuration) - 'emacs-mule-dos 'emacs-mule)) - ((memq 'escape-quoted (mm-get-coding-system-list)) 'escape-quoted) - ((coding-system-p 'no-conversion) 'no-conversion) - (t nil)) + mm-auto-save-coding-system "Coding system to compose mail.") ;;; Internal variables. diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el index d3c6b9c..8b5b91a 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 010d3f7..8d3ff3b 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 9f3d0e9..19e017a 100644 --- a/lisp/mm-view.el +++ b/lisp/mm-view.el @@ -63,7 +63,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/nndraft.el b/lisp/nndraft.el index 89bf608..196779f 100644 --- a/lisp/nndraft.el +++ b/lisp/nndraft.el @@ -30,6 +30,7 @@ (require 'gnus-start) (require 'nnmh) (require 'nnoo) +(require 'mm-util) (eval-when-compile (require 'cl) ;; This is just to shut up the byte-compiler. @@ -111,8 +112,10 @@ (when (and (file-exists-p newest) (let ((nnmail-file-coding-system (if (file-newer-than-file-p file auto) - 'binary - message-draft-coding-system))) + (if (equal group "drafts") + message-draft-coding-system + mm-text-coding-system) + mm-auto-save-coding-system))) (nnmail-find-file newest))) (save-excursion (set-buffer nntp-server-buffer) diff --git a/lisp/nnmail.el b/lisp/nnmail.el index 897df61..9af078b 100644 --- a/lisp/nnmail.el +++ b/lisp/nnmail.el @@ -1128,40 +1128,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 4b96978..7c745a8 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 @@ -85,23 +85,24 @@ 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 (point-min) (point-max) crashbox t '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 (point-min) (point-max) crashbox t '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) @@ -113,7 +114,7 @@ Returns the process associated with the connection." (get-buffer-create (format "trace of POP session to %s" mailhost))) (process) (coding-system-for-read 'binary) ;; because FSF Emacs 20 and - (coding-system-for-write 'binary) ;; XEmacs 20/1 are st00pid + (coding-system-for-write 'binary) ;; XEmacs 20 & 21 are st00pid ) (save-excursion (set-buffer process-buffer) 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.texi b/texi/gnus.texi index 7019b20..564d93c 100644 --- a/texi/gnus.texi +++ b/texi/gnus.texi @@ -1,7 +1,7 @@ @c \input texinfo @c -*-texinfo-*- @setfilename gnus -@settitle Pterodactyl Gnus 0.92 Manual +@settitle Pterodactyl Gnus 0.93 Manual @synindex fn cp @synindex vr cp @synindex pg cp @@ -319,7 +319,7 @@ into another language, under the above conditions for modified versions. @tex @titlepage -@title Pterodactyl Gnus 0.92 Manual +@title Pterodactyl Gnus 0.93 Manual @author by Lars Magne Ingebrigtsen @page @@ -355,7 +355,7 @@ can be gotten by any nefarious means you can think of---@sc{nntp}, local spool or your mbox file. All at the same time, if you want to push your luck. -This manual corresponds to Pterodactyl Gnus 0.92. +This manual corresponds to Pterodactyl Gnus 0.93. @end ifinfo @@ -7016,7 +7016,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 @@ -8461,7 +8461,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 @@ -8941,9 +8940,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 @@ -14136,7 +14138,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 diff --git a/texi/message.texi b/texi/message.texi index 0fbe349..c394868 100644 --- a/texi/message.texi +++ b/texi/message.texi @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @setfilename message -@settitle Pterodactyl Message 0.92 Manual +@settitle Pterodactyl Message 0.93 Manual @synindex fn cp @synindex vr cp @synindex pg cp @@ -42,7 +42,7 @@ into another language, under the above conditions for modified versions. @tex @titlepage -@title Pterodactyl Message 0.92 Manual +@title Pterodactyl Message 0.93 Manual @author by Lars Magne Ingebrigtsen @page @@ -83,7 +83,7 @@ Message mode buffers. * Key Index:: List of Message mode keys. @end menu -This manual corresponds to Pterodactyl Message 0.92. Message is +This manual corresponds to Pterodactyl Message 0.93. Message is distributed with the Gnus distribution bearing the same version number as this manual. -- 1.7.10.4