From 8221f8001b8c46ae61223c614cde4fb244fa6c1f Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Mon, 25 Mar 2002 16:35:58 +0000 Subject: [PATCH] Change M-o command to act like o if the output file is in a known format. --- v7/src/imail/imail-file.scm | 19 ++++++++++-------- v7/src/imail/imail-rmail.scm | 8 ++++---- v7/src/imail/imail-top.scm | 39 ++++++++++++++++++++---------------- v7/src/imail/imail-umail.scm | 8 ++++---- v7/src/imail/imail.pkg | 9 ++++----- v7/src/imail/load.scm | 4 ++-- v7/src/imail/todo.txt | 6 +----- 7 files changed, 48 insertions(+), 45 deletions(-) diff --git a/v7/src/imail/imail-file.scm b/v7/src/imail/imail-file.scm index e83904b12..7f996a643 100644 --- 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)))))) ;;;; URL @@ -146,7 +149,7 @@ (define-method folder-url-is-selectable? ((url )) (and (url-exists? url) - (url-file-folder-type url) + (file-folder-type (pathname-url-pathname url)) #t)) (define-method url-corresponding-container ((url )) diff --git a/v7/src/imail/imail-rmail.scm b/v7/src/imail/imail-rmail.scm index 4b98df048..daac00d9a 100644 --- 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 ()) (define-file-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 a09d048f8..d659bde48 100644 --- 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))))))) ;;;; 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 3dac0d5ad..90c4cdf97 100644 --- 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 ()) (define-file-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 885f9a1d2..205a9cf4a 100644 --- 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 d2c8ef69b..26bdb9c80 100644 --- 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 815b292ff..d5b3f13cd 100644 --- 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 -- 2.25.1