home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / mm / mm-ccmd-0.91.tar.Z / mm-ccmd-0.91.tar / work / mm / mmail.el < prev    next >
Lisp/Scheme  |  1990-12-18  |  4KB  |  123 lines
  1. ;;
  2. ;; Copyright (c) 1986, 1990 by The Trustees of Columbia University in
  3. ;; the City of New York.  Permission is granted to any individual or
  4. ;; institution to use, copy, or redistribute this software so long as it
  5. ;; is not sold for profit, provided this copyright notice is retained.
  6. ;;
  7.  
  8. ;; $Header: /f/src2/encore.bin/cucca/mm/tarring-it-up/RCS/mmail.el,v 2.2 90/10/04 18:39:21 melissa Exp $
  9.  
  10. (defconst *mmail-buffers*
  11.   '("*MM Outgoing*"            ; outgoing message buffer
  12.     "*MM In Reply To*"            ; Message replying to
  13.     "*MM Headers*"            ; header buffer
  14.     "*MM Message*")            ; Old message
  15.   "List of buffers for MM mode")
  16.  
  17. (defvar mmail-mode-hooks nil
  18.   "list of functions to call when entering mmail-mode.  This is called 
  19. after all of the mmail-mode buffers are set up.
  20. ")
  21.  
  22. ;; gnuemacs mmail mode for editing messages in mm
  23.  
  24. (defun mmail-mode () "Read MM tempfile, and set up buffers."
  25.   (interactive)
  26.   (setq window-min-height 1)
  27.   (define-key ctl-x-map "\^z" 'save-buffers-kill-emacs)
  28.   (define-key ctl-x-map "\^w" 'mmail-write-file)
  29.   (define-key esc-map "\t" 'mmail-tab-to-next-field)
  30.   (let ((p nil)
  31.     (fname nil)
  32.     (used-buffers nil)
  33.     (this-buffer (current-buffer))
  34.     (buffers *mmail-buffers*))
  35.     (switch-to-buffer "*scratch*" t)
  36.     (set-buffer this-buffer)
  37.     (goto-char (point-min))        ; start at the very beginning
  38.     (while (< (point) (point-max))    ; for all files,
  39.       (setq p (point))            ; remember beginning of line
  40.       (end-of-line 1)            ; go to the end of the line
  41.       (setq fname (buffer-substring p (point))) ; get the line as a filename
  42.       (cond ((not (string= fname "nil")) ; if not a "nil" file
  43.          (find-file fname)    ; read it in.
  44.          (text-mode)
  45.          (if buffers        ; set the name
  46.          (rename-buffer (car buffers)))
  47.          (make-local-variable 'version-control)
  48.          (setq version-control 'never)
  49.          (setq used-buffers
  50.            (append used-buffers (list(car buffers))))))
  51.       (setq buffers (cdr buffers)) ; buffer is used up
  52.       (set-buffer this-buffer)
  53.       (beginning-of-line 2))        ; get next file
  54.     (kill-buffer (current-buffer))    ; all done, kill this temp buffer
  55.     (switch-to-buffer "*scratch*" t)
  56.     (mmail-mode-fix-buffers used-buffers)) ; and do buffer specific things
  57.   (bury-buffer "*scratch*")
  58.   (message 
  59.    "Don't forget to save your buffers if you want your changes to take effect")
  60.   (let ((hooks mmail-mode-hooks))
  61.     (while (and hooks
  62.         (not (funcall (car hooks))))
  63.       (setq hooks (cdr hooks)))))
  64.  
  65. (defun mmail-mode-fix-buffers (buffers)
  66.   (cond ((< 1 (length buffers))        ; if more than one buffer
  67.      (split-window-vertically nil)    ; then have two windows
  68.      (other-window 1)))
  69.   (mmail-set-windows buffers 1)
  70.   (select-window (get-buffer-window (car buffers))))
  71.  
  72.  
  73. (defun mmail-set-windows (buffers windownum)
  74.   (cond ((null buffers))
  75.     (t (cond ((= 1 windownum)
  76.           (switch-to-buffer (car buffers)))
  77.          ((= 2 windownum)
  78.           (switch-to-buffer (car buffers))
  79.           (window-to-size))
  80.          (t (set-buffer (car buffers))))
  81.        (cond ((string= (car buffers) "*MM In Reply To*")
  82.           (setq buffer-read-only t)
  83.           (goto-char (point-min))
  84.           (re-search-forward "^$" (1- (point-max)) t)
  85.           (beginning-of-line 2)
  86.           (recenter 0))
  87.          ((string= (car buffers) "*MM Headers*")
  88.           (setq fill-prefix "    ")
  89.           (auto-fill-mode 1)
  90.           (goto-char (point-min)))
  91.          ((string= (car buffers) "*MM Outgoing*")
  92.           (auto-fill-mode 1)
  93.           (goto-char (point-max)))
  94.          ((string= (car buffers) "*MM Message*")))
  95.        (other-window 1)
  96.        (mmail-set-windows (cdr buffers) (1+ windownum)))))
  97.  
  98. (defun mmail-write-file (filename)
  99.   "Write file to FILENAME, but do not update filename or buffer name."
  100.   (interactive "FWrite file: ")
  101.   (write-region (point-min) (point-max) filename nil nil))
  102.   
  103. (defun mmail-tab-to-next-field ()
  104.   (interactive)
  105.   (let ((dot (point)))
  106.     (or (re-search-forward "^[A-Za-z-]+: ?" nil t)
  107.     (and (goto-char 1) (re-search-forward "^[A-Za-z-]+: ?" dot t))
  108.     (and (goto-char dot) (indent-for-tab-command)))))
  109.  
  110.  
  111. (defun window-to-size () "shrink a window to the size of the text in it"
  112.   (interactive "")
  113.   (let ((len 0))
  114.     (if (> (setq len (- (window-height) (count-lines (point-min) (point-max))))
  115.        1)
  116.     (shrink-window (1- len)))))
  117.  
  118.  
  119.  
  120. (mmail-mode)
  121.  
  122.  
  123.