comparison lisp/progmodes/compile.el @ 12219:7c0b93d3df6b

(compilation-find-file): If FILENAME is absolute, apply abbreviate-file-name to it and then use its directory part as the first search path element, searching for its nondirectory part. Fix prompting code not to use a free variable. (compilation-parse-errors, compile-abbreviate-directory): Use abbreviate-file-name on directories.

12218:a4f383dd5adb

;; If FILENAME is not found at all, ask the user where to find it.
;; Pop up the buffer containing MARKER and scroll to MARKER if we ask the user.
(defun compilation-find-file (marker filename dir &rest formats)
  (or formats (setq formats '("%s")))
  (let ((dirs compilation-search-path)
	result thisdir fmts name)
    (while (and dirs (null result))
      (setq thisdir (or (car dirs) dir)
	    fmts formats)
      (while (and fmts (null result))
	(setq name (expand-file-name (format (car fmts) filename) thisdir)
	      result (and (file-exists-p name)
			  (find-file-noselect name))
	      fmts (cdr fmts)))
      (setq dirs (cdr dirs)))
    (or result
	;; The file doesn't exist.
	;; Ask the user where to find it.
	;; If he hits C-g, then the next time he does
	;; next-error, he'll skip past it.
	(progn
	  (let* ((pop-up-windows t)
		 (w (display-buffer (marker-buffer marker))))
	    (set-window-point w marker)
	    (set-window-start w marker))
	  (setq name
		(expand-file-name
		 (read-file-name (format "Find this error in: (default %s) "
					 filename)
				 dir filename t)))
	  (if (file-directory-p name)
	      (setq name (concat (file-name-as-directory name) filename)))
	  (if (file-exists-p name)
	      (find-file-noselect name))))))

;; Set compilation-error-list to nil, and unchain the markers that point to the
;; error messages and their text, so that they no longer slow down gap motion.
;; This would happen anyway at the next garbage collection, but it is better to
;; do it right away.

			     (+ subexpr (nth 3 (car alist)))))
		  error-regexp-groups))
      (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
		;; but which extend past it.

			  (file-name-as-directory
			   (expand-file-name
			    (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))

;; 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)
  ;; Check for a comint-file-name-prefix and prepend it if appropriate.
  ;; (This is very useful for compilation-minor-mode in an rlogin-mode
  ;; buffer.)
  (if (boundp 'comint-file-name-prefix)
      (setq dir (concat comint-file-name-prefix dir)))

12219:7c0b93d3df6b

;; If FILENAME is not found at all, ask the user where to find it.
;; Pop up the buffer containing MARKER and scroll to MARKER if we ask the user.
(defun compilation-find-file (marker filename dir &rest formats)
  (or formats (setq formats '("%s")))
  (let ((dirs compilation-search-path)
	buffer thisdir fmts name)
    (if (file-name-absolute-p filename)
	;; The file name is absolute.  Use its explicit directory as
	;; the first in the search path, and strip it from FILENAME.
	(setq filename (abbreviate-file-name (expand-file-name filename))
	      dirs (cons (file-name-directory filename) dirs)
	      filename (file-name-nondirectory filename)))
    ;; Now search the path.
    (while (and dirs (null buffer))
      (setq thisdir (or (car dirs) dir)
	    fmts formats)
      ;; For each directory, try each format string.
      (while (and fmts (null buffer))
	(setq name (expand-file-name (format (car fmts) filename) thisdir)
	      buffer (and (file-exists-p name)
			  (find-file-noselect name))
	      fmts (cdr fmts)))
      (setq dirs (cdr dirs)))
    (or buffer
	;; The file doesn't exist.
	;; Ask the user where to find it.
	;; If he hits C-g, then the next time he does
	;; next-error, he'll skip past it.
	(let* ((pop-up-windows t)
	       (w (display-buffer (marker-buffer marker))))
	  (set-window-point w marker)
	  (set-window-start w marker)
	  (let ((name (expand-file-name
		       (read-file-name
			(format "Find this error in: (default %s) "
				filename)
			dir filename t))))
	    (if (file-directory-p name)
		(setq name (expand-file-name filename name)))
	    (and (file-exists-p name)
		 (find-file-noselect name)))))))

;; Set compilation-error-list to nil, and unchain the markers that point to the
;; error messages and their text, so that they no longer slow down gap motion.
;; This would happen anyway at the next garbage collection, but it is better to
;; do it right away.

			     (+ subexpr (nth 3 (car alist)))))
		  error-regexp-groups))
      (setq subexpr (+ subexpr 1 (count-regexp-groupings (car (car alist)))))
      (setq alist (cdr alist)))

    ;; Set up now the expanded, abbreviated directory variables
    ;; that compile-abbreviate-directory will need, so we can
    ;; compute them just once here.
    (setq orig (abbreviate-file-name default-directory)
	  orig-expanded (abbreviate-file-name
			 (file-truename default-directory))
	  parent-expanded (abbreviate-file-name
			   (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
		;; but which extend past it.

			  (file-name-as-directory
			   (expand-file-name
			    (buffer-substring beg
					      (match-end (+ leave-group
							    1)))))))
		     ;; The directory name in the "leaving" 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))

;; 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)
  ;; Apply canonical abbreviations to DIR first thing.
  ;; Those abbreviations are already done in the other arguments passed.
  (setq dir (abbreviate-file-name dir))

  ;; Check for a comint-file-name-prefix and prepend it if appropriate.
  ;; (This is very useful for compilation-minor-mode in an rlogin-mode
  ;; buffer.)
  (if (boundp 'comint-file-name-prefix)
      (setq dir (concat comint-file-name-prefix dir)))