+Sun Nov 15 02:01:31 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
+
+ * gnus.el: Pterodactyl Gnus v0.46 is released.
+
+1998-11-15 01:54:40 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * message.el (message-encode-message-body): Insert headers at the
+ right spot.
+
+Sun Nov 15 01:13:41 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
+
+ * gnus.el: Pterodactyl Gnus v0.45 is released.
+
+1998-11-15 00:28:49 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * 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 <larsi@gnus.org>
+
+ * 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 <zsh@cs.rochester.edu>
+
+ * 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 <larsi@menja.ifi.uio.no>
* gnus.el: Pterodactyl Gnus v0.44 is released.
(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))))
(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
(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)
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))
: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)
(require 'mail-parse)
(require 'mm-bodies)
(require 'mm-encode)
+(require 'mml)
(defgroup message '((user-mail-address custom-variable)
(user-full-name custom-variable))
(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.")
;;; 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 "<part type=%s filename=\"%s\"></part>\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)
;;; 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)
(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
)
((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))
(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")
(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)) "/")))
--- /dev/null
+;;; mml.el --- A package for parsing and validating MML documents
+;; Copyright (C) 1998 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
+;; 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 "</multipart")))
+ (cond
+ ((looking-at "<multipart")
+ (push (nconc (mml-read-tag) (mml-parse-1)) struct))
+ ((looking-at "<part")
+ (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))))
+ (unless (eobp)
+ (forward-line 1))
+ (nreverse struct)))
+
+(defun mml-read-tag ()
+ "Read a tag and return the contents."
+ (let (contents name elem val)
+ (forward-char 1)
+ (setq name (buffer-substring (point) (progn (forward-sexp 1) (point))))
+ (skip-chars-forward " \t\n")
+ (while (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 "</?\\(multi\\)?part." nil t)
+ (prog1
+ (buffer-substring beg (match-beginning 0))
+ (unless (equal (match-string 0) "</part>")
+ (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
(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)
\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
@tex
@titlepage
-@title Pterodactyl Gnus 0.44 Manual
+@title Pterodactyl Gnus 0.46 Manual
@author by Lars Magne Ingebrigtsen
@page
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
\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
@tex
@titlepage
-@title Pterodactyl Message 0.44 Manual
+@title Pterodactyl Message 0.46 Manual
@author by Lars Magne Ingebrigtsen
@page
* 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.
projects / elisp / gnus.git- / commitdiff