This commit was generated by cvs2svn to compensate for changes in r533,
[elisp/tm.git] / tm-comp.el
index ef6b7cb..8ff815c 100644 (file)
@@ -1,18 +1,24 @@
 ;;;
-;;; tm-comp.el: attachment for MIME composer
+;;; tm-comp.el --- attachment for MIME composer
 ;;;
-;;; by  MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;;; and   OKABE Yasuo    <okabe@kudpc.kyoto-u.ac.jp>
-;;; modified by MORITA Masahiro <hiro@isl.ntt.JP>
-;;;             MORIOKA Tomohiko,
-;;;      Kazushi (Jam) MARUKAWA <kazusi-m@is.aist-nara.ac.jp>,
-;;;             OKABE Yasuo,
-;;;            KOBAYASHI Shuhei <shuhei@cmpt01.phys.tohoku.ac.jp>,
-;;;         and YAMAOKA Katsumi <yamaoka@ga.sony.co.jp>
+;;; Copyright (C) 1995 Free Software Foundation, Inc.
+;;; Copyright (C) 1994,1995 MORIOKA Tomohiko
+;;; Copyright (C) 1994,1995 OKABE Yasuo
+;;;
+;;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>,
+;;;         OKABE Yasuo      <okabe@kudpc.kyoto-u.ac.jp>
+;;;    modified by MORITA Masahiro <hiro@isl.ntt.JP>
+;;;                 Kazushi (Jam) MARUKAWA <kazusi-m@is.aist-nara.ac.jp>,
+;;;                 KOBAYASHI Shuhei <shuhei@cmpt01.phys.tohoku.ac.jp>,
+;;;                 YAMAOKA Katsumi <yamaoka@ga.sony.co.jp>,
+;;;             and Richard Stanton <stanton@haas.berkeley.edu>
+;;; Keywords: mail, news, MIME, multimedia
+;;;
+;;; This file is part of tm (Tools for MIME).
 ;;;
 
 (require 'tm-view)
-(require 'tl-header)
+(require 'tl-822)
 (require 'tl-list)
 (require 'mail-utils)
 
@@ -21,7 +27,7 @@
 ;;;
 
 (defconst mime/composer-RCS-ID
-  "$Id: tm-comp.el,v 6.11 1995/09/04 00:47:37 morioka Exp $")
+  "$Id: tm-comp.el,v 7.2 1995/10/08 09:31:05 morioka Exp $")
 
 (defconst mime/composer-version (get-version-string mime/composer-RCS-ID))
 
@@ -165,7 +171,9 @@ Optional argument ENCODING specifies an encoding method such as base64."
       (let ((mc-flag nil)              ;Mule
            (file-coding-system-for-read
             (if (featurep 'mule) *noconv*))
-           (kanji-flag nil))           ;NEmacs
+           (kanji-flag nil)            ;NEmacs
+           (emx-binary-mode t)         ;Stop CRLF to LF conversion in OS/2
+           )
        (let (jka-compr-compression-info-list
              jam-zcat-filename-list)
          (insert-file-contents file))))
@@ -196,7 +204,8 @@ Optional argument ENCODING specifies an encoding method such as base64."
         )
     (save-restriction
       (narrow-to-region (1- (point)) (point))
-      (let ((start (point)))
+      (let ((start (point))
+           (emx-binary-mode t))        ;Stop LF to CRLF conversion in OS/2
        (insert-buffer-substring buffer)
        ;; Encode binary message if necessary.
        (if encoding
@@ -251,9 +260,9 @@ Optional argument ENCODING specifies an encoding method such as base64."
        (let ((hook (cdr (assq major-mode
                               mime/message-before-send-hook-alist))))
          (run-hooks hook))
-       (let* ((header (message/get-header-string-except
-                     mime/message-nuke-headers separator))
-              (orig-header (message/get-header-string-except
+       (let* ((header (rfc822/get-header-string-except
+                       mime/message-nuke-headers separator))
+              (orig-header (rfc822/get-header-string-except
                             mime/message-blind-headers separator))
               (subject (mail-fetch-field "subject"))
               (total (+ (/ lines mime/message-max-length)
@@ -433,27 +442,28 @@ Optional argument ENCODING specifies an encoding method such as base64."
 ;;; @ etc
 ;;;
 
-(defun message/get-header-string-except (pat boundary)
-  (save-excursion
-    (save-restriction
-      (narrow-to-region (goto-char (point-min))
-                       (progn
-                         (re-search-forward
-                          (concat "^\\(" (regexp-quote boundary) "\\)?$")
-                          nil t)
-                         (match-beginning 0)
-                         ))
-      (goto-char (point-min))
-      (let (field header)
-       (while (re-search-forward message/field-regexp nil t)
-         (setq field (buffer-substring (match-beginning 0)
-                                       (match-end 0)
-                                       ))
-         (if (not (string-match pat field))
-             (setq header (concat header field "\n"))
-           ))
-       header)
-      )))
+(defun rfc822/get-header-string-except (pat boundary)
+  (let ((case-fold-search t))
+    (save-excursion
+      (save-restriction
+       (narrow-to-region (goto-char (point-min))
+                         (progn
+                           (re-search-forward
+                            (concat "^\\(" (regexp-quote boundary) "\\)?$")
+                            nil t)
+                           (match-beginning 0)
+                           ))
+       (goto-char (point-min))
+       (let (field header)
+         (while (re-search-forward rfc822/field-top-regexp nil t)
+           (setq field (buffer-substring (match-beginning 0)
+                                         (rfc822/field-end)
+                                         ))
+           (if (not (string-match pat field))
+               (setq header (concat header field "\n"))
+             ))
+         header)
+       ))))
 
 (defun replace-space-with-underline (str)
   (mapconcat (function
@@ -465,6 +475,9 @@ Optional argument ENCODING specifies an encoding method such as base64."
   )
 
 
+;;; @ end
+;;;
+
 (provide 'tm-comp)
 
 (run-hooks 'tm-comp-load-hook)