code.delx.au - gnu-emacs/blob - lisp/cedet/ede.el

   1 ;;; ede.el --- Emacs Development Environment gloss
   2
   3 ;; Copyright (C) 1998-2005, 2007-2016 Free Software Foundation, Inc.
   4
   5 ;; Author: Eric M. Ludlam <zappo@gnu.org>
   6 ;; Keywords: project, make
   7 ;; Version: 1.2
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software: you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation, either version 3 of the License, or
  14 ;; (at your option) any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  23
  24 ;;; Commentary:
  25 ;;
  26 ;; EDE is the top level Lisp interface to a project management scheme
  27 ;; for Emacs.  Emacs does many things well, including editing,
  28 ;; building, and debugging.  Folks migrating from other IDEs don't
  29 ;; seem to think this qualifies, however, because they still have to
  30 ;; write the makefiles, and specify parameters to programs.
  31 ;;
  32 ;; This EDE mode will attempt to link these diverse programs together
  33 ;; into a comprehensive single interface, instead of a bunch of
  34 ;; different ones.
  35
  36 ;;; Install
  37 ;;
  38 ;;  This command enables project mode on all files.
  39 ;;
  40 ;;  (global-ede-mode t)
  41
  42 (require 'cedet)
  43 (require 'cl-lib)
  44 (require 'eieio)
  45 (require 'cl-generic)
  46 (require 'eieio-speedbar)
  47 (require 'ede/source)
  48 (require 'ede/base)
  49 (require 'ede/auto)
  50 (require 'ede/detect)
  51
  52 (eval-and-compile
  53   (load "ede/loaddefs" nil 'nomessage))
  54
  55 (declare-function ede-commit-project "ede/custom")
  56 (declare-function ede-convert-path "ede/files")
  57 (declare-function ede-directory-get-open-project "ede/files")
  58 (declare-function ede-directory-get-toplevel-open-project "ede/files")
  59 (declare-function ede-directory-project-p "ede/files")
  60 (declare-function ede-find-subproject-for-directory "ede/files")
  61 (declare-function ede-project-directory-remove-hash "ede/files")
  62 (declare-function ede-toplevel "ede/base")
  63 (declare-function ede-toplevel-project "ede/files")
  64 (declare-function ede-up-directory "ede/files")
  65 (declare-function semantic-lex-make-spp-table "semantic/lex-spp")
  66
  67 (defconst ede-version "2.0"
  68   "Current version of the Emacs EDE.")
  69
  70 ;;; Code:
  71 (defun ede-version ()
  72   "Display the current running version of EDE."
  73   (interactive) (message "EDE %s" ede-version))
  74
  75 (defgroup ede nil
  76   "Emacs Development Environment."
  77   :group 'tools
  78   :group 'extensions)
  79
  80 (defcustom ede-auto-add-method 'ask
  81   "Whether a new source file should be automatically added to a target.
  82 Whenever a new file is encountered in a directory controlled by a
  83 project file, all targets are queried to see if it should be added.
  84 If the value is `always', then the new file is added to the first
  85 target encountered.  If the value is `multi-ask', then if more than one
  86 target wants the file, the user is asked.  If only one target wants
  87 the file, then it is automatically added to that target.  If the
  88 value is `ask', then the user is always asked, unless there is no
  89 target willing to take the file.  `never' means never perform the check."
  90   :group 'ede
  91   :type '(choice (const always)
  92                  (const multi-ask)
  93                  (const ask)
  94                  (const never)))
  95
  96 (defcustom ede-debug-program-function 'gdb
  97   "Default Emacs command used to debug a target."
  98   :group 'ede
  99   :type 'function) ; make this be a list of options some day
 100
 101 (defcustom ede-project-directories nil
 102   "Directories in which EDE may search for project files.
 103 If the value is t, EDE may search in any directory.
 104
 105 If the value is a function, EDE calls that function with one
 106 argument, the directory name; the function should return t if
 107 EDE should look for project files in the directory.
 108
 109 Otherwise, the value should be a list of fully-expanded directory
 110 names.  EDE searches for project files only in those directories.
 111 If you invoke the commands \\[ede] or \\[ede-new] on a directory
 112 that is not listed, Emacs will offer to add it to the list.
 113
 114 Any other value disables searching for EDE project files."
 115   :group 'ede
 116   :type '(choice (const :tag "Any directory" t)
 117                  (repeat :tag "List of directories"
 118                          (directory))
 119                  (function :tag "Predicate"))
 120   :version "23.4"
 121   :risky t)
 122
 123 (defun ede-directory-safe-p (dir)
 124   "Return non-nil if DIR is a safe directory to load projects from.
 125 Projects that do not load a project definition as Emacs Lisp code
 126 are safe, and can be loaded automatically.  Other project types,
 127 such as those created with Project.ede files, are safe only if
 128 specified by `ede-project-directories'."
 129   (setq dir (directory-file-name (expand-file-name dir)))
 130   ;; Load only if allowed by `ede-project-directories'.
 131   (or (eq ede-project-directories t)
 132       (and (functionp ede-project-directories)
 133            (funcall ede-project-directories dir))
 134       (and (listp ede-project-directories)
 135            (member dir ede-project-directories))))
 136
 137 \f
 138 ;;; Management variables
 139
 140 (defvar ede-projects nil
 141   "A list of all active projects currently loaded in Emacs.")
 142
 143 (defvar ede-object-root-project nil
 144   "The current buffer's current root project.
 145 If a file is under a project, this specifies the project that is at
 146 the root of a project tree.")
 147 (make-variable-buffer-local 'ede-object-root-project)
 148
 149 (defvar ede-object-project nil
 150   "The current buffer's current project at that level.
 151 If a file is under a project, this specifies the project that contains the
 152 current target.")
 153 (make-variable-buffer-local 'ede-object-project)
 154
 155 (defvar ede-object nil
 156   "The current buffer's target object.
 157 This object's class determines how to compile and debug from a buffer.")
 158 (make-variable-buffer-local 'ede-object)
 159
 160 (defvar ede-selected-object nil
 161   "The currently user-selected project or target.
 162 If `ede-object' is nil, then commands will operate on this object.")
 163
 164 (defvar ede-constructing nil
 165   "Non nil when constructing a project hierarchy.
 166 If the project is being constructed from an autoload, then the
 167 value is the autoload object being used.")
 168
 169 (defvar ede-deep-rescan nil
 170   "Non nil means scan down a tree, otherwise rescans are top level only.
 171 Do not set this to non-nil globally.  It is used internally.")
 172
 173 \f
 174 ;;; Prompting
 175 ;;
 176 (defun ede-singular-object (prompt)
 177   "Using PROMPT, choose a single object from the current buffer."
 178   (if (listp ede-object)
 179       (ede-choose-object prompt ede-object)
 180     ede-object))
 181
 182 (defun ede-choose-object (prompt list-o-o)
 183   "Using PROMPT, ask the user which OBJECT to use based on the name field.
 184 Argument LIST-O-O is the list of objects to choose from."
 185   (let* ((al (object-assoc-list 'name list-o-o))
 186          (ans (completing-read prompt al nil t)))
 187     (setq ans (assoc ans al))
 188     (cdr ans)))
 189 \f
 190 ;;; Menu and Keymap
 191
 192 (defvar ede-minor-mode-map
 193   (let ((map (make-sparse-keymap))
 194         (pmap (make-sparse-keymap)))
 195     (define-key pmap "e" 'ede-edit-file-target)
 196     (define-key pmap "a" 'ede-add-file)
 197     (define-key pmap "d" 'ede-remove-file)
 198     (define-key pmap "t" 'ede-new-target)
 199     (define-key pmap "g" 'ede-rescan-toplevel)
 200     (define-key pmap "s" 'ede-speedbar)
 201     (define-key pmap "f" 'ede-find-file)
 202     (define-key pmap "C" 'ede-compile-project)
 203     (define-key pmap "c" 'ede-compile-target)
 204     (define-key pmap "\C-c" 'ede-compile-selected)
 205     (define-key pmap "D" 'ede-debug-target)
 206     (define-key pmap "R" 'ede-run-target)
 207     ;; bind our submap into map
 208     (define-key map "\C-c." pmap)
 209     map)
 210   "Keymap used in project minor mode.")
 211
 212 (defvar global-ede-mode-map
 213   (let ((map (make-sparse-keymap)))
 214     (define-key map [menu-bar cedet-menu]
 215       (cons "Development" cedet-menu-map))
 216     map)
 217   "Keymap used in `global-ede-mode'.")
 218
 219 ;; Activate the EDE items in cedet-menu-map
 220
 221 (define-key cedet-menu-map [ede-find-file]
 222   '(menu-item "Find File in Project..." ede-find-file :enable ede-object
 223               :visible global-ede-mode))
 224 (define-key cedet-menu-map [ede-speedbar]
 225   '(menu-item "View Project Tree" ede-speedbar :enable ede-object
 226               :visible global-ede-mode))
 227 (define-key cedet-menu-map [ede]
 228   '(menu-item "Load Project" ede
 229               :visible global-ede-mode))
 230 (define-key cedet-menu-map [ede-new]
 231   '(menu-item "Create Project" ede-new
 232               :enable (not ede-object)
 233               :visible global-ede-mode))
 234 (define-key cedet-menu-map [ede-target-options]
 235   '(menu-item "Target Options" ede-target-options
 236               :filter ede-target-forms-menu
 237               :visible global-ede-mode))
 238 (define-key cedet-menu-map [ede-project-options]
 239   '(menu-item "Project Options" ede-project-options
 240               :filter ede-project-forms-menu
 241               :visible global-ede-mode))
 242 (define-key cedet-menu-map [ede-build-forms-menu]
 243   '(menu-item "Build Project" ede-build-forms-menu
 244               :filter ede-build-forms-menu
 245               :enable ede-object
 246               :visible global-ede-mode))
 247
 248 (defun ede-buffer-belongs-to-target-p ()
 249   "Return non-nil if this buffer belongs to at least one target."
 250   (let ((obj ede-object))
 251     (if (consp obj)
 252         (setq obj (car obj)))
 253     (and obj (obj-of-class-p obj 'ede-target))))
 254
 255 (defun ede-buffer-belongs-to-project-p ()
 256   "Return non-nil if this buffer belongs to at least one project."
 257   (if (or (null ede-object) (consp ede-object)) nil
 258     (obj-of-class-p ede-object-project 'ede-project)))
 259
 260 (defun ede-menu-obj-of-class-p (class)
 261   "Return non-nil if some member of `ede-object' is a child of CLASS."
 262   (if (listp ede-object)
 263       (cl-some (lambda (o) (obj-of-class-p o class)) ede-object)
 264     (obj-of-class-p ede-object class)))
 265
 266 (defun ede-build-forms-menu (_menu-def)
 267   "Create a sub menu for building different parts of an EDE system.
 268 Argument MENU-DEF is the menu definition to use."
 269   (easy-menu-filter-return
 270    (easy-menu-create-menu
 271     "Build Forms"
 272     (let ((obj (ede-current-project))
 273           (newmenu nil) ;'([ "Build Selected..." ede-compile-selected t ]))
 274           targets
 275           targitems
 276           ede-obj
 277           (tskip nil))
 278       (if (not obj)
 279           nil
 280         (setq targets (when (slot-boundp obj 'targets)
 281                         (oref obj targets))
 282               ede-obj (if (listp ede-object) ede-object (list ede-object)))
 283         ;; First, collect the build items from the project
 284         (setq newmenu (append newmenu (ede-menu-items-build obj t)))
 285         ;; Second, declare the current target menu items
 286         (if (and ede-obj (ede-menu-obj-of-class-p 'ede-target))
 287             (while ede-obj
 288               (setq newmenu (append newmenu
 289                                     (ede-menu-items-build (car ede-obj) t))
 290                     tskip (car ede-obj)
 291                     ede-obj (cdr ede-obj))))
 292         ;; Third, by name, enable builds for other local targets
 293         (while targets
 294           (unless (eq tskip (car targets))
 295             (setq targitems (ede-menu-items-build (car targets) nil))
 296             (setq newmenu
 297                   (append newmenu
 298                           (if (= 1 (length targitems))
 299                               targitems
 300                             (cons (ede-name (car targets))
 301                                   targitems))))
 302             )
 303           (setq targets (cdr targets)))
 304         ;; Fourth, build sub projects.
 305         ;; -- nerp
 306         ;; Fifth, add make distribution
 307         (append newmenu (list [ "Make distribution" ede-make-dist t ]))
 308         )))))
 309
 310 (defun ede-target-forms-menu (_menu-def)
 311   "Create a target MENU-DEF based on the object belonging to this buffer."
 312   (easy-menu-filter-return
 313    (easy-menu-create-menu
 314     "Target Forms"
 315     (let ((obj (or ede-selected-object ede-object)))
 316       (append
 317        '([ "Add File" ede-add-file
 318            (and (ede-current-project)
 319                 (oref (ede-current-project) targets)) ]
 320          [ "Remove File" ede-remove-file
 321            (ede-buffer-belongs-to-project-p) ]
 322          "-")
 323        (if (not obj)
 324            nil
 325          (if (and (not (listp obj)) (oref obj menu))
 326              (oref obj menu)
 327            (when (listp obj)
 328              ;; This is bad, but I'm not sure what else to do.
 329              (oref (car obj) menu)))))))))
 330
 331 (defun ede-project-forms-menu (_menu-def)
 332   "Create a target MENU-DEF based on the object belonging to this buffer."
 333   (easy-menu-filter-return
 334    (easy-menu-create-menu
 335     "Project Forms"
 336     (let* ((obj (ede-current-project))
 337            (class (if obj (eieio-object-class obj)))
 338            (menu nil))
 339       (condition-case err
 340           (progn
 341             (while (and class (slot-exists-p class 'menu))
 342               ;;(message "Looking at class %S" class)
 343               (setq menu (append menu (oref-default class menu))
 344                     class (eieio-class-parent class))
 345               (if (listp class) (setq class (car class))))
 346             (append
 347              '( [ "Add Target" ede-new-target (ede-current-project) ]
 348                 [ "Remove Target" ede-delete-target ede-object ]
 349                 ( "Default configuration" :filter ede-configuration-forms-menu )
 350                 "-")
 351              menu
 352              ))
 353         (error (message "Err found: %S" err)
 354                menu)
 355         )))))
 356
 357 (defun ede-configuration-forms-menu (_menu-def)
 358   "Create a submenu for selecting the default configuration for this project.
 359 The current default is in the current object's CONFIGURATION-DEFAULT slot.
 360 All possible configurations are in CONFIGURATIONS.
 361 Argument MENU-DEF specifies the menu being created."
 362   (easy-menu-filter-return
 363    (easy-menu-create-menu
 364     "Configurations"
 365     (let* ((obj (ede-current-project))
 366            (conf (when obj (oref obj configurations)))
 367            (cdef (when obj (oref obj configuration-default)))
 368            (menu nil))
 369       (dolist (C conf)
 370         (setq menu (cons (vector C (list 'ede-project-configurations-set C)
 371                                  :style 'toggle
 372                                  :selected (string= C cdef))
 373                          menu))
 374         )
 375       (nreverse menu)))))
 376
 377 (defun ede-project-configurations-set (newconfig)
 378   "Set the current project's current configuration to NEWCONFIG.
 379 This function is designed to be used by `ede-configuration-forms-menu'
 380 but can also be used interactively."
 381   (interactive
 382    (list (let* ((proj (ede-current-project))
 383                 (configs (oref proj configurations)))
 384            (completing-read "New configuration: "
 385                             configs nil t
 386                             (oref proj configuration-default)))))
 387   (oset (ede-current-project) configuration-default newconfig)
 388   (message "%s will now build in %s mode."
 389            (eieio-object-name (ede-current-project))
 390            newconfig))
 391
 392 (defun ede-customize-forms-menu (_menu-def)
 393   "Create a menu of the project, and targets that can be customized.
 394 Argument MENU-DEF is the definition of the current menu."
 395   (easy-menu-filter-return
 396    (easy-menu-create-menu
 397     "Customize Project"
 398     (let* ((obj (ede-current-project))
 399            targ)
 400       (when obj
 401         (setq targ (when (and obj (slot-boundp obj 'targets))
 402                      (oref obj targets)))
 403         ;; Make custom menus for everything here.
 404         (append (list
 405                  (cons (concat "Project " (ede-name obj))
 406                        (eieio-customize-object-group obj))
 407                  [ "Reorder Targets" ede-project-sort-targets t ]
 408                  )
 409                 (mapcar (lambda (o)
 410                           (cons (concat "Target " (ede-name o))
 411                                 (eieio-customize-object-group o)))
 412                         targ)))))))
 413
 414
 415 (defun ede-apply-object-keymap (&optional _default)
 416   "Add target specific keybindings into the local map.
 417 Optional argument DEFAULT indicates if this should be set to the default
 418 version of the keymap."
 419   (let ((object (or ede-object ede-selected-object))
 420         (proj ede-object-project))
 421     (condition-case nil
 422         (let ((keys (ede-object-keybindings object)))
 423           (dolist (key
 424                    ;; Add keys for the project to whatever is in the current
 425                    ;; object so long as it isn't the same.
 426                    (if (eq object proj)
 427                        keys
 428                      (append keys (ede-object-keybindings proj))))
 429             (local-set-key (concat "\C-c." (car key)) (cdr key))))
 430       (error nil))))
 431
 432 ;;; Menu building methods for building
 433 ;;
 434 (cl-defmethod ede-menu-items-build ((obj ede-project) &optional current)
 435   "Return a list of menu items for building project OBJ.
 436 If optional argument CURRENT is non-nil, return sub-menu code."
 437   (if current
 438       (list [ "Build Current Project" ede-compile-project t ])
 439     (list (vector
 440            (list
 441             (concat "Build Project " (ede-name obj))
 442             `(project-compile-project ,obj))))))
 443
 444 (cl-defmethod ede-menu-items-build ((obj ede-target) &optional current)
 445   "Return a list of menu items for building target OBJ.
 446 If optional argument CURRENT is non-nil, return sub-menu code."
 447   (if current
 448       (list [ "Build Current Target" ede-compile-target t ])
 449     (list (vector
 450            (concat "Build Target " (ede-name obj))
 451            `(project-compile-target ,obj)
 452            t))))
 453 \f
 454 ;;; Mode Declarations
 455 ;;
 456
 457 (defun ede-apply-target-options ()
 458   "Apply options to the current buffer for the active project/target."
 459   (ede-apply-project-local-variables)
 460   ;; Apply keymaps and preprocessor symbols.
 461   (ede-apply-object-keymap)
 462   (ede-apply-preprocessor-map)
 463   )
 464
 465 (defun ede-turn-on-hook ()
 466   "Turn on EDE minor mode in the current buffer if needed.
 467 To be used in hook functions."
 468   (if (or (and (stringp (buffer-file-name))
 469                (stringp default-directory))
 470           ;; Emacs 21 has no buffer file name for directory edits.
 471           ;; so we need to add these hacks in.
 472           (eq major-mode 'dired-mode)
 473           (eq major-mode 'vc-dired-mode))
 474       (ede-minor-mode 1)))
 475
 476 (define-minor-mode ede-minor-mode
 477   "Toggle EDE (Emacs Development Environment) minor mode.
 478 With a prefix argument ARG, enable EDE minor mode if ARG is
 479 positive, and disable it otherwise.  If called from Lisp, enable
 480 EDE minor mode if ARG is omitted or nil.
 481
 482 If this file is contained, or could be contained in an EDE
 483 controlled project, then this mode is activated automatically
 484 provided `global-ede-mode' is enabled."
 485   :group 'ede
 486   (cond ((or (eq major-mode 'dired-mode)
 487              (eq major-mode 'vc-dired-mode))
 488          (ede-dired-minor-mode (if ede-minor-mode 1 -1)))
 489         (ede-minor-mode
 490          (if (not ede-constructing)
 491              (ede-initialize-state-current-buffer)
 492            ;; If we fail to have a project here, turn it back off.
 493            (ede-minor-mode -1)))))
 494
 495 (defun ede-initialize-state-current-buffer ()
 496   "Initialize the current buffer's state for EDE.
 497 Sets buffer local variables for EDE."
 498   ;; due to inode recycling, make sure we don't
 499   ;; we flush projects deleted off the system.
 500   (ede-flush-deleted-projects)
 501
 502   ;; Init the buffer.
 503   (let* ((ROOT nil)
 504          (proj (ede-directory-get-open-project default-directory
 505                                                'ROOT)))
 506
 507     (when (not proj)
 508       ;; If there is no open project, look up the project
 509       ;; autoloader to see if we should initialize.
 510       (let ((projdetect (ede-directory-project-cons default-directory)))
 511
 512         (when projdetect
 513           ;; No project was loaded, but we have a project description
 514           ;; object.  This means that we try to load it.
 515           ;;
 516           ;; Before loading, we need to check if it is a safe
 517           ;; project to load before requesting it to be loaded.
 518
 519           (when (or (oref (cdr projdetect) safe-p)
 520                     ;; The project style is not safe, so check if it is
 521                     ;; in `ede-project-directories'.
 522                     (let ((top (car projdetect)))
 523                       (ede-directory-safe-p top)))
 524
 525             ;; The project is safe, so load it in.
 526             (setq proj (ede-load-project-file default-directory projdetect 'ROOT))))))
 527
 528     ;; If PROJ is now loaded in, we can initialize our buffer to it.
 529     (when proj
 530
 531       ;; ede-object represents the specific EDE related class that best
 532       ;; represents this buffer.  It could be a project (for a project file)
 533       ;; or a target.  Also save off ede-object-project, the project that
 534       ;; the buffer belongs to for the case where ede-object is a target.
 535       (setq ede-object (ede-buffer-object (current-buffer)
 536                                           'ede-object-project))
 537
 538       ;; Every project has a root.  It might be the same as ede-object.
 539       ;; Cache that also as the root is a very common thing to need.
 540       (setq ede-object-root-project
 541             (or ROOT (ede-project-root ede-object-project)))
 542
 543       ;; Check to see if we want to add this buffer to a target.
 544       (if (and (not ede-object) ede-object-project)
 545           (ede-auto-add-to-target))
 546
 547       ;; Apply any options from the found target.
 548       (ede-apply-target-options))))
 549
 550 (defun ede-reset-all-buffers ()
 551   "Reset all the buffers due to change in EDE."
 552   (interactive)
 553   (dolist (b (buffer-list))
 554     (when (buffer-file-name b)
 555       (with-current-buffer b
 556         ;; Reset all state variables
 557         (setq ede-object nil
 558               ede-object-project nil
 559               ede-object-root-project nil)
 560         ;; Now re-initialize this buffer.
 561         (ede-initialize-state-current-buffer)))))
 562
 563 ;;;###autoload
 564 (define-minor-mode global-ede-mode
 565   "Toggle global EDE (Emacs Development Environment) mode.
 566 With a prefix argument ARG, enable global EDE mode if ARG is
 567 positive, and disable it otherwise.  If called from Lisp, enable
 568 the mode if ARG is omitted or nil.
 569
 570 This global minor mode enables `ede-minor-mode' in all buffers in
 571 an EDE controlled project."
 572   :global t
 573   :group 'ede
 574   (if global-ede-mode
 575       ;; Turn on global-ede-mode
 576       (progn
 577         (if semantic-mode
 578             (define-key cedet-menu-map [cedet-menu-separator] '("--")))
 579         (add-hook 'semanticdb-project-predicate-functions 'ede-directory-project-p)
 580         (add-hook 'semanticdb-project-root-functions 'ede-toplevel-project-or-nil)
 581         (add-hook 'ecb-source-path-functions 'ede-ecb-project-paths)
 582         ;; Append our hook to the end.  This allows mode-local to finish
 583         ;; it's stuff before we start doing misc file loads, etc.
 584         (add-hook 'find-file-hook 'ede-turn-on-hook t)
 585         (add-hook 'dired-mode-hook 'ede-turn-on-hook)
 586         (add-hook 'kill-emacs-hook 'ede-save-cache)
 587         (ede-load-cache)
 588         (ede-reset-all-buffers))
 589     ;; Turn off global-ede-mode
 590     (define-key cedet-menu-map [cedet-menu-separator] nil)
 591     (remove-hook 'semanticdb-project-predicate-functions 'ede-directory-project-p)
 592     (remove-hook 'semanticdb-project-root-functions 'ede-toplevel-project-or-nil)
 593     (remove-hook 'ecb-source-path-functions 'ede-ecb-project-paths)
 594     (remove-hook 'find-file-hook 'ede-turn-on-hook)
 595     (remove-hook 'dired-mode-hook 'ede-turn-on-hook)
 596     (remove-hook 'kill-emacs-hook 'ede-save-cache)
 597     (ede-save-cache)
 598     (ede-reset-all-buffers)))
 599
 600 (defvar ede-ignored-file-alist
 601   '( "\\.cvsignore$"
 602      "\\.#"
 603      "~$"
 604      )
 605   "List of file name patters that EDE will never ask about.")
 606
 607 (defun ede-ignore-file (filename)
 608   "Should we ignore FILENAME?"
 609   (let ((any nil)
 610         (F ede-ignored-file-alist))
 611     (while (and (not any) F)
 612       (when (string-match (car F) filename)
 613         (setq any t))
 614       (setq F (cdr F)))
 615     any))
 616
 617 (defun ede-auto-add-to-target ()
 618   "Look for a target that wants to own the current file.
 619 Follow the preference set with `ede-auto-add-method' and get the list
 620 of objects with the `ede-want-file-p' method."
 621   (if ede-object (error "ede-object already defined for %s" (buffer-name)))
 622   (if (or (eq ede-auto-add-method 'never)
 623           (ede-ignore-file (buffer-file-name)))
 624       nil
 625     (let (desires)
 626       (dolist (want (oref (ede-current-project) targets));Find all the objects.
 627         (if (ede-want-file-p want (buffer-file-name))
 628             (push want desires)))
 629       (if desires
 630           (cond ((or (eq ede-auto-add-method 'ask)
 631                      (and (eq ede-auto-add-method 'multi-ask)
 632                           (< 1 (length desires))))
 633                  (let* ((al (append
 634                              ;; some defaults
 635                              '(("none" . nil)
 636                                ("new target" . new))
 637                              ;; If we are in an unparented subdir,
 638                              ;; offer new a subproject
 639                              (if (ede-directory-project-p default-directory)
 640                                  ()
 641                                '(("create subproject" . project)))
 642                              ;; Here are the existing objects we want.
 643                              (object-assoc-list 'name desires)))
 644                         (case-fold-search t)
 645                         (ans (completing-read
 646                               (format "Add %s to target: " (buffer-file-name))
 647                               al nil t)))
 648                    (setq ans (assoc ans al))
 649                    (cond ((eieio-object-p (cdr ans))
 650                           (ede-add-file (cdr ans)))
 651                          ((eq (cdr ans) 'new)
 652                           (ede-new-target))
 653                          (t nil))))
 654                 ((or (eq ede-auto-add-method 'always)
 655                      (and (eq ede-auto-add-method 'multi-ask)
 656                           (= 1 (length desires))))
 657                  (ede-add-file (car desires)))
 658                 (t nil))))))
 659
 660 \f
 661 ;;; Interactive method invocations
 662 ;;
 663 (defun ede (dir)
 664   "Start up EDE for directory DIR.
 665 If DIR has an existing project file, load it.
 666 Otherwise, create a new project for DIR."
 667   (interactive
 668    ;; When choosing a directory to turn on, and we see some directory here,
 669    ;; provide that as the default.
 670    (let* ((top (ede-toplevel-project default-directory))
 671           (promptdflt (or top default-directory)))
 672      (list (read-directory-name "Project directory: "
 673                                 promptdflt promptdflt t))))
 674   (unless (file-directory-p dir)
 675     (error "%s is not a directory" dir))
 676   (when (ede-directory-get-open-project dir)
 677     (error "%s already has an open project associated with it" dir))
 678
 679   ;; Check if the directory has been added to the list of safe
 680   ;; directories.  It can also add the directory to the safe list if
 681   ;; the user chooses.
 682   (if (ede-check-project-directory dir)
 683       (progn
 684         ;; Load the project in DIR, or make one.
 685         ;; @TODO - IS THIS REAL?
 686         (ede-load-project-file dir)
 687
 688         ;; Check if we loaded anything on the previous line.
 689         (if (ede-current-project dir)
 690
 691             ;; We successfully opened an existing project.  Some open
 692             ;; buffers may also be referring to this project.
 693             ;; Resetting all the buffers will get them to also point
 694             ;; at this new open project.
 695             (ede-reset-all-buffers)
 696
 697           ;; ELSE
 698           ;; There was no project, so switch to `ede-new' which is how
 699           ;; a user can select a new kind of project to create.
 700           (let ((default-directory (expand-file-name dir)))
 701             (call-interactively 'ede-new))))
 702
 703     ;; If the proposed directory isn't safe, then say so.
 704     (error "%s is not an allowed project directory in `ede-project-directories'"
 705            dir)))
 706
 707 (defvar ede-check-project-query-fcn 'y-or-n-p
 708   "Function used to ask the user if they want to permit a project to load.
 709 This is abstracted out so that tests can answer this question.")
 710
 711 (defun ede-check-project-directory (dir)
 712   "Check if DIR should be in `ede-project-directories'.
 713 If it is not, try asking the user if it should be added; if so,
 714 add it and save `ede-project-directories' via Customize.
 715 Return nil if DIR should not be in `ede-project-directories'."
 716   (setq dir (directory-file-name (expand-file-name dir))) ; strip trailing /
 717   (or (eq ede-project-directories t)
 718       (and (functionp ede-project-directories)
 719            (funcall ede-project-directories dir))
 720       ;; If `ede-project-directories' is a list, maybe add it.
 721       (when (listp ede-project-directories)
 722         (or (member dir ede-project-directories)
 723             (when (funcall ede-check-project-query-fcn
 724                            (format-message
 725                             "`%s' is not listed in `ede-project-directories'.
 726 Add it to the list of allowed project directories? "
 727                             dir))
 728               (push dir ede-project-directories)
 729               ;; If possible, save `ede-project-directories'.
 730               (if (or custom-file user-init-file)
 731                   (let ((coding-system-for-read nil))
 732                     (customize-save-variable
 733                      'ede-project-directories
 734                      ede-project-directories)))
 735               t)))))
 736
 737 (defun ede-new (type &optional name)
 738   "Create a new project starting from project type TYPE.
 739 Optional argument NAME is the name to give this project."
 740   (interactive
 741    (list (completing-read "Project Type: "
 742                           (object-assoc-list
 743                            'name
 744                            (let* ((l ede-project-class-files)
 745                                   (cp (ede-current-project))
 746                                   (cs (when cp (eieio-object-class cp)))
 747                                   (r nil))
 748                              (while l
 749                                (if cs
 750                                    (if (eq (oref (car l) class-sym)
 751                                            cs)
 752                                        (setq r (cons (car l) r)))
 753                                  (if (oref (car l) new-p)
 754                                      (setq r (cons (car l) r))))
 755                                (setq l (cdr l)))
 756                              (when (not r)
 757                                (if cs
 758                                    (error "No valid interactive sub project types for %s"
 759                                           cs)
 760                                  (error "EDE error: Can't find project types to create")))
 761                              r)
 762                            )
 763                           nil t)))
 764   (require 'ede/custom)
 765   ;; Make sure we have a valid directory
 766   (when (not (file-exists-p default-directory))
 767     (error "Cannot create project in non-existent directory %s" default-directory))
 768   (when (not (file-writable-p default-directory))
 769     (error "No write permissions for %s" default-directory))
 770   (unless (ede-check-project-directory default-directory)
 771     (error "%s is not an allowed project directory in `ede-project-directories'"
 772            default-directory))
 773   ;; Make sure the project directory is loadable in the future.
 774   (ede-check-project-directory default-directory)
 775   ;; Create the project
 776   (let* ((obj (object-assoc type 'name ede-project-class-files))
 777          (nobj (let ((f (oref obj file))
 778                      (pf (oref obj proj-file)))
 779                  ;; We are about to make something new, changing the
 780                  ;; state of existing directories.
 781                  (ede-project-directory-remove-hash default-directory)
 782                  ;; Make sure this class gets loaded!
 783                  (require f)
 784                  (make-instance (oref obj class-sym)
 785                                 :name (or name (read-string "Name: "))
 786                                 :directory default-directory
 787                                 :file (cond ((stringp pf)
 788                                              (expand-file-name pf))
 789                                             ((fboundp pf)
 790                                              (funcall pf))
 791                                             (t
 792                                              (error
 793                                               "Unknown file name specifier %S"
 794                                               pf)))
 795                                 :targets nil)
 796
 797                  ))
 798          (inits (oref obj initializers)))
 799     ;; Force the name to match for new objects.
 800     (eieio-object-set-name-string nobj (oref nobj name))
 801     ;; Handle init args.
 802     (while inits
 803       (eieio-oset nobj (car inits) (car (cdr inits)))
 804       (setq inits (cdr (cdr inits))))
 805     (let ((pp (ede-parent-project)))
 806       (when pp
 807         (ede-add-subproject pp nobj)
 808         (ede-commit-project pp)))
 809     (ede-commit-project nobj))
 810   ;; Once the project is created, load it again.  This used to happen
 811   ;; lazily, but with project loading occurring less often and with
 812   ;; security in mind, this is now the safe time to reload.
 813   (ede-load-project-file default-directory)
 814   ;; Have the menu appear
 815   (setq ede-minor-mode t)
 816   ;; Allert the user
 817   (message "Project created and saved.  You may now create targets."))
 818
 819 (cl-defmethod ede-add-subproject ((proj-a ede-project) proj-b)
 820   "Add into PROJ-A, the subproject PROJ-B."
 821   (oset proj-a subproj (cons proj-b (oref proj-a subproj))))
 822
 823 (defun ede-invoke-method (sym &rest args)
 824   "Invoke method SYM on the current buffer's project object.
 825 ARGS are additional arguments to pass to method SYM."
 826   (if (not ede-object)
 827       (error "Cannot invoke %s for %s" (symbol-name sym)
 828              (buffer-name)))
 829   ;; Always query a target.  There should never be multiple
 830   ;; projects in a single buffer.
 831   (apply sym (ede-singular-object "Target: ") args))
 832
 833 (defun ede-rescan-toplevel ()
 834   "Rescan all project files."
 835   (interactive)
 836   (when (not (ede-toplevel))
 837     ;; This directory isn't open.  Can't rescan.
 838     (error "Attempt to rescan a project that isn't open"))
 839
 840   ;; Continue
 841   (let ((root (ede-toplevel))
 842         (ede-deep-rescan t))
 843
 844     (project-rescan root)
 845     (ede-reset-all-buffers)
 846     ))
 847
 848 (defun ede-new-target (&rest args)
 849   "Create a new target specific to this type of project file.
 850 Different projects accept different arguments ARGS.
 851 Typically you can specify NAME, target TYPE, and AUTOADD, where AUTOADD is
 852 a string \"y\" or \"n\", which answers the y/n question done interactively."
 853   (interactive)
 854   (apply #'project-new-target (ede-current-project) args)
 855   (when (and buffer-file-name
 856              (not (file-directory-p buffer-file-name)))
 857     (setq ede-object nil)
 858     (setq ede-object (ede-buffer-object (current-buffer)))
 859     (ede-apply-target-options)))
 860
 861 (defun ede-new-target-custom ()
 862   "Create a new target specific to this type of project file."
 863   (interactive)
 864   (project-new-target-custom (ede-current-project)))
 865
 866 (defun ede-delete-target (target)
 867   "Delete TARGET from the current project."
 868   (interactive (list
 869                 (let ((ede-object (ede-current-project)))
 870                   (ede-invoke-method 'project-interactive-select-target
 871                                      "Target: "))))
 872   ;; Find all sources in buffers associated with the condemned buffer.
 873   (let ((condemned (ede-target-buffers target)))
 874     (project-delete-target target)
 875     ;; Loop over all project controlled buffers
 876     (save-excursion
 877       (while condemned
 878         (set-buffer (car condemned))
 879         (setq ede-object nil)
 880         (setq ede-object (ede-buffer-object (current-buffer)))
 881         (setq condemned (cdr condemned))))
 882     (ede-apply-target-options)))
 883
 884 (defun ede-add-file (target)
 885   "Add the current buffer to a TARGET in the current project."
 886   (interactive (list
 887                 (let ((ede-object (ede-current-project)))
 888                   (ede-invoke-method 'project-interactive-select-target
 889                                      "Target: "))))
 890   (when (stringp target)
 891     (let* ((proj (ede-current-project))
 892            (ob (object-assoc-list 'name (oref proj targets))))
 893       (setq target (cdr (assoc target ob)))))
 894
 895   (when (not target)
 896     (error "Could not find specified target %S" target))
 897
 898   (project-add-file target (buffer-file-name))
 899   (setq ede-object nil)
 900
 901   ;; Setup buffer local variables.
 902   (ede-initialize-state-current-buffer)
 903
 904   (when (not ede-object)
 905     (error "Can't add %s to target %s: Wrong file type"
 906            (file-name-nondirectory (buffer-file-name))
 907            (eieio-object-name target)))
 908   (ede-apply-target-options))
 909
 910 (defun ede-remove-file (&optional force)
 911   "Remove the current file from targets.
 912 Optional argument FORCE forces the file to be removed without asking."
 913   (interactive "P")
 914   (if (not ede-object)
 915       (error "Cannot invoke remove-file for %s" (buffer-name)))
 916   (let ((eo (if (listp ede-object)
 917                 (prog1
 918                     ede-object
 919                   (setq force nil))
 920               (list ede-object))))
 921     (while eo
 922       (if (or force (y-or-n-p (format "Remove from %s? " (ede-name (car eo)))))
 923           (project-remove-file (car eo) (buffer-file-name)))
 924       (setq eo (cdr eo)))
 925     (setq ede-object nil)
 926     (setq ede-object (ede-buffer-object (current-buffer)))
 927     (ede-apply-target-options)))
 928
 929 (defun ede-edit-file-target ()
 930   "Enter the project file to hand edit the current buffer's target."
 931   (interactive)
 932   (ede-invoke-method 'project-edit-file-target))
 933
 934 ;;; Compilation / Debug / Run
 935 ;;
 936 (defun ede-compile-project ()
 937   "Compile the current project."
 938   (interactive)
 939   ;; @TODO - This just wants the root.  There should be a better way.
 940   (let ((cp (ede-current-project)))
 941     (while (ede-parent-project cp)
 942       (setq cp (ede-parent-project cp)))
 943     (let ((ede-object cp))
 944       (ede-invoke-method 'project-compile-project))))
 945
 946 (defun ede-compile-selected (target)
 947   "Compile some TARGET from the current project."
 948   (interactive (list (project-interactive-select-target (ede-current-project)
 949                                                         "Target to Build: ")))
 950   (project-compile-target target))
 951
 952 (defun ede-compile-target ()
 953   "Compile the current buffer's associated target."
 954   (interactive)
 955   (ede-invoke-method 'project-compile-target))
 956
 957 (defun ede-debug-target ()
 958   "Debug the current buffer's associated target."
 959   (interactive)
 960   (ede-invoke-method 'project-debug-target))
 961
 962 (defun ede-run-target ()
 963   "Run the current buffer's associated target."
 964   (interactive)
 965   (ede-invoke-method 'project-run-target))
 966
 967 (defun ede-make-dist ()
 968   "Create a distribution from the current project."
 969   (interactive)
 970   (let ((ede-object (ede-toplevel)))
 971     (ede-invoke-method 'project-make-dist)))
 972
 973 \f
 974 ;;; EDE project target baseline methods.
 975 ;;
 976 ;;  If you are developing a new project type, you need to implement
 977 ;;  all of these methods, unless, of course, they do not make sense
 978 ;;  for your particular project.
 979 ;;
 980 ;;  Your targets should inherit from `ede-target', and your project
 981 ;;  files should inherit from `ede-project'.  Create the appropriate
 982 ;;  methods based on those below.
 983
 984 (cl-defmethod project-interactive-select-target ((this ede-project-placeholder) prompt)
 985                                         ; checkdoc-params: (prompt)
 986   "Make sure placeholder THIS is replaced with the real thing, and pass through."
 987   (project-interactive-select-target this prompt))
 988
 989 (cl-defmethod project-interactive-select-target ((this ede-project) prompt)
 990   "Interactively query for a target that exists in project THIS.
 991 Argument PROMPT is the prompt to use when querying the user for a target."
 992   (let ((ob (object-assoc-list 'name (oref this targets))))
 993     (cdr (assoc (completing-read prompt ob nil t) ob))))
 994
 995 (cl-defmethod project-add-file ((this ede-project-placeholder) file)
 996                                         ; checkdoc-params: (file)
 997   "Make sure placeholder THIS is replaced with the real thing, and pass through."
 998   (project-add-file this file))
 999
1000 (cl-defmethod project-add-file ((ot ede-target) _file)
1001   "Add the current buffer into project project target OT.
1002 Argument FILE is the file to add."
1003   (error "add-file not supported by %s" (eieio-object-name ot)))
1004
1005 (cl-defmethod project-remove-file ((ot ede-target) _fnnd)
1006   "Remove the current buffer from project target OT.
1007 Argument FNND is an argument."
1008   (error "remove-file not supported by %s" (eieio-object-name ot)))
1009
1010 (cl-defmethod project-edit-file-target ((_ot ede-target))
1011   "Edit the target OT associated with this file."
1012   (find-file (oref (ede-current-project) file)))
1013
1014 (cl-defmethod project-new-target ((proj ede-project) &rest _args)
1015   "Create a new target.  It is up to the project PROJ to get the name."
1016   (error "new-target not supported by %s" (eieio-object-name proj)))
1017
1018 (cl-defmethod project-new-target-custom ((proj ede-project))
1019   "Create a new target.  It is up to the project PROJ to get the name."
1020   (error "New-target-custom not supported by %s" (eieio-object-name proj)))
1021
1022 (cl-defmethod project-delete-target ((ot ede-target))
1023   "Delete the current target OT from its parent project."
1024   (error "add-file not supported by %s" (eieio-object-name ot)))
1025
1026 (cl-defmethod project-compile-project ((obj ede-project) &optional _command)
1027   "Compile the entire current project OBJ.
1028 Argument COMMAND is the command to use when compiling."
1029   (error "compile-project not supported by %s" (eieio-object-name obj)))
1030
1031 (cl-defmethod project-compile-target ((obj ede-target) &optional _command)
1032   "Compile the current target OBJ.
1033 Argument COMMAND is the command to use for compiling the target."
1034   (error "compile-target not supported by %s" (eieio-object-name obj)))
1035
1036 (cl-defmethod project-debug-target ((obj ede-target))
1037   "Run the current project target OBJ in a debugger."
1038   (error "debug-target not supported by %s" (eieio-object-name obj)))
1039
1040 (cl-defmethod project-run-target ((obj ede-target))
1041   "Run the current project target OBJ."
1042   (error "run-target not supported by %s" (eieio-object-name obj)))
1043
1044 (cl-defmethod project-make-dist ((this ede-project))
1045   "Build a distribution for the project based on THIS project."
1046   (error "Make-dist not supported by %s" (eieio-object-name this)))
1047
1048 (cl-defmethod project-dist-files ((this ede-project))
1049   "Return a list of files that constitute a distribution of THIS project."
1050   (error "Dist-files is not supported by %s" (eieio-object-name this)))
1051
1052 (cl-defmethod project-rescan ((this ede-project))
1053   "Rescan the EDE project THIS."
1054   (error "Rescanning a project is not supported by %s" (eieio-object-name this)))
1055
1056 (defun ede-ecb-project-paths ()
1057   "Return a list of all paths for all active EDE projects.
1058 This functions is meant for use with ECB."
1059   (let ((p ede-projects)
1060         (d nil))
1061     (while p
1062       (setq d (cons (file-name-directory (oref (car p) file))
1063                     d)
1064             p (cdr p)))
1065     d))
1066
1067 ;;; PROJECT LOADING/TRACKING
1068 ;;
1069 (defun ede-add-project-to-global-list (proj)
1070   "Add the project PROJ to the master list of projects.
1071 On success, return the added project."
1072   (when (not proj)
1073     (error "No project created to add to master list"))
1074   (when (not (eieio-object-p proj))
1075     (error "Attempt to add non-object to master project list"))
1076   (when (not (obj-of-class-p proj 'ede-project-placeholder))
1077     (error "Attempt to add a non-project to the ede projects list"))
1078   (add-to-list 'ede-projects proj)
1079   proj)
1080
1081 (defun ede-delete-project-from-global-list (proj)
1082   "Remove project PROJ from the master list of projects."
1083   (setq ede-projects (remove proj ede-projects)))
1084
1085 (defun ede-flush-deleted-projects ()
1086   "Scan the projects list for projects which no longer exist.
1087 Flush the dead projects from the project cache."
1088   (interactive)
1089   (let ((dead nil))
1090     (dolist (P ede-projects)
1091       (when (not (file-exists-p (oref P file)))
1092         (add-to-list 'dead P)))
1093     (dolist (D dead)
1094       (ede-delete-project-from-global-list D))
1095     ))
1096
1097 (defvar ede--disable-inode)             ;Defined in ede/files.el.
1098
1099 (defun ede-global-list-sanity-check ()
1100   "Perform a sanity check to make sure there are no duplicate projects."
1101   (interactive)
1102   (let ((scanned nil))
1103     (dolist (P ede-projects)
1104       (if (member (oref P directory) scanned)
1105           (error "Duplicate project (by dir) found in %s!" (oref P directory))
1106         (push (oref P directory) scanned)))
1107     (unless ede--disable-inode
1108       (setq scanned nil)
1109       (dolist (P ede-projects)
1110         (if (member (ede--project-inode P) scanned)
1111           (error "Duplicate project (by inode) found in %s!" (ede--project-inode P))
1112           (push (ede--project-inode P) scanned))))
1113     (message "EDE by directory %sis still sane." (if ede--disable-inode "" "& inode "))))
1114
1115 (defun ede-load-project-file (dir &optional detectin rootreturn)
1116   "Project file independent way to read a project in from DIR.
1117 Optional DETECTIN is an autoload cons from `ede-detect-directory-for-project'
1118 which can be passed in to save time.
1119 Optional ROOTRETURN will return the root project for DIR."
1120   ;; Don't do anything if we are in the process of
1121   ;; constructing an EDE object.
1122   ;;
1123   ;; Prevent recursion.
1124   (unless ede-constructing
1125
1126     ;; Only load if something new is going on.  Flush the dirhash.
1127     (ede-project-directory-remove-hash dir)
1128
1129     ;; Do the load
1130     ;;(message "EDE LOAD : %S" file)
1131     (let* ((path (file-name-as-directory (expand-file-name dir)))
1132            (detect (or detectin (ede-directory-project-cons path)))
1133            (autoloader nil)
1134            (toppath nil)
1135            (o nil))
1136
1137       (when detect
1138         (setq toppath (car detect))
1139         (setq autoloader (cdr detect))
1140
1141         ;; See if it's been loaded before.  Use exact matching since
1142         ;; know that 'toppath' is the root of the project.
1143         (setq o (ede-directory-get-toplevel-open-project toppath 'exact))
1144
1145         ;; If not open yet, load it.
1146         (unless o
1147           ;; NOTE: We set ede-constructing to the autoloader we are using.
1148           ;;       Some project types have one class, but many autoloaders
1149           ;;       and this is how we tell the instantiation which kind of
1150           ;;       project to make.
1151           (let ((ede-constructing autoloader))
1152
1153             ;; This is the only place `ede-auto-load-project' should be called.
1154
1155             (setq o (ede-auto-load-project autoloader toppath))))
1156
1157         ;; Return the found root project.
1158         (when rootreturn (set rootreturn o))
1159
1160         ;; The project has been found (in the global list) or loaded from
1161         ;; disk (via autoloader.)  We can now search for the project asked
1162         ;; for from DIR in the sub-list.
1163         (ede-find-subproject-for-directory o path)
1164
1165         ;; Return the project.
1166         o))))
1167
1168 ;;; PROJECT ASSOCIATIONS
1169 ;;
1170 ;; Moving between relative projects.  Associating between buffers and
1171 ;; projects.
1172 (defun ede-parent-project (&optional obj)
1173   "Return the project belonging to the parent directory.
1174 Return nil if there is no previous directory.
1175 Optional argument OBJ is an object to find the parent of."
1176   (let* ((proj (or obj ede-object-project)) ;; Current project.
1177          (root (if obj (ede-project-root obj)
1178                  ede-object-root-project)))
1179     ;; This case is a SHORTCUT if the project has defined
1180     ;; a way to calculate the project root.
1181     (if (and root proj (eq root proj))
1182         nil ;; we are at the root.
1183       ;; Else, we may have a nil proj or root.
1184       (let* ((thisdir (if obj (oref obj directory)
1185                         default-directory))
1186              (updir (ede-up-directory thisdir)))
1187         (when updir
1188           ;; If there was no root, perhaps we can derive it from
1189           ;; updir now.
1190           (let ((root (or root (ede-directory-get-toplevel-open-project updir))))
1191             (or
1192              ;; This lets us find a subproject under root based on updir.
1193              (and root
1194                   (ede-find-subproject-for-directory root updir))
1195              ;; Try the all structure based search.
1196              (ede-directory-get-open-project updir))))))))
1197
1198 (defun ede-current-project (&optional dir)
1199   "Return the current project file.
1200 If optional DIR is provided, get the project for DIR instead."
1201   ;; If it matches the current directory, do we have a pre-existing project?
1202   (let ((proj (when (and (or (not dir) (string= dir default-directory))
1203                         ede-object-project)
1204                 ede-object-project)))
1205     ;; No current project.
1206     (if proj
1207         proj
1208       (let* ((ldir (or dir default-directory)))
1209         (ede-directory-get-open-project ldir)))))
1210
1211 (defun ede-buffer-object (&optional buffer projsym)
1212   "Return the target object for BUFFER.
1213 This function clears cached values and recalculates.
1214 Optional PROJSYM is a symbol, which will be set to the project
1215 that contains the target that becomes buffer's object."
1216   (save-excursion
1217     (if (not buffer) (setq buffer (current-buffer)))
1218     (set-buffer buffer)
1219     (setq ede-object nil)
1220     (let* ((localpo (ede-current-project))
1221            (po localpo)
1222            (top (ede-toplevel po)))
1223       (if po (setq ede-object (ede-find-target po buffer)))
1224       ;; If we get nothing, go with the backup plan of slowly
1225       ;; looping upward
1226       (while (and (not ede-object) (not (eq po top)))
1227         (setq po (ede-parent-project po))
1228         (if po (setq ede-object (ede-find-target po buffer))))
1229       ;; Filter down to 1 project if there are dups.
1230       (if (= (length ede-object) 1)
1231           (setq ede-object (car ede-object)))
1232       ;; Track the project, if needed.
1233       (when (and projsym (symbolp projsym))
1234         (if ede-object
1235             ;; If we found a target, then PO is the
1236             ;; project to use.
1237             (set projsym po)
1238           ;; If there is no ede-object, then the projsym
1239           ;; is whichever part of the project is most local.
1240           (set projsym localpo))
1241         ))
1242     ;; Return our findings.
1243     ede-object))
1244
1245 (cl-defmethod ede-target-in-project-p ((proj ede-project) target)
1246   "Is PROJ the parent of TARGET?
1247 If TARGET belongs to a subproject, return that project file."
1248   (if (and (slot-boundp proj 'targets)
1249            (memq target (oref proj targets)))
1250       proj
1251     (let ((s (oref proj subproj))
1252           (ans nil))
1253       (while (and s (not ans))
1254         (setq ans (ede-target-in-project-p (car s) target))
1255         (setq s (cdr s)))
1256       ans)))
1257
1258 (defun ede-target-parent (target)
1259   "Return the project which is the parent of TARGET.
1260 It is recommended you track the project a different way as this function
1261 could become slow in time."
1262   (or ede-object-project
1263       ;; If not cached, derive it from the current directory of the target.
1264       (let ((ans nil) (projs ede-projects))
1265         (while (and (not ans) projs)
1266           (setq ans (ede-target-in-project-p (car projs) target)
1267                 projs (cdr projs)))
1268         ans)))
1269
1270 (cl-defmethod ede-find-target ((proj ede-project) buffer)
1271   "Fetch the target in PROJ belonging to BUFFER or nil."
1272   (with-current-buffer buffer
1273
1274     ;; We can do a short-ut if ede-object local variable is set.
1275     (if ede-object
1276         ;; If the buffer is already loaded with good EDE stuff, make sure the
1277         ;; saved project is the project we're looking for.
1278         (when (and ede-object-project (eq proj ede-object-project)) ede-object)
1279
1280       ;; If the variable wasn't set, then we are probably initializing the buffer.
1281       ;; In that case, search the file system.
1282       (if (ede-buffer-mine proj buffer)
1283           proj
1284         (let ((targets (oref proj targets))
1285               (f nil))
1286           (while targets
1287             (if (ede-buffer-mine (car targets) buffer)
1288                 (setq f (cons (car targets) f)))
1289             (setq targets (cdr targets)))
1290           f)))))
1291
1292 (cl-defmethod ede-target-buffer-in-sourcelist ((this ede-target) buffer source)
1293   "Return non-nil if object THIS is in BUFFER to a SOURCE list.
1294 Handles complex path issues."
1295   (member (ede-convert-path this (buffer-file-name buffer)) source))
1296
1297 (cl-defmethod ede-buffer-mine ((_this ede-project) _buffer)
1298   "Return non-nil if object THIS lays claim to the file in BUFFER."
1299   nil)
1300
1301 (cl-defmethod ede-buffer-mine ((this ede-target) buffer)
1302   "Return non-nil if object THIS lays claim to the file in BUFFER."
1303   (condition-case nil
1304       (ede-target-buffer-in-sourcelist this buffer (oref this source))
1305     ;; An error implies a bad match.
1306     (error nil)))
1307
1308 \f
1309 ;;; Project mapping
1310 ;;
1311 (defun ede-project-buffers (project)
1312   "Return a list of all active buffers controlled by PROJECT.
1313 This includes buffers controlled by a specific target of PROJECT."
1314   (let ((bl (buffer-list))
1315         (pl nil))
1316     (while bl
1317       (with-current-buffer (car bl)
1318         (when (and ede-object (ede-find-target project (car bl)))
1319           (setq pl (cons (car bl) pl))))
1320       (setq bl (cdr bl)))
1321     pl))
1322
1323 (defun ede-target-buffers (target)
1324   "Return a list of buffers that are controlled by TARGET."
1325   (let ((bl (buffer-list))
1326         (pl nil))
1327     (while bl
1328       (with-current-buffer (car bl)
1329         (if (if (listp ede-object)
1330                 (memq target ede-object)
1331               (eq ede-object target))
1332             (setq pl (cons (car bl) pl))))
1333       (setq bl (cdr bl)))
1334     pl))
1335
1336 (defun ede-buffers ()
1337   "Return a list of all buffers controlled by an EDE object."
1338   (let ((bl (buffer-list))
1339         (pl nil))
1340     (while bl
1341       (with-current-buffer (car bl)
1342         (if ede-object
1343             (setq pl (cons (car bl) pl))))
1344       (setq bl (cdr bl)))
1345     pl))
1346
1347 (defun ede-map-buffers (proc)
1348   "Execute PROC on all buffers controlled by EDE."
1349   (mapcar proc (ede-buffers)))
1350
1351 (cl-defmethod ede-map-project-buffers ((this ede-project) proc)
1352   "For THIS, execute PROC on all buffers belonging to THIS."
1353   (mapcar proc (ede-project-buffers this)))
1354
1355 (cl-defmethod ede-map-target-buffers ((this ede-target) proc)
1356   "For THIS, execute PROC on all buffers belonging to THIS."
1357   (mapcar proc (ede-target-buffers this)))
1358
1359 ;; other types of mapping
1360 (cl-defmethod ede-map-subprojects ((this ede-project) proc)
1361   "For object THIS, execute PROC on all direct subprojects.
1362 This function does not apply PROC to sub-sub projects.
1363 See also `ede-map-all-subprojects'."
1364   (mapcar proc (oref this subproj)))
1365
1366 (cl-defmethod ede-map-all-subprojects ((this ede-project) allproc)
1367   "For object THIS, execute PROC on THIS and all subprojects.
1368 This function also applies PROC to sub-sub projects.
1369 See also `ede-map-subprojects'."
1370   (apply #'append
1371          (list (funcall allproc this))
1372          (ede-map-subprojects
1373           this
1374           (lambda (sp)
1375             (ede-map-all-subprojects sp allproc))
1376           )))
1377
1378 ;; (ede-map-all-subprojects (ede-load-project-file "../semantic/") (lambda (sp) (oref sp file)))
1379
1380 (cl-defmethod ede-map-targets ((this ede-project) proc)
1381   "For object THIS, execute PROC on all targets."
1382   (mapcar proc (oref this targets)))
1383
1384 (cl-defmethod ede-map-any-target-p ((this ede-project) proc)
1385   "For project THIS, map PROC to all targets and return if any non-nil.
1386 Return the first non-nil value returned by PROC."
1387   (cl-some proc (oref this targets)))
1388
1389 \f
1390 ;;; Some language specific methods.
1391 ;;
1392 ;; These items are needed by ede-cpp-root to add better support for
1393 ;; configuring items for Semantic.
1394
1395 ;; Generic paths
1396 (cl-defmethod ede-system-include-path ((_this ede-project))
1397   "Get the system include path used by project THIS."
1398   nil)
1399
1400 (cl-defmethod ede-system-include-path ((_this ede-target))
1401   "Get the system include path used by project THIS."
1402   nil)
1403
1404 (cl-defmethod ede-source-paths ((_this ede-project) _mode)
1405   "Get the base to all source trees in the current project for MODE.
1406 For example, <root>/src for sources of c/c++, Java, etc,
1407 and <root>/doc for doc sources."
1408   nil)
1409
1410 ;; C/C++
1411 (defun ede-apply-preprocessor-map ()
1412   "Apply preprocessor tables onto the current buffer."
1413   ;; TODO - what if semantic-mode isn't enabled?
1414   ;; what if we never want to load a C mode? Does this matter?
1415   ;; Note: This require is needed for the case where EDE ends up
1416   ;; in the hook order before Semantic based hooks.
1417   (require 'semantic/lex-spp)
1418   (when (and ede-object
1419              (boundp 'semantic-lex-spp-project-macro-symbol-obarray))
1420     (let* ((objs ede-object)
1421            (map (ede-preprocessor-map (if (consp objs)
1422                                           (car objs)
1423                                         objs))))
1424       (when map
1425         ;; We can't do a require for the below symbol.
1426         (setq semantic-lex-spp-project-macro-symbol-obarray
1427               (semantic-lex-make-spp-table map)))
1428       (when (consp objs)
1429         (message "Choosing preprocessor syms for project %s"
1430                  (eieio-object-name (car objs)))))))
1431
1432 (cl-defmethod ede-system-include-path ((_this ede-project))
1433   "Get the system include path used by project THIS."
1434   nil)
1435
1436 (cl-defmethod ede-preprocessor-map ((_this ede-project))
1437   "Get the pre-processor map for project THIS."
1438   nil)
1439
1440 (cl-defmethod ede-preprocessor-map ((_this ede-target))
1441   "Get the pre-processor map for project THIS."
1442   nil)
1443
1444 ;; Java
1445 (cl-defmethod ede-java-classpath ((_this ede-project))
1446   "Return the classpath for this project."
1447   ;; @TODO - Can JDEE add something here?
1448   nil)
1449
1450 \f
1451 ;;; Project-local variables
1452
1453 (defun ede-set (variable value &optional proj)
1454   "Set the project local VARIABLE to VALUE.
1455 If VARIABLE is not project local, just use set.  Optional argument PROJ
1456 is the project to use, instead of `ede-current-project'."
1457   (interactive "sVariable: \nxExpression: ")
1458   (let ((p (or proj (ede-toplevel))))
1459     ;; Make the change
1460     (ede-make-project-local-variable variable p)
1461     (ede-set-project-local-variable variable value p)
1462     (ede-commit-local-variables p)
1463
1464     ;; This is a heavy hammer, but will apply variables properly
1465     ;; based on stacking between the toplevel and child projects.
1466     (ede-map-buffers 'ede-apply-project-local-variables)
1467
1468     value))
1469
1470 (defun ede-apply-project-local-variables (&optional buffer)
1471   "Apply project local variables to the current buffer."
1472   (with-current-buffer (or buffer (current-buffer))
1473     ;; Always apply toplevel variables.
1474     (if (not (eq (ede-current-project) (ede-toplevel)))
1475         (ede-set-project-variables (ede-toplevel)))
1476     ;; Next apply more local project's variables.
1477     (if (ede-current-project)
1478         (ede-set-project-variables (ede-current-project)))
1479     ))
1480
1481 (defun ede-make-project-local-variable (variable &optional project)
1482   "Make VARIABLE project-local to PROJECT."
1483   (if (not project) (setq project (ede-toplevel)))
1484   (if (assoc variable (oref project local-variables))
1485       nil
1486     (oset project local-variables (cons (list variable)
1487                                         (oref project local-variables)))))
1488
1489 (defun ede-set-project-local-variable (variable value &optional project)
1490   "Set VARIABLE to VALUE for PROJECT.
1491 If PROJ isn't specified, use the current project.
1492 This function only assigns the value within the project structure.
1493 It does not apply the value to buffers."
1494   (if (not project) (setq project (ede-toplevel)))
1495   (let ((va (assoc variable (oref project local-variables))))
1496     (unless va
1497       (error "Cannot set project variable until it is added with `ede-make-project-local-variable'"))
1498     (setcdr va value)))
1499
1500 (cl-defmethod ede-set-project-variables ((project ede-project) &optional buffer)
1501   "Set variables local to PROJECT in BUFFER."
1502   (if (not buffer) (setq buffer (current-buffer)))
1503   (with-current-buffer buffer
1504     (dolist (v (oref project local-variables))
1505       (make-local-variable (car v))
1506       (set (car v) (cdr v)))))
1507
1508 (cl-defmethod ede-commit-local-variables ((_proj ede-project))
1509   "Commit change to local variables in PROJ."
1510   nil)
1511
1512 ;;; Integration with project.el
1513
1514 (defun project-try-ede (dir)
1515   (let ((project-dir
1516          (locate-dominating-file
1517           dir
1518           (lambda (dir)
1519             (ede-directory-get-open-project dir 'ROOT)))))
1520     (when project-dir
1521       (ede-directory-get-open-project project-dir 'ROOT))))
1522
1523 (cl-defmethod project-roots ((project ede-project))
1524   (list (ede-project-root-directory project)))
1525
1526 (add-hook 'project-find-functions #'project-try-ede)
1527
1528 (provide 'ede)
1529
1530 ;; Include this last because it depends on ede.
1531 (require 'ede/files)
1532
1533 ;; If this does not occur after the provide, we can get a recursive
1534 ;; load.  Yuck!
1535 (if (featurep 'speedbar)
1536     (ede-speedbar-file-setup)
1537   (add-hook 'speedbar-load-hook 'ede-speedbar-file-setup))
1538
1539 ;;; ede.el ends here