[climacs-cvs] CVS esa

[thenriksen]

Update of /project/climacs/cvsroot/esa
In directory clnet:/tmp/cvs-serv8074

Modified Files:
	esa.lisp esa-io.lisp 
Log Message:
Added file-time-checking to `save-buffer', improved the reporting of
arguments for key bindings in the on-line help.


--- /project/climacs/cvsroot/esa/esa.lisp	2006/07/21 07:58:42	1.20
+++ /project/climacs/cvsroot/esa/esa.lisp	2006/08/20 10:43:40	1.21
@@ -927,8 +927,14 @@
       (format stream ".~%")
       (when command-args
         (apply #'format stream
-	       "This binding invokes the command with the arguments ~@{~A~^, ~}.~%"
-	       command-args))
+	       "This binding invokes the command with these arguments: ~@{~A~^, ~}.~%"
+	       (mapcar #'(lambda (arg)
+                           (cond ((eq arg *unsupplied-argument-marker*)
+                                  "unsupplied-argument")
+                                 ((or (eq arg *numeric-argument-marker*)
+                                      (eq arg *numeric-argument-p*))
+                                  "numeric-argument")
+                                 (t arg))) command-args)))
       (terpri stream)
       (print-docstring-for-command command-name command-table stream)
       (scroll-extent stream 0 0))))
--- /project/climacs/cvsroot/esa/esa-io.lisp	2006/08/20 10:08:23	1.3
+++ /project/climacs/cvsroot/esa/esa-io.lisp	2006/08/20 10:43:40	1.4
@@ -269,6 +269,20 @@
 	    maximize version into max
 	  finally (return max))))
 
+(defun check-file-times (buffer filepath question answer)
+  "Return NIL if filepath newer than buffer and user doesn't want
+to overwrite."
+  (let ((f-w-d (file-write-date filepath))
+	(f-w-t (file-write-time buffer)))
+    (if (and f-w-d f-w-t (> f-w-d f-w-t))
+	(if (accept 'boolean
+		    :prompt (format nil "File has changed on disk. ~a anyway?"
+				    question))
+	    t
+	    (progn (display-message "~a not ~a" filepath answer)
+		   nil))
+	t)))
+
 (defmethod save-buffer (buffer application-frame)
   (let ((filepath (or (filepath buffer)
                       (accept 'pathname :prompt "Save Buffer to File"))))
@@ -277,7 +291,9 @@
        (display-message "~A is a directory." filepath)
        (beep))
       (t
-       (when (probe-file filepath)
+       (unless (check-file-times buffer filepath "Overwrite" "written")
+	 (return-from save-buffer))
+       (when (and (probe-file filepath) (not (file-saved-p buffer)))
          (let ((backup-name (pathname-name filepath))
                (backup-type (format nil "~A~~~D~~"
 				    (pathname-type filepath)