From 58450d89a9bb6a0bcd1c278b29433d1a5f86f763 Mon Sep 17 00:00:00 2001 From: ichikawa Date: Sun, 15 Nov 1998 03:10:43 +0000 Subject: [PATCH] Importing pgnus-0.46 --- lisp/ChangeLog | 36 +++++++++++++ lisp/gnus-art.el | 4 ++ lisp/gnus-sum.el | 5 +- lisp/gnus.el | 2 +- lisp/message.el | 94 +++++++++------------------------- lisp/mm-encode.el | 65 ++++------------------- lisp/mm-view.el | 3 +- lisp/mml.el | 148 +++++++++++++++++++++++++++++++++++++++++++++++++++++ lisp/nndraft.el | 9 ---- texi/gnus.texi | 6 +-- texi/message.texi | 6 +-- 11 files changed, 232 insertions(+), 146 deletions(-) create mode 100644 lisp/mml.el diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 7329efd..074bb13 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,39 @@ +Sun Nov 15 02:01:31 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.46 is released. + +1998-11-15 01:54:40 Lars Magne Ingebrigtsen + + * message.el (message-encode-message-body): Insert headers at the + right spot. + +Sun Nov 15 01:13:41 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.45 is released. + +1998-11-15 00:28:49 Lars Magne Ingebrigtsen + + * nndraft.el (nndraft-save-mime-part): Removed. + (nndraft-get-mime-part): Ditto. + + * message.el (message-format-mime-old): Removed. + (message-encode-message-body): Removed. + (message-encode-message-body): Renamed. + +1998-11-14 18:27:19 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-get-newsgroup-headers): Translate \r's. + + * message.el (message-format-mime): Check message-mime-part. + + * mm-encode.el (mm-mime-file-types): Removed. + (mm-default-file-encoding): New definition. + +Sat Nov 14 01:29:39 1998 Shenghuo ZHU + + * mm-view.el (mm-inline-image): Use mm-insert-inline. + * gnus-art.el (gnus-mm-display-part): Go to correct position. + Sat Nov 14 05:47:57 1998 Lars Magne Ingebrigtsen * gnus.el: Pterodactyl Gnus v0.44 is released. diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index cedbec9..d1d466b 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -2337,6 +2337,8 @@ If ALL-HEADERS is non-nil, no headers are hidden." (unwind-protect (progn (select-window (get-buffer-window (current-buffer) t)) + (goto-char point) + (forward-line) (mm-display-part handle)) (select-window window)))) (goto-char point)))) @@ -2365,6 +2367,8 @@ If ALL-HEADERS is non-nil, no headers are hidden." (if gnus-tmp-description (concat " (" gnus-tmp-description ")") "")) + (unless (bolp) + (insert "\n")) (setq b (point)) (gnus-eval-format gnus-mime-button-line-format gnus-mime-button-line-format-alist diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 06c6cdf..8485f0e 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -4481,6 +4481,7 @@ The resulting hash table is returned, or nil if no Xrefs were found." (set-buffer nntp-server-buffer) ;; Translate all TAB characters into SPACE characters. (subst-char-in-region (point-min) (point-max) ?\t ? t) + (subst-char-in-region (point-min) (point-max) ?\r ? t) (gnus-run-hooks 'gnus-parse-headers-hook) (let ((case-fold-search t) in-reply-to header p lines chars) @@ -4633,9 +4634,7 @@ list of headers that match SEQUENCE (see `nntp-retrieve-headers')." number headers header) (save-excursion (set-buffer nntp-server-buffer) - (goto-char (point-min)) - (while (search-forward "\r" nil t) - (replace-match " " t t)) + (subst-char-in-region (point-min) (point-max) ?\r ? t) ;; Allow the user to mangle the headers before parsing them. (gnus-run-hooks 'gnus-parse-headers-hook) (goto-char (point-min)) diff --git a/lisp/gnus.el b/lisp/gnus.el index a2ca37b..0d5a045 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.44" +(defconst gnus-version-number "0.46" "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 3696495..7d43608 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -41,6 +41,7 @@ (require 'mail-parse) (require 'mm-bodies) (require 'mm-encode) +(require 'mml) (defgroup message '((user-mail-address custom-variable) (user-full-name custom-variable)) @@ -667,6 +668,8 @@ Valid valued are `unique' and `unsent'." (defvar message-mode-syntax-table (let ((table (copy-syntax-table text-mode-syntax-table))) (modify-syntax-entry ?% ". " table) + (modify-syntax-entry ?> ". " table) + (modify-syntax-entry ?< ". " table) table) "Syntax table used while in Message mode.") @@ -4074,80 +4077,33 @@ regexp varstr." ;;; MIME functions ;;; -(defun message-encode-message-body () - "Examine the message body, encode it, and add the requisite headers." - (message-format-mime) - (when (featurep 'mule) - (let (old-headers) - (save-excursion - (save-restriction - (message-narrow-to-headers-or-head) - (unless (setq old-headers (message-fetch-field "mime-version")) - (message-remove-header - "^Content-Transfer-Encoding:\\|^Content-Type:\\|^Mime-Version:" - t)) - (goto-char (point-max)) - (widen) - (narrow-to-region (point) (point-max)) - (let* ((charset (mm-encode-body)) - (encoding (mm-body-encoding))) - (when (consp charset) - (error "Can't encode messages with multiple charsets (yet)")) - (widen) - (message-narrow-to-headers-or-head) - (goto-char (point-max)) - (setq charset (or charset - (mm-mule-charset-to-mime-charset 'ascii))) - ;; We don't insert MIME headers if they only say the default. - (when (and (not old-headers) - (not (and (eq charset 'us-ascii) - (eq encoding '7bit)))) - (mm-insert-rfc822-headers charset encoding)) - (mm-encode-body))))))) - (defun message-insert-mime-part (file type) "Insert a multipart/alternative part into the buffer." (interactive (let* ((file (read-file-name "Insert file: " nil nil t)) (type (mm-default-file-encoding file))) - (setq mime-type - (read-string (format "MIME type for %s: " file) (car type))) - (unless (equal mime-type (car type)) - (setq type (list mime-type))) - (list file type))) - - (insert (format "-*[%s %d]*-\n" (car type) (incf message-mime-part))) - (let ((current buffer-file-name) - (part message-mime-part)) - (mm-with-unibyte-buffer - (insert-file file) - (mm-insert-headers type (mm-encode-buffer type) file) - (nndraft-save-mime-part current part)))) - -(defun message-format-mime () - "Insert all the MIME parts." - (when (not (zerop message-mime-part)) - (message-narrow-to-headers) - (goto-char (point-max)) - (let ((boundary (mm-insert-multipart-headers)) - (current buffer-file-name)) - (widen) - (forward-line 1) - (insert "This is a MIME message. If you are reading this -- *phphthth*.\n\n") - (insert "--" boundary "\n\n") - (while (re-search-forward - "-\\*\\[\\([-a-z/A-Z0-9]+\\) \\([0-9]+\\)\\]\\*-" nil t) - (let ((part (string-to-number (match-string 2)))) - (delete-region (match-beginning 0) (match-end 0)) - (insert "\n--" boundary "\n") - (narrow-to-region (point) (point)) - (nndraft-get-mime-part current part) - (goto-char (point-max)) - (widen) - (insert "\n--" boundary "\n\n") - )) - (goto-char (point-max)) - (insert "\n--" boundary "--\n")))) + (list file + (completing-read + (format "MIME type for %s: " file) + (mapcar (lambda (m) (list (cdr m))) mailcap-mime-extensions) + nil nil type)))) + (insert (format "\n" + type file))) + +(defun message-encode-message-body () + (message-goto-body) + (narrow-to-region (point) (point-max)) + (let ((new (mml-generate-mime))) + (delete-region (point-min) (point-max)) + (insert new) + (goto-char (point-min)) + (widen) + (forward-line -1) + (let ((beg (point)) + (line (buffer-substring (point) (progn (forward-line 1) (point))))) + (delete-region beg (point)) + (insert "Mime-Version: 1.0\n") + (insert line)))) (run-hooks 'message-load-hook) diff --git a/lisp/mm-encode.el b/lisp/mm-encode.el index e3bd0af..30bc8cd 100644 --- a/lisp/mm-encode.el +++ b/lisp/mm-encode.el @@ -25,50 +25,7 @@ ;;; Code: (require 'mail-parse) - -(defvar mm-mime-file-types - '(("\\.rtf$" "text/richtext") - ("\\.\\(html\\|htm\\)$" "text/html") - ("\\.ps$" "application/postscript" - (encoding quoted-printable) - (disposition "attachment")) - ("\\.\\(jpeg\\|jpg\\)$" "image/jpeg") - ("\\.gif$" "image/gif") - ("\\.png$" "image/png") - ("\\.\\(tiff\\|tif\\)$" "image/tiff") - ("\\.pic$" "image/x-pic") - ("\\.mag$" "image/x-mag") - ("\\.xbm$" "image/x-xbm") - ("\\.xwd$" "image/x-xwd") - ("\\.au$" "audio/basic") - ("\\.mpg$" "video/mpeg") - ("\\.txt$" "text/plain") - ("\\.el$" "application/octet-stream" - ("type" ."emacs-lisp")) - ("\\.lsp$" "application/octet-stream" - ("type" "common-lisp")) - ("\\.tar\\.gz$" "application/octet-stream" - ("type" "tar+gzip")) - ("\\.tgz$" "application/octet-stream" - ("type" "tar+gzip")) - ("\\.tar\\.Z$" "application/octet-stream" - ("type" "tar+compress")) - ("\\.taz$" "application/octet-stream" - ("type" "tar+compress")) - ("\\.gz$" "application/octet-stream" - ("type" "gzip")) - ("\\.Z$" "application/octet-stream" - ("type" "compress")) - ("\\.lzh$" "application/octet-stream" - ("type" . "lha")) - ("\\.zip$" "application/zip") - ("\\.diffs?$" "text/plain" - ("type" . "patch")) - ("\\.patch$" "application/octet-stream" - ("type" "patch")) - ("\\.signature" "text/plain") - (".*" "application/octet-stream")) - "*Alist of regexps and MIME types.") +(require 'mailcap) (defvar mm-content-transfer-encoding-defaults '(("text/.*" quoted-printable) @@ -93,13 +50,9 @@ (defun mm-default-file-encoding (file) "Return a default encoding for FILE." - (let ((types mm-mime-file-types) - type) - (catch 'found - (while (setq type (pop types)) - (when (string-match (car type) file) - (throw 'found (cdr type))) - (pop types))))) + (if (not (string-match "\\.[^.]+$" file)) + "application/octet-stream" + (mailcap-extension-to-mime (match-string 0 file)))) (defun mm-encode-content-transfer-encoding (encoding &optional type) (cond @@ -117,10 +70,10 @@ ) ((null encoding) ) - ((eq encoding 'x-uuencode) - (condition-case () - (uudecode-encode-region (point-min) (point-max)) - (error nil))) + ;;((eq encoding 'x-uuencode) + ;; (condition-case () + ;; (uudecode-encode-region (point-min) (point-max)) + ;; (error nil))) ((functionp encoding) (condition-case () (funcall encoding (point-min) (point-max)) @@ -141,7 +94,7 @@ The encoding used is returned." (defun mm-insert-headers (type encoding &optional file) "Insert headers for TYPE." - (insert "Content-Type: " (car type)) + (insert "Content-Type: " type) (when file (insert ";\n\tname=\"" (file-name-nondirectory file) "\"")) (insert "\n") diff --git a/lisp/mm-view.el b/lisp/mm-view.el index 069858e..706a2a2 100644 --- a/lisp/mm-view.el +++ b/lisp/mm-view.el @@ -45,8 +45,7 @@ (let ((annot (make-annotation image nil 'text))) (set-extent-property annot 'mm t) (set-extent-property annot 'duplicable t) - (mm-handle-set-undisplayer handle annot)) - (insert " \n"))) + (mm-insert-inline handle " \n")))) (defun mm-inline-text (handle) (let ((type (cadr (split-string (car (mm-handle-type handle)) "/"))) diff --git a/lisp/mml.el b/lisp/mml.el new file mode 100644 index 0000000..c31e7fd --- /dev/null +++ b/lisp/mml.el @@ -0,0 +1,148 @@ +;;; mml.el --- A package for parsing and validating MML documents +;; 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: + +(defvar mml-syntax-table + (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table))) + (modify-syntax-entry ?\\ "/" table) + (modify-syntax-entry ?< "(" table) + (modify-syntax-entry ?> ")" table) + (modify-syntax-entry ?@ "w" table) + (modify-syntax-entry ?/ "w" table) + (modify-syntax-entry ?= " " table) + (modify-syntax-entry ?* " " table) + (modify-syntax-entry ?\; " " table) + (modify-syntax-entry ?\' " " table) + table)) + +(defun mml-parse () + "Parse the current buffer as an MML document." + (goto-char (point-min)) + (let ((table (syntax-table))) + (unwind-protect + (progn + (set-syntax-table mml-syntax-table) + (mml-parse-1)) + (set-syntax-table table)))) + +(defun mml-parse-1 () + "Parse the current buffer as an MML document." + (let (struct) + (while (and (not (eobp)) + (not (looking-at "")) + (setq elem (buffer-substring (point) (progn (forward-sexp 1) (point)))) + (skip-chars-forward "= \t\n") + (setq val (buffer-substring (point) (progn (forward-sexp 1) (point)))) + (when (string-match "^\"\\(.*\\)\"$" val) + (setq val (match-string 1 val))) + (push (cons (intern elem) val) contents) + (skip-chars-forward " \t\n")) + (forward-char 1) + (cons (intern name) (nreverse contents)))) + +(defun mml-read-part () + "Return the buffer up till the next part, multipart or closing part or multipart." + (let ((beg (point))) + (if (re-search-forward "") + (goto-char (match-beginning 0)))) + (buffer-substring beg (goto-char (point-max)))))) + +(defvar mml-boundary nil) + +(defun mml-generate-mime () + "Generate a MIME message based on the current MML document." + (setq mml-boundary "=-=-=") + (let ((cont (mml-parse))) + (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) + (setq type (or (cdr (assq 'type cont)) "text/plain")) + (with-temp-buffer + (if (setq filename (cdr (assq 'filename cont))) + (insert-file-contents-literally filename) + (insert (cdr (assq 'contents cont)))) + (if (equal (car (split-string type "/")) "text") + (setq charset (mm-encode-body) + encoding (mm-body-encoding)) + (setq encoding (mm-encode-buffer type))) + (setq 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))) + (insert "\n") + (insert coded))) + ((eq (car cont) 'multipart) + (let ((mml-boundary (concat "=" mml-boundary))) + (insert (format "Content-Type: multipart/%s; boundary=\"%s\"\n" + (or (cdr (assq 'type cont)) "mixed") + mml-boundary)) + (insert "\n") + (setq cont (cddr cont)) + (while cont + (insert "--" mml-boundary "\n") + (mml-generate-mime-1 (pop cont))) + (insert "--" mml-boundary "--\n"))) + (t + (error "%S" cont)))) + +(provide 'mml) + +;;; mml.el ends here diff --git a/lisp/nndraft.el b/lisp/nndraft.el index 1c10613..912893e 100644 --- a/lisp/nndraft.el +++ b/lisp/nndraft.el @@ -160,15 +160,6 @@ (clear-visited-file-modtime) article)) -(defun nndraft-save-mime-part (file part) - "Save MIME PART belonging to the FILE." - (write-region (point-min) (point-max) - (format "%s.%d" file part))) - -(defun nndraft-get-mime-part (file part) - "Save MIME PART belonging to the FILE." - (insert-file-contents (format "%s.%d" file part))) - (deffoo nndraft-request-expire-articles (articles group &optional server force) (nndraft-possibly-change-group group) (let* ((nnmh-allow-delete-final t) diff --git a/texi/gnus.texi b/texi/gnus.texi index b368047..84e29b3 100644 --- a/texi/gnus.texi +++ b/texi/gnus.texi @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @setfilename gnus -@settitle Pterodactyl Gnus 0.44 Manual +@settitle Pterodactyl Gnus 0.46 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.44 Manual +@title Pterodactyl Gnus 0.46 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.44. +This manual corresponds to Pterodactyl Gnus 0.46. @end ifinfo diff --git a/texi/message.texi b/texi/message.texi index 7ea85d5..5bdae93 100644 --- a/texi/message.texi +++ b/texi/message.texi @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @setfilename message -@settitle Pterodactyl Message 0.44 Manual +@settitle Pterodactyl Message 0.46 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.44 Manual +@title Pterodactyl Message 0.46 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.44. Message is +This manual corresponds to Pterodactyl Message 0.46. Message is distributed with the Gnus distribution bearing the same version number as this manual. -- 1.7.10.4