cgit.sxemacs.org Git - packages/blob - xemacs-packages/ede/ede.el

   1 ;;; ede.el --- Emacs Development Environment gloss
   2
   3 ;;;  Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2007  Eric M. Ludlam
   4
   5 ;; Author: Eric M. Ludlam <zappo@gnu.org>
   6 ;; Keywords: project, make
   7 ;; RCS: $Id: ede.el,v 1.1 2007-11-26 15:22:12 michaels Exp $
   8 (defconst ede-version "1.0pre4"
   9   "Current version of the Emacs EDE.")
  10
  11 ;; This software 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 2, or (at your option)
  14 ;; any later version.
  15
  16 ;; This software 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; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  24 ;; Boston, MA 02110-1301, USA.
  25
  26 ;;; Commentary:
  27 ;;
  28 ;; EDE is the top level Lisp interface to a project management scheme
  29 ;; for Emacs.  Emacs does many things well, including editing,
  30 ;; building, and debugging.  Folks migrating from other IDEs don't
  31 ;; seem to thing this qualifies, however, because they still have to
  32 ;; write the makefiles, and specify parameters to programs.
  33 ;;
  34 ;; This EDE mode will attempt to link these diverse programs together
  35 ;; into a comprehensive single interface, instead of a bunch of
  36 ;; different ones.
  37
  38 ;;; Install
  39 ;;
  40 ;;  This command enables project mode on all files.
  41 ;;
  42 ;;  (global-ede-mode t)
  43
  44 (require 'ede-source)
  45
  46 ;;; Code:
  47 (defun ede-version ()
  48   "Display the current running version of EDE."
  49   (interactive) (message "EDE %s" ede-version))
  50
  51 ;; From custom web page for compatibility between versions of custom
  52 (eval-and-compile
  53   (condition-case ()
  54       (require 'custom)
  55     (error nil))
  56   (if (and (featurep 'custom) (fboundp 'custom-declare-variable)
  57            ;; Some XEmacsen w/ custom don't have :set keyword.
  58            ;; This protects them against custom.
  59            (fboundp 'custom-initialize-set))
  60       nil ;; We've got what we needed
  61     ;; We have the old custom-library, hack around it!
  62     (if (boundp 'defgroup)
  63         nil
  64       (defmacro defgroup (&rest args)
  65         nil))
  66     (if (boundp 'defcustom)
  67         nil
  68       (defmacro defcustom (var value doc &rest args)
  69         (` (defvar (, var) (, value) (, doc)))))))
  70
  71 (defgroup ede nil
  72   "Emacs Development Environment gloss."
  73   :group 'tools
  74   :group 'convenience
  75   )
  76
  77 (defcustom ede-auto-add-method 'ask
  78   "*Determins if a new source file shoud be automatically added to a target.
  79 Whenever a new file is encountered in a directory controlled by a
  80 project file, all targets are queried to see if it should be added.
  81 If the value is 'always, then the new file is added to the first
  82 target encountered.  If the value is 'multi-ask, then if more than one
  83 target wants the file, the user is asked.  If only one target wants
  84 the file, then then it is automatically added to that target.  If the
  85 value is 'ask, then the user is always asked, unless there is no
  86 target willing to take the file.  'never means never perform the check."
  87   :group 'ede
  88   :type '(choice (const always)
  89                  (const multi-ask)
  90                  (const ask)
  91                  (const never)))
  92
  93 (defcustom ede-debug-program-function 'gdb
  94   "*Default Emacs command used to debug a target."
  95   :group 'ede
  96   :type 'sexp) ; make this be a list of options some day
  97
  98 (require 'eieio)
  99 (require 'eieio-speedbar)
 100
 101 ;;; Top level classes for projects and targets
 102 ;;
 103 ;;;###autoload
 104 (defclass ede-project-autoload ()
 105   ((name :initarg :name
 106          :documentation "Name of this project type")
 107    (file :initarg :file
 108          :documentation "The lisp file belonging to this class.")
 109    (proj-file :initarg :proj-file
 110               :documentation "Name of a project file of this type.")
 111    (initializers :initarg :initializers
 112                  :initform nil
 113                  :documentation
 114                  "Initializers passed to the project object.
 115 These are used so there can be multiple types of projects
 116 associated with a single object class, based on the initilizeres used.")
 117    (load-type :initarg :load-type
 118               :documentation "Fn symbol used to load this project file.")
 119    (class-sym :initarg :class-sym
 120               :documentation "Symbol representing the project class to use.")
 121    (new-p :initarg :new-p
 122           :initform t
 123           :documentation
 124           "Non-nil if this is an option when a user creates a project.")
 125    )
 126   "Class representing minimal knowledge set to run preliminary EDE functions.
 127 When more advanced functionality is needed from a project type, that projects
 128 type is required and the load function used.")
 129
 130 (defvar ede-project-class-files
 131   (list
 132    (ede-project-autoload "edeproject-makefile"
 133                          :name "Make" :file 'ede-proj
 134                          :proj-file "Project.ede"
 135                          :load-type 'ede-proj-load
 136                          :class-sym 'ede-proj-project)
 137    (ede-project-autoload "edeproject-automake"
 138                          :name "Automake" :file 'ede-proj
 139                          :proj-file "Project.ede"
 140                          :initializers '(:makefile-type Makefile.am)
 141                          :load-type 'ede-proj-load
 142                          :class-sym 'ede-proj-project)
 143    (ede-project-autoload "automake"
 144                          :name "automake" :file 'project-am
 145                          :proj-file "Makefile.am"
 146                          :load-type 'project-am-load
 147                          :class-sym 'project-am-makefile
 148                          :new-p nil)
 149    )
 150   "List of vectos defining how to determine what type of projects exist.")
 151
 152 ;;; AUTOLOADS
 153 ;;
 154 ;; These autoloads must appear here to avoid recursive loading.
 155 ;;
 156 ;; (require 'ede-load)
 157
 158 ;;; Generic project information manager objects
 159 ;;
 160 ;;;###autoload
 161 (defclass ede-target (eieio-speedbar-directory-button)
 162   ((buttonface :initform speedbar-file-face) ;override for superclass
 163    (name :initarg :name
 164          :type string
 165          :custom string
 166          :label "Name"
 167          :group (default name)
 168          :documentation "Name of this target.")
 169    (path :initarg :path
 170          :type string
 171          ;:custom string
 172          ;:label "Path to target"
 173          ;:group (default name)
 174          :documentation "The path to the sources of this target.
 175 Relative to the path of the project it belongs to.")
 176    (source :initarg :source
 177            :initform nil
 178            ;; I'd prefer a list of strings.
 179            :type list
 180            :custom (repeat (string :tag "File"))
 181            :label "Source Files"
 182            :group (default source)
 183            :documentation "Source files in this target.")
 184    (versionsource :initarg :versionsource
 185                   :initform nil
 186                   :type list
 187                   :custom (repeat (string :tag "File"))
 188                   :label "Source Files with Version String"
 189                   :group (source)
 190                   :documentation
 191                   "Source files with a version string in them.
 192 These files are checked for a version string whenever the EDE version
 193 of the master project is changed.  When strings are found, the version
 194 previously there is updated.")
 195    ;; Class level slots
 196    ;;
 197 ;   (takes-compile-command :allocation :class
 198 ;                         :initarg :takes-compile-command
 199 ;                         :type boolean
 200 ;                         :initform nil
 201 ;                         :documentation
 202 ;     "Non-nil if this target requires a user approved command.")
 203    (sourcetype :allocation :class
 204                :type list ;; list of symbols
 205                :documentation
 206                "A list of `ede-sourcecode' objects this class will handle.
 207 This is used to match target objects with the compilers they can use, and
 208 which files this object is interested in."
 209                :accessor ede-object-sourcecode)
 210    (keybindings :allocation :class
 211                 :initform (("D" . ede-debug-target))
 212                 :documentation
 213 "Keybindings specialized to this type of target."
 214                 :accessor ede-object-keybindings)
 215    (menu :allocation :class
 216          :initform ( [ "Debug target" ede-debug-target
 217                        (and ede-object
 218                             (obj-of-class-p ede-object ede-target)) ]
 219                      )
 220          :documentation "Menu specialized to this type of target."
 221          :accessor ede-object-menu)
 222    )
 223   "A top level target to build.")
 224
 225 (defclass ede-project-placeholder (eieio-speedbar-directory-button)
 226   ((name :initarg :name
 227          :initform "Untitled"
 228          :type string
 229          :custom string
 230          :label "Name"
 231          :group (default name)
 232          :documentation "The name used when generating distribution files.")
 233    (version :initarg :version
 234             :initform "1.0"
 235             :type string
 236             :custom string
 237             :label "Version"
 238             :group (default name)
 239             :documentation "The version number used when distributing files.")
 240    (file :initarg :file
 241          :type string
 242          ;; No initarg.  We don't want this saved in a file.
 243          :documentation "File name where this project is stored."))
 244   "Placeholder object for projects not loaded into memory.
 245 Projects placeholders will be stored in a user specific location
 246 and querying them will cause the actual project to get loaded.")
 247
 248 ;;;###autoload
 249 (defclass ede-project (ede-project-placeholder)
 250   ((subproj :initform nil
 251             :type list
 252             :documentation "Sub projects controlled by this project.
 253 For Automake based projects, each directory is treated as a project.")
 254    (targets :initarg :targets
 255             :type list
 256             :custom (repeat (object :objectcreatefcn ede-new-target-custom))
 257             :label "Local Targets"
 258             :group (targets)
 259             :documentation "List of top level targets in this project.")
 260    (web-site-url :initarg :web-site-url
 261                  :initform ""
 262                  :type string
 263                  :custom string
 264                  :label "Web Site URL"
 265                  :group name
 266                  :documentation "URL to this projects web site.
 267 This is a URL to be sent to a web site for documentation.")
 268    (web-site-directory :initarg :web-site-directory
 269                        :initform ""
 270                        :custom string
 271                        :label "Web Page Directory"
 272                        :group name
 273                        :documentation
 274                        "A directory where web pages can be found by Emacs.
 275 For remote locations use a path compatible with ange-ftp or EFS.
 276 You can also use TRAMP for use with rcp & scp.")
 277    (web-site-file :initarg :web-site-file
 278                   :initform ""
 279                   :custom string
 280                   :label "Web Page File"
 281                   :group name
 282                   :documentation
 283                   "A file which contains the home page for this project.
 284 This file can be relative to slot `web-site-directory'.
 285 This can be a local file, use ange-ftp, EFS, or TRAMP.")
 286    (ftp-site :initarg :ftp-site
 287              :initform ""
 288              :type string
 289              :custom string
 290              :label "FTP site"
 291              :group name
 292              :documentation
 293              "FTP site where this project's distribution can be found.
 294 This FTP site should be in Emacs form, as needed by `ange-ftp', but can
 295 also be of a form used by TRAMP for use with scp, or rcp.")
 296    (ftp-upload-site :initarg :ftp-upload-site
 297                     :initform ""
 298                     :type string
 299                     :custom string
 300                     :label "FTP Upload site"
 301                     :group name
 302                     :documentation
 303                     "FTP Site to upload new distributions to.
 304 This FTP site should be in Emacs form as needed by `ange-ftp'.
 305 If this slot is nil, then use `ftp-site' instead.")
 306    (configurations :initarg :configurations
 307                    :initform ("debug" "release")
 308                    :type list
 309                    :custom (repeat string)
 310                    :label "Configuration Options"
 311                    :group (settings)
 312                    :documentation "List of available configuration types.
 313 Individual target/project types can form associations between a configuration,
 314 and target specific elements such as build variables.")
 315    (configuration-default :initarg :configuration-default
 316                           :initform "debug"
 317                           :custom string
 318                           :label "Current Configuration"
 319                           :group (settings)
 320                           :documentation "The default configuration.")
 321    (local-variables :initarg :local-variables
 322                     :initform nil
 323                     :custom (repeat (cons (sexp :tag "Variable")
 324                                           (sexp :tag "Value")))
 325                     :label "Project Local Variables"
 326                     :group (settings)
 327                     :documentation "Project local variables")
 328    (keybindings :allocation :class
 329                 :initform (("D" . ede-debug-target))
 330                 :documentation "Keybindings specialized to this type of target."
 331                 :accessor ede-object-keybindings)
 332    (menu :allocation :class
 333          :initform
 334          (
 335           [ "Update Version" ede-update-version ede-object ]
 336           [ "Version Control Status" ede-vc-project-directory ede-object ]
 337           [ "Edit Project Homepage" ede-edit-web-page
 338             (and ede-object (oref (ede-toplevel) web-site-file)) ]
 339           [ "Browse Project URL" ede-web-browse-home
 340             (and ede-object
 341                  (not (string= "" (oref (ede-toplevel) web-site-url)))) ]
 342           "--"
 343           [ "Rescan Project Files" ede-rescan-toplevel t ]
 344           [ "Edit Projectfile" ede-edit-file-target
 345             (and ede-object
 346                  (or (listp ede-object)
 347                      (not (obj-of-class-p ede-object ede-project)))) ]
 348           )
 349          :documentation "Menu specialized to this type of target."
 350          :accessor ede-object-menu)
 351    )
 352   "Top level EDE project specification.
 353 All specific project types must derive from this project.")
 354 \f
 355 ;;; Management variables
 356 ;;
 357 ;;;###autoload
 358 (defvar ede-projects nil
 359   "A list of all active projects currently loaded in Emacs.")
 360
 361 (defvar ede-object nil
 362   "The current buffer's target object.
 363 This object's class determines how to compile and debug from a buffer.")
 364 (make-variable-buffer-local 'ede-object)
 365
 366 (defvar ede-selected-object nil
 367   "The currently user-selected project or target.
 368 If `ede-object' is nil, then commands will operate on this object.")
 369
 370 (defvar ede-constructing nil
 371   "Non nil when constructing a project hierarchy.")
 372
 373 (defvar ede-deep-rescan nil
 374   "Non nil means scan down a tree, otherwise rescans are top level only.
 375 Do not set this to non-nil globally.  It is used internally.")
 376 \f
 377 ;;; The EDE persistent cache.
 378 ;;
 379 (defcustom ede-project-placeholder-cache-file
 380   (expand-file-name "~/.projects.ede")
 381   "*File containing the list of projects EDE has viewed."
 382   :group 'ede
 383   :type 'file)
 384
 385 (defvar ede-project-cache-files nil
 386   "List of project files EDE has seen before.")
 387
 388 (defun ede-save-cache ()
 389   "Save a cache of EDE objects that Emacs has seen before."
 390   (interactive)
 391   (let ((p ede-projects)
 392         (c ede-project-cache-files))
 393     (set-buffer (find-file-noselect ede-project-placeholder-cache-file t))
 394     (erase-buffer)
 395     (insert ";; EDE project cache file.
 396 ;; This contains a list of projects you have visited.\n(")
 397     (while p
 398       (insert "\n  \"" (oref (car p) file) "\"")
 399       (setq p (cdr p)))
 400     (while c
 401       (insert "\n \"" (car c) "\"")
 402       (setq c (cdr c)))
 403     (insert "\n)\n")
 404     (save-buffer 0)
 405     (kill-buffer (current-buffer))
 406     ))
 407
 408 (defun ede-load-cache ()
 409   "Load the cache of EDE projects."
 410   (condition-case nil
 411       (save-excursion
 412         (set-buffer (find-file-noselect ede-project-placeholder-cache-file t))
 413         (goto-char (point-min))
 414         (let ((c (read (current-buffer)))
 415               (new nil)
 416               (p ede-projects))
 417           ;; Remove loaded projects from the cache.
 418           (while p
 419             (setq c (delete (oref (car p) file) c))
 420             (setq p (cdr p)))
 421           ;; Remove projects that aren't on the filesystem
 422           ;; anymore.
 423           (while c
 424             (when (file-exists-p (car c))
 425               (setq new (cons (car c) new)))
 426             (setq c (cdr c)))
 427           ;; Save it
 428           (setq ede-project-cache-files (nreverse new))))
 429     (error nil))
 430   (if (get-file-buffer ede-project-placeholder-cache-file)
 431       (kill-buffer (get-file-buffer ede-project-placeholder-cache-file)))
 432   )
 433
 434 ;;; Get the cache usable.
 435 (add-hook 'kill-emacs-hook 'ede-save-cache)
 436 (ede-load-cache)
 437
 438 \f
 439 ;;; Important macros for doing commands.
 440 ;;
 441 (defmacro ede-with-projectfile (obj &rest forms)
 442   "For the project in which OBJ resides, execute FORMS."
 443   (list 'save-window-excursion
 444         (list 'let* (list
 445                      (list 'pf
 446                            (list 'if (list 'obj-of-class-p
 447                                            obj 'ede-target)
 448                                  (list 'ede-load-project-file
 449                                        (list 'oref obj 'path))
 450                                  obj))
 451                      '(dbka (get-file-buffer (oref pf file))))
 452               '(if (not dbka) (find-file (oref pf file))
 453                  (switch-to-buffer dbka))
 454               (cons 'progn forms)
 455               '(if (not dbka) (kill-buffer (current-buffer))))))
 456 (put 'ede-with-projectfile 'lisp-indent-function 1)
 457
 458 \f
 459 ;;; Prompting
 460 ;;
 461 (defun ede-singular-object (prompt)
 462   "Using PROMPT, choose a single object from the current buffer."
 463   (if (listp ede-object)
 464       (ede-choose-object prompt ede-object)
 465     ede-object))
 466
 467 (defun ede-choose-object (prompt list-o-o)
 468   "Using PROMPT, ask the user which OBJECT to use based on the name field.
 469 Argument LIST-O-O is the list of objects to choose from."
 470   (let* ((al (object-assoc-list 'name list-o-o))
 471          (ans (completing-read prompt al nil t)))
 472     (setq ans (assoc ans al))
 473     (cdr ans)))
 474 \f
 475 ;;; Menu and Keymap
 476 ;;
 477 ;;;###autoload
 478 (defvar ede-minor-mode nil
 479   "Non-nil in EDE controlled buffers.")
 480 (make-variable-buffer-local 'ede-minor-mode)
 481
 482 ;; We don't want to waste space.  There is a menu after all.
 483 (add-to-list 'minor-mode-alist '(ede-minor-mode ""))
 484
 485 (defvar ede-minor-keymap
 486   (let ((map (make-sparse-keymap))
 487         (pmap (make-sparse-keymap)))
 488     (define-key pmap "e" 'ede-edit-file-target)
 489     (define-key pmap "a" 'ede-add-file)
 490     (define-key pmap "d" 'ede-remove-file)
 491     (define-key pmap "t" 'ede-new-target)
 492     (define-key pmap "g" 'ede-rescan-toplevel)
 493     (define-key pmap "s" 'ede-speedbar)
 494     (define-key pmap "l" 'ede-load-project-file)
 495     (define-key pmap "C" 'ede-compile-project)
 496     (define-key pmap "c" 'ede-compile-target)
 497     (define-key pmap "\C-c" 'ede-compile-selected)
 498     (define-key pmap "D" 'ede-debug-target)
 499     ;; bind our submap into map
 500     (define-key map "\C-c." pmap)
 501     map)
 502   "Keymap used in project minor mode.")
 503
 504 (if ede-minor-keymap
 505     (progn
 506       (easy-menu-define
 507        ede-minor-menu ede-minor-keymap "Project Minor Mode Menu"
 508        '("Project"
 509          ( "Build" :filter ede-build-forms-menu )
 510          ( "Project Options" :filter ede-project-forms-menu )
 511          ( "Target Options" :filter ede-target-forms-menu )
 512          [ "Create Project" ede-new (not ede-object) ]
 513          [ "Load a project" ede t ]
 514 ;;       [ "Select Active Target" 'undefined nil ]
 515 ;;       [ "Remove Project" 'undefined nil ]
 516          "---"
 517          ( "Customize" :filter ede-customize-forms-menu )
 518          [ "View Project Tree" ede-speedbar t ]
 519          ))
 520       ))
 521
 522 ;; Allow re-insertion of a new keymap
 523 (let ((a (assoc 'ede-minor-mode minor-mode-map-alist)))
 524   (if a
 525       (setcdr a ede-minor-keymap)
 526     (add-to-list 'minor-mode-map-alist
 527                  (cons 'ede-minor-mode ede-minor-keymap))
 528     ))
 529
 530 (defun ede-menu-obj-of-class-p (class)
 531   "Return non-nil if some member of `ede-object' is a child of CLASS."
 532   (if (listp ede-object)
 533       (ede-or (mapcar (lambda (o) (obj-of-class-p o class)) ede-object))
 534     (obj-of-class-p ede-object class)))
 535
 536 (defun ede-build-forms-menu (menu-def)
 537   "Create a sub menu for building different parts of an EDE system.
 538 Argument MENU-DEF is the menu definition to use."
 539   (easy-menu-filter-return
 540    (easy-menu-create-menu
 541     "Build Forms"
 542     (let ((obj (ede-current-project))
 543           (newmenu nil) ;'([ "Build Selected..." ede-compile-selected t ]))
 544           targets
 545           targitems
 546           ede-obj
 547           (tskip nil))
 548       (if (not obj)
 549           nil
 550         (setq targets (oref obj targets)
 551               ede-obj (if (listp ede-object) ede-object (list ede-object)))
 552         ;; First, collect the build items from the project
 553         (setq newmenu (append newmenu (ede-menu-items-build obj t)))
 554         ;; Second, Declare the current target menu items
 555         (if (and ede-obj (ede-menu-obj-of-class-p ede-target))
 556             (while ede-obj
 557               (setq newmenu (append newmenu
 558                                     (ede-menu-items-build (car ede-obj) t))
 559                     tskip (car ede-obj)
 560                     ede-obj (cdr ede-obj))))
 561         ;; Third, by name, enable builds for other local targets
 562         (while targets
 563           (unless (eq tskip (car targets))
 564             (setq targitems (ede-menu-items-build (car targets) nil))
 565             (setq newmenu
 566                   (append newmenu
 567                           (if (= 1 (length targitems))
 568                               targitems
 569                             (cons (ede-name (car targets))
 570                                   targitems))))
 571             )
 572           (setq targets (cdr targets)))
 573         ;; Fourth, build sub projects.
 574         ;; -- nerp
 575         ;; Fifth, Add make distribution
 576         (append newmenu (list [ "Make distribution" ede-make-dist t ]))
 577         )))))
 578
 579 (defun ede-target-forms-menu (menu-def)
 580   "Create a target MENU-DEF based on the object belonging to this buffer."
 581   (easy-menu-filter-return
 582    (easy-menu-create-menu
 583     "Target Forms"
 584     (let ((obj (or ede-selected-object ede-object)))
 585       (append
 586        '([ "Add File" ede-add-file (ede-current-project) ]
 587          [ "Remove File" ede-remove-file
 588            (and ede-object
 589                 (or (listp ede-object)
 590                     (not (obj-of-class-p ede-object ede-project)))) ]
 591          "-")
 592        (if (not obj)
 593            nil
 594          (if (and (not (listp obj)) (oref obj menu))
 595              (oref obj menu)
 596            (when (listp obj)
 597              ;; This is bad, but I'm not sure what else to do.
 598              (oref (car obj) menu)))))))))
 599
 600 (defun ede-project-forms-menu (menu-def)
 601   "Create a target MENU-DEF based on the object belonging to this buffer."
 602   (easy-menu-filter-return
 603    (easy-menu-create-menu
 604     "Project Forms"
 605     (let* ((obj (ede-current-project))
 606            (class (if obj (object-class obj)))
 607            (menu nil))
 608       (while (and class (slot-exists-p class 'menu))
 609         (setq menu (append menu (oref class menu))
 610               class (class-parent class))
 611         (if (listp class) (setq class (car class))))
 612       (append
 613        '( [ "Add Target" ede-new-target (ede-current-project) ]
 614           [ "Remove Target" ede-delete-target ede-object ]
 615           "-")
 616        menu
 617        )))))
 618
 619 (defun ede-customize-forms-menu (menu-def)
 620   "Create a menu of the project, and targets that can be customized.
 621 Argument MENU-DEF is the definition of the current menu."
 622   (easy-menu-filter-return
 623    (easy-menu-create-menu
 624     "Customize Project"
 625     (let ((obj (ede-current-project))
 626           (targ nil))
 627       (when obj
 628         ;; Make custom menus for everything here.
 629         (append (list
 630                  (cons (concat "Project " (ede-name obj))
 631                        (eieio-customize-object-group obj)))
 632                 (mapcar (lambda (o)
 633                           (cons (concat "Target " (ede-name o))
 634                                 (eieio-customize-object-group o)))
 635                         (oref obj targets))))))))
 636
 637 (defun ede-apply-object-keymap (&optional default)
 638   "Add target specific keybindings into the local map.
 639 Optional argument DEFAULT indicates if this should be set to the default
 640 version of the keymap."
 641   (let ((object (or ede-object ede-selected-object)))
 642     (condition-case nil
 643         (let ((keys (ede-object-keybindings object)))
 644           (while keys
 645             (local-set-key (concat "\C-c." (car (car keys)))
 646                            (cdr (car keys)))
 647             (setq keys (cdr keys))))
 648       (error nil))))
 649
 650 ;;; Menu building methods for building
 651 ;;
 652 (defmethod ede-menu-items-build ((obj ede-project) &optional current)
 653   "Return a list of menu items for building project OBJ.
 654 If optional argument CURRENT is non-nil, return sub-menu code."
 655   (if current
 656       (list [ "Build Current Project" ede-compile-project t ])
 657     (list (vector
 658            (list
 659             (concat "Build Project " (ede-name obj))
 660             `(project-compile-project ,obj))))))
 661
 662 (defmethod ede-menu-items-build ((obj ede-target) &optional current)
 663   "Return a list of menu items for building target OBJ.
 664 If optional argument CURRENT is non-nil, return sub-menu code."
 665   (if current
 666       (list [ "Build Current Target" ede-compile-target t ])
 667     (list (vector
 668            (concat "Build Target " (ede-name obj))
 669            `(project-compile-target ,obj)
 670            t))))
 671 \f
 672 ;;; Mode Declarations
 673 ;;
 674 (eval-and-compile
 675   (autoload 'ede-dired-minor-mode "ede-dired" "EDE commands for dired" t))
 676
 677 (defun ede-turn-on-hook ()
 678   "Turn on EDE minor mode in the current buffer if needed.
 679 To be used in hook functions."
 680   (if (or (and (stringp (buffer-file-name))
 681                (stringp default-directory))
 682           ;; Emacs 21 has no buffer file name for directory edits.
 683           ;; so we need to add these hacks in.
 684           (eq major-mode 'dired-mode)
 685           (eq major-mode 'vc-dired-mode))
 686       (ede-minor-mode 1)))
 687
 688 (defun ede-minor-mode (&optional arg)
 689   "Project minor mode.
 690 If this file is contained, or could be contained in an EDE
 691 controlled project, then this mode should be active.
 692
 693 With argument ARG positive, turn on the mode.  Negative, turn off the
 694 mode.  nil means to toggle the mode."
 695   (interactive "P")
 696   (if (or (eq major-mode 'dired-mode)
 697           (eq major-mode 'vc-dired-mode))
 698       (ede-dired-minor-mode arg)
 699     (progn
 700       (setq ede-minor-mode
 701             (not (or (and (null arg) ede-minor-mode)
 702                      (<= (prefix-numeric-value arg) 0))))
 703       (if (and ede-minor-mode (not ede-constructing)
 704                (ede-directory-project-p default-directory))
 705           (progn
 706             (ede-load-project-file default-directory)
 707             (setq ede-object (ede-buffer-object))
 708             (if (and (not ede-object) (ede-current-project))
 709                 (ede-auto-add-to-target))
 710             (if (ede-current-project)
 711                 (ede-set-project-variables (ede-current-project)))
 712             (ede-apply-object-keymap))
 713         ;; If we fail to have a project here, turn it back off.
 714         (if (not (interactive-p))
 715             (setq ede-minor-mode nil))))))
 716
 717 (defun global-ede-mode (arg)
 718   "Turn on variable `ede-minor-mode' mode when ARG is positive.
 719 If ARG is negative, disable.  Toggle otherwise."
 720   (interactive "P")
 721   (if (not arg)
 722       (if (member 'ede-turn-on-hook find-file-hooks)
 723           (global-ede-mode -1)
 724         (global-ede-mode 1))
 725     (if (or (eq arg t) (> arg 0))
 726         (progn
 727           (add-hook 'semanticdb-project-predicate-functions 'ede-directory-project-p)
 728           (add-hook 'semanticdb-project-root-functions 'ede-toplevel-project-or-nil)
 729           (add-hook 'ecb-source-path-functions 'ede-ecb-project-paths)
 730           (add-hook 'find-file-hooks 'ede-turn-on-hook)
 731           (add-hook 'dired-mode-hook 'ede-turn-on-hook))
 732       (remove-hook 'semanticdb-project-predicate-functions 'ede-directory-project-p)
 733       (remove-hook 'semanticdb-project-root-functions 'ede-toplevel-project-or-nil)
 734       (remove-hook 'ecb-source-path-functions 'ede-ecb-project-paths)
 735       (remove-hook 'find-file-hooks 'ede-turn-on-hook)
 736       (remove-hook 'dired-mode-hook 'ede-turn-on-hook))
 737     (let ((b (buffer-list)))
 738       (while b
 739         (if (buffer-file-name (car b))
 740             (save-excursion
 741               (set-buffer (car b))
 742               (ede-minor-mode arg))
 743           (save-excursion
 744             (set-buffer (car b))
 745             (if (eq major-mode 'dired-mode)
 746                 (ede-minor-mode arg)
 747               )))
 748         (setq b (cdr b))))))
 749
 750 (defun ede-auto-add-to-target ()
 751   "Look for a target that wants to own the current file.
 752 Follow the preference set with `ede-auto-add-method' and get the list
 753 of objects with the `ede-want-file-p' method."
 754   (if ede-object (error "Ede-object already defined for %s" (buffer-name)))
 755   (if (eq ede-auto-add-method 'never)
 756       nil
 757     (let (wants desires)
 758       ;; Find all the objects.
 759       (setq wants (oref (ede-current-project) targets))
 760       (while wants
 761         (if (ede-want-file-p (car wants) (buffer-file-name))
 762             (setq desires (cons (car wants) desires)))
 763         (setq wants (cdr wants)))
 764       (if desires
 765           (cond ((or (eq ede-auto-add-method 'ask)
 766                      (and (eq ede-auto-add-method 'multi-ask)
 767                           (< 1 (length desires))))
 768                  (let* ((al (append
 769                              ;; some defaults
 770                              '(("none" . nil)
 771                                ("new target" . new))
 772                              ;; If we are in an unparented subdir,
 773                              ;; offer new a subproject
 774                              (if (ede-directory-project-p default-directory)
 775                                  ()
 776                                '(("create subproject" . project)))
 777                              ;; Here are the existing objects we want.
 778                              (object-assoc-list 'name desires)))
 779                         (case-fold-search t)
 780                         (ans (completing-read
 781                               (format "Add %s to target: " (buffer-file-name))
 782                               al nil t)))
 783                    (setq ans (assoc ans al))
 784                    (cond ((object-p (cdr ans))
 785                           (ede-add-file (cdr ans)))
 786                          ((eq (cdr ans) 'new)
 787                           (ede-new-target))
 788                          (t nil))))
 789                 ((or (eq ede-auto-add-method 'always)
 790                      (and (eq ede-auto-add-method 'multi-ask)
 791                           (= 1 (length desires))))
 792                  (ede-add-file (car desires)))
 793                 (t nil))))))
 794
 795 \f
 796 ;;; Interactive method invocations
 797 ;;
 798 (defun ede (file)
 799   "Start up EDE on something.
 800 Argument FILE is the file or directory to load a project from."
 801   (interactive "fProject File: ")
 802   (if (not (file-exists-p file))
 803       (ede-new file)
 804     (ede-load-project-file (file-name-directory file))))
 805
 806 (defun ede-new (type)
 807   "Create a new project starting of project type TYPE."
 808   (interactive
 809    (list (completing-read "Project Type: "
 810                           (object-assoc-list
 811                            'name
 812                            (let ((l ede-project-class-files)
 813                                  (r nil))
 814                              (while l
 815                                (if (oref (car l) new-p)
 816                                    (setq r (cons (car l) r)))
 817                                (setq l (cdr l)))
 818                              r)
 819                            )
 820                           nil t)))
 821   (let* ((obj (object-assoc type 'name ede-project-class-files))
 822          (nobj (let ((f (oref obj file))
 823                      (pf (oref obj proj-file)))
 824                  ;; Make sure this class gets loaded!
 825                  (require f)
 826                  (make-instance (oref obj class-sym)
 827                                 :name (read-string "Name: ")
 828                                 :file (cond ((stringp pf)
 829                                              (expand-file-name pf))
 830                                             ((fboundp pf)
 831                                              (funcall pf))
 832                                             (t
 833                                              (error
 834                                               "Unknown file name specifier %S"
 835                                               pf)))
 836                                 :targets nil)))
 837          (inits (oref obj initializers)))
 838     (while inits
 839       (eieio-oset nobj (car inits) (car (cdr inits)))
 840       (setq inits (cdr (cdr inits))))
 841     (if (ede-parent-project)
 842         (ede-add-subproject (ede-parent-project) nobj))
 843     (ede-commit-project nobj))
 844   ;; Have the menu appear
 845   (setq ede-minor-mode t)
 846   ;; Allert the user
 847   (message "Project created and saved.  You may now create targets."))
 848
 849 (defmethod ede-add-subproject ((proj-a ede-project) proj-b)
 850   "Add into PROJ-A, the subproject PROJ-B."
 851   (oset proj-a subproj (cons proj-b (oref proj-a subproj))))
 852
 853 (defmethod ede-subproject-relative-path ((proj ede-project))
 854   "Get a path name for PROJ which is relative to the parent project."
 855   (let* ((parent (ede-parent-project proj))
 856          (pdir nil)
 857          (dir (file-name-directory (oref proj file))))
 858     (if parent
 859         (file-relative-name dir (file-name-directory (oref parent file)))
 860       dir)))
 861
 862 (defmethod ede-subproject-p ((proj ede-project))
 863   "Return non-nil if PROJ is a sub project."
 864   (ede-parent-project proj))
 865
 866 (defun ede-invoke-method (sym &rest args)
 867   "Invoke method SYM on the current buffer's project object.
 868 ARGS are additional arguments to pass to method sym."
 869   (if (not ede-object)
 870       (error "Cannot invoke %s for %s" (symbol-name sym)
 871              (buffer-name)))
 872   ;; Always query a target.  There should never be multiple
 873   ;; projects in a single buffer.
 874   (apply sym (ede-singular-object "Target: ") args))
 875
 876 (defun ede-rescan-toplevel ()
 877   "Rescan all project files."
 878   (interactive)
 879   (let ((toppath (ede-toplevel-project default-directory))
 880         (ede-deep-rescan t))
 881     (project-rescan (ede-load-project-file toppath))))
 882
 883 (defun ede-new-target ()
 884   "Create a new target specific to this type of project file."
 885   (interactive)
 886   (project-new-target (ede-current-project))
 887   (setq ede-object nil)
 888   (setq ede-object (ede-buffer-object (current-buffer)))
 889   (ede-apply-object-keymap))
 890
 891 (defun ede-new-target-custom ()
 892   "Create a new target specific to this type of project file."
 893   (interactive)
 894   (project-new-target-custom (ede-current-project)))
 895
 896 (defun ede-delete-target (target)
 897   "Delete TARGET from the current project."
 898   (interactive (list
 899                 (let ((ede-object (ede-current-project)))
 900                   (ede-invoke-method 'project-interactive-select-target
 901                                      "Target: "))))
 902   ;; Find all sources in buffers associated with the condemned buffer.
 903   (let ((condemned (ede-target-buffers target)))
 904     (project-delete-target target)
 905     ;; Loop over all project controlled buffers
 906     (save-excursion
 907       (while condemned
 908         (set-buffer (car condemned))
 909         (setq ede-object nil)
 910         (setq ede-object (ede-buffer-object (current-buffer)))
 911         (setq condemned (cdr condemned))))
 912     (ede-apply-object-keymap)))
 913
 914 (defun ede-add-file (target)
 915   "Add the current buffer to a TARGET in the current project."
 916   (interactive (list
 917                 (let ((ede-object (ede-current-project)))
 918                   (ede-invoke-method 'project-interactive-select-target
 919                                      "Target: "))))
 920   (project-add-file target (buffer-file-name))
 921   (setq ede-object nil)
 922   (setq ede-object (ede-buffer-object (current-buffer)))
 923   (when (not ede-object)
 924     (error "Can't add %s to target %s: Wrong file type"
 925            (file-name-nondirectory (buffer-file-name))
 926            (object-name target)))
 927   (ede-apply-object-keymap))
 928
 929 ;;;###autoload
 930 (defun ede-remove-file (&optional force)
 931   "Remove the current file from targets.
 932 Optional argument FORCE forces the file to be removed without asking."
 933   (interactive "P")
 934   (if (not ede-object)
 935       (error "Cannot invoke remove-file for %s" (buffer-name)))
 936   (let ((eo (if (listp ede-object)
 937                 (prog1
 938                     ede-object
 939                   (setq force nil))
 940               (list ede-object))))
 941     (while eo
 942       (if (or force (y-or-n-p (format "Remove from %s? " (ede-name (car eo)))))
 943           (project-remove-file (car eo) (buffer-file-name)))
 944       (setq eo (cdr eo)))
 945     (setq ede-object nil)
 946     (setq ede-object (ede-buffer-object (current-buffer)))
 947     (ede-apply-object-keymap)))
 948
 949 (defun ede-edit-file-target ()
 950   "Enter the project file to hand edit the current buffer's target."
 951   (interactive)
 952   (ede-invoke-method 'project-edit-file-target))
 953
 954 (defun ede-compile-project ()
 955   "Compile the current project."
 956   (interactive)
 957   (let ((cp (ede-current-project)))
 958     (while (ede-parent-project cp)
 959       (setq cp (ede-parent-project cp)))
 960     (let ((ede-object cp))
 961       (ede-invoke-method 'project-compile-project))))
 962
 963 (defun ede-compile-selected (target)
 964   "Compile some TARGET from the current project."
 965   (interactive (list (project-interactive-select-target (ede-current-project)
 966                                                         "Target to Build: ")))
 967   (project-compile-target target))
 968
 969 ;;;###autoload
 970 (defun ede-compile-target ()
 971   "Compile the current buffer's associated target."
 972   (interactive)
 973   (ede-invoke-method 'project-compile-target))
 974
 975 (defun ede-debug-target ()
 976   "Debug the current buffer's assocated target."
 977   (interactive)
 978   (ede-invoke-method 'project-debug-target))
 979
 980 (defun ede-make-dist ()
 981   "Create a distribution from the current project."
 982   (interactive)
 983   (let ((ede-object (ede-current-project)))
 984     (ede-invoke-method 'project-make-dist)))
 985
 986 (eval-when-compile (require 'eieio-custom))
 987
 988 (defvar eieio-ede-old-variables nil
 989   "The old variables for a project.")
 990
 991 (defalias 'customize-project 'ede-customize-project)
 992 (defun ede-customize-project (&optional group)
 993   "Edit fields of the current project through EIEIO & Custom.
 994 Optional GROUP specifies the subgroup of slots to customize."
 995   (interactive "P")
 996   (require 'eieio-custom)
 997   (let* ((ov (oref (ede-current-project) local-variables))
 998          (cp (ede-current-project))
 999          (group (if group (eieio-read-customization-group cp))))
1000     (eieio-customize-object cp group)
1001     (make-local-variable 'eieio-ede-old-variables)
1002     (setq eieio-ede-old-variables ov)))
1003
1004 (defalias 'customize-target 'ede-customize-current-target)
1005 (defun ede-customize-current-target(&optional group)
1006   "Edit fields of the current target through EIEIO & Custom.
1007 Optional argument OBJ is the target object to customize.
1008 Optional argument GROUP is the slot group to display."
1009   (interactive "P")
1010   (require 'eieio-custom)
1011   (if (not (obj-of-class-p ede-object ede-target))
1012       (error "Current file is not part of a target."))
1013   (let ((group (if group (eieio-read-customization-group ede-object))))
1014     (ede-customize-target ede-object group)))
1015
1016 (defun ede-customize-target (obj group)
1017   "Edit fields of the current target through EIEIO & Custom.
1018 Optional argument OBJ is the target object to customize.
1019 Optional argument GROUP is the slot group to display."
1020   (require 'eieio-custom)
1021   (if (and obj (not (obj-of-class-p obj ede-target)))
1022       (error "No logical target to customize"))
1023   (eieio-customize-object obj (or group 'default)))
1024
1025 (defmethod eieio-done-customizing ((proj ede-project))
1026   "Call this when a user finishes customizing PROJ."
1027   (let ((ov eieio-ede-old-variables)
1028         (nv (oref proj local-variables)))
1029     (setq eieio-ede-old-variables nil)
1030     (while ov
1031       (if (not (assoc (car (car ov)) nv))
1032           (save-excursion
1033             (mapcar (lambda (b)
1034                       (set-buffer b)
1035                       (kill-local-variable (car (car ov))))
1036                     (ede-project-buffers proj))))
1037       (setq ov (cdr ov)))
1038     (mapcar (lambda (b) (ede-set-project-variables proj b))
1039             (ede-project-buffers proj))))
1040
1041 (defmethod eieio-done-customizing ((target ede-target))
1042   "Call this when a user finishes customizing TARGET."
1043   nil)
1044
1045 (defmethod ede-commit-project ((proj ede-project))
1046   "Commit any change to PROJ to its file."
1047   nil
1048   )
1049
1050 \f
1051 ;;; EDE project placeholder methods
1052 ;;
1053 (defmethod ede-project-force-load ((this ede-project-placeholder))
1054   "Make sure the placeholder THIS is replaced with the real thing.
1055 Return the new object created in its place."
1056   this
1057   )
1058
1059 \f
1060 ;;; EDE project target baseline methods.
1061 ;;
1062 ;;  If you are developing a new project type, you need to implement
1063 ;;  all of these methods, unless, of course, they do not make sense
1064 ;;  for your particular project.
1065 ;;
1066 ;;  Your targets should inherit from `ede-target', and your project
1067 ;;  files should inherit from `ede-project'.  Create the appropriate
1068 ;;  methods based on those below.
1069
1070 (defmethod project-interactive-select-target ((this ede-project-placeholder) prompt)
1071   ; checkdoc-params: (prompt)
1072   "Make sure placeholder THIS is replaced with the real thing, and pass through."
1073   (project-interactive-select-target (ede-project-force-load this) prompt))
1074
1075 (defmethod project-interactive-select-target ((this ede-project) prompt)
1076   "Interactivly query for a target that exists in project THIS.
1077 Argument PROMPT is the prompt to use when querying the user for a target."
1078   (let ((ob (object-assoc-list 'name (oref this targets))))
1079     (cdr (assoc (completing-read prompt ob nil t) ob))))
1080
1081 (defmethod project-add-file ((this ede-project-placeholder) file)
1082   ; checkdoc-params: (file)
1083   "Make sure placeholder THIS is replaced with the real thing, and pass through."
1084   (project-add-file (ede-project-force-load this) file))
1085
1086 (defmethod project-add-file ((ot ede-target) file)
1087   "Add the current buffer into project project target OT.
1088 Argument FILE is the file to add."
1089   (error "add-file not supported by %s" (object-name ot)))
1090
1091 (defmethod project-remove-file ((ot ede-target) fnnd)
1092   "Remove the current buffer from project target OT.
1093 Argument FNND is an argument."
1094   (error "remove-file not supported by %s" (object-name ot)))
1095
1096 ;;;###autoload
1097 (defmethod project-edit-file-target ((ot ede-target))
1098   "Edit the target OT associated w/ this file."
1099   (find-file (oref (ede-current-project) file)))
1100
1101 (defmethod project-new-target ((proj ede-project))
1102   "Create a new target.  It is up to the project PROJ to get the name."
1103   (error "new-target not supported by %s" (object-name proj)))
1104
1105 (defmethod project-new-target-custom ((proj ede-project))
1106   "Create a new target.  It is up to the project PROJ to get the name."
1107   (error "New-target-custom not supported by %s" (object-name proj)))
1108
1109 (defmethod project-delete-target ((ot ede-target))
1110   "Delete the current target OT from it's parent project."
1111   (error "add-file not supported by %s" (object-name ot)))
1112
1113 ;;;###autoload
1114 (defmethod project-compile-project ((obj ede-project) &optional command)
1115   "Compile the entire current project OBJ.
1116 Argument COMMAND is the command to use when compiling."
1117   (error "compile-project not supported by %s" (object-name obj)))
1118
1119 ;;;###autoload
1120 (defmethod project-compile-target ((obj ede-target) &optional command)
1121   "Compile the current target OBJ.
1122 Argument COMMAND is the command to use for compiling the target."
1123   (error "compile-target not supported by %s" (object-name obj)))
1124
1125 (defmethod project-debug-target ((obj ede-target))
1126   "Run the current project target OBJ in a debugger."
1127   (error "debug-target not supported by %s" (object-name obj)))
1128
1129 ;;;###autoload
1130 (defmethod project-make-dist ((this ede-project))
1131   "Build a distribution for the project based on THIS project."
1132   (error "Make-dist not supported by %s" (object-name this)))
1133
1134 (defmethod project-dist-files ((this ede-project))
1135   "Return a list of files that constitues a distribution of THIS project."
1136   (error "Dist-files is not supported by %s" (object-name this)))
1137
1138 (defmethod project-rescan ((this ede-project))
1139   "Rescan the EDE proj project THIS."
1140   (error "Rescanning a project is not supported by %s" (object-name this)))
1141 \f
1142 ;;; Default methods for EDE classes
1143 ;;
1144 ;; These are methods which you might want to override, but there is
1145 ;; no need to in most situations because they are either a) simple, or
1146 ;; b) cosmetic.
1147
1148 ;;;###autoload
1149 (defmethod ede-name ((this ede-target))
1150   "Return the name of THIS targt."
1151   (oref this name))
1152
1153 (defmethod ede-target-name ((this ede-target))
1154   "Return the name of THIS target, suitable for make or debug style commands."
1155   (oref this name))
1156
1157 (defmethod ede-name ((this ede-project))
1158   "Return a short-name for THIS project file.
1159 Do this by extracting the lowest directory name."
1160   (oref this name))
1161
1162 ;;;###autoload
1163 (defmethod ede-description ((this ede-project))
1164   "Return a description suitible for the minibuffer about THIS."
1165   (format "Project %s: %d subprojects, %d targets."
1166           (ede-name this) (length (oref this subproj))
1167           (length (oref this targets))))
1168
1169 (defmethod ede-description ((this ede-target))
1170   "Return a description suitible for the minibuffer about THIS."
1171   (format "Target %s: with %d source files."
1172           (ede-name this) (length (oref this source))))
1173
1174 (defmethod ede-convert-path ((this ede-project) path)
1175   "Convert path in a standard way for a given project.
1176 Default to making it project relative.
1177 Argument THIS is the project to convert PATH to."
1178   (let ((pp (file-name-directory (expand-file-name (oref this file))))
1179         (fp (expand-file-name path)))
1180     (if (string-match (regexp-quote pp) fp)
1181         (substring fp (match-end 0))
1182       (error "Cannot convert relativize path %s" fp))))
1183
1184 (defmethod ede-convert-path ((this ede-target) path)
1185   "Convert path in a standard way for a given project.
1186 Default to making it project relative.
1187 Argument THIS is the project to convert PATH to."
1188   (let ((proj (ede-target-parent this)))
1189     (if proj
1190         (let ((p (ede-convert-path proj path))
1191               (lp (or (oref this path) "")))
1192           ;; Our target THIS may have path information.
1193           ;; strip this out of the conversion.
1194           (if (string-match (concat "^" (regexp-quote lp)) p)
1195               (substring p (length lp))
1196             p))
1197       (error "Parentless target %s" this))))
1198
1199 (defmethod ede-want-file-p ((this ede-target) file)
1200   "Return non-nil if THIS target wants FILE."
1201   ;; By default, all targets reference the source object, and let it decide.
1202   (let ((src (ede-target-sourcecode this)))
1203     (while (and src (not (ede-want-file-p (car src) file)))
1204       (setq src (cdr src)))
1205     src))
1206
1207 (defmethod ede-want-file-source-p ((this ede-target) file)
1208   "Return non-nil if THIS target wants FILE."
1209   ;; By default, all targets reference the source object, and let it decide.
1210   (let ((src (ede-target-sourcecode this)))
1211     (while (and src (not (ede-want-file-source-p (car src) file)))
1212       (setq src (cdr src)))
1213     src))
1214
1215 (defmethod ede-expand-filename ((this ede-project) filename &optional force)
1216   "Return a fully qualified file name based on project THIS.
1217 FILENAME should be just a filename which occurs in a directory controlled
1218 by this project.
1219 Optional argument FORCE forces the default filename to be provided even if it
1220 doesn't exist."
1221   (let ((path (file-name-directory (oref this file)))
1222         (proj (oref this subproj))
1223         (found nil))
1224     (or
1225      (cond ((file-exists-p (concat path filename))
1226             (concat path filename))
1227            ((file-exists-p (concat path "include/" filename))
1228             (concat path "include/" filename))
1229            (t
1230             (while (and (not found) proj)
1231               (setq found (when (car proj)
1232                             (ede-expand-filename (car proj) filename))
1233                     proj (cdr proj)))
1234             found))
1235      (and force (concat path filename)))))
1236
1237 (defmethod ede-expand-filename ((this ede-target) filename &optional force)
1238   "Return a fully qualified file name based on target THIS.
1239 FILENAME should a a filename which occurs in a directory in which THIS works.
1240 Optional argument FORCE forces the default filename to be provided even if it
1241 doesn't exist."
1242   (ede-expand-filename (ede-target-parent this) filename force))
1243
1244 (defun ede-header-file ()
1245   "Return the header file for the current buffer.
1246 Not all buffers need headers, so return nil if no applicable."
1247   (if ede-object
1248       (ede-buffer-header-file ede-object (current-buffer))
1249     nil))
1250
1251 (defmethod ede-buffer-header-file ((this ede-project) buffer)
1252   "Return nil, projects don't have header files."
1253   nil)
1254
1255 (defmethod ede-buffer-header-file ((this ede-target) buffer)
1256   "There are no default header files in EDE.
1257 Do a quick check to see if there is a Header tag in this buffer."
1258   (save-excursion
1259     (set-buffer buffer)
1260     (if (re-search-forward "::Header:: \\([a-zA-Z0-9.]+\\)" nil t)
1261         (buffer-substring-no-properties (match-beginning 1)
1262                                         (match-end 1))
1263       (let ((src (ede-target-sourcecode this))
1264             (found nil))
1265         (while (and src (not found))
1266           (setq found (ede-buffer-header-file (car src) (buffer-file-name))
1267                 src (cdr src)))
1268         found))))
1269
1270 ;;;###autoload
1271 (defun ede-documentation-files ()
1272   "Return the documentation files for the current buffer.
1273 Not all buffers need documentations, so return nil if no applicable.
1274 Some projects may have multiple documentation files, so return a list."
1275   (if ede-object
1276       (ede-buffer-documentation-files ede-object (current-buffer))
1277     nil))
1278
1279 (defmethod ede-buffer-documentation-files ((this ede-project) buffer)
1280   "Return all documentation in project THIS based on BUFFER."
1281   ;; Find the info node.
1282   (ede-documentation this))
1283
1284 (defmethod ede-buffer-documentation-files ((this ede-target) buffer)
1285   "Check for some documenation files for THIS.
1286 Also do a quick check to see if there is a Documentation tag in this BUFFER."
1287   (save-excursion
1288     (set-buffer buffer)
1289     (if (re-search-forward "::Documentation:: \\([a-zA-Z0-9.]+\\)" nil t)
1290         (buffer-substring-no-properties (match-beginning 1)
1291                                         (match-end 1))
1292       ;; Check the master project
1293       (let ((cp (ede-toplevel)))
1294         (ede-buffer-documentation-files cp (current-buffer))))))
1295
1296 (defmethod ede-documentation ((this ede-project))
1297   "Return a list of files that provides documentation.
1298 Documentation is not for object THIS, but is provided by THIS for other
1299 files in the project."
1300   (let ((targ (oref this targets))
1301         (proj (oref this subproj))
1302         (found nil))
1303     (while targ
1304       (setq found (append (ede-documentation (car targ)) found)
1305             targ (cdr targ)))
1306     (while proj
1307       (setq found (append (ede-documentation (car proj)) found)
1308             proj (cdr proj)))
1309     found))
1310
1311 (defmethod ede-documentation ((this ede-target))
1312   "Return a list of files that provides documentation.
1313 Documentation is not for object THIS, but is provided by THIS for other
1314 files in the project."
1315   nil)
1316
1317 (defun ede-html-documentation-files ()
1318   "Return a list of HTML documentation files associated with this project."
1319   (ede-html-documentation (ede-toplevel))
1320   )
1321
1322 (defmethod ede-html-documentation ((this ede-project))
1323   "Return a list of HTML files provided by project THIS."
1324
1325   )
1326
1327 (defun ede-ecb-project-paths ()
1328   "Return a list of all paths for all active EDE projects.
1329 This functions is meant for use with ECB."
1330   (let ((p ede-projects)
1331         (d nil))
1332     (while p
1333       (setq d (cons (file-name-directory (oref (car p) file))
1334                     d)
1335             p (cdr p)))
1336     d))
1337 \f
1338 ;;; EDE project-autoload methods
1339 ;;
1340 (defmethod ede-dir-to-projectfile ((this ede-project-autoload) dir)
1341   "Return a full file name of project THIS found in DIR.
1342 Return nil if the project file does not exist."
1343   (let* ((d (file-name-as-directory dir))
1344          (pf (oref this proj-file))
1345          (f (cond ((stringp pf)
1346                    (concat d pf))
1347                   ((and (symbolp pf) (fboundp pf))
1348                    (funcall pf dir))))
1349          )
1350     (and (file-exists-p f) f)))
1351
1352 ;;; EDE basic functions
1353 ;;
1354 (defun ede-directory-project-p (dir)
1355   "Return a project description object if DIR has a project.
1356 This depends on an up to date `ede-project-class-files' variable."
1357   (let ((types ede-project-class-files)
1358         (ret nil))
1359     ;; Loop over all types, loading in the first type that we find.
1360     (while (and types (not ret))
1361       (if (ede-dir-to-projectfile (car types) dir)
1362           (progn
1363             ;; We found one!  Require it now since we will need it.
1364             (require (oref (car types) file))
1365             (setq ret (car types))))
1366       (setq types (cdr types)))
1367     ret))
1368
1369 (defun ede-up-directory (dir)
1370   "Return a path that is up one directory.
1371 Argument DIR is the directory to trim upwards."
1372   (if (string-match "^[a-zA-Z]:[\\/]$" dir)
1373       nil
1374     (let ((parent (expand-file-name ".." dir)))
1375       (if (and (> (length parent) 1) (string= ".." (substring parent -2)))
1376           nil
1377         (file-name-as-directory parent)))))
1378
1379 (defun ede-toplevel-project-or-nil (path)
1380   "Starting with PATH, find the toplevel project directory, or return nil.
1381 nil is returned if the current directory is not a part ofa project."
1382   (if (ede-directory-project-p path)
1383       (ede-toplevel-project path)
1384     nil))
1385
1386 (defun ede-toplevel-project (path)
1387   "Starting with PATH, find the toplevel project directory."
1388   (let ((toppath nil) (newpath nil))
1389     ;; Loop up to the topmost project, and then load that single
1390     ;; project, and it's sub projects.  When we are done, identify the
1391     ;; sub-project object belonging to file.
1392     (setq toppath (expand-file-name path) newpath (expand-file-name path))
1393     (while (ede-directory-project-p newpath)
1394       (setq toppath newpath newpath (ede-up-directory toppath)))
1395     toppath))
1396
1397 ;;;###autoload
1398 (defun ede-load-project-file (file)
1399   "Project file independent way to read in FILE."
1400   (let* ((path (expand-file-name (file-name-directory file)))
1401          (pfc (ede-directory-project-p path))
1402          (toppath nil)
1403          (o nil))
1404     (cond
1405      ((not pfc)
1406       ;; Scan upward for a the next project file.
1407       (let ((p path))
1408         (while (and p (not (ede-directory-project-p p)))
1409           (setq p (ede-up-directory p)))
1410         (if p (ede-load-project-file p)
1411           nil)
1412         ;; recomment as we go
1413         ;nil
1414         ))
1415      (ede-constructing
1416       nil)
1417      (t
1418       (setq toppath (ede-toplevel-project path))
1419       ;; We found the top-most directory.  Check to see if we already
1420       ;; have an object defining it's project.
1421       (setq pfc (ede-directory-project-p toppath))
1422       ;; See if it's been loaded before
1423       (setq o (object-assoc (ede-dir-to-projectfile pfc toppath) 'file
1424                             ede-projects))
1425       (if (not o)
1426           ;; If not, get it now.
1427           (let ((ede-constructing t) (afo nil))
1428             (setq o (funcall (oref pfc load-type) toppath))
1429             (setq ede-projects (cons o ede-projects))))
1430       (let (tocheck found)
1431         ;; Now find the project file belonging to FILE!
1432         (setq tocheck (list o))
1433         (setq file (ede-dir-to-projectfile pfc (expand-file-name path)))
1434         (while (and tocheck (not found))
1435           (let ((newbits nil))
1436             (when (car tocheck)
1437               (if (string= file (oref (car tocheck) file))
1438                   (setq found (car tocheck)))
1439               (setq newbits (oref (car tocheck) subproj)))
1440             (setq tocheck
1441                   (append (cdr tocheck) newbits))))
1442         (if (not found)
1443             (error "No project for %s, but passes project-p test" file))
1444         ;; Now that the file has been reset inside the project object, do
1445         ;; the cache maintenance.
1446         (setq ede-project-cache-files
1447               (delete (oref found file) ede-project-cache-files))
1448         found)))))
1449
1450 (defun ede-toplevel (&optional subproj)
1451   "Return the ede project which is the root of the current project.
1452 Optional argument SUBPROJ indicates a subproject to start from
1453 instead of the current project."
1454   (let ((cp (or subproj (ede-current-project))))
1455     (while (ede-parent-project cp)
1456       (setq cp (ede-parent-project cp)))
1457     cp))
1458
1459 ;;;###autoload
1460 (defun ede-parent-project (&optional obj)
1461   "Return the project belonging to the parent directory.
1462 nil if there is no previous directory.
1463 Optional argument OBJ is an object to find the parent of."
1464   (ede-load-project-file
1465    (concat (ede-up-directory
1466             (if obj (file-name-directory (oref obj file))
1467               default-directory))
1468            "/")))
1469
1470 (defun ede-current-project ()
1471   "Return the current project file."
1472   (ede-load-project-file default-directory))
1473
1474 (defun ede-buffer-object (&optional buffer)
1475   "Return the target object for BUFFER."
1476   (if (not buffer) (setq buffer (current-buffer)))
1477   (let ((po (ede-current-project)))
1478     (if po (setq ede-object (ede-find-target po buffer))))
1479   (if (= (length ede-object) 1)
1480       (setq ede-object (car ede-object)))
1481   ede-object)
1482
1483 (defmethod ede-target-in-project-p ((proj ede-project) target)
1484   "Is PROJ the parent of TARGET?
1485 If TARGET belongs to a subproject, return that project file."
1486   (if (member target (oref proj targets))
1487       proj
1488     (let ((s (oref proj subproj))
1489           (ans nil))
1490       (while (and s (not ans))
1491         (setq ans (ede-target-in-project-p (car s) target))
1492         (setq s (cdr s)))
1493       ans)))
1494
1495 ;;;###autoload
1496 (defun ede-target-parent (target)
1497   "Return the project which is the parent of TARGET.
1498 It is recommended you track the project a different way as this function
1499 could become slow in time."
1500   (let ((ans nil) (projs ede-projects))
1501     (while (and (not ans) projs)
1502       (setq ans (ede-target-in-project-p (car projs) target)
1503             projs (cdr projs)))
1504     ans))
1505
1506 (defun ede-maybe-checkout (&optional buffer)
1507   "Check BUFFER out of VC if necessary."
1508   (save-excursion
1509     (if buffer (set-buffer buffer))
1510     (if (and buffer-read-only vc-mode
1511              (y-or-n-p "Checkout Makefile.am from VC? "))
1512         (vc-toggle-read-only))))
1513
1514 (defmethod ede-find-target ((proj ede-project) buffer)
1515   "Fetch the target in PROJ belonging to BUFFER or nil."
1516   (save-excursion
1517     (set-buffer buffer)
1518     (or ede-object
1519         (if (ede-buffer-mine proj buffer)
1520             proj
1521           (let ((targets (oref proj targets))
1522                 (f nil))
1523             (while targets
1524               (if (ede-buffer-mine (car targets) buffer)
1525                   (setq f (cons (car targets) f)))
1526               (setq targets (cdr targets)))
1527             f)))))
1528
1529 (defmethod ede-target-buffer-in-sourcelist ((this ede-target) buffer source)
1530   "Return non-nil if object THIS is in BUFFER to a SOURCE list.
1531 Handles complex path issues."
1532   (member (ede-convert-path this (buffer-file-name buffer)) source))
1533
1534 (defmethod ede-buffer-mine ((this ede-project) buffer)
1535   "Return non-nil if object THIS lays claim to the file in BUFFER."
1536   nil)
1537
1538 (defmethod ede-buffer-mine ((this ede-target) buffer)
1539   "Return non-nil if object THIS lays claim to the file in BUFFER."
1540   (ede-target-buffer-in-sourcelist this buffer (oref this source)))
1541
1542 \f
1543 ;;; Project mapping
1544 ;;
1545 (defun ede-project-buffers (project)
1546   "Return a list of all active buffers controlled by PROJECT.
1547 This includes buffers controlled by a specific target of PROJECT."
1548   (let ((bl (buffer-list))
1549         (pl nil))
1550     (while bl
1551       (save-excursion
1552         (set-buffer (car bl))
1553         (if (and ede-object (eq (ede-current-project) project))
1554             (setq pl (cons (car bl) pl))))
1555       (setq bl (cdr bl)))
1556     pl))
1557
1558 (defun ede-target-buffers (target)
1559   "Return a list of buffers that are controlled by TARGET."
1560   (let ((bl (buffer-list))
1561         (pl nil))
1562     (while bl
1563       (save-excursion
1564         (set-buffer (car bl))
1565         (if (if (listp ede-object)
1566                 (member target ede-object)
1567               (eq ede-object target))
1568             (setq pl (cons (car bl) pl))))
1569       (setq bl (cdr bl)))
1570     pl))
1571
1572 (defun ede-buffers ()
1573   "Return a list of all buffers controled by an EDE object."
1574   (let ((bl (buffer-list))
1575         (pl nil))
1576     (while bl
1577       (save-excursion
1578         (set-buffer (car bl))
1579         (if ede-object
1580             (setq pl (cons (car bl) pl))))
1581       (setq bl (cdr bl)))
1582     pl))
1583
1584 (defun ede-map-buffers (proc)
1585   "Execute PROC on all buffers controled by EDE."
1586   (mapcar proc (ede-buffers)))
1587
1588 (defmethod ede-map-project-buffers ((this ede-project) proc)
1589   "For THIS, execute PROC on all buffers belonging to THIS."
1590   (mapcar proc (ede-project-buffers this)))
1591
1592 (defmethod ede-map-target-buffers ((this ede-target) proc)
1593   "For THIS, execute PROC on all buffers belonging to THIS."
1594   (mapcar proc (ede-target-buffers this)))
1595
1596 ;; other types of mapping
1597 (defmethod ede-map-subprojects ((this ede-project) proc)
1598   "For object THIS, execute PROC on all subprojects."
1599   (mapcar proc (oref this subproj)))
1600
1601 (defmethod ede-map-targets ((this ede-project) proc)
1602   "For object THIS, execute PROC on all targets."
1603   (mapcar proc (oref this targets)))
1604
1605 (defmethod ede-map-any-target-p ((this ede-project) proc)
1606   "For project THIS, map PROC to all targets and return if any non-nil.
1607 Return the first non-nil value returned by PROC."
1608   (ede-or (ede-map-targets this proc)))
1609
1610 \f
1611 ;;; Project-local variables
1612 ;;
1613 (defun ede-make-project-local-variable (variable &optional project)
1614   "Make VARIABLE project-local to PROJECT."
1615   (if (not project) (setq project (ede-current-project)))
1616   (if (assoc variable (oref project local-variables))
1617       nil
1618     (oset project local-variables (cons (list variable)
1619                                         (oref project local-variables)))
1620     (mapcar (lambda (b) (save-excursion
1621                           (set-buffer  b)
1622                           (make-local-variable variable)))
1623             (ede-project-buffers project))))
1624
1625 (defun ede-set-project-variables (project &optional buffer)
1626   "Set variables local to PROJECT in BUFFER."
1627   (if (not buffer) (setq buffer (current-buffer)))
1628   (save-excursion
1629    (set-buffer buffer)
1630    (mapcar (lambda (v)
1631              (make-local-variable (car v))
1632              ;; set it's value here?
1633              (set (car v) (cdr v))
1634              )
1635            (oref project local-variables))))
1636
1637 (defun ede-set (variable value)
1638   "Set the project local VARIABLE to VALUE.
1639 If VARIABLE is not project local, just use set."
1640   (let ((p (ede-current-project)) a)
1641     (if (and p (setq a (assoc variable (oref p local-variables))))
1642         (progn
1643           (setcdr a value)
1644           (mapcar (lambda (b) (save-excursion
1645                                 (set-buffer b)
1646                                 (set variable value)))
1647                   (ede-project-buffers p)))
1648       (set variable value))
1649     (ede-commit-local-variables p))
1650   value)
1651
1652 (defmethod ede-commit-local-variables ((proj ede-project))
1653   "Commit change to local variables in PROJ."
1654   nil)
1655
1656 \f
1657 ;;; Accessors for more complex types where oref is inappropriate.
1658 ;;
1659 (defmethod ede-target-sourcecode ((this ede-target))
1660   "Return the sourcecode objects which THIS permits."
1661   (let ((sc (oref this sourcetype))
1662         (rs nil))
1663     (while (and (listp sc) sc)
1664       (setq rs (cons (symbol-value (car sc)) rs)
1665             sc (cdr sc)))
1666     rs))
1667
1668 \f
1669 ;;; Lame stuff
1670 ;;
1671 (defun ede-or (arg)
1672   "Do `or' like stuff to ARG because you can't apply `or'."
1673   (while (and arg (not (car arg)))
1674     (setq arg (cdr arg)))
1675   arg)
1676
1677 \f
1678 ;;; Hooks & Autoloads
1679 ;;
1680 ;;  These let us watch various activities, and respond apropriatly.
1681
1682 (add-hook 'edebug-setup-hook
1683           (lambda ()
1684             (def-edebug-spec ede-with-projectfile
1685               (form def-body))))
1686
1687 ;; Prevent warnings w/out requiring ede-speedbar.
1688 (eval-and-compile
1689   (autoload 'ede-speedbar "ede-speedbar" "Run speedbar in EDE project mode." t)
1690   (autoload 'ede-speedbar-file-setup "ede-speedbar" "EDE in Speedbar File mode hack." t)
1691 )
1692
1693 (autoload 'ede-update-version "ede-util"
1694   "Update the version of the current project." t)
1695
1696 (autoload 'ede-vc-project-directory "ede-system" t
1697   "Run `vc-directory' on the the current project.")
1698
1699 (autoload 'ede-web-browse-home "ede-system" t
1700   "Web browse this project's home page.")
1701
1702 (autoload 'ede-edit-web-page "ede-system" t
1703   "Edit the web site for this project.")
1704
1705 (autoload 'ede-upload-distribution "ede-system" t
1706   "Upload the dist for this project to the upload site.")
1707
1708 (autoload 'ede-upload-html-documentation "ede-system" t
1709   "Upload auto-generated HTML to the web site.")
1710
1711 (provide 'ede)
1712
1713 ;; If this does not occur after the provide, we can get a recursive
1714 ;; load.  Yuck!
1715 (if (featurep 'speedbar)
1716     (ede-speedbar-file-setup)
1717   (add-hook 'speedbar-load-hook 'ede-speedbar-file-setup))
1718
1719 ;;; ede.el ends here