; From: klm@goon.cme.nbs.gov (Ken Manheimer) ; Newsgroups: gnu.emacs ; Subject: Re: BABYL to unix mail format converter? ; Message-ID: ; Date: 17 Aug 89 15:03:17 GMT ; References: <31142@cornell.UUCP> ; Organization: Nat'l Institute of Standards and Technology ; Lines: 362 ; ; 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 ".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 ".rmail", leaving the vm translation as ; . 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 CR' 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 '.rmail' (but otherwise unaffected) and new vm versions are given original name ''. 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 "\\(\n+\\)From ") (delete-region (match-beginning 1) (match-end 1))) (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) (delete-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 " (From-addr-field (save-excursion ; Two main forms - ; "^From: ProperNm .. " ; 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 (concat "From " From-addr-field " " From-date-field "\n")) ; Insert vm attributes line: (insert (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 ) ) )