summaryrefslogtreecommitdiff
path: root/lisp/cedet/ede/files.el
blob: 3f23bfc80371d1d126250aeb10e6d849c98479c8 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
;;; ede/files.el --- Associate projects with files and directories.

;; Copyright (C) 2008-2016 Free Software Foundation, Inc.

;; Author: Eric M. Ludlam <eric@siege-engine.com>

;; This file is part of GNU Emacs.

;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:
;;
;; Directory and File scanning and matching functions.
;;
;; Basic Model:
;;
;; A directory belongs to a project if a ede-project-autoload structure
;; matches your directory.
;;
;; A toplevel project is one where there is no active project above
;; it.  Finding the toplevel project involves going up a directory
;; till no ede-project-autoload structure matches.
;;

(require 'ede)

(declare-function ede-locate-file-in-hash "ede/locate")
(declare-function ede-locate-add-file-to-hash "ede/locate")
(declare-function ede-locate-file-in-project "ede/locate")
(declare-function ede-locate-flush-hash "ede/locate")

(defvar ede--disable-inode nil
  "Set to t to simulate systems w/out inode support.")

;;; Code:
;;;###autoload
(defun ede-find-file (file)
  "Find FILE in project.  FILE can be specified without a directory.
There is no completion at the prompt.  FILE is searched for within
the current EDE project."
  (interactive "sFile: ")
  (let* ((proj (ede-current-project))
	 (fname (ede-expand-filename proj file))
	)
    (unless fname
      (error "Could not find %s in %s"
	     file
	     (ede-project-root-directory proj)))
    (find-file fname)))

(defun ede-flush-project-hash ()
  "Flush the file locate hash for the current project."
  (interactive)
  (require 'ede/locate)
  (let* ((loc (ede-get-locator-object (ede-current-project))))
    (when loc
      (ede-locate-flush-hash loc))))

;;; Placeholders for ROOT directory scanning on base objects
;;
(cl-defmethod ede-project-root ((this ede-project-placeholder))
  "If a project knows its root, return it here.
Allows for one-project-object-for-a-tree type systems."
  (oref this rootproject))

(cl-defmethod ede-project-root-directory ((this ede-project-placeholder)
				       &optional file)
  "If a project knows its root, return it here.
Allows for one-project-object-for-a-tree type systems.
Optional FILE is the file to test.  It is ignored in preference
of the anchor file for the project."
  (let ((root (or (ede-project-root this) this)))
    (file-name-directory (expand-file-name (oref this file)))))


;; Why INODEs?
;; An inode represents a unique ID that transcends symlinks, hardlinks, etc.
;; so when we cache an inode in a project, and hash directories to inodes, we
;; can avoid costly filesystem queries and regex matches.

(defvar ede-inode-directory-hash (make-hash-table
				  ;; Note on test.  Can we compare inodes or something?
				  :test 'equal)
  "A hash of directory names and inodes.")

(defun ede--put-inode-dir-hash (dir inode)
  "Add to the EDE project hash DIR associated with INODE."
  (when (fboundp 'puthash)
    (puthash dir inode ede-inode-directory-hash)
    inode))

(defun ede--get-inode-dir-hash (dir)
  "Get the EDE project hash DIR associated with INODE."
  (when (fboundp 'gethash)
    (gethash dir ede-inode-directory-hash)
    ))

(defun ede--inode-for-dir (dir)
  "Return the inode for the directory DIR."
  (let ((hashnode (ede--get-inode-dir-hash (expand-file-name dir))))
    (or hashnode
	(if ede--disable-inode
	    (ede--put-inode-dir-hash dir 0)
	  (let ((fattr (file-attributes dir)))
	    (ede--put-inode-dir-hash dir (nth 10 fattr))
	    )))))

(cl-defmethod ede--project-inode ((proj ede-project-placeholder))
  "Get the inode of the directory project PROJ is in."
  (if (slot-boundp proj 'dirinode)
      (oref proj dirinode)
    (oset proj dirinode (ede--inode-for-dir (oref proj :directory)))))

(defun ede--inode-get-toplevel-open-project (inode)
  "Return an already open toplevel project that is managing INODE.
Does not check subprojects."
  (when (or (and (numberp inode) (/= inode 0))
	    (consp inode))
    (let ((all ede-projects)
	  (found nil)
	  )
      (while (and all (not found))
	(when (equal inode (ede--project-inode (car all)))
	  (setq found (car all)))
	(setq all (cdr all)))
      found)))

;;; DIRECTORY IN OPEN PROJECT
;;
;; These routines match some directory name to one of the many pre-existing
;; open projects.  This should avoid hitting the disk, or asking lots of questions
;; if used throughout the other routines.

(defun ede-directory-get-open-project (dir &optional rootreturn)
  "Return an already open project that is managing DIR.
Optional ROOTRETURN specifies a symbol to set to the root project.
If DIR is the root project, then it is the same."
  (let* ((inode (ede--inode-for-dir dir))
	 (ft (file-name-as-directory (expand-file-name dir)))
	 (proj (ede--inode-get-toplevel-open-project inode))
	 (ans nil))
    ;; Try file based search.
    (when (or ede--disable-inode (not proj))
      (setq proj (ede-directory-get-toplevel-open-project ft)))
    ;; Default answer is this project
    (setq ans proj)
    ;; Save.
    (when rootreturn (set rootreturn proj))
    ;; Find subprojects.
    (when (and proj (if ede--disable-inode
			(not (string= ft (expand-file-name (oref proj :directory))))
		      (not (equal inode (ede--project-inode proj)))))
      (setq ans (ede-find-subproject-for-directory proj ft)))
    ans))

;; Force all users to switch to `ede-directory-get-open-project'
;; for performance reasons.
(defun ede-directory-get-toplevel-open-project (dir &optional exact)
  "Return an already open toplevel project that is managing DIR.
If optional EXACT is non-nil, only return exact matches for DIR."
  (let ((ft (file-name-as-directory (expand-file-name dir)))
	(all ede-projects)
	(ans nil)
	(shortans nil))
    (while (and all (not ans))
      ;; Do the check.
      (let ((pd (expand-file-name (oref (car all) :directory)))
	    )
	(cond
	 ;; Exact text match.
	 ((string= pd ft)
	  (setq ans (car all)))
	 ;; Some sub-directory
	 ((and (not exact) (string-match (concat "^" (regexp-quote pd)) ft))
	  (if (not shortans)
	      (setq shortans (car all))
	    ;; We already have a short answer, so see if pd (the match we found)
	    ;; is longer.  If it is longer, then it is more precise.
	    (when (< (length (oref shortans :directory))
		     (length pd))
	      (setq shortans (car all))))
	  )
	 ;; Exact inode match.  Useful with symlinks or complex automounters.
	 ((and (not ede--disable-inode)
	       (let ((pin (ede--project-inode (car all)))
		     (inode (ede--inode-for-dir dir)))
		 (and (not (eql pin 0)) (equal pin inode))))
	  (setq ans (car all)))
	 ;; Subdir via truename - slower by far, but faster than a traditional lookup.
	 ;; Note that we must resort to truename in order to resolve issues such as
	 ;; cross-symlink projects.
	 ((and (not exact)
	       (let ((ftn (file-truename ft))
		     (ptd (file-truename pd)))
		 (string-match (concat "^" (regexp-quote ptd)) ftn)))
	  (if (not shortans)
	      (setq shortans (car all))
	    ;; We already have a short answer, so see if pd (the match we found)
	    ;; is longer.  If it is longer, then it is more precise.
	    (when (< (length (expand-file-name (oref shortans :directory)))
		     (length pd))
	      (setq shortans (car all))))
	  )))
      (setq all (cdr all)))
    ;; If we have an exact answer, use that, otherwise use
    ;; the short answer we found -> ie - we are in a subproject.
    (or ans shortans)))

(cl-defmethod ede-find-subproject-for-directory ((proj ede-project-placeholder)
					      dir)
  "Find a subproject of PROJ that corresponds to DIR."
  (if ede--disable-inode
      (let ((ans nil)
	    (fulldir (file-truename dir)))
	;; Try to find the right project w/out inodes.
	(ede-map-subprojects
	 proj
	 (lambda (SP)
	   (when (not ans)
	     (if (string= fulldir (file-truename (oref SP :directory)))
		 (setq ans SP)
	       (ede-find-subproject-for-directory SP dir)))))
	ans)
    ;; We can use inodes, so let's try it.
    (let ((ans nil)
	  (inode (ede--inode-for-dir dir)))
      (ede-map-subprojects
       proj
       (lambda (SP)
	 (when (not ans)
	   (if (equal (ede--project-inode SP) inode)
	       (setq ans SP)
	     (setq ans (ede-find-subproject-for-directory SP dir))))))
      ans)))

;;; DIRECTORY HASH
;;
;; The directory hash matches expanded directory names to already detected
;; projects.  By hashing projects to directories, we can detect projects in
;; places we have been before much more quickly.

(defvar ede-project-directory-hash (make-hash-table
				    ;; Note on test.  Can we compare inodes or something?
				    :test 'equal)
  "A hash of directory names and associated EDE objects.")

(defun ede-flush-directory-hash ()
  "Flush the project directory hash.
Do this only when developing new projects that are incorrectly putting
'nomatch tokens into the hash."
  (interactive)
  (setq ede-project-directory-hash (make-hash-table :test 'equal))
  ;; Also slush the current project's locator hash.
  (let ((loc (ede-get-locator-object ede-object)))
    (when loc
      (ede-locate-flush-hash loc)))
  )

(defun ede-project-directory-remove-hash (dir)
  "Reset the directory hash for DIR.
Do this whenever a new project is created, as opposed to loaded."
  ;; TODO - Use maphash, and delete by regexp, not by dir searching!
  (setq dir (expand-file-name dir))
  (when (fboundp 'remhash)
    (remhash (file-name-as-directory dir) ede-project-directory-hash)
    ;; Look for all subdirs of D, and remove them.
    (let ((match (concat "^" (regexp-quote dir))))
      (maphash (lambda (K O)
		 (when (string-match match K)
		   (remhash K ede-project-directory-hash)))
	       ede-project-directory-hash))
    ))

(defun ede--directory-project-from-hash (dir)
  "If there is an already loaded project for DIR, return it from the hash."
  (when (fboundp 'gethash)
    (setq dir (expand-file-name dir))
    (gethash dir ede-project-directory-hash nil)))

(defun ede--directory-project-add-description-to-hash (dir desc)
  "Add to the EDE project hash DIR associated with DESC."
  (when (fboundp 'puthash)
    (setq dir (expand-file-name dir))
    (puthash dir desc ede-project-directory-hash)
    desc))

;;; DIRECTORY-PROJECT-P, -CONS
;;
;; These routines are useful for detecting if a project exists
;; in a provided directory.
;;
;; Note that -P provides less information than -CONS, so use -CONS
;; instead so that -P can be obsoleted.
(defun ede-directory-project-p (dir &optional force)
  "Return a project description object if DIR is in a project.
Optional argument FORCE means to ignore a hash-hit of `nomatch'.
This depends on an up to date `ede-project-class-files' variable.
Any directory that contains the file .ede-ignore will always
return nil.

Consider using `ede-directory-project-cons' instead if the next
question you want to ask is where the root of found project is."
  ;; @TODO - We used to have a full impl here, but moved it all
  ;;         to ede-directory-project-cons, and now hash contains only
  ;;         the results of detection which includes the root dir.
  ;;         Perhaps we can eventually remove this fcn?
  (let ((detect (ede-directory-project-cons dir force)))
    (cdr detect)))

(defun ede-directory-project-cons (dir &optional force)
  "Return a project CONS (ROOTDIR . AUTOLOAD) for DIR.
If there is no project in DIR, return nil.
Optional FORCE means to ignore the hash of known directories."
  (when (not (file-exists-p (expand-file-name ".ede-ignore" dir)))
    (let* ((dirtest (expand-file-name dir))
	   (match (ede--directory-project-from-hash dirtest)))
      (cond
       ((and (eq match 'nomatch) (not force))
	nil)
       ((and match (not (eq match 'nomatch)))
	match)
       (t
	;; First time here?  Use the detection code to identify if we have
	;; a project here.
	(let* ((detect (ede-detect-directory-for-project dirtest))
	       (autoloader (cdr detect))) ;; autoloader
	  (when autoloader (require (oref autoloader file)))
	  (ede--directory-project-add-description-to-hash dirtest (or detect 'nomatch))
	  detect)
	)))))


;;; TOPLEVEL
;;
;; These utilities will identify the "toplevel" of a project.
;;
;; NOTE: These two -toplevel- functions return a directory even though
;;       the function name implies a project.

(defun ede-toplevel-project (dir)
  "Starting with DIR, find the toplevel project directory.
If DIR is not part of a project, return nil."
  (let ((ans nil))

    (cond
     ;; Check if it is cached in the current buffer.
     ((and (string= dir default-directory)
	   ede-object-root-project)
      ;; Try the local buffer cache first.
      (oref ede-object-root-project :directory))

     ;; See if there is an existing project in DIR.
     ((setq ans (ede-directory-get-toplevel-open-project dir))
      (oref ans :directory))

     ;; Detect using our file system detector.
     ((setq ans (ede-detect-directory-for-project dir))
      (car ans))

     (t nil))))

(defalias 'ede-toplevel-project-or-nil 'ede-toplevel-project)

;;; DIRECTORY CONVERSION STUFF
;;
(cl-defmethod ede-convert-path ((this ede-project) path)
  "Convert path in a standard way for a given project.
Default to making it project relative.
Argument THIS is the project to convert PATH to."
  (let ((pp (ede-project-root-directory this))
	(fp (expand-file-name path)))
    (if (string-match (regexp-quote pp) fp)
	(substring fp (match-end 0))
      (let ((pptf (file-truename pp))
	    (fptf (file-truename fp)))
	(if (string-match (regexp-quote pptf) fptf)
	    (substring fptf (match-end 0))
	  (error "Cannot convert relativize path %s" fp))))))

(cl-defmethod ede-convert-path ((this ede-target) path &optional project)
  "Convert path in a standard way for a given project.
Default to making it project relative.
Argument THIS is the project to convert PATH to.
Optional PROJECT is the project that THIS belongs to.  Associating
a target to a project is expensive, so using this can speed things up."
  (let ((proj (or project (ede-target-parent this))))
    (if proj
	(let ((p (ede-convert-path proj path))
	      (lp (or (oref this path) "")))
	  ;; Our target THIS may have path information.
	  ;; strip this out of the conversion.
	  (if (string-match (concat "^" (regexp-quote lp)) p)
	      (substring p (length lp))
	    p))
      (error "Parentless target %s" this))))

;;; FILENAME EXPANSION
;;
(defun ede-get-locator-object (proj)
  "Get the locator object for project PROJ.
Get it from the toplevel project.  If it doesn't have one, make one."
  ;; Make sure we have a location object available for
  ;; caching values, and for locating things more robustly.
  (let ((top (ede-toplevel proj)))
    (when top
      (when (not (slot-boundp top 'locate-obj))
	(ede-enable-locate-on-project top))
      (oref top locate-obj)
      )))

(cl-defmethod ede-expand-filename ((this ede-project) filename &optional force)
  "Return a fully qualified file name based on project THIS.
FILENAME should be just a filename which occurs in a directory controlled
by this project.
Optional argument FORCE forces the default filename to be provided even if it
doesn't exist.
If FORCE equals 'newfile, then the cache is ignored and a new file in THIS
is returned."
  (require 'ede/locate)
  (let* ((loc (ede-get-locator-object this))
	 (ha (ede-locate-file-in-hash loc filename))
	 (ans nil)
	 )
    ;; NOTE: This function uses a locator object, which keeps a hash
    ;; table of files it has found in the past.  The hash table is
    ;; used to make commonly found file very fast to location.  Some
    ;; complex routines, such as smart completion asks this question
    ;; many times, so doing this speeds things up, especially on NFS
    ;; or other remote file systems.

    ;; As such, special care is needed to use the hash, and also obey
    ;; the FORCE option, which is needed when trying to identify some
    ;; new file that needs to be created, such as a Makefile.
    (cond
     ;; We have a hash-table match, AND that match wasn't the 'nomatch
     ;; flag, we can return it.
     ((and ha (not (eq ha 'nomatch)))
      (setq ans ha))
     ;; If we had a match, and it WAS no match, then we need to look
     ;; at the force-option to see what to do.  Since ans is already
     ;; nil, then we do nothing.
     ((and (eq ha 'nomatch) (not (eq force 'newfile)))
      nil)
     ;; We had no hash table match, so we have to look up this file
     ;; using the usual EDE file expansion rules.
     (t
      (let ((calc (ede-expand-filename-impl this filename)))
	(if calc
	    (progn
	      (ede-locate-add-file-to-hash loc filename calc)
	      (setq ans calc))
	  ;; If we failed to calculate something, we
	  ;; should add it to the hash, but ONLY if we are not
	  ;; going to FORCE the file into existence.
	  (when (not force)
	    (ede-locate-add-file-to-hash loc filename 'nomatch))))
      ))
    ;; Now that all options have been queried, if the FORCE option is
    ;; true, but ANS is still nil, then we can make up a file name.

    ;; Is it forced?
    (when (and force (not ans))
      (let ((dir (ede-project-root-directory this)))
	(setq ans (expand-file-name filename dir))))

    ans))

(cl-defmethod ede-expand-filename-impl ((this ede-project) filename &optional force)
  "Return a fully qualified file name based on project THIS.
FILENAME should be just a filename which occurs in a directory controlled
by this project.
Optional argument FORCE forces the default filename to be provided even if it
doesn't exist."
  (let ((loc (ede-get-locator-object this))
	(path (ede-project-root-directory this))
	(proj (oref this subproj))
	(found nil))
    ;; find it Locally.
    (setq found (or (ede-expand-filename-local this filename)
		    (ede-expand-filename-impl-via-subproj this filename)))
    ;; Use an external locate tool.
    (when (not found)
      (require 'ede/locate)
      (setq found (car (ede-locate-file-in-project loc filename))))
    ;; Return it
    found))

(cl-defmethod ede-expand-filename-local ((this ede-project) filename)
  "Expand filename locally to project THIS with filesystem tests."
  (let ((path (ede-project-root-directory this)))
    (cond ((file-exists-p (expand-file-name filename path))
	   (expand-file-name filename path))
	  ((file-exists-p (expand-file-name  (concat "include/" filename) path))
	   (expand-file-name (concat "include/" filename) path)))))

(cl-defmethod ede-expand-filename-impl-via-subproj ((this ede-project) filename)
  "Return a fully qualified file name based on project THIS.
FILENAME should be just a filename which occurs in a directory controlled
by this project."
  (let ((proj (list (ede-toplevel this)))
	(found nil))
    ;; find it Locally.
    (while (and (not found) proj)
      (let ((thisproj (car proj)))
	(setq proj (append (cdr proj) (oref thisproj subproj)))
	(setq found (when thisproj
		      (ede-expand-filename-local thisproj filename)))
	))
    ;; Return it
    found))

(cl-defmethod ede-expand-filename ((this ede-target) filename &optional force)
  "Return a fully qualified file name based on target THIS.
FILENAME should be a filename which occurs in a directory in which THIS works.
Optional argument FORCE forces the default filename to be provided even if it
doesn't exist."
  (ede-expand-filename (ede-target-parent this) filename force))

;;; UTILITIES
;;

(defun ede-up-directory (dir)
  "Return a dir that is up one directory.
Argument DIR is the directory to trim upwards."
  (let* ((fad (directory-file-name dir))
	 (fnd (file-name-directory fad)))
    (if (string= dir fnd) ; This will catch the old string-match against
			  ; c:/ for DOS like systems.
	nil
      fnd)))


(provide 'ede/files)

;; Local variables:
;; generated-autoload-file: "loaddefs.el"
;; generated-autoload-load-name: "ede/files"
;; End:

;;; ede/files.el ends here