From 373b1567db2c713c2a90909394f089a83415273c Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Thu, 10 Oct 1996 10:30:00 +0000 Subject: [PATCH] Generalize how RMAIL looks for the spool directory and the movemail program. --- v7/src/edwin/dos.scm | 4 ++- v7/src/edwin/edwin.pkg | 3 ++- v7/src/edwin/notify.scm | 10 +++++--- v7/src/edwin/os2.scm | 57 +++++++++++++++++++++++++---------------- v7/src/edwin/rmail.scm | 34 ++++++++++++------------ v7/src/edwin/unix.scm | 16 +++++++++--- 6 files changed, 78 insertions(+), 46 deletions(-) diff --git a/v7/src/edwin/dos.scm b/v7/src/edwin/dos.scm index bd2e48589..0c6a53616 100644 --- a/v7/src/edwin/dos.scm +++ b/v7/src/edwin/dos.scm @@ -1,6 +1,6 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: dos.scm,v 1.40 1996/10/09 15:44:28 cph Exp $ +;;; $Id: dos.scm,v 1.41 1996/10/10 10:29:20 cph Exp $ ;;; ;;; Copyright (c) 1992-96 Massachusetts Institute of Technology ;;; @@ -168,6 +168,8 @@ (define (os/write-file-methods) '()) (define (os/alternate-pathnames group pathname) group pathname '()) +(define (os/rmail-spool-directory) #f) +(define (os/rmail-primary-inbox-list system-mailboxes) system-mailboxes '()) (define (os/sendmail-program) "sendmail.exe") (define (os/rmail-pop-procedure) #f) (define (os/hostname) (error "OS/HOSTNAME procedure unimplemented.")) diff --git a/v7/src/edwin/edwin.pkg b/v7/src/edwin/edwin.pkg index 5255b524f..84a68a0a4 100644 --- a/v7/src/edwin/edwin.pkg +++ b/v7/src/edwin/edwin.pkg @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: edwin.pkg,v 1.198 1996/10/07 18:20:31 cph Exp $ +$Id: edwin.pkg,v 1.199 1996/10/10 10:30:00 cph Exp $ Copyright (c) 1989-96 Massachusetts Institute of Technology @@ -1559,6 +1559,7 @@ MIT in each case. |# fetch-all-fields fetch-first-field fetch-last-field + guarantee-rmail-variables-initialized make-in-reply-to-field prompt-for-rmail-output-filename rfc822-addresses->string diff --git a/v7/src/edwin/notify.scm b/v7/src/edwin/notify.scm index eb67da4fe..e0648e4dc 100644 --- a/v7/src/edwin/notify.scm +++ b/v7/src/edwin/notify.scm @@ -1,6 +1,6 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: notify.scm,v 1.16 1995/04/09 22:33:28 cph Exp $ +;;; $Id: notify.scm,v 1.17 1996/10/10 10:29:52 cph Exp $ ;;; ;;; Copyright (c) 1992-95 Massachusetts Institute of Technology ;;; @@ -118,10 +118,14 @@ Ignored if notify-show-mail is false." (define-variable mail-notify-directory "Directory in which MAIL-NOTIFY checks for mail." - (pathname-as-directory "/usr/mail/") - file-directory?) + #f + (lambda (object) (or (not object) (file-directory? object)))) (define (notifier:mail-present) + (if (not (ref-variable mail-notify-directory)) + (begin + (guarantee-rmail-variables-initialized) + (set-variable! mail-notify-directory rmail-spool-directory))) (if (let ((pathname (merge-pathnames (ref-variable mail-notify-directory) (current-user-name)))) diff --git a/v7/src/edwin/os2.scm b/v7/src/edwin/os2.scm index a158d59e3..cddc8c0a7 100644 --- a/v7/src/edwin/os2.scm +++ b/v7/src/edwin/os2.scm @@ -1,6 +1,6 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: os2.scm,v 1.34 1996/10/09 15:44:46 cph Exp $ +;;; $Id: os2.scm,v 1.35 1996/10/10 10:29:08 cph Exp $ ;;; ;;; Copyright (c) 1994-96 Massachusetts Institute of Technology ;;; @@ -70,6 +70,26 @@ (define (os/quit dir) dir (error "Can't quit.")) + +(define (os/hostname) + (if (not os2/cached-hostname) + (let ((buffer (temporary-buffer "*hostname*"))) + (let ((status.reason + (run-synchronous-process #f (buffer-end buffer) #f #f + "hostname"))) + (if (not (equal? status.reason '(EXITED . 0))) + (begin + (pop-up-buffer buffer) + (error "Error running HOSTNAME program:" status.reason)))) + (set! os2/cached-hostname (string-trim (buffer-string buffer))) + (kill-buffer buffer))) + os2/cached-hostname) + +(define os2/cached-hostname #f) +(add-event-receiver! event:after-restore + (lambda () + (set! os2/cached-hostname #f) + unspecific)) ;;;; OS/2 Clipboard Interface @@ -305,6 +325,19 @@ filename suffix \".gz\"." (define (os/sendmail-program) "sendmail") +(define (os/rmail-spool-directory) + (or (let ((etc (get-environment-variable "ETC"))) + (and etc + (file-directory? etc) + (let ((mail + (merge-pathnames "mail/" (pathname-as-directory etc)))) + (and (file-directory? mail) + (->namestring mail))))) + "c:\\mptn\\etc\\mail\\")) + +(define (os/rmail-primary-inbox-list system-mailboxes) + system-mailboxes) + (define (os/rmail-pop-procedure) (and (dos/find-program "popclient" (ref-variable exec-path) #f) (lambda (server user-name password directory) @@ -356,24 +389,4 @@ filename suffix \".gz\"." "If true, messages are deleted from the POP server after being retrieved. Otherwise, messages remain on the server and will be re-fetched later." #t - boolean?) - -(define (os/hostname) - (if (not os2/cached-hostname) - (let ((buffer (temporary-buffer "*hostname*"))) - (let ((status.reason - (run-synchronous-process #f (buffer-end buffer) #f #f - "hostname"))) - (if (not (equal? status.reason '(EXITED . 0))) - (begin - (pop-up-buffer buffer) - (error "Error running HOSTNAME program:" status.reason)))) - (set! os2/cached-hostname (string-trim (buffer-string buffer))) - (kill-buffer buffer))) - os2/cached-hostname) - -(define os2/cached-hostname #f) -(add-event-receiver! event:after-restore - (lambda () - (set! os2/cached-hostname #f) - unspecific)) \ No newline at end of file + boolean?) \ No newline at end of file diff --git a/v7/src/edwin/rmail.scm b/v7/src/edwin/rmail.scm index f09fe59d4..8916bbda5 100644 --- a/v7/src/edwin/rmail.scm +++ b/v7/src/edwin/rmail.scm @@ -1,6 +1,6 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: rmail.scm,v 1.52 1996/09/30 01:01:39 cph Exp $ +;;; $Id: rmail.scm,v 1.53 1996/10/10 10:28:22 cph Exp $ ;;; ;;; Copyright (c) 1991-96 Massachusetts Institute of Technology ;;; @@ -47,7 +47,7 @@ (declare (usual-integrations)) (define rmail-spool-directory - "/usr/mail/") + #f) (define-variable rmail-file-name "" @@ -164,7 +164,7 @@ C-M-r Like h only just messages with particular recipient(s) are summarized. t Toggle header, show Rmail header if unformatted or vice versa. w Edit the current message. C-c C-c to return to Rmail." (lambda (buffer) - (guarantee-variables-initialized) + (guarantee-rmail-variables-initialized) (define-variable-local-value! buffer (ref-variable-object mode-line-modified) "--- ") @@ -203,20 +203,22 @@ together with two commands to return to regular RMAIL: (lambda (buffer) (enable-group-undo! (buffer-group buffer)))) -(define (guarantee-variables-initialized) +(define (guarantee-rmail-variables-initialized) + (if (not rmail-spool-directory) + (set! rmail-spool-directory (os/rmail-spool-directory))) (if (not (ref-variable rmail-pop-procedure)) (set-variable! rmail-pop-procedure (os/rmail-pop-procedure))) (if (null? (ref-variable rmail-primary-inbox-list)) - (set-variable! - rmail-primary-inbox-list - (list "~/mbox" - (let ((server - (and (ref-variable rmail-pop-procedure) - (ref-variable rmail-primary-pop-server)))) - (if server - (string-append "pop:" server) - (string-append rmail-spool-directory - (current-user-name))))))) + (set-variable! rmail-primary-inbox-list + (os/rmail-primary-inbox-list + (list + (let ((server + (and (ref-variable rmail-pop-procedure) + (ref-variable rmail-primary-pop-server)))) + (if server + (string-append "pop:" server) + (string-append rmail-spool-directory + (current-user-name)))))))) (if (not (ref-variable rmail-dont-reply-to-names)) (set-variable! rmail-dont-reply-to-names @@ -525,8 +527,8 @@ and use that file as the inbox." (let ((start (buffer-start error-buffer)) (end (buffer-end error-buffer))) (run-synchronous-process false start false false - (->namestring - (edwin-etc-pathname "movemail")) + (os/find-program "movemail" + (edwin-etc-directory)) (->namestring source) (->namestring target)) (if (mark< start end) diff --git a/v7/src/edwin/unix.scm b/v7/src/edwin/unix.scm index 68482e672..0d7f37bc3 100644 --- a/v7/src/edwin/unix.scm +++ b/v7/src/edwin/unix.scm @@ -1,6 +1,6 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: unix.scm,v 1.72 1996/10/02 17:00:35 cph Exp $ +;;; $Id: unix.scm,v 1.73 1996/10/10 10:28:48 cph Exp $ ;;; ;;; Copyright (c) 1989-96 Massachusetts Institute of Technology ;;; @@ -788,9 +788,19 @@ option, instead taking -P ." (define os/restore-modes-to-updated-file! set-file-modes!) +(define (os/rmail-spool-directory) + (or (list-search-positive + '("/var/spool/mail/" "/var/mail/" "/usr/spool/mail/" "/usr/mail/") + file-directory?) + "/usr/spool/mail/")) + +(define (os/rmail-primary-inbox-list system-mailboxes) + (cons "~/mbox" system-mailboxes)) + (define (os/sendmail-program) - (if (file-exists? "/usr/lib/sendmail") - "/usr/lib/sendmail" + (or (list-search-positive + '("/usr/lib/sendmail" "/usr/sbin/sendmail" "/usr/ucblib/sendmail") + file-executable?) "fakemail")) (define (os/hostname) -- 2.25.1