/[emacs]/emacs/lisp/gnus/mml.el
ViewVC logotype

Diff of /emacs/lisp/gnus/mml.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.10 by pj, Sun Jul 15 17:42:53 2001 UTC revision 1.10.4.1 by zsh, Thu Feb 7 15:28:34 2002 UTC
# Line 133  The function is called with one paramete Line 133  The function is called with one paramete
133          (when (and (not raw) (memq nil charsets))          (when (and (not raw) (memq nil charsets))
134            (if (or (memq 'unknown-encoding mml-confirmation-set)            (if (or (memq 'unknown-encoding mml-confirmation-set)
135                    (prog1 (y-or-n-p                    (prog1 (y-or-n-p
136                     "\                            "\
137  Message contains characters with unknown encoding.  Really send?")  Message contains characters with unknown encoding.  Really send?")
138                      (set (make-local-variable 'mml-confirmation-set)                      (set (make-local-variable 'mml-confirmation-set)
139                           (push 'unknown-encoding mml-confirmation-set))))                           (push 'unknown-encoding mml-confirmation-set))))
# Line 252  A message part needs to be split into %d Line 252  A message part needs to be split into %d
252    "Return the buffer up till the next part, multipart or closing part or multipart.    "Return the buffer up till the next part, multipart or closing part or multipart.
253  If MML is non-nil, return the buffer up till the correspondent mml tag."  If MML is non-nil, return the buffer up till the correspondent mml tag."
254    (let ((beg (point)) (count 1))    (let ((beg (point)) (count 1))
255      ;; If the tag ended at the end of the line, we go to the next line.     ;; If the tag ended at the end of the line, we go to the next line.
256      (when (looking-at "[ \t]*\n")      (when (looking-at "[ \t]*\n")
257        (forward-line 1))        (forward-line 1))
258      (if mml      (if mml
# Line 305  If MML is non-nil, return the buffer up Line 305  If MML is non-nil, return the buffer up
305          (setq type (or (cdr (assq 'type cont)) "text/plain"))          (setq type (or (cdr (assq 'type cont)) "text/plain"))
306          (if (and (not raw)          (if (and (not raw)
307                   (member (car (split-string type "/")) '("text" "message")))                   (member (car (split-string type "/")) '("text" "message")))
308              (with-temp-buffer              (progn
309                (cond                (with-temp-buffer
310                 ((cdr (assq 'buffer cont))                  (cond
311                  (insert-buffer-substring (cdr (assq 'buffer cont))))                   ((cdr (assq 'buffer cont))
312                 ((and (setq filename (cdr (assq 'filename cont)))                    (insert-buffer-substring (cdr (assq 'buffer cont))))
313                       (not (equal (cdr (assq 'nofile cont)) "yes")))                   ((and (setq filename (cdr (assq 'filename cont)))
314                  (mm-insert-file-contents filename))                         (not (equal (cdr (assq 'nofile cont)) "yes")))
315                 ((eq 'mml (car cont))                    (mm-insert-file-contents filename))
316                  (insert (cdr (assq 'contents cont))))                   ((eq 'mml (car cont))
317                 (t                    (insert (cdr (assq 'contents cont))))
318                  (save-restriction                   (t
319                    (narrow-to-region (point) (point))                    (save-restriction
320                    (insert (cdr (assq 'contents cont)))                      (narrow-to-region (point) (point))
321                    ;; Remove quotes from quoted tags.                      (insert (cdr (assq 'contents cont)))
322                    (goto-char (point-min))                      ;; Remove quotes from quoted tags.
323                    (while (re-search-forward                      (goto-char (point-min))
324                            "<#!+/?\\(part\\|multipart\\|external\\|mml\\)" nil t)                      (while (re-search-forward
325                      (delete-region (+ (match-beginning 0) 2)                              "<#!+/?\\(part\\|multipart\\|external\\|mml\\)" nil t)
326                                     (+ (match-beginning 0) 3))))))                        (delete-region (+ (match-beginning 0) 2)
327                (cond                                       (+ (match-beginning 0) 3))))))
328                 ((eq (car cont) 'mml)                  (cond
329                  (let ((mml-boundary (funcall mml-boundary-function                   ((eq (car cont) 'mml)
330                                               (incf mml-multipart-number)))                    (let ((mml-boundary (funcall mml-boundary-function
331                        (mml-generate-default-type "text/plain"))                                                 (incf mml-multipart-number)))
332                    (mml-to-mime))                          (mml-generate-default-type "text/plain"))
333                  (let ((mm-7bit-chars (concat mm-7bit-chars "\x1b")))                      (mml-to-mime))
334                    ;; ignore 0x1b, it is part of iso-2022-jp                    (let ((mm-7bit-chars (concat mm-7bit-chars "\x1b")))
335                    (setq encoding (mm-body-7-or-8))))                      ;; ignore 0x1b, it is part of iso-2022-jp
336                 ((string= (car (split-string type "/")) "message")                      (setq encoding (mm-body-7-or-8))))
337                  (let ((mm-7bit-chars (concat mm-7bit-chars "\x1b")))                   ((string= (car (split-string type "/")) "message")
338                    ;; ignore 0x1b, it is part of iso-2022-jp                    (let ((mm-7bit-chars (concat mm-7bit-chars "\x1b")))
339                    (setq encoding (mm-body-7-or-8))))                      ;; ignore 0x1b, it is part of iso-2022-jp
340                 (t                      (setq encoding (mm-body-7-or-8))))
341                  (setq charset (mm-encode-body))                   (t
342                  (setq encoding (mm-body-encoding                    (setq charset (mm-encode-body))
343                                  charset (cdr (assq 'encoding cont))))))                    (setq encoding (mm-body-encoding
344                (setq coded (buffer-string)))                                    charset (cdr (assq 'encoding cont))))))
345                    (setq coded (buffer-string)))
346                  (mml-insert-mime-headers cont type charset encoding)
347                  (insert "\n")
348                  (insert coded))
349            (mm-with-unibyte-buffer            (mm-with-unibyte-buffer
350              (cond              (cond
351               ((cdr (assq 'buffer cont))               ((cdr (assq 'buffer cont))
# Line 353  If MML is non-nil, return the buffer up Line 357  If MML is non-nil, return the buffer up
357               (t               (t
358                (insert (cdr (assq 'contents cont)))))                (insert (cdr (assq 'contents cont)))))
359              (setq encoding (mm-encode-buffer type)              (setq encoding (mm-encode-buffer type)
360                    coded (buffer-string))))                    coded (buffer-string)))
361          (mml-insert-mime-headers cont type charset encoding)            (mml-insert-mime-headers cont type charset encoding)
362          (insert "\n")            (insert "\n")
363          (insert coded)))            (mm-with-unibyte-current-buffer
364                (insert coded)))))
365       ((eq (car cont) 'external)       ((eq (car cont) 'external)
366        (insert "Content-Type: message/external-body")        (insert "Content-Type: message/external-body")
367        (let ((parameters (mml-parameter-string        (let ((parameters (mml-parameter-string
# Line 378  If MML is non-nil, return the buffer up Line 383  If MML is non-nil, return the buffer up
383               (concat "access-type="               (concat "access-type="
384                       (if (member (nth 0 name) '("ftp@" "anonymous@"))                       (if (member (nth 0 name) '("ftp@" "anonymous@"))
385                           "anon-ftp"                           "anon-ftp"
386                         "ftp")))))                               "ftp")))))
387          (when parameters          (when parameters
388            (mml-insert-parameter-string            (mml-insert-parameter-string
389             cont '(expiration size permission))))             cont '(expiration size permission))))
# Line 651  If MML is non-nil, return the buffer up Line 656  If MML is non-nil, return the buffer up
656      main))      main))
657    
658  (easy-menu-define  (easy-menu-define
659   mml-menu mml-mode-map ""    mml-menu mml-mode-map ""
660   '("MML"    '("MML"
661     ("Attach"      ("Attach"
662      ["File" mml-attach-file t]       ["File" mml-attach-file t]
663      ["Buffer" mml-attach-buffer t]       ["Buffer" mml-attach-buffer t]
664      ["External" mml-attach-external t])       ["External" mml-attach-external t])
665     ("Insert"      ("Insert"
666      ["Multipart" mml-insert-multipart t]       ["Multipart" mml-insert-multipart t]
667      ["Part" mml-insert-part t])       ["Part" mml-insert-part t])
668     ;;["Narrow" mml-narrow-to-part t]      ;;["Narrow" mml-narrow-to-part t]
669     ["Quote" mml-quote-region t]      ["Quote" mml-quote-region t]
670     ["Validate" mml-validate t]      ["Validate" mml-validate t]
671     ["Preview" mml-preview t]))      ["Preview" mml-preview t]))
672    
673  (defvar mml-mode nil  (defvar mml-mode nil
674    "Minor mode for editing MML.")    "Minor mode for editing MML.")
# Line 692  If MML is non-nil, return the buffer up Line 697  If MML is non-nil, return the buffer up
697    
698  (defun mml-minibuffer-read-file (prompt)  (defun mml-minibuffer-read-file (prompt)
699    (let ((file (read-file-name prompt nil nil t)))    (let ((file (read-file-name prompt nil nil t)))
700      ;; Prevent some common errors.  This is inspired by similar code in     ;; Prevent some common errors.  This is inspired by similar code in
701      ;; VM.      ;; VM.
702      (when (file-directory-p file)      (when (file-directory-p file)
703        (error "%s is a directory, cannot attach" file))        (error "%s is a directory, cannot attach" file))
# Line 836  If RAW, don't highlight the article." Line 841  If RAW, don't highlight the article."
841      (if (re-search-forward      (if (re-search-forward
842           (concat "^" (regexp-quote mail-header-separator) "\n") nil t)           (concat "^" (regexp-quote mail-header-separator) "\n") nil t)
843          (replace-match "\n"))          (replace-match "\n"))
844      (mml-to-mime)      (let ((mail-header-separator "")) ;; mail-header-separator is removed.
845          (mml-to-mime))
846      (if raw      (if raw
847          (when (fboundp 'set-buffer-multibyte)          (when (fboundp 'set-buffer-multibyte)
848            (let ((s (buffer-string)))            (let ((s (buffer-string)))

Legend:
Removed from v.1.10  
changed lines
  Added in v.1.10.4.1

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26