From 8c85acf719c817521392ee12dc22a00f02035295 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Sun, 9 Apr 1995 23:28:20 +0000 Subject: [PATCH] Add hooks to allow OS-dependent POP mail support. --- v7/src/edwin/dos.scm | 7 +++-- v7/src/edwin/os2.scm | 5 ++- v7/src/edwin/rmail.scm | 70 ++++++++++++++++++++++++++---------------- v7/src/edwin/unix.scm | 7 +++-- 4 files changed, 58 insertions(+), 31 deletions(-) diff --git a/v7/src/edwin/dos.scm b/v7/src/edwin/dos.scm index dd35589d9..4c885d343 100644 --- a/v7/src/edwin/dos.scm +++ b/v7/src/edwin/dos.scm @@ -1,6 +1,6 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: dos.scm,v 1.22 1995/04/09 23:06:37 cph Exp $ +;;; $Id: dos.scm,v 1.23 1995/04/09 23:27:54 cph Exp $ ;;; ;;; Copyright (c) 1992-95 Massachusetts Institute of Technology ;;; @@ -466,4 +466,7 @@ Includes the new backup. Must be > 0." (set-file-modes! pathname #o777)) (define (os/sendmail-program) - "sendmail.exe") \ No newline at end of file + "sendmail.exe") + +(define (os/rmail-pop-procedure) + #f) \ No newline at end of file diff --git a/v7/src/edwin/os2.scm b/v7/src/edwin/os2.scm index 8981bdedd..20984d1d5 100644 --- a/v7/src/edwin/os2.scm +++ b/v7/src/edwin/os2.scm @@ -1,6 +1,6 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: os2.scm,v 1.8 1995/04/09 23:06:25 cph Exp $ +;;; $Id: os2.scm,v 1.9 1995/04/09 23:28:20 cph Exp $ ;;; ;;; Copyright (c) 1994-95 Massachusetts Institute of Technology ;;; @@ -337,6 +337,9 @@ Includes the new backup. Must be > 0." (define (os/sendmail-program) "sendmail.exe") + +(define (os/rmail-pop-procedure) + #f) ;;;; Dired customization diff --git a/v7/src/edwin/rmail.scm b/v7/src/edwin/rmail.scm index bc1d97218..8cf6c8582 100644 --- a/v7/src/edwin/rmail.scm +++ b/v7/src/edwin/rmail.scm @@ -1,6 +1,6 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: rmail.scm,v 1.36 1995/04/09 23:09:19 cph Exp $ +;;; $Id: rmail.scm,v 1.37 1995/04/09 23:28:06 cph Exp $ ;;; ;;; Copyright (c) 1991-95 Massachusetts Institute of Technology ;;; @@ -119,6 +119,11 @@ Called with the start and end marks of the header as arguments." (define-variable rmail-new-mail-hook "An event distributor that is invoked when RMAIL incorporates new mail." (make-event-distributor)) + +(define-variable rmail-pop-procedure + "A procedure that will get mail from a POP server. +A value of #F means there is no mechanism to get POP mail." + (os/rmail-pop-procedure)) (define-major-mode rmail read-only "RMAIL" "Rmail Mode is used by \\[rmail] for editing Rmail files. @@ -379,7 +384,7 @@ Interactively, a prefix argument causes us to read a file name and use that file as the inbox." (lambda () (list (and (command-argument) - (prompt-for-existing-file "Get new mail from file" false)))) + (prompt-for-string "Get new mail from file" #f)))) (lambda (filename) (let ((buffer (current-buffer))) (rmail-find-file-revert buffer) @@ -449,8 +454,9 @@ and use that file as the inbox." (mark-temporary! start) new-messages)))) -(define (insert-inbox-text buffer mark filename rename?) - (let ((insert +(define (insert-inbox-text buffer mark inbox-name rename?) + (let ((directory (buffer-default-directory buffer)) + (insert (lambda (pathname) (and (file-exists? pathname) (let ((mark (mark-left-inserting-copy mark))) @@ -462,37 +468,37 @@ and use that file as the inbox." (insert-newline mark)) (mark-temporary! mark) pathname))))) - (let ((source (->pathname filename))) - (cond ((not rename?) - (insert source)) - ((string=? rmail-spool-directory (directory-namestring source)) - (rename-inbox-using-movemail source - insert - (buffer-default-directory buffer))) - (else - (rename-inbox-using-rename source insert)))))) + (cond ((string-prefix? "pop:" inbox-name) + (get-mail-from-pop-inbox (or (ref-variable rmail-pop-procedure mark) + (error "POP mail not supported.")) + (string-tail inbox-name 3) + insert + directory)) + ((not rename?) + (insert inbox-name)) + ((string=? rmail-spool-directory (directory-namestring inbox-name)) + (rename-inbox-using-movemail inbox-name insert directory)) + (else + (rename-inbox-using-rename inbox-name insert))))) -(define (rename-inbox-using-rename source insert) - (let ((target (string-append (->namestring source) "+"))) - (let ((msg - (string-append "Getting mail from " - (->namestring source) - "..."))) +(define (rename-inbox-using-rename inbox-name insert) + (let ((target (string-append inbox-name "+"))) + (let ((msg (string-append "Getting mail from " inbox-name "..."))) (message msg) - (if (and (file-exists? source) (not (file-exists? target))) - (rename-file source target)) + (if (and (file-exists? inbox-name) (not (file-exists? target))) + (rename-file inbox-name target)) (let ((value (insert target))) (message msg "done") value)))) -(define (rename-inbox-using-movemail source insert directory) +(define (rename-inbox-using-movemail inbox-name insert directory) (let ((source ;; On some systems, /usr/spool/mail/foo is a directory and ;; the actual inbox is /usr/spool/mail/foo/foo. - (if (file-directory? source) - (merge-pathnames (pathname-name source) - (pathname-as-directory source)) - source)) + (if (file-directory? inbox-name) + (merge-pathnames (pathname-name inbox-name) + (pathname-as-directory inbox-name)) + inbox-name)) (target (merge-pathnames ".newmail" directory))) (let ((msg (string-append "Getting mail from " (->namestring source) "..."))) @@ -522,6 +528,18 @@ and use that file as the inbox." (message msg "done") value)))) +(define (get-mail-from-pop-inbox procedure server insert directory) + (let ((target (merge-pathnames (string-append ".pop-" server) directory)) + (msg (string-append "Getting mail from POP server " server "...")) + (password + (prompt-for-password + (string-append "Password for POP server " server)))) + (message msg) + (procedure server target password) + (let ((value (insert target))) + (message msg "done") + value))) + ;;;; Moving around (define-command rmail-next-message diff --git a/v7/src/edwin/unix.scm b/v7/src/edwin/unix.scm index b7838cb16..d96c12a63 100644 --- a/v7/src/edwin/unix.scm +++ b/v7/src/edwin/unix.scm @@ -1,6 +1,6 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: unix.scm,v 1.46 1995/04/09 23:06:46 cph Exp $ +;;; $Id: unix.scm,v 1.47 1995/04/09 23:27:46 cph Exp $ ;;; ;;; Copyright (c) 1989-95 Massachusetts Institute of Technology ;;; @@ -686,4 +686,7 @@ Value is a list of strings." (define (os/sendmail-program) (if (file-exists? "/usr/lib/sendmail") "/usr/lib/sendmail" - "fakemail")) \ No newline at end of file + "fakemail")) + +(define (os/rmail-pop-procedure) + #f) \ No newline at end of file -- 2.25.1