From 8b1305ac117e83bf50d4b562b2a839a627ce50e3 Mon Sep 17 00:00:00 2001 From: ichikawa Date: Tue, 1 Dec 1998 02:43:35 +0000 Subject: [PATCH] Importing pgnus-0.58 --- lisp/ChangeLog | 45 +++++++++++++++++++++++++++++++++++++ lisp/gnus.el | 2 +- lisp/ietf-drums.el | 2 ++ lisp/mail-parse.el | 2 ++ lisp/message.el | 2 +- lisp/mm-bodies.el | 50 ++++++++++++++++++++++++++--------------- lisp/mm-decode.el | 11 ++++----- lisp/mm-view.el | 17 +++++++++----- lisp/mml.el | 25 +++++++++++---------- lisp/rfc2045.el | 39 ++++++++++++++++++++++++++++++++ lisp/rfc2047.el | 3 ++- lisp/rfc2231.el | 60 +++++++++++++++++++++++++++++++++++++++++++++++++- texi/ChangeLog | 4 ++++ texi/emacs-mime.texi | 32 ++++++++++++++++++++++++++- texi/gnus.texi | 6 ++--- texi/message.texi | 6 ++--- 16 files changed, 252 insertions(+), 54 deletions(-) create mode 100644 lisp/rfc2045.el diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 3becb7b..3338e4d 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,48 @@ +Tue Dec 1 00:46:20 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.58 is released. + +1998-11-30 Hrvoje Niksic + + * mm-decode.el (mm-get-image): Return a glyph, not an image + specifier. + +1998-11-29 Hrvoje Niksic + + * rfc2047.el (rfc2047-decode): Bind mm-default-charset. + +1998-12-01 01:23:35 Lars Magne Ingebrigtsen + + * mail-parse.el (rfc2045): Required. + +1998-12-01 00:59:53 William M. Perry + + * mm-view.el (mm-inline-text): Remove props. + +1998-12-01 00:18:47 Lars Magne Ingebrigtsen + + * mm-view.el (mm-setup-w3): Protect url-misc. + + * message.el (message-ignored-resent-headers): Remove + Gnus-Warning. + + * mml.el (mml-insert-mime-headers): Use encoding. + (mml-parameter-string): Ditto. + + * rfc2045.el: New file. + (rfc2045-encode-string): New function. + +1998-11-30 23:11:22 Lars Magne Ingebrigtsen + + * mail-parse.el (mail-header-encode-parameter): New function. + + * rfc2231.el (rfc2231-encode-string): New function. + +Mon Nov 30 13:52:50 1998 Shenghuo ZHU + + * mm-bodies.el (mm-decode-string): New function. + * mm-view.el (mm-inline-text): Use mm-decode-string. + Mon Nov 30 21:57:00 1998 Lars Magne Ingebrigtsen * gnus.el: Pterodactyl Gnus v0.57 is released. diff --git a/lisp/gnus.el b/lisp/gnus.el index b614576..bc7c8be 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.57" +(defconst gnus-version-number "0.58" "Version number for this version of Gnus.") (defconst gnus-version (format "Pterodactyl Gnus v%s" gnus-version-number) diff --git a/lisp/ietf-drums.el b/lisp/ietf-drums.el index 865ddff..dd7f7f0 100644 --- a/lisp/ietf-drums.el +++ b/lisp/ietf-drums.el @@ -87,6 +87,8 @@ ((= i (length token)) (push (mm-make-char 'ascii c) out)) (t + (when b + (push (mm-make-char 'ascii b) out)) (setq b c)))) (nreverse out))) diff --git a/lisp/mail-parse.el b/lisp/mail-parse.el index 99bd017..0f7dbcd 100644 --- a/lisp/mail-parse.el +++ b/lisp/mail-parse.el @@ -39,10 +39,12 @@ (require 'ietf-drums) (require 'rfc2231) (require 'rfc2047) +(require 'rfc2045) (defalias 'mail-header-parse-content-type 'rfc2231-parse-string) (defalias 'mail-header-parse-content-disposition 'rfc2231-parse-string) (defalias 'mail-content-type-get 'rfc2231-get-value) +(defalias 'mail-header-encode-parameter 'rfc2045-encode-string) (defalias 'mail-header-remove-comments 'ietf-drums-remove-comments) (defalias 'mail-header-remove-whitespace 'ietf-drums-remove-whitespace) diff --git a/lisp/message.el b/lisp/message.el index aee3460..429ecae 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -322,7 +322,7 @@ The provided functions are: :group 'message-forwarding :type 'boolean) -(defcustom message-ignored-resent-headers "^Return-receipt\\|^X-Gnus" +(defcustom message-ignored-resent-headers "^Return-receipt\\|^X-Gnus\\|^Gnus-Warning:" "*All headers that match this regexp will be deleted when resending a message." :group 'message-interface :type 'regexp) diff --git a/lisp/mm-bodies.el b/lisp/mm-bodies.el index c209d36..22d2ae4 100644 --- a/lisp/mm-bodies.el +++ b/lisp/mm-bodies.el @@ -26,7 +26,8 @@ (eval-and-compile (or (fboundp 'base64-decode-region) - (require 'base64))) + (require 'base64)) + (autoload 'binhex-decode-region "binhex")) (require 'mm-util) (require 'rfc2047) @@ -93,24 +94,25 @@ If no encoding was done, nil is returned." (defun mm-body-encoding () "Return the encoding of the current buffer." - (cond ((not (featurep 'mule)) - (if (save-excursion + (cond + ((not (featurep 'mule)) + (if (save-excursion + (goto-char (point-min)) + (re-search-forward mm-8bit-char-regexp nil t)) + '8bit + '7bit)) + (t + ;; Mule version + (if (and (null (delq 'ascii (find-charset-region (point-min) (point-max)))) + ;;!!!The following is necessary because the function + ;;!!!above seems to return the wrong result under + ;;!!!Emacs 20.3. Sometimes. + (save-excursion (goto-char (point-min)) - (re-search-forward mm-8bit-char-regexp nil t)) - '8bit - '7bit)) - (t - ;; Mule version - (if (and (null (delq 'ascii (find-charset-region (point-min) (point-max)))) - ;;!!!The following is necessary because the function - ;;!!!above seems to return the wrong result under - ;;!!!Emacs 20.3. Sometimes. - (save-excursion - (goto-char (point-min)) - (skip-chars-forward "\0-\177") - (eobp))) - '7bit - '8bit)))) + (skip-chars-forward "\0-\177") + (eobp))) + '7bit + '8bit)))) ;;; ;;; Functions for decoding @@ -167,6 +169,18 @@ The characters in CHARSET should then be decoded." (setq mule-charset rfc2047-default-charset))) (mm-decode-coding-region (point-min) (point-max) mule-charset)))))) +(defun mm-decode-string (string charset) + "Decode STRING with CHARSET." + (setq charset (or charset rfc2047-default-charset)) + (when (featurep 'mule) + (let (mule-charset) + (when (and charset + (setq mule-charset (mm-charset-to-coding-system charset)) + enable-multibyte-characters + (or (not (eq mule-charset 'ascii)) + (setq mule-charset rfc2047-default-charset))) + (mm-decode-coding-string string mule-charset))))) + (provide 'mm-bodies) ;; mm-bodies.el ends here diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el index a1385fe..f208252 100644 --- a/lisp/mm-decode.el +++ b/lisp/mm-decode.el @@ -535,17 +535,14 @@ This overrides entries in the mailcap file." (car (mm-handle-type handle))) (prog1 (setq spec - (make-image-specifier - (vector (intern type) :data (buffer-string)))) + (make-glyph `[,(intern type) :data ,(buffer-string)])) (mm-handle-set-cache handle spec)))))) (defun mm-image-fit-p (handle) "Say whether the image in HANDLE will fit the current window." - (let ((image (make-annotation (mm-get-image handle)))) - (and (< (glyph-width (annotation-glyph image)) - (window-pixel-width)) - (< (glyph-height (annotation-glyph image)) - (window-pixel-height))))) + (let ((image (mm-get-image handle))) + (and (< (glyph-width image) (window-pixel-width)) + (< (glyph-height image) (window-pixel-height))))) (provide 'mm-decode) diff --git a/lisp/mm-view.el b/lisp/mm-view.el index 74a4703..64abdc3 100644 --- a/lisp/mm-view.el +++ b/lisp/mm-view.el @@ -45,7 +45,9 @@ (w3-do-setup) (require 'url) (require 'w3-vars) - (load "url-misc.el") + (condition-case () + (load "url-misc.el") + (error nil)) (setq mm-w3-setup t))) (defun mm-inline-text (handle) @@ -54,13 +56,12 @@ (cond ((equal type "plain") (setq text (mm-get-part handle)) - (let ((b (point))) - (insert text) + (let ((b (point)) + (charset (mail-content-type-get + (mm-handle-type handle) 'charset))) + (insert (mm-decode-string text charset)) (save-restriction (narrow-to-region b (point)) - (let ((charset (mail-content-type-get - (mm-handle-type handle) 'charset))) - (mm-decode-body charset nil)) (mm-handle-set-undisplayer handle `(lambda () @@ -84,6 +85,10 @@ handle `(lambda () (let (buffer-read-only) + (mapc (lambda (prop) + (remove-specifier + (face-property 'default prop) (current-buffer))) + '(background background-pixmap foreground)) (delete-region ,(set-marker (make-marker) (point-min)) ,(set-marker (make-marker) (point-max))))))))) diff --git a/lisp/mml.el b/lisp/mml.el index 6eaf391..1cc8cc6 100644 --- a/lisp/mml.el +++ b/lisp/mml.el @@ -164,13 +164,15 @@ (when name (setq name (mml-parse-file-name name)) (if (stringp name) - (insert ";\n name=\"" (prin1-to-string name) + (insert ";\n " (mail-header-encode-parameter "name" name) "\";\n access-type=local-file") (insert - (format ";\n name=%S;\n site=%S;\n directory=%S" - (file-name-nondirectory (nth 2 name)) - (nth 1 name) - (file-name-directory (nth 2 name)))) + (format ";\n " + (mail-header-encode-parameter + "name" (file-name-nondirectory (nth 2 name))) + (mail-header-encode-parameter "site" (nth 1 name)) + (mail-header-encode-parameter + "directory" (file-name-directory (nth 2 name))))) (insert ";\n access-type=" (if (member (nth 0 name) '("ftp@" "anonymous@")) "anon-ftp" @@ -246,7 +248,8 @@ (not (equal type "text/plain"))) (insert "Content-Type: " type) (when charset - (insert (format "; charset=\"%s\"" charset))) + (insert "; " (mail-header-encode-parameter + "charset" (symbol-name charset)))) (when parameters (insert parameters)) (insert "\n")) @@ -262,18 +265,16 @@ (unless (eq encoding '7bit) (insert (format "Content-Transfer-Encoding: %s\n" encoding))) (when (setq description (cdr (assq 'description cont))) - (insert "Content-Description: " description "\n")) - )) + (insert "Content-Description: " description "\n")))) (defun mml-parameter-string (cont types) (let ((string "") value type) (while (setq type (pop types)) (when (setq value (cdr (assq type cont))) - (setq string (concat string ";\n " (symbol-name type) "=" - (if (string-match "[^_0-9A-Za-z]" value) - (prin1-to-string value) - value))))) + (setq string (concat string ";\n " + (mail-header-encode-parameter + (symbol-name type) value))))) (when (not (zerop (length string))) string))) diff --git a/lisp/rfc2045.el b/lisp/rfc2045.el new file mode 100644 index 0000000..c8028db --- /dev/null +++ b/lisp/rfc2045.el @@ -0,0 +1,39 @@ +;;; rfc2045.el --- Functions for decoding rfc2045 headers +;; Copyright (C) 1998 Free Software Foundation, Inc. + +;; Author: Lars Magne Ingebrigtsen +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;;; Code: + +(require 'ietf-drums) + +(defun rfc2045-encode-string (param value) + "Return and PARAM=VALUE string encoded according to RFC2045." + (if (or (string-match (concat "[" ietf-drums-no-ws-ctl-token "]") value) + (string-match (concat "[" ietf-drums-tspecials "]") value) + (string-match "[ \n\t]" value) + (not (string-match (concat "[" ietf-drums-text-token "]") value))) + (concat param "=" (format "%S" value)) + (concat param "=" value))) + +(provide 'rfc2045) + +;;; rfc2045.el ends here diff --git a/lisp/rfc2047.el b/lisp/rfc2047.el index 6423dac..3484a04 100644 --- a/lisp/rfc2047.el +++ b/lisp/rfc2047.el @@ -305,7 +305,8 @@ Return WORD if not." "Decode STRING that uses CHARSET with ENCODING. Valid ENCODINGs are \"B\" and \"Q\". If your Emacs implementation can't decode CHARSET, it returns nil." - (let ((cs (mm-charset-to-coding-system charset))) + (let ((cs (let ((mm-default-charset rfc2047-default-charset)) + (mm-charset-to-coding-system charset)))) (when cs (when (eq cs 'ascii) (setq cs rfc2047-default-charset)) diff --git a/lisp/rfc2231.el b/lisp/rfc2231.el index cb0d53d..9e33529 100644 --- a/lisp/rfc2231.el +++ b/lisp/rfc2231.el @@ -42,7 +42,7 @@ The list will be on the form attribute value type subtype number encoded prev-attribute) (ietf-drums-init (mail-header-remove-whitespace - (mail-header-remove-comments string))) + (mail-header-remove-comments string))) (let ((table (copy-syntax-table ietf-drums-syntax-table))) (modify-syntax-entry ?\' "w" table) (set-syntax-table table)) @@ -137,6 +137,64 @@ These look like \"us-ascii'en-us'This%20is%20%2A%2A%2Afun%2A%2A%2A\"." (intern (car elems)))) (buffer-string)))) +(defun rfc2231-encode-string (param value) + "Return and PARAM=VALUE string encoded according to RFC2231." + (let ((control (ietf-drums-token-to-list ietf-drums-no-ws-ctl-token)) + (tspecial (ietf-drums-token-to-list ietf-drums-tspecials)) + (special (ietf-drums-token-to-list "*'%\n\t")) + (ascii (ietf-drums-token-to-list ietf-drums-text-token)) + (num -1) + spacep encodep charsetp charset broken) + (with-temp-buffer + (insert value) + (goto-char (point-min)) + (while (not (eobp)) + (cond + ((or (memq (following-char) control) + (memq (following-char) tspecial) + (memq (following-char) special)) + (setq encodep t)) + ((eq (following-char) ? ) + (setq spacep t)) + ((not (memq (following-char) ascii)) + (setq charsetp t))) + (forward-char 1)) + (when charsetp + (setq charset (mm-encode-body))) + (cond + ((or encodep charsetp) + (goto-char (point-min)) + (while (not (eobp)) + (when (> (current-column) 60) + (insert "\n") + (setq broken t)) + (if (or (not (memq (following-char) ascii)) + (memq (following-char) control) + (memq (following-char) tspecial) + (memq (following-char) special) + (eq (following-char) ? )) + (progn + (insert "%" (format "%02x" (following-char))) + (delete-char 1)) + (forward-char 1))) + (goto-char (point-min)) + (insert (or charset "ascii") "''") + (goto-char (point-min)) + (if (not broken) + (insert param "*=") + (while (not (eobp)) + (insert param "*" (format "%d" (incf num)) "*=") + (forward-line 1)))) + (spacep + (goto-char (point-min)) + (insert param "=\"") + (goto-char (point-max)) + (insert "\"")) + (t + (goto-char (point-min)) + (insert param "="))) + (buffer-string)))) + (provide 'rfc2231) ;;; rfc2231.el ends here diff --git a/texi/ChangeLog b/texi/ChangeLog index b2c444f..0cecc0b 100644 --- a/texi/ChangeLog +++ b/texi/ChangeLog @@ -1,3 +1,7 @@ +1998-12-01 00:27:04 Lars Magne Ingebrigtsen + + * emacs-mime.texi (rfc2045): New. + 1998-11-29 00:03:43 Lars Magne Ingebrigtsen * emacs-mime.texi (Composing): New chapter. diff --git a/texi/emacs-mime.texi b/texi/emacs-mime.texi index a00948d..916878d 100644 --- a/texi/emacs-mime.texi +++ b/texi/emacs-mime.texi @@ -166,6 +166,12 @@ Returns the value of the attribute. @result{} "b980912.gif" @end example +@item mail-header-encode-parameter +@findex mail-header-encode-parameter +Takes a parameter string and returns an encoded version of the string. +This is used for parameters in headers like @code{Content-Type} and +@code{Content-Disposition}. + @item mail-header-remove-comments @findex mail-header-remove-comments Return a comment-free version of a header. @@ -285,6 +291,7 @@ on. High-level functionality is dealt with in the next chapter (@pxref{Decoding and Viewing}). @menu +* rfc2045:: Encoding @code{Content-Type} headers. * rfc2231:: Parsing @code{Content-Type} headers. * ietf-drums:: Handling mail headers defined by RFC822bis. * rfc2047:: En/decoding encoded words in headers. @@ -298,6 +305,24 @@ on. High-level functionality is dealt with in the next chapter @end menu +@node rfc2045 +@section rfc2045 + +RFC2045 is the ``main'' @sc{mime} document, and as such, one would +imagine that there would be a lot to implement. But there isn't, since +most of the implementation details are delegated to the subsequent +RFCs. + +So @file{rfc2045.el} has only a single function: + +@table @code +@item rfc2045-encode-string +@findex rfc2045-encode-string +Takes a parameter and a value and returns a @samp{PARAM=VALUE} string. +@var{value} will be quoted if there are non-safe characters in it. +@end table + + @node rfc2231 @section rfc2231 @@ -337,9 +362,14 @@ elements. @item rfc2231-get-value @findex rfc2231-get-value -Takes one of the lists on the format above and return +Takes one of the lists on the format above and returns the value of the specified attribute. +@item rfc2231-encode-string +@findex rfc2231-encode-string +Encode a parameter in headers likes @code{Content-Type} and +@code{Content-Disposition}. + @end table diff --git a/texi/gnus.texi b/texi/gnus.texi index 1a5fe61..b24ab75 100644 --- a/texi/gnus.texi +++ b/texi/gnus.texi @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @setfilename gnus -@settitle Pterodactyl Gnus 0.56 Manual +@settitle Pterodactyl Gnus 0.58 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.56 Manual +@title Pterodactyl Gnus 0.58 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.56. +This manual corresponds to Pterodactyl Gnus 0.58. @end ifinfo diff --git a/texi/message.texi b/texi/message.texi index f3d0e15..d65d8d4 100644 --- a/texi/message.texi +++ b/texi/message.texi @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @setfilename message -@settitle Pterodactyl Message 0.57 Manual +@settitle Pterodactyl Message 0.58 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.57 Manual +@title Pterodactyl Message 0.58 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.57. Message is +This manual corresponds to Pterodactyl Message 0.58. Message is distributed with the Gnus distribution bearing the same version number as this manual. -- 1.7.10.4