Change M-o command to act like o if the output file is in a known

format.

diff --git a/v7/src/imail/imail-file.scm b/v7/src/imail/imail-file.scm
index e83904b126a1ad6558cc31e680a89763ce92a266..7f996a643d599d0a87cb49552a340ee5ddabe0cc 100644 (file)
--- a/v7/src/imail/imail-file.scm
+++ b/v7/src/imail/imail-file.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail-file.scm,v 1.80 2001/09/28 00:41:21 cph Exp $
+;;; $Id: imail-file.scm,v 1.81 2002/03/25 16:35:46 cph Exp $
 ;;;
-;;; Copyright (c) 1999-2001 Massachusetts Institute of Technology
+;;; Copyright (c) 1999-2002 Massachusetts Institute of Technology
 ;;;
 ;;; This program is free software; you can redistribute it and/or
 ;;; modify it under the terms of the GNU General Public License as
@@ -46,12 +46,15 @@
        (hash-table/datum-list file-folder-types))))
 
 (define (url-file-folder-type url)
+  (or (file-folder-type (pathname-url-pathname url))
+      (error "Unknown folder type:" url)))
+
+(define (file-folder-type pathname)
   (let loop ((types (hash-table/datum-list file-folder-types)))
-    (if (not (pair? types))
-       (error "Unknown folder type:" url))
-    (if ((file-folder-type-predicate (car types)) url)
-       (car types)
-       (loop (cdr types)))))
+    (and (pair? types)
+        (if ((file-folder-type-predicate (car types)) pathname)
+            (car types)
+            (loop (cdr types))))))
 \f
 ;;;; URL
 
@@ -146,7 +149,7 @@
 
 (define-method folder-url-is-selectable? ((url <file-url>))
   (and (url-exists? url)
-       (url-file-folder-type url)
+       (file-folder-type (pathname-url-pathname url))
        #t))
 
 (define-method url-corresponding-container ((url <file-url>))

diff --git a/v7/src/imail/imail-rmail.scm b/v7/src/imail/imail-rmail.scm
index 4b98df04886c17f0d09f3a1128f77cf44053955a..daac00d9ae8457bfe47dc53d17eb130fed265e5c 100644 (file)
--- a/v7/src/imail/imail-rmail.scm
+++ b/v7/src/imail/imail-rmail.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail-rmail.scm,v 1.69 2001/09/28 00:41:25 cph Exp $
+;;; $Id: imail-rmail.scm,v 1.70 2002/03/25 16:35:49 cph Exp $
 ;;;
-;;; Copyright (c) 1999-2001 Massachusetts Institute of Technology
+;;; Copyright (c) 1999-2002 Massachusetts Institute of Technology
 ;;;
 ;;; This program is free software; you can redistribute it and/or
 ;;; modify it under the terms of the GNU General Public License as
@@ -26,8 +26,8 @@
 (define-class <rmail-folder-type> (<file-folder-type>))
 
 (define-file-folder-type <rmail-folder-type> "Rmail"
-  (lambda (url)
-    (check-file-prefix (pathname-url-pathname url) "BABYL OPTIONS:")))
+  (lambda (pathname)
+    (check-file-prefix pathname "BABYL OPTIONS:")))
 
 ;;;; Server
 

diff --git a/v7/src/imail/imail-top.scm b/v7/src/imail/imail-top.scm
index a09d048f8655f5b8a8d67c3e66e1885d34b6748a..d659bde4835239f3b9dcffeb13c3810e4d831eb8 100644 (file)
--- a/v7/src/imail/imail-top.scm
+++ b/v7/src/imail/imail-top.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail-top.scm,v 1.282 2002/02/22 16:07:34 cph Exp $
+;;; $Id: imail-top.scm,v 1.283 2002/03/25 16:35:51 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2002 Massachusetts Institute of Technology
 ;;;
@@ -877,21 +877,26 @@ This command writes the message to the output file in human-readable format,
                           'HISTORY-INDEX 0)
          (command-argument)))
   (lambda (pathname argument)
-    (let ((write-separator? (file-exists? pathname)))
-      (call-with-temporary-buffer " *imail-file-message*"
-       (lambda (buffer)
-         (let ((mark (mark-left-inserting-copy (buffer-start buffer))))
-           (move-relative-undeleted argument
-             (lambda (message)
-               (if write-separator?
-                   (begin
-                     (insert-newline mark)
-                     (insert-chars #\= 79 mark)
-                     (insert-newlines 2 mark))
-                   (set! write-separator? #t))
-               (insert-message message #f 0 mark)))
-           (mark-temporary! mark))
-         (append-to-file (buffer-region buffer) pathname #t 'DEFAULT))))))
+    (let ((exists? (file-exists? pathname)))
+      (if (and exists? (file-folder-type pathname))
+         ((ref-command imail-output)
+          (url->string (make-pathname-url pathname))
+          argument)
+         (call-with-temporary-buffer " *imail-file-message*"
+           (lambda (buffer)
+             (let ((mark (mark-left-inserting-copy (buffer-start buffer))))
+               (move-relative-undeleted argument
+                 (lambda (message)
+                   (if exists?
+                       (begin
+                         (insert-newline mark)
+                         (insert-chars #\= 79 mark)
+                         (insert-newlines 2 mark))
+                       (set! exists? #t))
+                   (insert-message message #f 0 mark)))
+               (mark-temporary! mark))
+             (append-to-file (buffer-region buffer) pathname #t
+                             'DEFAULT)))))))
 \f
 ;;;; Attachments
 
@@ -1766,7 +1771,7 @@ Negative argument means search in reverse."
                            port
                            (ref-variable imail-default-imap-mailbox
                                          #f)))))
-       ((string-ci=? protocol "file") (make-file-url "~/RMAIL"))
+       ((string-ci=? protocol "file") (make-pathname-url "~/RMAIL"))
        (else (error:bad-range-argument protocol))))
 
 (define (imail-default-container)

diff --git a/v7/src/imail/imail-umail.scm b/v7/src/imail/imail-umail.scm
index 3dac0d5ad467112f38d5a24add335a5f1fff55ca..90c4cdf97a33d66dda9e19fd41b5e907c79b4ce0 100644 (file)
--- a/v7/src/imail/imail-umail.scm
+++ b/v7/src/imail/imail-umail.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail-umail.scm,v 1.50 2001/09/28 00:41:48 cph Exp $
+;;; $Id: imail-umail.scm,v 1.51 2002/03/25 16:35:54 cph Exp $
 ;;;
-;;; Copyright (c) 1999-2001 Massachusetts Institute of Technology
+;;; Copyright (c) 1999-2002 Massachusetts Institute of Technology
 ;;;
 ;;; This program is free software; you can redistribute it and/or
 ;;; modify it under the terms of the GNU General Public License as
@@ -26,8 +26,8 @@
 (define-class <umail-folder-type> (<file-folder-type>))
 
 (define-file-folder-type <umail-folder-type> "unix mail"
-  (lambda (url)
-    (check-file-prefix (pathname-url-pathname url) "From ")))
+  (lambda (pathname)
+    (check-file-prefix pathname "From ")))
 
 ;;;; Server operations
 

diff --git a/v7/src/imail/imail.pkg b/v7/src/imail/imail.pkg
index 885f9a1d2c0f01e1f1093853ba43ce133285bb1a..205a9cf4adb6c1a0247111d3b214a1f02ed5241e 100644 (file)
--- a/v7/src/imail/imail.pkg
+++ b/v7/src/imail/imail.pkg
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail.pkg,v 1.95 2001/12/18 21:35:40 cph Exp $
+;;; $Id: imail.pkg,v 1.96 2002/03/25 16:35:44 cph Exp $
 ;;;
 ;;; Copyright (c) 2000-2001 Massachusetts Institute of Technology
 ;;;
@@ -61,13 +61,12 @@
   (files "imail-file")
   (parent (edwin imail))
   (export (edwin imail)
-         directory-url?
          file-folder-pathname
+         file-folder-type
          file-folder?
          file-message?
-         file-url?
-         make-directory-url
-         make-file-url))
+         make-pathname-url
+         pathname-url?))
 
 (define-package (edwin imail file-folder rmail-folder)
   (files "imail-rmail")

diff --git a/v7/src/imail/load.scm b/v7/src/imail/load.scm
index d2c8ef69b5e40a3c57681ca7b6373c016536fc9f..26bdb9c806bce16fdb98413658a0eeef3651ef35 100644 (file)
--- a/v7/src/imail/load.scm
+++ b/v7/src/imail/load.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: load.scm,v 1.38 2002/02/03 04:37:21 cph Exp $
+;;; $Id: load.scm,v 1.39 2002/03/25 16:35:56 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2002 Massachusetts Institute of Technology
 ;;;
@@ -28,4 +28,4 @@
   (lambda ()
     (fluid-let ((*allow-package-redefinition?* #t))
       (load-package-set "imail"))))
-(add-subsystem-identification! "IMAIL" '(1 18))
\ No newline at end of file
+(add-subsystem-identification! "IMAIL" '(1 19))
\ No newline at end of file

diff --git a/v7/src/imail/todo.txt b/v7/src/imail/todo.txt
index 815b292ffcc177e432f40e1899940d7749ff0d5e..d5b3f13cd2cdc2b60c1115984fa8de401a1ee3db 100644 (file)
--- a/v7/src/imail/todo.txt
+++ b/v7/src/imail/todo.txt
@@ -1,13 +1,9 @@
 IMAIL To-Do List
-$Id: todo.txt,v 1.136 2002/01/12 02:57:38 cph Exp $
+$Id: todo.txt,v 1.137 2002/03/25 16:35:58 cph Exp $
 
 Bug fixes
 ---------
 
-* Change M-o command to act like o if the output file is in a known
-  format.  Maybe make the o command act like M-o if it is _not_ in a
-  known format?  In that case there would be only one output command.
-
 * Remove cache for folders that aren't on server any more.
 
 * When browser pops up a window of URLs that it is operating on, the