home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / misc / mh-pack.el < prev    next >
Encoding:
Text File  |  1990-07-22  |  4.5 KB  |  114 lines
  1. ;From utkcs2!emory!samsung!cs.utexas.edu!uunet!zephyr.ens.tek.com!tektronix!sequent!crg5!niven Wed Jun  6 08:07:16 EDT 1990
  2. ;Article 4375 of comp.emacs:
  3. ;Path: utkcs2!emory!samsung!cs.utexas.edu!uunet!zephyr.ens.tek.com!tektronix!sequent!crg5!niven
  4. ;From: niven@sequent.UUCP (Kevin H. Joyce)
  5. ;Newsgroups: comp.emacs
  6. ;Subject: mh-e things
  7. ;Message-ID: <NIVEN.90Jun5154546@crg2.UUCP>
  8. ;Date: 5 Jun 90 22:45:46 GMT
  9. ;Sender: root@crg5.UUCP
  10. ;Organization: Sequent Computer Systems Inc., Beaverton, OR
  11. ;Lines: 99
  12. ;
  13. ;Here's a little something I wrote for packing folders into a single file.
  14. ;The unpack function also unpacks ELM type folders. This is useful if you use 
  15. ;the ELM mail filter to funnel stuff into folders.
  16.  
  17. ;;   GNU EMACS, MH-E extension to allow packf and inc -file
  18. ;;   This allows large folders to be safely stored as a single file.
  19. ;;   Tested with mh 6.6 and gnu 18.55.15, and epoch 3.0.
  20. ;;   Enjoy. K. Joyce  10/5/89   rev 1.0
  21. ;;                    12/4/89   rev 1.1 added ability to unpack elm folders
  22. ;;
  23. (defvar mh-folder-mode-map (make-keymap)
  24.   "Keymap for composing mail.")
  25. (define-key mh-folder-mode-map "\ec" 'mh-copy-folder-to-file)
  26. (define-key mh-folder-mode-map "\ed" 'mh-get-folder-from-file)
  27. (defvar filename nil)
  28. (defun mh-copy-folder-to-file (folder range)
  29.   "Pack messages in the range into a single file whose name is that of the 
  30.    folder with -file tacked on the end. It is located in the user Mail 
  31.    directory. If the file already exists then the messages are simply
  32.    appended.  The messages are then deleted from the folder."
  33.   (interactive (list (mh-prompt-for-folder "copy to file: "
  34.                        mh-current-folder 
  35.                        nil)
  36.              (read-string "Range [all]? ")))
  37.   (mh-scan-folder folder (if (equal range "") "all" range))
  38.   (message "packing folder into a single file...")
  39.   (setq filename (substring folder 1 nil))
  40.   (setq filename (concat  filename "-file"))
  41.   (setq filename (concat  mh-user-path filename))
  42.   (mh-exec-cmd "packf" (if (equal range "") "all" range) "-file" filename)
  43.   (message "packing folder...done,   deleting messages from folder...")
  44.   (mh-exec-cmd "rmm" folder (if (equal range "") "all" range))
  45.   (setq mh-next-direction 'forward)
  46.   (mh-scan-folder mh-current-folder "all"))
  47. ;;
  48. ;;
  49. (defun mh-get-folder-from-file (folder)
  50.   "Unpack messages from a file folder-file where folder is the chosen
  51.    folder. The file is included in the folder of the same name. inc has
  52.    a bug that it adds a blank Return-Path: line so if this is in your
  53.    visible-headers make it insist on a char  (\\|Return-Path: [a-zA-Z0-9])
  54.    or something like that after the : space. The file is deleted after being
  55.    unpacked."
  56.   (interactive (list (mh-prompt-for-folder "insert file in folder: " 
  57.                        mh-current-folder 
  58.                        nil)))
  59.   (message "unpacking file into folder...")
  60.   (setq filename (substring folder 1 nil))
  61.   (setq filename (concat  filename "-file"))
  62.   (setq mh-elm-folder-name filename)
  63.   (setq filename (concat  mh-user-path filename))
  64. ;;
  65. ;; if the file has "from ...blah blah lines, put a blank line before each
  66. ;; occurance except the first
  67. ;;
  68.   (find-file filename)
  69.   (goto-char (point-min))
  70.   (mh-elm-folder-convert (point-min))
  71.   (save-buffer)
  72.   (kill-buffer mh-elm-folder-name)
  73. ;;
  74. ;; Now call inc to incorporate the mail..and erase file
  75. ;;
  76.   (mh-exec-cmd "inc" folder "-file" filename "-truncate")
  77.   (message "unpacking folder...done")
  78.   (setq mh-next-direction 'forward)
  79.   (mh-scan-folder mh-current-folder "all"))
  80. ;;
  81. ;;
  82. (defun mh-elm-folder-convert (start)
  83.   ;; Allow an elm type folder to be unpacked into mh compatible
  84.   ;; files. Basically requires searching for the 'from' line at the
  85.   ;; beginning of each piece of mail, and putting a blank line in front of it.
  86.   ;; The first piece of mail cannot have a blank line in front of it however.
  87.   (let ((case-fold-search t))
  88.     (save-restriction
  89.       (goto-char start)
  90.       (goto-char (point-min))
  91.         (forward-line 2)   ;skip first piece of mail
  92.            (while (re-search-forward
  93.             (concat "^[\^_]?\\("
  94. "From [^ \n]*\\(\\|\".*\"[^ \n]*\\)  ?[^ \n]* [^ \n]* *"
  95. "[0-9]* [0-9:]*\\( ?[A-Z]?[A-Z][A-Z]T\\| ?[-+]?[0-9][0-9][0-9][0-9]\\|\\) "
  96. "19[0-9]* *$\\|"
  97. "^Babyl Options:\\|"
  98. "\^L\n[01],\\)") nil t)
  99.         (beginning-of-line)
  100.         (open-line 1)
  101.         (forward-line 2))
  102.       (unlock-buffer))))
  103. ;;
  104. ;;
  105.  
  106. ;--
  107. ;
  108. ;----------------------------------------------------------------------------
  109. ;Kevin Joyce                                     UUCP:  ..uunet!sequent!niven
  110. ;Sequent Computer Systems, Beaverton, OR.                Tel.  (503) 526-4103
  111. ;----------------------------------------------------------------------------
  112.  
  113.  
  114.