From f3a70c238777ba00f8c692e76b7ba29d4e1ca585 Mon Sep 17 00:00:00 2001 From: ichikawa Date: Mon, 4 Jan 1999 06:49:14 +0000 Subject: [PATCH] Importing pgnus-0.69 --- lisp/ChangeLog | 136 ++++++++++++++++++++++++++++++++++++++++++++++++++++ lisp/binhex.el | 7 ++- lisp/gnus-agent.el | 14 +++++- lisp/gnus-art.el | 11 +++-- lisp/gnus-msg.el | 27 +++++------ lisp/gnus-picon.el | 16 +++++-- lisp/gnus-range.el | 76 ++++++++++++++++++++++++++--- lisp/gnus-uu.el | 5 +- lisp/gnus.el | 11 ++++- lisp/lpath.el | 12 +++-- lisp/mailcap.el | 8 +++- lisp/message.el | 127 +++++++++++++++++++++++++----------------------- lisp/mm-bodies.el | 4 +- lisp/mm-decode.el | 21 +++++--- lisp/mm-util.el | 6 +-- lisp/mm-uu.el | 14 ++++-- lisp/mm-view.el | 6 ++- lisp/nnmail.el | 9 +++- lisp/nnsoup.el | 13 ++--- lisp/rfc2047.el | 8 ++-- lisp/rfc2231.el | 3 +- lisp/uudecode.el | 5 +- texi/ChangeLog | 8 ++++ texi/gnus.texi | 24 ++++++++-- texi/message.texi | 6 +-- 25 files changed, 434 insertions(+), 143 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 1b2cead..2f08e83 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,139 @@ +Sun Jan 3 13:32:02 1999 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.69 is released. + +1999-01-03 06:45:10 Lars Magne Ingebrigtsen + + * gnus-picon.el (gnus-picons-setup-buffer): Run the hook. + + * gnus-agent.el (gnus-agent-remove-group): New command and + keystroke. + + * rfc2047.el (rfc2047-decode-region): Check for us-ascii. + +1999-01-02 14:12:41 Simon Josefsson + + * gnus-agent.el (gnus-agent-write-servers): Make directory. + +1998-12-26 02:38:01 Lars Magne Ingebrigtsen + + * mm-view.el (mm-inline-text): Bind current id. + + * mm-decode.el (mm-handle-id): New macro. + (mm-make-handle): Accept id. + (mm-dissect-singlepart): Use it. + +1998-12-23 Matt Pharr + + * message.el (message-cite-original-without-signature): Use + message-signature-separator when searching for signature in + message-cite-original-without-signature. + +1998-12-24 16:25:38 Simon Josefsson + + * gnus.el (gnus-server-to-method): Check named methods. + +1998-12-24 03:27:02 Lars Magne Ingebrigtsen + + * mm-view.el (mm-view-message): Goto point-min. + + * nnmail.el (nnmail-article-group): Don't delete lines, only + shorten them. + + * gnus-msg.el (gnus-configure-posting-styles): Also do nil + values. + + * nnheader.el (nnheader-temp-directory): New variable. + (nnheader-temp-directory): Removed. + +1998-12-22 Jack Vinson + + * mailcap.el (mailcap-parse-mailcaps): Add "~/.mailcaps" to the + list of files to check for mailcap entries under windows-nt. + +1998-12-24 03:02:15 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-article-maybe-hide-headers): Check whether the + summary buffer exists. + +1998-12-22 Aaron M. Ucko + + * nnsoup.el (nnsoup-store-reply): Remove code to deal with + irrelevant Sun sendmail bug. + (nnsoup-store-reply): Stop mucking with mail-header-separator. + + * message.el (message-send-news): Bind mail-header-separator to + "" when asking backend to post. + +1998-12-22 Karl Kleinpaste + + * mm-uu.el (mm-dissect-disposition): New variable. + (mm-uu-dissect): Use it. + +1998-12-21 21:34:22 Lars Magne Ingebrigtsen + + * mm-view.el (mm-inline-text): Bind url-current-object. + +1998-12-06 03:05:41 Simon Josefsson + + * gnus-range.el (gnus-remove-from-range): Rewrite. + +1998-12-09 SL Baur + + * gnus-picon.el (annotations): Remove bogus require 'xpm. + +1998-12-18 Hrvoje Niksic + + * message.el (message-encode-message-body): Insert `MIME-Version' + instead of `Mime-Version'. + +1998-12-04 Hrvoje Niksic + + * message.el (message-insert-mime-part): Add the attachment + disposition. + (message-insert-mime-part): Make TYPE and DESCRIPTION optional. + (message-mime-query-type): New function. + (message-mime-query-description): Ditto. + (message-mime-query-file): Ditto. + (message-insert-mime-part): Use them. + (message-mime-insert-external): Use the new stuff. + +1998-12-19 23:02:26 Lars Magne Ingebrigtsen + + * nnmail.el (nnmail-split-header-length-limit): New variable. + + * mm-decode.el (mm-dissect-buffer): Check syntax. + + * rfc2231.el (rfc2231-parse-string): Remove check for syntax. + + * rfc2047.el (rfc2047-encodable-p): Use mm-find-charset-region. + (rfc2047-dissect-region): Ditto. + +1998-12-17 18:36:43 Lars Magne Ingebrigtsen + + * mm-view.el (mm-view-message): Decode charset. + +1998-12-16 16:01:22 Lars Magne Ingebrigtsen + + * rfc2231.el (rfc2231-parse-string): Ignore syntactically invalid + CT headers. + +Wed Dec 16 01:44:40 1998 Shenghuo ZHU + + * mm-bodies.el (mm-decode-content-transfer-encoding): Use + mm-uu-*-function. + * mm-uu.el (mm-uu-dissect): Use x-uuencode. + +1998-12-16 10:20:52 Lars Magne Ingebrigtsen + + * message.el (message-send-mail): Do MML first. + (message-send-news): Ditto. + +1998-12-15 20:57:18 Lars Magne Ingebrigtsen + + * gnus-picon.el (gnus-picons-face): New face. + (gnus-picons-try-face): Use it. + Tue Dec 15 19:17:43 1998 Lars Magne Ingebrigtsen * gnus.el: Pterodactyl Gnus v0.68 is released. diff --git a/lisp/binhex.el b/lisp/binhex.el index 6d5a659..d2482aa 100644 --- a/lisp/binhex.el +++ b/lisp/binhex.el @@ -3,7 +3,7 @@ ;; Author: Shenghuo Zhu ;; Create Date: Oct 1, 1998 -;; $Revision: 1.1.1.4 $ +;; $Revision: 1.1.1.5 $ ;; Time-stamp: ;; Keywords: binhex @@ -63,7 +63,10 @@ input and write the converted data to its standard output.") "^[^:]...............................................................$") (defconst binhex-end-line ":$") -(defvar binhex-temporary-file-directory "/tmp/") +(defvar binhex-temporary-file-directory + (cond ((fboundp 'temp-directory) (temp-directory)) + ((boundp 'temporary-file-directory) temporary-file-directory) + ("/tmp/"))) (if (string-match "XEmacs" emacs-version) (defalias 'binhex-insert-char 'insert-char) diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el index d0d73b5..25675f4 100644 --- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -224,7 +224,8 @@ for download via the Agent.") "Jj" gnus-agent-toggle-plugged "Js" gnus-agent-fetch-session "JS" gnus-group-send-drafts - "Ja" gnus-agent-add-group) + "Ja" gnus-agent-add-group + "Jr" gnus-agent-remove-group) (defun gnus-agent-group-make-menu-bar () (unless (boundp 'gnus-agent-group-menu) @@ -400,6 +401,16 @@ be a select method." (setf (cadddr cat) (nconc (cadddr cat) groups)) (gnus-category-write))) +(defun gnus-agent-remove-group (arg) + "Remove the current group from its agent category, if any." + (interactive "P") + (let (c) + (gnus-group-iterate arg + (lambda (group) + (when (cadddr (setq c (gnus-group-category group))) + (setf (cadddr c) (delete group (cadddr c)))))) + (gnus-category-write))) + ;;; ;;; Server mode commands ;;; @@ -437,6 +448,7 @@ be a select method." (defun gnus-agent-write-servers () "Write the alist of covered servers." + (gnus-make-directory (nnheader-concat gnus-agent-directory "lib")) (with-temp-file (nnheader-concat gnus-agent-directory "lib/servers") (prin1 gnus-agent-covered-methods (current-buffer)))) diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 9a90823..db8a2ff 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -559,14 +559,13 @@ displayed by the first non-nil matching CONTENT face." ("\205" "...") ("\213" "<") ("\214" "OE") - ("\205" "...") ("\221" "`") ("\222" "'") ("\223" "``") ("\224" "''") ("\225" "*") ("\226" "-") - ("\227" "-") + ("\227" "-") ("\231" "(TM)") ("\233" ">") ("\234" "oe") @@ -2824,9 +2823,11 @@ If ALL-HEADERS is non-nil, no headers are hidden." (defun gnus-article-maybe-hide-headers () "Hide unwanted headers if `gnus-have-all-headers' is nil. Provided for backwards compatibility." - (or (save-excursion (set-buffer gnus-summary-buffer) gnus-have-all-headers) - gnus-inhibit-hiding - (gnus-article-hide-headers))) + (when (and (or (not (gnus-buffer-live-p gnus-summary-buffer)) + (not (save-excursion (set-buffer gnus-summary-buffer) + gnus-have-all-headers))) + (not gnus-inhibit-hiding)) + (gnus-article-hide-headers))) ;;; Article savers. diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index ebfa105..6cacd68 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -1125,21 +1125,20 @@ this is a reply." (set (make-local-variable variable) value-value) ;; This is either a body or a header to be inserted in the ;; message. - (when value-value - (let ((attr (car attribute))) - (make-local-variable 'message-setup-hook) - (if (eq 'body attr) - (add-hook 'message-setup-hook - `(lambda () - (save-excursion - (message-goto-body) - (insert ,value-value)))) + (let ((attr (car attribute))) + (make-local-variable 'message-setup-hook) + (if (eq 'body attr) (add-hook 'message-setup-hook - 'gnus-message-insert-stylings) - (push (cons (if (stringp attr) attr - (symbol-name attr)) - value-value) - gnus-message-style-insertions)))))))))))) + `(lambda () + (save-excursion + (message-goto-body) + (insert ,value-value)))) + (add-hook 'message-setup-hook + 'gnus-message-insert-stylings) + (push (cons (if (stringp attr) attr + (symbol-name attr)) + value-value) + gnus-message-style-insertions))))))))))) (defun gnus-message-insert-stylings () (let (val) diff --git a/lisp/gnus-picon.el b/lisp/gnus-picon.el index 1fd1f06..78f4e3d 100644 --- a/lisp/gnus-picon.el +++ b/lisp/gnus-picon.el @@ -26,7 +26,7 @@ ;;; Code: (require 'gnus) -(require 'xpm) +;; (require 'xpm) (require 'annotations) (require 'custom) (require 'gnus-art) @@ -148,6 +148,10 @@ please tell me so that we can list it." "Face to show xbm picons in." :group 'picons) +(defface gnus-picons-face '((t (:foreground "black" :background "white"))) + "Face to show picons in." + :group 'picons) + (defcustom gnus-picons-setup-hook nil "Hook run in Picons buffers." :group 'picons @@ -214,12 +218,15 @@ arguments necessary for the job.") (defun gnus-picons-setup-buffer () (let ((name (gnus-picons-buffer-name))) (save-excursion - (if (get-buffer name) + (if (and (get-buffer name) + (with-current-buffer name + (eq major-mode 'gnus-picons-mode))) (set-buffer name) (set-buffer (gnus-get-buffer-create name)) (buffer-disable-undo) (setq buffer-read-only t) (run-hooks 'gnus-picons-setup-hook) + (setq major-mode 'gnus-picons-mode) (add-hook 'gnus-summary-prepare-exit-hook 'gnus-picons-kill-buffer)) (current-buffer)))) @@ -476,8 +483,9 @@ none, and whose CDR is the corresponding element of DOMAINS." dir))) (setq suffixes nil glyph (make-glyph f)) - (when (equal suf "xbm") - (set-glyph-face glyph 'gnus-picons-xbm-face)) + (if (equal suf "xbm") + (set-glyph-face glyph 'gnus-picons-xbm-face) + (set-glyph-face glyph 'gnus-picons-face)) (push (cons key glyph) gnus-picons-glyph-alist))) glyph)) diff --git a/lisp/gnus-range.el b/lisp/gnus-range.el index 895505e..f05a83b 100644 --- a/lisp/gnus-range.el +++ b/lisp/gnus-range.el @@ -224,13 +224,75 @@ Note: LIST has to be sorted over `<'." (setq ranges (cdr ranges))) out))) -(defun gnus-remove-from-range (ranges list) - "Return a list of ranges that has all articles from LIST removed from RANGES. -Note: LIST has to be sorted over `<'." - ;; !!! This function shouldn't look like this, but I've got a headache. - (gnus-compress-sequence - (gnus-set-difference - (gnus-uncompress-range ranges) list))) +(defun gnus-remove-from-range (range1 range2) + "Return a range that has all articles from RANGE2 removed from +RANGE1. The returned range is always a list." + (if (or (null range1) (null range2)) + range1 + (let (out r1 r2 r1_min r1_max r2_min r2_max) + (setq range1 (if (listp (cdr range1)) range1 (list range1)) + range2 (if (listp (cdr range2)) range2 (list range2)) + r1 (car range1) + r2 (car range2) + r1_min (if (consp r1) (car r1) r1) + r1_max (if (consp r1) (cdr r1) r1) + r2_min (if (consp r2) (car r2) r2) + r2_max (if (consp r2) (cdr r2) r2)) + (while (and range1 range2) + (cond ((< r2_max r1_min) ; r2 < r1 + (pop range2) + (setq r2 (car range2) + r2_min (if (consp r2) (car r2) r2) + r2_max (if (consp r2) (cdr r2) r2))) + ((and (<= r2_min r1_min) (<= r1_max r2_max)) ; r2 overlap r1 + (pop range1) + (setq r1 (car range1) + r1_min (if (consp r1) (car r1) r1) + r1_max (if (consp r1) (cdr r1) r1))) + ((and (<= r2_min r1_min) (<= r2_max r1_max)) ; r2 overlap min r1 + (pop range2) + (setq r1_min (1+ r2_max) + r2 (car range2) + r2_min (if (consp r2) (car r2) r2) + r2_max (if (consp r2) (cdr r2) r2))) + ((and (<= r1_min r2_min) (<= r2_max r1_max)) ; r2 contained in r1 + (if (eq r1_min (1- r2_min)) + (push r1_min out) + (push (cons r1_min (1- r2_min)) out)) + (pop range2) + (if (< r2_max r1_max) ; finished with r1? + (setq r1_min (1+ r2_max)) + (pop range1) + (setq r1 (car range1) + r1_min (if (consp r1) (car r1) r1) + r1_max (if (consp r1) (cdr r1) r1))) + (setq r2 (car range2) + r2_min (if (consp r2) (car r2) r2) + r2_max (if (consp r2) (cdr r2) r2))) + ((and (<= r2_min r1_max) (<= r1_max r2_max)) ; r2 overlap max r1 + (if (eq r1_min (1- r2_min)) + (push r1_min out) + (push (cons r1_min (1- r2_min)) out)) + (pop range1) + (setq r1 (car range1) + r1_min (if (consp r1) (car r1) r1) + r1_max (if (consp r1) (cdr r1) r1))) + ((< r1_max r2_min) ; r2 > r1 + (pop range1) + (if (eq r1_min r1_max) + (push r1_min out) + (push (cons r1_min r1_max) out)) + (setq r1 (car range1) + r1_min (if (consp r1) (car r1) r1) + r1_max (if (consp r1) (cdr r1) r1))))) + (when r1 + (if (eq r1_min r1_max) + (push r1_min out) + (push (cons r1_min r1_max) out)) + (pop range1)) + (while range1 + (push (pop range1) out)) + (nreverse out)))) (defun gnus-member-of-range (number ranges) (if (not (listp (cdr ranges))) diff --git a/lisp/gnus-uu.el b/lisp/gnus-uu.el index 19f07a2..8744e86 100644 --- a/lisp/gnus-uu.el +++ b/lisp/gnus-uu.el @@ -216,7 +216,10 @@ Note that this variable can be used in conjunction with the ;; Various variables users may set -(defcustom gnus-uu-tmp-dir "/tmp/" +(defcustom gnus-uu-tmp-dir + (cond ((fboundp 'temp-directory) (temp-directory)) + ((boundp 'temporary-file-directory) temporary-file-directory) + ("/tmp/")) "*Variable saying where gnus-uu is to do its work. Default is \"/tmp/\"." :group 'gnus-extract diff --git a/lisp/gnus.el b/lisp/gnus.el index c7f303c..1332834 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -254,7 +254,7 @@ is restarted, and sometimes reloaded." :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) -(defconst gnus-version-number "0.68" +(defconst gnus-version-number "0.69" "Version number for this version of Gnus.") (defconst gnus-version (format "Pterodactyl Gnus v%s" gnus-version-number) @@ -2365,7 +2365,14 @@ that that variable is buffer-local to the summary buffers." (not (equal server (format "%s:%s" (caaar opened) (cadaar opened))))) (pop opened)) - (caar opened)))) + (caar opened)) + ;; It could be a named method, search all servers + (let ((servers gnus-secondary-select-methods)) + (while (and servers + (not (equal server (format "%s:%s" (caar servers) + (cadar servers))))) + (pop servers)) + (car servers)))) (defmacro gnus-method-equal (ss1 ss2) "Say whether two servers are equal." diff --git a/lisp/lpath.el b/lisp/lpath.el index 11a6030..01e2d2b 100644 --- a/lisp/lpath.el +++ b/lisp/lpath.el @@ -38,7 +38,7 @@ find-coding-systems-region get-charset-property coding-system-get w3-region rmail-summary-exists rmail-select-summary - rmail-update-summary + rmail-update-summary url-retrieve )) (maybe-bind '(global-face-data mark-active transient-mark-mode mouse-selection-click-count @@ -49,12 +49,15 @@ gnus-newsgroup-iso-8859-1-forced mail-mode-hook enable-multibyte-characters adaptive-fill-first-line-regexp adaptive-fill-regexp - url-current-mime-headers buffer-file-coding-system))) + url-current-mime-headers buffer-file-coding-system + w3-image-mappings url-current-mime-type + url-current-callback-func url-current-callback-data + url-be-asynchronous temporary-file-directory))) (maybe-bind '(mail-mode-hook enable-multibyte-characters browse-url-browser-function adaptive-fill-first-line-regexp adaptive-fill-regexp - url-current-mime-headers)) - (maybe-fbind '(color-instance-rgb-components + url-current-mime-headers help-echo-owns-message)) + (maybe-fbind '(color-instance-rgb-components temp-directory glyph-width annotation-glyph window-pixel-width glyph-height window-pixel-height make-color-instance color-instance-name specifier-instance @@ -76,6 +79,7 @@ make-annotation w3-do-setup w3-region rmail-summary-exists rmail-select-summary rmail-update-summary + url-generic-parse-url ))) (setq load-path (cons "." load-path)) diff --git a/lisp/mailcap.el b/lisp/mailcap.el index 2b9dc33..eccaf77 100644 --- a/lisp/mailcap.el +++ b/lisp/mailcap.el @@ -241,7 +241,10 @@ not.") (defvar mailcap-download-directory nil "*Where downloaded files should go by default.") -(defvar mailcap-temporary-directory (or (getenv "TMPDIR") "/tmp") +(defvar mailcap-temporary-directory + (cond ((fboundp 'temp-directory) (temp-directory)) + ((boundp 'temporary-file-directory) temporary-file-directory) + ("/tmp/")) "*Where temporary files go.") ;;; @@ -308,7 +311,8 @@ If FORCE, re-parse even if already parsed." (path nil) ((getenv "MAILCAPS") (setq path (getenv "MAILCAPS"))) ((memq system-type '(ms-dos ms-windows windows-nt)) - (setq path (mapconcat 'expand-file-name '("~/mail.cap" "~/etc/mail.cap") + (setq path (mapconcat 'expand-file-name + '("~/mail.cap" "~/etc/mail.cap" "~/.mailcap") ";"))) (t (setq path (mapconcat 'expand-file-name '("~/.mailcap" diff --git a/lisp/message.el b/lisp/message.el index fb5e183..a14960d 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -1324,7 +1324,7 @@ Point is left at the beginning of the narrowed-to region." (define-key message-mode-map "\C-c\C-a" 'message-mime-attach-file) (define-key message-mode-map "\C-c\C-m\C-a" 'message-mime-attach-file) - (define-key message-mode-map "\C-c\C-m\C-e" 'message-mime-insert-external) + (define-key message-mode-map "\C-c\C-m\C-e" 'message-mime-attach-external) (define-key message-mode-map "\C-c\C-m\C-q" 'mml-quote-region) (define-key message-mode-map "\t" 'message-tab)) @@ -1640,8 +1640,7 @@ With the prefix argument FORCE, insert the header anyway." (eq force 0)) (save-excursion (goto-char (point-max)) - (not (re-search-backward - message-signature-separator nil t)))) + (not (re-search-backward message-signature-separator nil t)))) ((and (null message-signature) force) t) @@ -1862,7 +1861,7 @@ prefix, and don't delete any headers." (list message-indent-citation-function))))) (mml-quote-region start end) (goto-char end) - (when (re-search-backward "^-- $" start t) + (when (re-search-backward message-signature-separator start t) ;; Also peel off any blank lines before the signature. (forward-line -1) (while (looking-at "^[ \t]*$") @@ -2106,6 +2105,7 @@ the user from the mailer." (case-fold-search nil) (news (message-news-p)) (mailbuf (current-buffer))) + (message-encode-message-body) (save-restriction (message-narrow-to-headers) ;; Insert some headers. @@ -2115,7 +2115,6 @@ the user from the mailer." (mail-encode-encoded-word-buffer) ;; Let the user do all of the above. (run-hooks 'message-header-hook)) - (message-encode-message-body) (unwind-protect (save-excursion (set-buffer tembuf) @@ -2282,6 +2281,7 @@ to find out how to use this." result) (if (not (message-check-news-body-syntax)) nil + (message-encode-message-body) (save-restriction (message-narrow-to-headers) ;; Insert some headers. @@ -2289,7 +2289,6 @@ to find out how to use this." (mail-encode-encoded-word-buffer) ;; Let the user do all of the above. (run-hooks 'message-header-hook)) - (message-encode-message-body) (message-cleanup-headers) (if (not (message-check-news-syntax)) nil @@ -2327,7 +2326,8 @@ to find out how to use this." ;; (funcall (intern (format "%s-request-post" (car method))) ;; (cadr method))) (gnus-open-server method) - (setq result (gnus-request-post method))) + (setq result (let ((mail-header-separator "")) + (gnus-request-post method)))) (kill-buffer tembuf)) (set-buffer messbuf) (if result @@ -4147,11 +4147,40 @@ regexp varstr." ;;; MIME functions ;;; - -;; I really think this function should be renamed. It is only useful -;; for inserting file attachments. - -(defun message-mime-attach-file (file type description) +(defun message-mime-query-file (prompt) + (let ((file (read-file-name prompt nil nil t))) + ;; Prevent some common errors. This is inspired by similar code in + ;; VM. + (when (file-directory-p file) + (error "%s is a directory, cannot attach" file)) + (unless (file-exists-p file) + (error "No such file: %s" file)) + (unless (file-readable-p file) + (error "Permission denied: %s" file)) + file)) + +(defun message-mime-query-type (file) + (let* ((default (or (mm-default-file-encoding file) + ;; Perhaps here we should check what the file + ;; looks like, and offer text/plain if it looks + ;; like text/plain. + "application/octet-stream")) + (string (completing-read + (format "Content type (default %s): " default) + (delete-duplicates + (mapcar (lambda (m) (list (cdr m))) mailcap-mime-extensions) + :test 'equal)))) + (if (not (equal string "")) + string + default))) + +(defun message-mime-query-description () + (let ((description (read-string "One line description: "))) + (when (string-match "\\`[ \t]*\\'" description) + (setq description nil)) + description)) + +(defun message-mime-attach-file (file &optional type description) "Attach a file to the outgoing MIME message. The file is not inserted or encoded until you send the message with `\\[message-send-and-exit]' or `\\[message-send]'. @@ -4160,51 +4189,29 @@ FILE is the name of the file to attach. TYPE is its content-type, a string of the form \"type/subtype\". DESCRIPTION is a one-line description of the attachment." (interactive - (let* ((file (read-file-name "Attach file: " nil nil t)) - (type (completing-read - (format "Content type (default %s): " - (or (mm-default-file-encoding file) - ;; Perhaps here we should check - ;; what the file looks like, and - ;; offer text/plain if it looks - ;; like text/plain. - "application/octet-stream")) - (delete-duplicates - (mapcar (lambda (m) (list (cdr m))) mailcap-mime-extensions) - :test 'equal))) - (description (read-string "One line description: "))) + (let* ((file (message-mime-query-file "Attach file: ")) + (type (message-mime-query-type file)) + (description (message-mime-query-description))) (list file type description))) - (when (string-match "\\`[ \t]*\\'" description) - (setq description nil)) - (when (string-match "\\`[ \t]*\\'" type) - (setq type (mm-default-file-encoding file))) nil - ;; Prevent some common errors. This is inspired by similar code in - ;; VM. - (when (file-directory-p file) - (error "%s is a directory, cannot attach" file)) - (unless (file-exists-p file) - (error "No such file: %s" file)) - (unless (file-readable-p file) - (error "Permission denied: %s" file)) - (insert (format "<#part type=%s filename=%s%s><#/part>\n" - type (prin1-to-string file) - (if description - (format " description=%s" (prin1-to-string description)) - "")))) - -(defun message-mime-insert-external (file type) - "Insert a message/external-body part into the buffer." + (insert (format + "<#part type=%s filename=%s%s disposition=attachment><#/part>\n" + type (prin1-to-string file) + (if description + (format " description=%s" (prin1-to-string description)) + "")))) + +(defun message-mime-attach-external (file &optional type description) + "Attach an external file into the buffer. +FILE is an ange-ftp/efs specification of the part location. +TYPE is the MIME type to use." (interactive - (let* ((file (read-file-name "Insert file: ")) - (type (mm-default-file-encoding file))) - (list file - (completing-read - (format "MIME type for %s: " file) - (delete-duplicates - (mapcar (lambda (m) (list (cdr m))) mailcap-mime-extensions)) - nil nil type)))) - (insert (format "<#external type=%s name=\"%s\"><#/external>\n" - type file))) + (let* ((file (message-mime-query-file "Attach external file: ")) + (type (message-mime-query-type file)) + (description (message-mime-query-description))) + (list file type description))) + (insert (format + "<#external type=%s name=%s disposition=attachment><#/external>\n" + type (prin1-to-string file)))) (defun message-encode-message-body () (let ((mm-default-charset message-default-charset) @@ -4226,16 +4233,16 @@ description of the attachment." (message-narrow-to-headers-or-head) (message-remove-header "Mime-Version") (goto-char (point-max)) - (insert "Mime-Version: 1.0\n") + (insert "MIME-Version: 1.0\n") (when lines (insert lines)) (setq multipart-p (re-search-backward "^Content-Type: multipart/" nil t))) + (save-restriction + (message-narrow-to-headers-or-head) + (message-remove-first-header "Content-Type") + (message-remove-first-header "Content-Transfer-Encoding")) (when multipart-p - (save-restriction - (message-narrow-to-headers-or-head) - (message-remove-first-header "Content-Type") - (message-remove-first-header "Content-Transfer-Encoding")) (message-goto-body) (insert "This is a MIME multipart message. If you are reading\n") (insert "this, you shouldn't.\n")))) diff --git a/lisp/mm-bodies.el b/lisp/mm-bodies.el index 6f46b92..09c406d 100644 --- a/lisp/mm-bodies.el +++ b/lisp/mm-bodies.el @@ -131,9 +131,9 @@ If no encoding was done, nil is returned." ((null encoding) ) ((eq encoding 'x-uuencode) - (uudecode-decode-region (point-min) (point-max))) + (funcall mm-uu-decode-function (point-min) (point-max))) ((eq encoding 'x-binhex) - (binhex-decode-region (point-min) (point-max))) + (funcall mm-uu-binhex-decode-function (point-min) (point-max))) ((functionp encoding) (funcall encoding (point-min) (point-max))) (t diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el index c99c912..8889bcb 100644 --- a/lisp/mm-decode.el +++ b/lisp/mm-decode.el @@ -48,10 +48,13 @@ `(nth 6 ,handle)) (defmacro mm-handle-set-cache (handle contents) `(setcar (nthcdr 6 ,handle) ,contents)) +(defmacro mm-handle-id (handle) + `(nth 7 ,handle)) (defmacro mm-make-handle (&optional buffer type encoding undisplayer - disposition description cache) + disposition description cache + id) `(list ,buffer ,type ,encoding ,undisplayer - ,disposition ,description ,cache)) + ,disposition ,description ,cache ,id)) (defvar mm-inline-media-tests '(("image/jpeg" mm-inline-image @@ -108,7 +111,10 @@ "text/richtext" "text/plain") "List that describes the precedence of alternative parts.") -(defvar mm-tmp-directory "/tmp/" +(defvar mm-tmp-directory + (cond ((fboundp 'temp-directory) (temp-directory)) + ((boundp 'temporary-file-directory) temporary-file-directory) + ("/tmp/")) "Where mm will store its temporary files.") (defvar mm-all-images-fit nil @@ -137,7 +143,8 @@ cd (mail-fetch-field "content-disposition") description (mail-fetch-field "content-description") id (mail-fetch-field "content-id")))) - (if (not ctl) + (if (or (not ctl) + (not (string-match "/" (car ctl)))) (mm-dissect-singlepart '("text/plain") nil no-strict-mime (and cd (condition-case () @@ -162,18 +169,18 @@ (and cd (condition-case () (mail-header-parse-content-disposition cd) (error nil))) - description)))) + description id)))) (when id (when (string-match " *<\\(.*\\)> *" id) (setq id (match-string 1 id))) (push (cons id result) mm-content-id-alist)) result)))) -(defun mm-dissect-singlepart (ctl cte &optional force cdl description) +(defun mm-dissect-singlepart (ctl cte &optional force cdl description id) (when (or force (not (equal "text/plain" (car ctl)))) (let ((res (mm-make-handle - (mm-copy-to-buffer) ctl cte nil cdl description))) + (mm-copy-to-buffer) ctl cte nil cdl description nil id))) (push (car res) mm-dissection-list) res))) diff --git a/lisp/mm-util.el b/lisp/mm-util.el index 6da9c66..6e54b00 100644 --- a/lisp/mm-util.el +++ b/lisp/mm-util.el @@ -31,9 +31,9 @@ (string-match "nt" system-configuration))) (defvar mm-binary-coding-system - (if mm-running-xemacs - 'binary 'no-conversion) - "100% binary coding system.") + (if mm-running-xemacs + 'binary 'no-conversion) + "100% binary coding system.") (defvar mm-text-coding-system (cond diff --git a/lisp/mm-uu.el b/lisp/mm-uu.el index 874dd9b..c0aa07d 100644 --- a/lisp/mm-uu.el +++ b/lisp/mm-uu.el @@ -2,7 +2,7 @@ ;; Copyright (c) 1998 by Shenghuo Zhu ;; Author: Shenghuo Zhu -;; $Revision: 1.1.1.7 $ +;; $Revision: 1.1.1.8 $ ;; Keywords: news postscript uudecode binhex shar ;; This file is not part of GNU Emacs, but the same permissions @@ -68,6 +68,10 @@ (defvar mm-uu-identifier-alist '((?% . postscript) (?b . uu) (?: . binhex) (?# . shar))) +(defvar mm-dissect-disposition "inline" + "The default disposition of uu parts. +This can be either \"inline\" or \"attachment\".") + ;;;### autoload (defun mm-uu-dissect () @@ -133,9 +137,9 @@ (mailcap-extension-to-mime (match-string 0 file-name))) "application/octet-stream")) - mm-uu-decode-function nil + 'x-uuencode nil (if (and file-name (not (equal file-name ""))) - (list "inline" (cons 'filename file-name))))) + (list mm-dissect-disposition (cons 'filename file-name))))) ((eq type 'binhex) (mm-make-handle (mm-uu-copy-to-buffer start-char end-char) (list (or (and file-name @@ -143,9 +147,9 @@ (mailcap-extension-to-mime (match-string 0 file-name))) "application/octet-stream")) - mm-uu-binhex-decode-function nil + 'x-binhex nil (if (and file-name (not (equal file-name ""))) - (list "inline" (cons 'filename file-name))))) + (list mm-dissect-disposition (cons 'filename file-name))))) ((eq type 'shar) (mm-make-handle (mm-uu-copy-to-buffer start-char end-char) '("application/x-shar")))) diff --git a/lisp/mm-view.el b/lisp/mm-view.el index a4780bc..2c06d0e 100644 --- a/lisp/mm-view.el +++ b/lisp/mm-view.el @@ -70,6 +70,8 @@ (setq text (mm-get-part handle)) (let ((b (point)) (url-standalone-mode t) + (url-current-object + (url-generic-parse-url (format "cid:%s" (mm-handle-id handle)))) (width (window-width))) (save-excursion (insert text) @@ -135,7 +137,9 @@ (defun mm-view-message () (gnus-article-prepare-display) - (fundamental-mode)) + (run-hooks 'gnus-article-decode-hook) + (fundamental-mode) + (goto-char (point-min))) (provide 'mm-view) diff --git a/lisp/nnmail.el b/lisp/nnmail.el index 2cb945e..7151f6f 100644 --- a/lisp/nnmail.el +++ b/lisp/nnmail.el @@ -454,6 +454,11 @@ parameter. It should return nil, `warn' or `delete'." :group 'nnmail :type '(repeat symbol)) +(defcustom nnmail-split-header-length-limit 1024 + "Header lines longer than this limit are excluded from the split function." + :group 'nnmail + :type 'integer) + ;;; Internal variables. (defvar nnmail-split-history nil @@ -1063,8 +1068,8 @@ FUNC will be called with the group name to determine the article number." (goto-char (point-min)) (while (not (eobp)) (end-of-line) - (if (> (current-column) 1024) - (gnus-delete-line) + (if (> (current-column) nnmail-split-header-length-limit) + (delete-region (point) (progn (end-of-line) (point))) (forward-line 1))) ;; Allow washing. (goto-char (point-min)) diff --git a/lisp/nnsoup.el b/lisp/nnsoup.el index 4931808..f0f4d7c 100644 --- a/lisp/nnsoup.el +++ b/lisp/nnsoup.el @@ -38,7 +38,10 @@ (defvoo nnsoup-directory "~/SOUP/" "*SOUP packet directory.") -(defvoo nnsoup-tmp-directory "/tmp/" +(defvoo nnsoup-tmp-directory + (cond ((fboundp 'temp-directory) (temp-directory)) + ((boundp 'temporary-file-directory) temporary-file-directory) + ("/tmp/")) "*Where nnsoup will store temporary files.") (defvoo nnsoup-replies-directory (concat nnsoup-directory "replies/") @@ -666,8 +669,6 @@ backend for the messages.") (require 'mail-utils) (let ((tembuf (generate-new-buffer " message temp")) (case-fold-search nil) - (real-header-separator mail-header-separator) - (mail-header-separator "") delimline (mailbuf (current-buffer))) (unwind-protect @@ -693,15 +694,11 @@ backend for the messages.") ;; Change header-delimiter to be what sendmail expects. (goto-char (point-min)) (re-search-forward - (concat "^" (regexp-quote real-header-separator) "\n")) + (concat "^" (regexp-quote mail-header-separator) "\n")) (replace-match "\n") (backward-char 1) (setq delimline (point-marker)) - ;; Insert an extra newline if we need it to work around - ;; Sun's bug that swallows newlines. (goto-char (1+ delimline)) - (when (eval message-mailer-swallows-blank-line) - (newline)) (let ((msg-buf (gnus-soup-store nnsoup-replies-directory diff --git a/lisp/rfc2047.el b/lisp/rfc2047.el index 47d1161..84204e5 100644 --- a/lisp/rfc2047.el +++ b/lisp/rfc2047.el @@ -138,7 +138,7 @@ Should be called narrowed to the head of the message." "Say whether the current (narrowed) buffer contains characters that need encoding." (let ((charsets (mapcar 'mm-mule-charset-to-mime-charset - (find-charset-region (point-min) (point-max)))) + (mm-find-charset-region (point-min) (point-max)))) (cs (list 'us-ascii rfc2047-default-charset)) found) (while charsets @@ -156,7 +156,7 @@ Should be called narrowed to the head of the message." (concat "[^" ietf-drums-tspecials " \t\n]+") nil t) (push (list (match-beginning 0) (match-end 0) - (car (delq 'ascii (find-charset-region + (car (delq 'ascii (mm-find-charset-region (match-beginning 0) (match-end 0))))) words)) words))) @@ -271,7 +271,9 @@ Should be called narrowed to the head of the message." (when (and (mm-multibyte-p) rfc2047-default-charset) (mm-decode-coding-region b e rfc2047-default-charset)) (setq b (point))) - (when (and (mm-multibyte-p) rfc2047-default-charset) + (when (and (mm-multibyte-p) + rfc2047-default-charset + (not (eq rfc2047-default-charset 'us-ascii))) (mm-decode-coding-region b (point-max) rfc2047-default-charset)))))) (defun rfc2047-decode-string (string) diff --git a/lisp/rfc2231.el b/lisp/rfc2231.el index 9e33529..2caec5e 100644 --- a/lisp/rfc2231.el +++ b/lisp/rfc2231.el @@ -113,7 +113,8 @@ The list will be on the form (when prev-attribute (push (cons prev-attribute prev-value) parameters)) - `(,type ,@(nreverse parameters)))))) + (when type + `(,type ,@(nreverse parameters))))))) (defun rfc2231-decode-encoded-string (string) "Decode an RFC2231-encoded string. diff --git a/lisp/uudecode.el b/lisp/uudecode.el index 3b548a3..b44e3c9 100644 --- a/lisp/uudecode.el +++ b/lisp/uudecode.el @@ -52,7 +52,10 @@ input and write the converted data to its standard output.") (setq str (concat str "[^a-z]"))) (concat str ".?$"))) -(defvar uudecode-temporary-file-directory "/tmp/") +(defvar uudecode-temporary-file-directory + (cond ((fboundp 'temp-directory) (temp-directory)) + ((boundp 'temporary-file-directory) temporary-file-directory) + ("/tmp/"))) ;;;###autoload (defun uudecode-decode-region-external (start end &optional file-name) diff --git a/texi/ChangeLog b/texi/ChangeLog index 6fa5d94..228deae 100644 --- a/texi/ChangeLog +++ b/texi/ChangeLog @@ -1,3 +1,11 @@ +1999-01-03 13:54:51 Lars Magne Ingebrigtsen + + * gnus.texi (Group Agent Commands): Addition. + +1998-12-19 23:29:50 Lars Magne Ingebrigtsen + + * gnus.texi (Splitting Mail): Addition. + 1998-12-13 08:54:07 Lars Magne Ingebrigtsen * message.texi (Insertion): Add. diff --git a/texi/gnus.texi b/texi/gnus.texi index 50cd93f..a5121d9 100644 --- a/texi/gnus.texi +++ b/texi/gnus.texi @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @setfilename gnus -@settitle Pterodactyl Gnus 0.68 Manual +@settitle Pterodactyl Gnus 0.69 Manual @synindex fn cp @synindex vr cp @synindex pg cp @@ -318,7 +318,7 @@ into another language, under the above conditions for modified versions. @tex @titlepage -@title Pterodactyl Gnus 0.68 Manual +@title Pterodactyl Gnus 0.69 Manual @author by Lars Magne Ingebrigtsen @page @@ -354,7 +354,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.68. +This manual corresponds to Pterodactyl Gnus 0.69. @end ifinfo @@ -9781,6 +9781,12 @@ links. If that's the case for you, set @code{nnmail-crosspost-link-function} to @code{copy-file}. (This variable is @code{add-name-to-file} by default.) +@findex nnmail-split-header-length-limit +Header lines may be arbitrarily long. However, the longer a line is, +the longer it takes to match them. Very long lines may lead to Gnus +taking forever to split the mail, so Gnus excludes lines that are longer +than @code{nnmail-split-header-length-limit} (which defaults to 1024). + @kindex M-x nnmail-split-history @kindex nnmail-split-history If you wish to see where the previous mail split put the messages, you @@ -12219,7 +12225,7 @@ Enter the Agent category buffer (@code{gnus-enter-category-buffer}). @kindex J s (Agent Group) @findex gnus-agent-fetch-session Fetch all eligible articles in all groups -(@code{gnus-agent-fetch-session}). +(@code{gnus-agent-fetch-session}). @item J S @kindex J S (Agent Group) @@ -12231,7 +12237,15 @@ Send all sendable messages in the draft group @kindex J a (Agent Group) @findex gnus-agent-add-group Add the current group to an Agent category -(@code{gnus-agent-add-group}). +(@code{gnus-agent-add-group}). This command understands the +process/prefix convention (@pxref{Process/Prefix}). + +@item J r +@kindex J r (Agent Group) +@findex gnus-agent-remove-group +Remove the current group from its category, if any +(@code{gnus-agent-remove-group}). This command understands the +process/prefix convention (@pxref{Process/Prefix}). @end table diff --git a/texi/message.texi b/texi/message.texi index 1b600bb..2db59ba 100644 --- a/texi/message.texi +++ b/texi/message.texi @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @setfilename message -@settitle Pterodactyl Message 0.68 Manual +@settitle Pterodactyl Message 0.69 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.68 Manual +@title Pterodactyl Message 0.69 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.68. Message is +This manual corresponds to Pterodactyl Message 0.69. Message is distributed with the Gnus distribution bearing the same version number as this manual. -- 1.7.10.4