+Sun Nov 29 15:12:52 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
+
+ * gnus.el: Pterodactyl Gnus v0.56 is released.
+
+1998-11-29 00:52:53 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * 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 <larsi@gnus.org>
+
+ * mml.el (mml-parameter-string): New function.
+ (mml-insert-mime-headers): Separated into new function.
+
+1998-11-28 Hrvoje Niksic <hniksic@srce.hr>
+
+ * mml.el (mml-make-boundary): Use `make-string'.
+
+1998-11-27 Hrvoje Niksic <hniksic@srce.hr>
+
+ * 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 <larsi@gnus.org>
+
+ * 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 <larsi@menja.ifi.uio.no>
* gnus.el: Pterodactyl Gnus v0.55 is released.
;;; Boston, MA 02111-1307, USA.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(require 'poe)
+
;; For non-MULE
(if (not (fboundp 'char-int))
(fset 'char-int 'identity))
(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)
+(defun-maybe base64-decode-region (start end)
(interactive "r")
;;(message "Decoding base64...")
(let ((work-buffer nil)
;;(message "Decoding base64... done")
)
-(defun base64-encode-region (start end &optional no-line-break)
+(defun-maybe base64-encode-region (start end &optional no-line-break)
(interactive "r")
(message "Encoding base64...")
(let ((work-buffer nil)
;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
;; Create Date: Oct 1, 1998
-;; $Revision: 1.1.2.3 $
+;; $Revision: 1.1.2.4 $
;; Time-stamp: <Tue Oct 6 23:48:38 EDT 1998 zsh>
;; Keywords: binhex
(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
(article-fill . gnus-article-word-wrap)
article-remove-cr
article-display-x-face
+ article-de-quoted-unreadable
+ article-mime-decode-quoted-printable
article-hide-pgp
article-hide-pem
article-hide-signature
article-date-iso8601
article-date-original
article-date-ut
+ article-decode-mime-words
+ article-decode-charset
+ article-decode-encoded-words
article-date-user
article-date-lapsed
article-emphasize
(make-local-variable 'gnus-page-broken)
(make-local-variable 'gnus-button-marker-list)
(make-local-variable 'gnus-article-current-summary)
+ (make-local-variable 'gnus-article-mime-handles)
+ (make-local-variable 'gnus-article-decoded-p)
+ (make-local-variable 'gnus-article-mime-handle-alist)
(gnus-set-default-directory)
(buffer-disable-undo)
(setq buffer-read-only t)
(substring name (match-end 0))))))
(setq gnus-article-buffer name)
(setq gnus-original-article-buffer original)
+ (setq gnus-article-mime-handle-alist nil)
;; This might be a variable local to the summary buffer.
(unless gnus-single-article-buffer
(save-excursion
;(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...")))
(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))
(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)))
(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
(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
: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\\>\\|\\<big5\\>" . cn-big5)
("^cn\\>\\|\\<chinese\\>" . cn-gb-2312)
(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
(defconst gnus-product-name "T-gnus"
"Product name of this version of gnus.")
-(defconst gnus-version-number "6.10.041"
+(defconst gnus-version-number "6.10.042"
"Version number for this version of gnus.")
-(defconst gnus-original-version-number "0.55"
+(defconst gnus-original-version-number "0.56"
"Version number for this version of Gnus.")
(defconst gnus-original-product-name "Pterodactyl Gnus"
: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
"\\([" 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.")
'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)
(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)
(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)
(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)
"")
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)
;;; 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))
(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")
(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"))))
(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.
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
(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
(< (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
;;; 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.")
"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)
(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)
(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)
(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)
((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))))
;; 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))))
"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
(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)
(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"
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)
"")
(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
(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
projects / elisp / gnus.git- / commitdiff