lisp/cedet/ede/files.el

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