Mercurial > emacs
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.
author | Roland McGrath <roland@gnu.org> |
---|---|
date | Wed, 14 Jun 1995 15:47:10 +0000 |
parents | 42da35386c5d |
children | e50e5d419c51 |
comparison
equal
deleted
inserted
replaced
12218:a4f383dd5adb | 12219:7c0b93d3df6b |
---|---|
1093 ;; If FILENAME is not found at all, ask the user where to find it. | 1093 ;; If FILENAME is not found at all, ask the user where to find it. |
1094 ;; Pop up the buffer containing MARKER and scroll to MARKER if we ask the user. | 1094 ;; Pop up the buffer containing MARKER and scroll to MARKER if we ask the user. |
1095 (defun compilation-find-file (marker filename dir &rest formats) | 1095 (defun compilation-find-file (marker filename dir &rest formats) |
1096 (or formats (setq formats '("%s"))) | 1096 (or formats (setq formats '("%s"))) |
1097 (let ((dirs compilation-search-path) | 1097 (let ((dirs compilation-search-path) |
1098 result thisdir fmts name) | 1098 buffer thisdir fmts name) |
1099 (while (and dirs (null result)) | 1099 (if (file-name-absolute-p filename) |
1100 ;; The file name is absolute. Use its explicit directory as | |
1101 ;; the first in the search path, and strip it from FILENAME. | |
1102 (setq filename (abbreviate-file-name (expand-file-name filename)) | |
1103 dirs (cons (file-name-directory filename) dirs) | |
1104 filename (file-name-nondirectory filename))) | |
1105 ;; Now search the path. | |
1106 (while (and dirs (null buffer)) | |
1100 (setq thisdir (or (car dirs) dir) | 1107 (setq thisdir (or (car dirs) dir) |
1101 fmts formats) | 1108 fmts formats) |
1102 (while (and fmts (null result)) | 1109 ;; For each directory, try each format string. |
1110 (while (and fmts (null buffer)) | |
1103 (setq name (expand-file-name (format (car fmts) filename) thisdir) | 1111 (setq name (expand-file-name (format (car fmts) filename) thisdir) |
1104 result (and (file-exists-p name) | 1112 buffer (and (file-exists-p name) |
1105 (find-file-noselect name)) | 1113 (find-file-noselect name)) |
1106 fmts (cdr fmts))) | 1114 fmts (cdr fmts))) |
1107 (setq dirs (cdr dirs))) | 1115 (setq dirs (cdr dirs))) |
1108 (or result | 1116 (or buffer |
1109 ;; The file doesn't exist. | 1117 ;; The file doesn't exist. |
1110 ;; Ask the user where to find it. | 1118 ;; Ask the user where to find it. |
1111 ;; If he hits C-g, then the next time he does | 1119 ;; If he hits C-g, then the next time he does |
1112 ;; next-error, he'll skip past it. | 1120 ;; next-error, he'll skip past it. |
1113 (progn | 1121 (let* ((pop-up-windows t) |
1114 (let* ((pop-up-windows t) | 1122 (w (display-buffer (marker-buffer marker)))) |
1115 (w (display-buffer (marker-buffer marker)))) | 1123 (set-window-point w marker) |
1116 (set-window-point w marker) | 1124 (set-window-start w marker) |
1117 (set-window-start w marker)) | 1125 (let ((name (expand-file-name |
1118 (setq name | 1126 (read-file-name |
1119 (expand-file-name | 1127 (format "Find this error in: (default %s) " |
1120 (read-file-name (format "Find this error in: (default %s) " | 1128 filename) |
1121 filename) | 1129 dir filename t)))) |
1122 dir filename t))) | 1130 (if (file-directory-p name) |
1123 (if (file-directory-p name) | 1131 (setq name (expand-file-name filename name))) |
1124 (setq name (concat (file-name-as-directory name) filename))) | 1132 (and (file-exists-p name) |
1125 (if (file-exists-p name) | 1133 (find-file-noselect name))))))) |
1126 (find-file-noselect name)))))) | |
1127 | 1134 |
1128 ;; Set compilation-error-list to nil, and unchain the markers that point to the | 1135 ;; Set compilation-error-list to nil, and unchain the markers that point to the |
1129 ;; error messages and their text, so that they no longer slow down gap motion. | 1136 ;; error messages and their text, so that they no longer slow down gap motion. |
1130 ;; This would happen anyway at the next garbage collection, but it is better to | 1137 ;; This would happen anyway at the next garbage collection, but it is better to |
1131 ;; do it right away. | 1138 ;; do it right away. |
1228 (+ subexpr (nth 3 (car alist))))) | 1235 (+ subexpr (nth 3 (car alist))))) |
1229 error-regexp-groups)) | 1236 error-regexp-groups)) |
1230 (setq subexpr (+ subexpr 1 (count-regexp-groupings (car (car alist))))) | 1237 (setq subexpr (+ subexpr 1 (count-regexp-groupings (car (car alist))))) |
1231 (setq alist (cdr alist))) | 1238 (setq alist (cdr alist))) |
1232 | 1239 |
1233 (setq orig default-directory) | 1240 ;; Set up now the expanded, abbreviated directory variables |
1234 (setq orig-expanded (file-truename orig)) | 1241 ;; that compile-abbreviate-directory will need, so we can |
1235 (setq parent-expanded (expand-file-name "../" orig-expanded)) | 1242 ;; compute them just once here. |
1243 (setq orig (abbreviate-file-name default-directory) | |
1244 orig-expanded (abbreviate-file-name | |
1245 (file-truename default-directory)) | |
1246 parent-expanded (abbreviate-file-name | |
1247 (expand-file-name "../" orig-expanded))) | |
1236 | 1248 |
1237 (while (and (not found-desired) | 1249 (while (and (not found-desired) |
1238 ;; We don't just pass LIMIT-SEARCH to re-search-forward | 1250 ;; We don't just pass LIMIT-SEARCH to re-search-forward |
1239 ;; because we want to find matches containing LIMIT-SEARCH | 1251 ;; because we want to find matches containing LIMIT-SEARCH |
1240 ;; but which extend past it. | 1252 ;; but which extend past it. |
1277 (file-name-as-directory | 1289 (file-name-as-directory |
1278 (expand-file-name | 1290 (expand-file-name |
1279 (buffer-substring beg | 1291 (buffer-substring beg |
1280 (match-end (+ leave-group | 1292 (match-end (+ leave-group |
1281 1))))))) | 1293 1))))))) |
1282 ;; The directory name in the "entering" message | 1294 ;; The directory name in the "leaving" message |
1283 ;; is a truename. Try to convert it to a form | 1295 ;; is a truename. Try to convert it to a form |
1284 ;; like what the user typed in. | 1296 ;; like what the user typed in. |
1285 (setq dir | 1297 (setq dir |
1286 (compile-abbreviate-directory dir orig orig-expanded | 1298 (compile-abbreviate-directory dir orig orig-expanded |
1287 parent-expanded)) | 1299 parent-expanded)) |
1410 ;; ORIG-EXPANDED is an expanded version of ORIG. | 1422 ;; ORIG-EXPANDED is an expanded version of ORIG. |
1411 ;; PARENT-EXPANDED is an expanded version of ORIG's parent. | 1423 ;; PARENT-EXPANDED is an expanded version of ORIG's parent. |
1412 ;; Those two args could be computed here, but we run faster by | 1424 ;; Those two args could be computed here, but we run faster by |
1413 ;; having the caller compute them just once. | 1425 ;; having the caller compute them just once. |
1414 (defun compile-abbreviate-directory (dir orig orig-expanded parent-expanded) | 1426 (defun compile-abbreviate-directory (dir orig orig-expanded parent-expanded) |
1427 ;; Apply canonical abbreviations to DIR first thing. | |
1428 ;; Those abbreviations are already done in the other arguments passed. | |
1429 (setq dir (abbreviate-file-name dir)) | |
1430 | |
1415 ;; Check for a comint-file-name-prefix and prepend it if appropriate. | 1431 ;; Check for a comint-file-name-prefix and prepend it if appropriate. |
1416 ;; (This is very useful for compilation-minor-mode in an rlogin-mode | 1432 ;; (This is very useful for compilation-minor-mode in an rlogin-mode |
1417 ;; buffer.) | 1433 ;; buffer.) |
1418 (if (boundp 'comint-file-name-prefix) | 1434 (if (boundp 'comint-file-name-prefix) |
1419 (setq dir (concat comint-file-name-prefix dir))) | 1435 (setq dir (concat comint-file-name-prefix dir))) |