1 ;;; ede/files.el --- Associate projects with files and directories.
3 ;; Copyright (C) 2008, 2009, 2010 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-load-name: "ede/files"
515 ;; arch-tag: 28e17358-0208-4678-828c-23fb0e783fd6
516 ;;; ede/files.el ends here