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)