Update of /project/climacs/cvsroot/esa In directory clnet:/tmp/cvs-serv3479
Modified Files: packages.lisp esa-io.lisp esa-buffer.lisp Log Message: Expanded `esa-buffer-mixin', added docstrings to some commands and expanded some commands to prepare for the use of ESA-IO in Climacs.
--- /project/climacs/cvsroot/esa/packages.lisp 2006/05/13 17:15:10 1.5 +++ /project/climacs/cvsroot/esa/packages.lisp 2006/08/20 10:08:23 1.6 @@ -18,7 +18,7 @@ (defpackage :esa-buffer (:use :clim-lisp :clim :esa) (:export #:make-buffer-from-stream #:save-buffer-to-stream - #:filepath #:name #:needs-saving + #:filepath #:name #:needs-saving #:file-write-time #:file-saved-p #:esa-buffer-mixin #:make-new-buffer #:read-only-p)) --- /project/climacs/cvsroot/esa/esa-io.lisp 2006/05/10 09:53:55 1.2 +++ /project/climacs/cvsroot/esa/esa-io.lisp 2006/08/20 10:08:23 1.3 @@ -158,6 +158,9 @@ buffer)))))
(defun directory-of-current-buffer () + "Extract the directory part of the filepath to the file in the current buffer. + If the current buffer does not have a filepath, the path to + the user's home directory will be returned." (make-pathname :directory (pathname-directory @@ -165,9 +168,16 @@ (user-homedir-pathname)))))
(define-command (com-find-file :name t :command-table esa-io-table) - ((filepath 'pathname :prompt "Find File: " :prompt-mode :raw - :default (directory-of-current-buffer) :default-type 'pathname + ((filepath 'pathname + :prompt "Find File: " + :prompt-mode :raw + :default (directory-of-current-buffer) + :default-type 'pathname :insert-default t)) + "Prompt for a filename then edit that file. +If a buffer is already visiting that file, switch to that +buffer. Does not create a file if the filename given does not +name an existing file." (find-file filepath *application-frame*))
(set-key `(com-find-file ,*unsupplied-argument-marker*) @@ -196,13 +206,26 @@ nil))))))
(define-command (com-find-file-read-only :name t :command-table esa-io-table) - ((filepath 'pathname :prompt "Find File read-only: " :prompt-mode :raw)) + ((filepath 'pathname + :prompt "Find File read-only: " + :prompt-mode :raw + :default (directory-of-current-buffer) + :default-type 'pathname + :insert-default t)) + "Prompt for a filename then open that file readonly. +If a buffer is already visiting that file, switch to that +buffer. If the filename given does not name an existing file, +signal an error." (find-file-read-only filepath *application-frame*))
(set-key `(com-find-file-read-only ,*unsupplied-argument-marker*) 'esa-io-table '((#\x :control) (#\r :control)))
-(define-command (com-read-only :name t :command-table esa-io-table) () +(define-command (com-read-only :name t :command-table esa-io-table) + () + "Toggle the readonly status of the current buffer. +When a buffer is readonly, attempts to change the contents of the +buffer signal an error." (let ((buffer (current-buffer *application-frame*))) (setf (read-only-p buffer) (not (read-only-p buffer)))))
@@ -214,11 +237,38 @@ (needs-saving buffer) t))
(define-command (com-set-visited-file-name :name t :command-table esa-io-table) - ((filename 'pathname :prompt "New file name: " :prompt-mode :raw - :default (directory-of-current-buffer) :insert-default t - :default-type 'pathname)) + ((filename 'pathname :prompt "New filename: " + :prompt-mode :raw + :default (directory-of-current-buffer) + :insert-default t + :default-type 'pathname + :insert-default t)) + "Prompt for a new filename for the current buffer. +The next time the buffer is saved it will be saved to a file with +that filename." (set-visited-file-name filename (current-buffer *application-frame*) *application-frame*))
+(defun extract-version-number (pathname) + "Extracts the emacs-style version-number from a pathname." + (let* ((type (pathname-type pathname)) + (length (length type))) + (when (and (> length 2) (char= (char type (1- length)) #~)) + (let ((tilde (position #~ type :from-end t :end (- length 2)))) + (when tilde + (parse-integer type :start (1+ tilde) :junk-allowed t)))))) + +(defun version-number (pathname) + "Return the number of the highest versioned backup of PATHNAME +or 0 if there is no versioned backup. Looks for name.type~X~, +returns highest X." + (let* ((wildpath (merge-pathnames (make-pathname :type :wild) pathname)) + (possibilities (directory wildpath))) + (loop for possibility in possibilities + for version = (extract-version-number possibility) + if (numberp version) + maximize version into max + finally (return max)))) + (defmethod save-buffer (buffer application-frame) (let ((filepath (or (filepath buffer) (accept 'pathname :prompt "Save Buffer to File")))) @@ -229,17 +279,23 @@ (t (when (probe-file filepath) (let ((backup-name (pathname-name filepath)) - (backup-type (concatenate 'string (pathname-type filepath) "~"))) + (backup-type (format nil "~A~~~D~~" + (pathname-type filepath) + (1+ (version-number filepath))))) (rename-file filepath (make-pathname :name backup-name :type backup-type)))) (with-open-file (stream filepath :direction :output :if-exists :supersede) (save-buffer-to-stream buffer stream)) (setf (filepath buffer) filepath + (file-write-time buffer) (file-write-date filepath) (name buffer) (filepath-filename filepath)) (display-message "Wrote: ~a" (filepath buffer)) (setf (needs-saving buffer) nil)))))
(define-command (com-save-buffer :name t :command-table esa-io-table) () + "Write the contents of the buffer to a file. +If there is filename associated with the buffer, write to that +file, replacing its contents. If not, prompt for a filename." (let ((buffer (current-buffer *application-frame*))) (if (or (null (filepath buffer)) (needs-saving buffer)) @@ -264,6 +320,8 @@ ((filepath 'pathname :prompt "Write Buffer to File: " :prompt-mode :raw :default (directory-of-current-buffer) :insert-default t :default-type 'pathname)) + "Prompt for a filename and write the current buffer to it. +Changes the file visted by the buffer to the given file." (let ((buffer (current-buffer *application-frame*))) (write-buffer buffer filepath *application-frame*)))
--- /project/climacs/cvsroot/esa/esa-buffer.lisp 2006/03/25 00:08:07 1.1.1.1 +++ /project/climacs/cvsroot/esa/esa-buffer.lisp 2006/08/20 10:08:23 1.2 @@ -31,16 +31,11 @@ (:documentation "Save the entire BUFFER to STREAM in the appropriate external representation"))
-(defgeneric filepath (buffer)) -(defgeneric (setf filepath) (filepath buffer)) -(defgeneric name (buffer)) -(defgeneric (setf name) (name buffer)) -(defgeneric needs-saving (buffer)) -(defgeneric (setf needs-saving) (needs-saving buffer)) - (defclass esa-buffer-mixin () ((%filepath :initform nil :accessor filepath) (%name :initarg :name :initform "*scratch*" :accessor name) (%needs-saving :initform nil :accessor needs-saving) + (%file-write-time :initform nil :accessor file-write-time) + (%file-saved-p :initform nil :accessor file-saved-p) (%read-only-p :initform nil :accessor read-only-p)))