From: marca@ncsa.uiuc.edu (Marc Andreessen)
Subject: Frustration with subst-char-in-region...
Organization: Nat'l Center for Supercomputing Applications
Date: Thu, 5 Nov 1992 09:56:03 GMT

I'm having troubles with subst-char-in-region, and I'll be damned if I
can figure out why.

The following function is being used in mime-compose.el (the
complete file is at the end of the message).

(defun mime-hide-region (from to hideflag)
  "Hides or shows lines from FROM to TO, according to FLAG."
  (let ((old (if hideflag ?\n ?\^M))
        (new (if hideflag ?\^M ?\n))
        (modp (buffer-modified-p)))
    (unwind-protect (progn
                      (subst-char-in-region from to
                                            old new t))
      (set-buffer-modified-p modp))))

This is ripped off almost verbatim from code in outline.el/hideif.el,
except modified to take T or NIL for a third arg instead of ?\n or
?\^M.  (I had the same problem I'll describe with the original
routine.)

So this routine is used to hide and unhide certain regions of a
buffer, and it works for that.  So far so good.  But in the course of
going from unhidden to hidden to unhidden, the text in the hidden
region becomes corrupted.  Examples follow:

CBEeHChQ4GLDBg0RaqAJgeZEDSliBOnShZIqqtCoXUu5cmXLIBoiJKhY169AnH4pZngR6M+h
CBEeHChQ4GLDBgoRaqAJgeZECiliBOnShZIqqtCoXUu5cmXLIBoiJKhY169AnH4pZngR6M+h
              ^         ^^

gnQLRO47M0IGDTFivKCyNKVilI2X/jWUWTl68oHKkdckmMIOnkaGKHVq9OULkyFDllDp8oYS
gnQLRO47M0IGCjFivKCyNKVilI2X/jWUWTl68oHKkdckmMIOnkaGKHVq9OULkyFDllDp8oYS
             ^

gaXwhkiJmUQNN9xQA4NEfmFWV3npUUcTZhCEEAh8Q32hxhBKBNEkE6bhgcdOh/xhSGiNdCKb
gaXwhkiJmUQKN9xQA4NEfmFWV3npUUcTZhCEEAh8Q32hxhBKBNEkE6bhgcdOh/xhSGiNdCKb
           ^

luFwWQ1t/sOZ9aBaZuGWFla9qcPOWLud5WFfkD4614cPFHATQRmckMIJytbg7BFAPMAoe2l8
luFwWQpt/sOZ9aBaZuGWFla9qcPOWLud5WFfkD4614cPFHATQRmckMIJytbg7BFAPMAoe2l8
      ^

This has been tested under both Epoch 4.2 (Emacs 18.58-derived) and
raw Emacs 18.59.  To see this for yourself, use mime-compose.el below,
and compose two messages containing a GIF file: set
mime-use-selective-display to T for one message and to NIL for the
other message.

Somebody please tell me I'm making a really stupid mistake.  (And then
tell me what it is.)

Thanks,

Marc

;;; --------------------------------------------------------------------------
;;; File: --- mime-compose.el ---
;;; Author: Marc Andreessen (marca@ncsa.uiuc.edu)
;;; Copyright (C) National Center for Supercomputing Applications, 1992.
;;;
;;; Further hacked by: Keith Waclena (k-waclena@uchicago.edu).
;;;
;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 1, or (at your option)
;;; any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with your copy of Emacs; if not, write to the Free Software
;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
;;;
;;; CONTENTS
;;;
;;; mime-compose: Utility routines for composing MIME-compliant mail.
;;; $Revision: 1.8 $
;;; $Date: 1992/11/05 08:23:25 $
;;;
;;; ------------------------------ INSTRUCTIONS ------------------------------
;;;
;;; Use the normal Emacs mail composer (C-x m).
;;;
;;; (Or, use with Emacs mh-e by loading this file *after* loading mh-e.
;;; Try putting (require 'mime-compose) in mh-letter-mode-hook.)
;;;
;;; Do nothing special to prepare a message to have MIME elements
;;; included in it.
;;;
;;; The basic commands to add MIME elements (images, audio, etc.) to a
;;; message are as follows:
;;;
;;; mail-mode  mh-e         command
;;; ---------  ---------    -------
;;; C-c g      C-c C-m g    Add a GIF file.
;;; C-c j      C-c C-m j    Add a JPEG file.
;;; C-c a      C-c C-m a    Add a (basic) audio file.
;;; C-c p      C-c C-m p    Add a PostScript file.
;;;
;;; (Note that mime-compose assumes you have the 'mmencode' program
;;; installed on your system.  See 'WHAT MIME IS' below for more
;;; information on mmencode and the metamail distribution.)
;;;
;;; Some mime-compose commands create data themselves; these follow:
;;;
;;; C-c x     C-c C-m x
;;;   Add the result of an X-window dump.  The program named in
;;;   mime-xwd-command will be run, and the resulting dump will be
;;;   inserted into the message.
;;;
;;; If you have a raw binary file and MIME doesn't have built-in
;;; support for it (e.g. an Emacs Lisp byte-compiled file), you can
;;; use:
;;;
;;; C-c r     C-c C-m r
;;;   Add a raw binary file.  You will be prompted for both the
;;;   filename and the content type of the file; if you do not give a
;;;   content type, the default (application/octet-stream) will be
;;;   used, and the recipient will be able to have his/her MIME mail
;;;   handler extract the raw binary file from the message.
;;;
;;; In addition to including files and generating inclusions on the
;;; fly, you can also point to external elements: files that will not
;;; be included in the document, but can be accessed by the recipient
;;; in some other way (most commonly, via FTP).  The following
;;; commands handle this:
;;;
;;; C-c e     C-c C-m e
;;;   Point to an external file (assumed to be accessable via
;;;   anonymous FTP).  You will be prompted for the name of the FTP
;;;   site, the remote directory name, and remote filename, the remote
;;;   file's content type, and a description of the remote file.
;;;   Content type can be any MIME content type (examples include
;;;   'image/gif', 'audio/basic', and 'application/postscript'; see
;;;   the MIME RFC and your local mailcap file for more information).
;;; C-c f     C-c C-m f
;;;   This is the same as 'C-c e', except that the file will be
;;;   accessed via regular FTP rather than anonymous FTP -- a username
;;;   and password will have to be provided by the recipient to gain
;;;   access to the file.
;;;
;;; ---------------------------- ADDITIONAL NOTES ----------------------------
;;;
;;; If you are running Lucid Emacs, the mail-mode popup menu (attached
;;; to the third mouse button) will include mime-compose entries.
;;;
;;; After your message has been `mimified' (by including a MIME
;;; element), it is best not to put trailing text outside the final
;;; boundary at the end of the file -- such text will not be
;;; considered to be part of the message by MIME-compliant mail
;;; readers (although it will still be sent).
;;;
;;; A command that usually isn't necessary, but is provided in case
;;; you wish to send a plaintext message with the various MIME headers
;;; and boundaries, is:
;;;
;;; C-c m     C-c C-m m     Mimify a message.
;;;
;;; MIME messages can contain elements and structures not yet
;;; supported by mime-compose.  If you have ideas or code, please send
;;; them to the author.
;;;
;;; ------------------------ WHAT MIME-COMPOSE IS NOT ------------------------
;;;
;;; mime-compose is not a MIME message handler.  It will not interpret
;;; MIME messages, display images, or anything similar.
;;;
;;; mime-compose is not intelligent enough (yet) to construct complex
;;; MIME messages (with nested boundaries, parallel message elements,
;;; and so on).
;;;
;;; mime-compose will not enforce correctness (MIME compliance) on
;;; your messages.  mime-compose generates MIME-compliant message
;;; elements, but will sit quietly if you alter them or add your own
;;; incorrect elements.
;;;
;;; ------------------------------ WHAT MIME IS ------------------------------
;;;
;;; MIME defines a format for email messages containing non-plaintext
;;; elements (images, audio, etc.).  MIME is detailed in Internet RFC
;;; 1341, by N. Borenstein and N. Freed.  You can FTP this RFC from
;;; many archive sites, including uxc.cso.uiuc.edu.
;;;
;;; Few mail readers handle MIME messages, yet.  However, most popular
;;; mail readers can be easily patched to feed MIME messages to a
;;; program called 'metamail', which can handle MIME messages.  You
;;; can FTP metamail from thumper.bellcore.com in /pub/nsb as
;;; mm.tar.Z.  Since mime-compose requires the existence of the
;;; program 'mmencode' (from the metamail distribution) to insert
;;; binary files into messages, it is a Good Idea to have metamail
;;; installed on your system.
;;;
;;; --------------------------------------------------------------------------
;;; LCD Archive Entry:
;;; mime-compose|Marc Andreessen|marca@ncsa.uiuc.edu
;;; |MIME-compliant message generation utilities.
;;; |$Date: 1992/11/05 08:23:25 $|$Revision: 1.8 $|
;;; --------------------------------------------------------------------------

(provide 'mime-compose)
(require 'sendmail)

(defvar mime-primary-boundary "outtahere"
  "*Word used as a MIME boundary.")

(defvar mime-xwd-command "xwd -frame"
  "*Command used to do a window dump under the X Window System.")

(defvar mime-use-selective-display nil
  "*Use selective-display to hide bodies of MIME enclosures.
Do NOT set this to T yet; it's not ready.")

(defun mime-primary-boundary ()
  "Return the current primary boundary."
  mime-primary-boundary)

(defun mime-hide-region (from to hideflag)
  "Hides or shows lines from FROM to TO, according to FLAG."
  (let ((old (if hideflag ?\n ?\^M))
        (new (if hideflag ?\^M ?\n))
        (modp (buffer-modified-p)))
    (unwind-protect (progn
                      (subst-char-in-region from to
                                            old new t))
      (set-buffer-modified-p modp))))

(defun mime-mimify-message ()
  "Add MIME headers to a message.  Add an initial informational message
for mailreaders that don't process MIME automatically.  Add an initial
area for plaintext.  Add a closing boundary at the end of the message.
This function is safe to call more than once."
  (interactive)
  (let ((mail-header-separator (if (eq major-mode 'mh-letter-mode)
				   "\n\n\\|^-+$"
				 mail-header-separator)))
    (or
     (save-excursion
       (goto-char (point-min))
       (re-search-forward "^Mime-Version: "
                          (save-excursion
                            (goto-char (point-min))
                            (re-search-forward mail-header-separator)
                            (point))
                          t))
     (let ((mime-virgin-message (save-excursion
                                  (next-line -1)
                                  (looking-at mail-header-separator))))
       (if mime-virgin-message
           (insert "\n"))
       ;; Configure selective-display if we want it...
       (if mime-use-selective-display
           (setq selective-display t))
       (save-excursion
         (save-excursion
           (goto-char (point-min))
           (re-search-forward mail-header-separator)
           (beginning-of-line)
           (insert "Mime-Version: 1.0\n")
           (insert "Content-Type: multipart/mixed;\n")
           (insert "\tboundary=" (mime-primary-boundary) "\n")
           (next-line 1)
           (insert "> THIS IS A MESSAGE IN 'MIME' FORMAT.\n")
           (insert 
            "> If you are reading this, your mail reader may not support MIME.\n")
           (insert 
            "> Some parts of this message will be readable as plain text.\n")
           (insert "\n")
           (goto-char (point-max))
           (insert "\n")
           (insert "\n")
           (insert "--" (mime-primary-boundary) "--\n"))
         (save-excursion
           (goto-char (point-min))
           (re-search-forward mail-header-separator)
           (beginning-of-line)
           (next-line 5)
           (insert "--" (mime-primary-boundary) "\n")
           (insert "Content-type: text/plain\n")
           (insert "\n"))
         (if mime-virgin-message
             (backward-delete-char 1)))))))

(defun mime-include-binary-file (filename content-type)
  "Include a binary file at point in a MIME message.  Encode it
in base64 mode."
  (mime-mimify-message)
  (push-mark)
  (insert "--" (mime-primary-boundary) "\n")
  (insert "Content-type: " content-type "\n")
  (insert "Content-Transfer-Encoding: base64\n")
  (insert "\n")
  (let ((start (point)) end)
    (next-line 1)
    (save-excursion
      (next-line -1)
      (insert-file filename))
    (setq end (point))
    (shell-command-on-region start end "mmencode" t)
    (setq end (point))
    (if mime-use-selective-display
        (mime-hide-region start (- end 1) t))
    (insert "\n")
    (insert "--" (mime-primary-boundary) "\n")
    (insert "Content-type: text/plain\n")
    (insert "\n\n")
    (next-line -1)))

(defun mime-include-nonbinary-file (filename content-type)
  "Include a nonbinary file at point in a MIME message.  Encode it
in quoted-printable mode."
  (mime-mimify-message)
  (push-mark)
  (insert "--" (mime-primary-boundary) "\n")
  (insert "Content-type: " content-type "\n")
  (insert "Content-Transfer-Encoding: quoted-printable\n")
  (insert "\n")
  (let ((start (point)) end)
    (next-line 1)
    (save-excursion
      (next-line -1)
      (insert-file filename))
    (setq end (point))
    (shell-command-on-region start end "mmencode -q" t)
    (setq end (point))
    (insert "\n")
    (insert "--" (mime-primary-boundary) "\n")
    (insert "Content-type: text/plain\n")
    (insert "\n\n")
    (next-line -1)))

(defun mime-include-external (site directory name content-type description 
                                   access-type)
  "Include an external pointer in a MIME message."
  (mime-mimify-message)
  (insert "--" (mime-primary-boundary) "\n")
  (insert "Content-type: message/external-body;\n")
  (insert "\taccess-type=\"" access-type "\";\n")
  (insert "\tsite=\"" site "\";\n")
  (insert "\tdirectory=\"" directory "\";\n")
  (insert "\tname=\"" name "\"\n")
  (insert "Content-description: " description "\n")
  (insert "\n")
  (insert "Content-type: " content-type "\n")
  (insert "\n")
  (insert "\n")
  (insert "--" (mime-primary-boundary) "\n")
  (insert "Content-type: text/plain\n")
  (insert "\n"))

(defun mime-include-external-anonftp (site directory name content-type 
                                           description)
  "Include an external pointer (anonymous FTP) in a MIME message."
  (interactive "sFTP site: \nsRemote directory name: \nsRemote filename: \nsContent type: \nsDescription: ")
  (mime-include-external site directory name content-type description "anon-ftp"))

(defun mime-include-external-ftp (site directory name content-type description)
  "Include an external pointer (regular FTP) in a MIME message."
  (interactive "sFTP site: \nsRemote directory name: \nsRemote filename: \nsContent type: \nsDescription: ")
  (mime-include-external site directory name content-type description "ftp"))

(defun mime-include-xwd-dump ()
  "Run xwd and include the results in a MIME message."
  (interactive)
  (mime-mimify-message)
  (push-mark)
  (insert "--" (mime-primary-boundary) "\n")
  (insert "Content-type: image/x-xwd\n")
  (insert "Content-Transfer-Encoding: base64\n")
  (insert "\n")
  (let ((start (point)) end)
    (next-line 1)
    (save-excursion
      (next-line -1)
      (shell-command mime-xwd-command t))
    (setq end (point))
    (shell-command-on-region start end "mmencode" t)
    (setq end (point))
    (insert "\n")
    (insert "--" (mime-primary-boundary) "\n")
    (insert "Content-type: text/plain\n")
    (insert "\n\n")
    (next-line -1)))

(defun mime-grab-audio-snippet ()
  (let ((audio-process))
    (setq audio-process 
          (start-process "snippet" "snippet" 
                         "recordaiff" "-n" "1" "-s" "8" "-r" "8000"
                         "/tmp/fooblatz.aiff"))
    ;; Quick hack to make Emacs sit until recording is done.
    (y-or-n-p "Press y or n when finished: ")
    (interrupt-process "snippet")
    ;; Wait until recordaiff has written data to disk. */
    (while (eq (process-status "snippet") 'run)
      (message "Waiting...")
      (sleep-for 1))
    ;; Kill off recordaiff and our buffer.
    (delete-process "snippet")
    (kill-buffer "snippet")
    ;; Remove the old mulaw file and do the conversion.
    (shell-command "rm -r /tmp/fooblatz")
    (shell-command 
     "sfconvert /tmp/fooblatz.aiff /tmp/fooblatz -o mulaw")))

(defun mime-include-audio-snippet ()
  "Record a snippet of audio in a MIME message.  This will only work
on SGI IRIS Indigo's and PI/35's."
  (interactive)
  (mime-mimify-message)
  (push-mark)
  (insert "--" (mime-primary-boundary) "\n")
  (insert "Content-type: audio/basic\n")
  (insert "Content-Transfer-Encoding: base64\n")
  (insert "\n")
  (let ((start (point)) end)
    (next-line 1)
    (save-excursion
      (next-line -1)
      (mime-grab-audio-snippet)
      (insert-file "/tmp/fooblatz"))
    (setq end (point))
    (shell-command-on-region start end "mmencode" t)
    (setq end (point))
    (insert "\n")
    (insert "--" (mime-primary-boundary) "\n")
    (insert "Content-type: text/plain\n")
    (insert "\n\n")
    (next-line -1)))

(defun mime-include-gif (filename)
  "Include a GIF file."
  (interactive "fGIF image filename: ")
  (mime-include-binary-file filename "image/gif"))
(defun mime-include-jpeg (filename)
  "Include a JPEG file."
  (interactive "fJPEG image filename: ")
  (mime-include-binary-file filename "image/jpeg"))
(defun mime-include-audio (filename)
  "Include an audio file."
  (interactive "fAudio filename: ")
  (mime-include-binary-file filename "audio/basic"))
(defun mime-include-postscript (filename)
  "Include a PostScript file."
  (interactive "fPostScript filename: ")
  (mime-include-nonbinary-file filename "application/postscript"))
(defun mime-include-raw-binary (filename content-type)
  "Include a raw binary file."
  (interactive "fRaw binary filename: \nsContent type (RET for default): ")
  (if (string= content-type "")
      (setq content-type "application/octet-stream"))
  (mime-include-binary-file filename content-type))

;;; Add functions to basic mail mode.
(define-key mail-mode-map "\C-cm" 'mime-mimify-message)
(define-key mail-mode-map "\C-cg" 'mime-include-gif)
(define-key mail-mode-map "\C-cj" 'mime-include-jpeg)
(define-key mail-mode-map "\C-ca" 'mime-include-audio)
(define-key mail-mode-map "\C-cp" 'mime-include-postscript)
(define-key mail-mode-map "\C-cr" 'mime-include-raw-binary)
(define-key mail-mode-map "\C-cx" 'mime-include-xwd-dump)
(define-key mail-mode-map "\C-ce" 'mime-include-external-anonftp)
(define-key mail-mode-map "\C-cf" 'mime-include-external-ftp)
(define-key mail-mode-map "\C-cs" 'mime-include-audio-snippet)

;;; Add functions to MH letter mode.
(if (boundp 'mh-letter-mode-map)
    (if (or (not (boundp 'mh-letter-mode-mime-map)) 
            (not mh-letter-mode-mime-map))
        (progn
          (setq mh-letter-mode-mime-map (make-sparse-keymap))
          (define-key mh-letter-mode-map "\C-c\C-m" mh-letter-mode-mime-map)
          (define-key mh-letter-mode-mime-map "m" 'mime-mimify-message)
          (define-key mh-letter-mode-mime-map "g" 'mime-include-gif)
          (define-key mh-letter-mode-mime-map "j" 'mime-include-jpeg)
          (define-key mh-letter-mode-mime-map "a" 'mime-include-audio)
          (define-key mh-letter-mode-mime-map "p" 'mime-include-postscript)
          (define-key mh-letter-mode-mime-map "r" 'mime-include-raw-binary)
          (define-key mh-letter-mode-mime-map "x" 'mime-include-xwd-dump)
          (define-key mh-letter-mode-mime-map "e" 
            'mime-include-external-anonftp)
          (define-key mh-letter-mode-mime-map "f" 
            'mime-include-external-ftp)
          (define-key mh-letter-mode-mime-map "s"
            'mime-include-audio-snippet))))

;;; -------------------------------- Menubar ---------------------------------

(defvar mime-running-lemacs (string-match "Lucid" emacs-version)
  "Non-nil if running Lucid Emacs.")

;; All we do at the moment is replace the popup menu defined in
;; Lucid Emacs 19.3's sendmail.el.
(if mime-running-lemacs
    (progn
      (setq mail-mode-menu
        '("Mail Mode"
          "Sending Mail:"
          "----"
          ["Send and Exit"		mail-send-and-exit		t]
          ["Send Mail"			mail-send			t]
          ["Sent Via"			mail-sent-via			t]
          "----"
          "Go to Field:"
          "----"
          ["To:"			mail-to				t]
          ["Subject:"			mail-subject			t]
          ["CC:"			mail-cc				t]
          ["BCC:"			mail-bcc			t]
          ["Text"			mail-text			t]
          "----"
          "Miscellaneous Commands:"
          "----"
          ["Yank Original"		mail-yank-original		t]
          ["Fill Yanked Message"	mail-fill-yanked-message	t]
          ["Insert Signature"		mail-signature			t]
          "----"
          "MIME Inclusions:"
          "----"
          ["Include GIF File"           mime-include-gif                t]
          ["Include JPEG File"          mime-include-jpeg               t]
          ["Include Audio File"         mime-include-audio              t]
          ["Include PostScript File"    mime-include-postscript         t]
          ["Include XWD Dump"           mime-include-xwd-dump           t]
          ["Include Raw Binary File"    mime-include-raw-binary         t]
          ["Include External AnonFTP"   mime-include-external-anonftp   t]
          ["Include External FTP"       mime-include-external-ftp       t]
          "----"
          ["Abort" kill-buffer t]
          ))))

;;; ----------------------------- New mail-send ------------------------------

;; If we're not running Lemacs, pop in a new mail-send routine.
(if (not mime-running-lemacs)
    (defun mail-send ()
      "Send the message in the current buffer.
If  mail-interactive  is non-nil, wait for success indication
or error messages, and inform user.
Otherwise any failure is reported in a message back to
the user from the mailer."
      (interactive)
      (message "Sending...")
      (run-hooks 'mail-send-hook)
      (funcall send-mail-function)
      (set-buffer-modified-p nil)
      (delete-auto-save-file-if-necessary)
      (message "Sending...done")))

;;; --------------------------------- Hooks ----------------------------------

;; Author: Daniel LaLiberte (liberte@cs.uiuc.edu).
(defun mime-postpend-unique-hook (hook-var hook-function)
  "Postpend HOOK-VAR with HOOK-FUNCTION, if it is not already an element.
hook-var's value may be a single function or a list of functions."
  (if (boundp hook-var)
      (let ((value (symbol-value hook-var)))
        (if (and (listp value) (not (eq (car value) 'lambda)))
            (and (not (memq hook-function value))
                 (set hook-var (append value (list hook-function))))
          (and (not (eq hook-function value))
               (set hook-var (append value (list hook-function))))))
    (set hook-var (list hook-function))))

(defun mime-unfrob-selective-display ()
  "Turn off selective display throughout this buffer."
  (if mime-use-selective-display
      (progn
        (message "Unfrobbing selective-display...")
        (mime-hide-region (point-min) (point-max) nil))))

;; Before the message is sent, remove the selective display crap.
(mime-postpend-unique-hook 'mail-send-hook 'mime-unfrob-selective-display)

--
Marc Andreessen
Software Development Group
National Center for Supercomputing Applications
marca@ncsa.uiuc.edu