Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv5957
Modified Files: file-commands.lisp Log Message: Use truenames (if available) when comparing pathnames in `find-file'.
--- /project/climacs/cvsroot/climacs/file-commands.lisp 2006/05/14 20:35:44 1.18 +++ /project/climacs/cvsroot/climacs/file-commands.lisp 2006/06/01 22:51:40 1.19 @@ -235,48 +235,56 @@ ((directory-pathname-p filepath) (display-message "~A is a directory name." filepath) (beep)) - (t - (let ((existing-buffer (find filepath (buffers *application-frame*) - :key #'filepath :test #'equal))) - (if (and existing-buffer (if readonlyp (read-only-p existing-buffer) t)) - (switch-to-buffer existing-buffer) - (progn - (when readonlyp - (unless (probe-file filepath) - (beep) - (display-message "No such file: ~A" filepath) - (return-from find-file nil))) - (let ((buffer (make-buffer)) - (pane (current-window))) - ;; Clear the pane's cache; otherwise residue from the - ;; previously displayed buffer may under certain - ;; circumstances be displayed. - (clear-cache pane) - (setf (syntax buffer) nil) - (setf (offset (point (buffer pane))) (offset (point pane))) - (setf (buffer (current-window)) buffer) - ;; Don't want to create the file if it doesn't exist. - (when (probe-file filepath) - (with-open-file (stream filepath :direction :input) - (input-from-stream stream buffer 0)) - (setf (file-write-time buffer) (file-write-date filepath)) - ;; A file! That means we may have a local options - ;; line to parse. - (evaluate-attributes-line buffer)) - ;; If the local options line didn't set a syntax, do - ;; it now. - (when (null (syntax buffer)) - (setf (syntax buffer) - (make-instance (syntax-class-name-for-filepath filepath) - :buffer buffer))) - (setf (filepath buffer) filepath - (name buffer) (filepath-filename filepath) - (needs-saving buffer) nil - (read-only-p buffer) readonlyp) - (beginning-of-buffer (point pane)) - (update-syntax buffer (syntax buffer)) - (clear-modify buffer) - buffer))))))) + (t + (flet ((usable-pathname (pathname) + (if (probe-file pathname) + (truename pathname) + pathname))) + (let ((existing-buffer (find filepath (buffers *application-frame*) + :key #'filepath + :test #'(lambda (fp1 fp2) + (and fp1 fp2 + (equal (usable-pathname fp1) + (usable-pathname fp2))))))) + (if (and existing-buffer (if readonlyp (read-only-p existing-buffer) t)) + (switch-to-buffer existing-buffer) + (progn + (when readonlyp + (unless (probe-file filepath) + (beep) + (display-message "No such file: ~A" filepath) + (return-from find-file nil))) + (let ((buffer (make-buffer)) + (pane (current-window))) + ;; Clear the pane's cache; otherwise residue from the + ;; previously displayed buffer may under certain + ;; circumstances be displayed. + (clear-cache pane) + (setf (syntax buffer) nil) + (setf (offset (point (buffer pane))) (offset (point pane))) + (setf (buffer (current-window)) buffer) + ;; Don't want to create the file if it doesn't exist. + (when (probe-file filepath) + (with-open-file (stream filepath :direction :input) + (input-from-stream stream buffer 0)) + (setf (file-write-time buffer) (file-write-date filepath)) + ;; A file! That means we may have a local options + ;; line to parse. + (evaluate-attributes-line buffer)) + ;; If the local options line didn't set a syntax, do + ;; it now. + (when (null (syntax buffer)) + (setf (syntax buffer) + (make-instance (syntax-class-name-for-filepath filepath) + :buffer buffer))) + (setf (filepath buffer) filepath + (name buffer) (filepath-filename filepath) + (needs-saving buffer) nil + (read-only-p buffer) readonlyp) + (beginning-of-buffer (point pane)) + (update-syntax buffer (syntax buffer)) + (clear-modify buffer) + buffer))))))))
(defun directory-of-buffer (buffer) "Extract the directory part of the filepath to the file in BUFFER.