From: ichikawa Date: Mon, 4 Jan 1999 06:38:01 +0000 (+0000) Subject: Sync up with Pteroductyl Gnus v0.69 X-Git-Tag: pgnus-ichikawa-199901041900 X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=8ef92c5138afe1e009db18c627941ae71c55c09d;p=elisp%2Fgnus.git- Sync up with Pteroductyl Gnus v0.69 --- diff --git a/ChangeLog b/ChangeLog index 2f09f1b..9299fc1 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +1999-01-04 Tatsuya Ichikawa + + * lisp/gnus.el (gnus-version-number): Update to 6.10.052. + + * Sync up with Pterodactyl Gnus v0.69. + 1998-12-28 Katsumi Yamaoka * lisp/gnus-sum.el (gnus-summary-preview-mime-message): Always 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 ab2ce39..5effade 100644 --- a/lisp/binhex.el +++ b/lisp/binhex.el @@ -3,7 +3,7 @@ ;; Author: Shenghuo Zhu ;; Create Date: Oct 1, 1998 -;; $Revision: 1.1.2.4 $ +;; $Revision: 1.1.2.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 cefdc0e..1c27281 100644 --- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -223,7 +223,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) @@ -399,6 +400,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 ;;; @@ -436,6 +447,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 10c0476..34e9429 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -582,14 +582,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") @@ -2934,9 +2933,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-mailcap.el b/lisp/gnus-mailcap.el index ed62652..70b4c4b 100644 --- a/lisp/gnus-mailcap.el +++ b/lisp/gnus-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/gnus-msg.el b/lisp/gnus-msg.el index 4bd9ca3..8147a2b 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -1190,21 +1190,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 8e35879..7d3112d 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)))) @@ -477,8 +484,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 f33dd46..82ae918 100644 --- a/lisp/gnus-uu.el +++ b/lisp/gnus-uu.el @@ -215,7 +215,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 867806b..08e7976 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -259,10 +259,10 @@ is restarted, and sometimes reloaded." (defconst gnus-product-name "T-gnus" "Product name of this version of gnus.") -(defconst gnus-version-number "6.10.051" +(defconst gnus-version-number "6.10.052" "Version number for this version of gnus.") -(defconst gnus-original-version-number "0.68" +(defconst gnus-original-version-number "0.69" "Version number for this version of Gnus.") (defconst gnus-original-product-name "Pterodactyl Gnus" @@ -2405,7 +2405,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 439cdba..16cd083 100644 --- a/lisp/lpath.el +++ b/lisp/lpath.el @@ -43,7 +43,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 @@ -54,12 +54,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 @@ -81,6 +84,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)) (require 'custom) diff --git a/lisp/message.el b/lisp/message.el index 25d5f18..dfd744a 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -1831,8 +1831,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) @@ -2054,7 +2053,7 @@ prefix, and don't delete any headers." message-indent-citation-function (list message-indent-citation-function))))) (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]*$") @@ -4786,11 +4785,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]'. @@ -4799,51 +4827,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) @@ -4870,6 +4876,10 @@ description of the attachment." (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) 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 d9b7489..d3c3db3 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 0b54ecd..601254f 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.2.7 $ +;; $Revision: 1.1.2.8 $ ;; Keywords: news postscript uudecode binhex shar ;; This file is not part of GNU Emacs, but the same permissions @@ -70,6 +70,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 () @@ -135,9 +139,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 @@ -145,9 +149,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 eec93cc..6362780 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 @@ -1062,8 +1067,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-ja.texi b/texi/gnus-ja.texi index 6370780..94cf631 100644 --- a/texi/gnus-ja.texi +++ b/texi/gnus-ja.texi @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @setfilename gnus-ja -@settitle Semi-gnus 6.10.051 Manual +@settitle Semi-gnus 6.10.052 Manual @synindex fn cp @synindex vr cp @synindex pg cp @@ -345,7 +345,7 @@ into another language, under the above conditions for modified versions. @tex @titlepage -@title Semi-gnus 6.10.051 Manual +@title Semi-gnus 6.10.052 Manual @author by Lars Magne Ingebrigtsen @author by members of Semi-gnus mailing-list @@ -399,7 +399,7 @@ Semi-gnus $B$O!"Bg$-$J3($,F~$C$F$$$?$j$5$^$6$^$J7A<0$rMQ$$$?$j$7$F$$$k$A$g$C(B $B$J8@8l7w$r:9JL$7$^$;$s!#$"$"!"%/%j%s%4%s$NJ}$O(B Unicode Next Generation$B$r(B $B$*BT$A$/$@$5$$!#(B -$B$3$N@bL@=q$O(B Semi-gnus 6.10.051 $B$KBP1~$7$^$9!#(B +$B$3$N@bL@=q$O(B Semi-gnus 6.10.052 $B$KBP1~$7$^$9!#(B @end ifinfo diff --git a/texi/gnus.texi b/texi/gnus.texi index 0311ccd..5a23e24 100644 --- a/texi/gnus.texi +++ b/texi/gnus.texi @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @setfilename gnus -@settitle Semi-gnus 6.10.051 Manual +@settitle Semi-gnus 6.10.052 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 Semi-gnus 6.10.051 Manual +@title Semi-gnus 6.10.052 Manual @author by Lars Magne Ingebrigtsen @page @@ -361,7 +361,7 @@ internationalization/localization and multiscript features based on MULE API. So Semi-gnus does not discriminate various language communities. Oh, if you are a Klingon, please wait Unicode Next Generation. -This manual corresponds to Semi-gnus 6.10.051. +This manual corresponds to Semi-gnus 6.10.052. @end ifinfo @@ -4000,7 +4000,7 @@ This command is mainly used if you have several accounts and want to ship a mail to a different account of yours. (If you're both @code{root} and @code{postmaster} and get a mail for @code{postmaster} to the @code{root} account, you may want to resend it to -@code{postmaster}. Ordnung muß sein! +@code{postmaster}. Ordnung mu(I_(B sein! This command understands the process/prefix convention (@pxref{Process/Prefix}). @@ -9766,6 +9766,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 @@ -11364,7 +11370,7 @@ group as read. If the search engine changes its output substantially, @code{nnweb} won't be able to parse it and will fail. One could hardly fault the Web -providers if they were to do this---their @emph{raison d'être} is to +providers if they were to do this---their @emph{raison d'$BsU(Bre} is to make money off of advertisements, not to provide services to the community. Since @code{nnweb} washes the ads off all the articles, one might think that the providers might be somewhat miffed. We'll see. @@ -12204,7 +12210,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) @@ -12216,7 +12222,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 @@ -13998,7 +14012,7 @@ then this operator will return @code{false}. @item ! @itemx not -@itemx ¬ +@itemx (I,(B This logical operator only takes a single argument. It returns the logical negation of the value of its argument. @@ -16323,7 +16337,7 @@ David Moore---rewrite of @file{nnvirtual.el} and many other things. Kevin Davidson---came up with the name @dfn{ding}, so blame him. @item -François Pinard---many, many interesting and thorough bug reports, as +Fran$BmP(Bis Pinard---many, many interesting and thorough bug reports, as well as autoconf support. @end itemize @@ -16336,7 +16350,7 @@ The following people have contributed many patches and suggestions: Christopher Davis, Andrew Eskilsson, Kai Grossjohann, -David Kågedal, +David K$BiH(Bedal, Richard Pieri, Fabrice Popineau, Daniel Quinlan, @@ -16408,7 +16422,7 @@ Marc Horowitz, Gunnar Horrigmo, Richard Hoskins, Brad Howes, -François Felix Ingrand, +Fran$BmP(Bis Felix Ingrand, Ishikawa Ichiro, @c Ishikawa Lee Iverson, Iwamuro Motonori, @c Iwamuro @@ -17833,8 +17847,8 @@ From: Jason L Tibbitts III @end example @item - tanken var at når du bruker `gnus-startup-file' som prefix (FOO) til å lete -opp en fil FOO-SERVER, FOO-SERVER.el, FOO-SERVER.eld, kan du la den være en + tanken var at n$BiS(B du bruker `gnus-startup-file' som prefix (FOO) til ’élete +opp en fil FOO-SERVER, FOO-SERVER.el, FOO-SERVER.eld, kan du la den v$BkS(Be en liste hvor du bruker hvert element i listen som FOO, istedet. da kunne man hatt forskjellige serveres startup-filer forskjellige steder. @@ -17907,8 +17921,8 @@ there was a sci.somethingelse group or section, then it should prompt for sci? first the sci.something? then sci.somethingelse?... @item -Ja, det burde være en måte å si slikt. Kanskje en ny variabel? -`gnus-use-few-score-files'? Så kunne score-regler legges til den +Ja, det burde v$BkS(Be en m$BiU(Be ’ési slikt. Kanskje en ny variabel? +`gnus-use-few-score-files'? S’ékunne score-regler legges til den "mest" lokale score-fila. F. eks. ville no-gruppene betjenes av "no.all.SCORE", osv. @@ -18238,7 +18252,7 @@ the current process mark set onto the stack. @item gnus-article-hide-pgp -Selv ville jeg nok ha valgt å slette den dersom teksten matcher +Selv ville jeg nok ha valgt ’éslette den dersom teksten matcher @example "\\(This\s+\\)?[^ ]+ has been automatically signed by" @end example diff --git a/texi/message-ja.texi b/texi/message-ja.texi index 7d685a7..08d5198 100644 --- a/texi/message-ja.texi +++ b/texi/message-ja.texi @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @setfilename message-ja -@settitle Message 6.10.051 Manual +@settitle Message 6.10.052 Manual @synindex fn cp @synindex vr cp @synindex pg cp @@ -60,7 +60,7 @@ into another language, under the above conditions for modified versions. @tex @titlepage -@title Message 6.10.051 Manual +@title Message 6.10.052 Manual @author by Lars Magne Ingebrigtsen @translated by members of Semi-gnus mailing-list @@ -112,7 +112,7 @@ Gnus $B$NA4$F$N%a%C%;!<%8$N:n@.(B ($B%a!<%k$H%K%e!<%9$NN>J}(B) $B$O%a%C%;!< * Key Index:: $B%a%C%;!<%8%b!<%I%-!<$N0lMw!#(B @end menu -$B$3$N%^%K%e%"%k$O(B Message 6.10.051 $B$KBP1~$7$^$9!#(BMessage $B$O$3$N%^%K%e%"%k$H(B +$B$3$N%^%K%e%"%k$O(B Message 6.10.052 $B$KBP1~$7$^$9!#(BMessage $B$O$3$N%^%K%e%"%k$H(B $BF1$8HGHV9f$N(B Gnus $B$NG[I[$H6&$KG[I[$5$l$^$9!#(B diff --git a/texi/message.texi b/texi/message.texi index 09baca2..16e94a1 100644 --- a/texi/message.texi +++ b/texi/message.texi @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @setfilename message -@settitle Message 6.10.051 Manual +@settitle Message 6.10.052 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 Message 6.10.051 Manual +@title Message 6.10.052 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 Message 6.10.051. Message is +This manual corresponds to Message 6.10.052. Message is distributed with the Gnus distribution bearing the same version number as this manual.