| 1 | ;;; ede.el --- Emacs Development Environment gloss |
| 2 | |
| 3 | ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, |
| 4 | ;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc. |
| 5 | |
| 6 | ;; Author: Eric M. Ludlam <zappo@gnu.org> |
| 7 | ;; Keywords: project, make |
| 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 | (load "ede/loaddefs" nil 'nomessage) |
| 47 | |
| 48 | (declare-function ede-convert-path "ede/files") |
| 49 | (declare-function ede-directory-get-open-project "ede/files") |
| 50 | (declare-function ede-directory-get-toplevel-open-project "ede/files") |
| 51 | (declare-function ede-directory-project-p "ede/files") |
| 52 | (declare-function ede-find-subproject-for-directory "ede/files") |
| 53 | (declare-function ede-project-directory-remove-hash "ede/files") |
| 54 | (declare-function ede-project-root "ede/files") |
| 55 | (declare-function ede-project-root-directory "ede/files") |
| 56 | (declare-function ede-toplevel "ede/files") |
| 57 | (declare-function ede-toplevel-project "ede/files") |
| 58 | (declare-function ede-up-directory "ede/files") |
| 59 | (declare-function data-debug-new-buffer "data-debug") |
| 60 | (declare-function data-debug-insert-object-slots "eieio-datadebug") |
| 61 | (declare-function semantic-lex-make-spp-table "semantic/lex-spp") |
| 62 | |
| 63 | (defconst ede-version "1.0pre7" |
| 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 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 | |
| 98 | ;;; Top level classes for projects and targets |
| 99 | |
| 100 | (defclass ede-project-autoload () |
| 101 | ((name :initarg :name |
| 102 | :documentation "Name of this project type") |
| 103 | (file :initarg :file |
| 104 | :documentation "The lisp file belonging to this class.") |
| 105 | (proj-file :initarg :proj-file |
| 106 | :documentation "Name of a project file of this type.") |
| 107 | (proj-root :initarg :proj-root |
| 108 | :type function |
| 109 | :documentation "A function symbol to call for the project root. |
| 110 | This function takes no arguments, and returns the current directories |
| 111 | root, if available. Leave blank to use the EDE directory walking |
| 112 | routine instead.") |
| 113 | (initializers :initarg :initializers |
| 114 | :initform nil |
| 115 | :documentation |
| 116 | "Initializers passed to the project object. |
| 117 | These are used so there can be multiple types of projects |
| 118 | associated with a single object class, based on the initilizeres used.") |
| 119 | (load-type :initarg :load-type |
| 120 | :documentation "Fn symbol used to load this project file.") |
| 121 | (class-sym :initarg :class-sym |
| 122 | :documentation "Symbol representing the project class to use.") |
| 123 | (new-p :initarg :new-p |
| 124 | :initform t |
| 125 | :documentation |
| 126 | "Non-nil if this is an option when a user creates a project.") |
| 127 | ) |
| 128 | "Class representing minimal knowledge set to run preliminary EDE functions. |
| 129 | When more advanced functionality is needed from a project type, that projects |
| 130 | type is required and the load function used.") |
| 131 | |
| 132 | (defvar ede-project-class-files |
| 133 | (list |
| 134 | (ede-project-autoload "edeproject-makefile" |
| 135 | :name "Make" :file 'ede/proj |
| 136 | :proj-file "Project.ede" |
| 137 | :load-type 'ede-proj-load |
| 138 | :class-sym 'ede-proj-project) |
| 139 | (ede-project-autoload "edeproject-automake" |
| 140 | :name "Automake" :file 'ede/proj |
| 141 | :proj-file "Project.ede" |
| 142 | :initializers '(:makefile-type Makefile.am) |
| 143 | :load-type 'ede-proj-load |
| 144 | :class-sym 'ede-proj-project) |
| 145 | (ede-project-autoload "automake" |
| 146 | :name "automake" :file 'ede/project-am |
| 147 | :proj-file "Makefile.am" |
| 148 | :load-type 'project-am-load |
| 149 | :class-sym 'project-am-makefile |
| 150 | :new-p nil) |
| 151 | (ede-project-autoload "cpp-root" |
| 152 | :name "CPP ROOT" :file 'ede/cpp-root |
| 153 | :proj-file 'ede-cpp-root-project-file-for-dir |
| 154 | :proj-root 'ede-cpp-root-project-root |
| 155 | :load-type 'ede-cpp-root-load |
| 156 | :class-sym 'ede-cpp-root |
| 157 | :new-p nil) |
| 158 | (ede-project-autoload "emacs" |
| 159 | :name "EMACS ROOT" :file 'ede/emacs |
| 160 | :proj-file "src/emacs.c" |
| 161 | :proj-root 'ede-emacs-project-root |
| 162 | :load-type 'ede-emacs-load |
| 163 | :class-sym 'ede-emacs-project |
| 164 | :new-p nil) |
| 165 | (ede-project-autoload "linux" |
| 166 | :name "LINUX ROOT" :file 'ede/linux |
| 167 | :proj-file "scripts/ver_linux" |
| 168 | :proj-root 'ede-linux-project-root |
| 169 | :load-type 'ede-linux-load |
| 170 | :class-sym 'ede-linux-project |
| 171 | :new-p nil) |
| 172 | (ede-project-autoload "simple-overlay" |
| 173 | :name "Simple" :file 'ede/simple |
| 174 | :proj-file 'ede-simple-projectfile-for-dir |
| 175 | :load-type 'ede-simple-load |
| 176 | :class-sym 'ede-simple-project)) |
| 177 | "List of vectors defining how to determine what type of projects exist.") |
| 178 | |
| 179 | ;;; Generic project information manager objects |
| 180 | |
| 181 | (defclass ede-target (eieio-speedbar-directory-button) |
| 182 | ((buttonface :initform speedbar-file-face) ;override for superclass |
| 183 | (name :initarg :name |
| 184 | :type string |
| 185 | :custom string |
| 186 | :label "Name" |
| 187 | :group (default name) |
| 188 | :documentation "Name of this target.") |
| 189 | ;; @todo - I think this should be "dir", and not "path". |
| 190 | (path :initarg :path |
| 191 | :type string |
| 192 | ;:custom string |
| 193 | ;:label "Path to target" |
| 194 | ;:group (default name) |
| 195 | :documentation "The path to the sources of this target. |
| 196 | Relative to the path of the project it belongs to.") |
| 197 | (source :initarg :source |
| 198 | :initform nil |
| 199 | ;; I'd prefer a list of strings. |
| 200 | :type list |
| 201 | :custom (repeat (string :tag "File")) |
| 202 | :label "Source Files" |
| 203 | :group (default source) |
| 204 | :documentation "Source files in this target.") |
| 205 | (versionsource :initarg :versionsource |
| 206 | :initform nil |
| 207 | :type list |
| 208 | :custom (repeat (string :tag "File")) |
| 209 | :label "Source Files with Version String" |
| 210 | :group (source) |
| 211 | :documentation |
| 212 | "Source files with a version string in them. |
| 213 | These files are checked for a version string whenever the EDE version |
| 214 | of the master project is changed. When strings are found, the version |
| 215 | previously there is updated.") |
| 216 | ;; Class level slots |
| 217 | ;; |
| 218 | ; (takes-compile-command :allocation :class |
| 219 | ; :initarg :takes-compile-command |
| 220 | ; :type boolean |
| 221 | ; :initform nil |
| 222 | ; :documentation |
| 223 | ; "Non-nil if this target requires a user approved command.") |
| 224 | (sourcetype :allocation :class |
| 225 | :type list ;; list of symbols |
| 226 | :documentation |
| 227 | "A list of `ede-sourcecode' objects this class will handle. |
| 228 | This is used to match target objects with the compilers they can use, and |
| 229 | which files this object is interested in." |
| 230 | :accessor ede-object-sourcecode) |
| 231 | (keybindings :allocation :class |
| 232 | :initform (("D" . ede-debug-target)) |
| 233 | :documentation |
| 234 | "Keybindings specialized to this type of target." |
| 235 | :accessor ede-object-keybindings) |
| 236 | (menu :allocation :class |
| 237 | :initform ( [ "Debug target" ede-debug-target |
| 238 | (and ede-object |
| 239 | (obj-of-class-p ede-object ede-target)) ] |
| 240 | ) |
| 241 | [ "Run target" ede-run-target |
| 242 | (and ede-object |
| 243 | (obj-of-class-p ede-object ede-target)) ] |
| 244 | :documentation "Menu specialized to this type of target." |
| 245 | :accessor ede-object-menu) |
| 246 | ) |
| 247 | "A top level target to build.") |
| 248 | |
| 249 | (defclass ede-project-placeholder (eieio-speedbar-directory-button) |
| 250 | ((name :initarg :name |
| 251 | :initform "Untitled" |
| 252 | :type string |
| 253 | :custom string |
| 254 | :label "Name" |
| 255 | :group (default name) |
| 256 | :documentation "The name used when generating distribution files.") |
| 257 | (version :initarg :version |
| 258 | :initform "1.0" |
| 259 | :type string |
| 260 | :custom string |
| 261 | :label "Version" |
| 262 | :group (default name) |
| 263 | :documentation "The version number used when distributing files.") |
| 264 | (directory :type string |
| 265 | :initarg :directory |
| 266 | :documentation "Directory this project is associated with.") |
| 267 | (dirinode :documentation "The inode id for :directory.") |
| 268 | (file :type string |
| 269 | :initarg :file |
| 270 | :documentation "File name where this project is stored.") |
| 271 | (rootproject ; :initarg - no initarg, don't save this slot! |
| 272 | :initform nil |
| 273 | :type (or null ede-project-placeholder-child) |
| 274 | :documentation "Pointer to our root project.") |
| 275 | ) |
| 276 | "Placeholder object for projects not loaded into memory. |
| 277 | Projects placeholders will be stored in a user specific location |
| 278 | and querying them will cause the actual project to get loaded.") |
| 279 | |
| 280 | (defclass ede-project (ede-project-placeholder) |
| 281 | ((subproj :initform nil |
| 282 | :type list |
| 283 | :documentation "Sub projects controlled by this project. |
| 284 | For Automake based projects, each directory is treated as a project.") |
| 285 | (targets :initarg :targets |
| 286 | :type list |
| 287 | :custom (repeat (object :objectcreatefcn ede-new-target-custom)) |
| 288 | :label "Local Targets" |
| 289 | :group (targets) |
| 290 | :documentation "List of top level targets in this project.") |
| 291 | (locate-obj :type (or null ede-locate-base-child) |
| 292 | :documentation |
| 293 | "A locate object to use as a backup to `ede-expand-filename'.") |
| 294 | (tool-cache :initarg :tool-cache |
| 295 | :type list |
| 296 | :custom (repeat object) |
| 297 | :label "Tool: " |
| 298 | :group tools |
| 299 | :documentation "List of tool cache configurations in this project. |
| 300 | This allows any tool to create, manage, and persist project-specific settings.") |
| 301 | (mailinglist :initarg :mailinglist |
| 302 | :initform "" |
| 303 | :type string |
| 304 | :custom string |
| 305 | :label "Mailing List Address" |
| 306 | :group name |
| 307 | :documentation |
| 308 | "An email address where users might send email for help.") |
| 309 | (web-site-url :initarg :web-site-url |
| 310 | :initform "" |
| 311 | :type string |
| 312 | :custom string |
| 313 | :label "Web Site URL" |
| 314 | :group name |
| 315 | :documentation "URL to this projects web site. |
| 316 | This is a URL to be sent to a web site for documentation.") |
| 317 | (web-site-directory :initarg :web-site-directory |
| 318 | :initform "" |
| 319 | :custom string |
| 320 | :label "Web Page Directory" |
| 321 | :group name |
| 322 | :documentation |
| 323 | "A directory where web pages can be found by Emacs. |
| 324 | For remote locations use a path compatible with ange-ftp or EFS. |
| 325 | You can also use TRAMP for use with rcp & scp.") |
| 326 | (web-site-file :initarg :web-site-file |
| 327 | :initform "" |
| 328 | :custom string |
| 329 | :label "Web Page File" |
| 330 | :group name |
| 331 | :documentation |
| 332 | "A file which contains the home page for this project. |
| 333 | This file can be relative to slot `web-site-directory'. |
| 334 | This can be a local file, use ange-ftp, EFS, or TRAMP.") |
| 335 | (ftp-site :initarg :ftp-site |
| 336 | :initform "" |
| 337 | :type string |
| 338 | :custom string |
| 339 | :label "FTP site" |
| 340 | :group name |
| 341 | :documentation |
| 342 | "FTP site where this project's distribution can be found. |
| 343 | This FTP site should be in Emacs form, as needed by `ange-ftp', but can |
| 344 | also be of a form used by TRAMP for use with scp, or rcp.") |
| 345 | (ftp-upload-site :initarg :ftp-upload-site |
| 346 | :initform "" |
| 347 | :type string |
| 348 | :custom string |
| 349 | :label "FTP Upload site" |
| 350 | :group name |
| 351 | :documentation |
| 352 | "FTP Site to upload new distributions to. |
| 353 | This FTP site should be in Emacs form as needed by `ange-ftp'. |
| 354 | If this slot is nil, then use `ftp-site' instead.") |
| 355 | (configurations :initarg :configurations |
| 356 | :initform ("debug" "release") |
| 357 | :type list |
| 358 | :custom (repeat string) |
| 359 | :label "Configuration Options" |
| 360 | :group (settings) |
| 361 | :documentation "List of available configuration types. |
| 362 | Individual target/project types can form associations between a configuration, |
| 363 | and target specific elements such as build variables.") |
| 364 | (configuration-default :initarg :configuration-default |
| 365 | :initform "debug" |
| 366 | :custom string |
| 367 | :label "Current Configuration" |
| 368 | :group (settings) |
| 369 | :documentation "The default configuration.") |
| 370 | (local-variables :initarg :local-variables |
| 371 | :initform nil |
| 372 | :custom (repeat (cons (sexp :tag "Variable") |
| 373 | (sexp :tag "Value"))) |
| 374 | :label "Project Local Variables" |
| 375 | :group (settings) |
| 376 | :documentation "Project local variables") |
| 377 | (keybindings :allocation :class |
| 378 | :initform (("D" . ede-debug-target) |
| 379 | ("R" . ede-run-target)) |
| 380 | :documentation "Keybindings specialized to this type of target." |
| 381 | :accessor ede-object-keybindings) |
| 382 | (menu :allocation :class |
| 383 | :initform |
| 384 | ( |
| 385 | [ "Update Version" ede-update-version ede-object ] |
| 386 | [ "Version Control Status" ede-vc-project-directory ede-object ] |
| 387 | [ "Edit Project Homepage" ede-edit-web-page |
| 388 | (and ede-object (oref (ede-toplevel) web-site-file)) ] |
| 389 | [ "Browse Project URL" ede-web-browse-home |
| 390 | (and ede-object |
| 391 | (not (string= "" (oref (ede-toplevel) web-site-url)))) ] |
| 392 | "--" |
| 393 | [ "Rescan Project Files" ede-rescan-toplevel t ] |
| 394 | [ "Edit Projectfile" ede-edit-file-target |
| 395 | (and ede-object |
| 396 | (or (listp ede-object) |
| 397 | (not (obj-of-class-p ede-object ede-project)))) ] |
| 398 | ) |
| 399 | :documentation "Menu specialized to this type of target." |
| 400 | :accessor ede-object-menu) |
| 401 | ) |
| 402 | "Top level EDE project specification. |
| 403 | All specific project types must derive from this project." |
| 404 | :method-invocation-order :depth-first) |
| 405 | \f |
| 406 | ;;; Management variables |
| 407 | |
| 408 | (defvar ede-projects nil |
| 409 | "A list of all active projects currently loaded in Emacs.") |
| 410 | |
| 411 | (defvar ede-object-root-project nil |
| 412 | "The current buffer's current root project. |
| 413 | If a file is under a project, this specifies the project that is at |
| 414 | the root of a project tree.") |
| 415 | (make-variable-buffer-local 'ede-object-root-project) |
| 416 | |
| 417 | (defvar ede-object-project nil |
| 418 | "The current buffer's current project at that level. |
| 419 | If a file is under a project, this specifies the project that contains the |
| 420 | current target.") |
| 421 | (make-variable-buffer-local 'ede-object-project) |
| 422 | |
| 423 | (defvar ede-object nil |
| 424 | "The current buffer's target object. |
| 425 | This object's class determines how to compile and debug from a buffer.") |
| 426 | (make-variable-buffer-local 'ede-object) |
| 427 | |
| 428 | (defvar ede-selected-object nil |
| 429 | "The currently user-selected project or target. |
| 430 | If `ede-object' is nil, then commands will operate on this object.") |
| 431 | |
| 432 | (defvar ede-constructing nil |
| 433 | "Non nil when constructing a project hierarchy.") |
| 434 | |
| 435 | (defvar ede-deep-rescan nil |
| 436 | "Non nil means scan down a tree, otherwise rescans are top level only. |
| 437 | Do not set this to non-nil globally. It is used internally.") |
| 438 | \f |
| 439 | ;;; The EDE persistent cache. |
| 440 | ;; |
| 441 | (defcustom ede-project-placeholder-cache-file |
| 442 | (locate-user-emacs-file "ede-projects.el" ".projects.ede") |
| 443 | "File containing the list of projects EDE has viewed." |
| 444 | :group 'ede |
| 445 | :type 'file) |
| 446 | |
| 447 | (defvar ede-project-cache-files nil |
| 448 | "List of project files EDE has seen before.") |
| 449 | |
| 450 | (defun ede-save-cache () |
| 451 | "Save a cache of EDE objects that Emacs has seen before." |
| 452 | (interactive) |
| 453 | (let ((p ede-projects) |
| 454 | (c ede-project-cache-files) |
| 455 | (recentf-exclude '(ignore)) |
| 456 | ) |
| 457 | (condition-case nil |
| 458 | (progn |
| 459 | (set-buffer (find-file-noselect ede-project-placeholder-cache-file t)) |
| 460 | (erase-buffer) |
| 461 | (insert ";; EDE project cache file. |
| 462 | ;; This contains a list of projects you have visited.\n(") |
| 463 | (while p |
| 464 | (when (and (car p) (ede-project-p p)) |
| 465 | (let ((f (oref (car p) file))) |
| 466 | (when (file-exists-p f) |
| 467 | (insert "\n \"" f "\"")))) |
| 468 | (setq p (cdr p))) |
| 469 | (while c |
| 470 | (insert "\n \"" (car c) "\"") |
| 471 | (setq c (cdr c))) |
| 472 | (insert "\n)\n") |
| 473 | (condition-case nil |
| 474 | (save-buffer 0) |
| 475 | (error |
| 476 | (message "File %s could not be saved." |
| 477 | ede-project-placeholder-cache-file))) |
| 478 | (kill-buffer (current-buffer)) |
| 479 | ) |
| 480 | (error |
| 481 | (message "File %s could not be read." |
| 482 | ede-project-placeholder-cache-file)) |
| 483 | |
| 484 | ))) |
| 485 | |
| 486 | (defun ede-load-cache () |
| 487 | "Load the cache of EDE projects." |
| 488 | (save-excursion |
| 489 | (let ((cachebuffer nil)) |
| 490 | (condition-case nil |
| 491 | (progn |
| 492 | (setq cachebuffer |
| 493 | (find-file-noselect ede-project-placeholder-cache-file t)) |
| 494 | (set-buffer cachebuffer) |
| 495 | (goto-char (point-min)) |
| 496 | (let ((c (read (current-buffer))) |
| 497 | (new nil) |
| 498 | (p ede-projects)) |
| 499 | ;; Remove loaded projects from the cache. |
| 500 | (while p |
| 501 | (setq c (delete (oref (car p) file) c)) |
| 502 | (setq p (cdr p))) |
| 503 | ;; Remove projects that aren't on the filesystem |
| 504 | ;; anymore. |
| 505 | (while c |
| 506 | (when (file-exists-p (car c)) |
| 507 | (setq new (cons (car c) new))) |
| 508 | (setq c (cdr c))) |
| 509 | ;; Save it |
| 510 | (setq ede-project-cache-files (nreverse new)))) |
| 511 | (error nil)) |
| 512 | (when cachebuffer (kill-buffer cachebuffer)) |
| 513 | ))) |
| 514 | \f |
| 515 | ;;; Important macros for doing commands. |
| 516 | ;; |
| 517 | (defmacro ede-with-projectfile (obj &rest forms) |
| 518 | "For the project in which OBJ resides, execute FORMS." |
| 519 | (list 'save-window-excursion |
| 520 | (list 'let* (list |
| 521 | (list 'pf |
| 522 | (list 'if (list 'obj-of-class-p |
| 523 | obj 'ede-target) |
| 524 | ;; @todo -I think I can change |
| 525 | ;; this to not need ede-load-project-file |
| 526 | ;; but I'm not sure how to test well. |
| 527 | (list 'ede-load-project-file |
| 528 | (list 'oref obj 'path)) |
| 529 | obj)) |
| 530 | '(dbka (get-file-buffer (oref pf file)))) |
| 531 | '(if (not dbka) (find-file (oref pf file)) |
| 532 | (switch-to-buffer dbka)) |
| 533 | (cons 'progn forms) |
| 534 | '(if (not dbka) (kill-buffer (current-buffer)))))) |
| 535 | (put 'ede-with-projectfile 'lisp-indent-function 1) |
| 536 | |
| 537 | \f |
| 538 | ;;; Prompting |
| 539 | ;; |
| 540 | (defun ede-singular-object (prompt) |
| 541 | "Using PROMPT, choose a single object from the current buffer." |
| 542 | (if (listp ede-object) |
| 543 | (ede-choose-object prompt ede-object) |
| 544 | ede-object)) |
| 545 | |
| 546 | (defun ede-choose-object (prompt list-o-o) |
| 547 | "Using PROMPT, ask the user which OBJECT to use based on the name field. |
| 548 | Argument LIST-O-O is the list of objects to choose from." |
| 549 | (let* ((al (object-assoc-list 'name list-o-o)) |
| 550 | (ans (completing-read prompt al nil t))) |
| 551 | (setq ans (assoc ans al)) |
| 552 | (cdr ans))) |
| 553 | \f |
| 554 | ;;; Menu and Keymap |
| 555 | |
| 556 | (defvar ede-minor-mode-map |
| 557 | (let ((map (make-sparse-keymap)) |
| 558 | (pmap (make-sparse-keymap))) |
| 559 | (define-key pmap "e" 'ede-edit-file-target) |
| 560 | (define-key pmap "a" 'ede-add-file) |
| 561 | (define-key pmap "d" 'ede-remove-file) |
| 562 | (define-key pmap "t" 'ede-new-target) |
| 563 | (define-key pmap "g" 'ede-rescan-toplevel) |
| 564 | (define-key pmap "s" 'ede-speedbar) |
| 565 | (define-key pmap "l" 'ede-load-project-file) |
| 566 | (define-key pmap "f" 'ede-find-file) |
| 567 | (define-key pmap "C" 'ede-compile-project) |
| 568 | (define-key pmap "c" 'ede-compile-target) |
| 569 | (define-key pmap "\C-c" 'ede-compile-selected) |
| 570 | (define-key pmap "D" 'ede-debug-target) |
| 571 | (define-key pmap "R" 'ede-run-target) |
| 572 | ;; bind our submap into map |
| 573 | (define-key map "\C-c." pmap) |
| 574 | map) |
| 575 | "Keymap used in project minor mode.") |
| 576 | |
| 577 | (defvar global-ede-mode-map |
| 578 | (let ((map (make-sparse-keymap))) |
| 579 | (define-key map [menu-bar cedet-menu] |
| 580 | (cons "Development" cedet-menu-map)) |
| 581 | map) |
| 582 | "Keymap used in `global-ede-mode'.") |
| 583 | |
| 584 | ;; Activate the EDE items in cedet-menu-map |
| 585 | |
| 586 | (define-key cedet-menu-map [ede-find-file] |
| 587 | '(menu-item "Find File in Project..." ede-find-file :enable ede-object |
| 588 | :visible global-ede-mode)) |
| 589 | (define-key cedet-menu-map [ede-speedbar] |
| 590 | '(menu-item "View Project Tree" ede-speedbar :enable ede-object |
| 591 | :visible global-ede-mode)) |
| 592 | (define-key cedet-menu-map [ede] |
| 593 | '(menu-item "Load Project" ede |
| 594 | :visible global-ede-mode)) |
| 595 | (define-key cedet-menu-map [ede-new] |
| 596 | '(menu-item "Create Project" ede-new |
| 597 | :enable (not ede-object) |
| 598 | :visible global-ede-mode)) |
| 599 | (define-key cedet-menu-map [ede-target-options] |
| 600 | '(menu-item "Target Options" ede-target-options |
| 601 | :filter ede-target-forms-menu |
| 602 | :visible global-ede-mode)) |
| 603 | (define-key cedet-menu-map [ede-project-options] |
| 604 | '(menu-item "Project Options" ede-project-options |
| 605 | :filter ede-project-forms-menu |
| 606 | :visible global-ede-mode)) |
| 607 | (define-key cedet-menu-map [ede-build-forms-menu] |
| 608 | '(menu-item "Build Project" ede-build-forms-menu |
| 609 | :filter ede-build-forms-menu |
| 610 | :enable ede-object |
| 611 | :visible global-ede-mode)) |
| 612 | |
| 613 | (defun ede-menu-obj-of-class-p (class) |
| 614 | "Return non-nil if some member of `ede-object' is a child of CLASS." |
| 615 | (if (listp ede-object) |
| 616 | (eval (cons 'or (mapcar (lambda (o) (obj-of-class-p o class)) ede-object))) |
| 617 | (obj-of-class-p ede-object class))) |
| 618 | |
| 619 | (defun ede-build-forms-menu (menu-def) |
| 620 | "Create a sub menu for building different parts of an EDE system. |
| 621 | Argument MENU-DEF is the menu definition to use." |
| 622 | (easy-menu-filter-return |
| 623 | (easy-menu-create-menu |
| 624 | "Build Forms" |
| 625 | (let ((obj (ede-current-project)) |
| 626 | (newmenu nil) ;'([ "Build Selected..." ede-compile-selected t ])) |
| 627 | targets |
| 628 | targitems |
| 629 | ede-obj |
| 630 | (tskip nil)) |
| 631 | (if (not obj) |
| 632 | nil |
| 633 | (setq targets (when (slot-boundp obj 'targets) |
| 634 | (oref obj targets)) |
| 635 | ede-obj (if (listp ede-object) ede-object (list ede-object))) |
| 636 | ;; First, collect the build items from the project |
| 637 | (setq newmenu (append newmenu (ede-menu-items-build obj t))) |
| 638 | ;; Second, Declare the current target menu items |
| 639 | (if (and ede-obj (ede-menu-obj-of-class-p ede-target)) |
| 640 | (while ede-obj |
| 641 | (setq newmenu (append newmenu |
| 642 | (ede-menu-items-build (car ede-obj) t)) |
| 643 | tskip (car ede-obj) |
| 644 | ede-obj (cdr ede-obj)))) |
| 645 | ;; Third, by name, enable builds for other local targets |
| 646 | (while targets |
| 647 | (unless (eq tskip (car targets)) |
| 648 | (setq targitems (ede-menu-items-build (car targets) nil)) |
| 649 | (setq newmenu |
| 650 | (append newmenu |
| 651 | (if (= 1 (length targitems)) |
| 652 | targitems |
| 653 | (cons (ede-name (car targets)) |
| 654 | targitems)))) |
| 655 | ) |
| 656 | (setq targets (cdr targets))) |
| 657 | ;; Fourth, build sub projects. |
| 658 | ;; -- nerp |
| 659 | ;; Fifth, Add make distribution |
| 660 | (append newmenu (list [ "Make distribution" ede-make-dist t ])) |
| 661 | ))))) |
| 662 | |
| 663 | (defun ede-target-forms-menu (menu-def) |
| 664 | "Create a target MENU-DEF based on the object belonging to this buffer." |
| 665 | (easy-menu-filter-return |
| 666 | (easy-menu-create-menu |
| 667 | "Target Forms" |
| 668 | (let ((obj (or ede-selected-object ede-object))) |
| 669 | (append |
| 670 | '([ "Add File" ede-add-file |
| 671 | (and (ede-current-project) |
| 672 | (oref (ede-current-project) targets)) ] |
| 673 | [ "Remove File" ede-remove-file |
| 674 | (and ede-object |
| 675 | (or (listp ede-object) |
| 676 | (not (obj-of-class-p ede-object ede-project)))) ] |
| 677 | "-") |
| 678 | (if (not obj) |
| 679 | nil |
| 680 | (if (and (not (listp obj)) (oref obj menu)) |
| 681 | (oref obj menu) |
| 682 | (when (listp obj) |
| 683 | ;; This is bad, but I'm not sure what else to do. |
| 684 | (oref (car obj) menu))))))))) |
| 685 | |
| 686 | (defun ede-project-forms-menu (menu-def) |
| 687 | "Create a target MENU-DEF based on the object belonging to this buffer." |
| 688 | (easy-menu-filter-return |
| 689 | (easy-menu-create-menu |
| 690 | "Project Forms" |
| 691 | (let* ((obj (ede-current-project)) |
| 692 | (class (if obj (object-class obj))) |
| 693 | (menu nil)) |
| 694 | (condition-case err |
| 695 | (progn |
| 696 | (while (and class (slot-exists-p class 'menu)) |
| 697 | ;;(message "Looking at class %S" class) |
| 698 | (setq menu (append menu (oref class menu)) |
| 699 | class (class-parent class)) |
| 700 | (if (listp class) (setq class (car class)))) |
| 701 | (append |
| 702 | '( [ "Add Target" ede-new-target (ede-current-project) ] |
| 703 | [ "Remove Target" ede-delete-target ede-object ] |
| 704 | "-") |
| 705 | menu |
| 706 | )) |
| 707 | (error (message "Err found: %S" err) |
| 708 | menu) |
| 709 | ))))) |
| 710 | |
| 711 | (defun ede-customize-forms-menu (menu-def) |
| 712 | "Create a menu of the project, and targets that can be customized. |
| 713 | Argument MENU-DEF is the definition of the current menu." |
| 714 | (easy-menu-filter-return |
| 715 | (easy-menu-create-menu |
| 716 | "Customize Project" |
| 717 | (let* ((obj (ede-current-project)) |
| 718 | targ) |
| 719 | (when obj |
| 720 | (setq targ (when (slot-boundp obj 'targets) |
| 721 | (oref obj targets))) |
| 722 | ;; Make custom menus for everything here. |
| 723 | (append (list |
| 724 | (cons (concat "Project " (ede-name obj)) |
| 725 | (eieio-customize-object-group obj)) |
| 726 | [ "Reorder Targets" ede-project-sort-targets t ] |
| 727 | ) |
| 728 | (mapcar (lambda (o) |
| 729 | (cons (concat "Target " (ede-name o)) |
| 730 | (eieio-customize-object-group o))) |
| 731 | targ))))))) |
| 732 | |
| 733 | |
| 734 | (defun ede-apply-object-keymap (&optional default) |
| 735 | "Add target specific keybindings into the local map. |
| 736 | Optional argument DEFAULT indicates if this should be set to the default |
| 737 | version of the keymap." |
| 738 | (let ((object (or ede-object ede-selected-object))) |
| 739 | (condition-case nil |
| 740 | (let ((keys (ede-object-keybindings object))) |
| 741 | (while keys |
| 742 | (local-set-key (concat "\C-c." (car (car keys))) |
| 743 | (cdr (car keys))) |
| 744 | (setq keys (cdr keys)))) |
| 745 | (error nil)))) |
| 746 | |
| 747 | ;;; Menu building methods for building |
| 748 | ;; |
| 749 | (defmethod ede-menu-items-build ((obj ede-project) &optional current) |
| 750 | "Return a list of menu items for building project OBJ. |
| 751 | If optional argument CURRENT is non-nil, return sub-menu code." |
| 752 | (if current |
| 753 | (list [ "Build Current Project" ede-compile-project t ]) |
| 754 | (list (vector |
| 755 | (list |
| 756 | (concat "Build Project " (ede-name obj)) |
| 757 | `(project-compile-project ,obj)))))) |
| 758 | |
| 759 | (defmethod ede-menu-items-build ((obj ede-target) &optional current) |
| 760 | "Return a list of menu items for building target OBJ. |
| 761 | If optional argument CURRENT is non-nil, return sub-menu code." |
| 762 | (if current |
| 763 | (list [ "Build Current Target" ede-compile-target t ]) |
| 764 | (list (vector |
| 765 | (concat "Build Target " (ede-name obj)) |
| 766 | `(project-compile-target ,obj) |
| 767 | t)))) |
| 768 | \f |
| 769 | ;;; Mode Declarations |
| 770 | ;; |
| 771 | (eval-and-compile |
| 772 | (autoload 'ede-dired-minor-mode "ede/dired" "EDE commands for dired" t)) |
| 773 | |
| 774 | (defun ede-apply-target-options () |
| 775 | "Apply options to the current buffer for the active project/target." |
| 776 | (if (ede-current-project) |
| 777 | (ede-set-project-variables (ede-current-project))) |
| 778 | (ede-apply-object-keymap) |
| 779 | (ede-apply-preprocessor-map) |
| 780 | ) |
| 781 | |
| 782 | (defun ede-turn-on-hook () |
| 783 | "Turn on EDE minor mode in the current buffer if needed. |
| 784 | To be used in hook functions." |
| 785 | (if (or (and (stringp (buffer-file-name)) |
| 786 | (stringp default-directory)) |
| 787 | ;; Emacs 21 has no buffer file name for directory edits. |
| 788 | ;; so we need to add these hacks in. |
| 789 | (eq major-mode 'dired-mode) |
| 790 | (eq major-mode 'vc-dired-mode)) |
| 791 | (ede-minor-mode 1))) |
| 792 | |
| 793 | (define-minor-mode ede-minor-mode |
| 794 | "Toggle EDE (Emacs Development Environment) minor mode. |
| 795 | With non-nil argument ARG, enable EDE minor mode if ARG is |
| 796 | positive; otherwise, disable it. |
| 797 | |
| 798 | If this file is contained, or could be contained in an EDE |
| 799 | controlled project, then this mode is activated automatically |
| 800 | provided `global-ede-mode' is enabled." |
| 801 | :group 'ede |
| 802 | (cond ((or (eq major-mode 'dired-mode) |
| 803 | (eq major-mode 'vc-dired-mode)) |
| 804 | (ede-dired-minor-mode (if ede-minor-mode 1 -1))) |
| 805 | (ede-minor-mode |
| 806 | (if (and (not ede-constructing) |
| 807 | (ede-directory-project-p default-directory t)) |
| 808 | (let* ((ROOT nil) |
| 809 | (proj (ede-directory-get-open-project default-directory |
| 810 | 'ROOT))) |
| 811 | (when (not proj) |
| 812 | ;; @todo - this could be wasteful. |
| 813 | (setq proj (ede-load-project-file default-directory 'ROOT))) |
| 814 | (setq ede-object-project proj) |
| 815 | (setq ede-object-root-project |
| 816 | (or ROOT (ede-project-root proj))) |
| 817 | (setq ede-object (ede-buffer-object)) |
| 818 | (if (and (not ede-object) ede-object-project) |
| 819 | (ede-auto-add-to-target)) |
| 820 | (ede-apply-target-options)) |
| 821 | ;; If we fail to have a project here, turn it back off. |
| 822 | (ede-minor-mode -1))))) |
| 823 | |
| 824 | (defun ede-reset-all-buffers (onoff) |
| 825 | "Reset all the buffers due to change in EDE. |
| 826 | ONOFF indicates enabling or disabling the mode." |
| 827 | (let ((b (buffer-list))) |
| 828 | (while b |
| 829 | (when (buffer-file-name (car b)) |
| 830 | (ede-buffer-object (car b)) |
| 831 | ) |
| 832 | (setq b (cdr b))))) |
| 833 | |
| 834 | ;;;###autoload |
| 835 | (define-minor-mode global-ede-mode |
| 836 | "Toggle global EDE (Emacs Development Environment) mode. |
| 837 | With non-nil argument ARG, enable global EDE mode if ARG is |
| 838 | positive; otherwise, disable it. |
| 839 | |
| 840 | This global minor mode enables `ede-minor-mode' in all buffers in |
| 841 | an EDE controlled project." |
| 842 | :global t |
| 843 | :group 'ede |
| 844 | (if global-ede-mode |
| 845 | ;; Turn on global-ede-mode |
| 846 | (progn |
| 847 | (if semantic-mode |
| 848 | (define-key cedet-menu-map [cedet-menu-separator] '("--"))) |
| 849 | (add-hook 'semanticdb-project-predicate-functions 'ede-directory-project-p) |
| 850 | (add-hook 'semanticdb-project-root-functions 'ede-toplevel-project-or-nil) |
| 851 | (add-hook 'ecb-source-path-functions 'ede-ecb-project-paths) |
| 852 | (add-hook 'find-file-hook 'ede-turn-on-hook) |
| 853 | (add-hook 'dired-mode-hook 'ede-turn-on-hook) |
| 854 | (add-hook 'kill-emacs-hook 'ede-save-cache) |
| 855 | (ede-load-cache) |
| 856 | (ede-reset-all-buffers 1)) |
| 857 | ;; Turn off global-ede-mode |
| 858 | (define-key cedet-menu-map [cedet-menu-separator] nil) |
| 859 | (remove-hook 'semanticdb-project-predicate-functions 'ede-directory-project-p) |
| 860 | (remove-hook 'semanticdb-project-root-functions 'ede-toplevel-project-or-nil) |
| 861 | (remove-hook 'ecb-source-path-functions 'ede-ecb-project-paths) |
| 862 | (remove-hook 'find-file-hook 'ede-turn-on-hook) |
| 863 | (remove-hook 'dired-mode-hook 'ede-turn-on-hook) |
| 864 | (remove-hook 'kill-emacs-hook 'ede-save-cache) |
| 865 | (ede-save-cache) |
| 866 | (ede-reset-all-buffers -1))) |
| 867 | |
| 868 | (defvar ede-ignored-file-alist |
| 869 | '( "\\.cvsignore$" |
| 870 | "\\.#" |
| 871 | "~$" |
| 872 | ) |
| 873 | "List of file name patters that EDE will never ask about.") |
| 874 | |
| 875 | (defun ede-ignore-file (filename) |
| 876 | "Should we ignore FILENAME?" |
| 877 | (let ((any nil) |
| 878 | (F ede-ignored-file-alist)) |
| 879 | (while (and (not any) F) |
| 880 | (when (string-match (car F) filename) |
| 881 | (setq any t)) |
| 882 | (setq F (cdr F))) |
| 883 | any)) |
| 884 | |
| 885 | (defun ede-auto-add-to-target () |
| 886 | "Look for a target that wants to own the current file. |
| 887 | Follow the preference set with `ede-auto-add-method' and get the list |
| 888 | of objects with the `ede-want-file-p' method." |
| 889 | (if ede-object (error "Ede-object already defined for %s" (buffer-name))) |
| 890 | (if (or (eq ede-auto-add-method 'never) |
| 891 | (ede-ignore-file (buffer-file-name))) |
| 892 | nil |
| 893 | (let (wants desires) |
| 894 | ;; Find all the objects. |
| 895 | (setq wants (oref (ede-current-project) targets)) |
| 896 | (while wants |
| 897 | (if (ede-want-file-p (car wants) (buffer-file-name)) |
| 898 | (setq desires (cons (car wants) desires))) |
| 899 | (setq wants (cdr wants))) |
| 900 | (if desires |
| 901 | (cond ((or (eq ede-auto-add-method 'ask) |
| 902 | (and (eq ede-auto-add-method 'multi-ask) |
| 903 | (< 1 (length desires)))) |
| 904 | (let* ((al (append |
| 905 | ;; some defaults |
| 906 | '(("none" . nil) |
| 907 | ("new target" . new)) |
| 908 | ;; If we are in an unparented subdir, |
| 909 | ;; offer new a subproject |
| 910 | (if (ede-directory-project-p default-directory) |
| 911 | () |
| 912 | '(("create subproject" . project))) |
| 913 | ;; Here are the existing objects we want. |
| 914 | (object-assoc-list 'name desires))) |
| 915 | (case-fold-search t) |
| 916 | (ans (completing-read |
| 917 | (format "Add %s to target: " (buffer-file-name)) |
| 918 | al nil t))) |
| 919 | (setq ans (assoc ans al)) |
| 920 | (cond ((eieio-object-p (cdr ans)) |
| 921 | (ede-add-file (cdr ans))) |
| 922 | ((eq (cdr ans) 'new) |
| 923 | (ede-new-target)) |
| 924 | (t nil)))) |
| 925 | ((or (eq ede-auto-add-method 'always) |
| 926 | (and (eq ede-auto-add-method 'multi-ask) |
| 927 | (= 1 (length desires)))) |
| 928 | (ede-add-file (car desires))) |
| 929 | (t nil)))))) |
| 930 | |
| 931 | \f |
| 932 | ;;; Interactive method invocations |
| 933 | ;; |
| 934 | (defun ede (file) |
| 935 | "Start up EDE on something. |
| 936 | Argument FILE is the file or directory to load a project from." |
| 937 | (interactive "fProject File: ") |
| 938 | (if (not (file-exists-p file)) |
| 939 | (ede-new file) |
| 940 | (ede-load-project-file (file-name-directory file)))) |
| 941 | |
| 942 | (defun ede-new (type &optional name) |
| 943 | "Create a new project starting of project type TYPE. |
| 944 | Optional argument NAME is the name to give this project." |
| 945 | (interactive |
| 946 | (list (completing-read "Project Type: " |
| 947 | (object-assoc-list |
| 948 | 'name |
| 949 | (let* ((l ede-project-class-files) |
| 950 | (cp (ede-current-project)) |
| 951 | (cs (when cp (object-class cp))) |
| 952 | (r nil)) |
| 953 | (while l |
| 954 | (if cs |
| 955 | (if (eq (oref (car l) :class-sym) |
| 956 | cs) |
| 957 | (setq r (cons (car l) r))) |
| 958 | (if (oref (car l) new-p) |
| 959 | (setq r (cons (car l) r)))) |
| 960 | (setq l (cdr l))) |
| 961 | (when (not r) |
| 962 | (if cs |
| 963 | (error "No valid interactive sub project types for %s" |
| 964 | cs) |
| 965 | (error "EDE error: Can't fin project types to create"))) |
| 966 | r) |
| 967 | ) |
| 968 | nil t))) |
| 969 | ;; Make sure we have a valid directory |
| 970 | (when (not (file-exists-p default-directory)) |
| 971 | (error "Cannot create project in non-existent directory %s" default-directory)) |
| 972 | (when (not (file-writable-p default-directory)) |
| 973 | (error "No write permissions for %s" default-directory)) |
| 974 | ;; Create the project |
| 975 | (let* ((obj (object-assoc type 'name ede-project-class-files)) |
| 976 | (nobj (let ((f (oref obj file)) |
| 977 | (pf (oref obj proj-file))) |
| 978 | ;; We are about to make something new, changing the |
| 979 | ;; state of existing directories. |
| 980 | (ede-project-directory-remove-hash default-directory) |
| 981 | ;; Make sure this class gets loaded! |
| 982 | (require f) |
| 983 | (make-instance (oref obj class-sym) |
| 984 | :name (or name (read-string "Name: ")) |
| 985 | :directory default-directory |
| 986 | :file (cond ((stringp pf) |
| 987 | (expand-file-name pf)) |
| 988 | ((fboundp pf) |
| 989 | (funcall pf)) |
| 990 | (t |
| 991 | (error |
| 992 | "Unknown file name specifier %S" |
| 993 | pf))) |
| 994 | :targets nil))) |
| 995 | (inits (oref obj initializers))) |
| 996 | ;; Force the name to match for new objects. |
| 997 | (object-set-name-string nobj (oref nobj :name)) |
| 998 | ;; Handle init args. |
| 999 | (while inits |
| 1000 | (eieio-oset nobj (car inits) (car (cdr inits))) |
| 1001 | (setq inits (cdr (cdr inits)))) |
| 1002 | (let ((pp (ede-parent-project))) |
| 1003 | (when pp |
| 1004 | (ede-add-subproject pp nobj) |
| 1005 | (ede-commit-project pp))) |
| 1006 | (ede-commit-project nobj)) |
| 1007 | ;; Have the menu appear |
| 1008 | (setq ede-minor-mode t) |
| 1009 | ;; Allert the user |
| 1010 | (message "Project created and saved. You may now create targets.")) |
| 1011 | |
| 1012 | (defmethod ede-add-subproject ((proj-a ede-project) proj-b) |
| 1013 | "Add into PROJ-A, the subproject PROJ-B." |
| 1014 | (oset proj-a subproj (cons proj-b (oref proj-a subproj)))) |
| 1015 | |
| 1016 | (defmethod ede-subproject-relative-path ((proj ede-project) &optional parent-in) |
| 1017 | "Get a path name for PROJ which is relative to the parent project. |
| 1018 | If PARENT is specified, then be relative to the PARENT project. |
| 1019 | Specifying PARENT is useful for sub-sub projects relative to the root project." |
| 1020 | (let* ((parent (or parent-in (ede-parent-project proj))) |
| 1021 | (dir (file-name-directory (oref proj file)))) |
| 1022 | (if (and parent (not (eq parent proj))) |
| 1023 | (file-relative-name dir (file-name-directory (oref parent file))) |
| 1024 | ""))) |
| 1025 | |
| 1026 | (defmethod ede-subproject-p ((proj ede-project)) |
| 1027 | "Return non-nil if PROJ is a sub project." |
| 1028 | (ede-parent-project proj)) |
| 1029 | |
| 1030 | (defun ede-invoke-method (sym &rest args) |
| 1031 | "Invoke method SYM on the current buffer's project object. |
| 1032 | ARGS are additional arguments to pass to method sym." |
| 1033 | (if (not ede-object) |
| 1034 | (error "Cannot invoke %s for %s" (symbol-name sym) |
| 1035 | (buffer-name))) |
| 1036 | ;; Always query a target. There should never be multiple |
| 1037 | ;; projects in a single buffer. |
| 1038 | (apply sym (ede-singular-object "Target: ") args)) |
| 1039 | |
| 1040 | (defun ede-rescan-toplevel () |
| 1041 | "Rescan all project files." |
| 1042 | (interactive) |
| 1043 | (let ((toppath (ede-toplevel-project default-directory)) |
| 1044 | (ede-deep-rescan t)) |
| 1045 | (project-rescan (ede-load-project-file toppath)) |
| 1046 | (ede-reset-all-buffers 1) |
| 1047 | )) |
| 1048 | |
| 1049 | (defun ede-new-target (&rest args) |
| 1050 | "Create a new target specific to this type of project file. |
| 1051 | Different projects accept different arguments ARGS. |
| 1052 | Typically you can specify NAME, target TYPE, and AUTOADD, where AUTOADD is |
| 1053 | a string \"y\" or \"n\", which answers the y/n question done interactively." |
| 1054 | (interactive) |
| 1055 | (apply 'project-new-target (ede-current-project) args) |
| 1056 | (setq ede-object nil) |
| 1057 | (setq ede-object (ede-buffer-object (current-buffer))) |
| 1058 | (ede-apply-target-options)) |
| 1059 | |
| 1060 | (defun ede-new-target-custom () |
| 1061 | "Create a new target specific to this type of project file." |
| 1062 | (interactive) |
| 1063 | (project-new-target-custom (ede-current-project))) |
| 1064 | |
| 1065 | (defun ede-delete-target (target) |
| 1066 | "Delete TARGET from the current project." |
| 1067 | (interactive (list |
| 1068 | (let ((ede-object (ede-current-project))) |
| 1069 | (ede-invoke-method 'project-interactive-select-target |
| 1070 | "Target: ")))) |
| 1071 | ;; Find all sources in buffers associated with the condemned buffer. |
| 1072 | (let ((condemned (ede-target-buffers target))) |
| 1073 | (project-delete-target target) |
| 1074 | ;; Loop over all project controlled buffers |
| 1075 | (save-excursion |
| 1076 | (while condemned |
| 1077 | (set-buffer (car condemned)) |
| 1078 | (setq ede-object nil) |
| 1079 | (setq ede-object (ede-buffer-object (current-buffer))) |
| 1080 | (setq condemned (cdr condemned)))) |
| 1081 | (ede-apply-target-options))) |
| 1082 | |
| 1083 | (defun ede-add-file (target) |
| 1084 | "Add the current buffer to a TARGET in the current project." |
| 1085 | (interactive (list |
| 1086 | (let ((ede-object (ede-current-project))) |
| 1087 | (ede-invoke-method 'project-interactive-select-target |
| 1088 | "Target: ")))) |
| 1089 | (when (stringp target) |
| 1090 | (let* ((proj (ede-current-project)) |
| 1091 | (ob (object-assoc-list 'name (oref proj targets)))) |
| 1092 | (setq target (cdr (assoc target ob))))) |
| 1093 | |
| 1094 | (when (not target) |
| 1095 | (error "Could not find specified target %S" target)) |
| 1096 | |
| 1097 | (project-add-file target (buffer-file-name)) |
| 1098 | (setq ede-object nil) |
| 1099 | (setq ede-object (ede-buffer-object (current-buffer))) |
| 1100 | (when (not ede-object) |
| 1101 | (error "Can't add %s to target %s: Wrong file type" |
| 1102 | (file-name-nondirectory (buffer-file-name)) |
| 1103 | (object-name target))) |
| 1104 | (ede-apply-target-options)) |
| 1105 | |
| 1106 | (defun ede-remove-file (&optional force) |
| 1107 | "Remove the current file from targets. |
| 1108 | Optional argument FORCE forces the file to be removed without asking." |
| 1109 | (interactive "P") |
| 1110 | (if (not ede-object) |
| 1111 | (error "Cannot invoke remove-file for %s" (buffer-name))) |
| 1112 | (let ((eo (if (listp ede-object) |
| 1113 | (prog1 |
| 1114 | ede-object |
| 1115 | (setq force nil)) |
| 1116 | (list ede-object)))) |
| 1117 | (while eo |
| 1118 | (if (or force (y-or-n-p (format "Remove from %s? " (ede-name (car eo))))) |
| 1119 | (project-remove-file (car eo) (buffer-file-name))) |
| 1120 | (setq eo (cdr eo))) |
| 1121 | (setq ede-object nil) |
| 1122 | (setq ede-object (ede-buffer-object (current-buffer))) |
| 1123 | (ede-apply-target-options))) |
| 1124 | |
| 1125 | (defun ede-edit-file-target () |
| 1126 | "Enter the project file to hand edit the current buffer's target." |
| 1127 | (interactive) |
| 1128 | (ede-invoke-method 'project-edit-file-target)) |
| 1129 | |
| 1130 | (defun ede-compile-project () |
| 1131 | "Compile the current project." |
| 1132 | (interactive) |
| 1133 | ;; @TODO - This just wants the root. There should be a better way. |
| 1134 | (let ((cp (ede-current-project))) |
| 1135 | (while (ede-parent-project cp) |
| 1136 | (setq cp (ede-parent-project cp))) |
| 1137 | (let ((ede-object cp)) |
| 1138 | (ede-invoke-method 'project-compile-project)))) |
| 1139 | |
| 1140 | (defun ede-compile-selected (target) |
| 1141 | "Compile some TARGET from the current project." |
| 1142 | (interactive (list (project-interactive-select-target (ede-current-project) |
| 1143 | "Target to Build: "))) |
| 1144 | (project-compile-target target)) |
| 1145 | |
| 1146 | (defun ede-compile-target () |
| 1147 | "Compile the current buffer's associated target." |
| 1148 | (interactive) |
| 1149 | (ede-invoke-method 'project-compile-target)) |
| 1150 | |
| 1151 | (defun ede-debug-target () |
| 1152 | "Debug the current buffer's associated target." |
| 1153 | (interactive) |
| 1154 | (ede-invoke-method 'project-debug-target)) |
| 1155 | |
| 1156 | (defun ede-run-target () |
| 1157 | "Run the current buffer's associated target." |
| 1158 | (interactive) |
| 1159 | (ede-invoke-method 'project-run-target)) |
| 1160 | |
| 1161 | (defun ede-make-dist () |
| 1162 | "Create a distribution from the current project." |
| 1163 | (interactive) |
| 1164 | (let ((ede-object (ede-current-project))) |
| 1165 | (ede-invoke-method 'project-make-dist))) |
| 1166 | |
| 1167 | ;;; Customization |
| 1168 | ;; |
| 1169 | ;; Routines for customizing projects and targets. |
| 1170 | |
| 1171 | (defvar eieio-ede-old-variables nil |
| 1172 | "The old variables for a project.") |
| 1173 | |
| 1174 | (defalias 'customize-project 'ede-customize-project) |
| 1175 | (defun ede-customize-project (&optional group) |
| 1176 | "Edit fields of the current project through EIEIO & Custom. |
| 1177 | Optional GROUP specifies the subgroup of slots to customize." |
| 1178 | (interactive "P") |
| 1179 | (require 'eieio-custom) |
| 1180 | (let* ((ov (oref (ede-current-project) local-variables)) |
| 1181 | (cp (ede-current-project)) |
| 1182 | (group (if group (eieio-read-customization-group cp)))) |
| 1183 | (eieio-customize-object cp group) |
| 1184 | (make-local-variable 'eieio-ede-old-variables) |
| 1185 | (setq eieio-ede-old-variables ov))) |
| 1186 | |
| 1187 | (defalias 'customize-target 'ede-customize-current-target) |
| 1188 | (defun ede-customize-current-target(&optional group) |
| 1189 | "Edit fields of the current target through EIEIO & Custom. |
| 1190 | Optional argument OBJ is the target object to customize. |
| 1191 | Optional argument GROUP is the slot group to display." |
| 1192 | (interactive "P") |
| 1193 | (require 'eieio-custom) |
| 1194 | (if (not (obj-of-class-p ede-object ede-target)) |
| 1195 | (error "Current file is not part of a target")) |
| 1196 | (let ((group (if group (eieio-read-customization-group ede-object)))) |
| 1197 | (ede-customize-target ede-object group))) |
| 1198 | |
| 1199 | (defun ede-customize-target (obj group) |
| 1200 | "Edit fields of the current target through EIEIO & Custom. |
| 1201 | Optional argument OBJ is the target object to customize. |
| 1202 | Optional argument GROUP is the slot group to display." |
| 1203 | (require 'eieio-custom) |
| 1204 | (if (and obj (not (obj-of-class-p obj ede-target))) |
| 1205 | (error "No logical target to customize")) |
| 1206 | (eieio-customize-object obj (or group 'default))) |
| 1207 | ;;; Target Sorting |
| 1208 | ;; |
| 1209 | ;; Target order can be important, but custom doesn't support a way |
| 1210 | ;; to resort items in a list. This function by David Engster allows |
| 1211 | ;; targets to be re-arranged. |
| 1212 | |
| 1213 | (defvar ede-project-sort-targets-order nil |
| 1214 | "Variable for tracking target order in `ede-project-sort-targets'.") |
| 1215 | |
| 1216 | (defun ede-project-sort-targets () |
| 1217 | "Create a custom-like buffer for sorting targets of current project." |
| 1218 | (interactive) |
| 1219 | (let ((proj (ede-current-project)) |
| 1220 | (count 1) |
| 1221 | current order) |
| 1222 | (switch-to-buffer (get-buffer-create "*EDE sort targets*")) |
| 1223 | (erase-buffer) |
| 1224 | (setq ede-object-project proj) |
| 1225 | (widget-create 'push-button |
| 1226 | :notify (lambda (&rest ignore) |
| 1227 | (let ((targets (oref ede-object-project targets)) |
| 1228 | cur newtargets) |
| 1229 | (while (setq cur (pop ede-project-sort-targets-order)) |
| 1230 | (setq newtargets (append newtargets |
| 1231 | (list (nth cur targets))))) |
| 1232 | (oset ede-object-project targets newtargets)) |
| 1233 | (ede-commit-project ede-object-project) |
| 1234 | (kill-buffer)) |
| 1235 | " Accept ") |
| 1236 | (widget-insert " ") |
| 1237 | (widget-create 'push-button |
| 1238 | :notify (lambda (&rest ignore) |
| 1239 | (kill-buffer)) |
| 1240 | " Cancel ") |
| 1241 | (widget-insert "\n\n") |
| 1242 | (setq ede-project-sort-targets-order nil) |
| 1243 | (mapc (lambda (x) |
| 1244 | (add-to-ordered-list |
| 1245 | 'ede-project-sort-targets-order |
| 1246 | x x)) |
| 1247 | (number-sequence 0 (1- (length (oref proj targets))))) |
| 1248 | (ede-project-sort-targets-list) |
| 1249 | (use-local-map widget-keymap) |
| 1250 | (widget-setup) |
| 1251 | (goto-char (point-min)))) |
| 1252 | |
| 1253 | (defun ede-project-sort-targets-list () |
| 1254 | "Sort the target list while using `ede-project-sort-targets'." |
| 1255 | (save-excursion |
| 1256 | (let ((count 0) |
| 1257 | (targets (oref ede-object-project targets)) |
| 1258 | (inhibit-read-only t) |
| 1259 | (inhibit-modification-hooks t)) |
| 1260 | (goto-char (point-min)) |
| 1261 | (forward-line 2) |
| 1262 | (delete-region (point) (point-max)) |
| 1263 | (while (< count (length targets)) |
| 1264 | (if (> count 0) |
| 1265 | (widget-create 'push-button |
| 1266 | :notify `(lambda (&rest ignore) |
| 1267 | (let ((cur ede-project-sort-targets-order)) |
| 1268 | (add-to-ordered-list |
| 1269 | 'ede-project-sort-targets-order |
| 1270 | (nth ,count cur) |
| 1271 | (1- ,count)) |
| 1272 | (add-to-ordered-list |
| 1273 | 'ede-project-sort-targets-order |
| 1274 | (nth (1- ,count) cur) ,count)) |
| 1275 | (ede-project-sort-targets-list)) |
| 1276 | " Up ") |
| 1277 | (widget-insert " ")) |
| 1278 | (if (< count (1- (length targets))) |
| 1279 | (widget-create 'push-button |
| 1280 | :notify `(lambda (&rest ignore) |
| 1281 | (let ((cur ede-project-sort-targets-order)) |
| 1282 | (add-to-ordered-list |
| 1283 | 'ede-project-sort-targets-order |
| 1284 | (nth ,count cur) (1+ ,count)) |
| 1285 | (add-to-ordered-list |
| 1286 | 'ede-project-sort-targets-order |
| 1287 | (nth (1+ ,count) cur) ,count)) |
| 1288 | (ede-project-sort-targets-list)) |
| 1289 | " Down ") |
| 1290 | (widget-insert " ")) |
| 1291 | (widget-insert (concat " " (number-to-string (1+ count)) ".: " |
| 1292 | (oref (nth (nth count ede-project-sort-targets-order) |
| 1293 | targets) name) "\n")) |
| 1294 | (setq count (1+ count)))))) |
| 1295 | |
| 1296 | ;;; Customization hooks |
| 1297 | ;; |
| 1298 | ;; These hooks are used when finishing up a customization. |
| 1299 | (defmethod eieio-done-customizing ((proj ede-project)) |
| 1300 | "Call this when a user finishes customizing PROJ." |
| 1301 | (let ((ov eieio-ede-old-variables) |
| 1302 | (nv (oref proj local-variables))) |
| 1303 | (setq eieio-ede-old-variables nil) |
| 1304 | (while ov |
| 1305 | (if (not (assoc (car (car ov)) nv)) |
| 1306 | (save-excursion |
| 1307 | (mapc (lambda (b) |
| 1308 | (set-buffer b) |
| 1309 | (kill-local-variable (car (car ov)))) |
| 1310 | (ede-project-buffers proj)))) |
| 1311 | (setq ov (cdr ov))) |
| 1312 | (mapc (lambda (b) (ede-set-project-variables proj b)) |
| 1313 | (ede-project-buffers proj)))) |
| 1314 | |
| 1315 | (defmethod eieio-done-customizing ((target ede-target)) |
| 1316 | "Call this when a user finishes customizing TARGET." |
| 1317 | nil) |
| 1318 | |
| 1319 | (defmethod ede-commit-project ((proj ede-project)) |
| 1320 | "Commit any change to PROJ to its file." |
| 1321 | nil |
| 1322 | ) |
| 1323 | |
| 1324 | \f |
| 1325 | ;;; EDE project placeholder methods |
| 1326 | ;; |
| 1327 | (defmethod ede-project-force-load ((this ede-project-placeholder)) |
| 1328 | "Make sure the placeholder THIS is replaced with the real thing. |
| 1329 | Return the new object created in its place." |
| 1330 | this |
| 1331 | ) |
| 1332 | |
| 1333 | \f |
| 1334 | ;;; EDE project target baseline methods. |
| 1335 | ;; |
| 1336 | ;; If you are developing a new project type, you need to implement |
| 1337 | ;; all of these methods, unless, of course, they do not make sense |
| 1338 | ;; for your particular project. |
| 1339 | ;; |
| 1340 | ;; Your targets should inherit from `ede-target', and your project |
| 1341 | ;; files should inherit from `ede-project'. Create the appropriate |
| 1342 | ;; methods based on those below. |
| 1343 | |
| 1344 | (defmethod project-interactive-select-target ((this ede-project-placeholder) prompt) |
| 1345 | ; checkdoc-params: (prompt) |
| 1346 | "Make sure placeholder THIS is replaced with the real thing, and pass through." |
| 1347 | (project-interactive-select-target (ede-project-force-load this) prompt)) |
| 1348 | |
| 1349 | (defmethod project-interactive-select-target ((this ede-project) prompt) |
| 1350 | "Interactively query for a target that exists in project THIS. |
| 1351 | Argument PROMPT is the prompt to use when querying the user for a target." |
| 1352 | (let ((ob (object-assoc-list 'name (oref this targets)))) |
| 1353 | (cdr (assoc (completing-read prompt ob nil t) ob)))) |
| 1354 | |
| 1355 | (defmethod project-add-file ((this ede-project-placeholder) file) |
| 1356 | ; checkdoc-params: (file) |
| 1357 | "Make sure placeholder THIS is replaced with the real thing, and pass through." |
| 1358 | (project-add-file (ede-project-force-load this) file)) |
| 1359 | |
| 1360 | (defmethod project-add-file ((ot ede-target) file) |
| 1361 | "Add the current buffer into project project target OT. |
| 1362 | Argument FILE is the file to add." |
| 1363 | (error "add-file not supported by %s" (object-name ot))) |
| 1364 | |
| 1365 | (defmethod project-remove-file ((ot ede-target) fnnd) |
| 1366 | "Remove the current buffer from project target OT. |
| 1367 | Argument FNND is an argument." |
| 1368 | (error "remove-file not supported by %s" (object-name ot))) |
| 1369 | |
| 1370 | (defmethod project-edit-file-target ((ot ede-target)) |
| 1371 | "Edit the target OT associated w/ this file." |
| 1372 | (find-file (oref (ede-current-project) file))) |
| 1373 | |
| 1374 | (defmethod project-new-target ((proj ede-project) &rest args) |
| 1375 | "Create a new target. It is up to the project PROJ to get the name." |
| 1376 | (error "new-target not supported by %s" (object-name proj))) |
| 1377 | |
| 1378 | (defmethod project-new-target-custom ((proj ede-project)) |
| 1379 | "Create a new target. It is up to the project PROJ to get the name." |
| 1380 | (error "New-target-custom not supported by %s" (object-name proj))) |
| 1381 | |
| 1382 | (defmethod project-delete-target ((ot ede-target)) |
| 1383 | "Delete the current target OT from its parent project." |
| 1384 | (error "add-file not supported by %s" (object-name ot))) |
| 1385 | |
| 1386 | (defmethod project-compile-project ((obj ede-project) &optional command) |
| 1387 | "Compile the entire current project OBJ. |
| 1388 | Argument COMMAND is the command to use when compiling." |
| 1389 | (error "compile-project not supported by %s" (object-name obj))) |
| 1390 | |
| 1391 | (defmethod project-compile-target ((obj ede-target) &optional command) |
| 1392 | "Compile the current target OBJ. |
| 1393 | Argument COMMAND is the command to use for compiling the target." |
| 1394 | (error "compile-target not supported by %s" (object-name obj))) |
| 1395 | |
| 1396 | (defmethod project-debug-target ((obj ede-target)) |
| 1397 | "Run the current project target OBJ in a debugger." |
| 1398 | (error "debug-target not supported by %s" (object-name obj))) |
| 1399 | |
| 1400 | (defmethod project-run-target ((obj ede-target)) |
| 1401 | "Run the current project target OBJ." |
| 1402 | (error "run-target not supported by %s" (object-name obj))) |
| 1403 | |
| 1404 | (defmethod project-make-dist ((this ede-project)) |
| 1405 | "Build a distribution for the project based on THIS project." |
| 1406 | (error "Make-dist not supported by %s" (object-name this))) |
| 1407 | |
| 1408 | (defmethod project-dist-files ((this ede-project)) |
| 1409 | "Return a list of files that constitute a distribution of THIS project." |
| 1410 | (error "Dist-files is not supported by %s" (object-name this))) |
| 1411 | |
| 1412 | (defmethod project-rescan ((this ede-project)) |
| 1413 | "Rescan the EDE proj project THIS." |
| 1414 | (error "Rescanning a project is not supported by %s" (object-name this))) |
| 1415 | \f |
| 1416 | ;;; Default methods for EDE classes |
| 1417 | ;; |
| 1418 | ;; These are methods which you might want to override, but there is |
| 1419 | ;; no need to in most situations because they are either a) simple, or |
| 1420 | ;; b) cosmetic. |
| 1421 | |
| 1422 | (defmethod ede-name ((this ede-target)) |
| 1423 | "Return the name of THIS target." |
| 1424 | (oref this name)) |
| 1425 | |
| 1426 | (defmethod ede-target-name ((this ede-target)) |
| 1427 | "Return the name of THIS target, suitable for make or debug style commands." |
| 1428 | (oref this name)) |
| 1429 | |
| 1430 | (defmethod ede-name ((this ede-project)) |
| 1431 | "Return a short-name for THIS project file. |
| 1432 | Do this by extracting the lowest directory name." |
| 1433 | (oref this name)) |
| 1434 | |
| 1435 | (defmethod ede-description ((this ede-project)) |
| 1436 | "Return a description suitable for the minibuffer about THIS." |
| 1437 | (format "Project %s: %d subprojects, %d targets." |
| 1438 | (ede-name this) (length (oref this subproj)) |
| 1439 | (length (oref this targets)))) |
| 1440 | |
| 1441 | (defmethod ede-description ((this ede-target)) |
| 1442 | "Return a description suitable for the minibuffer about THIS." |
| 1443 | (format "Target %s: with %d source files." |
| 1444 | (ede-name this) (length (oref this source)))) |
| 1445 | |
| 1446 | (defmethod ede-want-file-p ((this ede-target) file) |
| 1447 | "Return non-nil if THIS target wants FILE." |
| 1448 | ;; By default, all targets reference the source object, and let it decide. |
| 1449 | (let ((src (ede-target-sourcecode this))) |
| 1450 | (while (and src (not (ede-want-file-p (car src) file))) |
| 1451 | (setq src (cdr src))) |
| 1452 | src)) |
| 1453 | |
| 1454 | (defmethod ede-want-file-source-p ((this ede-target) file) |
| 1455 | "Return non-nil if THIS target wants FILE." |
| 1456 | ;; By default, all targets reference the source object, and let it decide. |
| 1457 | (let ((src (ede-target-sourcecode this))) |
| 1458 | (while (and src (not (ede-want-file-source-p (car src) file))) |
| 1459 | (setq src (cdr src))) |
| 1460 | src)) |
| 1461 | |
| 1462 | (defun ede-header-file () |
| 1463 | "Return the header file for the current buffer. |
| 1464 | Not all buffers need headers, so return nil if no applicable." |
| 1465 | (if ede-object |
| 1466 | (ede-buffer-header-file ede-object (current-buffer)) |
| 1467 | nil)) |
| 1468 | |
| 1469 | (defmethod ede-buffer-header-file ((this ede-project) buffer) |
| 1470 | "Return nil, projects don't have header files." |
| 1471 | nil) |
| 1472 | |
| 1473 | (defmethod ede-buffer-header-file ((this ede-target) buffer) |
| 1474 | "There are no default header files in EDE. |
| 1475 | Do a quick check to see if there is a Header tag in this buffer." |
| 1476 | (with-current-buffer buffer |
| 1477 | (if (re-search-forward "::Header:: \\([a-zA-Z0-9.]+\\)" nil t) |
| 1478 | (buffer-substring-no-properties (match-beginning 1) |
| 1479 | (match-end 1)) |
| 1480 | (let ((src (ede-target-sourcecode this)) |
| 1481 | (found nil)) |
| 1482 | (while (and src (not found)) |
| 1483 | (setq found (ede-buffer-header-file (car src) (buffer-file-name)) |
| 1484 | src (cdr src))) |
| 1485 | found)))) |
| 1486 | |
| 1487 | (defun ede-documentation-files () |
| 1488 | "Return the documentation files for the current buffer. |
| 1489 | Not all buffers need documentations, so return nil if no applicable. |
| 1490 | Some projects may have multiple documentation files, so return a list." |
| 1491 | (if ede-object |
| 1492 | (ede-buffer-documentation-files ede-object (current-buffer)) |
| 1493 | nil)) |
| 1494 | |
| 1495 | (defmethod ede-buffer-documentation-files ((this ede-project) buffer) |
| 1496 | "Return all documentation in project THIS based on BUFFER." |
| 1497 | ;; Find the info node. |
| 1498 | (ede-documentation this)) |
| 1499 | |
| 1500 | (defmethod ede-buffer-documentation-files ((this ede-target) buffer) |
| 1501 | "Check for some documentation files for THIS. |
| 1502 | Also do a quick check to see if there is a Documentation tag in this BUFFER." |
| 1503 | (with-current-buffer buffer |
| 1504 | (if (re-search-forward "::Documentation:: \\([a-zA-Z0-9.]+\\)" nil t) |
| 1505 | (buffer-substring-no-properties (match-beginning 1) |
| 1506 | (match-end 1)) |
| 1507 | ;; Check the master project |
| 1508 | (let ((cp (ede-toplevel))) |
| 1509 | (ede-buffer-documentation-files cp (current-buffer)))))) |
| 1510 | |
| 1511 | (defmethod ede-documentation ((this ede-project)) |
| 1512 | "Return a list of files that provide documentation. |
| 1513 | Documentation is not for object THIS, but is provided by THIS for other |
| 1514 | files in the project." |
| 1515 | (let ((targ (oref this targets)) |
| 1516 | (proj (oref this subproj)) |
| 1517 | (found nil)) |
| 1518 | (while targ |
| 1519 | (setq found (append (ede-documentation (car targ)) found) |
| 1520 | targ (cdr targ))) |
| 1521 | (while proj |
| 1522 | (setq found (append (ede-documentation (car proj)) found) |
| 1523 | proj (cdr proj))) |
| 1524 | found)) |
| 1525 | |
| 1526 | (defmethod ede-documentation ((this ede-target)) |
| 1527 | "Return a list of files that provide documentation. |
| 1528 | Documentation is not for object THIS, but is provided by THIS for other |
| 1529 | files in the project." |
| 1530 | nil) |
| 1531 | |
| 1532 | (defun ede-html-documentation-files () |
| 1533 | "Return a list of HTML documentation files associated with this project." |
| 1534 | (ede-html-documentation (ede-toplevel)) |
| 1535 | ) |
| 1536 | |
| 1537 | (defmethod ede-html-documentation ((this ede-project)) |
| 1538 | "Return a list of HTML files provided by project THIS." |
| 1539 | |
| 1540 | ) |
| 1541 | |
| 1542 | (defun ede-ecb-project-paths () |
| 1543 | "Return a list of all paths for all active EDE projects. |
| 1544 | This functions is meant for use with ECB." |
| 1545 | (let ((p ede-projects) |
| 1546 | (d nil)) |
| 1547 | (while p |
| 1548 | (setq d (cons (file-name-directory (oref (car p) file)) |
| 1549 | d) |
| 1550 | p (cdr p))) |
| 1551 | d)) |
| 1552 | \f |
| 1553 | ;;; EDE project-autoload methods |
| 1554 | ;; |
| 1555 | (defmethod ede-dir-to-projectfile ((this ede-project-autoload) dir) |
| 1556 | "Return a full file name of project THIS found in DIR. |
| 1557 | Return nil if the project file does not exist." |
| 1558 | (let* ((d (file-name-as-directory dir)) |
| 1559 | (root (ede-project-root-directory this d)) |
| 1560 | (pf (oref this proj-file)) |
| 1561 | (f (cond ((stringp pf) |
| 1562 | (expand-file-name pf (or root d))) |
| 1563 | ((and (symbolp pf) (fboundp pf)) |
| 1564 | (funcall pf (or root d))))) |
| 1565 | ) |
| 1566 | (when (and f (file-exists-p f)) |
| 1567 | f))) |
| 1568 | |
| 1569 | ;;; EDE basic functions |
| 1570 | ;; |
| 1571 | (defun ede-add-project-to-global-list (proj) |
| 1572 | "Add the project PROJ to the master list of projects. |
| 1573 | On success, return the added project." |
| 1574 | (when (not proj) |
| 1575 | (error "No project created to add to master list")) |
| 1576 | (when (not (eieio-object-p proj)) |
| 1577 | (error "Attempt to add Non-object to master project list")) |
| 1578 | (when (not (obj-of-class-p proj ede-project-placeholder)) |
| 1579 | (error "Attempt to add a non-project to the ede projects list")) |
| 1580 | (add-to-list 'ede-projects proj) |
| 1581 | proj) |
| 1582 | |
| 1583 | (defun ede-load-project-file (dir &optional rootreturn) |
| 1584 | "Project file independent way to read a project in from DIR. |
| 1585 | Optional ROOTRETURN will return the root project for DIR." |
| 1586 | ;; Only load if something new is going on. Flush the dirhash. |
| 1587 | (ede-project-directory-remove-hash dir) |
| 1588 | ;; Do the load |
| 1589 | ;;(message "EDE LOAD : %S" file) |
| 1590 | (let* ((file dir) |
| 1591 | (path (expand-file-name (file-name-directory file))) |
| 1592 | (pfc (ede-directory-project-p path)) |
| 1593 | (toppath nil) |
| 1594 | (o nil)) |
| 1595 | (cond |
| 1596 | ((not pfc) |
| 1597 | ;; @TODO - Do we really need to scan? Is this a waste of time? |
| 1598 | ;; Scan upward for a the next project file style. |
| 1599 | (let ((p path)) |
| 1600 | (while (and p (not (ede-directory-project-p p))) |
| 1601 | (setq p (ede-up-directory p))) |
| 1602 | (if p (ede-load-project-file p) |
| 1603 | nil) |
| 1604 | ;; recomment as we go |
| 1605 | ;nil |
| 1606 | )) |
| 1607 | ;; Do nothing if we are buiding an EDE project already |
| 1608 | (ede-constructing |
| 1609 | nil) |
| 1610 | ;; Load in the project in question. |
| 1611 | (t |
| 1612 | (setq toppath (ede-toplevel-project path)) |
| 1613 | ;; We found the top-most directory. Check to see if we already |
| 1614 | ;; have an object defining it's project. |
| 1615 | (setq pfc (ede-directory-project-p toppath t)) |
| 1616 | |
| 1617 | ;; See if it's been loaded before |
| 1618 | (setq o (object-assoc (ede-dir-to-projectfile pfc toppath) 'file |
| 1619 | ede-projects)) |
| 1620 | (if (not o) |
| 1621 | ;; If not, get it now. |
| 1622 | (let ((ede-constructing t)) |
| 1623 | (setq o (funcall (oref pfc load-type) toppath)) |
| 1624 | (when (not o) |
| 1625 | (error "Project type error: :load-type failed to create a project")) |
| 1626 | (ede-add-project-to-global-list o))) |
| 1627 | |
| 1628 | ;; Return the found root project. |
| 1629 | (when rootreturn (set rootreturn o)) |
| 1630 | |
| 1631 | (let (tocheck found) |
| 1632 | ;; Now find the project file belonging to FILE! |
| 1633 | (setq tocheck (list o)) |
| 1634 | (setq file (ede-dir-to-projectfile pfc (expand-file-name path))) |
| 1635 | (while (and tocheck (not found)) |
| 1636 | (let ((newbits nil)) |
| 1637 | (when (car tocheck) |
| 1638 | (if (string= file (oref (car tocheck) file)) |
| 1639 | (setq found (car tocheck))) |
| 1640 | (setq newbits (oref (car tocheck) subproj))) |
| 1641 | (setq tocheck |
| 1642 | (append (cdr tocheck) newbits)))) |
| 1643 | (if (not found) |
| 1644 | (message "No project for %s, but passes project-p test" file) |
| 1645 | ;; Now that the file has been reset inside the project object, do |
| 1646 | ;; the cache maintenance. |
| 1647 | (setq ede-project-cache-files |
| 1648 | (delete (oref found file) ede-project-cache-files))) |
| 1649 | found))))) |
| 1650 | |
| 1651 | (defun ede-parent-project (&optional obj) |
| 1652 | "Return the project belonging to the parent directory. |
| 1653 | Returns nil if there is no previous directory. |
| 1654 | Optional argument OBJ is an object to find the parent of." |
| 1655 | (let* ((proj (or obj ede-object-project)) ;; Current project. |
| 1656 | (root (if obj (ede-project-root obj) |
| 1657 | ede-object-root-project))) |
| 1658 | ;; This case is a SHORTCUT if the project has defined |
| 1659 | ;; a way to calculate the project root. |
| 1660 | (if (and root proj (eq root proj)) |
| 1661 | nil ;; we are at the root. |
| 1662 | ;; Else, we may have a nil proj or root. |
| 1663 | (let* ((thisdir (if obj (oref obj directory) |
| 1664 | default-directory)) |
| 1665 | (updir (ede-up-directory thisdir))) |
| 1666 | (when updir |
| 1667 | ;; If there was no root, perhaps we can derive it from |
| 1668 | ;; updir now. |
| 1669 | (let ((root (or root (ede-directory-get-toplevel-open-project updir)))) |
| 1670 | (or |
| 1671 | ;; This lets us find a subproject under root based on updir. |
| 1672 | (and root |
| 1673 | (ede-find-subproject-for-directory root updir)) |
| 1674 | ;; Try the all structure based search. |
| 1675 | (ede-directory-get-open-project updir) |
| 1676 | ;; Load up the project file as a last resort. |
| 1677 | ;; Last resort since it uses file-truename, and other |
| 1678 | ;; slow features. |
| 1679 | (and (ede-directory-project-p updir) |
| 1680 | (ede-load-project-file |
| 1681 | (file-name-as-directory updir)))))))))) |
| 1682 | |
| 1683 | (defun ede-current-project (&optional dir) |
| 1684 | "Return the current project file. |
| 1685 | If optional DIR is provided, get the project for DIR instead." |
| 1686 | (let ((ans nil)) |
| 1687 | ;; If it matches the current directory, do we have a pre-existing project? |
| 1688 | (when (and (or (not dir) (string= dir default-directory)) |
| 1689 | ede-object-project) |
| 1690 | (setq ans ede-object-project) |
| 1691 | ) |
| 1692 | ;; No current project. |
| 1693 | (when (not ans) |
| 1694 | (let* ((ldir (or dir default-directory))) |
| 1695 | (setq ans (ede-directory-get-open-project ldir)) |
| 1696 | (or ans |
| 1697 | ;; No open project, if this dir pass project-p, then load. |
| 1698 | (when (ede-directory-project-p ldir) |
| 1699 | (setq ans (ede-load-project-file ldir)))))) |
| 1700 | ;; Return what we found. |
| 1701 | ans)) |
| 1702 | |
| 1703 | (defun ede-buffer-object (&optional buffer) |
| 1704 | "Return the target object for BUFFER. |
| 1705 | This function clears cached values and recalculates." |
| 1706 | (save-excursion |
| 1707 | (if (not buffer) (setq buffer (current-buffer))) |
| 1708 | (set-buffer buffer) |
| 1709 | (setq ede-object nil) |
| 1710 | (let ((po (ede-current-project))) |
| 1711 | (if po (setq ede-object (ede-find-target po buffer)))) |
| 1712 | (if (= (length ede-object) 1) |
| 1713 | (setq ede-object (car ede-object))) |
| 1714 | ede-object)) |
| 1715 | |
| 1716 | (defmethod ede-target-in-project-p ((proj ede-project) target) |
| 1717 | "Is PROJ the parent of TARGET? |
| 1718 | If TARGET belongs to a subproject, return that project file." |
| 1719 | (if (and (slot-boundp proj 'targets) |
| 1720 | (memq target (oref proj targets))) |
| 1721 | proj |
| 1722 | (let ((s (oref proj subproj)) |
| 1723 | (ans nil)) |
| 1724 | (while (and s (not ans)) |
| 1725 | (setq ans (ede-target-in-project-p (car s) target)) |
| 1726 | (setq s (cdr s))) |
| 1727 | ans))) |
| 1728 | |
| 1729 | (defun ede-target-parent (target) |
| 1730 | "Return the project which is the parent of TARGET. |
| 1731 | It is recommended you track the project a different way as this function |
| 1732 | could become slow in time." |
| 1733 | ;; @todo - use ede-object-project as a starting point. |
| 1734 | (let ((ans nil) (projs ede-projects)) |
| 1735 | (while (and (not ans) projs) |
| 1736 | (setq ans (ede-target-in-project-p (car projs) target) |
| 1737 | projs (cdr projs))) |
| 1738 | ans)) |
| 1739 | |
| 1740 | (defun ede-maybe-checkout (&optional buffer) |
| 1741 | "Check BUFFER out of VC if necessary." |
| 1742 | (save-excursion |
| 1743 | (if buffer (set-buffer buffer)) |
| 1744 | (if (and buffer-read-only vc-mode |
| 1745 | (y-or-n-p "Checkout Makefile.am from VC? ")) |
| 1746 | (vc-toggle-read-only)))) |
| 1747 | |
| 1748 | (defmethod ede-find-target ((proj ede-project) buffer) |
| 1749 | "Fetch the target in PROJ belonging to BUFFER or nil." |
| 1750 | (with-current-buffer buffer |
| 1751 | (or ede-object |
| 1752 | (if (ede-buffer-mine proj buffer) |
| 1753 | proj |
| 1754 | (let ((targets (oref proj targets)) |
| 1755 | (f nil)) |
| 1756 | (while targets |
| 1757 | (if (ede-buffer-mine (car targets) buffer) |
| 1758 | (setq f (cons (car targets) f))) |
| 1759 | (setq targets (cdr targets))) |
| 1760 | f))))) |
| 1761 | |
| 1762 | (defmethod ede-target-buffer-in-sourcelist ((this ede-target) buffer source) |
| 1763 | "Return non-nil if object THIS is in BUFFER to a SOURCE list. |
| 1764 | Handles complex path issues." |
| 1765 | (member (ede-convert-path this (buffer-file-name buffer)) source)) |
| 1766 | |
| 1767 | (defmethod ede-buffer-mine ((this ede-project) buffer) |
| 1768 | "Return non-nil if object THIS lays claim to the file in BUFFER." |
| 1769 | nil) |
| 1770 | |
| 1771 | (defmethod ede-buffer-mine ((this ede-target) buffer) |
| 1772 | "Return non-nil if object THIS lays claim to the file in BUFFER." |
| 1773 | (condition-case nil |
| 1774 | (ede-target-buffer-in-sourcelist this buffer (oref this source)) |
| 1775 | ;; An error implies a bad match. |
| 1776 | (error nil))) |
| 1777 | |
| 1778 | \f |
| 1779 | ;;; Project mapping |
| 1780 | ;; |
| 1781 | (defun ede-project-buffers (project) |
| 1782 | "Return a list of all active buffers controlled by PROJECT. |
| 1783 | This includes buffers controlled by a specific target of PROJECT." |
| 1784 | (let ((bl (buffer-list)) |
| 1785 | (pl nil)) |
| 1786 | (while bl |
| 1787 | (with-current-buffer (car bl) |
| 1788 | (if (and ede-object (eq (ede-current-project) project)) |
| 1789 | (setq pl (cons (car bl) pl)))) |
| 1790 | (setq bl (cdr bl))) |
| 1791 | pl)) |
| 1792 | |
| 1793 | (defun ede-target-buffers (target) |
| 1794 | "Return a list of buffers that are controlled by TARGET." |
| 1795 | (let ((bl (buffer-list)) |
| 1796 | (pl nil)) |
| 1797 | (while bl |
| 1798 | (with-current-buffer (car bl) |
| 1799 | (if (if (listp ede-object) |
| 1800 | (memq target ede-object) |
| 1801 | (eq ede-object target)) |
| 1802 | (setq pl (cons (car bl) pl)))) |
| 1803 | (setq bl (cdr bl))) |
| 1804 | pl)) |
| 1805 | |
| 1806 | (defun ede-buffers () |
| 1807 | "Return a list of all buffers controlled by an EDE object." |
| 1808 | (let ((bl (buffer-list)) |
| 1809 | (pl nil)) |
| 1810 | (while bl |
| 1811 | (with-current-buffer (car bl) |
| 1812 | (if ede-object |
| 1813 | (setq pl (cons (car bl) pl)))) |
| 1814 | (setq bl (cdr bl))) |
| 1815 | pl)) |
| 1816 | |
| 1817 | (defun ede-map-buffers (proc) |
| 1818 | "Execute PROC on all buffers controlled by EDE." |
| 1819 | (mapcar proc (ede-buffers))) |
| 1820 | |
| 1821 | (defmethod ede-map-project-buffers ((this ede-project) proc) |
| 1822 | "For THIS, execute PROC on all buffers belonging to THIS." |
| 1823 | (mapcar proc (ede-project-buffers this))) |
| 1824 | |
| 1825 | (defmethod ede-map-target-buffers ((this ede-target) proc) |
| 1826 | "For THIS, execute PROC on all buffers belonging to THIS." |
| 1827 | (mapcar proc (ede-target-buffers this))) |
| 1828 | |
| 1829 | ;; other types of mapping |
| 1830 | (defmethod ede-map-subprojects ((this ede-project) proc) |
| 1831 | "For object THIS, execute PROC on all direct subprojects. |
| 1832 | This function does not apply PROC to sub-sub projects. |
| 1833 | See also `ede-map-all-subprojects'." |
| 1834 | (mapcar proc (oref this subproj))) |
| 1835 | |
| 1836 | (defmethod ede-map-all-subprojects ((this ede-project) allproc) |
| 1837 | "For object THIS, execute PROC on THIS and all subprojects. |
| 1838 | This function also applies PROC to sub-sub projects. |
| 1839 | See also `ede-map-subprojects'." |
| 1840 | (apply 'append |
| 1841 | (list (funcall allproc this)) |
| 1842 | (ede-map-subprojects |
| 1843 | this |
| 1844 | (lambda (sp) |
| 1845 | (ede-map-all-subprojects sp allproc)) |
| 1846 | ))) |
| 1847 | |
| 1848 | ;; (ede-map-all-subprojects (ede-load-project-file "../semantic/") (lambda (sp) (oref sp file))) |
| 1849 | |
| 1850 | (defmethod ede-map-targets ((this ede-project) proc) |
| 1851 | "For object THIS, execute PROC on all targets." |
| 1852 | (mapcar proc (oref this targets))) |
| 1853 | |
| 1854 | (defmethod ede-map-any-target-p ((this ede-project) proc) |
| 1855 | "For project THIS, map PROC to all targets and return if any non-nil. |
| 1856 | Return the first non-nil value returned by PROC." |
| 1857 | (eval (cons 'or (ede-map-targets this proc)))) |
| 1858 | |
| 1859 | \f |
| 1860 | ;;; Some language specific methods. |
| 1861 | ;; |
| 1862 | ;; These items are needed by ede-cpp-root to add better support for |
| 1863 | ;; configuring items for Semantic. |
| 1864 | (defun ede-apply-preprocessor-map () |
| 1865 | "Apply preprocessor tables onto the current buffer." |
| 1866 | (when (and ede-object (boundp 'semantic-lex-spp-macro-symbol-obarray)) |
| 1867 | (let* ((objs ede-object) |
| 1868 | (map (ede-preprocessor-map (if (consp objs) |
| 1869 | (car objs) |
| 1870 | objs)))) |
| 1871 | (when map |
| 1872 | ;; We can't do a require for the below symbol. |
| 1873 | (setq semantic-lex-spp-macro-symbol-obarray |
| 1874 | (semantic-lex-make-spp-table map))) |
| 1875 | (when (consp objs) |
| 1876 | (message "Choosing preprocessor syms for project %s" |
| 1877 | (object-name (car objs))))))) |
| 1878 | |
| 1879 | (defmethod ede-system-include-path ((this ede-project)) |
| 1880 | "Get the system include path used by project THIS." |
| 1881 | nil) |
| 1882 | |
| 1883 | (defmethod ede-preprocessor-map ((this ede-project)) |
| 1884 | "Get the pre-processor map for project THIS." |
| 1885 | nil) |
| 1886 | |
| 1887 | (defmethod ede-system-include-path ((this ede-target)) |
| 1888 | "Get the system include path used by project THIS." |
| 1889 | nil) |
| 1890 | |
| 1891 | (defmethod ede-preprocessor-map ((this ede-target)) |
| 1892 | "Get the pre-processor map for project THIS." |
| 1893 | nil) |
| 1894 | |
| 1895 | \f |
| 1896 | ;;; Project-local variables |
| 1897 | ;; |
| 1898 | (defun ede-make-project-local-variable (variable &optional project) |
| 1899 | "Make VARIABLE project-local to PROJECT." |
| 1900 | (if (not project) (setq project (ede-current-project))) |
| 1901 | (if (assoc variable (oref project local-variables)) |
| 1902 | nil |
| 1903 | (oset project local-variables (cons (list variable) |
| 1904 | (oref project local-variables))) |
| 1905 | (dolist (b (ede-project-buffers project)) |
| 1906 | (with-current-buffer b |
| 1907 | (make-local-variable variable))))) |
| 1908 | |
| 1909 | (defmethod ede-set-project-variables ((project ede-project) &optional buffer) |
| 1910 | "Set variables local to PROJECT in BUFFER." |
| 1911 | (if (not buffer) (setq buffer (current-buffer))) |
| 1912 | (with-current-buffer buffer |
| 1913 | (dolist (v (oref project local-variables)) |
| 1914 | (make-local-variable (car v)) |
| 1915 | ;; set it's value here? |
| 1916 | (set (car v) (cdr v))))) |
| 1917 | |
| 1918 | (defun ede-set (variable value &optional proj) |
| 1919 | "Set the project local VARIABLE to VALUE. |
| 1920 | If VARIABLE is not project local, just use set. Optional argument PROJ |
| 1921 | is the project to use, instead of `ede-current-project'." |
| 1922 | (let ((p (or proj (ede-current-project))) |
| 1923 | a) |
| 1924 | (if (and p (setq a (assoc variable (oref p local-variables)))) |
| 1925 | (progn |
| 1926 | (setcdr a value) |
| 1927 | (dolist (b (ede-project-buffers p)) |
| 1928 | (with-current-buffer b |
| 1929 | (set variable value)))) |
| 1930 | (set variable value)) |
| 1931 | (ede-commit-local-variables p)) |
| 1932 | value) |
| 1933 | |
| 1934 | (defmethod ede-commit-local-variables ((proj ede-project)) |
| 1935 | "Commit change to local variables in PROJ." |
| 1936 | nil) |
| 1937 | |
| 1938 | \f |
| 1939 | ;;; Accessors for more complex types where oref is inappropriate. |
| 1940 | ;; |
| 1941 | (defmethod ede-target-sourcecode ((this ede-target)) |
| 1942 | "Return the sourcecode objects which THIS permits." |
| 1943 | (let ((sc (oref this sourcetype)) |
| 1944 | (rs nil)) |
| 1945 | (while (and (listp sc) sc) |
| 1946 | (setq rs (cons (symbol-value (car sc)) rs) |
| 1947 | sc (cdr sc))) |
| 1948 | rs)) |
| 1949 | |
| 1950 | \f |
| 1951 | ;;; Debugging. |
| 1952 | |
| 1953 | (defun ede-adebug-project () |
| 1954 | "Run adebug against the current EDE project. |
| 1955 | Display the results as a debug list." |
| 1956 | (interactive) |
| 1957 | (require 'data-debug) |
| 1958 | (when (ede-current-project) |
| 1959 | (data-debug-new-buffer "*Analyzer ADEBUG*") |
| 1960 | (data-debug-insert-object-slots (ede-current-project) "") |
| 1961 | )) |
| 1962 | |
| 1963 | (defun ede-adebug-project-parent () |
| 1964 | "Run adebug against the current EDE parent project. |
| 1965 | Display the results as a debug list." |
| 1966 | (interactive) |
| 1967 | (require 'data-debug) |
| 1968 | (when (ede-parent-project) |
| 1969 | (data-debug-new-buffer "*Analyzer ADEBUG*") |
| 1970 | (data-debug-insert-object-slots (ede-parent-project) "") |
| 1971 | )) |
| 1972 | |
| 1973 | (defun ede-adebug-project-root () |
| 1974 | "Run adebug against the current EDE parent project. |
| 1975 | Display the results as a debug list." |
| 1976 | (interactive) |
| 1977 | (require 'data-debug) |
| 1978 | (when (ede-toplevel) |
| 1979 | (data-debug-new-buffer "*Analyzer ADEBUG*") |
| 1980 | (data-debug-insert-object-slots (ede-toplevel) "") |
| 1981 | )) |
| 1982 | \f |
| 1983 | ;;; Hooks & Autoloads |
| 1984 | ;; |
| 1985 | ;; These let us watch various activities, and respond appropriately. |
| 1986 | |
| 1987 | ;; (add-hook 'edebug-setup-hook |
| 1988 | ;; (lambda () |
| 1989 | ;; (def-edebug-spec ede-with-projectfile |
| 1990 | ;; (form def-body)))) |
| 1991 | |
| 1992 | (provide 'ede) |
| 1993 | |
| 1994 | ;; Include this last because it depends on ede. |
| 1995 | (require 'ede/files) |
| 1996 | |
| 1997 | ;; If this does not occur after the provide, we can get a recursive |
| 1998 | ;; load. Yuck! |
| 1999 | (if (featurep 'speedbar) |
| 2000 | (ede-speedbar-file-setup) |
| 2001 | (add-hook 'speedbar-load-hook 'ede-speedbar-file-setup)) |
| 2002 | |
| 2003 | ;; arch-tag: 0e1e0eba-484f-4119-abdb-30951f725705 |
| 2004 | ;;; ede.el ends here |