From:	CRDGW2::CRDGW2::MRGATE::"SMTP::PREP.AI.MIT.EDU::INFO-GNU-EMACS-REQUEST" 17-AUG-1989 14:35
To:	MRGATE::"ARISIA::EVERHART"
Subj:	Re: BABYL to unix mail format converter?

Received: by life.ai.mit.edu (4.1/AI-4.10) id AA03935; Thu, 17 Aug 89 11:41:25 EDT
Return-Path: <info-gnu-emacs-request@prep.ai.mit.edu>
Received: from tut.cis.ohio-state.edu by life.ai.mit.edu (4.1/AI-4.10) id AA03755; Thu, 17 Aug 89 11:19:58 EDT
Received: by tut.cis.ohio-state.edu (5.61/4.890725)
	id AA16675; Thu, 17 Aug 89 11:13:44 -0400
Received: from USENET by tut.cis.ohio-state.edu with netnews
	for info-gnu-emacs@prep.ai.mit.edu (info-gnu-emacs@prep.ai.mit.edu)
	(contact usenet@tut.cis.ohio-state.edu if you have questions)
Date: 17 Aug 89 15:03:17 GMT
From: cme!durer!klm@uunet.uu.net  (Ken Manheimer)
Organization: Nat'l Institute of Standards and Technology
Subject: Re: BABYL to unix mail format converter?
Message-Id: <KLM.89Aug17110317@goon.cme.nbs.gov>
References: <31142@cornell.UUCP>
Sender: info-gnu-emacs-request@prep.ai.mit.edu
To: info-gnu-emacs@prep.ai.mit.edu

I developed this script a few weeks ago, made some major changes last
week, and was getting ready to post to the world (beyond my site)
today, and then someone lets me know about the current activity on
just this topic in this newsgroup.

Below is a set of functions that provide a fairly thorough means to
generate vm versions of rmail files in your directory hierarchy.  The
function you probably want to use, if you're like me and have a lot of
rmail files in some directory hierarchy (or scattered around your
general directory hierarchy), is the function 'rmail-hierarchy-to-vm'.
You can do the conversion on a folder-by-folder basis with the
function 'rmail-folder-to-vm'.  (See comments at the top of the code
for more details about operation and customization.)

The folder and hierarchy functions move the original, rmail version of
the folder to a file with the suffix ".rmail" appended to their name,
and leave the original name assigned to the vm-translation of the
folder.  Once you've run it and have satisfied yourself that it worked
ok you can use, eg, find to identify and delete the "<fn>.rmail" files.

I was careful to preserve the sundry message characteristics (like
replied, filed, etc) in the translation, though some of the mapping
was inferred by reverse engineering and may not be exactly right.
(I'm inclined to think it is, though - anyone who feels otherwise
please let me know.)

One other caution - i added some code to prevent the programs from
following symbolic links only to discover that pretty much everyone at
my sight who needed to do the conversion had already used my previous
release, and so i had no one to test the fairly simple mods.  I did
some complicated-case tests but couldn't do anything really extensive,
as i did with the prior release.  Once again, i'm fairly assured about
the code but if you have any problems (or comments) please let me know
and i'll look into it asap...

Ken Manheimer		 	Nat'l Inst of Standards and Technology
(301) 975-3539			(Formerly "National Bureau of Standards")
klm@cme.nist.gov		CME, Factory Automation Systems Division
or ..!uunet!cme-durer!klm	Integrated Systems Group

"Gadzooks," he said stupidly as he jumped into his convertible lemon and
drove off with his egg-shaped wife.  - Mad Libs, published example.

; Translate rmail entities (folders residing in a directory hierarchy, folder,
; buffer, and message) into a vm equivalent.
;
; THERE IS NO EXPLICIT OR IMPLICIT WARRANTY ON THIS CODE.  I, the author,
; intend for everyone to have the right to share this code as stated in the
; GNU EMACS GENERAL PUBLIC LICENSE (as stated in a version on or after 11 Feb
; 1988).  In particular, i permit everyone to use it free of charge, and to
; redistribute it in whole or in part free of charge, with the condition that
; no one redistributing it charge for the code itself.
;
; Ken Manheimer	10-Aug-1989 	Nat'l Inst of Standards and Technology
; (301) 975-3539		(Formerly "National Bureau of Standards")
; klm@cme.nist.gov		CME, Factory Automation Systems Division
; or ..!uunet!cme-durer!klm	Integrated Systems Group
;
; The functions fall into two levels.  At the base are rmail-message-to-vm
; and rmail-buffer-to-vm, which do the actual text conversion from rmail to vm.
; They operate on the current buffer and have nothing to do with the business
; of visiting or saving files.  (rmail-buffer-to-vm takes care of the rmail
; file header and then dispatches rmail-message-to-vm to take care of the
; individual messages.)  Above them are the functions that deal with the file-
; system business.
;
; rmail-folder-to-vm actually creates a vm file for a designated rmail file and
; moves the rmail file to "<filename>.rmail", leaving the vm translation as
; <filename>.  Though the original file is renamed, it is not otherwise
; affected.
;
; Finally, rmail-hierarchy-to-vm will traverse an rmail directory
; hierarchy, starting at a source directory you specify, applying
; rmail-folder-to-vm to every rmail folder it finds.  It reports
; each directory that it completes.  This is the one you probably
; want to use if you have a bunch of files to convert.  Symbolic 
; links are not be traversed.  Iff 'rmail-to-vm-ignore-src-backups'
; (default t) is t then backup versions of rmail files (as determined by
; the elisp function 'backup-file-name-p') are skipped.  Iff the variable
; rmail-to-vm-dont-redo (default t) is t then previously processed
; rmail files (as indicated by their having an ".rmail" extension and a
; corresponding file whose name lacks that extension) will not be
; reprocessed.
;
; interactive functions:  perform translation:
; ---------------------	  -------------------
; rmail-hierarchy-to-vm	- create vm versions of any rmail files located in
;			  hierarchy designated by directory argument.  A few
;			  variable (see below) affects whether rmail backup
;			  versions are processed.
; rmail-folder-to-vm	- create vm version of rmail file, moving original
;			  rmail file to same name with ".rmail" appended and
;			  leaving the vm version with the original name.
; rmail-buffer-to-vm	- transform contents of current buffer.  The contents
;			  must start with rmail (ie, "Babyl") header.
; rmail-message-to-vm	- transform next rmail message somewhere after point in
;			  current buffer.  Need not have rmail header.
;
; Customization variables - after loading the file you can do an
; -----------------------   'ESC-x set-variable <var>CR<value>' to alter them.
; rmail-to-vm-ignore-src-backups	- default t
;	if t, rmail-hierarchy-to-vm won't create corresponding vm versions for
;	backups of rmail files (ie, won't process backup files).
; rmail-to-vm-dont-redo			- default t
;	iff t, rmail-folder-to-vm won't process rmail files when they already
;	have a ".rmail" extension and another file exists whose name is the
;	same excluding the ".rmail" suffix
;
; NOTE for all you recursion buffs out there - some of these functions are
; iterative where recursion looks appropriate - it turns out there are some
; stack limits that can be circumvented, but it seemed more expedient (for
; a few reasons) to just unravel some of the recursion to iteration.  (I
; happen to prefer reading and writing recursive code myself...  klm.)

(defconst r-to-v-notice "rmail-to-vm"
  "Preface for rmail-to-vm utility prompts")
(defvar rmail-to-vm-ignore-src-backups t
  "If true, rmail-hierarchy-to-vm skips translating rmail backup files")
(defvar rmail-to-vm-dont-redo t
  "If true, don't process rmail files in hierarchy scan that already have
existing vm versions")

(defconst rmail-file-head-line "^BABYL OPTIONS:$" "First line in rmail file")
(defconst rmail-entry-start "\^L\n")
(defconst rmail-entry-end "^\^_")
(defconst rmail-entry-msg-delim "^\\*\\*\\* EOOH \\*\\*\\*\n")
(defconst rmail-attrs "[01],.*\n")
(defconst rmail-attrs-line (concat "^" rmail-attrs))
(defconst rmail-summary-line "^Summary-line:.*$")
(defconst vm-attr-start "X-VM-Attributes: [")
(defconst rtv-done-suffix ".rmail")


(defun rmail-hierarchy-to-vm (srcDir)
  "Apply rmail-folder-to-vm to all rmail folders in hierarchy rooted at SRCDIR.
Non-rmail files in hierarchy ignored.  Original rmail files are renamed to
'<fn>.rmail' (but otherwise unaffected) and new vm versions are given original
name '<fn>'.  If rmail-to-vm-ignore-src-backups t then backup versions aren't
translated."
  (interactive "Drmail-to-vm on hierarchy: ")
					; ensure srcDir is directory format
  (if (file-directory-p srcDir)
      (setq srcDir (file-name-as-directory srcDir))
    (error "rmail-hierarchy-to-vm: %s not a directory" srcDir))
					; iterate through current dir entries 
  (let ((dirEntries (directory-files srcDir)))
    (while dirEntries
      (let ((entry (car dirEntries)))
	(cond						; skip . and ..:
	 ((or (string= entry ".")(string= entry "..")))
					; skip backups if indicated:
	 ((and rmail-to-vm-ignore-src-backups (backup-file-name-p entry)))
					; skip already done files if indicated:
	 ((and rmail-to-vm-dont-redo
	       (rtv-already-did (concat srcDir entry))))
					; don't follow symlinks:
	 ((file-symlink-p (concat srcDir entry))
	  (message "%s: symlink %s disregarded"
		   r-to-v-notice (concat srcDir entry)))
					; disregard unfathomable nonsense:
	 ((not (file-exists-p (concat srcDir entry))))

	 ((file-directory-p (concat srcDir entry))	; recurse on dirs
	  (rmail-hierarchy-to-vm (concat srcDir entry "/")))
	 (t						; translate files
	  (condition-case failure
	      (rmail-folder-to-vm (concat srcDir entry))
	    (file-error (if (not (y-or-n-p
				  (format "can't access %s, continue onwards? "
					  (concat srcDir entry))))
			    (error "rmail-hierarchy-to-vm foiled on %s"
				   (concat srcDir entry))))
	    (error
	     (if (not (y-or-n-p
		       (format "ignoring %s; bad rmail format, continue on? "
					  (concat srcDir entry))))
			    (error "rmail-hierarchy-to-vm foiled on %s"
				   (concat srcDir entry))))))))
      (setq dirEntries (cdr dirEntries))))
  (message "%s %s done." r-to-v-notice srcDir)
  )

(defun rtv-already-did (fn)
  (if (file-exists-p (concat fn ".rmail"))
      t
    (let ((fnlen (length fn))
	  (sufflen (length rtv-done-suffix)))
      (if (string= (substring fn (- fnlen sufflen) fnlen) rtv-done-suffix)
	  (file-exists-p (substring fn 0 (- fnlen sufflen)))))))

(defun rmail-folder-to-vm (src)
  "create vm version of rmail file, leaving original rmail version with
'.rmail' appended on name and leaving the vm version with the original name."
  (interactive "fRmail source folder: ")
  (cond					; validate:
   ((file-directory-p src) (error "Rmail source must not be a directory"))
   ((not (file-exists-p src)) (error "Rmail source %s not found" src))
   ((not (file-readable-p src)) (error "Rmail source %s unreadable" src)))
  (let ((dstBuf (create-file-buffer src)))
    (save-excursion
      (set-buffer dstBuf)		 ; Obtain rmail folder in dstBuf:
      (condition-case failure
	  (insert-file-contents src t)
	(error
	 (progn (set-buffer-modified-p nil)
		(kill-buffer dstBuf)
		(error "can't read %s; %s" src failure))))
      (if (looking-at rmail-file-head-line) ; Do cursory verify of rmail format
	   
	  (progn (condition-case failure
		     (rmail-buffer-to-vm)		; Do translation
		   (error (set-buffer-modified-p nil)
			  (kill-buffer dstBuf)
			  (error "%s bad format, giving up..." src)))

		 (goto-char (point-min))
		 (if (looking-at "From ")	; good enough...
		     (condition-case failure
			 (progn			; mv rmail file aside:
			   (rename-file src (concat src ".rmail") 1)
			   (write-file src))	; save vm version
		       (error
			(progn (set-buffer-modified-p nil)
			       (kill-buffer dstBuf)
			       (error "can't write %s; %s" src failure)))))))
      (set-buffer-modified-p nil)
      (kill-buffer dstBuf)))		; free up buffer
  )

(defun rmail-amt-entries ()
  (let ((count 0) opoint)
    (save-excursion
      (goto-char (point-min))
      (while (and (not (eobp))
		  (re-search-forward rmail-entry-start nil t))
	(setq count (1+ count))))
    count))

(defun current-match (ord)
  (buffer-substring (match-beginning ord) (match-end ord)))

(defun rmail-buffer-to-vm ()
  "Translate rmail-format contents of current buffer to vm format."
  (interactive)
  (let ((delFrom (point)))		; Delete Babyl header
    (re-search-forward rmail-entry-end)
    (kill-region delFrom (point)))
  (message "%s buffer %s" r-to-v-notice (buffer-file-name))
  (let ((amt-done 0)
	(total-amt (rmail-amt-entries)))
					; Massage messages to vm format
					; while we have more messages:
    (while (rmail-message-to-vm)
      (setq amt-done (1+ amt-done))
      (message "%s buffer %s: %d of %d done"
	       r-to-v-notice (buffer-file-name) amt-done total-amt)
      )

    )
)

(defun rmail-message-to-vm ()
  "Convert message following point in current buffer from rmail to vm format,
or return nil if no message following."
  (interactive)
  (if (re-search-forward
       (concat rmail-entry-start rmail-attrs) (1+ (buffer-size)) t)
      (progn
	(goto-char (match-beginning 0))
	(looking-at rmail-entry-start)
	(delete-region (match-beginning 0)(match-end 0)) ; dispose of delimiter
					; Determine and insert standard
					; mail-entry initial line and vm attrs:
	(let* ((eocm			; End-Of-Current-Message
		(save-excursion (re-search-forward rmail-entry-end)
				(point)))
	       (rmail-attrs-string
		(if (re-search-forward rmail-attrs-line eocm t)
		    (prog1 (current-match 0)
		      (delete-region (match-beginning 0) (match-end 0)))
		  "1,,"))
	       (eocm			; End-Of-Current-Message
		(save-excursion (re-search-forward rmail-entry-end)
				(point)))
					; toggled-header indicates whether
					; stuff after "***EOOH***" is full
					; header or not:
	       (toggled-header (string-match "0," rmail-attrs-string))
	       (new-attr "nil")
	       (unseen-attr
		(if (string-match "unseen" rmail-attrs-string) "t" "nil"))
	       (unread-attr new-attr)
	       (deleted-attr "nil")	; ignore saved "deleted" flags
	       (filed-attr
		(if (string-match "filed" rmail-attrs-string) "t" "nil"))
	       (replied-attr
		(if (string-match "answered"rmail-attrs-string)"t" "nil"))
					; insert mail-format line:
					; "From <user> <date>" 
	       (From-addr-field
		(save-excursion
					; Two main forms -
					; "^From: ProperNm .. <actual@address>"
					; or "^From: actual@address stuff..."
					; then progressively less likely forms
		  (cond ((re-search-forward "^From: .*<\\(.*\\)>" eocm t))
			((re-search-forward "^From: \\([^ \n]*\\)" eocm t))
			((re-search-forward
			  "^Really-From: \\([^ \n]*\\)"eocm t))
			((re-search-forward "^Sender: .*<\\(.*\\)>" eocm t))
			((re-search-forward "^Sender: \\([^ \n]*\\)" eocm t)))
		  (current-match 1)))
	       (From-date-field
		(save-excursion
		  (cond
		   ((re-search-forward
					; Suitable for the mailer at my site -
					; u may need to revise it for yours...
					; klm 19-Jul-1989
		     (concat
			; prelim vv    weekday vv     monthday vv
		      "^\^Iid [^ ]* " "\\([^,]*\\), " "\\([^ ]*\\) "
			; month vv	year vv	      clock time vv
		      "\\([^ ]*\\) " "\\([^ ]*\\) " "\\([^ ]*\\)") eocm t)
		    (concat
		     (current-match 1) " " ; weekday
		     (current-match 3) " " ; month
		     (current-match 2) " " ; monthday
		     (current-match 5) " " ; clock time
		     "19" (current-match 4))) ; year
		   ((re-search-forward "Date: \\(.*\\)$" eocm t)
		    (current-match 1))
		   (t "Previously"))))
	       )
					; Insert mail-entry initial line:
	  (insert-string
	   (concat "From " From-addr-field " " From-date-field "\n"))
					; Insert vm attributes line:
	  (insert-string
	   (concat "X-VM-Attributes: ["
		   new-attr " "
		   unseen-attr " "
		   deleted-attr " "
		   filed-attr " "
		   replied-attr "]\n"))
					; deal with digested/uprocessed header:
	  (let* ((eocm			; Recompute End-Of-Current-Message
		  (save-excursion (re-search-forward rmail-entry-end)
				  (point))))
	    (re-search-forward rmail-entry-msg-delim eocm t)
	    (delete-region (1- (match-beginning 0)) (1- (match-end 0)))
	    (if (not toggled-header)
		(delete-region (1- (point))
			       (progn (re-search-forward "^$") (point)))))
	  )
					; Delete entry-end delim, loop to next:
	(re-search-forward rmail-entry-end)
	(delete-backward-char 1)
	t
	)
    )
  )
