--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/efs/efs-vm.el	Mon Aug 13 08:50:29 2007 +0200
@@ -0,0 +1,342 @@
+;; -*-Emacs-Lisp-*-
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; File:         efs-vm.el
+;; Release:      $efs release: 1.15 $
+;; Version:      $Revision: 1.1 $
+;; RCS:          
+;; Description:  Allows the VM  mail reader to access folders using efs.
+;;               If you are looking for support for VM/CMS, see efs-cms.el.
+;; Author:       Sandy Rutherford <sandy@ibm550.sissa.it>
+;; Created:      Mon Nov  9 23:49:18 1992 by sandy on riemann
+;; Modified:     Sun Nov 27 18:44:07 1994 by sandy on gandalf
+;; 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; If vm-get-new-mail (usually bound to "g") is given a prefix, it
+;; will prompt for a folder from which to collect mail. With
+;; efs-vm, this folder can be in efs syntax. As is usual
+;; with VM, this folder will not be deleted. If at the folder prompt,
+;; you give "/user@host:", efs-vm will collect mail from the
+;; spool file on the remote machine. The spool file will be deleted if
+;; the mail is successfully collected. It is not necessary for
+;; movemail, nor even emacs, to be installed on the remote machine.
+;; The functionality of movemail is mimicked with FTP commands. Both
+;; local and remote crashboxes are used, so that mail will not be lost
+;; if the FTP connection is lost.
+;;
+;; To use efs-vm, put (require 'efs-vm) in your .vm file.
+;;
+;; Works for vm 5.56 through 5.72.  May not work with older versions.
+;; If vm grows some file-name-handler-alist support, we should use it.
+;; Actually it has.  I just haven't gotten around to this yet.
+
+;;; Known Bugs:
+;;
+;;  1. efs-vm will not be able to collect mail from a spool file if
+;;     you do not have write permission in the spool directory.
+;;     I think that this precludes HP-UX.
+;;     I hope to do something about this.
+;;
+;;  2. efs-vm is as clever as at can be about spool file locking.
+;;     i.e. not very clever at all.  At least it uses a rename command
+;;     to minimize the window for problems.  Use POP if you want to
+;;     be careful.
+;;
+
+;;; Provisions, requirements, and autoloads
+
+(provide 'efs-vm)
+(require 'efs-cu)
+(require 'efs-ovwrt)
+(require 'vm)
+;(require 'vm-folder) ; not provided
+(if (or (not (fboundp 'vm-get-new-mail))
+	(eq (car-safe (symbol-function 'vm-get-new-mail)) 'autoload))
+    (load-library "vm-folder"))
+(autoload 'efs-make-tmp-name "efs")
+(autoload 'efs-del-tmp-name "efs")
+(autoload 'efs-send-cmd "efs")
+(autoload 'efs-re-read-dir "efs")
+(autoload 'efs-copy-file-internal "efs")
+
+;;; User variables
+
+(defvar efs-vm-spool-files nil
+  "Association list of \( USER@MACHINE . SPOOLFILES \) pairs that
+specify the location of the default remote spool file for MACHINE. SPOOLFILES
+is a list of remote spool files.")
+
+(defvar efs-vm-crash-box "~/EFS.INBOX.CRASH"
+  "Local file where efs keeps its local crash boxes.")
+
+;;; Internal variables
+
+(defconst efs-vm-version
+  (concat (substring "$efs release: 1.15 $" 14 -2)
+	  "/"
+	  (substring "$Revision: 1.1 $" 11 -2)))
+
+
+(defun efs-vm-get-new-mail (&optional arg)
+  "Documented as original"
+  (interactive "P")
+  (vm-select-folder-buffer)
+  (vm-check-for-killed-summary)
+  (vm-error-if-virtual-folder)
+  (vm-error-if-folder-read-only)
+  (cond
+   ((null arg)
+    (if (not (eq major-mode 'vm-mode))
+	(vm-mode))
+    (if (consp (car (vm-spool-files)))
+	(message "Checking for new mail for %s..." buffer-file-name)
+      (message "Checking for new mail..."))
+    (let (new-messages totals-blurb)
+      (if (and (vm-get-spooled-mail)
+	       (setq new-messages (vm-assimilate-new-messages t)))
+	  (progn
+	    (if vm-arrived-message-hook
+		(while new-messages
+		  (vm-run-message-hook (car new-messages)
+				       'vm-arrived-message-hook)
+		  (setq new-messages (cdr new-messages))))
+	    ;; say this NOW, before the non-previewers read
+	    ;; a message, alter the new message count and
+	    ;; confuse themselves.
+	    (setq totals-blurb (vm-emit-totals-blurb))
+	    (vm-display nil nil '(vm-get-new-mail) '(vm-get-new-mail))
+	    (if (vm-thoughtfully-select-message)
+		(vm-preview-current-message)
+	      (vm-update-summary-and-mode-line))
+	    (message totals-blurb))
+	(if (consp (car (vm-spool-files)))
+	    (message "No new mail for %s" buffer-file-name)
+	  (message "No new mail."))
+	(sit-for 4)
+	(message ""))))
+   (t
+    (let* ((buffer-read-only nil)
+	   (folder (read-file-name "Gather mail from folder: "
+				   vm-folder-directory t))
+	   (parsed (efs-ftp-path folder))
+	   mcount new-messages totals-blurb)
+      (if parsed
+	  (if (string-equal (nth 2 parsed) "")
+	      ;; a spool file
+	      (if (not (and (efs-vm-get-remote-spooled-mail folder)
+			    (setq new-messages
+				  (vm-assimilate-new-messages t))))
+		  (progn
+		    (message
+		     "No new mail, or mail couldn't be retrieved by ftp.")
+		    ;; don't let this message stay up forever...
+		    (sit-for 4)
+		    (message ""))
+		(if vm-arrived-message-hook
+		    (while new-messages
+		      (vm-run-message-hook (car new-messages)
+					   'vm-arrived-message-hook)
+		      (setq new-messages (cdr new-messages))))
+		;; say this NOW, before the non-previewers read
+		;; a message, alter the new message count and
+		;; confuse themselves.
+		(setq totals-blurb (vm-emit-totals-blurb))
+		(vm-display nil nil '(vm-get-new-mail) '(vm-get-new-mail))
+		(if (vm-thoughtfully-select-message)
+		    (vm-preview-current-message)
+		  (vm-update-summary-and-mode-line))
+		(message totals-blurb))
+	    
+	    ;; a remote folder
+	    (let ((tmp-file (car (efs-make-tmp-name nil (car parsed))))
+		  (folder (expand-file-name folder)))
+	      (unwind-protect
+		  (progn
+		    (efs-copy-file-internal
+		     folder parsed tmp-file nil t nil
+		     (format "Getting %s" folder)
+		     ;; asynch worries me here
+		     nil nil)
+		    (if (and vm-check-folder-types
+			     (not (vm-compatible-folder-p tmp-file)))
+			(error
+			 "Folder %s is not the same format as this folder."
+			 folder))
+		    (save-excursion
+		      (vm-save-restriction
+		       (widen)
+		       (goto-char (point-max))
+		       (insert-file-contents tmp-file)))
+		    (setq mcount (length vm-message-list))
+		    (if (setq new-messages (vm-assimilate-new-messages))
+			(progn
+			  (if vm-arrived-message-hook
+			      (while new-messages
+				(vm-run-message-hook (car new-messages)
+						     'vm-arrived-message-hook)
+				(setq new-messages (cdr new-messages))))
+			  ;; say this NOW, before the non-previewers read
+			  ;; a message, alter the new message count and
+			  ;; confuse themselves.
+			  (setq totals-blurb (vm-emit-totals-blurb))
+			  (vm-display nil nil '(vm-get-new-mail)
+				      '(vm-get-new-mail))
+			  (if (vm-thoughtfully-select-message)
+			      (vm-preview-current-message)
+			    (vm-update-summary-and-mode-line))
+			  (message totals-blurb)
+			  ;; The gathered messages are actually still on disk
+			  ;; unless the user deletes the folder himself.
+			  ;; However, users may not understand what happened if
+			  ;; the messages go away after a "quit, no save".
+			  (setq vm-messages-not-on-disk
+				(+ vm-messages-not-on-disk
+				   (- (length vm-message-list)
+				      mcount))))
+		      (message "No messages gathered."))
+		    (efs-del-tmp-name tmp-file)))))
+
+	;; local
+	
+	(if (and vm-check-folder-types
+		 (not (vm-compatible-folder-p folder)))
+	    (error "Folder %s is not the same format as this folder."
+		   folder))
+	(save-excursion
+	  (vm-save-restriction
+	   (widen)
+	   (goto-char (point-max))
+	   (insert-file-contents folder)))
+	(setq mcount (length vm-message-list))
+	(if (setq new-messages (vm-assimilate-new-messages))
+	    (progn
+	      (if vm-arrived-message-hook
+		  (while new-messages
+		       (vm-run-message-hook (car new-messages)
+					    'vm-arrived-message-hook)
+		       (setq new-messages (cdr new-messages))))
+	      ;; say this NOW, before the non-previewers read
+	      ;; a message, alter the new message count and
+	      ;; confuse themselves.
+	      (setq totals-blurb (vm-emit-totals-blurb))
+	      (vm-display nil nil '(vm-get-new-mail) '(vm-get-new-mail))
+	      (if (vm-thoughtfully-select-message)
+		  (vm-preview-current-message)
+		(vm-update-summary-and-mode-line))
+	      (message totals-blurb)
+	      ;; The gathered messages are actually still on disk
+	      ;; unless the user deletes the folder himself.
+	      ;; However, users may not understand what happened if
+	      ;; the messages go away after a "quit, no save".
+	      (setq vm-messages-not-on-disk
+		       (+ vm-messages-not-on-disk
+			  (- (length vm-message-list)
+			     mcount))))
+	  (message "No messages gathered.")))))))
+
+(defun efs-vm-gobble-remote-crash-box (remote-crash-box)
+  (let ((remote-crash-box (expand-file-name remote-crash-box))
+	(crash-box (expand-file-name efs-vm-crash-box))
+	lsize)
+    (if (file-exists-p vm-crash-box)
+	(progn
+	  ;; This should never happen, but let's make sure that we never
+	  ;; clobber mail.
+	  (message "Recovering messages from local crash box...")
+	  (vm-gobble-crash-box efs-vm-crash-box)
+	  (message "Recovering messages from local crash box... done")))
+    (efs-copy-file-internal remote-crash-box (efs-ftp-path remote-crash-box)
+			    crash-box nil nil nil
+			    (format "Getting %s" remote-crash-box)
+			    ;; asynch worries me here
+			    nil nil)
+    ;; only delete the remote crash box if we are sure that we have everything
+    (if (and (setq lsize (nth 7 (file-attributes crash-box)))
+	     (eq lsize (nth 7 (file-attributes remote-crash-box)))
+	     (vm-compatible-folder-p crash-box))
+	(progn
+	  (vm-gobble-crash-box crash-box)
+	  (delete-file remote-crash-box))
+      ;; don't leave garbage in the local crash box
+      (condition-case () (delete-file crash-box) (error nil))
+      (error "Problem reading remote crash box %s" remote-crash-box))))
+
+(defun efs-vm-get-remote-spooled-mail (remote-path)
+  ;; remote-path is usually of the form /user@machine:
+  ;; Usually vm sets inhibit-quit to t for this. This is probably
+  ;; a bad idea if there is ftp activity.
+  ;; I don't want to assume that the remote machine has movemail.
+  ;; Try to mimic movemail with ftp commands as best as possible.
+  ;; For this to work, we need to be able to create a subdirectory
+  ;; in the spool directory.
+  (if vm-block-new-mail
+    (error "Can't get new mail until you save this folder."))
+  (let* ((parsed (efs-ftp-path remote-path))
+	 (host (car parsed))
+	 (user (nth 1 parsed))
+	 (spool-files
+	  (or (cdr (assoc (concat user "@" host)
+			  efs-vm-spool-files))
+	      (list (concat "/usr/spool/mail/" user))))
+	 got-mail)
+    (while spool-files
+      (let* ((s-file (car spool-files))
+	     (spool-file (format efs-path-format-string user host s-file))
+	     ;; rmdir and mkdir bomb if this path ends in a /.
+	     (c-dir (concat s-file ".CRASHBOX"))
+	     (rc-file (concat c-dir "/CRASHBOX"))
+	     (crash-dir (concat spool-file ".CRASHBOX/"))
+	     (remote-crash-file (concat crash-dir "CRASHBOX"))
+	     (crash-box (expand-file-name efs-vm-crash-box)))
+	(if (file-exists-p crash-box)
+	    (progn
+	      (message "Recovering messages from crash box...")
+	      (vm-gobble-crash-box crash-box)
+		 (message "Recovering messages from crash box... done")
+		 (setq got-mail t)))
+	(if (let ((efs-allow-child-lookup nil))
+	      (file-exists-p remote-crash-file))
+	    (progn
+	      (message "Recovering messages from remote crash box...")
+	    (efs-vm-gobble-remote-crash-box remote-crash-file)
+	    (message "Recovering messages from remote crash box... done")
+	    (setq got-mail t)))
+	(if (file-exists-p crash-box)
+	    (progn
+	      (message "Recovering messages from crash box...")
+	      (vm-gobble-crash-box crash-box)
+	      (message "Recovering messages from crash box... done")
+	      (setq got-mail t)))
+	(unwind-protect
+	    (if (car
+		 (efs-send-cmd
+		  host user (list 'mkdir c-dir)
+		  (format "Making crash directory %s" crash-dir)))
+		(progn
+		  (efs-re-read-dir crash-dir)
+		  (message "Unable to make crash directory %s" crash-dir)
+		  (ding))
+	      (or (car
+		   (efs-send-cmd host user (list 'rename s-file rc-file)
+				 (format "Checking spool file %s" spool-file)))
+		  (progn
+		    (message "Getting new mail from %s..." spool-file)
+		    ;; The rename above wouldn't have updated the cash.
+		    (efs-re-read-dir crash-dir)
+		    (efs-vm-gobble-remote-crash-box remote-crash-file)
+		    (message "Getting new mail from %s... done" spool-file)
+		    (setq got-mail t))))
+	  (condition-case nil
+	      (efs-send-cmd
+	       host user (list 'rmdir c-dir)
+	       "Removing crash directory")
+	    (error nil))))
+      (setq spool-files (cdr spool-files)))
+    got-mail))
+
+;;; Overwrite existing functions
+
+(efs-overwrite-fn "efs" 'vm-get-new-mail)
+
+;;; end of efs-vm.el