Commit | Line | Data |
---|---|---|
acc33231 CY |
1 | ;;; ede/files.el --- Associate projects with files and directories. |
2 | ||
73b0cd50 | 3 | ;; Copyright (C) 2008-2011 Free Software Foundation, Inc. |
acc33231 CY |
4 | |
5 | ;; Author: Eric M. Ludlam <eric@siege-engine.com> | |
6 | ||
7 | ;; This file is part of GNU Emacs. | |
8 | ||
9 | ;; GNU Emacs is free software: you can redistribute it and/or modify | |
10 | ;; it under the terms of the GNU General Public License as published by | |
11 | ;; the Free Software Foundation, either version 3 of the License, or | |
12 | ;; (at your option) any later version. | |
13 | ||
14 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
17 | ;; GNU General Public License for more details. | |
18 | ||
19 | ;; You should have received a copy of the GNU General Public License | |
20 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | |
21 | ||
22 | ;;; Commentary: | |
23 | ;; | |
24 | ;; Directory and File scanning and matching functions. | |
25 | ;; | |
26 | ;; Basic Model: | |
27 | ;; | |
28 | ;; A directory belongs to a project if a ede-project-autoload structure | |
29 | ;; matches your directory. | |
30 | ;; | |
31 | ;; A toplevel project is one where there is no active project above | |
32 | ;; it. Finding the toplevel project involves going up a directory | |
33 | ;; till no ede-project-autoload structure matches. | |
34 | ;; | |
35 | ||
36 | (require 'ede) | |
37 | ||
38 | (declare-function ede-locate-file-in-hash "ede/locate") | |
39 | (declare-function ede-locate-add-file-to-hash "ede/locate") | |
40 | (declare-function ede-locate-file-in-project "ede/locate") | |
cb85c0d8 | 41 | (declare-function ede-locate-flush-hash "ede/locate") |
acc33231 CY |
42 | |
43 | (defvar ede--disable-inode nil | |
44 | "Set to 't' to simulate systems w/out inode support.") | |
45 | ||
46 | ;;; Code: | |
47 | ;;;###autoload | |
48 | (defun ede-find-file (file) | |
49 | "Find FILE in project. FILE can be specified without a directory. | |
50 | There is no completion at the prompt. FILE is searched for within | |
51 | the current EDE project." | |
52 | (interactive "sFile: ") | |
53 | (let ((fname (ede-expand-filename (ede-current-project) file)) | |
54 | ) | |
55 | (unless fname | |
56 | (error "Could not find %s in %s" | |
57 | file | |
58 | (ede-project-root-directory (ede-current-project)))) | |
59 | (find-file fname))) | |
60 | ||
cb85c0d8 EL |
61 | (defun ede-flush-project-hash () |
62 | "Flush the file locate hash for the current project." | |
63 | (interactive) | |
64 | (require 'ede/locate) | |
65 | (let* ((loc (ede-get-locator-object (ede-current-project)))) | |
66 | (ede-locate-flush-hash loc))) | |
67 | ||
acc33231 CY |
68 | ;;; Placeholders for ROOT directory scanning on base objects |
69 | ;; | |
70 | (defmethod ede-project-root ((this ede-project-placeholder)) | |
cb85c0d8 | 71 | "If a project knows its root, return it here. |
acc33231 CY |
72 | Allows for one-project-object-for-a-tree type systems." |
73 | (oref this rootproject)) | |
74 | ||
75 | (defmethod ede-project-root-directory ((this ede-project-placeholder) | |
76 | &optional file) | |
cb85c0d8 | 77 | "If a project knows its root, return it here. |
acc33231 CY |
78 | Allows for one-project-object-for-a-tree type systems. |
79 | Optional FILE is the file to test. It is ignored in preference | |
80 | of the anchor file for the project." | |
81 | (file-name-directory (expand-file-name (oref this file)))) | |
82 | ||
83 | ||
acc33231 CY |
84 | (defmethod ede--project-inode ((proj ede-project-placeholder)) |
85 | "Get the inode of the directory project PROJ is in." | |
86 | (if (slot-boundp proj 'dirinode) | |
87 | (oref proj dirinode) | |
88 | (oset proj dirinode (ede--inode-for-dir (oref proj :directory))))) | |
89 | ||
90 | (defmethod ede-find-subproject-for-directory ((proj ede-project-placeholder) | |
91 | dir) | |
92 | "Find a subproject of PROJ that corresponds to DIR." | |
93 | (if ede--disable-inode | |
94 | (let ((ans nil)) | |
95 | ;; Try to find the right project w/out inodes. | |
96 | (ede-map-subprojects | |
97 | proj | |
98 | (lambda (SP) | |
99 | (when (not ans) | |
100 | (if (string= (file-truename dir) (oref SP :directory)) | |
101 | (setq ans SP) | |
102 | (ede-find-subproject-for-directory SP dir))))) | |
103 | ans) | |
c7015153 | 104 | ;; We can use inodes, so let's try it. |
acc33231 CY |
105 | (let ((ans nil) |
106 | (inode (ede--inode-for-dir dir))) | |
107 | (ede-map-subprojects | |
108 | proj | |
109 | (lambda (SP) | |
110 | (when (not ans) | |
111 | (if (equal (ede--project-inode SP) inode) | |
112 | (setq ans SP) | |
113 | (ede-find-subproject-for-directory SP dir))))) | |
114 | ans))) | |
115 | ||
116 | ;;; DIRECTORY IN OPEN PROJECT | |
117 | ;; | |
118 | ;; These routines match some directory name to one of the many pre-existing | |
119 | ;; open projects. This should avoid hitting the disk, or asking lots of questions | |
120 | ;; if used throughout the other routines. | |
121 | (defvar ede-inode-directory-hash (make-hash-table | |
122 | ;; Note on test. Can we compare inodes or something? | |
123 | :test 'equal) | |
124 | "A hash of directory names and inodes.") | |
125 | ||
126 | (defun ede--put-inode-dir-hash (dir inode) | |
127 | "Add to the EDE project hash DIR associated with INODE." | |
128 | (when (fboundp 'puthash) | |
129 | (puthash dir inode ede-inode-directory-hash) | |
130 | inode)) | |
131 | ||
132 | (defun ede--get-inode-dir-hash (dir) | |
133 | "Get the EDE project hash DIR associated with INODE." | |
134 | (when (fboundp 'gethash) | |
135 | (gethash dir ede-inode-directory-hash) | |
136 | )) | |
137 | ||
138 | (defun ede--inode-for-dir (dir) | |
139 | "Return the inode for the directory DIR." | |
140 | (let ((hashnode (ede--get-inode-dir-hash (expand-file-name dir)))) | |
141 | (or hashnode | |
142 | (if ede--disable-inode | |
143 | (ede--put-inode-dir-hash dir 0) | |
144 | (let ((fattr (file-attributes dir))) | |
145 | (ede--put-inode-dir-hash dir (nth 10 fattr)) | |
146 | ))))) | |
147 | ||
148 | (defun ede-directory-get-open-project (dir &optional rootreturn) | |
149 | "Return an already open project that is managing DIR. | |
150 | Optional ROOTRETURN specifies a symbol to set to the root project. | |
151 | If DIR is the root project, then it is the same." | |
152 | (let* ((inode (ede--inode-for-dir dir)) | |
153 | (ft (file-name-as-directory (expand-file-name dir))) | |
154 | (proj (ede--inode-get-toplevel-open-project inode)) | |
155 | (ans nil)) | |
156 | ;; Try file based search. | |
157 | (when (not proj) | |
158 | (setq proj (ede-directory-get-toplevel-open-project ft))) | |
159 | ;; Default answer is this project | |
160 | (setq ans proj) | |
161 | ;; Save. | |
162 | (when rootreturn (set rootreturn proj)) | |
163 | ;; Find subprojects. | |
164 | (when (and proj (or ede--disable-inode | |
165 | (not (equal inode (ede--project-inode proj))))) | |
166 | (setq ans (ede-find-subproject-for-directory proj ft))) | |
167 | ans)) | |
168 | ||
169 | (defun ede--inode-get-toplevel-open-project (inode) | |
170 | "Return an already open toplevel project that is managing INODE. | |
171 | Does not check subprojects." | |
172 | (when (or (and (numberp inode) (/= inode 0)) | |
173 | (consp inode)) | |
174 | (let ((all ede-projects) | |
175 | (found nil) | |
176 | ) | |
177 | (while (and all (not found)) | |
178 | (when (equal inode (ede--project-inode (car all))) | |
179 | (setq found (car all))) | |
180 | (setq all (cdr all))) | |
181 | found))) | |
182 | ||
183 | (defun ede-directory-get-toplevel-open-project (dir) | |
184 | "Return an already open toplevel project that is managing DIR." | |
185 | (let ((ft (file-name-as-directory (expand-file-name dir))) | |
186 | (all ede-projects) | |
187 | (ans nil)) | |
188 | (while (and all (not ans)) | |
189 | ;; Do the check. | |
190 | (let ((pd (oref (car all) :directory)) | |
191 | ) | |
192 | (cond | |
193 | ;; Exact text match. | |
194 | ((string= pd ft) | |
195 | (setq ans (car all))) | |
196 | ;; Some sub-directory | |
197 | ((string-match (concat "^" (regexp-quote pd)) ft) | |
198 | (setq ans (car all))) | |
199 | ;; Exact inode match. Useful with symlinks or complex automounters. | |
200 | ((let ((pin (ede--project-inode (car all))) | |
201 | (inode (ede--inode-for-dir dir))) | |
202 | (and (not (eql pin 0)) (equal pin inode))) | |
203 | (setq ans (car all))) | |
204 | ;; Subdir via truename - slower by far, but faster than a traditional lookup. | |
205 | ((let ((ftn (file-truename ft)) | |
206 | (ptd (file-truename (oref (car all) :directory)))) | |
207 | (string-match (concat "^" (regexp-quote ptd)) ftn)) | |
208 | (setq ans (car all))) | |
209 | )) | |
210 | (setq all (cdr all))) | |
211 | ans)) | |
212 | ||
213 | ;;; DIRECTORY-PROJECT-P | |
214 | ;; | |
215 | ;; For a fresh buffer, or for a path w/ no open buffer, use this | |
216 | ;; routine to determine if there is a known project type here. | |
217 | (defvar ede-project-directory-hash (make-hash-table | |
218 | ;; Note on test. Can we compare inodes or something? | |
219 | :test 'equal) | |
220 | "A hash of directory names and associated EDE objects.") | |
221 | ||
222 | (defun ede-project-directory-remove-hash (dir) | |
223 | "Reset the directory hash for DIR. | |
224 | Do this whenever a new project is created, as opposed to loaded." | |
225 | ;; TODO - Use maphash, and delete by regexp, not by dir searching! | |
226 | ||
227 | (when (fboundp 'remhash) | |
228 | (remhash (file-name-as-directory dir) ede-project-directory-hash) | |
229 | ;; Look for all subdirs of D, and remove them. | |
230 | (let ((match (concat "^" (regexp-quote dir)))) | |
231 | (maphash (lambda (K O) | |
232 | (when (string-match match K) | |
233 | (remhash K ede-project-directory-hash))) | |
234 | ede-project-directory-hash)) | |
235 | )) | |
236 | ||
237 | (defun ede-directory-project-from-hash (dir) | |
238 | "If there is an already loaded project for DIR, return it from the hash." | |
239 | (when (fboundp 'gethash) | |
240 | (gethash dir ede-project-directory-hash nil))) | |
241 | ||
242 | (defun ede-directory-project-add-description-to-hash (dir desc) | |
243 | "Add to the EDE project hash DIR associated with DESC." | |
244 | (when (fboundp 'puthash) | |
245 | (puthash dir desc ede-project-directory-hash) | |
246 | desc)) | |
247 | ||
248 | (defun ede-directory-project-p (dir &optional force) | |
249 | "Return a project description object if DIR has a project. | |
250 | Optional argument FORCE means to ignore a hash-hit of 'nomatch. | |
cb85c0d8 EL |
251 | This depends on an up to date `ede-project-class-files' variable. |
252 | Any directory that contains the file .ede-ignore will allways | |
253 | return nil." | |
254 | (when (not (file-exists-p (expand-file-name ".ede-ignore" dir))) | |
255 | (let* ((dirtest (expand-file-name dir)) | |
256 | (match (ede-directory-project-from-hash dirtest))) | |
257 | (cond | |
258 | ((and (eq match 'nomatch) (not force)) | |
259 | nil) | |
260 | ((and match (not (eq match 'nomatch))) | |
261 | match) | |
262 | (t | |
263 | (let ((types ede-project-class-files) | |
264 | (ret nil)) | |
265 | ;; Loop over all types, loading in the first type that we find. | |
266 | (while (and types (not ret)) | |
267 | (if (ede-dir-to-projectfile (car types) dirtest) | |
268 | (progn | |
269 | ;; We found one! Require it now since we will need it. | |
270 | (require (oref (car types) file)) | |
271 | (setq ret (car types)))) | |
272 | (setq types (cdr types))) | |
273 | (ede-directory-project-add-description-to-hash dirtest (or ret 'nomatch)) | |
274 | ret)))))) | |
acc33231 CY |
275 | |
276 | ;;; TOPLEVEL | |
277 | ;; | |
278 | ;; These utilities will identify the "toplevel" of a project. | |
279 | ;; | |
280 | (defun ede-toplevel-project-or-nil (dir) | |
281 | "Starting with DIR, find the toplevel project directory, or return nil. | |
a785b776 | 282 | nil is returned if the current directory is not a part of a project." |
acc33231 CY |
283 | (let* ((ans (ede-directory-get-toplevel-open-project dir))) |
284 | (if ans | |
285 | (oref ans :directory) | |
286 | (if (ede-directory-project-p dir) | |
287 | (ede-toplevel-project dir) | |
288 | nil)))) | |
289 | ||
290 | (defun ede-toplevel-project (dir) | |
291 | "Starting with DIR, find the toplevel project directory." | |
292 | (if (and (string= dir default-directory) | |
293 | ede-object-root-project) | |
294 | ;; Try the local buffer cache first. | |
295 | (oref ede-object-root-project :directory) | |
296 | ;; Otherwise do it the hard way. | |
297 | (let* ((thisdir (ede-directory-project-p dir)) | |
298 | (ans (ede-directory-get-toplevel-open-project dir))) | |
299 | (if (and ans ;; We have an answer | |
300 | (or (not thisdir) ;; this dir isn't setup | |
301 | (and (object-of-class-p ;; Same as class for this dir? | |
302 | ans (oref thisdir :class-sym))) | |
303 | )) | |
304 | (oref ans :directory) | |
305 | (let* ((toppath (expand-file-name dir)) | |
306 | (newpath toppath) | |
307 | (proj (ede-directory-project-p dir)) | |
308 | (ans nil)) | |
309 | (if proj | |
310 | ;; If we already have a project, ask it what the root is. | |
311 | (setq ans (ede-project-root-directory proj))) | |
312 | ||
313 | ;; If PROJ didn't know, or there is no PROJ, then | |
314 | ||
315 | ;; Loop up to the topmost project, and then load that single | |
cb85c0d8 | 316 | ;; project, and its sub projects. When we are done, identify the |
acc33231 CY |
317 | ;; sub-project object belonging to file. |
318 | (while (and (not ans) newpath proj) | |
319 | (setq toppath newpath | |
320 | newpath (ede-up-directory toppath)) | |
321 | (when newpath | |
322 | (setq proj (ede-directory-project-p newpath))) | |
323 | ||
324 | (when proj | |
325 | ;; We can home someone in the middle knows too. | |
326 | (setq ans (ede-project-root-directory proj))) | |
327 | ) | |
328 | (or ans toppath)))))) | |
329 | ||
acc33231 CY |
330 | ;;; DIRECTORY CONVERSION STUFF |
331 | ;; | |
332 | (defmethod ede-convert-path ((this ede-project) path) | |
333 | "Convert path in a standard way for a given project. | |
334 | Default to making it project relative. | |
335 | Argument THIS is the project to convert PATH to." | |
336 | (let ((pp (ede-project-root-directory this)) | |
337 | (fp (expand-file-name path))) | |
338 | (if (string-match (regexp-quote pp) fp) | |
339 | (substring fp (match-end 0)) | |
340 | (let ((pptf (file-truename pp)) | |
341 | (fptf (file-truename fp))) | |
342 | (if (string-match (regexp-quote pptf) fptf) | |
343 | (substring fptf (match-end 0)) | |
344 | (error "Cannot convert relativize path %s" fp)))))) | |
345 | ||
cb85c0d8 | 346 | (defmethod ede-convert-path ((this ede-target) path &optional project) |
acc33231 CY |
347 | "Convert path in a standard way for a given project. |
348 | Default to making it project relative. | |
cb85c0d8 EL |
349 | Argument THIS is the project to convert PATH to. |
350 | Optional PROJECT is the project that THIS belongs to. Associating | |
351 | a target to a project is expensive, so using this can speed things up." | |
352 | (let ((proj (or project (ede-target-parent this)))) | |
acc33231 CY |
353 | (if proj |
354 | (let ((p (ede-convert-path proj path)) | |
355 | (lp (or (oref this path) ""))) | |
356 | ;; Our target THIS may have path information. | |
357 | ;; strip this out of the conversion. | |
358 | (if (string-match (concat "^" (regexp-quote lp)) p) | |
359 | (substring p (length lp)) | |
360 | p)) | |
361 | (error "Parentless target %s" this)))) | |
362 | ||
363 | ;;; FILENAME EXPANSION | |
364 | ;; | |
365 | (defun ede-get-locator-object (proj) | |
366 | "Get the locator object for project PROJ. | |
367 | Get it from the toplevel project. If it doesn't have one, make one." | |
368 | ;; Make sure we have a location object available for | |
369 | ;; caching values, and for locating things more robustly. | |
370 | (let ((top (ede-toplevel proj))) | |
371 | (when (not (slot-boundp top 'locate-obj)) | |
67d3ffe4 | 372 | (ede-enable-locate-on-project top)) |
acc33231 CY |
373 | (oref top locate-obj) |
374 | )) | |
375 | ||
376 | (defmethod ede-expand-filename ((this ede-project) filename &optional force) | |
377 | "Return a fully qualified file name based on project THIS. | |
378 | FILENAME should be just a filename which occurs in a directory controlled | |
379 | by this project. | |
380 | Optional argument FORCE forces the default filename to be provided even if it | |
381 | doesn't exist. | |
cb85c0d8 EL |
382 | If FORCE equals 'newfile, then the cache is ignored and a new file in THIS |
383 | is returned." | |
acc33231 CY |
384 | (require 'ede/locate) |
385 | (let* ((loc (ede-get-locator-object this)) | |
386 | (ha (ede-locate-file-in-hash loc filename)) | |
387 | (ans nil) | |
388 | ) | |
389 | ;; NOTE: This function uses a locator object, which keeps a hash | |
390 | ;; table of files it has found in the past. The hash table is | |
391 | ;; used to make commonly found file very fast to location. Some | |
392 | ;; complex routines, such as smart completion asks this question | |
393 | ;; many times, so doing this speeds things up, especially on NFS | |
394 | ;; or other remote file systems. | |
395 | ||
396 | ;; As such, special care is needed to use the hash, and also obey | |
397 | ;; the FORCE option, which is needed when trying to identify some | |
398 | ;; new file that needs to be created, such as a Makefile. | |
399 | (cond | |
400 | ;; We have a hash-table match, AND that match wasn't the 'nomatch | |
401 | ;; flag, we can return it. | |
402 | ((and ha (not (eq ha 'nomatch))) | |
403 | (setq ans ha)) | |
404 | ;; If we had a match, and it WAS no match, then we need to look | |
405 | ;; at the force-option to see what to do. Since ans is already | |
406 | ;; nil, then we do nothing. | |
407 | ((and (eq ha 'nomatch) (not (eq force 'newfile))) | |
408 | nil) | |
409 | ;; We had no hash table match, so we have to look up this file | |
410 | ;; using the usual EDE file expansion rules. | |
411 | (t | |
412 | (let ((calc (ede-expand-filename-impl this filename))) | |
413 | (if calc | |
414 | (progn | |
415 | (ede-locate-add-file-to-hash loc filename calc) | |
416 | (setq ans calc)) | |
417 | ;; If we failed to calculate something, we | |
418 | ;; should add it to the hash, but ONLY if we are not | |
5a89f0a7 | 419 | ;; going to FORCE the file into existence. |
acc33231 CY |
420 | (when (not force) |
421 | (ede-locate-add-file-to-hash loc filename 'nomatch)))) | |
422 | )) | |
423 | ;; Now that all options have been queried, if the FORCE option is | |
424 | ;; true, but ANS is still nil, then we can make up a file name. | |
425 | ||
426 | ;; Is it forced? | |
427 | (when (and force (not ans)) | |
428 | (let ((dir (ede-project-root-directory this))) | |
429 | (setq ans (expand-file-name filename dir)))) | |
430 | ||
431 | ans)) | |
432 | ||
433 | (defmethod ede-expand-filename-impl ((this ede-project) filename &optional force) | |
434 | "Return a fully qualified file name based on project THIS. | |
435 | FILENAME should be just a filename which occurs in a directory controlled | |
436 | by this project. | |
437 | Optional argument FORCE forces the default filename to be provided even if it | |
438 | doesn't exist." | |
439 | (let ((loc (ede-get-locator-object this)) | |
440 | (path (ede-project-root-directory this)) | |
441 | (proj (oref this subproj)) | |
442 | (found nil)) | |
443 | ;; find it Locally. | |
cb85c0d8 EL |
444 | (setq found (or (ede-expand-filename-local this filename) |
445 | (ede-expand-filename-impl-via-subproj this filename))) | |
acc33231 CY |
446 | ;; Use an external locate tool. |
447 | (when (not found) | |
448 | (require 'ede/locate) | |
449 | (setq found (car (ede-locate-file-in-project loc filename)))) | |
450 | ;; Return it | |
451 | found)) | |
452 | ||
cb85c0d8 EL |
453 | (defmethod ede-expand-filename-local ((this ede-project) filename) |
454 | "Expand filename locally to project THIS with filesystem tests." | |
455 | (let ((path (ede-project-root-directory this))) | |
456 | (cond ((file-exists-p (expand-file-name filename path)) | |
457 | (expand-file-name filename path)) | |
458 | ((file-exists-p (expand-file-name (concat "include/" filename) path)) | |
459 | (expand-file-name (concat "include/" filename) path))))) | |
460 | ||
461 | (defmethod ede-expand-filename-impl-via-subproj ((this ede-project) filename) | |
462 | "Return a fully qualified file name based on project THIS. | |
463 | FILENAME should be just a filename which occurs in a directory controlled | |
464 | by this project." | |
465 | (let ((proj (list (ede-toplevel this))) | |
466 | (found nil)) | |
467 | ;; find it Locally. | |
468 | (while (and (not found) proj) | |
469 | (let ((thisproj (car proj))) | |
470 | (setq proj (append (cdr proj) (oref thisproj subproj))) | |
471 | (setq found (when thisproj | |
472 | (ede-expand-filename-local thisproj filename))) | |
473 | )) | |
474 | ;; Return it | |
475 | found)) | |
476 | ||
acc33231 CY |
477 | (defmethod ede-expand-filename ((this ede-target) filename &optional force) |
478 | "Return a fully qualified file name based on target THIS. | |
045b9da7 | 479 | FILENAME should be a filename which occurs in a directory in which THIS works. |
acc33231 CY |
480 | Optional argument FORCE forces the default filename to be provided even if it |
481 | doesn't exist." | |
482 | (ede-expand-filename (ede-target-parent this) filename force)) | |
483 | ||
484 | ;;; UTILITIES | |
485 | ;; | |
486 | ||
487 | (defun ede-up-directory (dir) | |
488 | "Return a dir that is up one directory. | |
489 | Argument DIR is the directory to trim upwards." | |
490 | (let* ((fad (directory-file-name dir)) | |
491 | (fnd (file-name-directory fad))) | |
492 | (if (string= dir fnd) ; This will catch the old string-match against | |
493 | ; c:/ for DOS like systems. | |
494 | nil | |
495 | fnd))) | |
496 | ||
497 | (provide 'ede/files) | |
498 | ||
499 | ;; Local variables: | |
500 | ;; generated-autoload-file: "loaddefs.el" | |
acc33231 CY |
501 | ;; generated-autoload-load-name: "ede/files" |
502 | ;; End: | |
503 | ||
504 | ;;; ede/files.el ends here |