1 ;;; ede/files.el --- Associate projects with files and directories.
3 ;; Copyright (C) 2008, 2009 Free Software Foundation, Inc.
5 ;; Author: Eric M. Ludlam <eric@siege-engine.com>
7 ;; This file is part of GNU Emacs.
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.
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.
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/>.
24 ;; Directory and File scanning and matching functions.
28 ;; A directory belongs to a project if a ede-project-autoload structure
29 ;; matches your directory.
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.
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")
42 (defvar ede--disable-inode nil
43 "Set to 't' to simulate systems w/out inode support.")
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
))
55 (error "Could not find %s in %s"
57 (ede-project-root-directory (ede-current-project))))
60 ;;; Placeholders for ROOT directory scanning on base objects
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
))
67 (defmethod ede-project-root-directory ((this ede-project-placeholder
)
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
))))
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."
81 (defmethod ede-project-root-directory ((this ede-project-autoload
)
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
88 (setq file default-directory
))
89 (when (slot-boundp this
:proj-root
)
90 (let ((rootfcn (oref this proj-root
)))
93 (funcall rootfcn file
)
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
)
102 (oset proj dirinode
(ede--inode-for-dir (oref proj
:directory
)))))
104 (defmethod ede-find-subproject-for-directory ((proj ede-project-placeholder
)
106 "Find a subproject of PROJ that corresponds to DIR."
107 (if ede--disable-inode
109 ;; Try to find the right project w/out inodes.
114 (if (string= (file-truename dir
) (oref SP
:directory
))
116 (ede-find-subproject-for-directory SP dir
)))))
118 ;; We can use inodes, so lets try it.
120 (inode (ede--inode-for-dir dir
)))
125 (if (equal (ede--project-inode SP
) inode
)
127 (ede-find-subproject-for-directory SP dir
)))))
130 ;;; DIRECTORY IN OPEN PROJECT
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?
138 "A hash of directory names and inodes.")
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
)
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
)
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
))))
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
))
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
))
170 ;; Try file based search.
172 (setq proj
(ede-directory-get-toplevel-open-project ft
)))
173 ;; Default answer is this project
176 (when rootreturn
(set rootreturn proj
))
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
)))
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))
188 (let ((all ede-projects
)
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
)))
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
)))
202 (while (and all
(not ans
))
204 (let ((pd (oref (car all
) :directory
))
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
)))
224 (setq all
(cdr all
)))
227 ;;; DIRECTORY-PROJECT-P
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?
234 "A hash of directory names and associated EDE objects.")
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!
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
))
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
)))
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
)
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
)))
269 ((and (eq match
'nomatch
) (not force
))
271 ((and match
(not (eq match
'nomatch
)))
274 (let ((types ede-project-class-files
)
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
)
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
))
289 ;; These utilities will identify the "toplevel" of a project.
291 (defun ede-toplevel-project-or-nil (dir)
292 "Starting with DIR, find the toplevel project directory, or return nil.
293 nil is returned if the current directory is not a part of a project."
294 (let* ((ans (ede-directory-get-toplevel-open-project dir
)))
296 (oref ans
:directory
)
297 (if (ede-directory-project-p dir
)
298 (ede-toplevel-project dir
)
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
)))
315 (oref ans
:directory
)
316 (let* ((toppath (expand-file-name dir
))
318 (proj (ede-directory-project-p dir
))
321 ;; If we already have a project, ask it what the root is.
322 (setq ans
(ede-project-root-directory proj
)))
324 ;; If PROJ didn't know, or there is no PROJ, then
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
))
333 (setq proj
(ede-directory-project-p newpath
)))
336 ;; We can home someone in the middle knows too.
337 (setq ans
(ede-project-root-directory proj
)))
339 (or ans toppath
))))))
343 ;; The toplevel project is a way to identify the EDE structure that belongs
344 ;; to the top of a project.
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)))
353 (or (and cp
(ede-project-root cp
))
355 (while (ede-parent-project cp
)
356 (setq cp
(ede-parent-project cp
)))
359 ;;; DIRECTORY CONVERSION STUFF
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
))))))
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
)))
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
))
388 (error "Parentless target %s" this
))))
390 ;;; FILENAME EXPANSION
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 top
))
400 (oref top locate-obj
)
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
407 Optional argument FORCE forces the default filename to be provided even if it
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
))
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.
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.
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
)))
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
)))
435 ;; We had no hash table match, so we have to look up this file
436 ;; using the usual EDE file expansion rules.
438 (let ((calc (ede-expand-filename-impl this filename
)))
441 (ede-locate-add-file-to-hash loc filename 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.
447 (ede-locate-add-file-to-hash loc filename
'nomatch
))))
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.
453 (when (and force
(not ans
))
454 (let ((dir (ede-project-root-directory this
)))
455 (setq ans
(expand-file-name filename dir
))))
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
463 Optional argument FORCE forces the default filename to be provided even if it
465 (let ((loc (ede-get-locator-object this
))
466 (path (ede-project-root-directory this
))
467 (proj (oref this subproj
))
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
))
476 (while (and (not found
) proj
)
477 (setq found
(when (car proj
)
478 (ede-expand-filename (car proj
) filename
))
481 ;; Use an external locate tool.
483 (require 'ede
/locate
)
484 (setq found
(car (ede-locate-file-in-project loc filename
))))
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
493 (ede-expand-filename (ede-target-parent this
) filename force
))
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.
511 ;; generated-autoload-file: "loaddefs.el"
512 ;; generated-autoload-feature: ede/loaddefs
513 ;; generated-autoload-load-name: "ede/files"
516 ;; arch-tag: 28e17358-0208-4678-828c-23fb0e783fd6
517 ;;; ede/files.el ends here