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