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