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