From 0d1720aee995af053638966ad6bcf16698575735 Mon Sep 17 00:00:00 2001 From: yamaoka Date: Sun, 29 Nov 1998 22:29:08 +0000 Subject: [PATCH] Importing Pterodactyl Gnus v0.56. --- lisp/ChangeLog | 40 ++++++++ lisp/base64.el | 22 ++--- lisp/binhex.el | 24 ++--- lisp/gnus-art.el | 92 ++++++++++-------- lisp/gnus-sum.el | 6 +- lisp/gnus.el | 2 +- lisp/message.el | 79 +++++++++++++--- lisp/mm-bodies.el | 44 ++++++--- lisp/mm-decode.el | 24 ----- lisp/mm-util.el | 15 ++- lisp/mm-view.el | 2 +- lisp/mml.el | 122 ++++++++++++++++++++---- lisp/uudecode.el | 22 ++--- make.bat | 128 ++++++++++++------------- texi/ChangeLog | 8 ++ texi/Makefile.in | 2 +- texi/emacs-mime.texi | 252 +++++++++++++++++++++++++++++++++++++++++++++++++- texi/gnus.texi | 6 +- texi/message.texi | 6 +- 19 files changed, 659 insertions(+), 237 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index c2e8f7a..79cbebc 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,43 @@ +Sun Nov 29 15:12:52 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.56 is released. + +1998-11-29 00:52:53 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-mime-display-part): New function. + (gnus-mime-display-mixed): Use it. + + * mm-view.el (mm-setup-w3): Don't register. + + * message.el (message-cite-original): Cite parts. + +1998-11-28 23:51:25 Lars Magne Ingebrigtsen + + * mml.el (mml-parameter-string): New function. + (mml-insert-mime-headers): Separated into new function. + +1998-11-28 Hrvoje Niksic + + * mml.el (mml-make-boundary): Use `make-string'. + +1998-11-27 Hrvoje Niksic + + * binhex.el (binhex-insert-char): Ditto. + + * base64.el (base64-insert-char): Ditto. + + * uudecode.el (uudecode-insert-char): Code correctly. + +1998-11-28 01:08:19 Lars Magne Ingebrigtsen + + * mml.el (mml-generate-mime): Don't generate multiparts for + empties. + + * gnus-art.el (gnus-display-mime): Save excursion. + + * message.el (message-remove-first-header): New function. + (message-encode-message-body): Use it. + Fri Nov 27 12:26:10 1998 Lars Magne Ingebrigtsen * gnus.el: Pterodactyl Gnus v0.55 is released. diff --git a/lisp/base64.el b/lisp/base64.el index 5abc827..0c562d1 100644 --- a/lisp/base64.el +++ b/lisp/base64.el @@ -98,21 +98,13 @@ base64-encoder-program.") (delete-file tempfile) (error nil))))) -(defun base64-insert-char (char &optional count ignored buffer) - (condition-case nil - (progn - (insert-char char count ignored buffer) - (fset 'base64-insert-char 'insert-char)) - (wrong-number-of-arguments - (fset 'base64-insert-char 'base64-xemacs-insert-char) - (base64-insert-char char count ignored buffer)))) - -(defun base64-xemacs-insert-char (char &optional count ignored buffer) - (if (or (null buffer) (eq buffer (current-buffer))) - (insert-char char count) - (save-excursion - (set-buffer buffer) - (insert-char char count)))) +(if (string-match "XEmacs" emacs-version) + (defalias 'base64-insert-char 'insert-char) + (defun base64-insert-char (char &optional count ignored buffer) + (if (or (null buffer) (eq buffer (current-buffer))) + (insert-char char count) + (with-current-buffer buffer + (insert-char char count))))) (defun base64-decode-region (start end) (interactive "r") diff --git a/lisp/binhex.el b/lisp/binhex.el index a8f37a2..3017479 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.2 $ +;; $Revision: 1.1.1.3 $ ;; Time-stamp: ;; Keywords: binhex @@ -65,21 +65,13 @@ input and write the converted data to its standard output.") (defvar binhex-temporary-file-directory "/tmp/") -(defun binhex-insert-char (char &optional count ignored buffer) - (condition-case nil - (progn - (insert-char char count ignored buffer) - (fset 'binhex-insert-char 'insert-char)) - (wrong-number-of-arguments - (fset 'binhex-insert-char 'binhex-xemacs-insert-char) - (binhex-insert-char char count ignored buffer)))) - -(defun binhex-xemacs-insert-char (char &optional count ignored buffer) - (if (or (null buffer) (eq buffer (current-buffer))) - (insert-char char count) - (save-excursion - (set-buffer buffer) - (insert-char char count)))) +(if (string-match "XEmacs" emacs-version) + (defalias 'binhex-insert-char 'insert-char) + (defun binhex-insert-char (char &optional count ignored buffer) + (if (or (null buffer) (eq buffer (current-buffer))) + (insert-char char count) + (with-current-buffer buffer + (insert-char char count))))) (defvar binhex-crc-table [0 4129 8258 12387 16516 20645 24774 28903 diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 65d38ce..7ea2327 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -2227,10 +2227,8 @@ If ALL-HEADERS is non-nil, no headers are hidden." (gnus-run-hooks 'gnus-tmp-internal-hook) (gnus-run-hooks 'gnus-article-prepare-hook) (when gnus-display-mime-function - ;(let ((url-standalone-mode (not gnus-plugged))) - (funcall gnus-display-mime-function) - ) - ;) + (let ((url-standalone-mode (not gnus-plugged))) + (funcall gnus-display-mime-function))) ;; Perform the article display hooks. (gnus-run-hooks 'gnus-article-display-hook))) @@ -2260,8 +2258,8 @@ If ALL-HEADERS is non-nil, no headers are hidden." ;(gnus-mime-view-part "\M-\r" "View Interactively...") (gnus-mime-view-part "v" "View Interactively...") (gnus-mime-save-part "o" "Save...") - (gnus-mime-copy-part "c" "View In Buffer") - (gnus-mime-inline-part "i" "View Inline") + (gnus-mime-copy-part "c" "View As Text, In Other Buffer") + (gnus-mime-inline-part "i" "View As Text, In This Buffer") (gnus-mime-externalize-part "e" "View Externally") (gnus-mime-pipe-part "|" "Pipe To Command..."))) @@ -2497,34 +2495,48 @@ If ALL-HEADERS is non-nil, no headers are hidden." (defun gnus-display-mime (&optional ihandles) "Insert MIME buttons in the buffer." - (save-selected-window - (let ((window (get-buffer-window gnus-article-buffer))) - (when window - (select-window window))) - (let* ((handles (or ihandles (mm-dissect-buffer) (mm-uu-dissect))) - handle name type b e display) - (unless ihandles - ;; Top-level call; we clean up. - (mm-destroy-parts gnus-article-mime-handles) - (setq gnus-article-mime-handles handles - gnus-article-mime-handle-alist nil) - ;; We allow users to glean info from the handles. - (when gnus-article-mime-part-function - (gnus-mime-part-function handles))) - (when (and handles - (or (not (stringp (car handles))) - (cdr handles))) + (save-excursion + (save-selected-window + (let ((window (get-buffer-window gnus-article-buffer))) + (when window + (select-window window))) + (let* ((handles (or ihandles (mm-dissect-buffer) (mm-uu-dissect))) + handle name type b e display) (unless ihandles - ;; Clean up for mime parts. - (article-goto-body) - (delete-region (point) (point-max))) - (if (stringp (car handles)) - (if (equal (car handles) "multipart/alternative") - (let ((id (1+ (length gnus-article-mime-handle-alist)))) - (push (cons id handles) gnus-article-mime-handle-alist) - (gnus-mime-display-alternative (cdr handles) nil nil id)) - (gnus-mime-display-mixed (cdr handles))) - (gnus-mime-display-single handles)))))) + ;; Top-level call; we clean up. + (mm-destroy-parts gnus-article-mime-handles) + (setq gnus-article-mime-handles handles + gnus-article-mime-handle-alist nil) + ;; We allow users to glean info from the handles. + (when gnus-article-mime-part-function + (gnus-mime-part-function handles))) + (when (and handles + (or (not (stringp (car handles))) + (cdr handles))) + (unless ihandles + ;; Clean up for mime parts. + (article-goto-body) + (delete-region (point) (point-max))) + (gnus-mime-display-part handles)))))) + +(defun gnus-mime-display-part (handle) + (cond + ;; Single part. + ((not (stringp (car handle))) + (gnus-mime-display-single handle)) + ;; multipart/alternative + ((equal (car handle) "multipart/alternative") + (let ((id (1+ (length gnus-article-mime-handle-alist)))) + (push (cons id handle) gnus-article-mime-handle-alist) + (gnus-mime-display-alternative (cdr handle) nil nil id))) + ;; multipart/related + ((equal (car handle) "multipart/related") + ;;;!!!We should find the start part, but we just default + ;;;!!!to the first part. + (gnus-mime-display-part (cadr handle))) + ;; Other multiparts are handled like multipart/mixed. + (t + (gnus-mime-display-mixed (cdr handle))))) (defun gnus-mime-part-function (handles) (if (stringp (car handles)) @@ -2534,13 +2546,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." (defun gnus-mime-display-mixed (handles) (let (handle) (while (setq handle (pop handles)) - (if (stringp (car handle)) - (if (equal (car handle) "multipart/alternative") - (let ((id (1+ (length gnus-article-mime-handle-alist)))) - (push (cons id handle) gnus-article-mime-handle-alist) - (gnus-mime-display-alternative (cdr handle) nil nil id)) - (gnus-mime-display-mixed (cdr handle))) - (gnus-mime-display-single handle))))) + (gnus-mime-display-part handle)))) (defun gnus-mime-display-single (handle) (let ((type (car (mm-handle-type handle))) @@ -3803,7 +3809,7 @@ forbidden in URL encoding." (select-window win))) (defvar gnus-decode-header-methods - '(mail-decode-encoded-word-region) + '(gnus-decode-with-mail-decode-encoded-word-region) "List of methods used to decode headers This variable is a list of FUNCTION or (REGEXP . FUNCTION). If item is @@ -3819,6 +3825,10 @@ For example: (defvar gnus-decode-header-methods-cache nil) +(defun gnus-decode-with-mail-decode-encoded-word-region (start end) + (let ((rfc2047-default-charset gnus-default-charset)) + (mail-decode-encoded-word-region start end))) + (defun gnus-multi-decode-header (start end) "Apply the functions from `gnus-encoded-word-methods' that match." (unless (and gnus-decode-header-methods-cache diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 70df894..aedd26d 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -797,6 +797,10 @@ which it may alter in any way.") :group 'gnus-summary :type 'regexp) +(defcustom gnus-default-charset 'iso-8859-1 + "Default charset assumed to be used when viewing non-ASCII characters. +This variable is used only in non-Mule Emacsen.") + (defcustom gnus-newsgroup-default-charset-alist '(("^hk\\>\\|^tw\\>\\|\\" . cn-big5) ("^cn\\>\\|\\" . cn-gb-2312) @@ -9174,7 +9178,7 @@ save those articles instead." (setq alist nil charset (cdr elem)))) charset))) - rfc2047-default-charset)) + gnus-default-charset)) (setq gnus-newsgroup-iso-8859-1-forced (and gnus-newsgroup-name (or (gnus-group-find-parameter diff --git a/lisp/gnus.el b/lisp/gnus.el index 5819603..db8d2e7 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.55" +(defconst gnus-version-number "0.56" "Version number for this version of Gnus.") (defconst gnus-version (format "Pterodactyl Gnus v%s" gnus-version-number) diff --git a/lisp/message.el b/lisp/message.el index 87ffcb4..aee3460 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -448,6 +448,11 @@ The function `message-setup' runs this hook." :group 'message-various :type 'hook) +(defcustom message-cancel-hook nil + "Hook run when cancelling articles." + :group 'message-various + :type 'hook) + (defcustom message-signature-setup-hook nil "Normal hook, run each time a new outgoing message is initialized. It is run after the headers have been inserted and before @@ -832,7 +837,7 @@ Defaults to `text-mode-abbrev-table'.") "\\([" cite-prefix "]+[" cite-suffix "]*\\)?" "[:>|}].*") (0 'message-cited-text-face)) - ("<#/?\\(multi\\)part.*>" + ("<#/?\\(multipart\\|part\\|external\\).*>" (0 'message-mml-face)))) "Additional expressions to highlight in Message mode.") @@ -878,9 +883,12 @@ The cdr of ech entry is a function for applying the face to a region.") 'escape-quoted 'emacs-mule) "Coding system to compose mail.") +(defvar message-default-charset 'iso-8859-1 + "Default charset assumed to be used when viewing non-ASCII characters. +This variable is used only in non-Mule Emacsen.") + ;;; Internal variables. -(defvar message-default-charset nil) (defvar message-buffer-list nil) (defvar message-this-is-news nil) (defvar message-this-is-mail nil) @@ -1147,6 +1155,18 @@ Return the number of headers removed." (goto-char (point-max))))) number)) +(defun message-remove-first-header (header) + "Remove the first instance of HEADER if there is more than one." + (let ((count 0) + (regexp (concat "^" (regexp-quote header) ":"))) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward regexp nil t) + (incf count))) + (while (> count 1) + (message-remove-header header nil t) + (decf count)))) + (defun message-narrow-to-headers () "Narrow the buffer to the head of the message." (widen) @@ -1297,6 +1317,8 @@ Point is left at the beginning of the narrowed-to region." (define-key message-mode-map "\M-\r" 'message-newline-and-reformat) (define-key message-mode-map "\C-c\C-a" 'message-insert-mime-part) + (define-key message-mode-map "\C-c\C-m\C-a" 'message-insert-mime-part) + (define-key message-mode-map "\C-c\C-m\C-e" 'message-mime-insert-external) (define-key message-mode-map "\t" 'message-tab)) @@ -1833,7 +1855,7 @@ prefix, and don't delete any headers." (list message-indent-citation-function))))) (goto-char start) ;; Quote parts. - (while (re-search-forward "<#/?!*\\(multi\\|part\\)>" end t) + (while (re-search-forward "<#/?!*\\(multipart\\|part\\|external\\)" end t) (goto-char (match-beginning 1)) (insert "!")) (goto-char end) @@ -1867,7 +1889,8 @@ prefix, and don't delete any headers." (list message-indent-citation-function))))) (goto-char start) ;; Quote parts. - (while (re-search-forward "<#/?!*\\(multi\\|part\\)>" end t) + (while (re-search-forward + "<#/?!*\\(multipart\\|part\\|external\\)" end t) (goto-char (match-beginning 1)) (insert "!")) (goto-char start) @@ -3620,6 +3643,7 @@ responses here are directed to other newsgroups.")) "") mail-header-separator "\n" message-cancel-message) + (run-hooks 'message-cancel-hook) (message "Canceling your article...") (if (let ((message-syntax-checks 'dont-check-for-anything-just-trust-me)) @@ -4107,7 +4131,7 @@ regexp varstr." ;;; MIME functions ;;; -(defun message-insert-mime-part (file type) +(defun message-insert-mime-part (file type description) "Insert a multipart/alternative part into the buffer." (interactive (let* ((file (read-file-name "Insert file: " nil nil t)) @@ -4117,24 +4141,45 @@ regexp varstr." (format "MIME type for %s: " file) (delete-duplicates (mapcar (lambda (m) (list (cdr m))) mailcap-mime-extensions)) + nil nil type) + (read-string "Description: ")))) + (insert (format "<#part type=%s filename=\"%s\"%s><#/part>\n" + type file + (if (zerop (length description)) + "" + (format " description=%s" + (prin1-to-string description)))))) + +(defun message-mime-insert-external (file type) + "Insert a message/external-body part into the buffer." + (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 "<#part type=%s filename=\"%s\"><#/part>\n" + (insert (format "<#external type=%s name=\"%s\"><#/external>\n" type file))) (defun message-encode-message-body () - (let (lines multipart-p) + (let ((mm-default-charset message-default-charset) + lines multipart-p) (message-goto-body) (save-restriction (narrow-to-region (point) (point-max)) (let ((new (mml-generate-mime))) - (delete-region (point-min) (point-max)) - (insert new) - (goto-char (point-min)) - (if (eq (aref new 0) ?\n) - (delete-char 1) - (search-forward "\n\n") - (setq lines (buffer-substring (point-min) (1- (point)))) - (delete-region (point-min) (point))))) + (when new + (delete-region (point-min) (point-max)) + (insert new) + (goto-char (point-min)) + (if (eq (aref new 0) ?\n) + (delete-char 1) + (search-forward "\n\n") + (setq lines (buffer-substring (point-min) (1- (point)))) + (delete-region (point-min) (point)))))) (save-restriction (message-narrow-to-headers-or-head) (message-remove-header "Mime-Version") @@ -4145,6 +4190,10 @@ regexp varstr." (setq multipart-p (re-search-backward "^Content-Type: multipart/" nil t))) (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 09a776e..2cf5a4f 100644 --- a/lisp/mm-bodies.el +++ b/lisp/mm-bodies.el @@ -33,6 +33,10 @@ (require 'qp) (require 'uudecode) +;; 8bit treatment gets any char except: 0x32 - 0x7f, CR, LF, TAB, BEL, +;; BS, vertical TAB, form feed, and ^_ +(defvar mm-8bit-char-regexp "[^\x20-\x7f\r\n\t\x7\x8\xb\xc\x1f]") + (defun mm-encode-body () "Encode a body. Should be called narrowed to the body that is to be encoded. @@ -41,7 +45,15 @@ MULE charsets are returned. If successful, the MIME charset is returned. If no encoding was done, nil is returned." (if (not (featurep 'mule)) - 'iso-8859-1 + ;; In the non-Mule case, we search for non-ASCII chars and + ;; return the value of `mm-default-charset' if any are found. + (save-excursion + (goto-char (point-min)) + (if (re-search-forward "[^\x0-\x7f]" nil t) + mm-default-charset + ;; The logic in `mml-generate-mime-1' confirms that it's OK + ;; to return nil here. + nil)) (save-excursion (goto-char (point-min)) (let ((charsets @@ -81,18 +93,24 @@ If no encoding was done, nil is returned." (defun mm-body-encoding () "Return the encoding of the current buffer." - (if (and - (featurep 'mule) - (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)) + (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)) + (skip-chars-forward "\0-\177") + (eobp))) + '7bit + '8bit)))) ;;; ;;; Functions for decoding diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el index 196f8cc..565c520 100644 --- a/lisp/mm-decode.el +++ b/lisp/mm-decode.el @@ -529,30 +529,6 @@ This overrides entries in the mailcap file." (< (glyph-height (annotation-glyph image)) (window-pixel-height))))) -(defun url-cid (url) - (set-buffer (get-buffer-create url-working-buffer)) - (let ((content-type nil) - (encoding nil) - (part nil) - (data nil)) - (if (not (string-match "^cid:\\(.*\\)" url)) - (message "Malformed CID URL: %s" url) - (setq url (url-unhex-string (match-string 1 url)) - part (mm-get-content-id url)) - (if (not part) - (message "Unknown CID encounterred: %s" url) - (setq data (buffer-string nil nil (mm-handle-buffer part)) - content-type (mm-handle-type part) - encoding (symbol-name (mm-handle-encoding part))) - (if (= 0 (length content-type)) (setq content-type "text/plain")) - (if (= 0 (length encoding)) (setq encoding "8bit")) - (setq url-current-content-length (length data) - url-current-mime-type content-type - url-current-mime-encoding encoding - url-current-mime-headers (list (cons "content-type" content-type) - (cons "content-encoding" encoding))) - (and data (insert data)))))) - (provide 'mm-decode) ;; mm-decode.el ends here diff --git a/lisp/mm-util.el b/lisp/mm-util.el index 29c65ac..b7811b2 100644 --- a/lisp/mm-util.el +++ b/lisp/mm-util.el @@ -24,8 +24,10 @@ ;;; Code: +(defvar mm-running-xemacs (string-match "XEmacs" emacs-version)) + (defvar mm-binary-coding-system - (if (string-match "XEmacs" emacs-version) + (if mm-running-xemacs 'binary 'no-conversion) "100% binary coding system.") @@ -33,7 +35,13 @@ "The default coding system to use.") (defvar mm-known-charsets '(iso-8859-1) - "List of known charsets.") + "List of known charsets. +Use this under non-Mule Emacsen to specify which charsets your Emacs +can display. Also see `mm-default-charset'.") + +(defvar mm-default-charset 'iso-8859-1 + "Default charset assumed to be used when viewing non-ASCII characters. +This variable is used only in non-Mule Emacsen.") (defvar mm-mime-mule-charset-alist '((us-ascii ascii) @@ -154,7 +162,8 @@ used as the line break code type of the coding system." (cond ;; Running in a non-MULE environment. ((and (null (mm-get-coding-system-list)) - (memq charset mm-known-charsets)) + (or (eq charset mm-default-charset) + (memq charset mm-known-charsets))) charset) ;; ascii ((eq charset 'us-ascii) diff --git a/lisp/mm-view.el b/lisp/mm-view.el index d366bdc..74a4703 100644 --- a/lisp/mm-view.el +++ b/lisp/mm-view.el @@ -45,7 +45,7 @@ (w3-do-setup) (require 'url) (require 'w3-vars) - (url-register-protocol 'cid nil 'url-identity-expander) + (load "url-misc.el") (setq mm-w3-setup t))) (defun mm-inline-text (handle) diff --git a/lisp/mml.el b/lisp/mml.el index 01c4773..a7f7ffc 100644 --- a/lisp/mml.el +++ b/lisp/mml.el @@ -27,6 +27,9 @@ (require 'mm-bodies) (require 'mm-encode) +(eval-and-compile + (autoload 'message-make-message-id "message")) + (defvar mml-syntax-table (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table))) (modify-syntax-entry ?\\ "/" table) @@ -61,6 +64,9 @@ ((looking-at "<#part") (push (nconc (mml-read-tag) (list (cons 'contents (mml-read-part)))) struct)) + ((looking-at "<#external") + (push (nconc (mml-read-tag) (list (cons 'contents (mml-read-part)))) + struct)) (t (push (list 'part '(type . "text/plain") (cons 'contents (mml-read-part))) struct)))) @@ -91,10 +97,10 @@ ;; If the tag ended at the end of the line, we go to the next line. (when (looking-at "[ \t]*\n") (forward-line 1)) - (if (re-search-forward "<#/?\\(multi\\)?part." nil t) + (if (re-search-forward "<#/?\\(multipart\\|part\\|external\\)." nil t) (prog1 (buffer-substring beg (match-beginning 0)) - (if (not (equal (match-string 0) "<#/part>")) + (if (equal (match-string 0) "<#/multipart>") (goto-char (match-beginning 0)) (when (looking-at "[ \t]*\n") (forward-line 1)))) @@ -108,18 +114,20 @@ "Generate a MIME message based on the current MML document." (let ((cont (mml-parse)) (mml-multipart-number 0)) - (with-temp-buffer - (if (and (consp (car cont)) - (= (length cont) 1)) - (mml-generate-mime-1 (car cont)) - (mml-generate-mime-1 (nconc (list 'multipart '(type . "mixed")) - cont))) - (buffer-string)))) + (if (not cont) + nil + (with-temp-buffer + (if (and (consp (car cont)) + (= (length cont) 1)) + (mml-generate-mime-1 (car cont)) + (mml-generate-mime-1 (nconc (list 'multipart '(type . "mixed")) + cont))) + (buffer-string))))) (defun mml-generate-mime-1 (cont) (cond ((eq (car cont) 'part) - (let (coded encoding charset filename type) + (let (coded encoding charset filename type parameters) (setq type (or (cdr (assq 'type cont)) "text/plain")) (if (equal (car (split-string type "/")) "text") (with-temp-buffer @@ -130,7 +138,8 @@ (insert (cdr (assq 'contents cont))) ;; Remove quotes from quoted tags. (goto-char (point-min)) - (while (re-search-forward "<#!+\\(part\\|multipart\\)" nil t) + (while (re-search-forward + "<#!+\\(part\\|multipart\\|external\\)" nil t) (delete-region (+ (match-beginning 0) 2) (+ (match-beginning 0) 3))))) (setq charset (mm-encode-body) @@ -142,16 +151,38 @@ (insert (cdr (assq 'contents cont)))) (setq encoding (mm-encode-buffer type) coded (buffer-string)))) - (when (or charset - (not (equal type "text/plain"))) - (insert "Content-Type: " type) - (when charset - (insert (format "; charset=\"%s\"" charset))) - (insert "\n")) - (unless (eq encoding '7bit) - (insert (format "Content-Transfer-Encoding: %s\n" encoding))) + (mml-insert-mime-headers cont type charset encoding) (insert "\n") (insert coded))) + ((eq (car cont) 'external) + (insert "Content-Type: message/external-body") + (let ((parameters (mml-parameter-string + cont '(expiration size permission))) + (name (cdr (assq 'name cont)))) + (when name + (setq name (mml-parse-file-name name)) + (if (stringp name) + (insert ";\n name=\"" (prin1-to-string 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)))) + (insert ";\n access-type=" + (if (member (nth 0 name) '("ftp@" "anonymous@")) + "anon-ftp" + "ftp")))) + (when parameters + (insert parameters))) + (insert "\n\n") + (insert "Content-Type: " (cdr (assq 'type cont)) "\n") + (insert "Content-ID: " (message-make-message-id) "\n") + (insert "Content-Transfer-Encoding: " + (or (cdr (assq 'encoding cont)) "binary")) + (insert "\n\n") + (insert (or (cdr (assq 'contents cont)))) + (insert "\n")) ((eq (car cont) 'multipart) (let ((mml-boundary (mml-compute-boundary cont))) (insert (format "Content-Type: multipart/%s; boundary=\"%s\"\n" @@ -192,7 +223,7 @@ t)) (defun mml-make-boundary () - (concat (mml-make-string (% (incf mml-multipart-number) 60) "=") + (concat (make-string (% (incf mml-multipart-number) 60) ?=) (if (> mml-multipart-number 17) (format "%x" mml-multipart-number) "") @@ -204,6 +235,57 @@ (setq out (concat out string))) out)) +(defun mml-insert-mime-headers (cont type charset encoding) + (let (parameters disposition description) + (when (or charset + (setq parameters + (mml-parameter-string + cont '(name access-type expiration size permission))) + (not (equal type "text/plain"))) + (insert "Content-Type: " type) + (when charset + (insert (format "; charset=\"%s\"" charset))) + (when parameters + (insert parameters)) + (insert "\n")) + (when (or (setq disposition (cdr (assq 'disposition cont))) + (setq parameters + (mml-parameter-string + cont '(filename creation-date modification-date + read-date)))) + (insert "Content-Disposition: " (or disposition "inline")) + (when parameters + (insert parameters)) + (insert "\n")) + (unless (eq encoding '7bit) + (insert (format "Content-Transfer-Encoding: %s\n" encoding))) + (when (setq description (cdr (assq 'description cont))) + (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))))) + (when (not (zerop (length string))) + string))) + +(defvar ange-ftp-path-format) +(defvar efs-path-regexp) +(defun mml-parse-file-name (path) + (if (if (boundp 'efs-path-regexp) + (string-match efs-path-regexp path) + (if (boundp 'ange-ftp-path-format) + (string-match (car ange-ftp-path-format)))) + (list (match-string 1 path) (match-string 2 path) + (substring path (1+ (match-end 2)))) + path)) + (provide 'mml) ;;; mml.el ends here diff --git a/lisp/uudecode.el b/lisp/uudecode.el index 3d03c5d..eb97109 100644 --- a/lisp/uudecode.el +++ b/lisp/uudecode.el @@ -106,21 +106,13 @@ If FILE-NAME is non-nil, save the result to FILE-NAME." (error)) ))) -(defun uudecode-insert-char (char &optional count ignored buffer) - (condition-case nil - (progn - (insert-char char count ignored buffer) - (fset 'uudecode-insert-char 'insert-char)) - (wrong-number-of-arguments - (fset 'uudecode-insert-char 'uudecode-xemacs-insert-char) - (uudecode-insert-char char count ignored buffer)))) - -(defun uudecode-xemacs-insert-char (char &optional count ignored buffer) - (if (or (null buffer) (eq buffer (current-buffer))) - (insert-char char count) - (save-excursion - (set-buffer buffer) - (insert-char char count)))) +(if (string-match "XEmacs" emacs-version) + (defalias 'uudecode-insert-char 'insert-char) + (defun uudecode-insert-char (char &optional count ignored buffer) + (if (or (null buffer) (eq buffer (current-buffer))) + (insert-char char count) + (with-current-buffer buffer + (insert-char char count))))) ;;;###autoload diff --git a/make.bat b/make.bat index c3c9e2e..b203277 100755 --- a/make.bat +++ b/make.bat @@ -1,64 +1,64 @@ -@echo off - -rem Written by David Charlap - -rem There are two catches, however. The emacs.bat batch file may not exist -rem in all distributions. It is part of the Voelker build of Emacs 19.34 -rem (http://www.cs.washington.edu/homes/voelker/ntemacs.html). If the user -rem installs Gnus with some other build, he may have to replace calls to -rem %1\emacs.bat with something else. -rem -rem Also, the emacs.bat file that Voelker ships does not accept more than 9 -rem parameters, so the attempts to compile the .texi files will fail. To -rem fix that (at least on NT. I don't know about Win95), the following -rem change should be made to emacs.bat: -rem -rem %emacs_dir%\bin\emacs.exe %1 %2 %3 %4 %5 %6 %7 %8 %9 -rem -rem should become -rem -rem %emacs_dir%\bin\emacs.exe %* -rem -rem which will allow the batch file to accept an unlimited number of -rem parameters. - -rem Clear PWD so emacs doesn't get confused -set GNUS_PWD_SAVE=%PWD% -set PWD= - -if "%1" == "" goto usage - -cd lisp -call %1\bin\emacs.bat -batch -q -no-site-file -l ./dgnushack.el -f dgnushack-compile -if not "%2" == "copy" goto info -copy *.el* %1\lisp - -:info -cd ..\texi -call %1\bin\emacs.bat -batch -q -no-site-file gnus.texi -l texinfmt -f texinfo-every-node-update -f texinfo-format-buffer -f save-buffer -call %1\bin\emacs.bat -batch -q -no-site-file message.texi -l texinfmt -f texinfo-every-node-update -f texinfo-format-buffer -f save-buffer -if not "%2" == "copy" goto done -copy gnus %1\info -copy gnus-?? %1\info -copy message %1\info - -:etc -cd ..\etc -copy gnus-tut.txt %1\etc - -:done -cd .. -goto end - -:usage -echo Usage: make ^ [copy] -echo. -echo where: ^ is the directory you installed emacs in -echo eg. d:\emacs\19.34 -echo copy indicates that the compiled files should be copied to your -echo emacs lisp, info, and etc directories - -rem Restore PWD so whoever called this batch file doesn't get confused -set PWD=%GNUS_PWD_SAVE% -set GNUS_PWD_SAVE= -:end +@echo off + +rem Written by David Charlap + +rem There are two catches, however. The emacs.bat batch file may not exist +rem in all distributions. It is part of the Voelker build of Emacs 19.34 +rem (http://www.cs.washington.edu/homes/voelker/ntemacs.html). If the user +rem installs Gnus with some other build, he may have to replace calls to +rem %1\emacs.bat with something else. +rem +rem Also, the emacs.bat file that Voelker ships does not accept more than 9 +rem parameters, so the attempts to compile the .texi files will fail. To +rem fix that (at least on NT. I don't know about Win95), the following +rem change should be made to emacs.bat: +rem +rem %emacs_dir%\bin\emacs.exe %1 %2 %3 %4 %5 %6 %7 %8 %9 +rem +rem should become +rem +rem %emacs_dir%\bin\emacs.exe %* +rem +rem which will allow the batch file to accept an unlimited number of +rem parameters. + +rem Clear PWD so emacs doesn't get confused +set GNUS_PWD_SAVE=%PWD% +set PWD= + +if "%1" == "" goto usage + +cd lisp +call %1\bin\emacs.bat -batch -q -no-site-file -l ./dgnushack.el -f dgnushack-compile +if not "%2" == "copy" goto info +copy *.el* %1\lisp + +:info +cd ..\texi +call %1\bin\emacs.bat -batch -q -no-site-file gnus.texi -l texinfmt -f texinfo-every-node-update -f texinfo-format-buffer -f save-buffer +call %1\bin\emacs.bat -batch -q -no-site-file message.texi -l texinfmt -f texinfo-every-node-update -f texinfo-format-buffer -f save-buffer +if not "%2" == "copy" goto done +copy gnus %1\info +copy gnus-?? %1\info +copy message %1\info + +:etc +cd ..\etc +copy gnus-tut.txt %1\etc + +:done +cd .. +goto end + +:usage +echo Usage: make ^ [copy] +echo. +echo where: ^ is the directory you installed emacs in +echo eg. d:\emacs\19.34 +echo copy indicates that the compiled files should be copied to your +echo emacs lisp, info, and etc directories + +rem Restore PWD so whoever called this batch file doesn't get confused +set PWD=%GNUS_PWD_SAVE% +set GNUS_PWD_SAVE= +:end diff --git a/texi/ChangeLog b/texi/ChangeLog index 60671c8..b2c444f 100644 --- a/texi/ChangeLog +++ b/texi/ChangeLog @@ -1,3 +1,11 @@ +1998-11-29 00:03:43 Lars Magne Ingebrigtsen + + * emacs-mime.texi (Composing): New chapter. + +1998-11-25 Karl Eichwalder + + * Makefile.in (install): Remove emacs-info, add emacs-mime. + 1998-11-25 10:56:08 Lars Magne Ingebrigtsen * gnus.texi (To From Newsgroups): Addition. diff --git a/texi/Makefile.in b/texi/Makefile.in index c74b8b2..c122828 100644 --- a/texi/Makefile.in +++ b/texi/Makefile.in @@ -116,7 +116,7 @@ distclean: install: $(SHELL) $(top_srcdir)/mkinstalldirs $(infodir) - @for file in gnus message emacs-info; do \ + @for file in gnus message emacs-mime; do \ for ifile in `echo $$file $$file-[0-9] $$file-[0-9][0-9]`; do \ if test -f $$ifile; then \ echo " $(INSTALL_DATA) $$ifile $(infodir)/$$ifile"; \ diff --git a/texi/emacs-mime.texi b/texi/emacs-mime.texi index 122f513..a00948d 100644 --- a/texi/emacs-mime.texi +++ b/texi/emacs-mime.texi @@ -89,6 +89,7 @@ read at least RFC2045 and RFC2047. * Interface Functions:: An abstraction over the basic functions. * Basic Functions:: Utility and basic parsing functions. * Decoding and Viewing:: A framework for decoding and viewing. +* Composing:: MML; a language for describing MIME parts. * Standards:: A summary of RFCs and working documents used. * Index:: Function and variable index. @end menu @@ -810,7 +811,249 @@ Offer to pipe the part to some process. Prompt for a mailcap method to use to view the part. @end table - + + +@node Composing +@chapter Composing +@cindex Composing +@cindex MIME Composing +@cindex MML +@cindex MIME Meta Language + +Creating a @sc{mime} message is boring and non-trivial. Therefore, a +library called @code{mml} has been defined that parses a language called +MML (@sc{mime} Meta Language) and generates @sc{mime} messages. + +@findex mml-generate-mime +The main interface function is @code{mml-generate-mime}. It will +examine the contents of the current (narrowed-to) buffer and return a +string containing the @sc{mime} message. + +@menu +* Simple MML Example:: An example MML document. +* MML Definition:: All valid MML elements. +* Advanced MML Example:: Another example MML document. +@end menu + + +@node Simple MML Example +@section Simple MML Example + +Here's a simple @samp{multipart/alternative}: + +@example +<#multipart type=alternative> +This is a plain text part. +<#part type=text/enriched> +
This is a centered enriched part
+<#/multipart> +@end example + +After running this through @code{mml-generate-mime}, we get this: + +@example +Content-Type: multipart/alternative; boundary="=-=-=" + + +--=-=-= + + +This is a plain text part. + +--=-=-= +Content-Type: text/enriched + + +
This is a centered enriched part
+ +--=-=-=-- +@end example + + +@node MML Definition +@section MML Definition + +The MML language is very simple. It looks a bit like an SGML +application, but it's not. + +The main concept of MML is the @dfn{part}. Each part can be of a +different type or use a different charset. The way to delineate a part +is with a @samp{<#part ...>} tag. Multipart parts can be introduced +with the @samp{<#multipart ...>} tag. Parts are ended by the +@samp{<#/part>} or @samp{<#/multipart>} tags. Parts started with the +@samp{<#part ...>} tags are also closed by the next open tag. + +There's also the @samp{<#external ...>} tag. These introduce +@samp{external/message-body} parts. + +Each tag can contain zero or more parameters on the form +@samp{parameter=value}. The values may be enclosed in quotation marks, +but that's not necessary unless the value contains white space. So +@samp{filename=/home/user/#hello$^yes} is perfectly valid. + +The following parameters have meaning in MML; parameters that have no +meaning are ignored. The MML parameter names are the same as the +@sc{mime} parameter names; the things in the parentheses say which +header it will be used in. + +@table @samp +@item type +The @sc{mime} type of the part (@code{Content-Type}). + +@item filename +Use the contents of the file in the body of the part +(@code{Content-Disposition}). + +@item charset +The contents of the body of the part are to be encoded in the character +set speficied (@code{Content-Type}). + +@item name +Might be used to suggest a file name if the part is to be saved +to a file (@code{Content-Type}). + +@item disposition +Valid values are @samp{inline} and @samp{attachment} +(@code{Content-Disposition}). + +@item encoding +Valid values are @samp{7bit}, @samp{8bit}, @samp{quoted-printable} and +@samp{base64} (@code{Content-Transfer-Encoding}). + +@item description +A description of the part (@code{Content-Description}). + +@item creation-date +RFC822 date when the part was created (@code{Content-Disposition}). + +@item modification-date +RFC822 date when the part was modified (@code{Content-Disposition}). + +@item read-date +RFC822 date when the part was read (@code{Content-Disposition}). + +@item size +The size (in octets) of the part (@code{Content-Disposition}). + +@end table + +Parameters for @samp{application/octet-stream}: + +@table @samp +@item type +Type of the part; informal---meant for human readers +(@code{Content-Type}). +@end table + +Parameters for @samp{message/external-body}: + +@table @samp +@item access-type +A word indicating the supported access mechanism by which the file may +be obtained. Values include @samp{ftp}, @samp{anon-ftp}, @samp{tftp}, +@samp{localfile}, and @samp{mailserver}. (@code{Content-Type}.) + +@item expiration +The RFC822 date after which the file may no longer be fetched. +(@code{Content-Type}.) + +@item size +The size (in octets) of the file. (@code{Content-Type}.) + +@item permission +Valid values are @samp{read} and @samp{read-write} +(@code{Content-Type}). + +@end table + + +@node Advanced MML Example +@section Advanced MML Example + +Here's a complex multipart message. It's a @samp{multipart/mixed} that +contains many parts, one of which is a @samp{multipart/alternative}. + +@example +<#multipart type=mixed> +<#part type=image/jpeg filename=~/rms.jpg disposition=inline> +<#multipart type=alternative> +This is a plain text part. +<#part type=text/enriched name=enriched.txt> +
This is a centered enriched part
+<#/multipart> +This is a new plain text part. +<#part disposition=attachment> +This plain text part is an attachment. +<#/multipart> +@end example + +And this is the resulting @sc{mime} message: + +@example +Content-Type: multipart/mixed; boundary="=-=-=" + + +--=-=-= + + + +--=-=-= +Content-Type: image/jpeg; + filename="~/rms.jpg" +Content-Disposition: inline; + filename="~/rms.jpg" +Content-Transfer-Encoding: base64 + +/9j/4AAQSkZJRgABAQAAAQABAAD/2wBDAAgGBgcGBQgHBwcJCQgKDBQNDAsLDBkSEw8UHRof +Hh0aHBwgJC4nICIsIxwcKDcpLDAxNDQ0Hyc5PTgyPC4zNDL/wAALCAAwADABAREA/8QAHwAA +AQUBAQEBAQEAAAAAAAAAAAECAwQFBgcICQoL/8QAtRAAAgEDAwIEAwUFBAQAAAF9AQIDAAQR +BRIhMUEGE1FhByJxFDKBkaEII0KxwRVS0fAkM2JyggkKFhcYGRolJicoKSo0NTY3ODk6Q0RF +RkdISUpTVFVWV1hZWmNkZWZnaGlqc3R1dnd4eXqDhIWGh4iJipKTlJWWl5iZmqKjpKWmp6ip +qrKztLW2t7i5usLDxMXGx8jJytLT1NXW19jZ2uHi4+Tl5ufo6erx8vP09fb3+Pn6/9oACAEB +AAA/AO/rifFHjldNuGsrDa0qcSSHkA+gHrXKw+LtWLrMb+RgTyhbr+HSug07xNqV9fQtZrNI +AyiaE/NuBPOOOP0rvRNE880KOC8TbXXGCv1FPqjrF4LDR7u5L7SkTFT/ALWOP1xXgTuXfc7E +sx6nua6rwp4IvvEM8chCxWxOdzn7wz6V9AaB4S07w9p5itow0rDLSY5Pt9K43xO66P4xs71m +2QXiGCbA4yOVJ9+1aYORkdK434lyNH4ahCnG66VT9Nj15JFbPdX0MS43M4VQf5/yr2vSpLnw +5ZW8dlCZ8KFXjOPX0/mK6rSPEGt3Angu44fNEReHYNvIH3TzXDeKNO8RX+kSX2ouZkicTIOc +L+g7E810ulFjpVtv3bwgB3HJyK5L4quY/C9sVxk3ij/xx6850u7t1mtp/wDlpEw3An3Jr3Dw +34gsbWza4nBlhC5LDsaW6+IFgupQyCF3iHH7gA7c9R9ay7zx6t7aX9jHC4smhfBkGCvHGfrm +tLQ7hbnRrV1GPkAP1x1/Hr+Ncr8Vzjwrbf8AX6v/AKA9eQRyYlQk8Yx9K6XTNbkgia2ciSIn +7p5Ga9Atte0LTLKO6it4i7dVRFJDcZ4PvXN+JvEMF9bILVGXJLSZ4zkjivRPDaeX4b08HOTC +pOffmua+KkbS+GLVUGT9tT/0B68eeIpIFYjB70+OOVXyoOM9+M1eaWeCLzHPyHGO/NVWvJJm +jQ8KGH1NfQWhXSXmh2c8eArRLwO3HSv/2Q== + +--=-=-= +Content-Type: multipart/alternative; boundary="==-=-=" + + +--==-=-= + + +This is a plain text part. + +--==-=-= +Content-Type: text/enriched; + name="enriched.txt" + + +
This is a centered enriched part
+ +--==-=-=-- + +--=-=-= + +This is a new plain text part. + +--=-=-= +Content-Disposition: attachment + + +This plain text part is an attachment. + +--=-=-=-- +@end example + + @node Standards @chapter Standards @@ -854,10 +1097,17 @@ ASCII characters @item draft-ietf-drums-msg-fmt-05.txt Draft for the successor of RFC822 +@item RFC2112 +The MIME Multipart/Related Content-type + @item RFC1892 The Multipart/Report Content Type for the Reporting of Mail System Administrative Messages +@item RFC2183 +Communicating Presentation Information in Internet Messages: The +Content-Disposition Header Field + @end table diff --git a/texi/gnus.texi b/texi/gnus.texi index 3ec9b51..1a5fe61 100644 --- a/texi/gnus.texi +++ b/texi/gnus.texi @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @setfilename gnus -@settitle Pterodactyl Gnus 0.55 Manual +@settitle Pterodactyl Gnus 0.56 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.55 Manual +@title Pterodactyl Gnus 0.56 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.55. +This manual corresponds to Pterodactyl Gnus 0.56. @end ifinfo diff --git a/texi/message.texi b/texi/message.texi index b33c0be..651d2a7 100644 --- a/texi/message.texi +++ b/texi/message.texi @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @setfilename message -@settitle Pterodactyl Message 0.55 Manual +@settitle Pterodactyl Message 0.56 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.55 Manual +@title Pterodactyl Message 0.56 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.55. Message is +This manual corresponds to Pterodactyl Message 0.56. Message is distributed with the Gnus distribution bearing the same version number as this manual. -- 1.7.10.4