;; This package is designed for enabling moderators to do various
;; spiffy things while moderating groups. Some of these things are
-;; rather evil if done by non-moderators -- canceling other people's
+;; rather evil if done by non-moderators -- cancelling other people's
;; articles, including Approved headers and so on. So while this file
;; is GPL'd and there therefore is no distribution restriction --
;; please do not put this file at any public sites. All people who
(defvar gnus-moderated-groups nil
"Regexp that match groups you moderate.")
-(defvar gnus-moderation-ignored-headers "^\\(Received\\|To\\|Cc\\|X-From-Line\\|Return-Path\\|Xref\\|NNTP-Posting-Host\\):"
+(defvar gnus-moderation-ignored-headers "^\\(Received\\|To\\|Cc\\|X-From-Line\\|Return-Path\\|Xref\\|NNTP-Posting-Host\\|X-Trace\\NNTP-Posting-Date\\):"
"Headers to be removed before posting an approved article.")
(defvar gnus-moderation-mode nil
(let ((user-mail-address
(nth 1 (mail-extract-address-components
(mail-fetch-field "from"))))
+ (message-cancel-hook
+ (lambda ()
+ (goto-char (point-min))
+ (insert "Approved: " (message-make-from) "\n")))
(message-cancel-message
(format
- "Moderator %s canceling a message in a group I moderate.\n"
+ "Moderator %s cancelling a message in a group I moderate.\n"
(message-make-from))))
(message-cancel-news)))
(gnus-summary-mark-as-read article gnus-canceled-mark)
;; Select article if needed.
(gnus-summary-show-article t)
(gnus-article-edit-article
- `(lambda ()
+ `(lambda (&optional arg)
(gnus-moderation-send-buffer)))))
(defun gnus-moderation-send-article ()
+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.
(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")
;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
;; Create Date: Oct 1, 1998
-;; $Revision: 5.1 $
+;; $Revision: 5.2 $
;; 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
(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)))
;(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
: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)
: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)
(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))
(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))
(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)
+ (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
;; Copyright (c) 1998 by Shenghuo Zhu <zsh@cs.rochester.edu>
;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
-;; $Revision: 1.3 $
+;; $Revision: 5.2 $
;; Keywords: uudecode
;; This file is not part of GNU Emacs, but the same permissions
(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
+1998-11-29 00:03:43 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * emacs-mime.texi (Composing): New chapter.
+
+1998-11-25 Karl Eichwalder <ke@gnu.franken.de>
+
+ * Makefile.in (install): Remove emacs-info, add emacs-mime.
+
1998-11-25 10:56:08 Lars Magne Ingebrigtsen <larsi@gnus.org>
* gnus.texi (To From Newsgroups): Addition.
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"; \
* 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
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>
+<center>This is a centered enriched part</center>
+<#/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
+
+
+<center>This is a centered enriched part</center>
+
+--=-=-=--
+@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>
+<center>This is a centered enriched part</center>
+<#/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"
+
+
+<center>This is a centered enriched part</center>
+
+--==-=-=--
+
+--=-=-=
+
+This is a new plain text part.
+
+--=-=-=
+Content-Disposition: attachment
+
+
+This plain text part is an attachment.
+
+--=-=-=--
+@end example
+
+
@node Standards
@chapter Standards
@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
\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
@tex
@titlepage
-@title Pterodactyl Gnus 0.55 Manual
+@title Pterodactyl Gnus 0.56 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.55.
+This manual corresponds to Pterodactyl Gnus 0.56.
@end ifinfo
\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
@tex
@titlepage
-@title Pterodactyl Message 0.55 Manual
+@title Pterodactyl Message 0.56 Manual
@author by Lars Magne Ingebrigtsen
@page
* 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.
projects / gnus / commitdiff