changeset 3940:aa9f37730d77

(compile-abbreviate-directory): New function. (compilation-parse-errors): Use that, to visit files with a dirname more like the one the user specified.

--- a/lisp/progmodes/compile.el	Wed Jun 30 21:35:59 1993 +0000
+++ b/lisp/progmodes/compile.el	Wed Jun 30 22:03:15 1993 +0000
@@ -902,7 +902,7 @@
 See variable `compilation-parse-errors-function' for the interface it uses."
   (setq compilation-error-list nil)
   (message "Parsing error messages...")
-  (let (text-buffer
+  (let (text-buffer orig orig-expanded parent-expanded
 	regexp enter-group leave-group error-group
 	alist subexpr error-regexp-groups
 	(found-desired nil)
@@ -952,6 +952,10 @@
       (setq subexpr (+ subexpr 1 (count-regexp-groupings (car (car alist)))))
       (setq alist (cdr alist)))
 
+    (setq orig default-directory)
+    (setq orig-expanded (file-truename orig))
+    (setq parent-expanded (expand-file-name "../" orig-expanded))
+
     (while (and (not found-desired)
 		;; We don't just pass LIMIT-SEARCH to re-search-forward
 		;; because we want to find matches containing LIMIT-SEARCH
@@ -966,6 +970,12 @@
 		     (expand-file-name
 		      (buffer-substring (match-beginning (+ enter-group 1))
 					(match-end (+ enter-group 1)))))))
+	       ;; The directory name in the "entering" message
+	       ;; is a truename.  Try to convert it to a form
+	       ;; like what the user typed in.
+	       (setq dir
+		     (compile-abbreviate-directory dir orig orig-expanded
+						   parent-expanded))
 	       (setq compilation-directory-stack
 		     (cons dir compilation-directory-stack))
 	       (and (file-directory-p dir)
@@ -982,6 +992,12 @@
 			    (buffer-substring beg
 					      (match-end (+ leave-group
 							    1)))))))
+		     ;; The directory name in the "entering" message
+		     ;; is a truename.  Try to convert it to a form
+		     ;; like what the user typed in.
+		     (setq dir
+			   (compile-abbreviate-directory dir orig orig-expanded
+							 parent-expanded))
 		     (while (and stack
 				 (not (string-equal (car stack) dir)))
 		       (setq stack (cdr stack)))))
@@ -1069,6 +1085,28 @@
   (setq compilation-error-list (nreverse compilation-error-list))
   (message "Parsing error messages...done"))
 
+;; If directory DIR is a subdir of ORIG or of ORIG's parent,
+;; return a relative name for it starting from ORIG or its parent.
+;; ORIG-EXPANDED is an expanded version of ORIG.
+;; PARENT-EXPANDED is an expanded version of ORIG's parent.
+;; Those two args could be computed here, but we run faster by
+;; having the caller compute them just once.
+(defun compile-abbreviate-directory (dir orig orig-expanded parent-expanded)
+  (if (and (> (length dir) (length orig-expanded))
+	   (string= orig-expanded
+		    (substring dir 0 (length orig-expanded))))
+      (setq dir
+	    (concat orig
+		    (substring dir (length orig-expanded)))))
+  (if (and (> (length dir) (length parent-expanded))
+	   (string= parent-expanded
+		    (substring dir 0 (length parent-expanded))))
+    (setq dir
+	  (concat (file-name-directory
+		   (directory-file-name orig))
+		  (substring dir (length parent-expanded)))))
+  dir)
+
 (provide 'compile)
 
 ;;; compile.el ends here