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