Patch by Ed L. Cashin to make gnus-move-split-methods move to

[gnus] / lisp / mml.el

diff --git a/lisp/mml.el b/lisp/mml.el
index 49c915d..8c7b849 100644 (file)
--- a/lisp/mml.el
+++ b/lisp/mml.el
@@ -27,7 +27,7 @@
 (require 'mm-bodies)
 (require 'mm-encode)
 (require 'mm-decode)
-(eval-when-compile 'cl)
+(eval-when-compile (require 'cl))
 
 (eval-and-compile
   (autoload 'message-make-message-id "message")
@@ -107,7 +107,7 @@ The function is called with one parameter, which is the generated part.")
 
 (defun mml-parse-1 ()
   "Parse the current buffer as an MML document."
-  (let (struct tag point contents charsets warn use-ascii no-markup-p)
+  (let (struct tag point contents charsets warn use-ascii no-markup-p raw)
     (while (and (not (eobp))
                (not (looking-at "<#/multipart")))
       (cond
@@ -124,20 +124,24 @@ The function is called with one parameter, which is the generated part.")
          (setq tag (list 'part '(type . "text/plain"))
                no-markup-p t
                warn t))
-       (setq point (point)
+       (setq raw (cdr (assq 'raw tag))
+             point (point)
              contents (mml-read-part (eq 'mml (car tag)))
-             charsets (mm-find-mime-charset-region point (point)))
-       (when (memq nil charsets)
+             charsets (if raw nil 
+                        (mm-find-mime-charset-region point (point))))
+       (when (and (not raw) (memq nil charsets))
          (if (or (memq 'unknown-encoding mml-confirmation-set)
                  (y-or-n-p
-                  "Warning: You message contains characters with unknown encoding. Really send?"))
+                  "Message contains characters with unknown encoding.  Really send?"))
              (if (setq use-ascii 
                        (or (memq 'use-ascii mml-confirmation-set)
                            (y-or-n-p "Use ASCII as charset?")))
                  (setq charsets (delq nil charsets))
                (setq warn nil))
            (error "Edit your message to remove those characters")))
-       (if (< (length charsets) 2)
+       (if (or raw
+               (eq 'mml (car tag))
+               (< (length charsets) 2))
            (if (or (not no-markup-p)
                    (string-match "[^ \t\r\n]" contents))
                ;; Don't create blank parts.
@@ -289,9 +293,11 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
        (funcall mml-generate-mime-preprocess-function cont))
     (cond
      ((or (eq (car cont) 'part) (eq (car cont) 'mml))
-      (let (coded encoding charset filename type)
+      (let ((raw (cdr (assq 'raw cont)))
+           coded encoding charset filename type)
        (setq type (or (cdr (assq 'type cont)) "text/plain"))
-       (if (member (car (split-string type "/")) '("text" "message"))
+       (if (and (not raw)
+                (member (car (split-string type "/")) '("text" "message")))
            (with-temp-buffer
              (cond
               ((cdr (assq 'buffer cont))
@@ -440,12 +446,6 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
            "")
          mml-base-boundary))
 
-(defun mml-make-string (num string)
-  (let ((out ""))
-    (while (not (zerop (decf num)))
-      (setq out (concat out string)))
-    out))
-
 (defun mml-insert-mime-headers (cont type charset encoding)
   (let (parameters disposition description)
     (setq parameters
@@ -506,13 +506,13 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
         (mail-header-encode-parameter
          (symbol-name type) value))))))
 
-(defvar ange-ftp-path-format)
+(defvar ange-ftp-name-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))))
+       (if (boundp 'ange-ftp-name-format)
+           (string-match (car ange-ftp-name-format) path)))
       (list (match-string 1 path) (match-string 2 path)
            (substring path (1+ (match-end 2))))
     path))
@@ -638,7 +638,7 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
     (define-key map "p" 'mml-insert-part)
     (define-key map "v" 'mml-validate)
     (define-key map "P" 'mml-preview)
-    (define-key map "n" 'mml-narrow-to-part)
+    ;;(define-key map "n" 'mml-narrow-to-part)
     (define-key main "\M-m" map)
     main))
 
@@ -652,7 +652,7 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
    ("Insert"
     ["Multipart" mml-insert-multipart t]
     ["Part" mml-insert-part t])
-   ["Narrow" mml-narrow-to-part t]
+   ;;["Narrow" mml-narrow-to-part t]
    ["Quote" mml-quote-region t]
    ["Validate" mml-validate t]
    ["Preview" mml-preview t]))
@@ -695,6 +695,7 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
     file))
 
 (defun mml-minibuffer-read-type (name &optional default)
+  (mailcap-parse-mimetypes)
   (let* ((default (or default
                      (mm-default-file-encoding name)
                      ;; Perhaps here we should check what the file
@@ -703,25 +704,7 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
                      "application/octet-stream"))
         (string (completing-read
                  (format "Content type (default %s): " default)
-                 (mapcar
-                  'list
-                  (mm-delete-duplicates
-                   (nconc
-                    (mapcar 'cdr mailcap-mime-extensions)
-                    (apply
-                     'nconc
-                     (mapcar
-                      (lambda (l)
-                        (delq nil
-                              (mapcar
-                               (lambda (m)
-                                 (let ((type (cdr (assq 'type (cdr m)))))
-                                   (if (equal (cadr (split-string type "/"))
-                                              "*")
-                                       nil
-                                     type)))
-                               (cdr l))))
-                      mailcap-mime-data))))))))
+                 (mapcar 'list (mailcap-mime-types)))))
     (if (not (equal string ""))
        string
       default)))
@@ -743,7 +726,7 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
       (goto-char (point-min))
       ;; Quote parts.
       (while (re-search-forward
-             "<#/?!*\\(multipart\\|part\\|external\\|mml\\)" nil t)
+             "<#!*/?\\(multipart\\|part\\|external\\|mml\\)" nil t)
        ;; Insert ! after the #.
        (goto-char (+ (match-beginning 0) 2))
        (insert "!")))))
@@ -847,7 +830,12 @@ If RAW, don't highlight the article."
        (replace-match "\n"))
     (mml-to-mime)
     (if raw
-       (mm-disable-multibyte)
+       (when (fboundp 'set-buffer-multibyte)
+         (let ((s (buffer-string)))
+           ;; Insert the content into unibyte buffer.
+           (erase-buffer)
+           (mm-disable-multibyte)
+           (insert s)))
       (let ((gnus-newsgroup-charset (car message-posting-charset)))
        (run-hooks 'gnus-article-decode-hook)
        (let ((gnus-newsgroup-name "dummy"))