Fix bug in AFTER-FIND-FILE: code was assuming that every buffer had an

AUTO-SAVE-PATHNAME.

Add new commands to encrypt and decrypt files using blowfish.

diff --git a/v7/src/edwin/filcom.scm b/v7/src/edwin/filcom.scm
index 64a25496e021d124a7d77fdb641dd51db610a210..fcf486807d91740b5c55e0c7994f95e688e30afc 100644 (file)
--- a/v7/src/edwin/filcom.scm
+++ b/v7/src/edwin/filcom.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Id: filcom.scm,v 1.189 1997/01/03 04:06:46 cph Exp $
+;;;    $Id: filcom.scm,v 1.190 1997/07/21 04:38:48 cph Exp $
 ;;;
 ;;;    Copyright (c) 1986, 1989-97 Massachusetts Institute of Technology
 ;;;
@@ -158,9 +158,9 @@ invocation."
               (sit-for 1))))
        (cond ((not buffer-read-only?)
               (cond ((and warn?
-                          (file-newer-than-file?
-                           (buffer-auto-save-pathname buffer)
-                           pathname))
+                          (let ((asp (buffer-auto-save-pathname buffer)))
+                            (and asp
+                                 (file-newer-than-file? asp pathname))))
                      (serious-message
                       "Auto save file is newer; consider M-x recover-file"))
                     (error?
@@ -183,7 +183,7 @@ invocation."
     (normal-mode buffer true)
     (event-distributor/invoke! (ref-variable find-file-hooks buffer) buffer)
     (load-find-file-initialization buffer pathname)))
-
+\f
 (define (file-test-no-errors test pathname)
   (catch-file-errors (lambda () false)
                     (lambda () (test pathname))))
@@ -194,7 +194,7 @@ invocation."
         (let ((b (file-modification-time-indirect b)))
           (or (not b)
               (> a b))))))
-\f
+
 (define (load-find-file-initialization buffer pathname)
   (let ((pathname
         (catch-file-errors
@@ -552,9 +552,9 @@ If a file with the new name already exists, confirmation is requested first."
             (string-append "File "
                            (->namestring new)
                            " already exists; copy anyway")))
-       (begin (copy-file old new)
-              (message "Copied " (->namestring old)
-                       " => " (->namestring new))))))
+       (begin
+         (copy-file old new)
+         (message "Copied " (->namestring old) " => " (->namestring new))))))
 
 (define-command rename-file
   "Rename a file; the old and new names are read in the typein window.
@@ -608,6 +608,47 @@ If a file with the new name already exists, confirmation is requested first."
                        ": Permission denied"))
       (set-buffer-default-directory! buffer directory))))
 \f
+(define-command encrypt-file
+  "Encrypt a file with the blowfish encryption algorithm.
+Prompts for a filename; the encrypted file is written with a \".bf\" suffix.
+Deletes the plaintext file after encryption."
+  "fEncrypt File"
+  (lambda (filename)
+    (if (not (blowfish-available?))
+       (editor-error "Blowfish encryption not supported on this system"))
+    (if (equal? "bf" (pathname-type filename))
+       (editor-error (->namestring filename) " is already encrypted"))
+    (if (copy-file-through-buffer filename
+                                 (string-append (->namestring filename)
+                                                ".bf"))
+       (delete-file filename))))
+
+(define-command decrypt-file
+  "Decrypt a file with the blowfish encryption algorithm.
+Prompts for a filename, which must end with a \".bf\" suffix."
+  "fDecrypt File"
+  (lambda (filename)
+    (if (not (blowfish-available?))
+       (editor-error "Blowfish encryption not supported on this system"))
+    (if (not (equal? "bf" (pathname-type filename)))
+       (editor-error (->namestring filename) " does not have \".bf\" suffix"))
+    (copy-file-through-buffer filename (pathname-new-type filename #f))))
+
+(define (copy-file-through-buffer input output)
+  (if (or (not (file-exists? output))
+         (prompt-for-yes-or-no?
+          (string-append "File "
+                         (->namestring output)
+                         " already exists; overwrite")))
+      (begin
+       (call-with-temporary-buffer " *copy-file*"
+         (lambda (buffer)
+           (local-set-variable! translate-file-data-on-input #f buffer)
+           (insert-file (buffer-start buffer) input)
+           (write-region (buffer-region buffer) output #t #f)))
+       #t)
+      #f))
+\f
 ;;;; Prompting
 
 (define (prompt-for-file prompt default)
@@ -728,7 +769,7 @@ If a file with the new name already exists, confirmation is requested first."
             (if (null? filenames)
                 (if-not-found)
                 (loop directory filenames)))))))
-
+\f
 (define (filename-completions-list pathname)
   (let ((directory (directory-namestring pathname)))
     (canonicalize-filename-completions