Mercurial > emacs
changeset 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.
line wrap: on
line diff
--- a/lisp/ChangeLog Sun Sep 20 14:22:30 2009 +0000 +++ b/lisp/ChangeLog Sun Sep 20 15:06:05 2009 +0000 @@ -1,12 +1,18 @@ 2009-09-20 Chong Yidong <cyd@stupidchicken.com> + * cedet/ede.el, cedet/ede/*.el: New files. + + * cedet/cedet.el: Require ede. + * progmodes/autoconf.el: Provide autoconf as well. * files.el (auto-mode-alist): Use emacs-lisp-mode for Project.ede. * cedet/semantic/bovine/gcc.el (semantic-gcc-test-output-parser) (semantic-gcc-test-output-parser-this-machine): - * cedet/semantic/symref/filter.el (semantic-symref-test-count-hits-in-tag): + * cedet/semantic/symref/filter.el (semantic-symref-test-count-hits-in-tag) + (semantic-symref-hits-in-region): Require semantic/idle. + * cedet/semantic/db-global.el (semanticdb-test-gnu-global): * cedet/semantic/tag-write.el (semantic-tag-write-test) (semantic-tag-write-list-test):
--- a/lisp/cedet/cedet.el Sun Sep 20 14:22:30 2009 +0000 +++ b/lisp/cedet/cedet.el Sun Sep 20 15:06:05 2009 +0000 @@ -50,7 +50,7 @@ (require 'eieio) (require 'semantic) ;; (require 'srecode) -;; (require 'ede) +(require 'ede) (require 'speedbar) (defconst cedet-packages
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/cedet/ede.el Sun Sep 20 15:06:05 2009 +0000 @@ -0,0 +1,2013 @@ +;;; ede.el --- Emacs Development Environment gloss + +;;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, +;;; 2007, 2008, 2009 Free Software Foundation, Inc. + +;; Author: Eric M. Ludlam <zappo@gnu.org> +;; Keywords: project, make + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; EDE is the top level Lisp interface to a project management scheme +;; for Emacs. Emacs does many things well, including editing, +;; building, and debugging. Folks migrating from other IDEs don't +;; seem to think this qualifies, however, because they still have to +;; write the makefiles, and specify parameters to programs. +;; +;; This EDE mode will attempt to link these diverse programs together +;; into a comprehensive single interface, instead of a bunch of +;; different ones. + +;;; Install +;; +;; This command enables project mode on all files. +;; +;; (global-ede-mode t) + +(require 'eieio) +(require 'eieio-speedbar) +(require 'ede/source) +(require 'ede/loaddefs) + +(declare-function ede-convert-path "ede/files") +(declare-function ede-directory-get-open-project "ede/files") +(declare-function ede-directory-get-toplevel-open-project "ede/files") +(declare-function ede-directory-project-p "ede/files") +(declare-function ede-find-subproject-for-directory "ede/files") +(declare-function ede-project-directory-remove-hash "ede/files") +(declare-function ede-project-root "ede/files") +(declare-function ede-project-root-directory "ede/files") +(declare-function ede-toplevel "ede/files") +(declare-function ede-toplevel-project "ede/files") +(declare-function ede-up-directory "ede/files") +(declare-function data-debug-new-buffer "data-debug") +(declare-function data-debug-insert-object-slots "eieio-datadebug") +(declare-function semantic-lex-make-spp-table "semantic/lex-spp") + +(defconst ede-version "1.0pre7" + "Current version of the Emacs EDE.") + +;;; Code: +(defun ede-version () + "Display the current running version of EDE." + (interactive) (message "EDE %s" ede-version)) + +(defgroup ede nil + "Emacs Development Environment gloss." + :group 'tools + :group 'convenience + ) + +(defcustom ede-auto-add-method 'ask + "Whether a new source file shoud be automatically added to a target. +Whenever a new file is encountered in a directory controlled by a +project file, all targets are queried to see if it should be added. +If the value is 'always, then the new file is added to the first +target encountered. If the value is 'multi-ask, then if more than one +target wants the file, the user is asked. If only one target wants +the file, then then it is automatically added to that target. If the +value is 'ask, then the user is always asked, unless there is no +target willing to take the file. 'never means never perform the check." + :group 'ede + :type '(choice (const always) + (const multi-ask) + (const ask) + (const never))) + +(defcustom ede-debug-program-function 'gdb + "Default Emacs command used to debug a target." + :group 'ede + :type 'sexp) ; make this be a list of options some day + + +;;; Top level classes for projects and targets + +(defclass ede-project-autoload () + ((name :initarg :name + :documentation "Name of this project type") + (file :initarg :file + :documentation "The lisp file belonging to this class.") + (proj-file :initarg :proj-file + :documentation "Name of a project file of this type.") + (proj-root :initarg :proj-root + :type function + :documentation "A function symbol to call for the project root. +This function takes no arguments, and returns the current directories +root, if available. Leave blank to use the EDE directory walking +routine instead.") + (initializers :initarg :initializers + :initform nil + :documentation + "Initializers passed to the project object. +These are used so there can be multiple types of projects +associated with a single object class, based on the initilizeres used.") + (load-type :initarg :load-type + :documentation "Fn symbol used to load this project file.") + (class-sym :initarg :class-sym + :documentation "Symbol representing the project class to use.") + (new-p :initarg :new-p + :initform t + :documentation + "Non-nil if this is an option when a user creates a project.") + ) + "Class representing minimal knowledge set to run preliminary EDE functions. +When more advanced functionality is needed from a project type, that projects +type is required and the load function used.") + +(defvar ede-project-class-files + (list + (ede-project-autoload "edeproject-makefile" + :name "Make" :file 'ede/proj + :proj-file "Project.ede" + :load-type 'ede-proj-load + :class-sym 'ede-proj-project) + (ede-project-autoload "edeproject-automake" + :name "Automake" :file 'ede/proj + :proj-file "Project.ede" + :initializers '(:makefile-type Makefile.am) + :load-type 'ede-proj-load + :class-sym 'ede-proj-project) + (ede-project-autoload "automake" + :name "automake" :file 'ede/project-am + :proj-file "Makefile.am" + :load-type 'project-am-load + :class-sym 'project-am-makefile + :new-p nil) + (ede-project-autoload "cpp-root" + :name "CPP ROOT" :file 'ede/cpp-root + :proj-file 'ede-cpp-root-project-file-for-dir + :proj-root 'ede-cpp-root-project-root + :load-type 'ede-cpp-root-load + :class-sym 'ede-cpp-root + :new-p nil) + (ede-project-autoload "emacs" + :name "EMACS ROOT" :file 'ede/emacs + :proj-file "src/emacs.c" + :proj-root 'ede-emacs-project-root + :load-type 'ede-emacs-load + :class-sym 'ede-emacs-project + :new-p nil) + (ede-project-autoload "linux" + :name "LINUX ROOT" :file 'ede/linux + :proj-file "scripts/ver_linux" + :proj-root 'ede-linux-project-root + :load-type 'ede-linux-load + :class-sym 'ede-linux-project + :new-p nil) + (ede-project-autoload "simple-overlay" + :name "Simple" :file 'ede/simple + :proj-file 'ede-simple-projectfile-for-dir + :load-type 'ede-simple-load + :class-sym 'ede-simple-project)) + "List of vectos defining how to determine what type of projects exist.") + +;;; Generic project information manager objects + +(defclass ede-target (eieio-speedbar-directory-button) + ((buttonface :initform speedbar-file-face) ;override for superclass + (name :initarg :name + :type string + :custom string + :label "Name" + :group (default name) + :documentation "Name of this target.") + ;; @todo - I think this should be "dir", and not "path". + (path :initarg :path + :type string + ;:custom string + ;:label "Path to target" + ;:group (default name) + :documentation "The path to the sources of this target. +Relative to the path of the project it belongs to.") + (source :initarg :source + :initform nil + ;; I'd prefer a list of strings. + :type list + :custom (repeat (string :tag "File")) + :label "Source Files" + :group (default source) + :documentation "Source files in this target.") + (versionsource :initarg :versionsource + :initform nil + :type list + :custom (repeat (string :tag "File")) + :label "Source Files with Version String" + :group (source) + :documentation + "Source files with a version string in them. +These files are checked for a version string whenever the EDE version +of the master project is changed. When strings are found, the version +previously there is updated.") + ;; Class level slots + ;; +; (takes-compile-command :allocation :class +; :initarg :takes-compile-command +; :type boolean +; :initform nil +; :documentation +; "Non-nil if this target requires a user approved command.") + (sourcetype :allocation :class + :type list ;; list of symbols + :documentation + "A list of `ede-sourcecode' objects this class will handle. +This is used to match target objects with the compilers they can use, and +which files this object is interested in." + :accessor ede-object-sourcecode) + (keybindings :allocation :class + :initform (("D" . ede-debug-target)) + :documentation +"Keybindings specialized to this type of target." + :accessor ede-object-keybindings) + (menu :allocation :class + :initform ( [ "Debug target" ede-debug-target + (and ede-object + (obj-of-class-p ede-object ede-target)) ] + ) + :documentation "Menu specialized to this type of target." + :accessor ede-object-menu) + ) + "A top level target to build.") + +(defclass ede-project-placeholder (eieio-speedbar-directory-button) + ((name :initarg :name + :initform "Untitled" + :type string + :custom string + :label "Name" + :group (default name) + :documentation "The name used when generating distribution files.") + (version :initarg :version + :initform "1.0" + :type string + :custom string + :label "Version" + :group (default name) + :documentation "The version number used when distributing files.") + (directory :type string + :initarg :directory + :documentation "Directory this project is associated with.") + (dirinode :documentation "The inode id for :directory.") + (file :type string + :initarg :file + :documentation "File name where this project is stored.") + (rootproject ; :initarg - no initarg, don't save this slot! + :initform nil + :type (or null ede-project-placeholder-child) + :documentation "Pointer to our root project.") + ) + "Placeholder object for projects not loaded into memory. +Projects placeholders will be stored in a user specific location +and querying them will cause the actual project to get loaded.") + +(defclass ede-project (ede-project-placeholder) + ((subproj :initform nil + :type list + :documentation "Sub projects controlled by this project. +For Automake based projects, each directory is treated as a project.") + (targets :initarg :targets + :type list + :custom (repeat (object :objectcreatefcn ede-new-target-custom)) + :label "Local Targets" + :group (targets) + :documentation "List of top level targets in this project.") + (locate-obj :type (or null ede-locate-base-child) + :documentation + "A locate object to use as a backup to `ede-expand-filename'.") + (tool-cache :initarg :tool-cache + :type list + :custom (repeat object) + :label "Tool: " + :group tools + :documentation "List of tool cache configurations in this project. +This allows any tool to create, manage, and persist project-specific settings.") + (mailinglist :initarg :mailinglist + :initform "" + :type string + :custom string + :label "Mailing List Address" + :group name + :documentation + "An email address where users might send email for help.") + (web-site-url :initarg :web-site-url + :initform "" + :type string + :custom string + :label "Web Site URL" + :group name + :documentation "URL to this projects web site. +This is a URL to be sent to a web site for documentation.") + (web-site-directory :initarg :web-site-directory + :initform "" + :custom string + :label "Web Page Directory" + :group name + :documentation + "A directory where web pages can be found by Emacs. +For remote locations use a path compatible with ange-ftp or EFS. +You can also use TRAMP for use with rcp & scp.") + (web-site-file :initarg :web-site-file + :initform "" + :custom string + :label "Web Page File" + :group name + :documentation + "A file which contains the home page for this project. +This file can be relative to slot `web-site-directory'. +This can be a local file, use ange-ftp, EFS, or TRAMP.") + (ftp-site :initarg :ftp-site + :initform "" + :type string + :custom string + :label "FTP site" + :group name + :documentation + "FTP site where this project's distribution can be found. +This FTP site should be in Emacs form, as needed by `ange-ftp', but can +also be of a form used by TRAMP for use with scp, or rcp.") + (ftp-upload-site :initarg :ftp-upload-site + :initform "" + :type string + :custom string + :label "FTP Upload site" + :group name + :documentation + "FTP Site to upload new distributions to. +This FTP site should be in Emacs form as needed by `ange-ftp'. +If this slot is nil, then use `ftp-site' instead.") + (configurations :initarg :configurations + :initform ("debug" "release") + :type list + :custom (repeat string) + :label "Configuration Options" + :group (settings) + :documentation "List of available configuration types. +Individual target/project types can form associations between a configuration, +and target specific elements such as build variables.") + (configuration-default :initarg :configuration-default + :initform "debug" + :custom string + :label "Current Configuration" + :group (settings) + :documentation "The default configuration.") + (local-variables :initarg :local-variables + :initform nil + :custom (repeat (cons (sexp :tag "Variable") + (sexp :tag "Value"))) + :label "Project Local Variables" + :group (settings) + :documentation "Project local variables") + (keybindings :allocation :class + :initform (("D" . ede-debug-target)) + :documentation "Keybindings specialized to this type of target." + :accessor ede-object-keybindings) + (menu :allocation :class + :initform + ( + [ "Update Version" ede-update-version ede-object ] + [ "Version Control Status" ede-vc-project-directory ede-object ] + [ "Edit Project Homepage" ede-edit-web-page + (and ede-object (oref (ede-toplevel) web-site-file)) ] + [ "Browse Project URL" ede-web-browse-home + (and ede-object + (not (string= "" (oref (ede-toplevel) web-site-url)))) ] + "--" + [ "Rescan Project Files" ede-rescan-toplevel t ] + [ "Edit Projectfile" ede-edit-file-target + (and ede-object + (or (listp ede-object) + (not (obj-of-class-p ede-object ede-project)))) ] + ) + :documentation "Menu specialized to this type of target." + :accessor ede-object-menu) + ) + "Top level EDE project specification. +All specific project types must derive from this project." + :method-invocation-order :depth-first) + +;;; Management variables + +(defvar ede-projects nil + "A list of all active projects currently loaded in Emacs.") + +(defvar ede-object-root-project nil + "The current buffer's current root project. +If a file is under a project, this specifies the project that is at +the root of a project tree.") +(make-variable-buffer-local 'ede-object-root-project) + +(defvar ede-object-project nil + "The current buffer's current project at that level. +If a file is under a project, this specifies the project that contains the +current target.") +(make-variable-buffer-local 'ede-object-project) + +(defvar ede-object nil + "The current buffer's target object. +This object's class determines how to compile and debug from a buffer.") +(make-variable-buffer-local 'ede-object) + +(defvar ede-selected-object nil + "The currently user-selected project or target. +If `ede-object' is nil, then commands will operate on this object.") + +(defvar ede-constructing nil + "Non nil when constructing a project hierarchy.") + +(defvar ede-deep-rescan nil + "Non nil means scan down a tree, otherwise rescans are top level only. +Do not set this to non-nil globally. It is used internally.") + +;;; The EDE persistent cache. +;; +(defcustom ede-project-placeholder-cache-file + (expand-file-name "~/.projects.ede") + "File containing the list of projects EDE has viewed." + :group 'ede + :type 'file) + +(defvar ede-project-cache-files nil + "List of project files EDE has seen before.") + +(defun ede-save-cache () + "Save a cache of EDE objects that Emacs has seen before." + (interactive) + (let ((p ede-projects) + (c ede-project-cache-files) + (recentf-exclude '(ignore)) + ) + (condition-case nil + (progn + (set-buffer (find-file-noselect ede-project-placeholder-cache-file t)) + (erase-buffer) + (insert ";; EDE project cache file. +;; This contains a list of projects you have visited.\n(") + (while p + (when (and (car p) (ede-project-p p)) + (let ((f (oref (car p) file))) + (when (file-exists-p f) + (insert "\n \"" f "\"")))) + (setq p (cdr p))) + (while c + (insert "\n \"" (car c) "\"") + (setq c (cdr c))) + (insert "\n)\n") + (condition-case nil + (save-buffer 0) + (error + (message "File %s could not be saved." + ede-project-placeholder-cache-file))) + (kill-buffer (current-buffer)) + ) + (error + (message "File %s could not be read." + ede-project-placeholder-cache-file)) + + ))) + +(defun ede-load-cache () + "Load the cache of EDE projects." + (save-excursion + (let ((cachebuffer nil)) + (condition-case nil + (progn + (setq cachebuffer + (find-file-noselect ede-project-placeholder-cache-file t)) + (set-buffer cachebuffer) + (goto-char (point-min)) + (let ((c (read (current-buffer))) + (new nil) + (p ede-projects)) + ;; Remove loaded projects from the cache. + (while p + (setq c (delete (oref (car p) file) c)) + (setq p (cdr p))) + ;; Remove projects that aren't on the filesystem + ;; anymore. + (while c + (when (file-exists-p (car c)) + (setq new (cons (car c) new))) + (setq c (cdr c))) + ;; Save it + (setq ede-project-cache-files (nreverse new)))) + (error nil)) + (when cachebuffer (kill-buffer cachebuffer)) + ))) + +;;; Important macros for doing commands. +;; +(defmacro ede-with-projectfile (obj &rest forms) + "For the project in which OBJ resides, execute FORMS." + (list 'save-window-excursion + (list 'let* (list + (list 'pf + (list 'if (list 'obj-of-class-p + obj 'ede-target) + ;; @todo -I think I can change + ;; this to not need ede-load-project-file + ;; but I'm not sure how to test well. + (list 'ede-load-project-file + (list 'oref obj 'path)) + obj)) + '(dbka (get-file-buffer (oref pf file)))) + '(if (not dbka) (find-file (oref pf file)) + (switch-to-buffer dbka)) + (cons 'progn forms) + '(if (not dbka) (kill-buffer (current-buffer)))))) +(put 'ede-with-projectfile 'lisp-indent-function 1) + + +;;; Prompting +;; +(defun ede-singular-object (prompt) + "Using PROMPT, choose a single object from the current buffer." + (if (listp ede-object) + (ede-choose-object prompt ede-object) + ede-object)) + +(defun ede-choose-object (prompt list-o-o) + "Using PROMPT, ask the user which OBJECT to use based on the name field. +Argument LIST-O-O is the list of objects to choose from." + (let* ((al (object-assoc-list 'name list-o-o)) + (ans (completing-read prompt al nil t))) + (setq ans (assoc ans al)) + (cdr ans))) + +;;; Menu and Keymap + +(defvar ede-minor-mode nil + "Non-nil in EDE controlled buffers.") +(make-variable-buffer-local 'ede-minor-mode) + +;; We don't want to waste space. There is a menu after all. +(add-to-list 'minor-mode-alist '(ede-minor-mode "")) + +(defvar ede-minor-keymap + (let ((map (make-sparse-keymap)) + (pmap (make-sparse-keymap))) + (define-key pmap "e" 'ede-edit-file-target) + (define-key pmap "a" 'ede-add-file) + (define-key pmap "d" 'ede-remove-file) + (define-key pmap "t" 'ede-new-target) + (define-key pmap "g" 'ede-rescan-toplevel) + (define-key pmap "s" 'ede-speedbar) + (define-key pmap "l" 'ede-load-project-file) + (define-key pmap "f" 'ede-find-file) + (define-key pmap "C" 'ede-compile-project) + (define-key pmap "c" 'ede-compile-target) + (define-key pmap "\C-c" 'ede-compile-selected) + (define-key pmap "D" 'ede-debug-target) + ;; bind our submap into map + (define-key map "\C-c." pmap) + map) + "Keymap used in project minor mode.") + +(if ede-minor-keymap + (progn + (easy-menu-define + ede-minor-menu ede-minor-keymap "Project Minor Mode Menu" + '("Project" + ( "Build" :filter ede-build-forms-menu ) + ( "Project Options" :filter ede-project-forms-menu ) + ( "Target Options" :filter ede-target-forms-menu ) + [ "Create Project" ede-new (not ede-object) ] + [ "Load a project" ede t ] +;; [ "Select Active Target" 'undefined nil ] +;; [ "Remove Project" 'undefined nil ] + "---" + [ "Find File in Project..." ede-find-file t ] + ( "Customize" :filter ede-customize-forms-menu ) + [ "View Project Tree" ede-speedbar t ] + )) + )) + +;; Allow re-insertion of a new keymap +(let ((a (assoc 'ede-minor-mode minor-mode-map-alist))) + (if a + (setcdr a ede-minor-keymap) + (add-to-list 'minor-mode-map-alist + (cons 'ede-minor-mode ede-minor-keymap)) + )) + +(defun ede-menu-obj-of-class-p (class) + "Return non-nil if some member of `ede-object' is a child of CLASS." + (if (listp ede-object) + (ede-or (mapcar (lambda (o) (obj-of-class-p o class)) ede-object)) + (obj-of-class-p ede-object class))) + +(defun ede-build-forms-menu (menu-def) + "Create a sub menu for building different parts of an EDE system. +Argument MENU-DEF is the menu definition to use." + (easy-menu-filter-return + (easy-menu-create-menu + "Build Forms" + (let ((obj (ede-current-project)) + (newmenu nil) ;'([ "Build Selected..." ede-compile-selected t ])) + targets + targitems + ede-obj + (tskip nil)) + (if (not obj) + nil + (setq targets (when (slot-boundp obj 'targets) + (oref obj targets)) + ede-obj (if (listp ede-object) ede-object (list ede-object))) + ;; First, collect the build items from the project + (setq newmenu (append newmenu (ede-menu-items-build obj t))) + ;; Second, Declare the current target menu items + (if (and ede-obj (ede-menu-obj-of-class-p ede-target)) + (while ede-obj + (setq newmenu (append newmenu + (ede-menu-items-build (car ede-obj) t)) + tskip (car ede-obj) + ede-obj (cdr ede-obj)))) + ;; Third, by name, enable builds for other local targets + (while targets + (unless (eq tskip (car targets)) + (setq targitems (ede-menu-items-build (car targets) nil)) + (setq newmenu + (append newmenu + (if (= 1 (length targitems)) + targitems + (cons (ede-name (car targets)) + targitems)))) + ) + (setq targets (cdr targets))) + ;; Fourth, build sub projects. + ;; -- nerp + ;; Fifth, Add make distribution + (append newmenu (list [ "Make distribution" ede-make-dist t ])) + ))))) + +(defun ede-target-forms-menu (menu-def) + "Create a target MENU-DEF based on the object belonging to this buffer." + (easy-menu-filter-return + (easy-menu-create-menu + "Target Forms" + (let ((obj (or ede-selected-object ede-object))) + (append + '([ "Add File" ede-add-file (ede-current-project) ] + [ "Remove File" ede-remove-file + (and ede-object + (or (listp ede-object) + (not (obj-of-class-p ede-object ede-project)))) ] + "-") + (if (not obj) + nil + (if (and (not (listp obj)) (oref obj menu)) + (oref obj menu) + (when (listp obj) + ;; This is bad, but I'm not sure what else to do. + (oref (car obj) menu))))))))) + +(defun ede-project-forms-menu (menu-def) + "Create a target MENU-DEF based on the object belonging to this buffer." + (easy-menu-filter-return + (easy-menu-create-menu + "Project Forms" + (let* ((obj (ede-current-project)) + (class (if obj (object-class obj))) + (menu nil)) + (condition-case err + (progn + (while (and class (slot-exists-p class 'menu)) + ;;(message "Looking at class %S" class) + (setq menu (append menu (oref class menu)) + class (class-parent class)) + (if (listp class) (setq class (car class)))) + (append + '( [ "Add Target" ede-new-target (ede-current-project) ] + [ "Remove Target" ede-delete-target ede-object ] + "-") + menu + )) + (error (message "Err found: %S" err) + menu) + ))))) + +(defun ede-customize-forms-menu (menu-def) + "Create a menu of the project, and targets that can be customized. +Argument MENU-DEF is the definition of the current menu." + (easy-menu-filter-return + (easy-menu-create-menu + "Customize Project" + (let* ((obj (ede-current-project)) + (targ (when (slot-boundp obj 'targets) + (oref obj targets)))) + (when obj + ;; Make custom menus for everything here. + (append (list + (cons (concat "Project " (ede-name obj)) + (eieio-customize-object-group obj)) + [ "Reorder Targets" ede-project-sort-targets t ] + ) + (mapcar (lambda (o) + (cons (concat "Target " (ede-name o)) + (eieio-customize-object-group o))) + targ))))))) + + +(defun ede-apply-object-keymap (&optional default) + "Add target specific keybindings into the local map. +Optional argument DEFAULT indicates if this should be set to the default +version of the keymap." + (let ((object (or ede-object ede-selected-object))) + (condition-case nil + (let ((keys (ede-object-keybindings object))) + (while keys + (local-set-key (concat "\C-c." (car (car keys))) + (cdr (car keys))) + (setq keys (cdr keys)))) + (error nil)))) + +;;; Menu building methods for building +;; +(defmethod ede-menu-items-build ((obj ede-project) &optional current) + "Return a list of menu items for building project OBJ. +If optional argument CURRENT is non-nil, return sub-menu code." + (if current + (list [ "Build Current Project" ede-compile-project t ]) + (list (vector + (list + (concat "Build Project " (ede-name obj)) + `(project-compile-project ,obj)))))) + +(defmethod ede-menu-items-build ((obj ede-target) &optional current) + "Return a list of menu items for building target OBJ. +If optional argument CURRENT is non-nil, return sub-menu code." + (if current + (list [ "Build Current Target" ede-compile-target t ]) + (list (vector + (concat "Build Target " (ede-name obj)) + `(project-compile-target ,obj) + t)))) + +;;; Mode Declarations +;; +(eval-and-compile + (autoload 'ede-dired-minor-mode "ede-dired" "EDE commands for dired" t)) + +(defun ede-apply-target-options () + "Apply options to the current buffer for the active project/target." + (if (ede-current-project) + (ede-set-project-variables (ede-current-project))) + (ede-apply-object-keymap) + (ede-apply-preprocessor-map) + ) + +(defun ede-turn-on-hook () + "Turn on EDE minor mode in the current buffer if needed. +To be used in hook functions." + (if (or (and (stringp (buffer-file-name)) + (stringp default-directory)) + ;; Emacs 21 has no buffer file name for directory edits. + ;; so we need to add these hacks in. + (eq major-mode 'dired-mode) + (eq major-mode 'vc-dired-mode)) + (ede-minor-mode 1))) + +(defun ede-minor-mode (&optional arg) + "Project minor mode. +If this file is contained, or could be contained in an EDE +controlled project, then this mode should be active. + +With argument ARG positive, turn on the mode. Negative, turn off the +mode. nil means to toggle the mode." + (interactive "P") + (if (or (eq major-mode 'dired-mode) + (eq major-mode 'vc-dired-mode)) + (ede-dired-minor-mode arg) + (progn + (setq ede-minor-mode + (not (or (and (null arg) ede-minor-mode) + (<= (prefix-numeric-value arg) 0)))) + (if (and ede-minor-mode (not ede-constructing) + (ede-directory-project-p default-directory t)) + (let* ((ROOT nil) + (proj (ede-directory-get-open-project default-directory + 'ROOT))) + (when (not proj) + ;; @todo - this could be wasteful. + (setq proj (ede-load-project-file default-directory 'ROOT))) + + (setq ede-object-project proj) + (setq ede-object-root-project + (or ROOT (ede-project-root proj))) + (setq ede-object (ede-buffer-object)) + (if (and (not ede-object) ede-object-project) + (ede-auto-add-to-target)) + (ede-apply-target-options)) + ;; If we fail to have a project here, turn it back off. + (if (not (interactive-p)) + (setq ede-minor-mode nil)))))) + +(defun ede-reset-all-buffers (onoff) + "Reset all the buffers due to change in EDE. +ONOFF indicates enabling or disabling the mode." + (let ((b (buffer-list))) + (while b + (when (buffer-file-name (car b)) + (ede-buffer-object (car b)) + ) + (setq b (cdr b))))) + +;;;###autoload +(defun global-ede-mode (arg) + "Turn on variable `ede-minor-mode' mode when ARG is positive. +If ARG is negative, disable. Toggle otherwise." + (interactive "P") + (if (not arg) + (if (member 'ede-turn-on-hook find-file-hook) + (global-ede-mode -1) + (global-ede-mode 1)) + (if (or (eq arg t) (> arg 0)) + (progn + (add-hook 'semanticdb-project-predicate-functions 'ede-directory-project-p) + (add-hook 'semanticdb-project-root-functions 'ede-toplevel-project-or-nil) + (add-hook 'ecb-source-path-functions 'ede-ecb-project-paths) + (add-hook 'find-file-hook 'ede-turn-on-hook) + (add-hook 'dired-mode-hook 'ede-turn-on-hook) + (add-hook 'kill-emacs-hook 'ede-save-cache) + (ede-load-cache)) + (remove-hook 'semanticdb-project-predicate-functions 'ede-directory-project-p) + (remove-hook 'semanticdb-project-root-functions 'ede-toplevel-project-or-nil) + (remove-hook 'ecb-source-path-functions 'ede-ecb-project-paths) + (remove-hook 'find-file-hook 'ede-turn-on-hook) + (remove-hook 'dired-mode-hook 'ede-turn-on-hook) + (remove-hook 'kill-emacs-hook 'ede-save-cache) + (ede-save-cache)) + (ede-reset-all-buffers arg))) + +(defvar ede-ignored-file-alist + '( "\\.cvsignore$" + "\\.#" + "~$" + ) + "List of file name patters that EDE will never ask about.") + +(defun ede-ignore-file (filename) + "Should we ignore FILENAME?" + (let ((any nil) + (F ede-ignored-file-alist)) + (while (and (not any) F) + (when (string-match (car F) filename) + (setq any t)) + (setq F (cdr F))) + any)) + +(defun ede-auto-add-to-target () + "Look for a target that wants to own the current file. +Follow the preference set with `ede-auto-add-method' and get the list +of objects with the `ede-want-file-p' method." + (if ede-object (error "Ede-object already defined for %s" (buffer-name))) + (if (or (eq ede-auto-add-method 'never) + (ede-ignore-file (buffer-file-name))) + nil + (let (wants desires) + ;; Find all the objects. + (setq wants (oref (ede-current-project) targets)) + (while wants + (if (ede-want-file-p (car wants) (buffer-file-name)) + (setq desires (cons (car wants) desires))) + (setq wants (cdr wants))) + (if desires + (cond ((or (eq ede-auto-add-method 'ask) + (and (eq ede-auto-add-method 'multi-ask) + (< 1 (length desires)))) + (let* ((al (append + ;; some defaults + '(("none" . nil) + ("new target" . new)) + ;; If we are in an unparented subdir, + ;; offer new a subproject + (if (ede-directory-project-p default-directory) + () + '(("create subproject" . project))) + ;; Here are the existing objects we want. + (object-assoc-list 'name desires))) + (case-fold-search t) + (ans (completing-read + (format "Add %s to target: " (buffer-file-name)) + al nil t))) + (setq ans (assoc ans al)) + (cond ((eieio-object-p (cdr ans)) + (ede-add-file (cdr ans))) + ((eq (cdr ans) 'new) + (ede-new-target)) + (t nil)))) + ((or (eq ede-auto-add-method 'always) + (and (eq ede-auto-add-method 'multi-ask) + (= 1 (length desires)))) + (ede-add-file (car desires))) + (t nil)))))) + + +;;; Interactive method invocations +;; +(defun ede (file) + "Start up EDE on something. +Argument FILE is the file or directory to load a project from." + (interactive "fProject File: ") + (if (not (file-exists-p file)) + (ede-new file) + (ede-load-project-file (file-name-directory file)))) + +(defun ede-new (type &optional name) + "Create a new project starting of project type TYPE. +Optional argument NAME is the name to give this project." + (interactive + (list (completing-read "Project Type: " + (object-assoc-list + 'name + (let* ((l ede-project-class-files) + (cp (ede-current-project)) + (cs (when cp (object-class cp))) + (r nil)) + (while l + (if cs + (if (eq (oref (car l) :class-sym) + cs) + (setq r (cons (car l) r))) + (if (oref (car l) new-p) + (setq r (cons (car l) r)))) + (setq l (cdr l))) + (when (not r) + (if cs + (error "No valid interactive sub project types for %s" + cs) + (error "EDE error: Can't fin project types to create"))) + r) + ) + nil t))) + ;; Make sure we have a valid directory + (when (not (file-exists-p default-directory)) + (error "Cannot create project in non-existant directory %s" default-directory)) + (when (not (file-writable-p default-directory)) + (error "No write permissions for %s" default-directory)) + ;; Create the project + (let* ((obj (object-assoc type 'name ede-project-class-files)) + (nobj (let ((f (oref obj file)) + (pf (oref obj proj-file))) + ;; We are about to make something new, changing the + ;; state of existing directories. + (ede-project-directory-remove-hash default-directory) + ;; Make sure this class gets loaded! + (require f) + (make-instance (oref obj class-sym) + :name (or name (read-string "Name: ")) + :directory default-directory + :file (cond ((stringp pf) + (expand-file-name pf)) + ((fboundp pf) + (funcall pf)) + (t + (error + "Unknown file name specifier %S" + pf))) + :targets nil))) + (inits (oref obj initializers))) + ;; Force the name to match for new objects. + (object-set-name-string nobj (oref nobj :name)) + ;; Handle init args. + (while inits + (eieio-oset nobj (car inits) (car (cdr inits))) + (setq inits (cdr (cdr inits)))) + (let ((pp (ede-parent-project))) + (when pp + (ede-add-subproject pp nobj) + (ede-commit-project pp))) + (ede-commit-project nobj)) + ;; Have the menu appear + (setq ede-minor-mode t) + ;; Allert the user + (message "Project created and saved. You may now create targets.")) + +(defmethod ede-add-subproject ((proj-a ede-project) proj-b) + "Add into PROJ-A, the subproject PROJ-B." + (oset proj-a subproj (cons proj-b (oref proj-a subproj)))) + +(defmethod ede-subproject-relative-path ((proj ede-project) &optional parent-in) + "Get a path name for PROJ which is relative to the parent project. +If PARENT is specified, then be relative to the PARENT project. +Specifying PARENT is useful for sub-sub projects relative to the root project." + (let* ((parent (or parent-in (ede-parent-project proj))) + (dir (file-name-directory (oref proj file)))) + (if (and parent (not (eq parent proj))) + (file-relative-name dir (file-name-directory (oref parent file))) + ""))) + +(defmethod ede-subproject-p ((proj ede-project)) + "Return non-nil if PROJ is a sub project." + (ede-parent-project proj)) + +(defun ede-invoke-method (sym &rest args) + "Invoke method SYM on the current buffer's project object. +ARGS are additional arguments to pass to method sym." + (if (not ede-object) + (error "Cannot invoke %s for %s" (symbol-name sym) + (buffer-name))) + ;; Always query a target. There should never be multiple + ;; projects in a single buffer. + (apply sym (ede-singular-object "Target: ") args)) + +(defun ede-rescan-toplevel () + "Rescan all project files." + (interactive) + (let ((toppath (ede-toplevel-project default-directory)) + (ede-deep-rescan t)) + (project-rescan (ede-load-project-file toppath)) + (ede-reset-all-buffers 1) + )) + +(defun ede-new-target (&rest args) + "Create a new target specific to this type of project file. +Different projects accept different arguments ARGS. +Typically you can specify NAME, target TYPE, and AUTOADD, where AUTOADD is +a string \"y\" or \"n\", which answers the y/n question done interactively." + (interactive) + (apply 'project-new-target (ede-current-project) args) + (setq ede-object nil) + (setq ede-object (ede-buffer-object (current-buffer))) + (ede-apply-target-options)) + +(defun ede-new-target-custom () + "Create a new target specific to this type of project file." + (interactive) + (project-new-target-custom (ede-current-project))) + +(defun ede-delete-target (target) + "Delete TARGET from the current project." + (interactive (list + (let ((ede-object (ede-current-project))) + (ede-invoke-method 'project-interactive-select-target + "Target: ")))) + ;; Find all sources in buffers associated with the condemned buffer. + (let ((condemned (ede-target-buffers target))) + (project-delete-target target) + ;; Loop over all project controlled buffers + (save-excursion + (while condemned + (set-buffer (car condemned)) + (setq ede-object nil) + (setq ede-object (ede-buffer-object (current-buffer))) + (setq condemned (cdr condemned)))) + (ede-apply-target-options))) + +(defun ede-add-file (target) + "Add the current buffer to a TARGET in the current project." + (interactive (list + (let ((ede-object (ede-current-project))) + (ede-invoke-method 'project-interactive-select-target + "Target: ")))) + (when (stringp target) + (let* ((proj (ede-current-project)) + (ob (object-assoc-list 'name (oref proj targets)))) + (setq target (cdr (assoc target ob))))) + + (when (not target) + (error "Could not find specified target %S" target)) + + (project-add-file target (buffer-file-name)) + (setq ede-object nil) + (setq ede-object (ede-buffer-object (current-buffer))) + (when (not ede-object) + (error "Can't add %s to target %s: Wrong file type" + (file-name-nondirectory (buffer-file-name)) + (object-name target))) + (ede-apply-target-options)) + +(defun ede-remove-file (&optional force) + "Remove the current file from targets. +Optional argument FORCE forces the file to be removed without asking." + (interactive "P") + (if (not ede-object) + (error "Cannot invoke remove-file for %s" (buffer-name))) + (let ((eo (if (listp ede-object) + (prog1 + ede-object + (setq force nil)) + (list ede-object)))) + (while eo + (if (or force (y-or-n-p (format "Remove from %s? " (ede-name (car eo))))) + (project-remove-file (car eo) (buffer-file-name))) + (setq eo (cdr eo))) + (setq ede-object nil) + (setq ede-object (ede-buffer-object (current-buffer))) + (ede-apply-target-options))) + +(defun ede-edit-file-target () + "Enter the project file to hand edit the current buffer's target." + (interactive) + (ede-invoke-method 'project-edit-file-target)) + +(defun ede-compile-project () + "Compile the current project." + (interactive) + ;; @TODO - This just wants the root. There should be a better way. + (let ((cp (ede-current-project))) + (while (ede-parent-project cp) + (setq cp (ede-parent-project cp))) + (let ((ede-object cp)) + (ede-invoke-method 'project-compile-project)))) + +(defun ede-compile-selected (target) + "Compile some TARGET from the current project." + (interactive (list (project-interactive-select-target (ede-current-project) + "Target to Build: "))) + (project-compile-target target)) + +(defun ede-compile-target () + "Compile the current buffer's associated target." + (interactive) + (ede-invoke-method 'project-compile-target)) + +(defun ede-debug-target () + "Debug the current buffer's assocated target." + (interactive) + (ede-invoke-method 'project-debug-target)) + +(defun ede-make-dist () + "Create a distribution from the current project." + (interactive) + (let ((ede-object (ede-current-project))) + (ede-invoke-method 'project-make-dist))) + +;;; Customization +;; +;; Routines for customizing projects and targets. + +(defvar eieio-ede-old-variables nil + "The old variables for a project.") + +(defalias 'customize-project 'ede-customize-project) +(defun ede-customize-project (&optional group) + "Edit fields of the current project through EIEIO & Custom. +Optional GROUP specifies the subgroup of slots to customize." + (interactive "P") + (require 'eieio-custom) + (let* ((ov (oref (ede-current-project) local-variables)) + (cp (ede-current-project)) + (group (if group (eieio-read-customization-group cp)))) + (eieio-customize-object cp group) + (make-local-variable 'eieio-ede-old-variables) + (setq eieio-ede-old-variables ov))) + +(defalias 'customize-target 'ede-customize-current-target) +(defun ede-customize-current-target(&optional group) + "Edit fields of the current target through EIEIO & Custom. +Optional argument OBJ is the target object to customize. +Optional argument GROUP is the slot group to display." + (interactive "P") + (require 'eieio-custom) + (if (not (obj-of-class-p ede-object ede-target)) + (error "Current file is not part of a target.")) + (let ((group (if group (eieio-read-customization-group ede-object)))) + (ede-customize-target ede-object group))) + +(defun ede-customize-target (obj group) + "Edit fields of the current target through EIEIO & Custom. +Optional argument OBJ is the target object to customize. +Optional argument GROUP is the slot group to display." + (require 'eieio-custom) + (if (and obj (not (obj-of-class-p obj ede-target))) + (error "No logical target to customize")) + (eieio-customize-object obj (or group 'default))) +;;; Target Sorting +;; +;; Target order can be important, but custom doesn't support a way +;; to resort items in a list. This function by David Engster allows +;; targets to be re-arranged. + +(defvar ede-project-sort-targets-order nil + "Variable for tracking target order in `ede-project-sort-targets'.") + +(defun ede-project-sort-targets () + "Create a custom-like buffer for sorting targets of current project." + (interactive) + (let ((proj (ede-current-project)) + (count 1) + current order) + (switch-to-buffer (get-buffer-create "*EDE sort targets*")) + (erase-buffer) + (setq ede-object-project proj) + (widget-create 'push-button + :notify (lambda (&rest ignore) + (let ((targets (oref ede-object-project targets)) + cur newtargets) + (while (setq cur (pop ede-project-sort-targets-order)) + (setq newtargets (append newtargets + (list (nth cur targets))))) + (oset ede-object-project targets newtargets)) + (ede-commit-project ede-object-project) + (kill-buffer)) + " Accept ") + (widget-insert " ") + (widget-create 'push-button + :notify (lambda (&rest ignore) + (kill-buffer)) + " Cancel ") + (widget-insert "\n\n") + (setq ede-project-sort-targets-order nil) + (mapc (lambda (x) + (add-to-ordered-list + 'ede-project-sort-targets-order + x x)) + (number-sequence 0 (1- (length (oref proj targets))))) + (ede-project-sort-targets-list) + (use-local-map widget-keymap) + (widget-setup) + (goto-char (point-min)))) + +(defun ede-project-sort-targets-list () + "Sort the target list while using `ede-project-sort-targets'." + (save-excursion + (let ((count 0) + (targets (oref ede-object-project targets)) + (inhibit-read-only t) + (inhibit-modification-hooks t)) + (goto-char (point-min)) + (forward-line 2) + (delete-region (point) (point-max)) + (while (< count (length targets)) + (if (> count 0) + (widget-create 'push-button + :notify `(lambda (&rest ignore) + (let ((cur ede-project-sort-targets-order)) + (add-to-ordered-list + 'ede-project-sort-targets-order + (nth ,count cur) + (1- ,count)) + (add-to-ordered-list + 'ede-project-sort-targets-order + (nth (1- ,count) cur) ,count)) + (ede-project-sort-targets-list)) + " Up ") + (widget-insert " ")) + (if (< count (1- (length targets))) + (widget-create 'push-button + :notify `(lambda (&rest ignore) + (let ((cur ede-project-sort-targets-order)) + (add-to-ordered-list + 'ede-project-sort-targets-order + (nth ,count cur) (1+ ,count)) + (add-to-ordered-list + 'ede-project-sort-targets-order + (nth (1+ ,count) cur) ,count)) + (ede-project-sort-targets-list)) + " Down ") + (widget-insert " ")) + (widget-insert (concat " " (number-to-string (1+ count)) ".: " + (oref (nth (nth count ede-project-sort-targets-order) + targets) name) "\n")) + (setq count (1+ count)))))) + +;;; Customization hooks +;; +;; These hooks are used when finishing up a customization. +(defmethod eieio-done-customizing ((proj ede-project)) + "Call this when a user finishes customizing PROJ." + (let ((ov eieio-ede-old-variables) + (nv (oref proj local-variables))) + (setq eieio-ede-old-variables nil) + (while ov + (if (not (assoc (car (car ov)) nv)) + (save-excursion + (mapc (lambda (b) + (set-buffer b) + (kill-local-variable (car (car ov)))) + (ede-project-buffers proj)))) + (setq ov (cdr ov))) + (mapc (lambda (b) (ede-set-project-variables proj b)) + (ede-project-buffers proj)))) + +(defmethod eieio-done-customizing ((target ede-target)) + "Call this when a user finishes customizing TARGET." + nil) + +(defmethod ede-commit-project ((proj ede-project)) + "Commit any change to PROJ to its file." + nil + ) + + +;;; EDE project placeholder methods +;; +(defmethod ede-project-force-load ((this ede-project-placeholder)) + "Make sure the placeholder THIS is replaced with the real thing. +Return the new object created in its place." + this + ) + + +;;; EDE project target baseline methods. +;; +;; If you are developing a new project type, you need to implement +;; all of these methods, unless, of course, they do not make sense +;; for your particular project. +;; +;; Your targets should inherit from `ede-target', and your project +;; files should inherit from `ede-project'. Create the appropriate +;; methods based on those below. + +(defmethod project-interactive-select-target ((this ede-project-placeholder) prompt) + ; checkdoc-params: (prompt) + "Make sure placeholder THIS is replaced with the real thing, and pass through." + (project-interactive-select-target (ede-project-force-load this) prompt)) + +(defmethod project-interactive-select-target ((this ede-project) prompt) + "Interactively query for a target that exists in project THIS. +Argument PROMPT is the prompt to use when querying the user for a target." + (let ((ob (object-assoc-list 'name (oref this targets)))) + (cdr (assoc (completing-read prompt ob nil t) ob)))) + +(defmethod project-add-file ((this ede-project-placeholder) file) + ; checkdoc-params: (file) + "Make sure placeholder THIS is replaced with the real thing, and pass through." + (project-add-file (ede-project-force-load this) file)) + +(defmethod project-add-file ((ot ede-target) file) + "Add the current buffer into project project target OT. +Argument FILE is the file to add." + (error "add-file not supported by %s" (object-name ot))) + +(defmethod project-remove-file ((ot ede-target) fnnd) + "Remove the current buffer from project target OT. +Argument FNND is an argument." + (error "remove-file not supported by %s" (object-name ot))) + +(defmethod project-edit-file-target ((ot ede-target)) + "Edit the target OT associated w/ this file." + (find-file (oref (ede-current-project) file))) + +(defmethod project-new-target ((proj ede-project) &rest args) + "Create a new target. It is up to the project PROJ to get the name." + (error "new-target not supported by %s" (object-name proj))) + +(defmethod project-new-target-custom ((proj ede-project)) + "Create a new target. It is up to the project PROJ to get the name." + (error "New-target-custom not supported by %s" (object-name proj))) + +(defmethod project-delete-target ((ot ede-target)) + "Delete the current target OT from it's parent project." + (error "add-file not supported by %s" (object-name ot))) + +(defmethod project-compile-project ((obj ede-project) &optional command) + "Compile the entire current project OBJ. +Argument COMMAND is the command to use when compiling." + (error "compile-project not supported by %s" (object-name obj))) + +(defmethod project-compile-target ((obj ede-target) &optional command) + "Compile the current target OBJ. +Argument COMMAND is the command to use for compiling the target." + (error "compile-target not supported by %s" (object-name obj))) + +(defmethod project-debug-target ((obj ede-target)) + "Run the current project target OBJ in a debugger." + (error "debug-target not supported by %s" (object-name obj))) + +(defmethod project-make-dist ((this ede-project)) + "Build a distribution for the project based on THIS project." + (error "Make-dist not supported by %s" (object-name this))) + +(defmethod project-dist-files ((this ede-project)) + "Return a list of files that constitutes a distribution of THIS project." + (error "Dist-files is not supported by %s" (object-name this))) + +(defmethod project-rescan ((this ede-project)) + "Rescan the EDE proj project THIS." + (error "Rescanning a project is not supported by %s" (object-name this))) + +;;; Default methods for EDE classes +;; +;; These are methods which you might want to override, but there is +;; no need to in most situations because they are either a) simple, or +;; b) cosmetic. + +(defmethod ede-name ((this ede-target)) + "Return the name of THIS targt." + (oref this name)) + +(defmethod ede-target-name ((this ede-target)) + "Return the name of THIS target, suitable for make or debug style commands." + (oref this name)) + +(defmethod ede-name ((this ede-project)) + "Return a short-name for THIS project file. +Do this by extracting the lowest directory name." + (oref this name)) + +(defmethod ede-description ((this ede-project)) + "Return a description suitable for the minibuffer about THIS." + (format "Project %s: %d subprojects, %d targets." + (ede-name this) (length (oref this subproj)) + (length (oref this targets)))) + +(defmethod ede-description ((this ede-target)) + "Return a description suitable for the minibuffer about THIS." + (format "Target %s: with %d source files." + (ede-name this) (length (oref this source)))) + +(defmethod ede-want-file-p ((this ede-target) file) + "Return non-nil if THIS target wants FILE." + ;; By default, all targets reference the source object, and let it decide. + (let ((src (ede-target-sourcecode this))) + (while (and src (not (ede-want-file-p (car src) file))) + (setq src (cdr src))) + src)) + +(defmethod ede-want-file-source-p ((this ede-target) file) + "Return non-nil if THIS target wants FILE." + ;; By default, all targets reference the source object, and let it decide. + (let ((src (ede-target-sourcecode this))) + (while (and src (not (ede-want-file-source-p (car src) file))) + (setq src (cdr src))) + src)) + +(defun ede-header-file () + "Return the header file for the current buffer. +Not all buffers need headers, so return nil if no applicable." + (if ede-object + (ede-buffer-header-file ede-object (current-buffer)) + nil)) + +(defmethod ede-buffer-header-file ((this ede-project) buffer) + "Return nil, projects don't have header files." + nil) + +(defmethod ede-buffer-header-file ((this ede-target) buffer) + "There are no default header files in EDE. +Do a quick check to see if there is a Header tag in this buffer." + (save-excursion + (set-buffer buffer) + (if (re-search-forward "::Header:: \\([a-zA-Z0-9.]+\\)" nil t) + (buffer-substring-no-properties (match-beginning 1) + (match-end 1)) + (let ((src (ede-target-sourcecode this)) + (found nil)) + (while (and src (not found)) + (setq found (ede-buffer-header-file (car src) (buffer-file-name)) + src (cdr src))) + found)))) + +(defun ede-documentation-files () + "Return the documentation files for the current buffer. +Not all buffers need documentations, so return nil if no applicable. +Some projects may have multiple documentation files, so return a list." + (if ede-object + (ede-buffer-documentation-files ede-object (current-buffer)) + nil)) + +(defmethod ede-buffer-documentation-files ((this ede-project) buffer) + "Return all documentation in project THIS based on BUFFER." + ;; Find the info node. + (ede-documentation this)) + +(defmethod ede-buffer-documentation-files ((this ede-target) buffer) + "Check for some documentation files for THIS. +Also do a quick check to see if there is a Documentation tag in this BUFFER." + (save-excursion + (set-buffer buffer) + (if (re-search-forward "::Documentation:: \\([a-zA-Z0-9.]+\\)" nil t) + (buffer-substring-no-properties (match-beginning 1) + (match-end 1)) + ;; Check the master project + (let ((cp (ede-toplevel))) + (ede-buffer-documentation-files cp (current-buffer)))))) + +(defmethod ede-documentation ((this ede-project)) + "Return a list of files that provides documentation. +Documentation is not for object THIS, but is provided by THIS for other +files in the project." + (let ((targ (oref this targets)) + (proj (oref this subproj)) + (found nil)) + (while targ + (setq found (append (ede-documentation (car targ)) found) + targ (cdr targ))) + (while proj + (setq found (append (ede-documentation (car proj)) found) + proj (cdr proj))) + found)) + +(defmethod ede-documentation ((this ede-target)) + "Return a list of files that provides documentation. +Documentation is not for object THIS, but is provided by THIS for other +files in the project." + nil) + +(defun ede-html-documentation-files () + "Return a list of HTML documentation files associated with this project." + (ede-html-documentation (ede-toplevel)) + ) + +(defmethod ede-html-documentation ((this ede-project)) + "Return a list of HTML files provided by project THIS." + + ) + +(defun ede-ecb-project-paths () + "Return a list of all paths for all active EDE projects. +This functions is meant for use with ECB." + (let ((p ede-projects) + (d nil)) + (while p + (setq d (cons (file-name-directory (oref (car p) file)) + d) + p (cdr p))) + d)) + +;;; EDE project-autoload methods +;; +(defmethod ede-dir-to-projectfile ((this ede-project-autoload) dir) + "Return a full file name of project THIS found in DIR. +Return nil if the project file does not exist." + (let* ((d (file-name-as-directory dir)) + (root (ede-project-root-directory this d)) + (pf (oref this proj-file)) + (f (cond ((stringp pf) + (expand-file-name pf (or root d))) + ((and (symbolp pf) (fboundp pf)) + (funcall pf (or root d))))) + ) + (when (and f (file-exists-p f)) + f))) + +;;; EDE basic functions +;; +(defun ede-add-project-to-global-list (proj) + "Add the project PROJ to the master list of projects. +On success, return the added project." + (when (not proj) + (error "No project created to add to master list")) + (when (not (eieio-object-p proj)) + (error "Attempt to add Non-object to master project list")) + (when (not (obj-of-class-p proj ede-project-placeholder)) + (error "Attempt to add a non-project to the ede projects list")) + (add-to-list 'ede-projects proj) + proj) + +(defun ede-load-project-file (dir &optional rootreturn) + "Project file independent way to read a project in from DIR. +Optional ROOTRETURN will return the root project for DIR." + ;; Only load if something new is going on. Flush the dirhash. + (ede-project-directory-remove-hash dir) + ;; Do the load + ;;(message "EDE LOAD : %S" file) + (let* ((file dir) + (path (expand-file-name (file-name-directory file))) + (pfc (ede-directory-project-p path)) + (toppath nil) + (o nil)) + (cond + ((not pfc) + ;; @TODO - Do we really need to scan? Is this a waste of time? + ;; Scan upward for a the next project file style. + (let ((p path)) + (while (and p (not (ede-directory-project-p p))) + (setq p (ede-up-directory p))) + (if p (ede-load-project-file p) + nil) + ;; recomment as we go + ;nil + )) + ;; Do nothing if we are buiding an EDE project already + (ede-constructing + nil) + ;; Load in the project in question. + (t + (setq toppath (ede-toplevel-project path)) + ;; We found the top-most directory. Check to see if we already + ;; have an object defining it's project. + (setq pfc (ede-directory-project-p toppath t)) + + ;; See if it's been loaded before + (setq o (object-assoc (ede-dir-to-projectfile pfc toppath) 'file + ede-projects)) + (if (not o) + ;; If not, get it now. + (let ((ede-constructing t)) + (setq o (funcall (oref pfc load-type) toppath)) + (when (not o) + (error "Project type error: :load-type failed to create a project")) + (ede-add-project-to-global-list o))) + + ;; Return the found root project. + (when rootreturn (set rootreturn o)) + + (let (tocheck found) + ;; Now find the project file belonging to FILE! + (setq tocheck (list o)) + (setq file (ede-dir-to-projectfile pfc (expand-file-name path))) + (while (and tocheck (not found)) + (let ((newbits nil)) + (when (car tocheck) + (if (string= file (oref (car tocheck) file)) + (setq found (car tocheck))) + (setq newbits (oref (car tocheck) subproj))) + (setq tocheck + (append (cdr tocheck) newbits)))) + (if (not found) + (message "No project for %s, but passes project-p test" file) + ;; Now that the file has been reset inside the project object, do + ;; the cache maintenance. + (setq ede-project-cache-files + (delete (oref found file) ede-project-cache-files))) + found))))) + +(defun ede-parent-project (&optional obj) + "Return the project belonging to the parent directory. +nil if there is no previous directory. +Optional argument OBJ is an object to find the parent of." + (let* ((proj (or obj ede-object-project)) ;; Current project. + (root (if obj (ede-project-root obj) + ede-object-root-project))) + ;; This case is a SHORTCUT if the project has defined + ;; a way to calculate the project root. + (if (and root proj (eq root proj)) + nil ;; we are at the root. + ;; Else, we may have a nil proj or root. + (let* ((thisdir (if obj (oref obj directory) + default-directory)) + (updir (ede-up-directory thisdir))) + (when updir + ;; If there was no root, perhaps we can derive it from + ;; updir now. + (let ((root (or root (ede-directory-get-toplevel-open-project updir)))) + (or + ;; This lets us find a subproject under root based on updir. + (and root + (ede-find-subproject-for-directory root updir)) + ;; Try the all structure based search. + (ede-directory-get-open-project updir) + ;; Load up the project file as a last resort. + ;; Last resort since it uses file-truename, and other + ;; slow features. + (and (ede-directory-project-p updir) + (ede-load-project-file + (file-name-as-directory updir)))))))))) + +(defun ede-current-project (&optional dir) + "Return the current project file. +If optional DIR is provided, get the project for DIR instead." + (let ((ans nil)) + ;; If it matches the current directory, do we have a pre-existing project? + (when (and (or (not dir) (string= dir default-directory)) + ede-object-project) + (setq ans ede-object-project) + ) + ;; No current project. + (when (not ans) + (let* ((ldir (or dir default-directory))) + (setq ans (ede-directory-get-open-project ldir)) + (or ans + ;; No open project, if this dir pass project-p, then load. + (when (ede-directory-project-p ldir) + (setq ans (ede-load-project-file ldir)))))) + ;; Return what we found. + ans)) + +(defun ede-buffer-object (&optional buffer) + "Return the target object for BUFFER. +This function clears cached values and recalculates." + (save-excursion + (if (not buffer) (setq buffer (current-buffer))) + (set-buffer buffer) + (setq ede-object nil) + (let ((po (ede-current-project))) + (if po (setq ede-object (ede-find-target po buffer)))) + (if (= (length ede-object) 1) + (setq ede-object (car ede-object))) + ede-object)) + +(defmethod ede-target-in-project-p ((proj ede-project) target) + "Is PROJ the parent of TARGET? +If TARGET belongs to a subproject, return that project file." + (if (and (slot-boundp proj 'targets) + (memq target (oref proj targets))) + proj + (let ((s (oref proj subproj)) + (ans nil)) + (while (and s (not ans)) + (setq ans (ede-target-in-project-p (car s) target)) + (setq s (cdr s))) + ans))) + +(defun ede-target-parent (target) + "Return the project which is the parent of TARGET. +It is recommended you track the project a different way as this function +could become slow in time." + ;; @todo - use ede-object-project as a starting point. + (let ((ans nil) (projs ede-projects)) + (while (and (not ans) projs) + (setq ans (ede-target-in-project-p (car projs) target) + projs (cdr projs))) + ans)) + +(defun ede-maybe-checkout (&optional buffer) + "Check BUFFER out of VC if necessary." + (save-excursion + (if buffer (set-buffer buffer)) + (if (and buffer-read-only vc-mode + (y-or-n-p "Checkout Makefile.am from VC? ")) + (vc-toggle-read-only)))) + +(defmethod ede-find-target ((proj ede-project) buffer) + "Fetch the target in PROJ belonging to BUFFER or nil." + (save-excursion + (set-buffer buffer) + (or ede-object + (if (ede-buffer-mine proj buffer) + proj + (let ((targets (oref proj targets)) + (f nil)) + (while targets + (if (ede-buffer-mine (car targets) buffer) + (setq f (cons (car targets) f))) + (setq targets (cdr targets))) + f))))) + +(defmethod ede-target-buffer-in-sourcelist ((this ede-target) buffer source) + "Return non-nil if object THIS is in BUFFER to a SOURCE list. +Handles complex path issues." + (member (ede-convert-path this (buffer-file-name buffer)) source)) + +(defmethod ede-buffer-mine ((this ede-project) buffer) + "Return non-nil if object THIS lays claim to the file in BUFFER." + nil) + +(defmethod ede-buffer-mine ((this ede-target) buffer) + "Return non-nil if object THIS lays claim to the file in BUFFER." + (condition-case nil + (ede-target-buffer-in-sourcelist this buffer (oref this source)) + ;; An error implies a bad match. + (error nil))) + + +;;; Project mapping +;; +(defun ede-project-buffers (project) + "Return a list of all active buffers controlled by PROJECT. +This includes buffers controlled by a specific target of PROJECT." + (let ((bl (buffer-list)) + (pl nil)) + (while bl + (save-excursion + (set-buffer (car bl)) + (if (and ede-object (eq (ede-current-project) project)) + (setq pl (cons (car bl) pl)))) + (setq bl (cdr bl))) + pl)) + +(defun ede-target-buffers (target) + "Return a list of buffers that are controlled by TARGET." + (let ((bl (buffer-list)) + (pl nil)) + (while bl + (save-excursion + (set-buffer (car bl)) + (if (if (listp ede-object) + (memq target ede-object) + (eq ede-object target)) + (setq pl (cons (car bl) pl)))) + (setq bl (cdr bl))) + pl)) + +(defun ede-buffers () + "Return a list of all buffers controled by an EDE object." + (let ((bl (buffer-list)) + (pl nil)) + (while bl + (save-excursion + (set-buffer (car bl)) + (if ede-object + (setq pl (cons (car bl) pl)))) + (setq bl (cdr bl))) + pl)) + +(defun ede-map-buffers (proc) + "Execute PROC on all buffers controled by EDE." + (mapcar proc (ede-buffers))) + +(defmethod ede-map-project-buffers ((this ede-project) proc) + "For THIS, execute PROC on all buffers belonging to THIS." + (mapcar proc (ede-project-buffers this))) + +(defmethod ede-map-target-buffers ((this ede-target) proc) + "For THIS, execute PROC on all buffers belonging to THIS." + (mapcar proc (ede-target-buffers this))) + +;; other types of mapping +(defmethod ede-map-subprojects ((this ede-project) proc) + "For object THIS, execute PROC on all direct subprojects. +This function does not apply PROC to sub-sub projects. +See also `ede-map-all-subprojects'." + (mapcar proc (oref this subproj))) + +(defmethod ede-map-all-subprojects ((this ede-project) allproc) + "For object THIS, execute PROC on THIS and all subprojects. +This function also applies PROC to sub-sub projects. +See also `ede-map-subprojects'." + (apply 'append + (list (funcall allproc this)) + (ede-map-subprojects + this + (lambda (sp) + (ede-map-all-subprojects sp allproc)) + ))) + +;; (ede-map-all-subprojects (ede-load-project-file "../semantic/") (lambda (sp) (oref sp file))) + +(defmethod ede-map-targets ((this ede-project) proc) + "For object THIS, execute PROC on all targets." + (mapcar proc (oref this targets))) + +(defmethod ede-map-any-target-p ((this ede-project) proc) + "For project THIS, map PROC to all targets and return if any non-nil. +Return the first non-nil value returned by PROC." + (ede-or (ede-map-targets this proc))) + + +;;; Some language specific methods. +;; +;; These items are needed by ede-cpp-root to add better support for +;; configuring items for Semantic. +(defun ede-apply-preprocessor-map () + "Apply preprocessor tables onto the current buffer." + (when (and ede-object (boundp 'semantic-lex-spp-macro-symbol-obarray)) + (let ((map (ede-preprocessor-map ede-object))) + (when map + ;; We can't do a require for the below symbol. + (setq semantic-lex-spp-macro-symbol-obarray + (semantic-lex-make-spp-table map)) + )))) + +(defmethod ede-system-include-path ((this ede-project)) + "Get the system include path used by project THIS." + nil) + +(defmethod ede-preprocessor-map ((this ede-project)) + "Get the pre-processor map for project THIS." + nil) + +(defmethod ede-system-include-path ((this ede-target)) + "Get the system include path used by project THIS." + nil) + +(defmethod ede-preprocessor-map ((this ede-target)) + "Get the pre-processor map for project THIS." + nil) + + +;;; Project-local variables +;; +(defun ede-make-project-local-variable (variable &optional project) + "Make VARIABLE project-local to PROJECT." + (if (not project) (setq project (ede-current-project))) + (if (assoc variable (oref project local-variables)) + nil + (oset project local-variables (cons (list variable) + (oref project local-variables))) + (mapcar (lambda (b) (save-excursion + (set-buffer b) + (make-local-variable variable))) + (ede-project-buffers project)))) + +(defmethod ede-set-project-variables ((project ede-project) &optional buffer) + "Set variables local to PROJECT in BUFFER." + (if (not buffer) (setq buffer (current-buffer))) + (save-excursion + (set-buffer buffer) + (mapcar (lambda (v) + (make-local-variable (car v)) + ;; set it's value here? + (set (car v) (cdr v)) + ) + (oref project local-variables)))) + +(defun ede-set (variable value &optional proj) + "Set the project local VARIABLE to VALUE. +If VARIABLE is not project local, just use set." + (let ((p (or proj (ede-current-project))) + a) + (if (and p (setq a (assoc variable (oref p local-variables)))) + (progn + (setcdr a value) + (mapc (lambda (b) (save-excursion + (set-buffer b) + (set variable value))) + (ede-project-buffers p))) + (set variable value)) + (ede-commit-local-variables p)) + value) + +(defmethod ede-commit-local-variables ((proj ede-project)) + "Commit change to local variables in PROJ." + nil) + + +;;; Accessors for more complex types where oref is inappropriate. +;; +(defmethod ede-target-sourcecode ((this ede-target)) + "Return the sourcecode objects which THIS permits." + (let ((sc (oref this sourcetype)) + (rs nil)) + (while (and (listp sc) sc) + (setq rs (cons (symbol-value (car sc)) rs) + sc (cdr sc))) + rs)) + + +;;; Lame stuff +;; +(defun ede-or (arg) + "Do `or' like stuff to ARG because you can't apply `or'." + (while (and arg (not (car arg))) + (setq arg (cdr arg))) + arg) + + +;;; Debugging. + +(defun ede-adebug-project () + "Run adebug against the current ede project. +Display the results as a debug list." + (interactive) + (require 'data-debug) + (when (ede-current-project) + (data-debug-new-buffer "*Analyzer ADEBUG*") + (data-debug-insert-object-slots (ede-current-project) "") + )) + +(defun ede-adebug-project-parent () + "Run adebug against the current ede parent project. +Display the results as a debug list." + (interactive) + (require 'data-debug) + (when (ede-parent-project) + (data-debug-new-buffer "*Analyzer ADEBUG*") + (data-debug-insert-object-slots (ede-parent-project) "") + )) + +(defun ede-adebug-project-root () + "Run adebug against the current ede parent project. +Display the results as a debug list." + (interactive) + (require 'data-debug) + (when (ede-toplevel) + (data-debug-new-buffer "*Analyzer ADEBUG*") + (data-debug-insert-object-slots (ede-toplevel) "") + )) + +;;; Hooks & Autoloads +;; +;; These let us watch various activities, and respond apropriatly. + +;; (add-hook 'edebug-setup-hook +;; (lambda () +;; (def-edebug-spec ede-with-projectfile +;; (form def-body)))) + +;; (autoload 'ede-update-version "ede-util" +;; "Update the version of the current project." t) + +;; (autoload 'ede-vc-project-directory "ede-system" t +;; "Run `vc-directory' on the the current project.") + +;; (autoload 'ede-web-browse-home "ede-system" t +;; "Web browse this project's home page.") + +;; (autoload 'ede-edit-web-page "ede-system" t +;; "Edit the web site for this project.") + +;; (autoload 'ede-upload-distribution "ede-system" t +;; "Upload the dist for this project to the upload site.") + +;; (autoload 'ede-upload-html-documentation "ede-system" t +;; "Upload auto-generated HTML to the web site.") + +(provide 'ede) + +;; Include this last because it depends on ede. +(require 'ede/files) + +;; If this does not occur after the provide, we can get a recursive +;; load. Yuck! +(if (featurep 'speedbar) + (ede-speedbar-file-setup) + (add-hook 'speedbar-load-hook 'ede-speedbar-file-setup)) + +;;; ede.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/cedet/ede/autoconf-edit.el Sun Sep 20 15:06:05 2009 +0000 @@ -0,0 +1,424 @@ +;;; ede/autoconf-edit.el --- Keymap for autoconf + +;;; Copyright (C) 1998, 1999, 2000, 2009 Free Software Foundation, Inc. + +;; Author: Eric M. Ludlam <zappo@gnu.org> +;; Keywords: project + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; Autoconf editing and modification support, and compatibility layer +;; for Emacses w/out autoconf mode built in. + +;;; Code: +(require 'autoconf) + +(defvar autoconf-new-automake-string + "dnl Process this file with autoconf to produce a configure script + +AC_INIT(%s) +AM_INIT_AUTOMAKE([%s], 0) +AM_CONFIG_HEADER(config.h) + +dnl End the configure script. +AC_OUTPUT(Makefile, [date > stamp-h] )\n" + "This string is used to initialize a new configure.in. +The default is designed to be used with automake. +The first %s will be filled with the test file. +The second %s will be filled with the program name.") + +(defun autoconf-new-program (rootdir program testfile) + "Initialize a new configure.in in ROOTDIR for PROGRAM using TESTFILE. +ROOTDIR is the root directory of a given autoconf controlled project. +PROGRAM is the program to be configured. +TESTFILE is the file used with AC_INIT. +configure the initial configure script using `autoconf-new-automake-string'" + (interactive "DRoot Dir: \nsProgram: \nsTest File: ") + (if (bufferp rootdir) + (set-buffer rootdir) + (let ((cf1 (expand-file-name "configure.in" rootdir)) + (cf2 (expand-file-name "configure.ac" rootdir))) + (if (and (or (file-exists-p cf1) (file-exists-p cf2)) + (not (y-or-n-p (format "File %s exists. Start Over? " + (if (file-exists-p cf1) + cf1 cf2) + )))) + (error "Quit")) + (find-file cf2))) + ;; Note, we only ask about overwrite if a string/path is specified. + (erase-buffer) + (insert (format autoconf-new-automake-string testfile program))) + +(defvar autoconf-preferred-macro-order + '("AC_INIT" + "AM_INIT_AUTOMAKE" + "AM_CONFIG_HEADER" + ;; Arg parsing + "AC_ARG_ENABLE" + "AC_ARG_WITH" + ;; Programs + "AC_PROG_MAKE_SET" + "AC_PROG_AWK" + "AC_PROG_CC" + "AC_PROG_CC_C_O" + "AC_PROG_CPP" + "AC_PROG_CXX" + "AC_PROG_CXXCPP" + "AC_ISC_POSIX" + "AC_PROG_F77" + "AC_PROG_GCC_TRADITIONAL" + "AC_PROG_INSTALL" + "AC_PROG_LEX" + "AC_PROG_LN_S" + "AC_PROG_RANLIB" + "AC_PROG_YACC" + "AC_CHECK_PROG" + "AC_CHECK_PROGS" + "AC_PROG_LIBTOOL" + ;; Libraries + "AC_CHECK_LIB" + "AC_PATH_XTRA" + ;; Headers + "AC_HEADER_STDC" + "AC_HEADER_SYS_WAIT" + "AC_HEADER_TIME" + "AC_HEADERS" + ;; Typedefs, structures + "AC_TYPE_PID_T" + "AC_TYPE_SIGNAL" + "AC_TYPE_UID_T" + "AC_STRUCT_TM" + ;; Compiler characteristics + "AC_CHECK_SIZEOF" + "AC_C_CONST" + ;; Library functions + "AC_CHECK_FUNCS" + "AC_TRY_LINK" + ;; System Services + ;; Other + "AM_PATH_LISPDIR" + "AM_INIT_GUILE_MODULE" + ;; AC_OUTPUT is always last + "AC_OUTPUT" + ) + "List of macros in the order that they prefer to occur in. +This helps when inserting a macro which doesn't yet exist +by positioning it near other macros which may exist. +From the autoconf manual: + `AC_INIT(FILE)' + checks for programs + checks for libraries + checks for header files + checks for typedefs + checks for structures + checks for compiler characteristics + checks for library functions + checks for system services + `AC_OUTPUT([FILE...])'") + +(defvar autoconf-multiple-macros + '("AC_ARG_ENABLE" + "AC_ARG_WITH" + "AC_CHECK_PROGS" + "AC_CHECK_LIB" + "AC_CHECK_SIZEOF" + "AC_TRY_LINK" + ) + "Macros which appear multiple times.") + +(defvar autoconf-multiple-multiple-macros + '("AC_HEADERS" "AC_CHECK_FUNCS") + "Macros which appear multiple times, and perform multiple queries.") + +(defun autoconf-in-macro (macro) + "Non-nil if point is in a macro of type MACRO." + (save-excursion + (beginning-of-line) + (looking-at (concat "\\(A[CM]_" macro "\\|" macro "\\)")))) + +(defun autoconf-find-last-macro (macro) + "Move to the last occurance of MACRO in FILE, and return that point. +The last macro is usually the one in which we would like to insert more +items such as CHECK_HEADERS." + (let ((op (point))) + (goto-char (point-max)) + (if (re-search-backward (concat "^" (regexp-quote macro) "\\s-*\\((\\|$\\)") nil t) + (progn + (beginning-of-line) + (point)) + (goto-char op) + nil))) + +(defun autoconf-parameter-strip (param) + "Strip the parameter PARAM of whitespace and misc characters." + (when (string-match "^\\s-*\\[?\\s-*" param) + (setq param (substring param (match-end 0)))) + (when (string-match "\\s-*\\]?\\s-*$" param) + (setq param (substring param 0 (match-beginning 0)))) + param) + +(defun autoconf-parameters-for-macro (macro) + "Retrieve the parameters to MACRO. +Returns a list of the arguments passed into MACRO as strings." + (save-excursion + (when (autoconf-find-last-macro macro) + (forward-sexp 1) + (mapcar + #'autoconf-parameter-strip + (when (looking-at "(") + (let* ((start (+ (point) 1)) + (end (save-excursion + (forward-sexp 1) + (- (point) 1))) + (ans (buffer-substring-no-properties start end))) + (split-string ans "," t))))))) + +(defun autoconf-position-for-macro (macro) + "Position the cursor where a new MACRO could be inserted. +This will appear at the BEGINNING of the macro MACRO should appear AFTER. +This is to make it compatible with `autoconf-find-last-macro'. +Assume that MACRO doesn't appear in the buffer yet, so search +the ordering list `autoconf-preferred-macro-order'." + ;; Search this list backwards.. heh heh heh + ;; This lets us do a reverse search easilly. + (let ((ml (member macro (reverse autoconf-preferred-macro-order)))) + (if (not ml) (error "Don't know how to position for %s yet" macro)) + (setq ml (cdr ml)) + (goto-char (point-max)) + (while (and ml (not (autoconf-find-last-macro (car ml)))) + (setq ml (cdr ml))) + (if (not ml) (error "Could not find context for positioning %s" macro)))) + +(defun autoconf-insert-macro-at-point (macro &optional param) + "Add MACRO at the current point with PARAM." + (insert macro) + (if param + (progn + (insert "(" param ")") + (if (< (current-column) 3) (insert " dnl"))))) + +(defun autoconf-insert-new-macro (macro &optional param) + "Add a call to MACRO in the current autoconf file. +Deals with macro order. See `autoconf-preferred-macro-order' and +`autoconf-multi-macros'. +Optional argument PARAM is the parameter to pass to the macro as one string." + (cond ((member macro autoconf-multiple-macros) + ;; This occurs multiple times + (or (autoconf-find-last-macro macro) + (autoconf-position-for-macro macro)) + (forward-sexp 2) + (end-of-line) + (insert "\n") + (autoconf-insert-macro-at-point macro param)) + ((member macro autoconf-multiple-multiple-macros) + (if (not param) + (error "You must have a paramter for %s" macro)) + (if (not (autoconf-find-last-macro macro)) + (progn + ;; Doesn't exist yet.... + (autoconf-position-for-macro macro) + (forward-sexp 2) + (end-of-line) + (insert "\n") + (autoconf-insert-macro-at-point macro param)) + ;; Does exist, can we fit onto the current line? + (forward-sexp 2) + (down-list -1) + (if (> (+ (current-column) (length param)) fill-column) + (insert " " param) + (up-list 1) + (end-of-line) + (insert "\n") + (autoconf-insert-macro-at-point macro param)))) + ((autoconf-find-last-macro macro) + ;; If it isn't one of the multi's, it's a singleton. + ;; If it exists, ignore it. + nil) + (t + (autoconf-position-for-macro macro) + (forward-sexp 1) + (if (looking-at "\\s-*(") + (forward-sexp 1)) + (end-of-line) + (insert "\n") + (autoconf-insert-macro-at-point macro param)))) + +(defun autoconf-find-query-for-header (header) + "Position the cursor where HEADER is queried." + (interactive "sHeader: ") + (let ((op (point)) + (found t)) + (goto-char (point-min)) + (condition-case nil + (while (not + (progn + (re-search-forward + (concat "\\b" (regexp-quote header) "\\b")) + (save-excursion + (beginning-of-line) + (looking-at "AC_CHECK_HEADERS"))))) + ;; We depend on the search failing to exit our loop on failure. + (error (setq found nil))) + (if (not found) (goto-char op)) + found)) + +(defun autoconf-add-query-for-header (header) + "Add in HEADER to be queried for in our autoconf file." + (interactive "sHeader: ") + (or (autoconf-find-query-for-header header) + (autoconf-insert-new-macro "AC_CHECK_HEADERS" header))) + + +(defun autoconf-find-query-for-func (func) + "Position the cursor where FUNC is queried." + (interactive "sFunction: ") + (let ((op (point)) + (found t)) + (goto-char (point-min)) + (condition-case nil + (while (not + (progn + (re-search-forward + (concat "\\b" (regexp-quote func) "\\b")) + (save-excursion + (beginning-of-line) + (looking-at "AC_CHECK_FUNCS"))))) + ;; We depend on the search failing to exit our loop on failure. + (error (setq found nil))) + (if (not found) (goto-char op)) + found)) + +(defun autoconf-add-query-for-func (func) + "Add in FUNC to be queried for in our autoconf file." + (interactive "sFunction: ") + (or (autoconf-find-query-for-func func) + (autoconf-insert-new-macro "AC_CHECK_FUNCS" func))) + +(defvar autoconf-program-builtin + '(("AWK" . "AC_PROG_AWK") + ("CC" . "AC_PROG_CC") + ("CPP" . "AC_PROG_CPP") + ("CXX" . "AC_PROG_CXX") + ("CXXCPP" . "AC_PROG_CXXCPP") + ("F77" . "AC_PROG_F77") + ("GCC_TRADITIONAL" . "AC_PROG_GCC_TRADITIONAL") + ("INSTALL" . "AC_PROG_INSTALL") + ("LEX" . "AC_PROG_LEX") + ("LN_S" . "AC_PROG_LN_S") + ("RANLIB" . "AC_PROG_RANLIB") + ("YACC" . "AC_PROG_YACC") + ) + "Association list of PROGRAM variables and their built-in MACRO.") + +(defun autoconf-find-query-for-program (prog) + "Position the cursor where PROG is queried. +PROG is the VARIABLE to use in autoconf to identify the program. +PROG excludes the _PROG suffix. Thus if PROG were EMACS, then the +variable in configure.in would be EMACS_PROG." + (let ((op (point)) + (found t) + (builtin (assoc prog autoconf-program-builtin))) + (goto-char (point-min)) + (condition-case nil + (re-search-forward + (concat "^" + (or (cdr-safe builtin) + (concat "AC_CHECK_PROG\\s-*(\\s-*" prog "_PROG")) + "\\>")) + (error (setq found nil))) + (if (not found) (goto-char op)) + found)) + +(defun autoconf-add-query-for-program (prog &optional names) + "Add in PROG to be queried for in our autoconf file. +Optional NAMES is for non-built-in programs, and is the list +of possible names." + (interactive "sProgram: ") + (if (autoconf-find-query-for-program prog) + nil + (let ((builtin (assoc prog autoconf-program-builtin))) + (if builtin + (autoconf-insert-new-macro (cdr builtin)) + ;; Not built in, try the params item + (autoconf-insert-new-macro "AC_CHECK_PROGS" (concat prog "," names)) + )))) + +;;; Scrappy little changes +;; +(defvar autoconf-deleted-text nil + "Set to the last bit of text deleted during an edit.") + +(defvar autoconf-inserted-text nil + "Set to the last bit of text inserted during an edit.") + +(defmacro autoconf-edit-cycle (&rest body) + "Start an edit cycle, unsetting the modified flag if there is no change. +Optional argument BODY is the code to execute which edits the autoconf file." + `(let ((autoconf-deleted-text nil) + (autoconf-inserted-text nil) + (mod (buffer-modified-p))) + ,@body + (if (and (not mod) + (string= autoconf-deleted-text autoconf-inserted-text)) + (set-buffer-modified-p nil)))) + +(defun autoconf-delete-parameter (index) + "Delete the INDEXth parameter from the macro starting on the current line. +Leaves the cursor where a new parameter can be inserted. +INDEX starts at 1." + (beginning-of-line) + (down-list 1) + (re-search-forward ", ?" nil nil (1- index)) + (let ((end (save-excursion + (re-search-forward ",\\|)" (save-excursion + (end-of-line) + (point))) + (forward-char -1) + (point)))) + (setq autoconf-deleted-text (buffer-substring (point) end)) + (delete-region (point) end))) + +(defun autoconf-insert (text) + "Insert TEXT." + (setq autoconf-inserted-text text) + (insert text)) + +(defun autoconf-set-version (version) + "Set the version used with automake to VERSION." + (if (not (stringp version)) + (signal 'wrong-type-argument '(stringp version))) + (if (not (autoconf-find-last-macro "AM_INIT_AUTOMAKE")) + (error "Cannot update version") + ;; Move to correct position. + (autoconf-edit-cycle + (autoconf-delete-parameter 2) + (autoconf-insert version)))) + +(defun autoconf-set-output (outputlist) + "Set the files created in AC_OUTPUT to OUTPUTLIST. +OUTPUTLIST is a list of strings representing relative paths +to Makefiles, or other files using Autoconf substitution." + (if (not (autoconf-find-last-macro "AC_OUTPUT")) + (error "Cannot update version") + (autoconf-edit-cycle + (autoconf-delete-parameter 1) + (autoconf-insert (mapconcat (lambda (a) a) outputlist " "))))) + +(provide 'ede/autoconf-edit) + +;;; ede/autoconf-edit.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/cedet/ede/cpp-root.el Sun Sep 20 15:06:05 2009 +0000 @@ -0,0 +1,515 @@ +;;; ede/cpp-root.el --- A simple way to wrap a C++ project with a single root + +;; Copyright (C) 2007, 2008, 2009 Free Software Foundation, Inc. + +;; Author: Eric M. Ludlam <eric@siege-engine.com> + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; NOTE: ede-cpp-root.el has been commented so as to also make it +;; useful for learning how to make similar project types. +;; +;; Not everyone can use automake, or an EDE project type. For +;; pre-existing code, it is often helpful jut to be able to wrap the +;; whole thing up in as simple a way as possible. +;; +;; The cpp-root project type will allow you to create a single object +;; with no save-file in your .emacs file that will be recognized, and +;; provide a way to easilly allow EDE to provide Semantic with the +;; ability to find header files, and other various source files +;; quickly. +;; +;; The cpp-root class knows a few things about C++ projects, such as +;; the prevalence of "include" directories, and typical file-layout +;; stuff. If this isn't sufficient, you can subclass +;; `ede-cpp-root-project' and add your own tweaks in just a few lines. +;; See the end of this file for an example. +;; +;;; EXAMPLE +;; +;; Add this to your .emacs file, modifying apropriate bits as needed. +;; +;; (ede-cpp-root-project "SOMENAME" :file "/dir/to/some/file") +;; +;; Replace SOMENAME with whatever name you want, and the filename to +;; an actual file at the root of your project. It might be a +;; Makefile, a README file. Whatever. It doesn't matter. It's just +;; a key to hang the rest of EDE off of. +;; +;; The most likely reason to create this project, is to help make +;; finding files within the project faster. In conjunction with +;; Semantic completion, having a short include path is key. You can +;; override the include path like this: +;; +;; (ede-cpp-root-project "NAME" :file "FILENAME" +;; :include-path '( "/include" "../include" "/c/include" ) +;; :system-include-path '( "/usr/include/c++/3.2.2/" ) +;; :spp-table '( ("MOOSE" . "") +;; ("CONST" . "const") ) +;; :spp-files '( "include/config.h" ) +;; ) +;; +;; In this case each item in the include path list is searched. If +;; the directory starts with "/", then that expands to the project +;; root directory. If a directory does not start with "/", then it +;; is relative to the default-directory of the current buffer when +;; the file name is expanded. +;; +;; The include path only affects C/C++ header files. Use the slot +;; :header-match-regexp to change it. +;; +;; The :system-include-path allows you to specify full directory +;; names to include directories where system header files can be +;; found. These will be applied to files in this project only. +;; +;; The :spp-table provides a list of project specific #define style +;; macros that are unique to this project, passed in to the compiler +;; on the command line, or are in special headers. +;; +;; The :spp-files option is like :spp-table, except you can provide a +;; file name for a header in your project where most of your CPP +;; macros reside. Doing this can be easier than listing everything in +;; the :spp-table option. The files listed in :spp-files should not +;; start with a /, and are relative to something in :include-path.;; +;; +;; If you want to override the file-finding tool with your own +;; function you can do this: +;; +;; (ede-cpp-root-project "NAME" :file "FILENAME" :locate-fcn 'MYFCN) +;; +;; Where FILENAME is a file in the root directory of the project. +;; Where MYFCN is a symbol for a function. See: +;; +;; M-x describe-class RET ede-cpp-root-project RET +;; +;; for documentation about the locate-fcn extension. +;; +;;; ADVANCED EXAMPLE +;; +;; If the cpp-root project style is right for you, but you want a +;; dynamic loader, instead of hard-coding values in your .emacs, you +;; can do that too, but you will need to write some lisp code. +;; +;; To do that, you need to add an entry to the +;; `ede-project-class-files' list, and also provide two functions to +;; teach EDE how to load your project pattern +;; +;; It would oook like this: +;; +;; (defun MY-FILE-FOR-DIR (&optional dir) +;; "Return a full file name to the project file stored in DIR." +;; <write your code here, or return nil> +;; ) +;; +;; (defun MY-ROOT-FCN () +;; "Return the root directory for `default-directory'" +;; ;; You might be able to use `ede-cpp-root-project-root'. +;; ) +;; +;; (defun MY-LOAD (dir) +;; "Load a project of type `cpp-root' for the directory DIR. +;; Return nil if there isn't one." +;; (ede-cpp-root-project "NAME" :file (expand-file-name "FILE" dir) +;; :locate-fcn 'MYFCN) +;; ) +;; +;; (add-to-list 'ede-project-class-files +;; (ede-project-autoload "cpp-root" +;; :name "CPP ROOT" +;; :file 'ede-cpp-root +;; :proj-file 'MY-FILE-FOR-DIR +;; :proj-root 'MY-ROOT-FCN +;; :load-type 'MY-LOAD +;; :class-sym 'ede-cpp-root) +;; t) +;; +;;; TODO +;; +;; Need a way to reconfigure a project, and have it affect all open buffers. +;; From Tobias Gerdin: +;; +;; >>3) Is there any way to refresh a ede-cpp-root-project dynamically? I have +;; >>some file open part of the project, fiddle with the include paths and would +;; >>like the open buffer to notice this when I re-evaluate the +;; >>ede-cpp-root-project constructor. +;; > +;; > Another good idea. The easy way is to "revert-buffer" as needed. The +;; > ede "project local variables" does this already, so it should be easy +;; > to adapt something. +;; +;; I actually tried reverting the buffer but Semantic did not seem to pick +;; up the differences (the "include summary" reported the same include paths). + +(require 'ede) + +(defvar semantic-lex-spp-project-macro-symbol-obarray) +(declare-function semantic-lex-make-spp-table "semantic/lex-spp") +(declare-function semanticdb-file-table-object "semantic/db") +(declare-function semanticdb-needs-refresh-p "semantic/db") +(declare-function semanticdb-refresh-table "semantic/db") + +;;; Code: + +;;; PROJECT CACHE: +;; +;; cpp-root projects are created in a .emacs or other config file, but +;; there still needs to be a way for a particular file to be +;; identified against it. The cache is where we look to map a file +;; against a project. +;; +;; Setting up a simple in-memory cache of active projects allows the +;; user to re-load their configuration file several times without +;; messing up the active project set. +;; +(defvar ede-cpp-root-project-list nil + "List of projects created by option `ede-cpp-root-project'.") + +(defun ede-cpp-root-file-existing (dir) + "Find a cpp-root project in the list of cpp-root projects. +DIR is the directory to search from." + (let ((projs ede-cpp-root-project-list) + (ans nil)) + (while (and projs (not ans)) + (let ((root (ede-project-root-directory (car projs)))) + (when (string-match (concat "^" (regexp-quote root)) dir) + (setq ans (car projs)))) + (setq projs (cdr projs))) + ans)) + +;;; PROJECT AUTOLOAD CONFIG +;; +;; Each project type registers itself into the project-class list. +;; This way, each time a file is loaded, EDE can map that file to a +;; project. This project type checks files against the internal cache +;; of projects created by the user. +;; +;; EDE asks two kinds of questions. One is, does this DIR belong to a +;; project. If it does, it then asks, what is the ROOT directory to +;; the project in DIR. This is easy for cpp-root projects, but more +;; complex for multiply nested projects. +;; +;; If EDE finds out that a project exists for DIR, it then loads that +;; project. The LOAD routine can either create a new project object +;; (if it needs to load it off disk) or more likely can return an +;; existing object for the discovered directory. cpp-root always uses +;; the second case. + +(defun ede-cpp-root-project-file-for-dir (&optional dir) + "Return a full file name to the project file stored in DIR." + (let ((proj (ede-cpp-root-file-existing dir))) + (when proj (oref proj :file)))) + +(defvar ede-cpp-root-count 0 + "Count number of hits to the cpp root thing. +This is a debugging variable to test various optimizations in file +lookup in the main EDE logic.") + +;;;###autoload +(defun ede-cpp-root-project-root (&optional dir) + "Get the root directory for DIR." + (let ((projfile (ede-cpp-root-project-file-for-dir + (or dir default-directory)))) + (setq ede-cpp-root-count (1+ ede-cpp-root-count)) + ;(debug) + (when projfile + (file-name-directory projfile)))) + +(defun ede-cpp-root-load (dir &optional rootproj) + "Return a CPP root object if you created one. +Return nil if there isn't one. +Argument DIR is the directory it is created for. +ROOTPROJ is nil, since there is only one project." + ;; Snoop through our master list. + (ede-cpp-root-file-existing dir)) + +;;; CLASSES +;; +;; EDE sets up projects with two kinds of objects. +;; +;; The PROJECT is a class that represents everything under a directory +;; hierarchy. A TARGET represents a subset of files within a project. +;; A project can have multiple targets, and multiple sub-projects. +;; Sub projects should map to sub-directories. +;; +;; The CPP-ROOT project maps any file in C or C++ mode to a target for +;; C files. +;; +;; When creating a custom project the project developer an opportunity +;; to run code to setup various tools whenever an associated buffer is +;; loaded. The CPP-ROOT project spends most of its time setting up C +;; level include paths, and PreProcessor macro tables. + +(defclass ede-cpp-root-target (ede-target) + () + "EDE cpp-root project target. +All directories need at least one target.") + +(defclass ede-cpp-root-project (ede-project eieio-instance-tracker) + ((tracking-symbol :initform 'ede-cpp-root-project-list) + (include-path :initarg :include-path + :initform '( "/include" "../include/" ) + :type list + :documentation + "The default locate function expands filenames within a project. +If a header file (.h, .hh, etc) name is expanded, and +the :locate-fcn slot is nil, then the include path is checked +first, and other directories are ignored. For very large +projects, this optimization can save a lot of time. + +Directory names in the path can be relative to the current +buffer's `default-directory' (not starting with a /). Directories +that are relative to the project's root should start with a /, such +as \"/include\", meaning the directory `include' off the project root +directory.") + (system-include-path :initarg :system-include-path + :initform nil + :type list + :documentation + "The system include path for files in this project. +C files initialized in an ede-cpp-root-project have their semantic +system include path set to this value. If this is nil, then the +semantic path is not modified.") + (spp-table :initarg :spp-table + :initform nil + :type list + :documentation + "C Preprocessor macros for your files. +Preprocessor symbols will be used while parsing your files. +These macros might be passed in through the command line compiler, or +are critical symbols derived from header files. Providing header files +macro values through this slot improves accuracy and performance. +Use `:spp-files' to use these files directly.") + (spp-files :initarg :spp-files + :initform nil + :type list + :documentation + "C header file with Preprocessor macros for your files. +The PreProcessor symbols appearing in these files will be used while +parsing files in this project. +See `semantic-lex-c-preprocessor-symbol-map' for more on how this works.") + (header-match-regexp :initarg :header-match-regexp + :initform + "\\.\\(h\\(h\\|xx\\|pp\\|\\+\\+\\)?\\|H\\)$\\|\\<\\w+$" + :type string + :documentation + "Regexp used to identify C/C++ header files.") + (locate-fcn :initarg :locate-fcn + :initform nil + :type (or null function) + :documentation + "The locate function can be used in place of +`ede-expand-filename' so you can quickly customize your custom target +to use specialized local routines instead of the EDE routines. +The function symbol must take two arguments: + NAME - The name of the file to find. + DIR - The directory root for this cpp-root project. + +It should return the fully qualified file name passed in from NAME. If that file does not +exist, it should return nil." + ) + ) + "EDE cpp-root project class. +Each directory needs a a project file to control it.") + +;;; INIT +;; +;; Most projects use `initialize-instance' to do special setup +;; on the object when it is created. In this case, EDE-CPP-ROOT can +;; find previous copies of this project, and make sure that one of the +;; objects is deleted. + +(defmethod initialize-instance ((this ede-cpp-root-project) + &rest fields) + "Make sure the :file is fully expanded." + ;; Add ourselves to the master list + (call-next-method) + (let ((f (expand-file-name (oref this :file)))) + ;; Remove any previous entries from the main list. + (let ((old (eieio-instance-tracker-find (file-name-directory f) + :directory 'ede-cpp-root-project-list))) + ;; This is safe, because :directory isn't filled in till later. + (when (and old (not (eq old this))) + (delete-instance old))) + ;; Basic initialization. + (when (or (not (file-exists-p f)) + (file-directory-p f)) + (delete-instance this) + (error ":file for ede-cpp-root must be a file.")) + (oset this :file f) + (oset this :directory (file-name-directory f)) + (ede-project-directory-remove-hash (file-name-directory f)) + (ede-add-project-to-global-list this) + (unless (slot-boundp this 'targets) + (oset this :targets nil)) + ;; We need to add ourselves to the master list. + ;;(setq ede-projects (cons this ede-projects)) + )) + +;;; SUBPROJ Management. +;; +;; This is a way to allow a subdirectory to point back to the root +;; project, simplifying authoring new single-point projects. + +(defmethod ede-find-subproject-for-directory ((proj ede-cpp-root-project) + dir) + "Return PROJ, for handling all subdirs below DIR." + proj) + +;;; TARGET MANAGEMENT +;; +;; Creating new targets on a per directory basis is a good way to keep +;; files organized. See ede-emacs for an example with multiple file +;; types. +(defmethod ede-find-target ((proj ede-cpp-root-project) buffer) + "Find an EDE target in PROJ for BUFFER. +If one doesn't exist, create a new one for this directory." + (let* ((targets (oref proj targets)) + (dir default-directory) + (ans (object-assoc dir :path targets)) + ) + (when (not ans) + (setq ans (ede-cpp-root-target dir + :name (file-name-nondirectory + (directory-file-name dir)) + :path dir + :source nil)) + (object-add-to-list proj :targets ans) + ) + ans)) + +;;; FILE NAMES +;; +;; One of the more important jobs of EDE is to find files in a +;; directory structure. cpp-root has tricks it knows about how most C +;; projects are set up with include paths. +;; +;; This tools also uses the ede-locate setup for augmented file name +;; lookup using external tools. +(defmethod ede-expand-filename-impl ((proj ede-cpp-root-project) name) + "Within this project PROJ, find the file NAME. +This knows details about or source tree." + ;; The slow part of the original is looping over subprojects. + ;; This version has no subprojects, so this will handle some + ;; basic cases. + (let ((ans (call-next-method))) + (unless ans + (let* ((lf (oref proj locate-fcn)) + (dir (file-name-directory (oref proj file)))) + (if lf + (setq ans (funcall lf name dir)) + (if (ede-cpp-root-header-file-p proj name) + ;; Else, use our little hack. + (let ((ip (oref proj include-path)) + (tmp nil)) + (while ip + ;; Translate + (setq tmp (ede-cpp-root-translate-file proj (car ip))) + ;; Test this name. + (setq tmp (expand-file-name name tmp)) + (if (file-exists-p tmp) + (setq ans tmp)) + (setq ip (cdr ip)) )) + ;; Else, do the usual. + (setq ans (call-next-method))) + ))) + (or ans (call-next-method)))) + +(defmethod ede-project-root ((this ede-cpp-root-project)) + "Return my root." + this) + +(defmethod ede-project-root-directory ((this ede-cpp-root-project)) + "Return my root." + (file-name-directory (oref this file))) + +;;; C/CPP SPECIFIC CODE +;; +;; The following code is specific to setting up header files, +;; include lists, and Preprocessor symbol tables. + +(defmethod ede-cpp-root-header-file-p ((proj ede-cpp-root-project) name) + "Non nil if in PROJ the filename NAME is a header." + (save-match-data + (string-match (oref proj header-match-regexp) name))) + +(defmethod ede-cpp-root-translate-file ((proj ede-cpp-root-project) filename) + "For PROJ, translate a user specified FILENAME. +This is for project include paths and spp source files." + ;; Step one: Root of this project. + (let ((dir (file-name-directory (oref proj file)))) + + ;; Step two: Analyze first char, and rehost + (if (and (not (string= filename "")) (= (aref filename 0) ?/)) + ;; Check relative to root of project + (setq filename (expand-file-name (substring filename 1) + dir)) + ;; Relative to current directory. + (setq filename (expand-file-name filename))) + + filename)) + +(defmethod ede-set-project-variables ((project ede-cpp-root-project) &optional buffer) + "Set variables local to PROJECT in BUFFER. +Also set up the lexical preprocessor map." + (call-next-method) + (when (and (featurep 'semantic-c) (featurep 'semantic-lex-spp)) + (setq semantic-lex-spp-project-macro-symbol-obarray + (semantic-lex-make-spp-table (oref project spp-table))) + )) + +(defmethod ede-system-include-path ((this ede-cpp-root-project)) + "Get the system include path used by project THIS." + (oref this system-include-path)) + +(defmethod ede-preprocessor-map ((this ede-cpp-root-project)) + "Get the pre-processor map for project THIS." + (require 'semantic/db) + (let ((spp (oref this spp-table)) + (root (ede-project-root this)) + ) + (mapc + (lambda (F) + (let* ((expfile (ede-expand-filename root F)) + (table (when expfile + (semanticdb-file-table-object expfile))) + ) + (when (not table) + (message "Cannot find file %s in project." F)) + (when (and table (semanticdb-needs-refresh-p table)) + (semanticdb-refresh-table table)) + (setq spp (append spp (oref table lexical-table))))) + (oref this spp-files)) + spp)) + +(defmethod ede-system-include-path ((this ede-cpp-root-target)) + "Get the system include path used by project THIS." + (ede-system-include-path (ede-target-parent this))) + +(defmethod ede-preprocessor-map ((this ede-cpp-root-target)) + "Get the pre-processor map for project THIS." + (ede-preprocessor-map (ede-target-parent this))) + +(provide 'ede/cpp-root) + +;; Local variables: +;; generated-autoload-file: "loaddefs.el" +;; generated-autoload-feature: ede/loaddefs +;; generated-autoload-load-name: "ede/cpp-root" +;; End: + +;;; ede/cpp-root.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/cedet/ede/dired.el Sun Sep 20 15:06:05 2009 +0000 @@ -0,0 +1,109 @@ +;;; ede/dired.el --- EDE extensions to dired. + +;;; Copyright (C) 1998, 1999, 2000, 2003 Free Software Foundation, Inc. + +;; Author: Eric M. Ludlam <zappo@gnu.org> +;; Version: 0.4 +;; Keywords: project, make + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; This provides a dired interface to EDE, allowing users to modify +;; their project file by adding files (or whatever) directly from a +;; dired buffer. + +(require 'easymenu) +(require 'dired) +(require 'ede) + +;;; Code: +(defvar ede-dired-minor-mode nil + "Non-nil when in ede dired minor mode.") +(make-variable-buffer-local 'ede-dired-minor-mode) + +(defvar ede-dired-keymap nil + "Keymap used for ede dired minor mode.") + +(if ede-dired-keymap + nil + (setq ede-dired-keymap (make-sparse-keymap)) + (define-key ede-dired-keymap ".a" 'ede-dired-add-to-target) + (define-key ede-dired-keymap ".t" 'ede-new-target) + (define-key ede-dired-keymap ".s" 'ede-speedbar) + (define-key ede-dired-keymap ".C" 'ede-compile-project) + (define-key ede-dired-keymap ".d" 'ede-make-dist) + + (easy-menu-define + ede-dired-menu ede-dired-keymap "EDE Dired Minor Mode Menu" + '("Project" + [ "Add files to target" ede-dired-add-to-target (ede-current-project) ] + ( "Build" :filter ede-build-forms-menu) + "-" + [ "Create Project" ede-new (not (ede-current-project)) ] + [ "Create Target" ede-new-target (ede-current-project) ] + "-" + ( "Customize Project" :filter ede-customize-forms-menu ) + [ "View Project Tree" ede-speedbar (ede-current-project) ] + )) + ) + +(defun ede-dired-minor-mode (&optional arg) + "A minor mode that should only be activated in DIRED buffers. +If ARG is nil, toggle, if it is a positive number, force on, if +negative, force off." + (interactive "P") + (if (not (or (eq major-mode 'dired-mode) + (eq major-mode 'vc-dired-mode))) + (error "Not in DIRED mode")) + (setq ede-dired-minor-mode + (not (or (and (null arg) ede-dired-minor-mode) + (<= (prefix-numeric-value arg) 0)))) + (if (and (not (ede-directory-project-p default-directory)) + (not (interactive-p))) + (setq ede-dired-minor-mode nil)) + ) + +(defun ede-dired-add-to-target (target) + "Add a file, or all marked files into a TARGET." + (interactive (list + (let ((ede-object (ede-current-project))) + (ede-invoke-method 'project-interactive-select-target + "Add files to Target: ")))) + (let ((files (dired-get-marked-files t))) + (while files + (project-add-file target (car files)) + ;; Find the buffer for this files, and set it's ede-object + (if (get-file-buffer (car files)) + (save-excursion + (set-buffer (get-file-buffer (car files))) + (setq ede-object nil) + (setq ede-object (ede-buffer-object (current-buffer))))) + ;; Increment. + (setq files (cdr files))))) + +;; Minor mode management. +(add-to-list 'minor-mode-alist '(ede-dired-minor-mode " EDE")) +(let ((a (assoc 'ede-dired-minor-mode minor-mode-map-alist))) + (if a + (setcdr a ede-dired-keymap) + (add-to-list 'minor-mode-map-alist (cons 'ede-dired-minor-mode + ede-dired-keymap)))) + +(provide 'ede/dired) + +;;; ede/dired.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/cedet/ede/emacs.el Sun Sep 20 15:06:05 2009 +0000 @@ -0,0 +1,257 @@ +;;; ede/emacs.el --- Special project for Emacs + +;; Copyright (C) 2008, 2009 Free Software Foundation, Inc. + +;; Author: Eric M. Ludlam <eric@siege-engine.com> + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; Provide a special project type just for Emacs, cause Emacs is special. +;; +;; Identifies an Emacs project automatically. +;; Speedy ede-expand-filename based on extension. +;; Pre-populates the preprocessor map from lisp.h +;; +;; ToDo : +;; * Add "build" options. +;; * Add texinfo lookup options. +;; * Add website + +(require 'ede) +(declare-function semanticdb-file-table-object "semantic/db") +(declare-function semanticdb-needs-refresh-p "semantic/db") +(declare-function semanticdb-refresh-table "semantic/db") + +;;; Code: +(defvar ede-emacs-project-list nil + "List of projects created by option `ede-emacs-project'.") + +(defun ede-emacs-file-existing (dir) + "Find a Emacs project in the list of Emacs projects. +DIR is the directory to search from." + (let ((projs ede-emacs-project-list) + (ans nil)) + (while (and projs (not ans)) + (let ((root (ede-project-root-directory (car projs)))) + (when (string-match (concat "^" (regexp-quote root)) dir) + (setq ans (car projs)))) + (setq projs (cdr projs))) + ans)) + +;;;###autoload +(defun ede-emacs-project-root (&optional dir) + "Get the root directory for DIR." + (when (not dir) (setq dir default-directory)) + (let ((case-fold-search t) + (proj (ede-emacs-file-existing dir))) + (if proj + (ede-up-directory (file-name-directory + (oref proj :file))) + ;; No pre-existing project. Lets take a wild-guess if we have + ;; an Emacs project here. + (when (string-match "emacs[^/]*" dir) + (let ((base (substring dir 0 (match-end 0)))) + (when (file-exists-p (expand-file-name "src/emacs.c" base)) + base)))))) + +(defun ede-emacs-version (dir) + "Find the Emacs version for the Emacs src in DIR." + (let ((buff (get-buffer-create " *emacs-query*"))) + (save-excursion + (set-buffer buff) + (erase-buffer) + (setq default-directory (file-name-as-directory dir)) + (call-process "egrep" nil buff nil "-n" "-e" "^version=" "Makefile") + (goto-char (point-min)) + (re-search-forward "version=\\([0-9.]+\\)") + (prog1 + (match-string 1) + (kill-buffer buff) + )))) + +(defclass ede-emacs-project (ede-project eieio-instance-tracker) + ((tracking-symbol :initform 'ede-emacs-project-list) + ) + "Project Type for the Emacs source code." + :method-invocation-order :depth-first) + +(defun ede-emacs-load (dir &optional rootproj) + "Return an Emacs Project object if there is a match. +Return nil if there isn't one. +Argument DIR is the directory it is created for. +ROOTPROJ is nil, since there is only one project." + (or (ede-emacs-file-existing dir) + ;; Doesn't already exist, so lets make one. + (ede-emacs-project "Emacs" + :name (concat "Emacs" (ede-emacs-version dir)) + :directory dir + :file (expand-file-name "src/emacs.c" + dir)) + (ede-add-project-to-global-list this) + ) + ) + +(defclass ede-emacs-target-c (ede-target) + () + "EDE Emacs Project target for C code. +All directories need at least one target.") + +(defclass ede-emacs-target-el (ede-target) + () + "EDE Emacs Project target for Emacs Lisp code. +All directories need at least one target.") + +(defclass ede-emacs-target-misc (ede-target) + () + "EDE Emacs Project target for Misc files. +All directories need at least one target.") + +(defmethod initialize-instance ((this ede-emacs-project) + &rest fields) + "Make sure the :file is fully expanded." + (call-next-method) + (unless (slot-boundp this 'targets) + (oset this :targets nil))) + +;;; File Stuff +;; +(defmethod ede-project-root-directory ((this ede-emacs-project) + &optional file) + "Return the root for THIS Emacs project with file." + (ede-up-directory (file-name-directory (oref this file)))) + +(defmethod ede-project-root ((this ede-emacs-project)) + "Return my root." + this) + +(defmethod ede-find-subproject-for-directory ((proj ede-emacs-project) + dir) + "Return PROJ, for handling all subdirs below DIR." + proj) + +;;; TARGET MANAGEMENT +;; +(defun ede-emacs-find-matching-target (class dir targets) + "Find a target that is a CLASS and is in DIR in the list of TARGETS." + (let ((match nil)) + (dolist (T targets) + (when (and (object-of-class-p T class) + (string= (oref T :path) dir)) + (setq match T) + )) + match)) + +(defmethod ede-find-target ((proj ede-emacs-project) buffer) + "Find an EDE target in PROJ for BUFFER. +If one doesn't exist, create a new one for this directory." + (let* ((ext (file-name-extension (buffer-file-name buffer))) + (cls (cond ((not ext) + 'ede-emacs-target-misc) + ((string-match "c\\|h" ext) + 'ede-emacs-target-c) + ((string-match "elc?" ext) + 'ede-emacs-target-el) + (t 'ede-emacs-target-misc))) + (targets (oref proj targets)) + (dir default-directory) + (ans (ede-emacs-find-matching-target cls dir targets)) + ) + (when (not ans) + (setq ans (make-instance + cls + :name (file-name-nondirectory + (directory-file-name dir)) + :path dir + :source nil)) + (object-add-to-list proj :targets ans) + ) + ans)) + +;;; UTILITIES SUPPORT. +;; +(defmethod ede-preprocessor-map ((this ede-emacs-target-c)) + "Get the pre-processor map for Emacs C code. +All files need the macros from lisp.h!" + (require 'semantic/db) + (let* ((proj (ede-target-parent this)) + (root (ede-project-root proj)) + (table (semanticdb-file-table-object + (ede-expand-filename root "lisp.h"))) + filemap + ) + (when table + (when (semanticdb-needs-refresh-p table) + (semanticdb-refresh-table table)) + (setq filemap (append filemap (oref table lexical-table))) + ) + filemap + )) + +(defun ede-emacs-find-in-directories (name base dirs) + "Find NAME is BASE directory sublist of DIRS." + (let ((ans nil)) + (while (and dirs (not ans)) + (let* ((D (car dirs)) + (ed (expand-file-name D base)) + (ef (expand-file-name name ed))) + (if (file-exists-p ef) + (setq ans ef) + ;; Not in this dir? How about subdirs? + (let ((dirfile (directory-files ed t)) + (moredirs nil) + ) + ;; Get all the subdirs. + (dolist (DF dirfile) + (when (and (file-directory-p DF) + (not (string-match "\\.$" DF))) + (push DF moredirs))) + ;; Try again. + (setq ans (ede-emacs-find-in-directories name ed moredirs)) + )) + (setq dirs (cdr dirs)))) + ans)) + +(defmethod ede-expand-filename-impl ((proj ede-emacs-project) name) + "Within this project PROJ, find the file NAME. +Knows about how the Emacs source tree is organized." + (let* ((ext (file-name-extension name)) + (root (ede-project-root proj)) + (dir (ede-project-root-directory root)) + (dirs (cond + ((not ext) nil) + ((string-match "h\\|c" ext) + '("src" "lib-src" "lwlib")) + ((string-match "elc?" ext) + '("lisp")) + ((string-match "texi" ext) + '("doc")) + (t nil))) + ) + (if (not dirs) (call-next-method) + (ede-emacs-find-in-directories name dir dirs)) + )) + +(provide 'ede/emacs) + +;; Local variables: +;; generated-autoload-file: "loaddefs.el" +;; generated-autoload-feature: ede/loaddefs +;; generated-autoload-load-name: "ede/emacs" +;; End: + +;;; ede/emacs.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/cedet/ede/files.el Sun Sep 20 15:06:05 2009 +0000 @@ -0,0 +1,516 @@ +;;; ede/files.el --- Associate projects with files and directories. + +;; Copyright (C) 2008, 2009 Free Software Foundation, Inc. + +;; Author: Eric M. Ludlam <eric@siege-engine.com> + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; Directory and File scanning and matching functions. +;; +;; Basic Model: +;; +;; A directory belongs to a project if a ede-project-autoload structure +;; matches your directory. +;; +;; A toplevel project is one where there is no active project above +;; it. Finding the toplevel project involves going up a directory +;; till no ede-project-autoload structure matches. +;; + +(require 'ede) + +(declare-function ede-locate-file-in-hash "ede/locate") +(declare-function ede-locate-add-file-to-hash "ede/locate") +(declare-function ede-locate-file-in-project "ede/locate") + +(defvar ede--disable-inode nil + "Set to 't' to simulate systems w/out inode support.") + +;;; Code: +;;;###autoload +(defun ede-find-file (file) + "Find FILE in project. FILE can be specified without a directory. +There is no completion at the prompt. FILE is searched for within +the current EDE project." + (interactive "sFile: ") + (let ((fname (ede-expand-filename (ede-current-project) file)) + ) + (unless fname + (error "Could not find %s in %s" + file + (ede-project-root-directory (ede-current-project)))) + (find-file fname))) + +;;; Placeholders for ROOT directory scanning on base objects +;; +(defmethod ede-project-root ((this ede-project-placeholder)) + "If a project knows it's root, return it here. +Allows for one-project-object-for-a-tree type systems." + (oref this rootproject)) + +(defmethod ede-project-root-directory ((this ede-project-placeholder) + &optional file) + "If a project knows it's root, return it here. +Allows for one-project-object-for-a-tree type systems. +Optional FILE is the file to test. It is ignored in preference +of the anchor file for the project." + (file-name-directory (expand-file-name (oref this file)))) + + +(defmethod ede-project-root ((this ede-project-autoload)) + "If a project knows it's root, return it here. +Allows for one-project-object-for-a-tree type systems." + nil) + +(defmethod ede-project-root-directory ((this ede-project-autoload) + &optional file) + "If a project knows it's root, return it here. +Allows for one-project-object-for-a-tree type systems. +Optional FILE is the file to test. If there is no FILE, use +the current buffer." + (when (not file) + (setq file default-directory)) + (when (slot-boundp this :proj-root) + (let ((rootfcn (oref this proj-root))) + (when rootfcn + (condition-case nil + (funcall rootfcn file) + (error + (funcall rootfcn))) + )))) + +(defmethod ede--project-inode ((proj ede-project-placeholder)) + "Get the inode of the directory project PROJ is in." + (if (slot-boundp proj 'dirinode) + (oref proj dirinode) + (oset proj dirinode (ede--inode-for-dir (oref proj :directory))))) + +(defmethod ede-find-subproject-for-directory ((proj ede-project-placeholder) + dir) + "Find a subproject of PROJ that corresponds to DIR." + (if ede--disable-inode + (let ((ans nil)) + ;; Try to find the right project w/out inodes. + (ede-map-subprojects + proj + (lambda (SP) + (when (not ans) + (if (string= (file-truename dir) (oref SP :directory)) + (setq ans SP) + (ede-find-subproject-for-directory SP dir))))) + ans) + ;; We can use inodes, so lets try it. + (let ((ans nil) + (inode (ede--inode-for-dir dir))) + (ede-map-subprojects + proj + (lambda (SP) + (when (not ans) + (if (equal (ede--project-inode SP) inode) + (setq ans SP) + (ede-find-subproject-for-directory SP dir))))) + ans))) + +;;; DIRECTORY IN OPEN PROJECT +;; +;; These routines match some directory name to one of the many pre-existing +;; open projects. This should avoid hitting the disk, or asking lots of questions +;; if used throughout the other routines. +(defvar ede-inode-directory-hash (make-hash-table + ;; Note on test. Can we compare inodes or something? + :test 'equal) + "A hash of directory names and inodes.") + +(defun ede--put-inode-dir-hash (dir inode) + "Add to the EDE project hash DIR associated with INODE." + (when (fboundp 'puthash) + (puthash dir inode ede-inode-directory-hash) + inode)) + +(defun ede--get-inode-dir-hash (dir) + "Get the EDE project hash DIR associated with INODE." + (when (fboundp 'gethash) + (gethash dir ede-inode-directory-hash) + )) + +(defun ede--inode-for-dir (dir) + "Return the inode for the directory DIR." + (let ((hashnode (ede--get-inode-dir-hash (expand-file-name dir)))) + (or hashnode + (if ede--disable-inode + (ede--put-inode-dir-hash dir 0) + (let ((fattr (file-attributes dir))) + (ede--put-inode-dir-hash dir (nth 10 fattr)) + ))))) + +(defun ede-directory-get-open-project (dir &optional rootreturn) + "Return an already open project that is managing DIR. +Optional ROOTRETURN specifies a symbol to set to the root project. +If DIR is the root project, then it is the same." + (let* ((inode (ede--inode-for-dir dir)) + (ft (file-name-as-directory (expand-file-name dir))) + (proj (ede--inode-get-toplevel-open-project inode)) + (ans nil)) + ;; Try file based search. + (when (not proj) + (setq proj (ede-directory-get-toplevel-open-project ft))) + ;; Default answer is this project + (setq ans proj) + ;; Save. + (when rootreturn (set rootreturn proj)) + ;; Find subprojects. + (when (and proj (or ede--disable-inode + (not (equal inode (ede--project-inode proj))))) + (setq ans (ede-find-subproject-for-directory proj ft))) + ans)) + +(defun ede--inode-get-toplevel-open-project (inode) + "Return an already open toplevel project that is managing INODE. +Does not check subprojects." + (when (or (and (numberp inode) (/= inode 0)) + (consp inode)) + (let ((all ede-projects) + (found nil) + ) + (while (and all (not found)) + (when (equal inode (ede--project-inode (car all))) + (setq found (car all))) + (setq all (cdr all))) + found))) + +(defun ede-directory-get-toplevel-open-project (dir) + "Return an already open toplevel project that is managing DIR." + (let ((ft (file-name-as-directory (expand-file-name dir))) + (all ede-projects) + (ans nil)) + (while (and all (not ans)) + ;; Do the check. + (let ((pd (oref (car all) :directory)) + ) + (cond + ;; Exact text match. + ((string= pd ft) + (setq ans (car all))) + ;; Some sub-directory + ((string-match (concat "^" (regexp-quote pd)) ft) + (setq ans (car all))) + ;; Exact inode match. Useful with symlinks or complex automounters. + ((let ((pin (ede--project-inode (car all))) + (inode (ede--inode-for-dir dir))) + (and (not (eql pin 0)) (equal pin inode))) + (setq ans (car all))) + ;; Subdir via truename - slower by far, but faster than a traditional lookup. + ((let ((ftn (file-truename ft)) + (ptd (file-truename (oref (car all) :directory)))) + (string-match (concat "^" (regexp-quote ptd)) ftn)) + (setq ans (car all))) + )) + (setq all (cdr all))) + ans)) + +;;; DIRECTORY-PROJECT-P +;; +;; For a fresh buffer, or for a path w/ no open buffer, use this +;; routine to determine if there is a known project type here. +(defvar ede-project-directory-hash (make-hash-table + ;; Note on test. Can we compare inodes or something? + :test 'equal) + "A hash of directory names and associated EDE objects.") + +(defun ede-project-directory-remove-hash (dir) + "Reset the directory hash for DIR. +Do this whenever a new project is created, as opposed to loaded." + ;; TODO - Use maphash, and delete by regexp, not by dir searching! + + (when (fboundp 'remhash) + (remhash (file-name-as-directory dir) ede-project-directory-hash) + ;; Look for all subdirs of D, and remove them. + (let ((match (concat "^" (regexp-quote dir)))) + (maphash (lambda (K O) + (when (string-match match K) + (remhash K ede-project-directory-hash))) + ede-project-directory-hash)) + )) + +(defun ede-directory-project-from-hash (dir) + "If there is an already loaded project for DIR, return it from the hash." + (when (fboundp 'gethash) + (gethash dir ede-project-directory-hash nil))) + +(defun ede-directory-project-add-description-to-hash (dir desc) + "Add to the EDE project hash DIR associated with DESC." + (when (fboundp 'puthash) + (puthash dir desc ede-project-directory-hash) + desc)) + +(defun ede-directory-project-p (dir &optional force) + "Return a project description object if DIR has a project. +Optional argument FORCE means to ignore a hash-hit of 'nomatch. +This depends on an up to date `ede-project-class-files' variable." + (let* ((dirtest (expand-file-name dir)) + (match (ede-directory-project-from-hash dirtest))) + (cond + ((and (eq match 'nomatch) (not force)) + nil) + ((and match (not (eq match 'nomatch))) + match) + (t + (let ((types ede-project-class-files) + (ret nil)) + ;; Loop over all types, loading in the first type that we find. + (while (and types (not ret)) + (if (ede-dir-to-projectfile (car types) dirtest) + (progn + ;; We found one! Require it now since we will need it. + (require (oref (car types) file)) + (setq ret (car types)))) + (setq types (cdr types))) + (ede-directory-project-add-description-to-hash dirtest (or ret 'nomatch)) + ret))))) + +;;; TOPLEVEL +;; +;; These utilities will identify the "toplevel" of a project. +;; +(defun ede-toplevel-project-or-nil (dir) + "Starting with DIR, find the toplevel project directory, or return nil. +nil is returned if the current directory is not a part ofa project." + (let* ((ans (ede-directory-get-toplevel-open-project dir))) + (if ans + (oref ans :directory) + (if (ede-directory-project-p dir) + (ede-toplevel-project dir) + nil)))) + +(defun ede-toplevel-project (dir) + "Starting with DIR, find the toplevel project directory." + (if (and (string= dir default-directory) + ede-object-root-project) + ;; Try the local buffer cache first. + (oref ede-object-root-project :directory) + ;; Otherwise do it the hard way. + (let* ((thisdir (ede-directory-project-p dir)) + (ans (ede-directory-get-toplevel-open-project dir))) + (if (and ans ;; We have an answer + (or (not thisdir) ;; this dir isn't setup + (and (object-of-class-p ;; Same as class for this dir? + ans (oref thisdir :class-sym))) + )) + (oref ans :directory) + (let* ((toppath (expand-file-name dir)) + (newpath toppath) + (proj (ede-directory-project-p dir)) + (ans nil)) + (if proj + ;; If we already have a project, ask it what the root is. + (setq ans (ede-project-root-directory proj))) + + ;; If PROJ didn't know, or there is no PROJ, then + + ;; Loop up to the topmost project, and then load that single + ;; project, and it's sub projects. When we are done, identify the + ;; sub-project object belonging to file. + (while (and (not ans) newpath proj) + (setq toppath newpath + newpath (ede-up-directory toppath)) + (when newpath + (setq proj (ede-directory-project-p newpath))) + + (when proj + ;; We can home someone in the middle knows too. + (setq ans (ede-project-root-directory proj))) + ) + (or ans toppath)))))) + +;;; TOPLEVEL PROJECT +;; +;; The toplevel project is a way to identify the EDE structure that belongs +;; to the top of a project. + +(defun ede-toplevel (&optional subproj) + "Return the ede project which is the root of the current project. +Optional argument SUBPROJ indicates a subproject to start from +instead of the current project." + (or ede-object-root-project + (let* ((cp (or subproj (ede-current-project))) + ) + (or (and cp (ede-project-root cp)) + (progn + (while (ede-parent-project cp) + (setq cp (ede-parent-project cp))) + cp))))) + +;;; DIRECTORY CONVERSION STUFF +;; +(defmethod ede-convert-path ((this ede-project) path) + "Convert path in a standard way for a given project. +Default to making it project relative. +Argument THIS is the project to convert PATH to." + (let ((pp (ede-project-root-directory this)) + (fp (expand-file-name path))) + (if (string-match (regexp-quote pp) fp) + (substring fp (match-end 0)) + (let ((pptf (file-truename pp)) + (fptf (file-truename fp))) + (if (string-match (regexp-quote pptf) fptf) + (substring fptf (match-end 0)) + (error "Cannot convert relativize path %s" fp)))))) + +(defmethod ede-convert-path ((this ede-target) path) + "Convert path in a standard way for a given project. +Default to making it project relative. +Argument THIS is the project to convert PATH to." + (let ((proj (ede-target-parent this))) + (if proj + (let ((p (ede-convert-path proj path)) + (lp (or (oref this path) ""))) + ;; Our target THIS may have path information. + ;; strip this out of the conversion. + (if (string-match (concat "^" (regexp-quote lp)) p) + (substring p (length lp)) + p)) + (error "Parentless target %s" this)))) + +;;; FILENAME EXPANSION +;; +(defun ede-get-locator-object (proj) + "Get the locator object for project PROJ. +Get it from the toplevel project. If it doesn't have one, make one." + ;; Make sure we have a location object available for + ;; caching values, and for locating things more robustly. + (let ((top (ede-toplevel proj))) + (when (not (slot-boundp top 'locate-obj)) + (ede-enable-locate-on-project this)) + (oref top locate-obj) + )) + +(defmethod ede-expand-filename ((this ede-project) filename &optional force) + "Return a fully qualified file name based on project THIS. +FILENAME should be just a filename which occurs in a directory controlled +by this project. +Optional argument FORCE forces the default filename to be provided even if it +doesn't exist. +If FORCE equals 'newfile, then the cache is ignored." + (require 'ede/locate) + (let* ((loc (ede-get-locator-object this)) + (ha (ede-locate-file-in-hash loc filename)) + (ans nil) + ) + ;; NOTE: This function uses a locator object, which keeps a hash + ;; table of files it has found in the past. The hash table is + ;; used to make commonly found file very fast to location. Some + ;; complex routines, such as smart completion asks this question + ;; many times, so doing this speeds things up, especially on NFS + ;; or other remote file systems. + + ;; As such, special care is needed to use the hash, and also obey + ;; the FORCE option, which is needed when trying to identify some + ;; new file that needs to be created, such as a Makefile. + (cond + ;; We have a hash-table match, AND that match wasn't the 'nomatch + ;; flag, we can return it. + ((and ha (not (eq ha 'nomatch))) + (setq ans ha)) + ;; If we had a match, and it WAS no match, then we need to look + ;; at the force-option to see what to do. Since ans is already + ;; nil, then we do nothing. + ((and (eq ha 'nomatch) (not (eq force 'newfile))) + nil) + ;; We had no hash table match, so we have to look up this file + ;; using the usual EDE file expansion rules. + (t + (let ((calc (ede-expand-filename-impl this filename))) + (if calc + (progn + (ede-locate-add-file-to-hash loc filename calc) + (setq ans calc)) + ;; If we failed to calculate something, we + ;; should add it to the hash, but ONLY if we are not + ;; going to FORCE the file into existance. + (when (not force) + (ede-locate-add-file-to-hash loc filename 'nomatch)))) + )) + ;; Now that all options have been queried, if the FORCE option is + ;; true, but ANS is still nil, then we can make up a file name. + + ;; Is it forced? + (when (and force (not ans)) + (let ((dir (ede-project-root-directory this))) + (setq ans (expand-file-name filename dir)))) + + ans)) + +(defmethod ede-expand-filename-impl ((this ede-project) filename &optional force) + "Return a fully qualified file name based on project THIS. +FILENAME should be just a filename which occurs in a directory controlled +by this project. +Optional argument FORCE forces the default filename to be provided even if it +doesn't exist." + (let ((loc (ede-get-locator-object this)) + (path (ede-project-root-directory this)) + (proj (oref this subproj)) + (found nil)) + ;; find it Locally. + (setq found + (cond ((file-exists-p (expand-file-name filename path)) + (expand-file-name filename path)) + ((file-exists-p (expand-file-name (concat "include/" filename) path)) + (expand-file-name (concat "include/" filename) path)) + (t + (while (and (not found) proj) + (setq found (when (car proj) + (ede-expand-filename (car proj) filename)) + proj (cdr proj))) + found))) + ;; Use an external locate tool. + (when (not found) + (require 'ede/locate) + (setq found (car (ede-locate-file-in-project loc filename)))) + ;; Return it + found)) + +(defmethod ede-expand-filename ((this ede-target) filename &optional force) + "Return a fully qualified file name based on target THIS. +FILENAME should a a filename which occurs in a directory in which THIS works. +Optional argument FORCE forces the default filename to be provided even if it +doesn't exist." + (ede-expand-filename (ede-target-parent this) filename force)) + +;;; UTILITIES +;; + +(defun ede-up-directory (dir) + "Return a dir that is up one directory. +Argument DIR is the directory to trim upwards." + (let* ((fad (directory-file-name dir)) + (fnd (file-name-directory fad))) + (if (string= dir fnd) ; This will catch the old string-match against + ; c:/ for DOS like systems. + nil + fnd))) + +(provide 'ede/files) + +;; Local variables: +;; generated-autoload-file: "loaddefs.el" +;; generated-autoload-feature: ede/loaddefs +;; generated-autoload-load-name: "ede/files" +;; End: + +;;; ede/files.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/cedet/ede/linux.el Sun Sep 20 15:06:05 2009 +0000 @@ -0,0 +1,237 @@ +;;; ede/linux.el --- Special project for Linux + +;; Copyright (C) 2008, 2009 Free Software Foundation, Inc. + +;; Author: Eric M. Ludlam <eric@siege-engine.com> + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; Provide a special project type just for Linux, cause Linux is special. +;; +;; Identifies a Linux project automatically. +;; Speedy ede-expand-filename based on extension. +;; Pre-populates the preprocessor map from lisp.h +;; +;; ToDo : +;; * Add "build" options. +;; * Add texinfo lookup options. +;; * Add website + +(require 'ede) +(declare-function semanticdb-file-table-object "semantic/db") +(declare-function semanticdb-needs-refresh-p "semantic/db") +(declare-function semanticdb-refresh-table "semantic/db") + +;;; Code: +(defvar ede-linux-project-list nil + "List of projects created by option `ede-linux-project'.") + +(defun ede-linux-file-existing (dir) + "Find a Linux project in the list of Linux projects. +DIR is the directory to search from." + (let ((projs ede-linux-project-list) + (ans nil)) + (while (and projs (not ans)) + (let ((root (ede-project-root-directory (car projs)))) + (when (string-match (concat "^" (regexp-quote root)) dir) + (setq ans (car projs)))) + (setq projs (cdr projs))) + ans)) + +;;;###autoload +(defun ede-linux-project-root (&optional dir) + "Get the root directory for DIR." + (when (not dir) (setq dir default-directory)) + (let ((case-fold-search t) + (proj (ede-linux-file-existing dir))) + (if proj + (ede-up-directory (file-name-directory + (oref proj :file))) + ;; No pre-existing project. Lets take a wild-guess if we have + ;; an Linux project here. + (when (string-match "linux[^/]*" dir) + (let ((base (substring dir 0 (match-end 0)))) + (when (file-exists-p (expand-file-name "scripts/ver_linux" base)) + base)))))) + +(defun ede-linux-version (dir) + "Find the Linux version for the Linux src in DIR." + (let ((buff (get-buffer-create " *linux-query*"))) + (save-excursion + (set-buffer buff) + (erase-buffer) + (setq default-directory (file-name-as-directory dir)) + (call-process "head" nil buff nil "-n" "3" "Makefile") + (goto-char (point-min)) + (let (major minor sub) + (re-search-forward "^VERSION *= *\\([0-9.]+\\)") + (setq major (match-string 1)) + (re-search-forward "^PATCHLEVEL *= *\\([0-9.]+\\)") + (setq minor (match-string 1)) + (re-search-forward "^SUBLEVEL *= *\\([0-9.]+\\)") + (setq sub (match-string 1)) + (prog1 + (concat major "." minor "." sub) + (kill-buffer buff) + ))))) + +(defclass ede-linux-project (ede-project eieio-instance-tracker) + ((tracking-symbol :initform 'ede-linux-project-list) + ) + "Project Type for the Linux source code." + :method-invocation-order :depth-first) + +(defun ede-linux-load (dir &optional rootproj) + "Return an Linux Project object if there is a match. +Return nil if there isn't one. +Argument DIR is the directory it is created for. +ROOTPROJ is nil, since there is only one project." + (or (ede-linux-file-existing dir) + ;; Doesn't already exist, so lets make one. + (ede-linux-project "Linux" + :name (concat "Linux" (ede-linux-version dir)) + :directory dir + :file (expand-file-name "scripts/ver_linux" + dir)) + (ede-add-project-to-global-list this) + ) + ) + +(defclass ede-linux-target-c (ede-target) + () + "EDE Linux Project target for C code. +All directories need at least one target.") + +(defclass ede-linux-target-misc (ede-target) + () + "EDE Linux Project target for Misc files. +All directories need at least one target.") + +(defmethod initialize-instance ((this ede-linux-project) + &rest fields) + "Make sure the :file is fully expanded." + (call-next-method) + (unless (slot-boundp this 'targets) + (oset this :targets nil))) + +;;; File Stuff +;; +(defmethod ede-project-root-directory ((this ede-linux-project) + &optional file) + "Return the root for THIS Linux project with file." + (ede-up-directory (file-name-directory (oref this file)))) + +(defmethod ede-project-root ((this ede-linux-project)) + "Return my root." + this) + +(defmethod ede-find-subproject-for-directory ((proj ede-linux-project) + dir) + "Return PROJ, for handling all subdirs below DIR." + proj) + +;;; TARGET MANAGEMENT +;; +(defun ede-linux-find-matching-target (class dir targets) + "Find a target that is a CLASS and is in DIR in the list of TARGETS." + (let ((match nil)) + (dolist (T targets) + (when (and (object-of-class-p T class) + (string= (oref T :path) dir)) + (setq match T) + )) + match)) + +(defmethod ede-find-target ((proj ede-linux-project) buffer) + "Find an EDE target in PROJ for BUFFER. +If one doesn't exist, create a new one for this directory." + (let* ((ext (file-name-extension (buffer-file-name buffer))) + (cls (cond ((not ext) + 'ede-linux-target-misc) + ((string-match "c\\|h" ext) + 'ede-linux-target-c) + (t 'ede-linux-target-misc))) + (targets (oref proj targets)) + (dir default-directory) + (ans (ede-linux-find-matching-target cls dir targets)) + ) + (when (not ans) + (setq ans (make-instance + cls + :name (file-name-nondirectory + (directory-file-name dir)) + :path dir + :source nil)) + (object-add-to-list proj :targets ans) + ) + ans)) + +;;; UTILITIES SUPPORT. +;; +(defmethod ede-preprocessor-map ((this ede-linux-target-c)) + "Get the pre-processor map for Linux C code. +All files need the macros from lisp.h!" + (require 'semantic/db) + (let* ((proj (ede-target-parent this)) + (root (ede-project-root proj)) + (versionfile (ede-expand-filename root "include/linux/version.h")) + (table (when (and versionfile (file-exists-p versionfile)) + (semanticdb-file-table-object versionfile))) + (filemap '( ("__KERNEL__" . "") + )) + ) + (when table + (when (semanticdb-needs-refresh-p table) + (semanticdb-refresh-table table)) + (setq filemap (append filemap (oref table lexical-table))) + ) + filemap + )) + +(defun ede-linux-file-exists-name (name root subdir) + "Return a file name if NAME exists under ROOT with SUBDIR in between." + (let ((F (expand-file-name name (expand-file-name subdir root)))) + (when (file-exists-p F) F))) + +(defmethod ede-expand-filename-impl ((proj ede-linux-project) name) + "Within this project PROJ, find the file NAME. +Knows about how the Linux source tree is organized." + (let* ((ext (file-name-extension name)) + (root (ede-project-root proj)) + (dir (ede-project-root-directory root)) + (F (cond + ((not ext) nil) + ((string-match "h" ext) + (or (ede-linux-file-exists-name name dir "") + (ede-linux-file-exists-name name dir "include")) + ) + ((string-match "txt" ext) + (ede-linux-file-exists-name name dir "Documentation")) + (t nil))) + ) + (or F (call-next-method)))) + +(provide 'ede/linux) + +;; Local variables: +;; generated-autoload-file: "loaddefs.el" +;; generated-autoload-feature: ede/loaddefs +;; generated-autoload-load-name: "ede/linux" +;; End: + +;;; ede/linux.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/cedet/ede/locate.el Sun Sep 20 15:06:05 2009 +0000 @@ -0,0 +1,328 @@ +;;; ede/locate.el --- Locate support + +;; Copyright (C) 2008, 2009 Free Software Foundation, Inc. + +;; Author: Eric M. Ludlam <eric@siege-engine.com> + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; Support for various LOCATE type functions. +;; +;; A key feature of EDE is `ede-expand-filename', which allows a +;; project to expand a filename reference in one file to some actual +;; filename. +;; +;; In that way, you may #include <foo.h>, and without knowing how to +;; read a Makefile, find it in <root>/include/foo.h. +;; +;; Some projects are regular, such as the Emacs project. Some +;; projects are completely controlled by EDE, such sh the Project.ede +;; based projects. +;; +;; For other projects, haveing a "quick hack" to support these location +;; routines is handy. +;; +;; The baseclass `ede-locate-base' provides the abstract interface to +;; finding files in a project. +;; +;; New location routines will subclass `ede-locate-base'. +;; +;; How to use: +;; +;; Configure `ede-locate-setup-options' to add the types of locate +;; features you have available. EDE will then enable the correct one +;; when it is available. + +(require 'ede) +(eval-when-compile (require 'data-debug) + (require 'eieio-datadebug) + (require 'cedet-global) + (require 'cedet-idutils) + (require 'cedet-cscope)) + +(require 'locate) + +;;; Code: +(defcustom ede-locate-setup-options + '(ede-locate-base) + "List of locate objects to try out by default. +Listed in order of preference. If the first item cannot be used in +a particular project, then the next one is tried. +It is always assumed that `ede-locate-base' is at end of the list." + :group 'ede + :type '(repeat + (choice (const :tag "None" ede-locate-base) + (const :tag "locate" ede-locate-locate) + (const :tag "GNU Global" ede-locate-global) + (const :tag "ID Utils" ede-locate-idutils) + (const :tag "CScope" ede-locate-cscope))) + ) + +;;;###autoload +(defun ede-enable-locate-on-project (&optional project) + "Enable an EDE locate feature on PROJECT. +Attempt to guess which project locate style to use +based on `ede-locate-setup-options'." + (interactive) + (let* ((proj (or project (ede-toplevel))) + (root (ede-project-root-directory proj)) + (opts ede-locate-setup-options) + (ans nil)) + (while (and opts (not ans)) + (when (ede-locate-ok-in-project (car opts) root) + ;; If interactive, check with the user. + (when (or (not (interactive-p)) + (y-or-n-p (format "Set project locator to %s? " (car opts)))) + (setq ans (car opts)))) + (setq opts (cdr opts))) + ;; No match? Always create the baseclass for the hashing tool. + (when (not ans) + (when (interactive-p) + (message "Setting locator to ede-locate-base")) + (setq ans 'ede-locate-base)) + (oset proj locate-obj (make-instance ans "Loc" :root root)) + (when (interactive-p) + (message "Satting locator to %s." ans)) + )) + +;;; LOCATE BASECLASS +;; +;; The baseclass for all location style queries. +(defclass ede-locate-base () + ((root :initarg :root + :documentation + "The root of these locat searches.") + (file :documentation + "The last file search for with EDE locate.") + (lastanswer :documentation + "The last answer provided by the locator.") + (hash :documentation + "Hash table of previously found files.") + ) + "Baseclass for LOCATE feature in EDE.") + +(defmethod initialize-instance ((loc ede-locate-base) &rest fields) + "Make sure we have a hash table." + ;; Basic setup. + (call-next-method) + ;; Make sure we have a hash table. + (oset loc hash (make-hash-table :test 'equal)) + ) + +(defmethod ede-locate-ok-in-project :static ((loc ede-locate-base) + root) + "Is it ok to use this project type under ROOT." + t) + +(defmethod ede-locate-file-in-hash ((loc ede-locate-base) + filestring) + "For LOC, is the file FILESTRING in our hashtable?" + (gethash filestring (oref loc hash))) + +(defmethod ede-locate-add-file-to-hash ((loc ede-locate-base) + filestring fullfilename) + "For LOC, add FILESTR to the hash with FULLFILENAME." + (puthash filestring fullfilename (oref loc hash))) + +(defmethod ede-locate-file-in-project ((loc ede-locate-base) + filesubstring + ) + "Locate with LOC occurances of FILESUBSTRING. +Searches are done under the current root of the EDE project +that crated this ede locat object." + (let ((ans (ede-locate-file-in-project-impl loc filesubstring)) + ) + (oset loc file filesubstring) + (oset loc lastanswer ans) + ans)) + +(defmethod ede-locate-file-in-project-impl ((loc ede-locate-base) + filesubstring + ) + "Locate with LOC occurances of FILESUBSTRING. +Searches are done under the current root of the EDE project +that crated this ede locat object." + nil + ) + +;;; LOCATE +;; +;; Using the standard unix "locate" command. +;; Since locate is system wide, we need to hack the search +;; to restrict it to within just this project. + +(defclass ede-locate-locate (ede-locate-base) + () + "EDE Locator using the locate command. +Configure the Emacs `locate-program' variable to also +configure the use of EDE locate.") + +(defmethod ede-locate-ok-in-project :static ((loc ede-locate-locate) + root) + "Is it ok to use this project type under ROOT." + (or (featurep 'locate) (locate-library "locate")) + ) + +(defmethod ede-locate-file-in-project-impl ((loc ede-locate-locate) + filesubstring) + "Locate with LOC occurances of FILESUBSTRING under PROJECTROOT. +Searches are done under the current root of the EDE project +that crated this ede locat object." + ;; We want something like: + ;; /my/project/root*/filesubstring.c + (let* ((searchstr (concat (directory-file-name (oref loc root)) + "*/" filesubstring)) + (b (get-buffer-create "*LOCATE*")) + (cd default-directory) + ) + (save-excursion + (set-buffer b) + (setq default-directory cd) + (erase-buffer)) + (apply 'call-process locate-command + nil b nil + searchstr nil) + (save-excursion + (set-buffer b) + (split-string (buffer-string) "\n" t)) + ) + ) + +;;; GLOBAL +;; +(defclass ede-locate-global (ede-locate-base) + () + "EDE Locator using GNU Global. +Configure EDE's use of GNU Global through the cedet-global.el +variable `cedet-global-command'.") + +(defmethod initialize-instance ((loc ede-locate-global) + &rest slots) + "Make sure that we can use GNU Global." + (require 'cedet-global) + ;; Get ourselves initialized. + (call-next-method) + ;; Do the checks. + (cedet-gnu-global-version-check) + (let* ((default-directory (oref loc root)) + (root (cedet-gnu-global-root))) + (when (not root) + (error "Cannot use GNU Global in %s" + (oref loc root)))) + ) + +(defmethod ede-locate-ok-in-project :static ((loc ede-locate-global) + root) + "Is it ok to use this project type under ROOT." + (require 'cedet-global) + (cedet-gnu-global-version-check) + (let* ((default-directory root) + (newroot (cedet-gnu-global-root))) + newroot)) + +(defmethod ede-locate-file-in-project-impl ((loc ede-locate-global) + filesubstring) + "Locate with LOC occurances of FILESUBSTRING under PROJECTROOT. +Searches are done under the current root of the EDE project +that crated this ede locat object." + (require 'cedet-global) + (let ((default-directory (oref loc root))) + (cedet-gnu-global-expand-filename filesubstring))) + +;;; IDUTILS +;; +(defclass ede-locate-idutils (ede-locate-base) + () + "EDE Locator using IDUtils. +Configure EDE's use of IDUtils through the cedet-idutils.el +file name searching variable `cedet-idutils-file-command'.") + +(defmethod initialize-instance ((loc ede-locate-idutils) + &rest slots) + "Make sure that we can use IDUtils." + ;; Get ourselves initialized. + (call-next-method) + ;; Do the checks. + (require 'cedet-idutils) + (cedet-idutils-version-check) + (when (not (cedet-idutils-support-for-directory (oref loc root))) + (error "Cannot use IDUtils in %s" + (oref loc root))) + ) + +(defmethod ede-locate-ok-in-project :static ((loc ede-locate-idutils) + root) + "Is it ok to use this project type under ROOT." + (require 'cedet-idutils) + (cedet-idutils-version-check) + (when (cedet-idutils-support-for-directory root) + root)) + +(defmethod ede-locate-file-in-project-impl ((loc ede-locate-idutils) + filesubstring) + "Locate with LOC occurances of FILESUBSTRING under PROJECTROOT. +Searches are done under the current root of the EDE project +that crated this ede locat object." + (require 'cedet-idutils) + (let ((default-directory (oref loc root))) + (cedet-idutils-expand-filename filesubstring))) + +;;; CSCOPE +;; +(defclass ede-locate-cscope (ede-locate-base) + () + "EDE Locator using Cscope. +Configure EDE's use of Cscope through the cedet-cscope.el +file name searching variable `cedet-cscope-file-command'.") + +(defmethod initialize-instance ((loc ede-locate-cscope) + &rest slots) + "Make sure that we can use Cscope." + ;; Get ourselves initialized. + (call-next-method) + ;; Do the checks. + (cedet-cscope-version-check) + (when (not (cedet-cscope-support-for-directory (oref loc root))) + (error "Cannot use Cscope in %s" + (oref loc root))) + ) + +(defmethod ede-locate-ok-in-project :static ((loc ede-locate-cscope) + root) + "Is it ok to use this project type under ROOT." + (cedet-cscope-version-check) + (when (cedet-cscope-support-for-directory root) + root)) + +(defmethod ede-locate-file-in-project-impl ((loc ede-locate-cscope) + filesubstring) + "Locate with LOC occurances of FILESUBSTRING under PROJECTROOT. +Searches are done under the current root of the EDE project +that crated this ede locat object." + (let ((default-directory (oref loc root))) + (cedet-cscope-expand-filename filesubstring))) + +(provide 'ede/locate) + +;; Local variables: +;; generated-autoload-file: "loaddefs.el" +;; generated-autoload-feature: ede/loaddefs +;; generated-autoload-load-name: "ede/locate" +;; End: + +;;; ede/locate.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/cedet/ede/make.el Sun Sep 20 15:06:05 2009 +0000 @@ -0,0 +1,110 @@ +;;; ede/make.el --- General information about "make" + +;;; Copyright (C) 2009 Free Software Foundation, Inc. + +;; Author: Eric M. Ludlam <eric@siege-engine.com> + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; This file needs to choose the version of "make" it wants to use. +;; Whenever an executable "gmake" is available, we prefer that since +;; it usually means GNU Make. If it doesn't exist, use "make". +;; +;; Run tests on make --version to be sure it is GNU make so that +;; logical error messages can be provided. + +;;; Code: + +(declare-function inversion-check-version "inversion") + +(if (fboundp 'locate-file) + (defsubst ede--find-executable (exec) + "Return an expanded file name for a program EXEC on the exec path." + (locate-file exec exec-path)) + + ;; Else, older version of Emacs. + + (defsubst ede--find-executable (exec) + "Return an expanded file name for a program EXEC on the exec path." + (let ((p exec-path) + (found nil)) + (while (and p (not found)) + (let ((f (expand-file-name exec (car p)))) + (if (file-exists-p f) + (setq found f))) + (setq p (cdr p))) + found)) + ) + +(defvar ede-make-min-version "3.0" + "Minimum version of GNU make required.") + +(defcustom ede-make-command (cond ((ede--find-executable "gmake") + "gmake") + (t "make")) ;; What to do? + "The MAKE command to use for EDE when compiling. +The makefile generated by EDE for C files uses syntax that depends on GNU Make, +so this should be set to something that can execute GNU Make files." + :group 'ede + :type 'string) + +;;;###autoload +(defun ede-make-check-version (&optional noerror) + "Check the version of GNU Make installed. +The check passes if the MAKE version is no high enough, or if it +is not GNU make. +If NOERROR is non-nil, return t for success, nil for failure. +If NOERROR is nil, then throw an error on failure. Return t otherwise." + (interactive) + (let ((b (get-buffer-create "*EDE Make Version*")) + (cd default-directory) + (rev nil) + (ans nil) + ) + (save-excursion + ;; Setup, and execute make. + (set-buffer b) + (setq default-directory cd) + (erase-buffer) + (call-process ede-make-command nil b nil + "--version") + ;; Check the buffer for the string + (goto-char (point-min)) + (when (looking-at "GNU Make\\(?: version\\)? \\([0-9][^,]+\\),") + (setq rev (match-string 1)) + (require 'inversion) + (setq ans (not (inversion-check-version rev nil ede-make-min-version)))) + + ;; Answer reporting. + (when (and (interactive-p) ans) + (message "GNU Make version %s. Good enough for CEDET." rev)) + + (when (and (not noerror) (not ans)) + (error "EDE requires GNU Make version %s or later. Configure `ede-make-command' to fix" + ede-make-min-version)) + ans))) + +(provide 'ede/make) + +;; Local variables: +;; generated-autoload-file: "loaddefs.el" +;; generated-autoload-feature: ede/loaddefs +;; generated-autoload-load-name: "ede/make" +;; End: + +;;; ede/make.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/cedet/ede/makefile-edit.el Sun Sep 20 15:06:05 2009 +0000 @@ -0,0 +1,129 @@ +;;; makefile-edit.el --- Makefile editing/scanning commands. + +;;; Copyright (C) 2009 Free Software Foundation, Inc. + +;; Author: Eric M. Ludlam <eric@siege-engine.com> + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; Utilities for editing a Makefile for EDE Makefile management commands. +;; +;; Derived from project-am.el. +;; +;; Makefile editing and scanning commands +;; +;; Formatting of a makefile +;; +;; 1) Creating an automakefile, stick in a top level comment about +;; being created by emacs +;; 2) Leave order of variable contents alone, except for SOURCE +;; SOURCE always keep in the order of .c, .h, the other stuff. + +;;; Things to do +;; makefile-fill-paragraph -- refill a macro w/ backslashes +;; makefile-insert-macro -- insert "foo = " + + +;;; Code: + +(defun makefile-beginning-of-command () + "Move the the beginning of the current command." + (interactive) + (if (save-excursion + (forward-line -1) + (makefile-line-continued-p)) + (forward-line -1)) + (beginning-of-line) + (if (not (makefile-line-continued-p)) + nil + (while (and (makefile-line-continued-p) + (not (bobp))) + (forward-line -1)) + (forward-line 1))) + +(defun makefile-end-of-command () + "Move the the beginning of the current command." + (interactive) + (end-of-line) + (while (and (makefile-line-continued-p) + (not (eobp))) + (forward-line 1) + (end-of-line))) + +(defun makefile-line-continued-p () + "Return non-nil if the current line ends in continuation." + (save-excursion + (end-of-line) + (= (preceding-char) ?\\))) + +;;; Programatic editing of a Makefile +;; +(defun makefile-move-to-macro (macro &optional next) + "Move to the definition of MACRO. Return t if found. +If NEXT is non-nil, move to the next occurance of MACRO." + (let ((oldpt (point))) + (when (not next) (goto-char (point-min))) + (if (re-search-forward (concat "^\\s-*" macro "\\s-*[+:?]?=") nil t) + t + (goto-char oldpt) + nil))) + +(defun makefile-navigate-macro (stop-before) + "In a list of files, move forward until STOP-BEFORE is reached. +STOP-BEFORE is a regular expression matching a file name." + (save-excursion + (makefile-beginning-of-command) + (let ((e (save-excursion + (makefile-end-of-command) + (point)))) + (if (re-search-forward stop-before nil t) + (goto-char (match-beginning 0)) + (goto-char e))))) + +(defun makefile-macro-file-list (macro) + "Return a list of all files in MACRO." + (save-excursion + (goto-char (point-min)) + (let ((lst nil)) + (while (makefile-move-to-macro macro t) + (let ((e (save-excursion + (makefile-end-of-command) + (point)))) + (while (re-search-forward "\\s-**\\([-a-zA-Z0-9./_@$%(){}]+\\)\\s-*" e t) + (let ((var nil)(varexp nil) + (match (buffer-substring-no-properties + (match-beginning 1) + (match-end 1)))) + (if (not (setq var (makefile-extract-varname-from-text match))) + (setq lst (cons match lst)) + (setq varexp (makefile-macro-file-list var)) + (dolist (V varexp) + (setq lst (cons V lst)))))))) + (nreverse lst)))) + +(defun makefile-extract-varname-from-text (text) + "Extract the variable name from TEXT if it is a variable reference. +Return nil if it isn't a variable." + (save-match-data + (when (string-match "\\$\\s(\\([A-Za-z0-9_]+\\)\\s)" text) + (match-string 1 text)))) + + +(provide 'ede/makefile-edit) + +;;; ede/makefile-edit.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/cedet/ede/pconf.el Sun Sep 20 15:06:05 2009 +0000 @@ -0,0 +1,188 @@ +;;; ede/pconf.el --- configure.ac maintenance for EDE + +;;; Copyright (C) 1998, 1999, 2000, 2005, 2008, 2009 +;;; Free Software Foundation, Inc. + +;; Author: Eric M. Ludlam <zappo@gnu.org> +;; Keywords: project + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; Code generator for autoconf configure.ac, and support files. + +(require 'ede/proj) +(require 'ede/autoconf-edit) +(defvar compilation-in-progress) + +(defvar ede-pconf-create-file-query 'ask + "Controls if queries are made while creating project files. +A value of 'ask means to always ask the user before creating +a file, such as AUTHORS. A value of 'never means don't ask, and +don't do it. A value of nil means to just do it.") + +;;; Code: +(defmethod ede-proj-configure-file ((this ede-proj-project)) + "The configure.ac script used by project THIS." + (ede-expand-filename (ede-toplevel this) "configure.ac" t)) + +(defmethod ede-proj-configure-test-required-file ((this ede-proj-project) file) + "For project THIS, test that the file FILE exists, or create it." + (when (not (ede-expand-filename (ede-toplevel this) file)) + (save-excursion + (find-file (ede-expand-filename (ede-toplevel this) file t)) + (cond ((string= file "AUTHORS") + (insert (user-full-name) " <" (user-login-name) ">")) + ((string= file "NEWS") + (insert "NEWS file for " (ede-name this))) + (t (insert "\n"))) + (save-buffer) + (when + (and (eq ede-pconf-create-file-query 'ask) + (not (eq ede-pconf-create-file-query 'never)) + (not (y-or-n-p + (format "I had to create the %s file for you. Ok? " file))) + (error "Quit")))))) + + +(defmethod ede-proj-configure-synchronize ((this ede-proj-project)) + "Synchronize what we know about project THIS into configure.ac." + (let ((b (find-file-noselect (ede-proj-configure-file this))) + ;;(td (file-name-directory (ede-proj-configure-file this))) + (targs (oref this targets)) + (postcmd "") + (add-missing nil)) + ;; First, make sure we have a file. + (if (not (file-exists-p (ede-proj-configure-file this))) + (autoconf-new-program b (oref this name) "Project.ede")) + (set-buffer b) + ;; Next, verify all targets of all subobjects. + (autoconf-set-version (oref this version)) + (let ((top-level-project-local this)) + (autoconf-set-output + (ede-map-all-subprojects + this + (lambda (sp) + ;; NOTE: don't put in ./Makefile - configure complains. + (let ((dir (file-name-as-directory + (directory-file-name + (ede-subproject-relative-path sp top-level-project-local))))) + (when (string= dir "./") (setq dir "")) + ;; Use concat, because expand-file-name removes the relativeness. + (concat dir "Makefile") ))))) + ;; + ;; NOTE TO SELF. TURN THIS INTO THE OFFICIAL LIST + ;; + (ede-proj-dist-makefile this) + ;; Loop over all targets to clean and then add themselves in. + (ede-map-all-subprojects + this + (lambda (sp) + (ede-map-targets sp 'ede-proj-flush-autoconf))) + (ede-map-all-subprojects + this + (lambda (sp) + (ede-map-targets this 'ede-proj-tweak-autoconf))) + ;; Now save + (save-buffer) + ;; Verify aclocal + (setq postcmd "aclocal;") + ;; Always add missing files as needed. + (setq postcmd (concat postcmd "automake --add-missing;")) + + ;; Always do autoreconf + (setq postcmd (concat postcmd "autoreconf;")) + ;; Verify a bunch of files that are required by automake. + (ede-proj-configure-test-required-file this "AUTHORS") + (ede-proj-configure-test-required-file this "NEWS") + (ede-proj-configure-test-required-file this "README") + (ede-proj-configure-test-required-file this "ChangeLog") + ;; Let specific targets get missing files. + (mapc 'ede-proj-configure-create-missing targs) + ;; Verify that we have a make system. + (if (or (not (ede-expand-filename (ede-toplevel this) "Makefile")) + ;; Now is this one of our old Makefiles? + (save-excursion + (set-buffer (find-file-noselect + (ede-expand-filename (ede-toplevel this) + "Makefile" t) t)) + (goto-char (point-min)) + ;; Here is the unique piece for our makefiles. + (re-search-forward "For use with: make" nil t))) + (setq postcmd (concat postcmd "./configure;"))) + (if (not (string= "" postcmd)) + (progn + (compile postcmd) + + (while compilation-in-progress + (accept-process-output) + (sit-for 1)) + + (save-excursion + (set-buffer "*compilation*") + (goto-char (point-max)) + + (when (not (string= mode-line-process ":exit [0]")) + (error "Configure failed!")) + + ;; The Makefile is now recreated by configure? + (let ((b (get-file-buffer + (ede-expand-filename (ede-toplevel this) + "Makefile" 'newfile)))) + ;; This makes sure that if Makefile was loaded, and old, + ;; that it gets flushed so we don't keep rebuilding + ;; the autoconf system. + (if b (kill-buffer b)))) + + )))) + +(defmethod ede-proj-configure-recreate ((this ede-proj-project)) + "Delete project THISes configure script and start over." + (if (not (ede-proj-configure-file this)) + (error "Could not determine configure.ac for %S" (object-name this))) + (let ((b (get-file-buffer (ede-proj-configure-file this)))) + ;; Destroy all evidence of the old configure.ac + (delete-file (ede-proj-configure-file this)) + (if b (kill-buffer b))) + (ede-proj-configure-synchronize this)) + +(defmethod ede-proj-tweak-autoconf ((this ede-proj-target)) + "Tweak the configure file (current buffer) to accomodate THIS." + ;; Check the compilers belonging to THIS, and call the autoconf + ;; setup for those compilers. + (mapc 'ede-proj-tweak-autoconf (ede-proj-compilers this)) + (mapc 'ede-proj-tweak-autoconf (ede-proj-linkers this)) + ) + +(defmethod ede-proj-flush-autoconf ((this ede-proj-target)) + "Flush the configure file (current buffer) to accomodate THIS. +By flushing, remove any cruft that may be in the file. Subsequent +calls to `ede-proj-tweak-autoconf' can restore items removed by flush." + nil) + +(defmethod ede-proj-configure-add-missing ((this ede-proj-target)) + "Query if any files needed by THIS provided by automake are missing. +Results in --add-missing being passed to automake." + nil) + +(defmethod ede-proj-configure-create-missing ((this ede-proj-target)) + "Add any missing files for THIS by creating them." + nil) + +(provide 'ede/pconf) + +;;; ede/pconf.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/cedet/ede/pmake.el Sun Sep 20 15:06:05 2009 +0000 @@ -0,0 +1,659 @@ +;;; ede-pmake.el --- EDE Generic Project Makefile code generator. + +;;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, +;;; 2007, 2008, 2009 Free Software Foundation, Inc. + +;; Author: Eric M. Ludlam <zappo@gnu.org> +;; Keywords: project, make + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; Code generator for Makefiles. +;; +;; Here is how it should work: +;; 1) Collect information about the project and targets +;; 2) Insert header into the Makefile +;; 3) Insert basic variables (target/source) +;; 4) Conditional +;; a) Makefile +;; 1) Insert support variables (compiler variables, etc) +;; 2) Insert VERSION and DISTDIR +;; 3) Specify top build dir if necessary +;; 4) Specify compile/link commands (c, etc) +;; 5) Specify dependency files +;; 6) Specify all: target +;; 7) Include dependency files +;; 8) Insert commonized target specify rules +;; 9) Insert clean: and dist: rules +;; b) Automake file +;; 1) Insert distribution source variables for targets +;; 2) Insert user requested rules + +(require 'ede/proj) +(require 'ede/proj-obj) +(require 'ede/proj-comp) + +;;; Code: +(defmethod ede-proj-makefile-create ((this ede-proj-project) mfilename) + "Create a Makefile for all Makefile targets in THIS. +MFILENAME is the makefile to generate." + (let ((mt nil) + (isdist (string= mfilename (ede-proj-dist-makefile this))) + (depth 0) + (orig-buffer nil) + (buff-to-kill nil) + ) + ;; Find out how deep this project is. + (let ((tmp this)) + (while (setq tmp (ede-parent-project tmp)) + (setq depth (1+ depth)))) + ;; Collect the targets that belong in a makefile. + (mapc + (lambda (obj) + (if (and (obj-of-class-p obj 'ede-proj-target-makefile) + (string= (oref obj makefile) mfilename)) + (setq mt (cons obj mt)))) + (oref this targets)) + ;; Fix the order so things compile in the right direction. + (setq mt (nreverse mt)) + ;; Add in the header part of the Makefile* + (save-excursion + (setq orig-buffer (get-file-buffer mfilename)) + (set-buffer (setq buff-to-kill (find-file-noselect mfilename))) + (goto-char (point-min)) + (if (and + (not (eobp)) + (not (looking-at "# Automatically Generated \\w+ by EDE."))) + (if (not (y-or-n-p (format "Really replace %s? " mfilename))) + (error "Not replacing Makefile")) + (message "Replace EDE Makefile")) + (erase-buffer) + (ede-srecode-setup) + ;; Insert a giant pile of stuff that is common between + ;; one of our Makefiles, and a Makefile.in + (ede-srecode-insert + "file:ede-empty" + "MAKETYPE" + (with-slots (makefile-type) this + (cond ((eq makefile-type 'Makefile) "make") + ((eq makefile-type 'Makefile.in) "autoconf") + ((eq makefile-type 'Makefile.am) "automake") + (t (error ":makefile-type in project invalid"))))) + + ;; Just this project's variables + (ede-proj-makefile-insert-variables this) + + ;; Space + (insert "\n") + + (cond + ((eq (oref this makefile-type) 'Makefile) + ;; Make sure the user has the right kind of make + (ede-make-check-version) + + (let* ((targ (if isdist (oref this targets) mt)) + (sp (oref this subproj)) + (df (apply 'append + (mapcar (lambda (tg) + (ede-proj-makefile-dependency-files tg)) + targ)))) + ;; Distribution variables + (ede-compiler-begin-unique + (mapc 'ede-proj-makefile-insert-variables targ)) + ;; Only add the distribution stuff in when depth != 0 + (let ((top (ede-toplevel this)) + (tmp this) + (subdir "")) + (insert "VERSION=" (oref top version) "\n" + "DISTDIR=$(top)" (oref top name) "-$(VERSION)") + (while (ede-parent-project tmp) + (setq subdir + (concat + "/" + (file-name-nondirectory + (directory-file-name + (file-name-directory (oref tmp file)))) + subdir) + tmp (ede-parent-project tmp))) + (insert subdir "\n")) + ;; Some built in variables for C code + (if df + (let ((tc depth)) + (insert "top_builddir = ") + (while (/= 0 tc) + (setq tc (1- tc)) + (insert "..") + (if (/= tc 0) (insert "/"))) + (insert "\n"))) + (insert "\n") + ;; Create a variable with all the dependency files to include + ;; These methods borrowed from automake. + (if (and (oref this automatic-dependencies) df) + (progn + (insert "DEP_FILES=" + (mapconcat (lambda (f) + (concat ".deps/" + (file-name-nondirectory + (file-name-sans-extension + f)) ".P")) + df " ")))) + ;; + ;; Insert ALL Rule + ;; + (insert "\n\nall:") + (mapc (lambda (c) + (if (and (slot-exists-p c 'partofall) (oref c partofall)) + ;; Only insert this rule if it is a part of ALL. + (insert " " (ede-proj-makefile-target-name c)))) + targ) + (mapc (lambda (c) + (insert " " (ede-name c)) + ) + sp) + (insert "\n\n") + ;; + ;; Add in the include files + ;; + (mapc (lambda (c) + (insert "include " c "\n\n")) + (oref this include-file)) + ;; Some C inference rules + ;; Dependency rules borrowed from automake. + ;; + ;; NOTE: This is GNU Make specific. + (if (and (oref this automatic-dependencies) df) + (insert "DEPS_MAGIC := $(shell mkdir .deps > /dev/null " + "2>&1 || :)\n" + "-include $(DEP_FILES)\n\n")) + ;; + ;; General makefile rules stored in the individual targets + ;; + (ede-compiler-begin-unique + (ede-proj-makefile-insert-rules this) + (mapc 'ede-proj-makefile-insert-rules targ)) + ;; + ;; phony targets for sub projects + ;; + (mapc 'ede-proj-makefile-insert-subproj-rules sp) + ;; + ;; Distribution rules such as CLEAN and DIST + ;; + (when isdist + (ede-proj-makefile-tags this mt) + (ede-proj-makefile-insert-dist-rules this))) + (save-buffer)) + ((eq (oref this makefile-type) 'Makefile.in) + (error "Makefile.in is not supported")) + ((eq (oref this makefile-type) 'Makefile.am) + (require 'ede-pconf) + ;; Distribution variables + (let ((targ (if isdist (oref this targets) mt))) + (ede-compiler-begin-unique + (mapc 'ede-proj-makefile-insert-automake-pre-variables targ)) + (ede-compiler-begin-unique + (mapc 'ede-proj-makefile-insert-source-variables targ)) + (ede-compiler-begin-unique + (mapc 'ede-proj-makefile-insert-automake-post-variables targ)) + (ede-compiler-begin-unique + (ede-proj-makefile-insert-user-rules this)) + (insert "\n# End of Makefile.am\n") + (save-buffer)) + ) + (t (error "Unknown makefile type when generating Makefile"))) + ;; Put the cursor in a nice place + (goto-char (point-min))) + ;; If we have an original buffer, then don't kill it. + (when (not orig-buffer) + (kill-buffer buff-to-kill)) + )) + +;;; VARIABLE insertion +;; +(defun ede-pmake-end-of-variable () + "Move to the end of the variable declaration under point." + (end-of-line) + (while (= (preceding-char) ?\\) + (forward-char 1) + (end-of-line)) + ) + +(defmacro ede-pmake-insert-variable-shared (varname &rest body) + "Add VARNAME into the current Makefile. +Execute BODY in a location where a value can be placed." + `(let ((addcr t) (v ,varname)) + (if (re-search-backward (concat "^" v "\\s-*=") nil t) + (progn + (ede-pmake-end-of-variable) + (if (< (current-column) 40) + (if (and (/= (preceding-char) ?=) + (/= (preceding-char) ? )) + (insert " ")) + (insert "\\\n ")) + (setq addcr nil)) + (insert v "=")) + ,@body + (if addcr (insert "\n")) + (goto-char (point-max)))) +(put 'ede-pmake-insert-variable-shared 'lisp-indent-function 1) + +;;; SOURCE VARIABLE NAME CONSTRUCTION + +(defsubst ede-pmake-varname (obj) + "Convert OBJ into a variable name name. +Change . to _ in the variable name." + (let ((name (oref obj name))) + (while (string-match "\\." name) + (setq name (replace-match "_" nil t name))) + name)) + +(defmethod ede-proj-makefile-sourcevar ((this ede-proj-target)) + "Return the variable name for THIS's sources." + (concat (ede-pmake-varname this) "_YOU_FOUND_A_BUG")) + +;;; DEPENDENCY FILE GENERATOR LISTS +;; +(defmethod ede-proj-makefile-dependency-files ((this ede-proj-target)) + "Return a list of source files to convert to dependencies. +Argument THIS is the target to get sources from." + nil) + +;;; GENERIC VARIABLES +;; +(defmethod ede-proj-makefile-configuration-variables ((this ede-proj-project) + configuration) + "Return a list of configuration variables from THIS. +Use CONFIGURATION as the current configuration to query." + (cdr (assoc configuration (oref this configuration-variables)))) + +(defmethod ede-proj-makefile-insert-variables-new ((this ede-proj-project)) + "Insert variables needed by target THIS. + +NOTE: Not yet in use! This is part of an SRecode conversion of + EDE that is in progress." +; (let ((conf-table (ede-proj-makefile-configuration-variables +; this (oref this configuration-default))) +; (conf-done nil)) +; +; (ede-srecode-insert-with-dictionary +; "declaration:ede-vars" +; +; ;; Insert all variables, and augment them with details from +; ;; the current configuration. +; (mapc (lambda (c) +; +; (let ((ldict (srecode-dictionary-add-section-dictionary +; dict "VARIABLE")) +; ) +; (srecode-dictionary-set-value ldict "NAME" (car c)) +; (if (assoc (car c) conf-table) +; (let ((vdict (srecode-dictionary-add-section-dictionary +; ldict "VALUE"))) +; (srecode-dictionary-set-value +; vdict "VAL" (cdr (assoc (car c) conf-table))) +; (setq conf-done (cons (car c) conf-done)))) +; (let ((vdict (srecode-dictionary-add-section-dictionary +; ldict "VALUE"))) +; (srecode-dictionary-set-value vdict "VAL" (cdr c)))) +; ) +; +; (oref this variables)) +; +; ;; Add in all variables from the configuration not allready covered. +; (mapc (lambda (c) +; +; (if (member (car c) conf-done) +; nil +; (let* ((ldict (srecode-dictionary-add-section-dictionary +; dict "VARIABLE")) +; (vdict (srecode-dictionary-add-section-dictionary +; ldict "VALUE")) +; ) +; (srecode-dictionary-set-value ldict "NAME" (car c)) +; (srecode-dictionary-set-value vdict "VAL" (cdr c)))) +; ) +; +; conf-table) +; + + ;; @TODO - finish off this function, and replace the below fcn + +; )) + ) + +(defmethod ede-proj-makefile-insert-variables ((this ede-proj-project)) + "Insert variables needed by target THIS." + (let ((conf-table (ede-proj-makefile-configuration-variables + this (oref this configuration-default))) + (conf-done nil)) + ;; Insert all variables, and augment them with details from + ;; the current configuration. + (mapc (lambda (c) + (insert (car c) "=") + (if (assoc (car c) conf-table) + (progn + (insert (cdr (assoc (car c) conf-table)) " ") + (setq conf-done (cons (car c) conf-done)))) + (insert (cdr c) "\n")) + (oref this variables)) + ;; Add in all variables from the configuration not allready covered. + (mapc (lambda (c) + (if (member (car c) conf-done) + nil + (insert (car c) "=" (cdr c) "\n"))) + conf-table)) + (let* ((top "") + (tmp this)) + (while (ede-parent-project tmp) + (setq tmp (ede-parent-project tmp) + top (concat "../" top))) + (insert "\ntop=" top)) + (insert "\nede_FILES=" (file-name-nondirectory (oref this file)) " " + (file-name-nondirectory (ede-proj-dist-makefile this)) "\n")) + +(defmethod ede-proj-makefile-insert-source-variables ((this ede-proj-target) + &optional + moresource) + "Insert the source variables needed by THIS. +Optional argument MORESOURCE is a list of additional sources to add to the +sources variable." + (let ((sv (ede-proj-makefile-sourcevar this))) + ;; This variable may be shared between targets + (ede-pmake-insert-variable-shared (cond ((listp sv) (car sv)) + (t sv)) + (insert (mapconcat (lambda (a) a) (oref this source) " ")) + (if moresource + (insert " \\\n " (mapconcat (lambda (a) a) moresource " ") ""))))) + +(defmethod ede-proj-makefile-insert-variables ((this ede-proj-target) &optional + moresource) + "Insert variables needed by target THIS. +Optional argument MORESOURCE is a list of additional sources to add to the +sources variable." + (ede-proj-makefile-insert-source-variables this moresource) + ) + +(defmethod ede-proj-makefile-configuration-variables ((this ede-proj-target-makefile) + configuration) + "Return a list of configuration variables from THIS. +Use CONFIGURATION as the current configuration to query." + (cdr (assoc configuration (oref this configuration-variables)))) + +(defmethod ede-proj-makefile-insert-variables ((this ede-proj-target-makefile) + &optional moresource) + "Insert variables needed by target THIS. +Optional argument MORESOURCE is a list of additional sources to add to the +sources variable." + (call-next-method) + (let* ((proj (ede-target-parent this)) + (conf-table (ede-proj-makefile-configuration-variables + this (oref proj configuration-default))) + (conf-done nil) + ) + ;; Add in all variables from the configuration not allready covered. + (mapc (lambda (c) + (if (member (car c) conf-done) + nil + (insert (car c) "=" (cdr c) "\n"))) + conf-table)) + (let ((comp (ede-proj-compilers this)) + (link (ede-proj-linkers this)) + (name (ede-proj-makefile-target-name this)) + (src (oref this source))) + (while comp + (ede-compiler-only-once (car comp) + (ede-proj-makefile-insert-object-variables (car comp) name src) + (ede-proj-makefile-insert-variables (car comp))) + (setq comp (cdr comp))) + (while link + (ede-linker-only-once (car link) + (ede-proj-makefile-insert-variables (car link))) + (setq link (cdr link))))) + +(defmethod ede-proj-makefile-insert-automake-pre-variables + ((this ede-proj-target)) + "Insert variables needed by target THIS in Makefile.am before SOURCES." + nil) + +(defmethod ede-proj-makefile-insert-automake-post-variables + ((this ede-proj-target)) + "Insert variables needed by target THIS in Makefile.am after SOURCES." + nil) + +;;; GARBAGE PATTERNS +;; +(defmethod ede-proj-makefile-garbage-patterns ((this ede-proj-project)) + "Return a list of patterns that are considered garbage to THIS. +These are removed with make clean." + (let ((mc (ede-map-targets + this (lambda (c) (ede-proj-makefile-garbage-patterns c)))) + (uniq nil)) + (setq mc (sort (apply 'append mc) 'string<)) + ;; Filter out duplicates from the targets. + (while mc + (if (and (car uniq) (string= (car uniq) (car mc))) + nil + (setq uniq (cons (car mc) uniq))) + (setq mc (cdr mc))) + (nreverse uniq))) + +(defmethod ede-proj-makefile-garbage-patterns ((this ede-proj-target)) + "Return a list of patterns that are considered garbage to THIS. +These are removed with make clean." + ;; Get the the source object from THIS, and use the specified garbage. + (let ((src (ede-target-sourcecode this)) + (garb nil)) + (while src + (setq garb (append (oref (car src) garbagepattern) garb) + src (cdr src))) + garb)) + + +;;; RULES +;; +(defmethod ede-proj-makefile-insert-subproj-rules ((this ede-proj-project)) + "Insert a rule for the project THIS which should be a subproject." + (insert ".PHONY:" (ede-name this)) + (newline) + (insert (ede-name this) ":") + (newline) + (insert "\t$(MAKE) -C " (directory-file-name (ede-subproject-relative-path this))) + (newline) + (newline) + ) + +(defmethod ede-proj-makefile-insert-rules ((this ede-proj-project)) + "Insert rules needed by THIS target." + (mapc 'ede-proj-makefile-insert-rules (oref this inference-rules)) + ) + +(defmethod ede-proj-makefile-insert-dist-dependencies ((this ede-proj-project)) + "Insert any symbols that the DIST rule should depend on. +Argument THIS is the project that should insert stuff." + (mapc 'ede-proj-makefile-insert-dist-dependencies (oref this targets)) + ) + +(defmethod ede-proj-makefile-insert-dist-dependencies ((this ede-proj-target)) + "Insert any symbols that the DIST rule should depend on. +Argument THIS is the target that should insert stuff." + nil) + +(defmethod ede-proj-makefile-insert-dist-filepatterns ((this ede-proj-target)) + "Insert any symbols that the DIST rule should depend on. +Argument THIS is the target that should insert stuff." + (ede-proj-makefile-insert-dist-dependencies this) + ) + +(defmethod ede-proj-makefile-insert-dist-rules ((this ede-proj-project)) + "Insert distribution rules for THIS in a Makefile, such as CLEAN and DIST." + (let ((junk (ede-proj-makefile-garbage-patterns this)) + tmp) + ;; Build CLEAN, DIST, TAG, and other rules here. + (if junk + (insert "\nclean:\n" + "\trm -f " + (mapconcat (lambda (c) c) junk " ") + "\n\n")) + ;; @TODO: ^^^ Clean should also recurse. ^^^ + + (insert ".PHONY: dist\n") + (insert "\ndist:") + (ede-proj-makefile-insert-dist-dependencies this) + (insert "\n") + (unless (or (ede-subproject-p this) + (oref this metasubproject)) + ;; Only delete if we are the toplevel project. + (insert "\trm -rf $(DISTDIR)\n")) + (insert "\tmkdir $(DISTDIR)\n") ;We may need a -p, but I think not. + (setq tmp (oref this targets)) + (insert "\tcp") + (while tmp + (let ((sv (ede-proj-makefile-sourcevar (car tmp)))) + (if (listp sv) + ;; Handle special case variables. + (cond ((eq (cdr sv) 'share) + ;; This variable may be shared between multiple targets. + (if (re-search-backward (concat "\\$(" (car sv) ")") + (save-excursion + (beginning-of-line) + (point)) + t) + ;; If its already in the dist target, then skip it. + nil + (setq sv (car sv)))) + (t (setq sv (car sv))))) + (if (stringp sv) + (insert " $(" sv ")")) + (ede-proj-makefile-insert-dist-filepatterns (car tmp)) + (setq tmp (cdr tmp)))) + (insert " $(ede_FILES) $(DISTDIR)\n") + + ;; Call our sub projects. + (ede-map-subprojects + this (lambda (sproj) + (let ((rp (directory-file-name (ede-subproject-relative-path sproj)))) + (insert "\t$(MAKE) -C " rp " $(MFLAGS) DISTDIR=$(DISTDIR)/" rp + " dist" + "\n")))) + + ;; Tar up the stuff. + (unless (or (ede-subproject-p this) + (oref this metasubproject)) + (insert "\ttar -cvzf $(DISTDIR).tar.gz $(DISTDIR)\n" + "\trm -rf $(DISTDIR)\n")) + + ;; Make sure the Makefile is ok. + (insert "\n" + (file-name-nondirectory (buffer-file-name)) ": " + (file-name-nondirectory (oref this file)) "\n" +;; "$(EMACS) -batch Project.ede -l ede -f ede-proj-regenerate" + "\t@echo Makefile is out of date! " + "It needs to be regenerated by EDE.\n" + "\t@echo If you have not modified Project.ede, you can" + " use 'touch' to update the Makefile time stamp.\n" + "\t@false\n\n" + "\n\n# End of Makefile\n"))) + +(defmethod ede-proj-makefile-insert-rules ((this ede-proj-target)) + "Insert rules needed by THIS target." + nil) + +(defmethod ede-proj-makefile-insert-rules ((this ede-proj-target-makefile)) + "Insert rules needed by THIS target." + (mapc 'ede-proj-makefile-insert-rules (oref this rules)) + (let ((c (ede-proj-compilers this))) + (when c + (mapc 'ede-proj-makefile-insert-rules c) + (if (oref this phony) + (insert ".PHONY: " (ede-proj-makefile-target-name this) "\n")) + (insert (ede-proj-makefile-target-name this) ": " + (ede-proj-makefile-dependencies this) "\n") + (ede-proj-makefile-insert-commands this) + ))) + +(defmethod ede-proj-makefile-insert-commands ((this ede-proj-target-makefile)) + "Insert the commands needed by target THIS. +For targets, insert the commands needed by the chosen compiler." + (mapc 'ede-proj-makefile-insert-commands (ede-proj-compilers this)) + (when (object-assoc t :uselinker (ede-proj-compilers this)) + (mapc 'ede-proj-makefile-insert-commands (ede-proj-linkers this)))) + + +(defmethod ede-proj-makefile-insert-user-rules ((this ede-proj-project)) + "Insert user specified rules needed by THIS target. +This is different from `ede-proj-makefile-insert-rules' in that this +function won't create the building rules which are auto created with +automake." + (mapc 'ede-proj-makefile-insert-user-rules (oref this inference-rules))) + +(defmethod ede-proj-makefile-insert-user-rules ((this ede-proj-target)) + "Insert user specified rules needed by THIS target." + (mapc 'ede-proj-makefile-insert-rules (oref this rules))) + +(defmethod ede-proj-makefile-dependencies ((this ede-proj-target-makefile)) + "Return a string representing the dependencies for THIS. +Some compilers only use the first element in the dependencies, others +have a list of intermediates (object files), and others don't care. +This allows customization of how these elements appear." + (let* ((c (ede-proj-compilers this)) + (io (ede-or (mapcar 'ede-compiler-intermediate-objects-p c))) + (out nil)) + (if io + (progn + (while c + (setq out + (concat out "$(" (ede-compiler-intermediate-object-variable + (car c) + (ede-proj-makefile-target-name this)) ")") + c (cdr c))) + out) + (let ((sv (ede-proj-makefile-sourcevar this)) + (aux (oref this auxsource))) + (setq out + (if (and (stringp sv) (not (string= sv ""))) + (concat "$(" sv ")") + "")) + (while aux + (setq out (concat out " " (car aux))) + (setq aux (cdr aux))) + out)))) + +;; Tags +(defmethod ede-proj-makefile-tags ((this ede-proj-project) targets) + "Insert into the current location rules to make recursive TAGS files. +Argument THIS is the project to create tags for. +Argument TARGETS are the targets we should depend on for TAGS." + (insert "tags: ") + (let ((tg targets)) + ;; Loop over all source variables and insert them + (while tg + (insert "$(" (ede-proj-makefile-sourcevar (car tg)) ") ") + (setq tg (cdr tg))) + (insert "\n") + (if targets + (insert "\tetags $^\n")) + ;; Now recurse into all subprojects + (setq tg (oref this subproj)) + (while tg + (insert "\t$(MAKE) -C " (ede-subproject-relative-path (car tg)) " $(MFLAGS) $@\n") + (setq tg (cdr tg))) + (insert "\n"))) + + +(provide 'ede/pmake) + +;;; ede/pmake.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/cedet/ede/proj-archive.el Sun Sep 20 15:06:05 2009 +0000 @@ -0,0 +1,64 @@ +;;; ede/proj-archive.el --- EDE Generic Project archive support + +;;; Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation, Inc. + +;; Author: Eric M. Ludlam <zappo@gnu.org> +;; Keywords: project, make + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; Handle object code archives in and EDE Project file. + +(require 'ede/pmake) +(require 'ede/proj-obj) + +;;; Code: + +(defclass ede-proj-target-makefile-archive + (ede-proj-target-makefile-objectcode) + ((availablelinkers :initform (ede-archive-linker))) + "This target generates an object code archive.") + +(defvar ede-archive-linker + (ede-linker + "ede-archive-linker" + :name "ar" + :variables '(("AR" . "ar") + ("AR_CMD" . "$(AR) cr")) + :commands '("$(AR_CMD) lib$@.a $^") + :autoconf '(("AC_CHECK_PROGS" . "RANLIB, ranlib")) + :objectextention "") + "Linker object for creating an archive.") + +(defmethod ede-proj-makefile-insert-source-variables :BEFORE + ((this ede-proj-target-makefile-archive) &optional moresource) + "Insert bin_PROGRAMS variables needed by target THIS. +We aren't acutally inserting SOURCE details, but this is used by the +Makefile.am generator, so use it to add this important bin program." + (ede-pmake-insert-variable-shared + (concat "lib" (ede-name this) "_a_LIBRARIES") + (insert (concat "lib" (ede-name this) ".a")))) + +(defmethod ede-proj-makefile-garbage-patterns + ((this ede-proj-target-makefile-archive)) + "Add archive name to the garbage patterns. +This makes sure that the archive is removed with 'make clean'." + (let ((garb (call-next-method))) + (append garb (list (concat "lib" (ede-name this) ".a"))))) + +(provide 'ede/proj-archive) + +;;; ede/proj-archive.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/cedet/ede/proj-aux.el Sun Sep 20 15:06:05 2009 +0000 @@ -0,0 +1,47 @@ +;;; ede/proj-aux.el --- EDE Generic Project auxilliary file support + +;;; Copyright (C) 1998, 1999, 2000, 2007 Free Software Foundation, Inc. + +;; Author: Eric M. Ludlam <zappo@gnu.org> +;; Keywords: project, make + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; Handle auxiliary files (README, FAQ, etc) in and EDE Project file. + +(require 'ede/proj) +(require 'ede/pmake) + +;;; Code: +(defclass ede-proj-target-aux (ede-proj-target) + ((sourcetype :initform (ede-aux-source))) + "This target consists of aux files such as READMEs and COPYING.") + +(defvar ede-aux-source + (ede-sourcecode "ede-aux-source-txt" + :name "Auxiliary Text" + :sourcepattern "^[A-Z]+$\\|\\.txt$") + "Miscelaneous fields definition.") + +(defmethod ede-proj-makefile-sourcevar ((this ede-proj-target-aux)) + "Return the variable name for THIS's sources." + (concat (ede-pmake-varname this) "_AUX")) + +(provide 'ede/proj-aux) + +;;; ede/proj-aux.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/cedet/ede/proj-comp.el Sun Sep 20 15:06:05 2009 +0000 @@ -0,0 +1,346 @@ +;;; ede-proj-comp.el --- EDE Generic Project compiler/rule driver + +;;; Copyright (C) 1999, 2000, 2001, 2004, 2005, 2007, 2009 +;;; Free Software Foundation, Inc. + +;; Author: Eric M. Ludlam <zappo@gnu.org> +;; Keywords: project, make + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; This software handles the maintenance of compiler and rule definitions +;; for different object types. +;; +;; The `ede-compiler' class lets different types of project objects create +;; definitions of compilers that can be swapped in and out for compiling +;; source code. Users can also define new compiler types whenever they +;; some customized behavior. +;; +;; The `ede-makefile-rule' class lets users add customized rules into thier +;; objects, and also lets different compilers add chaining rules to their +;; behaviors. +;; +;; It is important that all new compiler types be registered once. That +;; way the chaining rules and variables are inserted into any given Makefile +;; only once. +;; +;; To insert many compiler elements, wrap them in `ede-compiler-begin-unique' +;; before calling their insert methods. +;; To write a method that inserts a variable or rule for a compiler +;; based object, wrap the body of your call in `ede-compiler-only-once' + +(require 'ede) ;source object +(require 'ede/autoconf-edit) + +;;; Types: +(defclass ede-compilation-program (eieio-instance-inheritor) + ((name :initarg :name + :type string + :custom string + :documentation "Name of this type of compiler.") + (variables :initarg :variables + :type list + :custom (repeat (cons (string :tag "Variable") + (string :tag "Value"))) + :documentation + "Variables needed in the Makefile for this compiler. +An assoc list where each element is (VARNAME . VALUE) where VARNAME +is a string, and VALUE is either a string, or a list of strings. +For example, GCC would define CC=gcc, and emacs would define EMACS=emacs.") + (sourcetype :initarg :sourcetype + :type list ;; of symbols + :documentation + "A list of `ede-sourcecode' objects this class will handle. +This is used to match target objects with the compilers and linkers +they can use, and which files this object is interested in." + :accessor ede-object-sourcecode) + (rules :initarg :rules + :initform nil + :type list + :custom (repeat (object :objecttype ede-makefile-rule)) + :documentation + "Auxiliary rules needed for this compiler to run. +For example, yacc/lex files need additional chain rules, or inferences.") + (commands :initarg :commands + :type list + :custom (repeat string) + :documentation + "The commands used to execute this compiler. +The object which uses this compiler will place these commands after +it's rule definition.") + (autoconf :initarg :autoconf + :initform nil + :type list + :custom (repeat string) + :documentation + "Autoconf function to call if this type of compiler is used. +When a project is in Automake mode, this defines the autoconf function to +call to initialize automake to use this compiler. +For example, there may be multiple C compilers, but they all probably +use the same autoconf form.") + (objectextention :initarg :objectextention + :type string + :documentation + "A string which is the extention used for object files. +For example, C code uses .o on unix, and Emacs Lisp uses .elc.") + ) + "A program used to compile or link a program via a Makefile. +Contains everything needed to output code into a Makefile, or autoconf +file.") + +(defclass ede-compiler (ede-compilation-program) + ((makedepends :initarg :makedepends + :initform nil + :type boolean + :documentation + "Non-nil if this compiler can make dependencies.") + (uselinker :initarg :uselinker + :initform nil + :type boolean + :documentation + "Non-nil if this compiler creates code that can be linked. +This requires that the containing target also define a list of available +linkers that can be used.") + ) + "Definition for a compiler. +Different types of objects will provide different compilers for +different situations.") + +(defclass ede-linker (ede-compilation-program) + () + "Contains information needed to link many generated object files together.") + +(defclass ede-makefile-rule () + ((target :initarg :target + :initform "" + :type string + :custom string + :documentation "The target pattern. +A pattern of \"%.o\" is used for inference rules, and would match object files. +A target of \"foo.o\" explicitly matches the file foo.o.") + (dependencies :initarg :dependencies + :initform "" + :type string + :custom string + :documentation "Dependencies on this target. +A pattern of \"%.o\" would match a file of the same prefix as the target +if that target is also an inference rule pattern. +A dependency of \"foo.c\" explicitly lists foo.c as a dependency. +A variable such as $(name_SOURCES) will list all the source files +belonging to the target name.") + (rules :initarg :rules + :initform nil + :type list + :custom (repeat string) + :documentation "Scripts to execute. +These scripst will be executed in sh (Unless the SHELL variable is overriden). +Do not prefix with TAB. +Each individual element of this list can be either a string, or +a lambda function. (The custom element does not yet express that.") + (phony :initarg :phony + :initform nil + :type boolean + :custom boolean + :documentation "Is this a phony rule? +Adds this rule to a .PHONY list.")) + "A single rule for building some target.") + +;;; Code: +(defvar ede-compiler-list nil + "The master list of all EDE compilers.") + +(defvar ede-linker-list nil + "The master list of all EDE compilers.") + +(defvar ede-current-build-list nil + "List of EDE compilers that have already inserted parts of themselves. +This is used when creating a Makefile to prevend duplicate variables and +rules from being created.") + +(defmethod initialize-instance :AFTER ((this ede-compiler) &rest fields) + "Make sure that all ede compiler objects are cached in +`ede-compiler-list'." + (add-to-list 'ede-compiler-list this)) + +(defmethod initialize-instance :AFTER ((this ede-linker) &rest fields) + "Make sure that all ede compiler objects are cached in +`ede-linker-list'." + (add-to-list 'ede-linker-list this)) + +(defmacro ede-compiler-begin-unique (&rest body) + "Execute BODY, making sure that `ede-current-build-list' is maintained. +This will prevent rules from creating duplicate variables or rules." + `(let ((ede-current-build-list nil)) + ,@body)) + +(defmacro ede-compiler-only-once (object &rest body) + "Using OBJECT, execute BODY only once per Makefile generation." + `(if (not (member ,object ede-current-build-list)) + (progn + (add-to-list 'ede-current-build-list ,object) + ,@body))) + +(defmacro ede-linker-begin-unique (&rest body) + "Execute BODY, making sure that `ede-current-build-list' is maintained. +This will prevent rules from creating duplicate variables or rules." + `(let ((ede-current-build-list nil)) + ,@body)) + +(defmacro ede-linker-only-once (object &rest body) + "Using OBJECT, execute BODY only once per Makefile generation." + `(if (not (member ,object ede-current-build-list)) + (progn + (add-to-list 'ede-current-build-list ,object) + ,@body))) + +(add-hook 'edebug-setup-hook + (lambda () + (def-edebug-spec ede-compiler-begin-unique def-body) + (def-edebug-spec ede-compiler-only-once (form def-body)) + (def-edebug-spec ede-linker-begin-unique def-body) + (def-edebug-spec ede-linker-only-once (form def-body)) + (def-edebug-spec ede-pmake-insert-variable-shared (form def-body)) + )) + +;;; Querys +(defun ede-proj-find-compiler (compilers sourcetype) + "Return a compiler from the list COMPILERS that will compile SOURCETYPE." + (while (and compilers + (not (member sourcetype (oref (car compilers) sourcetype)))) + (setq compilers (cdr compilers))) + (car-safe compilers)) + +(defun ede-proj-find-linker (linkers sourcetype) + "Return a compiler from the list LINKERS to be used with SOURCETYPE." + (while (and linkers + (slot-boundp (car linkers) 'sourcetype) + (not (member sourcetype (oref (car linkers) sourcetype)))) + (setq linkers (cdr linkers))) + (car-safe linkers)) + +;;; Methods: +(defmethod ede-proj-tweak-autoconf ((this ede-compilation-program)) + "Tweak the configure file (current buffer) to accomodate THIS." + (mapcar + (lambda (obj) + (cond ((stringp obj) + (autoconf-insert-new-macro obj)) + ((consp obj) + (autoconf-insert-new-macro (car obj) (cdr obj))) + (t (error "Autoconf directives must be a string, or cons cell"))) + ) + (oref this autoconf))) + +(defmethod ede-proj-flush-autoconf ((this ede-compilation-program)) + "Flush the configure file (current buffer) to accomodate THIS." + nil) + +(defmethod ede-proj-makefile-insert-variables ((this ede-compilation-program)) + "Insert variables needed by the compiler THIS." + (if (eieio-instance-inheritor-slot-boundp this 'variables) + (with-slots (variables) this + (mapcar + (lambda (var) + (insert (car var) "=") + (let ((cd (cdr var))) + (if (listp cd) + (mapc (lambda (c) (insert " " c)) cd) + (insert cd))) + (insert "\n")) + variables)))) + +(defmethod ede-compiler-intermediate-objects-p ((this ede-compiler)) + "Return non-nil if THIS has intermediate object files. +If this compiler creates code that can be linked together, +then the object files created by the compiler are considered intermediate." + (oref this uselinker)) + +(defmethod ede-compiler-intermediate-object-variable ((this ede-compiler) + targetname) + "Return a string based on THIS representing a make object variable. +TARGETNAME is the name of the target that these objects belong to." + (concat targetname "_OBJ")) + +(defmethod ede-proj-makefile-insert-object-variables ((this ede-compiler) + targetname sourcefiles) + "Insert an OBJ variable to specify object code to be generated for THIS. +The name of the target is TARGETNAME as a string. SOURCEFILES is the list of +files to be objectified. +Not all compilers do this." + (if (ede-compiler-intermediate-objects-p this) + (progn + (insert (ede-compiler-intermediate-object-variable this targetname) + "=") + (let ((src (oref this sourcetype))) + (mapc (lambda (s) + (let ((ts src)) + (while (and ts (not (ede-want-file-source-p + (symbol-value (car ts)) s))) + (setq ts (cdr ts))) + ;; Only insert the object if the given file is a major + ;; source-code type. + (if ts;; a match as a source file. + (insert " " (file-name-sans-extension s) + (oref this objectextention))))) + sourcefiles) + (insert "\n"))))) + +(defmethod ede-proj-makefile-insert-rules ((this ede-compilation-program)) + "Insert rules needed for THIS compiler object." + (ede-compiler-only-once this + (mapc 'ede-proj-makefile-insert-rules (oref this rules)))) + +(defmethod ede-proj-makefile-insert-rules ((this ede-makefile-rule)) + "Insert rules needed for THIS rule object." + (if (oref this phony) (insert ".PHONY: (oref this target)\n")) + (insert (oref this target) ": " (oref this dependencies) "\n\t" + (mapconcat (lambda (c) c) (oref this rules) "\n\t") + "\n\n")) + +(defmethod ede-proj-makefile-insert-commands ((this ede-compilation-program)) + "Insert the commands needed to use compiler THIS. +The object creating makefile rules must call this method for the +compiler it decides to use after inserting in the rule." + (when (slot-boundp this 'commands) + (with-slots (commands) this + (mapc + (lambda (obj) (insert "\t" + (cond ((stringp obj) + obj) + ((and (listp obj) + (eq (car obj) 'lambda)) + (funcall obj)) + (t + (format "%S" obj))) + "\n")) + commands)) + (insert "\n"))) + +;;; Some details about our new macro +;; +(add-hook 'edebug-setup-hook + (lambda () + (def-edebug-spec ede-compiler-begin-unique def-body))) +(put 'ede-compiler-begin-unique 'lisp-indent-function 0) +(put 'ede-compiler-only-once 'lisp-indent-function 1) +(put 'ede-linker-begin-unique 'lisp-indent-function 0) +(put 'ede-linker-only-once 'lisp-indent-function 1) + +(provide 'ede/proj-comp) + +;;; ede/proj-comp.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/cedet/ede/proj-elisp.el Sun Sep 20 15:06:05 2009 +0000 @@ -0,0 +1,393 @@ +;;; ede-proj-elisp.el --- EDE Generic Project Emacs Lisp support + +;;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, +;;; 2007, 2008, 2009 Free Software Foundation, Inc. + +;; Author: Eric M. Ludlam <zappo@gnu.org> +;; Keywords: project, make + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; Handle Emacs Lisp in and EDE Project file. + +(require 'ede/proj) +(require 'ede/pmake) +(require 'ede/pconf) + +;;; Code: +(defclass ede-proj-target-elisp (ede-proj-target-makefile) + ((menu :initform nil) + (keybindings :initform nil) + (phony :initform t) + (sourcetype :initform (ede-source-emacs)) + (availablecompilers :initform (ede-emacs-compiler ede-xemacs-compiler)) + (aux-packages :initarg :aux-packages + :initform nil + :type list + :custom (repeat string) + :documentation "Additional packages needed. +There should only be one toplevel package per auxiliary tool needed. +These packages location is found, and added to the compile time +load path." + )) + "This target consists of a group of lisp files. +A lisp target may be one general program with many separate lisp files in it.") + +(defvar ede-source-emacs + (ede-sourcecode "ede-emacs-source" + :name "Emacs Lisp" + :sourcepattern "\\.el$" + :garbagepattern '("*.elc")) + "Emacs Lisp source code definition.") + +(defvar ede-emacs-compiler + (ede-compiler + "ede-emacs-compiler" + :name "emacs" + :variables '(("EMACS" . "emacs") + ("EMACSFLAGS" . "-batch --no-site-file")) + :commands + '("@echo \"(add-to-list 'load-path nil)\" > $@-compile-script" + "for loadpath in . ${LOADPATH}; do \\" + " echo \"(add-to-list 'load-path \\\"$$loadpath\\\")\" >> $@-compile-script; \\" + "done;" + "@echo \"(setq debug-on-error t)\" >> $@-compile-script" + "\"$(EMACS)\" $(EMACSFLAGS) -l $@-compile-script -f batch-byte-compile $^" + ) + :autoconf '("AM_PATH_LISPDIR") + :sourcetype '(ede-source-emacs) +; :objectextention ".elc" + ) + "Compile Emacs Lisp programs.") + +(defvar ede-xemacs-compiler + (clone ede-emacs-compiler "ede-xemacs-compiler" + :name "xemacs" + :variables '(("EMACS" . "xemacs"))) + "Compile Emacs Lisp programs with XEmacs.") + +;;; Claiming files +(defmethod ede-buffer-mine ((this ede-proj-target-elisp) buffer) + "Return t if object THIS lays claim to the file in BUFFER. +Lays claim to all .elc files that match .el files in this target." + (if (string-match "\\.elc$" (buffer-file-name buffer)) + (let ((fname + (concat + (file-name-sans-extension (buffer-file-name buffer)) + ".el") + )) + ;; Is this in our list. + (member fname (oref this auxsource)) + ) + (call-next-method) ; The usual thing. + )) + +;;; Emacs Lisp Compiler +;;; Emacs Lisp Target +(defun ede-proj-elisp-packages-to-loadpath (packages) + "Convert a list of PACKAGES, to a list of load path." + (let ((paths nil) + (ldir nil)) + (while packages + (or (setq ldir (locate-library (car packages))) + (error "Cannot find package %s" (car packages))) + (let* ((fnd (file-name-directory ldir)) + (rel (file-relative-name fnd)) + (full nil) + ) + ;; Make sure the relative name isn't to far off + (when (string-match "^\\.\\./\\.\\./\\.\\./\\.\\." rel) + (setq full fnd)) + ;; Do the setup. + (setq paths (cons (or full rel) paths) + packages (cdr packages)))) + paths)) + +(defmethod project-compile-target ((obj ede-proj-target-elisp)) + "Compile all sources in a Lisp target OBJ. +Bonus: Return a cons cell: (COMPILED . UPTODATE)." + (let* ((proj (ede-target-parent obj)) + (dir (oref proj directory)) + (comp 0) + (utd 0)) + (mapc (lambda (src) + (let* ((fsrc (expand-file-name src dir)) + (elc (concat (file-name-sans-extension fsrc) ".elc")) + ) + (if (or (not (file-exists-p elc)) + (file-newer-than-file-p fsrc elc)) + (progn + (setq comp (1+ comp)) + (byte-compile-file fsrc)) + (setq utd (1+ utd))))) + (oref obj source)) + (message "All Emacs Lisp sources are up to date in %s" (object-name obj)) + (cons comp utd) + )) + +(defmethod ede-update-version-in-source ((this ede-proj-target-elisp) version) + "In a Lisp file, updated a version string for THIS to VERSION. +There are standards in Elisp files specifying how the version string +is found, such as a `-version' variable, or the standard header." + (if (and (slot-boundp this 'versionsource) + (oref this versionsource)) + (let ((vs (oref this versionsource)) + (match nil)) + (while vs + (save-excursion + (set-buffer (find-file-noselect + (ede-expand-filename this (car vs)))) + (goto-char (point-min)) + (let ((case-fold-search t)) + (if (re-search-forward "-version\\s-+\"\\([^\"]+\\)\"" nil t) + (progn + (setq match t) + (delete-region (match-beginning 1) + (match-end 1)) + (goto-char (match-beginning 1)) + (insert version))))) + (setq vs (cdr vs))) + (if (not match) (call-next-method))))) + + +;;; Makefile generation functions +;; +(defmethod ede-proj-makefile-sourcevar ((this ede-proj-target-elisp)) + "Return the variable name for THIS's sources." + (cond ((ede-proj-automake-p) '("lisp_LISP" . share)) + (t (concat (ede-pmake-varname this) "_LISP")))) + +(defun ede-proj-makefile-insert-loadpath-items (items) + "Insert a sequence of ITEMS into the Makefile LOADPATH variable." + (when items + (ede-pmake-insert-variable-shared "LOADPATH" + (let ((begin (save-excursion (re-search-backward "\\s-*=")))) + (while items + (when (not (save-excursion + (re-search-backward + (concat "\\s-" (regexp-quote (car items)) "[ \n\t\\]") + begin t))) + (insert " " (car items))) + (setq items (cdr items))))) + )) + +(defmethod ede-proj-makefile-insert-variables :AFTER ((this ede-proj-target-elisp)) + "Insert variables needed by target THIS." + (let ((newitems (if (oref this aux-packages) + (ede-proj-elisp-packages-to-loadpath + (oref this aux-packages)))) + ) + (ede-proj-makefile-insert-loadpath-items newitems))) + +(defun ede-proj-elisp-add-path (path) + "Add path PATH into the file if it isn't already there." + (goto-char (point-min)) + (if (re-search-forward (concat "(cons \\\"" + (regexp-quote path)) + nil t) + nil;; We have it already + (if (re-search-forward "(cons nil" nil t) + (progn + ;; insert stuff here + (end-of-line) + (insert "\n" + " echo \"(setq load-path (cons \\\"" + path + "\\\" load-path))\" >> script") + ) + (error "Don't know how to update load path")))) + +(defmethod ede-proj-tweak-autoconf ((this ede-proj-target-elisp)) + "Tweak the configure file (current buffer) to accomodate THIS." + (call-next-method) + ;; Ok, now we have to tweak the autoconf provided `elisp-comp' program. + (let ((ec (ede-expand-filename this "elisp-comp" 'newfile))) + (if (or (not ec) (not (file-exists-p ec))) + (message "No elisp-comp file. There may be compile errors? Rerun a second time.") + (save-excursion + (if (file-symlink-p ec) + (progn + ;; Desymlinkafy + (rename-file ec (concat ec ".tmp")) + (copy-file (concat ec ".tmp") ec) + (delete-file (concat ec ".tmp")))) + (set-buffer (find-file-noselect ec t)) + (ede-proj-elisp-add-path "..") + (let ((paths (ede-proj-elisp-packages-to-loadpath + (oref this aux-packages)))) + ;; Add in the current list of paths + (while paths + (ede-proj-elisp-add-path (car paths)) + (setq paths (cdr paths)))) + (save-buffer)) ))) + +(defmethod ede-proj-flush-autoconf ((this ede-proj-target-elisp)) + "Flush the configure file (current buffer) to accomodate THIS." + ;; Remove crufty old paths from elisp-compile + (let ((ec (ede-expand-filename this "elisp-comp" 'newfile)) + ) + (if (and ec (file-exists-p ec)) + (save-excursion + (set-buffer (find-file-noselect ec t)) + (goto-char (point-min)) + (while (re-search-forward "(cons \\([^ ]+\\) load-path)" + nil t) + (let ((path (match-string 1))) + (if (string= path "nil") + nil + (delete-region (save-excursion (beginning-of-line) (point)) + (save-excursion (end-of-line) + (forward-char 1) + (point)))))))))) + +;;; +;; Autoload generators +;; +(defclass ede-proj-target-elisp-autoloads (ede-proj-target-elisp) + ((availablecompilers :initform (ede-emacs-cedet-autogen-compiler)) + (aux-packages :initform ("cedet-autogen")) + (phony :initform t) + (autoload-file :initarg :autoload-file + :initform "loaddefs.el" + :type string + :custom string + :documentation "The file that autoload definitions are placed in. +There should be one load defs file for a given package. The load defs are created +for all Emacs Lisp sources that exist in the directory of the created target.") + (autoload-dirs :initarg :autoload-dirs + :initform nil + :type list + :custom (repeat string) + :documentation "The directories to scan for autoload definitions. +If nil defaults to the current directory.") + ) + "Target that builds an autoload file. +Files do not need to be added to this target.") + + +;;; Claiming files +(defmethod ede-buffer-mine ((this ede-proj-target-elisp-autoloads) buffer) + "Return t if object THIS lays claim to the file in BUFFER. +Lays claim to all .elc files that match .el files in this target." + (if (string-match + (concat (regexp-quote (oref this autoload-file)) "$") + (buffer-file-name buffer)) + t + (call-next-method) ; The usual thing. + )) + +;; Compilers +(defvar ede-emacs-cedet-autogen-compiler + (ede-compiler + "ede-emacs-autogen-compiler" + :name "emacs" + :variables '(("EMACS" . "emacs")) + :commands + '("@echo \"(add-to-list 'load-path nil)\" > $@-compile-script" + "for loadpath in . ${LOADPATH}; do \\" + " echo \"(add-to-list 'load-path \\\"$$loadpath\\\")\" >> $@-compile-script; \\" + "done;" + "@echo \"(require 'cedet-autogen)\" >> $@-compile-script" + "\"$(EMACS)\" -batch --no-site-file -l $@-compile-script -f cedet-batch-update-autoloads $(LOADDEFS) $(LOADDIRS)" + ) + :sourcetype '(ede-source-emacs) + ) + "Build an autoloads file.") + +(defmethod ede-proj-compilers ((obj ede-proj-target-elisp-autoloads)) + "List of compilers being used by OBJ. +If the `compiler' slot is empty, get the car of the compilers list." + (let ((comp (oref obj compiler))) + (if comp + (if (listp comp) + (setq comp (mapcar 'symbol-value comp)) + (setq comp (list (symbol-value comp)))) + ;; Get the first element from our list of compilers. + (let ((avail (mapcar 'symbol-value (oref obj availablecompilers)))) + (setq comp (list (car avail))))) + comp)) + +(defmethod ede-proj-makefile-insert-source-variables ((this ede-proj-target-elisp-autoloads) + &optional + moresource) + "Insert the source variables needed by THIS. +Optional argument MORESOURCE is a list of additional sources to add to the +sources variable." + nil) + +(defmethod ede-proj-makefile-sourcevar ((this ede-proj-target-elisp-autoloads)) + "Return the variable name for THIS's sources." + nil) ; "LOADDEFS") + +(defmethod ede-proj-makefile-dependencies ((this ede-proj-target-elisp-autoloads)) + "Return a string representing the dependencies for THIS. +Always return an empty string for an autoloads generator." + "") + +(defmethod ede-proj-makefile-insert-variables :AFTER ((this ede-proj-target-elisp-autoloads)) + "Insert variables needed by target THIS." + (ede-pmake-insert-variable-shared "LOADDEFS" + (insert (oref this autoload-file))) + (ede-pmake-insert-variable-shared "LOADDIRS" + (insert (mapconcat 'identity + (or (oref this autoload-dirs) '(".")) + " "))) + ) + +(defmethod project-compile-target ((obj ede-proj-target-elisp-autoloads)) + "Create or update the autoload target." + (require 'cedet-autogen) + (let ((default-directory (ede-expand-filename obj "."))) + (apply 'cedet-update-autoloads + (oref obj autoload-file) + (oref obj autoload-dirs)) + )) + +(defmethod ede-update-version-in-source ((this ede-proj-target-elisp-autoloads) version) + "In a Lisp file, updated a version string for THIS to VERSION. +There are standards in Elisp files specifying how the version string +is found, such as a `-version' variable, or the standard header." + nil) + +(defmethod ede-proj-makefile-insert-dist-dependencies ((this ede-proj-target-elisp-autoloads)) + "Insert any symbols that the DIST rule should depend on. +Emacs Lisp autoload files ship the generated .el files. +Argument THIS is the target which needs to insert an info file." + ;; In some cases, this is ONLY the index file. That should generally + ;; be ok. + (insert " " (ede-proj-makefile-target-name this)) + ) + +(defmethod ede-proj-makefile-insert-dist-filepatterns ((this ede-proj-target-elisp-autoloads)) + "Insert any symbols that the DIST rule should distribute. +Emacs Lisp autoload files ship the generated .el files. +Argument THIS is the target which needs to insert an info file." + (insert " " (oref this autoload-file)) + ) + +(defmethod ede-proj-tweak-autoconf ((this ede-proj-target-elisp-autoloads)) + "Tweak the configure file (current buffer) to accomodate THIS." + (error "Autoloads not supported in autoconf yet.")) + +(defmethod ede-proj-flush-autoconf ((this ede-proj-target-elisp-autoloads)) + "Flush the configure file (current buffer) to accomodate THIS." + nil) + +(provide 'ede/proj-elisp) + +;;; ede/proj-elisp.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/cedet/ede/proj-info.el Sun Sep 20 15:06:05 2009 +0000 @@ -0,0 +1,186 @@ +;;; ede-proj-info.el --- EDE Generic Project texinfo support + +;;; Copyright (C) 1998, 1999, 2000, 2001, 2004, 2007, 2008, 2009 +;;; Free Software Foundation, Inc. + +;; Author: Eric M. Ludlam <zappo@gnu.org> +;; Keywords: project, make + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; Handle texinfo in and EDE Project file. + +(require 'ede/pmake) + +;;; Code: +(defclass ede-proj-target-makefile-info (ede-proj-target-makefile) + ((menu :initform nil) + (keybindings :initform nil) + (availablecompilers :initform (ede-makeinfo-compiler + ede-texi2html-compiler)) + (sourcetype :initform (ede-makeinfo-source)) + (mainmenu :initarg :mainmenu + :initform "" + :type string + :custom string + :documentation "The main menu resides in this file. +All other sources should be included independently.")) + "Target for a single info file.") + +(defvar ede-makeinfo-source + (ede-sourcecode "ede-makeinfo-source" + :name "Texinfo" + :sourcepattern "\\.texi?$" + :garbagepattern '("*.info*" "*.html")) + "Texinfo source code definition.") + +(defvar ede-makeinfo-compiler + (ede-compiler + "ede-makeinfo-compiler" + :name "makeinfo" + :variables '(("MAKEINFO" . "makeinfo")) + :commands '("$(MAKEINFO) $<") + :autoconf '(("AC_CHECK_PROG" . "MAKEINFO, makeinfo")) + :sourcetype '(ede-makeinfo-source) + ) + "Compile texinfo files into info files.") + +(defvar ede-texi2html-compiler + (ede-compiler + "ede-texi2html-compiler" + :name "texi2html" + :variables '(("TEXI2HTML" . "makeinfo -html")) + :commands '("makeinfo -o $@ $<") + :sourcetype '(ede-makeinfo-source) + ) + "Compile texinfo files into html files.") + +;;; Makefile generation +;; +(defmethod ede-proj-configure-add-missing + ((this ede-proj-target-makefile-info)) + "Query if any files needed by THIS provided by automake are missing. +Results in --add-missing being passed to automake." + (not (ede-expand-filename (ede-toplevel) "texinfo.tex"))) + +(defmethod ede-proj-makefile-sourcevar ((this ede-proj-target-makefile-info)) + "Return the variable name for THIS's sources." + (concat (ede-pmake-varname this) "_TEXINFOS")) + +(defmethod ede-proj-makefile-insert-source-variables + ((this ede-proj-target-makefile-info) &optional moresource) + "Insert the source variables needed by THIS info target. +Optional argument MORESOURCE is a list of additional sources to add to the +sources variable. +Does the usual for Makefile mode, but splits source into two variables +when working in Automake mode." + (if (not (ede-proj-automake-p)) + (call-next-method) + (let* ((sv (ede-proj-makefile-sourcevar this)) + (src (copy-sequence (oref this source))) + (menu (or (oref this menu) (car src)))) + (setq src (delq menu src)) + ;; the info_TEXINFOS variable is probably shared + (ede-pmake-insert-variable-shared "info_TEXINFOS" + (insert menu)) + ;; Now insert the rest of the source elsewhere + (ede-pmake-insert-variable-shared sv + (insert (mapconcat 'identity src " "))) + (if moresource + (error "Texinfo files should not have moresource"))))) + +(defun ede-makeinfo-find-info-filename (source) + "Find the info filename produced by SOURCE texinfo file." + (let ((opened (get-file-buffer source)) + (buffer (or (get-file-buffer source) + (find-file-noselect source nil t))) + info) + (with-current-buffer buffer + (save-excursion + (goto-char (point-min)) + (and (re-search-forward "^@setfilename\\s-+\\([^.]+\\).info$" nil t) + (setq info (match-string 1))))) + (unless (eq buffer opened) + (kill-buffer buffer)) + info)) + +(defmethod ede-proj-makefile-target-name ((this ede-proj-target-makefile-info)) + "Return the name of the main target for THIS target." + ;; The target should be the main-menu file name translated to .info. + (let* ((source (if (not (string= (oref this mainmenu) "")) + (oref this mainmenu) + (car (oref this source)))) + (info (ede-makeinfo-find-info-filename source))) + (concat (or info (file-name-sans-extension source)) ".info"))) + +(defmethod ede-proj-makefile-insert-dist-dependencies ((this ede-proj-target-makefile-info)) + "Insert any symbols that the DIST rule should depend on. +Texinfo files want to insert generated `.info' files. +Argument THIS is the target which needs to insert an info file." + ;; In some cases, this is ONLY the index file. That should generally + ;; be ok. + (insert " " (ede-proj-makefile-target-name this)) + ) + +(defmethod ede-proj-makefile-insert-dist-filepatterns ((this ede-proj-target-makefile-info)) + "Insert any symbols that the DIST rule should depend on. +Texinfo files want to insert generated `.info' files. +Argument THIS is the target which needs to insert an info file." + ;; In some cases, this is ONLY the index file. That should generally + ;; be ok. + (insert " " (ede-proj-makefile-target-name this) "*") + ) + +; (let ((n (ede-name this))) +; (if (string-match "\\.info$" n) +; n +; (concat n ".info")))) + +(defmethod object-write ((this ede-proj-target-makefile-info)) + "Before committing any change to THIS, make sure the mainmenu is first." + (let ((mm (oref this mainmenu)) + (s (oref this source)) + (nl nil)) + (if (or (string= mm "") (not mm) (string= mm (car s))) + nil + ;; Make sure that MM is first in the list of items. + (setq nl (cons mm (delq mm s))) + (oset this source nl))) + (call-next-method)) + +(defmethod ede-documentation ((this ede-proj-target-makefile-info)) + "Return a list of files that provides documentation. +Documentation is not for object THIS, but is provided by THIS for other +files in the project." + (let* ((src (oref this source)) + (proj (ede-target-parent this)) + (dir (oref proj directory)) + (out nil) + ) + ;; convert src to full file names. + (while src + (setq out (cons + (expand-file-name (car src) dir) + out)) + (setq src (cdr src))) + ;; Return it + out)) + +(provide 'ede/proj-info) + +;;; ede/proj-info.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/cedet/ede/proj-misc.el Sun Sep 20 15:06:05 2009 +0000 @@ -0,0 +1,93 @@ +;;; ede-proj-nusc.el --- EDE Generic Project Emacs Lisp support + +;;; Copyright (C) 1998, 1999, 2000, 2001, 2008 +;;; Free Software Foundation, Inc. + +;; Author: Eric M. Ludlam <zappo@gnu.org> +;; Keywords: project, make + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; Handle miscelaneous compilable projects in and EDE Project file. +;; This misc target lets the user link in custom makefiles to an EDE +;; project. + +(require 'ede/pmake) +(require 'ede/proj-comp) + +;;; Code: +(defclass ede-proj-target-makefile-miscelaneous (ede-proj-target-makefile) + ((sourcetype :initform (ede-misc-source)) + (availablecompilers :initform (ede-misc-compile)) + (submakefile :initarg :submakefile + :initform "" + :type string + :custom string + :documentation + "Miscellaneous sources which have a specialized makefile. +The sub-makefile is used to build this target.") + ) + "Miscelaneous target type. +A user-written makefile is used to build this target. +All listed sources are included in the distribution.") + +(defvar ede-misc-source + (ede-sourcecode "ede-misc-source" + :name "Miscelaneous" + :sourcepattern ".*") + "Miscelaneous fiels definition.") + +(defvar ede-misc-compile + (ede-compiler "ede-misc-compile" + :name "Sub Makefile" + :commands + '( + ) + :autoconf nil + :sourcetype '(ede-misc-source) + ) + "Compile code via a sub-makefile.") + +(defmethod ede-proj-makefile-sourcevar ((this ede-proj-target-makefile-miscelaneous)) + "Return the variable name for THIS's sources." + (concat (ede-pmake-varname this) "_MISC")) + +(defmethod ede-proj-makefile-dependency-files + ((this ede-proj-target-makefile-miscelaneous)) + "Return a list of files which THIS target depends on." + (with-slots (submakefile) this + (cond ((string= submakefile "") + nil) + ((not submakefile) + nil) + (t (list submakefile))))) + +(defmethod ede-proj-makefile-insert-rules ((this ede-proj-target-makefile-miscelaneous)) + "Create the make rule needed to create an archive for THIS." + ;; DO NOT call the next method. We will never have any compilers, + ;; or any dependencies, or stuff like this. This rull will lets us + ;; deal with it in a nice way. + (insert (ede-name this) ": ") + (with-slots (submakefile) this + (if (string= submakefile "") + (insert "\n\t@\n\n") + (insert submakefile "\n" "\t$(MAKE) -f " submakefile "\n\n")))) + +(provide 'ede/proj-misc) + +;;; ede/proj-misc.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/cedet/ede/proj-obj.el Sun Sep 20 15:06:05 2009 +0000 @@ -0,0 +1,281 @@ +;;; ede/proj-obj.el --- EDE Generic Project Object code generation support + +;;; Copyright (C) 1998, 1999, 2000, 2005, 2008, 2009 +;;; Free Software Foundation, Inc. + +;; Author: Eric M. Ludlam <zappo@gnu.org> +;; Keywords: project, make + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; Handles a supperclass of target types which create object code in +;; and EDE Project file. + +(require 'ede/proj) +(declare-function ede-pmake-varname "ede/pmake") + +(defvar ede-proj-objectcode-dodependencies nil + "Flag specifies to do automatic dependencies.") + +;;; Code: +(defclass ede-proj-target-makefile-objectcode (ede-proj-target-makefile) + (;; Give this a new default + (configuration-variables :initform ("debug" . (("CFLAGS" . "-g") + ("LDFLAGS" . "-g")))) + ;; @TODO - add an include path. + (availablecompilers :initform (ede-gcc-compiler + ede-g++-compiler + ede-gfortran-compiler + ede-gfortran-module-compiler + ;; More C and C++ compilers, plus + ;; fortran or pascal can be added here + )) + (availablelinkers :initform (ede-g++-linker + ;; Add more linker thingies here. + ede-ld-linker + ede-gfortran-linker + )) + (sourcetype :initform (ede-source-c + ede-source-c++ + ede-source-f77 + ede-source-f90 + ;; ede-source-other + ;; This object should take everything that + ;; gets compiled into objects like fortran + ;; and pascal. + )) + ) + "Abstract class for Makefile based object code generating targets. +Belonging to this group assumes you could make a .o from an element source +file.") + +(defclass ede-object-compiler (ede-compiler) + ((uselinker :initform t) + (dependencyvar :initarg :dependencyvar + :type list + :custom (cons (string :tag "Variable") + (string :tag "Value")) + :documentation + "A variable dedicated to dependency generation.")) + "Ede compiler class for source which must compiler, and link.") + +;;; C/C++ Compilers and Linkers +;; +(defvar ede-source-c + (ede-sourcecode "ede-source-c" + :name "C" + :sourcepattern "\\.c$" + :auxsourcepattern "\\.h$" + :garbagepattern '("*.o" "*.obj" ".deps/*.P" ".lo")) + "C source code definition.") + +(defvar ede-gcc-compiler + (ede-object-compiler + "ede-c-compiler-gcc" + :name "gcc" + :dependencyvar '("C_DEPENDENCIES" . "-Wp,-MD,.deps/$(*F).P") + :variables '(("CC" . "gcc") + ("C_COMPILE" . + "$(CC) $(DEFS) $(INCLUDES) $(CPPFLAGS) $(CFLAGS)")) + :rules (list (ede-makefile-rule + "c-inference-rule" + :target "%.o" + :dependencies "%.c" + :rules '("@echo '$(C_COMPILE) -c $<'; \\" + "$(C_COMPILE) $(C_DEPENDENCIES) -o $@ -c $<" + ) + )) + :autoconf '("AC_PROG_CC" "AC_PROG_GCC_TRADITIONAL") + :sourcetype '(ede-source-c) + :objectextention ".o" + :makedepends t + :uselinker t) + "Compiler for C sourcecode.") + +(defvar ede-source-c++ + (ede-sourcecode "ede-source-c++" + :name "C++" + :sourcepattern "\\.\\(cpp\\|cc\\|cxx\\)$" + :auxsourcepattern "\\.\\(hpp\\|hh?\\|hxx\\)$" + :garbagepattern '("*.o" "*.obj" ".deps/*.P" ".lo")) + "C++ source code definition.") + +(defvar ede-g++-compiler + (ede-object-compiler + "ede-c-compiler-g++" + :name "g++" + :dependencyvar '("CXX_DEPENDENCIES" . "-Wp,-MD,.deps/$(*F).P") + :variables '(("CXX" "g++") + ("CXX_COMPILE" . + "$(CXX) $(DEFS) $(INCLUDES) $(CPPFLAGS) $(CFLAGS)") + ) + :rules (list (ede-makefile-rule + "c++-inference-rule" + :target "%.o" + :dependencies "%.cpp" + :rules '("@echo '$(CXX_COMPILE) -c $<'; \\" + "$(CXX_COMPILE) $(CXX_DEPENDENCIES) -o $@ -c $<" + ) + )) + :autoconf '("AC_PROG_CXX") + :sourcetype '(ede-source-c++) + :objectextention ".o" + :makedepends t + :uselinker t) + "Compiler for C sourcecode.") + +(defvar ede-g++-linker + (ede-linker + "ede-g++-linker" + :name "g++" + ;; Only use this linker when c++ exists. + :sourcetype '(ede-source-c++) + :variables '(("CXX_LINK" . + "$(CXX) $(CFLAGS) $(LDFLAGS) -L. -o $@") + ) + :commands '("$(CXX_LINK) $^") + :autoconf '("AC_PROG_CXX") + :objectextention "") + "Linker needed for c++ programs.") + +;;; Fortran Compiler/Linker +;; +;; Contributed by David Engster +(defvar ede-source-f90 + (ede-sourcecode "ede-source-f90" + :name "Fortran 90/95" + :sourcepattern "\\.[fF]9[05]$" + :auxsourcepattern "\\.incf$" + :garbagepattern '("*.o" "*.mod" ".deps/*.P")) + "Fortran 90/95 source code definition.") + +(defvar ede-source-f77 + (ede-sourcecode "ede-source-f77" + :name "Fortran 77" + :sourcepattern "\\.\\([fF]\\|for\\)$" + :auxsourcepattern "\\.incf$" + :garbagepattern '("*.o" ".deps/*.P")) + "Fortran 77 source code definition.") + +(defvar ede-gfortran-compiler + (ede-object-compiler + "ede-f90-compiler-gfortran" + :name "gfortran" + :dependencyvar '("F90_DEPENDENCIES" . "-Wp,-MD,.deps/$(*F).P") + :variables '(("F90" . "gfortran") + ("F90_COMPILE" . + "$(F90) $(DEFS) $(INCLUDES) $(F90FLAGS)")) + :rules (list (ede-makefile-rule + "f90-inference-rule" + :target "%.o" + :dependencies "%.f90" + :rules '("@echo '$(F90_COMPILE) -c $<'; \\" + "$(F90_COMPILE) $(F90_DEPENDENCIES) -o $@ -c $<" + ) + )) + :sourcetype '(ede-source-f90 ede-source-f77) + :objectextention ".o" + :makedepends t + :uselinker t) + "Compiler for Fortran sourcecode.") + +(defvar ede-gfortran-module-compiler + (clone ede-gfortran-compiler + "ede-f90-module-compiler-gfortran" + :name "gfortranmod" + :sourcetype '(ede-source-f90) + :commands '("$(F90_COMPILE) -c $^") + :objectextention ".mod" + :uselinker nil) + "Compiler for Fortran 90/95 modules.") + + +(defvar ede-gfortran-linker + (ede-linker + "ede-gfortran-linker" + :name "gfortran" + :sourcetype '(ede-source-f90 ede-source-f77) + :variables '(("F90_LINK" . + "$(F90) $(CFLAGS) $(LDFLAGS) -L. -o $@") + ) + :commands '("$(F90_LINK) $^") + :objectextention "") + "Linker needed for Fortran programs.") + +;;; Generic Linker +;; +(defvar ede-ld-linker + (ede-linker + "ede-ld-linker" + :name "ld" + :variables '(("LD" . "ld") + ("LD_LINK" . + "$(LD) $(LDFLAGS) -L. -o $@") + ) + :commands '("$(LD_LINK) $^") + :objectextention "") + "Linker needed for c++ programs.") + +;;; The EDE object compiler +;; +(defmethod ede-proj-makefile-insert-variables ((this ede-object-compiler)) + "Insert variables needed by the compiler THIS." + (call-next-method) + (if (eieio-instance-inheritor-slot-boundp this 'dependencyvar) + (with-slots (dependencyvar) this + (insert (car dependencyvar) "=") + (let ((cd (cdr dependencyvar))) + (if (listp cd) + (mapc (lambda (c) (insert " " c)) cd) + (insert cd)) + (insert "\n"))))) + +;;; EDE Object target type methods +;; +(defmethod ede-proj-makefile-sourcevar + ((this ede-proj-target-makefile-objectcode)) + "Return the variable name for THIS's sources." + (require 'ede/pmake) + (concat (ede-pmake-varname this) "_SOURCES")) + +(defmethod ede-proj-makefile-dependency-files + ((this ede-proj-target-makefile-objectcode)) + "Return a list of source files to convert to dependencies. +Argument THIS is the target to get sources from." + (append (oref this source) (oref this auxsource))) + +(defmethod ede-proj-makefile-insert-variables ((this ede-proj-target-makefile-objectcode) + &optional moresource) + "Insert variables needed by target THIS. +Optional argument MORESOURCE is not used." + (let ((ede-proj-objectcode-dodependencies + (oref (ede-target-parent this) automatic-dependencies))) + (call-next-method))) + +(defmethod ede-buffer-header-file((this ede-proj-target-makefile-objectcode) + buffer) + "There are no default header files." + (or (call-next-method) + ;; Ok, nothing obvious. Try looking in ourselves. + (let ((h (oref this auxsource))) + ;; Add more logic here when the problem is better understood. + (car-safe h)))) + +(provide 'ede/proj-obj) + +;;; ede/proj-obj.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/cedet/ede/proj-prog.el Sun Sep 20 15:06:05 2009 +0000 @@ -0,0 +1,113 @@ +;;; ede-proj-prog.el --- EDE Generic Project program support + +;;; Copyright (C) 1998, 1999, 2000, 2001, 2005, 2008 +;;; Free Software Foundation, Inc. + +;; Author: Eric M. Ludlam <zappo@gnu.org> +;; Keywords: project, make + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; Handle building programs from object files in and EDE Project file. + +(require 'ede/pmake) +(require 'ede/proj-obj) + +;;; Code: +(defclass ede-proj-target-makefile-program + (ede-proj-target-makefile-objectcode) + ((ldlibs :initarg :ldlibs + :initform nil + :type list + :custom (repeat (string :tag "Library")) + :documentation + "Libraries, such as \"m\" or \"Xt\" which this program depends on. +The linker flag \"-l\" is automatically prepended. Do not include a \"lib\" +prefix, or a \".so\" suffix. + +Note: Currently only used for Automake projects." + ) + (ldflags :initarg :ldflags + :initform nil + :type list + :custom (repeat (string :tag "Link Flag")) + :documentation + "Additional flags to add when linking this target. +Use ldlibs to add addition libraries. Use this to specify specific +options to the linker. + +Note: Not currently used. This bug needs to be fixed.") + ) + "This target is an executable program.") + +(defmethod ede-proj-makefile-insert-automake-pre-variables + ((this ede-proj-target-makefile-program)) + "Insert bin_PROGRAMS variables needed by target THIS." + (ede-pmake-insert-variable-shared "bin_PROGRAMS" + (insert (ede-name this))) + (call-next-method)) + +(defmethod ede-proj-makefile-insert-automake-post-variables + ((this ede-proj-target-makefile-program)) + "Insert bin_PROGRAMS variables needed by target THIS." + (ede-pmake-insert-variable-shared + (concat (ede-name this) "_LDADD") + (mapc (lambda (c) (insert " -l" c)) (oref this ldlibs))) + ;; For other targets THIS depends on + ;; + ;; NOTE: FIX THIS + ;; + ;;(ede-pmake-insert-variable-shared + ;; (concat (ede-name this) "_DEPENDENCIES") + ;; (mapcar (lambda (d) (insert d)) (oref this FOOOOOOOO))) + (call-next-method)) + +(defmethod ede-proj-makefile-insert-rules ((this ede-proj-target-makefile-program)) + "Insert rules needed by THIS target." + (let ((ede-proj-compiler-object-linkflags + (mapconcat 'identity (oref this ldflags) " "))) + (with-slots (ldlibs) this + (if ldlibs + (setq ede-proj-compiler-object-linkflags + (concat ede-proj-compiler-object-linkflags + " -l" + (mapconcat 'identity ldlibs " -l"))))) + (call-next-method))) + +(defmethod project-debug-target ((obj ede-proj-target-makefile-program)) + "Debug a program target OBJ." + (let ((tb (get-buffer-create " *padt*")) + (dd (if (not (string= (oref obj path) "")) + (oref obj path) + default-directory)) + (cmd nil)) + (unwind-protect + (progn + (set-buffer tb) + (setq default-directory dd) + (setq cmd (read-from-minibuffer + "Run (like this): " + (concat (symbol-name ede-debug-program-function) + " " (ede-target-name obj)))) + (funcall ede-debug-program-function cmd)) + (kill-buffer tb)))) + + +(provide 'ede/proj-prog) + +;;; ede/proj-prog.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/cedet/ede/proj-scheme.el Sun Sep 20 15:06:05 2009 +0000 @@ -0,0 +1,49 @@ +;;; ede/proj-scheme.el --- EDE Generic Project scheme (guile) support + +;;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc. + +;; Author: Eric M. Ludlam <zappo@gnu.org> +;; Keywords: project, make, scheme + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; Handle scheme (Guile) in and EDE Project file. +;; This is a specialized do nothing class. + +(require 'ede/proj) +(require 'ede/autoconf-edit) + +;;; Code: +(defclass ede-proj-target-scheme (ede-proj-target) + ((menu :initform nil) + (keybindings :initform nil) + (interpreter :initarg :interpreter + :initform "guile" + :type string + :custom string + :documentation "The preferred interpreter for this code.") + ) + "This target consists of scheme files.") + +(defmethod ede-proj-tweak-autoconf ((this ede-proj-target-scheme)) + "Tweak the configure file (current buffer) to accomodate THIS." + (autoconf-insert-new-macro "AM_INIT_GUILE_MODULE")) + +(provide 'ede/proj-scheme) + +;;; ede/proj-scheme.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/cedet/ede/proj-shared.el Sun Sep 20 15:06:05 2009 +0000 @@ -0,0 +1,164 @@ +;;; ede-proj-shared.el --- EDE Generic Project shared library support + +;;; Copyright (C) 1998, 1999, 2000, 2009 Free Software Foundation, Inc. + +;; Author: Eric M. Ludlam <zappo@gnu.org> +;; Keywords: project, make + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; Handle shared object libraries in and EDE Project file. +;; Tries to deal with libtool and non-libtool situations. + +(require 'ede/pmake) +(require 'ede/proj-prog) + +;;; THIS NEEDS WORK. SEE ede-proj-obj. + +;;; Code: +(defclass ede-proj-target-makefile-shared-object + (ede-proj-target-makefile-program) + ((availablecompilers :initform (ede-gcc-shared-compiler + ede-gcc-libtool-shared-compiler + ede-g++-shared-compiler + ede-g++-libtool-shared-compiler + )) + (ldflags :custom (repeat (string :tag "Libtool flag")) + :documentation + "Additional flags to add when linking this shared library. +Use ldlibs to add addition libraries.") + ) + "This target generates a shared library.") + +(defvar ede-gcc-shared-compiler + (clone ede-gcc-compiler + "ede-c-shared-compiler" + :name "gcc -shared" + :variables '(("CC_SHARED" . "gcc") + ("C_SHARED_COMPILE" . + "$(CC_SHARED) -shared $(DEFS) $(INCLUDES) $(CPPFLAGS) $(CFLAGS)")) +; :linkvariables '(("C_SHARED_LINK" . +; "$(CC_SHARED) -shared $(CFLAGS) $(LDFLAGS) -L. -o $@ $^") +; ) +; :commands '("$(C_SHARED_LINK) %s") + ;; @TODO - addative modification of autoconf. + :autoconf '("AC_PROG_LIBTOOL") + ) + "Compiler for C sourcecode.") + +(defvar ede-gcc-libtool-shared-compiler + (clone ede-gcc-shared-compiler + "ede-c-shared-compiler-libtool" + :name "libtool" + :variables '(("LIBTOOL" . "$(SHELL) libtool") + ("LTCOMPILE" . "$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(INCLUDES) $(CPPFLAGS) $(CFLAGS)") + ("LTLINK" . "$(LIBTOOL) --mode=link $(CC) $(CFLAGS) $(LDFLAGS) -L. -o $@") + ) + :commands '("$(LTLINK) $^" + ) + :autoconf '("AC_PROG_LIBTOOL") + ) + "Compiler for C sourcecode.") + +(defvar ede-g++-shared-compiler + (clone ede-g++-compiler + "ede-c++-shared-compiler" + :name "gcc -shared" + :variables '(("CXX_SHARED" . "g++") + ("CXX_SHARED_COMPILE" . + "$(CXX_SHARED) -shared $(DEFS) $(INCLUDES) $(CPPFLAGS) $(CFLAGS)")) + ;; @TODO - addative modification of autoconf. + :autoconf '("AC_PROG_LIBTOOL") + ) + "Compiler for C sourcecode.") + +(defvar ede-g++-libtool-shared-compiler + (clone ede-g++-shared-compiler + "ede-c++-shared-compiler-libtool" + :name "libtool" + :variables '(("CXX" "g++") + ("LIBTOOL" . "$(SHELL) libtool") + ("LTCOMPILE" . "$(LIBTOOL) --mode=compile $(CXX) $(DEFS) $(INCLUDES) $(CPPFLAGS) $(CFLAGS)") + ("LTLINK" . "$(LIBTOOL) --mode=link $(CXX) $(CFLAGS) $(LDFLAGS) -L. -o $@") + ) + :commands '("$(LTLINK) $^" + ) + :autoconf '("AC_PROG_LIBTOOL") + ) + "Compiler for C sourcecode.") + +;;; @TODO - C++ versions of the above. + +(when nil + + + (insert;; These C to O rules create dependencies + "%.o: %.c\n" + "\t@echo '$(COMPILE) -c $<'; \\\n" + "\t$(COMPILE)" + (if (oref this automatic-dependencies) + " -Wp,-MD,.deps/$(*F).P" + "") + " -c $<\n\n") + (if have-libtool + (insert;; These C to shared o rules create pic code. + "%.lo: %.c\n" + "\t@echo '$(LTCOMPILE) -c $<'; \\\n" + "\t$(LTCOMPILE) -Wp,-MD,.deps/$(*F).p -c $<\n" + "\t@-sed -e 's/^\([^:]*\)\.o:/\1.lo \1.o:/' \\\n" + "\t < .deps/$(*F).p > .deps/$(*F).P\n" + "\t@-rm -f .deps/$(*F).p\n\n")) + ) + +(defmethod ede-proj-configure-add-missing + ((this ede-proj-target-makefile-shared-object)) + "Query if any files needed by THIS provided by automake are missing. +Results in --add-missing being passed to automake." + (not (and (ede-expand-filename (ede-toplevel) "ltconfig") + (ede-expand-filename (ede-toplevel) "ltmain.sh")))) + +(defmethod ede-proj-makefile-insert-automake-pre-variables + ((this ede-proj-target-makefile-shared-object)) + "Insert bin_PROGRAMS variables needed by target THIS. +We aren't acutally inserting SOURCE details, but this is used by the +Makefile.am generator, so use it to add this important bin program." + (ede-pmake-insert-variable-shared "lib_LTLIBRARIES" + (insert (concat "lib" (ede-name this) ".la")))) + +(defmethod ede-proj-makefile-insert-automake-post-variables + ((this ede-proj-target-makefile-shared-object)) + "Insert bin_PROGRAMS variables needed by target THIS. +We need to override -program which has an LDADD element." + nil) + +(defmethod ede-proj-makefile-target-name ((this ede-proj-target-makefile-shared-object)) + "Return the name of the main target for THIS target." + ;; We need some platform gunk to make the .so change to .sl, or .a, + ;; depending on the platform we are going to compile against. + (concat "lib" (ede-name this) ".so")) + +(defmethod ede-proj-makefile-sourcevar ((this ede-proj-target-makefile-shared-object)) + "Return the variable name for THIS's sources." + (if (eq (oref (ede-target-parent this) makefile-type) 'Makefile.am) + (concat "lib" (oref this name) "_la_SOURCES") + (call-next-method))) + + +(provide 'ede/proj-shared) + +;;; ede/proj-shared.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/cedet/ede/proj.el Sun Sep 20 15:06:05 2009 +0000 @@ -0,0 +1,675 @@ +;;; ede-proj.el --- EDE Generic Project file driver + +;;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2007, 2008, 2009 +;;; Free Software Foundation, Inc. + +;; Author: Eric M. Ludlam <zappo@gnu.org> +;; Keywords: project, make + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; EDE defines a method for managing a project. EDE-PROJ aims to be a +;; generic project file format based on the EIEIO object stream +;; methods. Changes in the project structure will require Makefile +;; rebuild. The targets provided in ede-proj can be augmented with +;; additional target types inherited directly from `ede-proj-target'. + +;; (eval-and-compile '(require 'ede)) +(require 'ede/proj-comp) +(require 'ede/make) + +(declare-function ede-proj-makefile-create "ede/pmake") +(declare-function ede-proj-configure-synchronize "ede/pconf") + +(autoload 'ede-proj-target-aux "ede/proj-aux" + "Target class for a group of lisp files." nil nil) +(autoload 'ede-proj-target-elisp "ede/proj-elisp" + "Target class for a group of lisp files." nil nil) +(autoload 'ede-proj-target-elisp-autoloads "ede/proj-elisp" + "Target class for generating autoload files." nil nil) +(autoload 'ede-proj-target-scheme "ede/proj-scheme" + "Target class for a group of lisp files." nil nil) +(autoload 'ede-proj-target-makefile-miscelaneous "ede/proj-misc" + "Target class for a group of miscelaneous w/ a special makefile." nil nil) +(autoload 'ede-proj-target-makefile-program "ede/proj-prog" + "Target class for building a program." nil nil) +(autoload 'ede-proj-target-makefile-archive "ede/proj-archive" + "Target class for building an archive of object code." nil nil) +(autoload 'ede-proj-target-makefile-shared-object "ede/proj-shared" + "Target class for building a shared object." nil nil) +(autoload 'ede-proj-target-makefile-info "ede/proj-info" + "Target class for info files." nil nil) + +;;; Class Definitions: +(defclass ede-proj-target (ede-target) + ((auxsource :initarg :auxsource + :initform nil + :type list + :custom (repeat (string :tag "File")) + :label "Auxiliary Source Files" + :group (default source) + :documentation "Auxilliary source files included in this target. +Each of these is considered equivalent to a source file, but it is not +distributed, and each should have a corresponding rule to build it.") + (dirty :initform nil + :type boolean + :documentation "Non-nil when generated files needs updating.") + (compiler :initarg :compiler + :initform nil + :type (or null symbol) + :custom (choice (const :tag "None" nil) + :slotofchoices availablecompilers) + :label "Compiler for building sources" + :group make + :documentation + "The compiler to be used to compile this object. +This should be a symbol, which contains the object defining the compiler. +This enables save/restore to do so by name, permitting the sharing +of these compiler resources, and global customization thereof.") + (linker :initarg :linker + :initform nil + :type (or null symbol) + :custom (choice (const :tag "None" nil) + :slotofchoices availablelinkers) + :label "Linker for combining intermediate object files." + :group make + :documentation + "The linker to be used to link compiled sources for this object. +This should be a symbol, which contains the object defining the linker. +This enables save/restore to do so by name, permitting the sharing +of these linker resources, and global customization thereof.") + ;; Class allocated slots + (phony :allocation :class + :initform nil + :type boolean + :documentation + "A phony target is one where the build target does not relate to a file. +Such targets are always built, but make knows how to deal with them..") + (availablecompilers :allocation :class + :initform nil + :type (or null list) + :documentation + "A list of `ede-compiler' objects. +These are the compilers the user can choose from when setting the +`compiler' slot.") + (availablelinkers :allocation :class + :initform nil + :type (or null list) + :documentation + "A list of `ede-linker' objects. +These are the linkers the user can choose from when setting the +`linker' slot.") + ) + "Abstract class for ede-proj targets.") + +(defclass ede-proj-target-makefile (ede-proj-target) + ((makefile :initarg :makefile + :initform "Makefile" + :type string + :custom string + :label "Parent Makefile" + :group make + :documentation "File name of generated Makefile.") + (partofall :initarg :partofall + :initform t + :type boolean + :custom boolean + :label "Part of `all:' target" + :group make + :documentation + "Non nil means the rule created is part of the all target. +Setting this to nil creates the rule to build this item, but does not +include it in the ALL`all:' rule.") + (configuration-variables + :initarg :configuration-variables + :initform nil + :type list + :custom (repeat (cons (string :tag "Configuration") + (repeat + (cons (string :tag "Name") + (string :tag "Value"))))) + :label "Environment Variables for configurations" + :group make + :documentation "Makefile variables appended to use in different configurations. +These variables are used in the makefile when a configuration becomes active. +Target variables are always renamed such as foo_CFLAGS, then included into +commands where the variable would usually appear.") + (rules :initarg :rules + :initform nil + :type list + :custom (repeat (object :objecttype ede-makefile-rule)) + :label "Additional Rules" + :group (make) + :documentation + "Arbitrary rules and dependencies needed to make this target. +It is safe to leave this blank.") + ) + "Abstract class for Makefile based targets.") + +(defvar ede-proj-target-alist + '(("program" . ede-proj-target-makefile-program) + ("archive" . ede-proj-target-makefile-archive) + ("sharedobject" . ede-proj-target-makefile-shared-object) + ("emacs lisp" . ede-proj-target-elisp) + ("emacs lisp autoloads" . ede-proj-target-elisp-autoloads) + ("info" . ede-proj-target-makefile-info) + ("auxiliary" . ede-proj-target-aux) + ("scheme" . ede-proj-target-scheme) + ("miscellaneous" . ede-proj-target-makefile-miscelaneous) + ) + "Alist of names to class types for available project target classes.") + +(defun ede-proj-register-target (name class) + "Register a new target class with NAME and class symbol CLASS. +This enables the creation of your target type." + (let ((a (assoc name ede-proj-target-alist))) + (if a + (setcdr a class) + (setq ede-proj-target-alist + (cons (cons name class) ede-proj-target-alist))))) + +(defclass ede-proj-project (ede-project) + ((makefile-type :initarg :makefile-type + :initform Makefile + :type symbol + :custom (choice (const Makefile) + ;(const Makefile.in) + (const Makefile.am) + ;(const cook) + ) + :documentation "The type of Makefile to generate. +Can be one of 'Makefile, 'Makefile.in, or 'Makefile.am. +If this value is NOT 'Makefile, then that overrides the :makefile slot +in targets.") + (variables :initarg :variables + :initform nil + :type list + :custom (repeat (cons (string :tag "Name") + (string :tag "Value"))) + :group (settings) + :documentation "Variables to set in this Makefile.") + (configuration-variables + :initarg :configuration-variables + :initform ("debug" (("DEBUG" . "1"))) + :type list + :custom (repeat (cons (string :tag "Configuration") + (repeat + (cons (string :tag "Name") + (string :tag "Value"))))) + :group (settings) + :documentation "Makefile variables to use in different configurations. +These variables are used in the makefile when a configuration becomes active.") + (inference-rules :initarg :inference-rules + :initform nil + :custom (repeat + (object :objecttype ede-makefile-rule)) + :documentation "Inference rules to add to the makefile.") + (include-file :initarg :include-file + :initform nil + :custom (repeat + (string :tag "Include File")) + :documentation "Additional files to include. +These files can contain additional rules, variables, and customizations.") + (automatic-dependencies + :initarg :automatic-dependencies + :initform t + :type boolean + :custom boolean + :group (default settings) + :documentation + "Non-nil to do implement automatic dependencies in the Makefile.") + (menu :initform + ( + [ "Regenerate Makefiles" ede-proj-regenerate t ] + [ "Upload Distribution" ede-upload-distribution t ] + ) + ) + (metasubproject + :initarg :metasubproject + :initform nil + :type boolean + :custom boolean + :group (default settings) + :documentation + "Non-nil if this is a metasubproject. +Usually, a subproject is determined by a parent project. If multiple top level +projects are grouped into a large project not maintained by EDE, then you need +to set this to non-nil. The only effect is that the `dist' rule will then avoid +making a tar file.") + ) + "The EDE-PROJ project definition class.") + +;;; Code: +(defun ede-proj-load (project &optional rootproj) + "Load a project file from PROJECT directory. +If optional ROOTPROJ is provided then ROOTPROJ is the root project +for the tree being read in. If ROOTPROJ is nil, then assume that +the PROJECT being read in is the root project." + (save-excursion + (let ((ret nil) + (subdirs (directory-files project nil "[^.].*" nil))) + (set-buffer (get-buffer-create " *tmp proj read*")) + (unwind-protect + (progn + (insert-file-contents (concat project "Project.ede") + nil nil nil t) + (goto-char (point-min)) + (setq ret (read (current-buffer))) + (if (not (eq (car ret) 'ede-proj-project)) + (error "Corrupt project file")) + (setq ret (eval ret)) + (oset ret file (concat project "Project.ede")) + (oset ret directory project) + (oset ret rootproject rootproj) + ) + (kill-buffer " *tmp proj read*")) + (while subdirs + (let ((sd (file-name-as-directory + (expand-file-name (car subdirs) project)))) + (if (and (file-directory-p sd) + (ede-directory-project-p sd)) + (oset ret subproj + (cons (ede-proj-load sd (or rootproj ret)) + (oref ret subproj)))) + (setq subdirs (cdr subdirs)))) + ret))) + +(defun ede-proj-save (&optional project) + "Write out object PROJECT into its file." + (save-excursion + (if (not project) (setq project (ede-current-project))) + (let ((b (set-buffer (get-buffer-create " *tmp proj write*"))) + (cfn (oref project file)) + (cdir (oref project directory))) + (unwind-protect + (save-excursion + (erase-buffer) + (let ((standard-output (current-buffer))) + (oset project file (file-name-nondirectory cfn)) + (slot-makeunbound project :directory) + (object-write project ";; EDE project file.")) + (write-file cfn nil) + ) + ;; Restore the :file on exit. + (oset project file cfn) + (oset project directory cdir) + (kill-buffer b))))) + +(defmethod ede-commit-local-variables ((proj ede-proj-project)) + "Commit change to local variables in PROJ." + (ede-proj-save proj)) + +(defmethod eieio-done-customizing ((proj ede-proj-project)) + "Call this when a user finishes customizing this object. +Argument PROJ is the project to save." + (call-next-method) + (ede-proj-save proj)) + +(defmethod eieio-done-customizing ((target ede-proj-target)) + "Call this when a user finishes customizing this object. +Argument TARGET is the project we are completing customization on." + (call-next-method) + (ede-proj-save (ede-current-project))) + +(defmethod ede-commit-project ((proj ede-proj-project)) + "Commit any change to PROJ to its file." + (ede-proj-save proj)) + +(defmethod ede-buffer-mine ((this ede-proj-project) buffer) + "Return t if object THIS lays claim to the file in BUFFER." + (let ((f (ede-convert-path this (buffer-file-name buffer)))) + (or (string= (file-name-nondirectory (oref this file)) f) + (string= (ede-proj-dist-makefile this) f) + (string-match "Makefile\\(\\.\\(in\\|am\\)\\)?$" f) + (string-match "config\\(ure\\.in\\|\\.stutus\\)?$" f) + ))) + +(defmethod ede-buffer-mine ((this ede-proj-target) buffer) + "Return t if object THIS lays claim to the file in BUFFER." + (or (call-next-method) + (ede-target-buffer-in-sourcelist this buffer (oref this auxsource)))) + + +;;; EDE command functions +;; +(defvar ede-proj-target-history nil + "History when querying for a target type.") + +(defmethod project-new-target ((this ede-proj-project) + &optional name type autoadd) + "Create a new target in THIS based on the current buffer." + (let* ((name (or name (read-string "Name: " ""))) + (type (or type + (completing-read "Type: " ede-proj-target-alist + nil t nil '(ede-proj-target-history . 1)))) + (ot nil) + (src (if (and (buffer-file-name) + (if (and autoadd (stringp autoadd)) + (string= autoadd "y") + (y-or-n-p (format "Add %s to %s? " (buffer-name) name)))) + (buffer-file-name))) + (fcn (cdr (assoc type ede-proj-target-alist))) + ) + + (when (not fcn) + (error "Unknown target type %s for EDE Project." type)) + + (setq ot (funcall fcn name :name name + :path (ede-convert-path this default-directory) + :source (if src + (list (file-name-nondirectory src)) + nil))) + ;; If we added it, set the local buffer's object. + (if src (progn + (setq ede-object ot) + (ede-apply-object-keymap))) + ;; Add it to the project object + ;;(oset this targets (cons ot (oref this targets))) + ;; New form: Add to the end using fancy eieio function. + ;; @todone - Some targets probably want to be in the front. + ;; How to do that? + ;; @ans - See elisp autoloads for answer + (object-add-to-list this 'targets ot t) + ;; And save + (ede-proj-save this))) + +(defmethod project-new-target-custom ((this ede-proj-project)) + "Create a new target in THIS for custom." + (let* ((name (read-string "Name: " "")) + (type (completing-read "Type: " ede-proj-target-alist + nil t nil '(ede-proj-target-history . 1)))) + (funcall (cdr (assoc type ede-proj-target-alist)) name :name name + :path (ede-convert-path this default-directory) + :source nil))) + +(defmethod project-delete-target ((this ede-proj-target)) + "Delete the current target THIS from it's parent project." + (let ((p (ede-current-project)) + (ts (oref this source))) + ;; Loop across all sources. If it exists in a buffer, + ;; clear it's object. + (while ts + (let* ((default-directory (oref this path)) + (b (get-file-buffer (car ts)))) + (if b + (save-excursion + (set-buffer b) + (if (eq ede-object this) + (progn + (setq ede-object nil) + (ede-apply-object-keymap)))))) + (setq ts (cdr ts))) + ;; Remove THIS from it's parent. + ;; The two vectors should be pointer equivalent. + (oset p targets (delq this (oref p targets))) + (ede-proj-save (ede-current-project)))) + +(defmethod project-add-file ((this ede-proj-target) file) + "Add to target THIS the current buffer represented as FILE." + (let ((file (ede-convert-path this file)) + (src (ede-target-sourcecode this))) + (while (and src (not (ede-want-file-p (car src) file))) + (setq src (cdr src))) + (when src + (setq src (car src)) + (cond ((ede-want-file-source-p this file) + (object-add-to-list this 'source file t)) + ((ede-want-file-auxiliary-p this file) + (object-add-to-list this 'auxsource file t)) + (t (error "`project-add-file(ede-target)' source mismatch error"))) + (ede-proj-save)))) + +(defmethod project-remove-file ((target ede-proj-target) file) + "For TARGET, remove FILE. +FILE must be massaged by `ede-convert-path'." + ;; Speedy delete should be safe. + (object-remove-from-list target 'source (ede-convert-path target file)) + (object-remove-from-list target 'auxsource (ede-convert-path target file)) + (ede-proj-save)) + +(defmethod project-update-version ((this ede-proj-project)) + "The :version of project THIS has changed." + (ede-proj-save)) + +(defmethod project-make-dist ((this ede-proj-project)) + "Build a distribution for the project based on THIS target." + ;; I'm a lazy bum, so I'll make a makefile for doing this sort + ;; of thing, and rely only on that small section of code. + (let ((pm (ede-proj-dist-makefile this)) + (df (project-dist-files this))) + (if (and (file-exists-p (car df)) + (not (y-or-n-p "Dist file already exists. Rebuild? "))) + (error "Try `ede-update-version' before making a distribution")) + (ede-proj-setup-buildenvironment this) + (if (string= pm "Makefile.am") (setq pm "Makefile")) + (compile (concat ede-make-command " -f " pm " dist")) + )) + +(defmethod project-dist-files ((this ede-proj-project)) + "Return a list of files that constitutes a distribution of THIS project." + (list + ;; Note to self, keep this first for the above fn to check against. + (concat (oref this name) "-" (oref this version) ".tar.gz") + )) + +(defmethod project-compile-project ((proj ede-proj-project) &optional command) + "Compile the entire current project PROJ. +Argument COMMAND is the command to use when compiling." + (let ((pm (ede-proj-dist-makefile proj)) + (default-directory (file-name-directory (oref proj file)))) + (ede-proj-setup-buildenvironment proj) + (if (string= pm "Makefile.am") (setq pm "Makefile")) + (compile (concat ede-make-command" -f " pm " all")))) + +;;; Target type specific compilations/debug +;; +(defmethod project-compile-target ((obj ede-proj-target) &optional command) + "Compile the current target OBJ. +Argument COMMAND is the command to use for compiling the target." + (project-compile-project (ede-current-project) command)) + +(defmethod project-compile-target ((obj ede-proj-target-makefile) + &optional command) + "Compile the current target program OBJ. +Optional argument COMMAND is the s the alternate command to use." + (ede-proj-setup-buildenvironment (ede-current-project)) + (compile (concat ede-make-command " -f " (oref obj makefile) " " + (ede-proj-makefile-target-name obj)))) + +(defmethod project-debug-target ((obj ede-proj-target)) + "Run the current project target OBJ in a debugger." + (error "Debug-target not supported by %s" (object-name obj))) + +(defmethod ede-proj-makefile-target-name ((this ede-proj-target)) + "Return the name of the main target for THIS target." + (ede-name this)) + +;;; Compiler and source code generators +;; +(defmethod ede-want-file-auxiliary-p ((this ede-target) file) + "Return non-nil if THIS target wants FILE." + ;; By default, all targets reference the source object, and let it decide. + (let ((src (ede-target-sourcecode this))) + (while (and src (not (ede-want-file-auxiliary-p (car src) file))) + (setq src (cdr src))) + src)) + +(defmethod ede-proj-compilers ((obj ede-proj-target)) + "List of compilers being used by OBJ. +If the `compiler' slot is empty, concoct one on a first match found +basis for any given type from the `availablecompilers' slot. +Otherwise, return the `compiler' slot. +Converts all symbols into the objects to be used." + (when (slot-exists-p obj 'compiler) + (let ((comp (oref obj compiler))) + (if comp + ;; Now that we have a pre-set compilers to use, convert tye symbols + ;; into objects for ease of use + (if (listp comp) + (setq comp (mapcar 'symbol-value comp)) + (setq comp (list (symbol-value comp)))) + (let* ((acomp (oref obj availablecompilers)) + (avail (mapcar 'symbol-value acomp)) + (st (oref obj sourcetype)) + (sources (oref obj source))) + ;; COMP is not specified, so generate a list from the available + ;; compilers list. + (while st + (if (ede-want-any-source-files-p (symbol-value (car st)) sources) + (let ((c (ede-proj-find-compiler avail (car st)))) + (if c (setq comp (cons c comp))))) + (setq st (cdr st))))) + ;; Return the disovered compilers + comp))) + +(defmethod ede-proj-linkers ((obj ede-proj-target)) + "List of linkers being used by OBJ. +If the `linker' slot is empty, concoct one on a first match found +basis for any given type from the `availablelinkers' slot. +Otherwise, return the `linker' slot. +Converts all symbols into the objects to be used." + (when (slot-exists-p obj 'linker) + (let ((link (oref obj linker))) + (if link + ;; Now that we have a pre-set linkers to use, convert type symbols + ;; into objects for ease of use + (if (symbolp link) + (setq link (list (symbol-value link))) + (error ":linker is not a symbol. Howd you do that?")) + (let* ((alink (oref obj availablelinkers)) + (avail (mapcar 'symbol-value alink)) + (st (oref obj sourcetype)) + (sources (oref obj source))) + ;; LINKER is not specified, so generate a list from the available + ;; compilers list. + (while st + (if (ede-want-any-source-files-p (symbol-value (car st)) sources) + (let ((c (ede-proj-find-linker avail (car st)))) + (if c (setq link (cons c link))))) + (setq st (cdr st))) + (unless link + ;; No linker stands out! Loop over our linkers and pull out + ;; the first that has no source type requirement. + (while (and avail (not (eieio-instance-inheritor-slot-boundp (car avail) 'sourcetype))) + (setq avail (cdr avail))) + (setq link (cdr avail))))) + ;; Return the disovered linkers + link))) + + +;;; Target type specific autogenerating gobbldegook. +;; + +(defun ede-proj-makefile-type (&optional proj) + "Makefile type of the current project PROJ." + (oref (or proj (ede-current-project)) makefile-type)) + +(defun ede-proj-automake-p (&optional proj) + "Return non-nil if the current project PROJ is automake mode." + (eq (ede-proj-makefile-type proj) 'Makefile.am)) + +(defun ede-proj-autoconf-p (&optional proj) + "Return non-nil if the current project PROJ is automake mode." + (eq (ede-proj-makefile-type proj) 'Makefile.in)) + +(defun ede-proj-make-p (&optional proj) + "Return non-nil if the current project PROJ is automake mode." + (eq (ede-proj-makefile-type proj) 'Makefile)) + +(defmethod ede-proj-dist-makefile ((this ede-proj-project)) + "Return the name of the Makefile with the DIST target in it for THIS." + (cond ((eq (oref this makefile-type) 'Makefile.am) + (concat (file-name-directory (oref this file)) + "Makefile.am")) + ((eq (oref this makefile-type) 'Makefile.in) + (concat (file-name-directory (oref this file)) + "Makefile.in")) + ((object-assoc "Makefile" 'makefile (oref this targets)) + (concat (file-name-directory (oref this file)) + "Makefile")) + (t + (let ((targets (oref this targets))) + (while (and targets + (not (obj-of-class-p + (car targets) + 'ede-proj-target-makefile))) + (setq targets (cdr targets))) + (if targets (oref (car targets) makefile) + (concat (file-name-directory (oref this file)) + "Makefile")))))) + +(defun ede-proj-regenerate () + "Regenerate Makefiles for and edeproject project." + (interactive) + (ede-proj-setup-buildenvironment (ede-current-project) t)) + +(defmethod ede-proj-makefile-create-maybe ((this ede-proj-project) mfilename) + "Create a Makefile for all Makefile targets in THIS if needed. +MFILENAME is the makefile to generate." + ;; For now, pass through until dirty is implemented. + (require 'ede/pmake) + (if (or (not (file-exists-p mfilename)) + (file-newer-than-file-p (oref this file) mfilename)) + (ede-proj-makefile-create this mfilename))) + +(defmethod ede-proj-setup-buildenvironment ((this ede-proj-project) + &optional force) + "Setup the build environment for project THIS. +Handles the Makefile, or a Makefile.am configure.in combination. +Optional argument FORCE will force items to be regenerated." + (if (not force) + (ede-proj-makefile-create-maybe this (ede-proj-dist-makefile this)) + (require 'ede/pmake) + (ede-proj-makefile-create this (ede-proj-dist-makefile this))) + ;; Rebuild all subprojects + (ede-map-subprojects + this (lambda (sproj) (ede-proj-setup-buildenvironment sproj force))) + ;; Autoconf projects need to do other kinds of initializations. + (when (and (ede-proj-automake-p this) + (eq this (ede-toplevel this))) + (require 'ede/pconf) + ;; If the user wants to force this, do it some other way? + (ede-proj-configure-synchronize this) + ;; Now run automake to fill in the blanks, autoconf, and other + ;; auto thingies so that we can just say "make" when done. + ) + ) + + +;;; Lower level overloads +;; +(defmethod project-rescan ((this ede-proj-project)) + "Rescan the EDE proj project THIS." + (let ((root (or (ede-project-root this) this)) + ) + (setq ede-projects (delq root ede-projects)) + (ede-proj-load (ede-project-root-directory root)) + )) + +(defmethod project-rescan ((this ede-proj-target) readstream) + "Rescan target THIS from the read list READSTREAM." + (setq readstream (cdr (cdr readstream))) ;; constructor/name + (while readstream + (let ((tag (car readstream)) + (val (car (cdr readstream)))) + (eieio-oset this tag val)) + (setq readstream (cdr (cdr readstream))))) + +(provide 'ede/proj) + +;;; ede/proj.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/cedet/ede/project-am.el Sun Sep 20 15:06:05 2009 +0000 @@ -0,0 +1,994 @@ +;;; project-am.el --- A project management scheme based on automake files. + +;;; Copyright (C) 1998, 1999, 2000, 2003, 2005, 2007, 2008, 2009 +;;; Free Software Foundation, Inc. + +;; Author: Eric M. Ludlam <zappo@gnu.org> +;; Version: 0.0.3 +;; Keywords: project, make + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; The GNU Automake tool is the first step towards having a really +;; good project management system. It provides a simple and concise +;; look at what is actually in a project, and records it in a simple +;; fashion. +;; +;; project-am uses the structure defined in all good GNU projects with +;; the Automake file as it's base template, and then maintains that +;; information during edits, automatically updating the automake file +;; where appropriate. + + +;; (eval-and-compile +;; ;; Compatibility for makefile mode. +;; (condition-case nil +;; (require 'makefile "make-mode") +;; (error (require 'make-mode "make-mode"))) + +;; ;; Requiring the .el files prevents incomplete builds. +;; (require 'eieio "eieio.el") +;; (require 'ede "ede.el")) + +(require 'make-mode) +(require 'ede) +(require 'ede/make) +(require 'ede/makefile-edit) + +(declare-function autoconf-parameters-for-macro "ede/autoconf-edit") +(eval-when-compile (require 'compile)) + +;;; Code: +(defgroup project-am nil + "File and tag browser frame." + :group 'tools + :group 'ede + ) + +(defcustom project-am-compile-project-command nil + "*Default command used to compile a project." + :group 'project-am + :type 'string) + +(defcustom project-am-compile-target-command (concat ede-make-command " -k %s") + "*Default command used to compile a project." + :group 'project-am + :type 'string) + +(defcustom project-am-debug-target-function 'gdb + "*Default Emacs command used to debug a target." + :group 'project-am + :type 'sexp) ; make this be a list some day + +(defconst project-am-type-alist + '(("bin" project-am-program "bin_PROGRAMS" t) + ("sbin" project-am-program "sbin_PROGRAMS" t) + ("noinstbin" project-am-program "noinst_PROGRAMS" t) + ("checkbin" project-am-program "check_PROGRAMS" t) + ("lib" project-am-lib "lib_LIBS" t) + ("libraries" project-am-lib "lib_LIBRARIES" t) + ("librariesnoinst" project-am-lib "noinst_LIBRARIES" t) + ("pkglibraries" project-am-lib "pkglib_LIBRARIES" t) + ("checklibs" project-am-lib "check_LIBRARIES" t) + ("ltlibraries" project-am-lib "lib_LTLIBRARIES" t) + ("ltlibrariesnoinst" project-am-lib "noinst_LTLIBRARIES" t) + ("pkgltlibraries" project-am-lib "pkglib_LTLIBRARIES" t) + ("checkltlibs" project-am-lib "check_LTLIBRARIES" t) + ("headernoinst" project-am-header-noinst "noinst_HEADERS") + ("headerinst" project-am-header-inst "include_HEADERS") + ("headerpkg" project-am-header-pkg "pkginclude_HEADERS") + ("headerpkg" project-am-header-chk "check_HEADERS") + ("texinfo" project-am-texinfo "info_TEXINFOS" t) + ("man" project-am-man "man_MANS") + ("lisp" project-am-lisp "lisp_LISP") + ;; for other global files track EXTRA_ + ("extrabin" project-am-program "EXTRA_PROGRAMS" t) + ("builtsrcs" project-am-built-src "BUILT_SOURCES") + ("extradist" project-am-extra-dist "EXTRA_DIST") + ;; Custom libraries targets? + ;; ("ltlibcustom" project-am-lib ".*?_LTLIBRARIES" t) + ) + "Alist of type names and the type of object to create for them. +Each entry is of th form: + (EMACSNAME CLASS AUToMAKEVAR INDIRECT) +where EMACSNAME is a name for Emacs to use. +CLASS is the EDE target class to represent the target. +AUTOMAKEVAR is the Automake variable to identify. This cannot be a + regular expression. +INDIRECT is optional. If it is non-nil, then the variable in +question lists other variables that need to be looked up.") + +(defclass project-am-target (ede-target) + nil + "Base target class for everything in project-am.") + +(defclass project-am-objectcode (project-am-target) + ((source :initarg :source :documentation "List of source files.")) + "A target which creates object code, like a C program or library.") + +(defclass project-am-program (project-am-objectcode) + ((ldadd :initarg :ldadd :documentation "Additional LD args." + :initform nil)) + "A top level program to build") + +(defclass project-am-header (project-am-target) + () + "A group of misc source files, such as headers.") + +(defclass project-am-header-noinst (project-am-header) + () + "A group of header files that are not installed.") + +(defclass project-am-header-inst (project-am-header) + () + "A group of header files that are not installed.") + +(defclass project-am-header-pkg (project-am-header) + () + "A group of header files that are not installed.") + +(defclass project-am-header-chk (project-am-header) + () + "A group of header files that are not installed.") + +(defclass project-am-lib (project-am-objectcode) + nil + "A top level library to build") + +(defclass project-am-lisp (project-am-target) + () + "A group of Emacs Lisp programs to byte compile.") + +(defclass project-am-texinfo (project-am-target) + ((include :initarg :include + :initform nil + :documentation "Additional texinfo included in this one.")) + "A top level texinfo file to build.") + +(defclass project-am-man (project-am-target) + nil + "A top level man file to build.") + +;; For generic files tracker like EXTRA_DIST +(defclass project-am-built-src (project-am-target) + () + "A group of Emacs Lisp programs to byte compile.") + +(defclass project-am-extra-dist (project-am-target) + () + "A group of Emacs Lisp programs to byte compile.") + +(defclass project-am-makefile (ede-project) + ((targets :initarg :targets + :initform nil + :documentation "Top level targets in this makefile.") + (configureoutputfiles + :initform nil + :documentation + "List of files output from configure system.") + ) + "Encode one makefile.") + +;;; Code: +(defmethod project-add-file ((ot project-am-target)) + "Add the current buffer into a project. +OT is the object target. DIR is the directory to start in." + (let* ((target (if ede-object (error "Already assocated w/ a target") + (let ((amf (project-am-load default-directory))) + (if (not amf) (error "No project file")) + (completing-read "Target: " + (object-assoc-list 'name + (oref amf targets)) + nil t)))) + ;; The input target might be new. See if we can find it. + (amf (ede-load-project-file (oref ot path))) + (ot (object-assoc target 'name (oref amf targets))) + (ofn (file-name-nondirectory (buffer-file-name)))) + (if (not ot) + (setq ot + (project-new-target + target (project-am-preferred-target-type (buffer-file-name))))) + (ede-with-projectfile ot + (makefile-move-to-macro (project-am-macro ot)) + (ede-maybe-checkout) + (makefile-end-of-command) + (insert " " ofn) + (makefile-fill-paragraph nil) + (project-rescan ot) + (save-buffer)) + (setq ede-object ot))) + +(defmethod project-remove-file ((ot project-am-target) fnnd) + "Remove the current buffer from any project targets." + (ede-with-projectfile ot + (makefile-move-to-macro (project-am-macro ot)) + (if (and buffer-read-only vc-mode + (y-or-n-p "Checkout Makefile.am from VC? ")) + (vc-toggle-read-only t)) + (ede-maybe-checkout) + (makefile-navigate-macro (concat " *" (regexp-quote (ede-name fnnd)))) + (replace-match "" t t nil 0) + (makefile-fill-paragraph nil) + (project-rescan ot) + (save-buffer)) + (setq ede-object nil)) + +(defmethod project-edit-file-target ((obj project-am-target)) + "Edit the target associated w/ this file." + (find-file (concat (oref obj path) "Makefile.am")) + (goto-char (point-min)) + (makefile-move-to-macro (project-am-macro obj)) + (if (= (point-min) (point)) + (re-search-forward (ede-target-name obj)))) + +(defmethod project-new-target ((proj project-am-makefile) + &optional name type) + "Create a new target named NAME. +Argument TYPE is the type of target to insert. This is a string +matching something in `project-am-type-alist' or type class symbol. +Despite the fact that this is a method, it depends on the current +buffer being in order to provide a smart default target type." + (let* ((name (or name (read-string "Name: " ""))) + (type (or type + (completing-read "Type: " + project-am-type-alist + nil t + (cond ((eq major-mode 'texinfo-mode) + "texinfo") + ((eq major-mode 'nroff-mode) + "man") + ((eq major-mode 'emacs-lisp-mode) + "lisp") + (t "bin"))))) + (ntype (assoc type project-am-type-alist)) + (ot nil)) + (setq ot (apply (car (cdr ntype)) name :name name + :path (expand-file-name default-directory) nil)) + (if (not ot) (error "Error creating target object %S" ntype)) + (ede-with-projectfile ot + (goto-char (point-min)) + (ede-maybe-checkout) + (makefile-next-dependency) + (if (= (point) (point-min)) + (goto-char (point-max)) + (beginning-of-line) + (insert "\n") + (forward-char -1)) + ;; Add the new target sources macro (if needed) + (if (project-am-macro ot) + (makefile-insert-macro (project-am-macro ot))) + ;; Add to the list of objects. + (goto-char (point-min)) + (makefile-move-to-macro (car (cdr (cdr ntype)))) + (if (= (point) (point-min)) + (progn + (if (re-search-forward makefile-macroassign-regex nil t) + (progn (forward-line -1) + (end-of-line) + (insert "\n")) + ;; If the above search fails, thats ok. We'd just want to be at + ;; point-min anyway. + ) + (makefile-insert-macro (car (cdr (cdr ntype)))))) + (makefile-end-of-command) + (insert " " (ede-target-name ot)) + (save-buffer) + ;; Rescan the object in this makefile. + (project-rescan ede-object)))) + +;(defun project-am-rescan-toplevel () +; "Rescan all projects in which the current buffer resides." +; (interactive) +; (let* ((tlof (project-am-find-topmost-level default-directory)) +; (tlo (project-am-load tlof)) +; (ede-deep-rescan t)) ; scan deep in this case. +; ;; tlo is the top level object for whatever file we are in +; ;; or nil. If we have an object, call the rescan method. +; (if tlo (project-am-rescan tlo)))) + +;; +;; NOTE TO SELF +;; +;; This should be handled at the EDE level, calling a method of the +;; top most project. +;; +(defmethod project-compile-project ((obj project-am-target) &optional command) + "Compile the entire current project. +Argument COMMAND is the command to use when compiling." + (require 'compile) + (if (not command) + (setq + command + ;; This interactive statement was taken from compile, and I'll + ;; use the same command history too. + (progn + (if (not project-am-compile-project-command) + (setq project-am-compile-project-command compile-command)) + (if (or compilation-read-command current-prefix-arg) + (read-from-minibuffer "Project compile command: " + ;; hardcode make -k + ;; This is compile project after all. + project-am-compile-project-command + nil nil '(compile-history . 1)) + project-am-compile-project-command)))) + ;; When compile a project, we might be in a subdirectory, + ;; so we have to make sure we move all the way to the top. + (let* ((default-directory (project-am-find-topmost-level default-directory))) + (compile command))) + +(defmethod project-compile-project ((obj project-am-makefile) + &optional command) + "Compile the entire current project. +Argument COMMAND is the command to use when compiling." + (require 'compile) + (if (not command) + (setq + command + ;; This interactive statement was taken from compile, and I'll + ;; use the same command history too. + (progn + (if (not project-am-compile-project-command) + (setq project-am-compile-project-command compile-command)) + (if (or compilation-read-command current-prefix-arg) + (read-from-minibuffer "Project compile command: " + ;; hardcode make -k + ;; This is compile project after all. + project-am-compile-project-command + nil nil '(compile-history . 1)) + project-am-compile-project-command)))) + ;; When compile a project, we might be in a subdirectory, + ;; so we have to make sure we move all the way to the top. + (let* ((default-directory (project-am-find-topmost-level default-directory))) + (compile command))) + +(defmethod project-compile-target ((obj project-am-target) &optional command) + "Compile the current target. +Argument COMMAND is the command to use for compiling the target." + (require 'compile) + (if (not project-am-compile-project-command) + (setq project-am-compile-project-command compile-command)) + (if (not command) + (setq + command + (if compilation-read-command + (read-from-minibuffer "Project compile command: " + ;; hardcode make -k + ;; This is compile project after all. + (if ede-object + (format + project-am-compile-target-command + (project-compile-target-command + ede-object)) + project-am-compile-target-command) + nil nil + '(compile-history . 1)) + (if ede-object + project-am-compile-project-command + (format + project-am-compile-target-command + (project-compile-target-command ede-object)))))) + ;; We better be in the right place when compiling a specific target. + (compile command)) + +(defmethod project-debug-target ((obj project-am-objectcode)) + "Run the current project target in a debugger." + (let ((tb (get-buffer-create " *padt*")) + (dd (oref obj path)) + (cmd nil)) + (unwind-protect + (progn + (set-buffer tb) + (setq default-directory dd) + (setq cmd (read-from-minibuffer + "Run (like this): " + (concat (symbol-name project-am-debug-target-function) + " " (ede-target-name obj)))) + (funcall project-am-debug-target-function cmd)) + (kill-buffer tb)))) + +(defmethod project-make-dist ((this project-am-target)) + "Run the current project in the debugger." + (require 'compile) + (if (not project-am-compile-project-command) + (setq project-am-compile-project-command compile-command)) + (project-compile-project this (concat project-am-compile-project-command + " dist"))) + +;;; Project loading and saving +;; +(defun project-am-load (project &optional rootproj) + "Read an automakefile PROJECT into our data structure. +Make sure that the tree down to our makefile is complete so that there +is cohesion in the project. Return the project file (or sub-project). +If a given set of projects has already been loaded, then do nothing +but return the project for the directory given. +Optional ROOTPROJ is the root EDE project." + ;; @TODO - rationalize this to the newer EDE way of doing things. + (setq project (expand-file-name project)) + (let* ((ede-constructing t) + (fn (project-am-find-topmost-level (file-name-as-directory project))) + (amo nil) + (trimmed (if (string-match (regexp-quote fn) + project) + (replace-match "" t t project) + "")) + (subdir nil)) + (setq amo (object-assoc (expand-file-name "Makefile.am" fn) + 'file ede-projects)) + (if amo + (error "Synchronous error in ede/project-am objects") + (let ((project-am-constructing t)) + (setq amo (project-am-load-makefile fn)))) + (if (not amo) + nil + ;; Now scan down from amo, and find the current directory + ;; from the PROJECT file. + (while (< 0 (length trimmed)) + (if (string-match "\\([a-zA-Z0-9.-]+\\)/" trimmed) + (setq subdir (match-string 0 trimmed) + trimmed (replace-match "" t t trimmed)) + (error "Error scanning down path for project")) + (setq amo (project-am-subtree + amo + (expand-file-name "Makefile.am" + (expand-file-name subdir fn))) + fn (expand-file-name subdir fn))) + amo) + )) + +(defun project-am-find-topmost-level (dir) + "Find the topmost automakefile starting with DIR." + (let ((newdir dir)) + (while (or (file-exists-p (concat newdir "Makefile.am")) + (file-exists-p (concat newdir "configure.ac")) + (file-exists-p (concat newdir "configure.in")) + ) + (setq dir newdir newdir + (file-name-directory (directory-file-name newdir)))) + (expand-file-name dir))) + +(defmacro project-am-with-makefile-current (dir &rest forms) + "Set the Makefile.am in DIR to be the current buffer. +Run FORMS while the makefile is current. +Kill the makefile if it was not loaded before the load." + `(let* ((fn (expand-file-name "Makefile.am" ,dir)) + (fb nil) + (kb (get-file-buffer fn))) + (if (not (file-exists-p fn)) + nil + (save-excursion + (if kb (setq fb kb) + ;; We need to find-file this thing, but don't use + ;; any semantic features. + (let ((semantic-init-hooks nil)) + (setq fb (find-file-noselect fn))) + ) + (set-buffer fb) + (prog1 ,@forms + (if (not kb) (kill-buffer (current-buffer)))))))) +(put 'project-am-with-makefile-current 'lisp-indent-function 1) + +(add-hook 'edebug-setup-hook + (lambda () + (def-edebug-spec project-am-with-makefile-current + (form def-body)))) + + +(defun project-am-load-makefile (path) + "Convert PATH into a project Makefile, and return its project object. +It does not check for existing project objects. Use `project-am-load'." + (project-am-with-makefile-current path + (if (and ede-object (project-am-makefile-p ede-object)) + ede-object + (let* ((pi (project-am-package-info path)) + (pn (or (nth 0 pi) (project-am-last-dir fn))) + (ver (or (nth 1 pi) "0.0")) + (bug (nth 2 pi)) + (cof (nth 3 pi)) + (ampf (project-am-makefile + pn :name pn + :version ver + :mailinglist (or bug "") + :file fn))) + (oset ampf :directory (file-name-directory fn)) + (oset ampf configureoutputfiles cof) + (make-local-variable 'ede-object) + (setq ede-object ampf) + ;; Move the rescan after we set ede-object to prevent recursion + (project-rescan ampf) + ampf)))) + +;;; Methods: +(defmethod ede-find-target ((amf project-am-makefile) buffer) + "Fetch the target belonging to BUFFER." + (or (call-next-method) + (let ((targ (oref amf targets)) + (sobj (oref amf subproj)) + (obj nil)) + (while (and targ (not obj)) + (if (ede-buffer-mine (car targ) buffer) + (setq obj (car targ))) + (setq targ (cdr targ))) + (while (and sobj (not obj)) + (setq obj (project-am-buffer-object (car sobj) buffer) + sobj (cdr sobj))) + obj))) + +(defmethod project-targets-for-file ((proj project-am-makefile)) + "Return a list of targets the project PROJ." + (oref proj targets)) + +(defun project-am-scan-for-targets (currproj dir) + "Scan the current Makefile.am for targets. +CURRPROJ is the current project being scanned. +DIR is the directory to apply to new targets." + (let* ((otargets (oref currproj targets)) + (ntargets nil) + (tmp nil) + ) + (mapc + ;; Map all the different types + (lambda (typecar) + (let ((macro (nth 2 typecar)) + (class (nth 1 typecar)) + (indirect (nth 3 typecar)) + ;(name (car typecar)) + ) + (if indirect + ;; Map all the found objects + (mapc (lambda (lstcar) + (setq tmp (object-assoc lstcar 'name otargets)) + (when (not tmp) + (setq tmp (apply class lstcar :name lstcar + :path dir nil))) + (project-rescan tmp) + (setq ntargets (cons tmp ntargets))) + (makefile-macro-file-list macro)) + ;; Non-indirect will have a target whos sources + ;; are actual files, not names of other targets. + (let ((files (makefile-macro-file-list macro))) + (when files + (setq tmp (object-assoc macro 'name otargets)) + (when (not tmp) + (setq tmp (apply class macro :name macro + :path dir nil))) + (project-rescan tmp) + (setq ntargets (cons tmp ntargets)) + )) + ) + )) + project-am-type-alist) + ntargets)) + +(defmethod project-rescan ((this project-am-makefile)) + "Rescan the makefile for all targets and sub targets." + (project-am-with-makefile-current (file-name-directory (oref this file)) + ;;(message "Scanning %s..." (oref this file)) + (let* ((pi (project-am-package-info (oref this directory))) + (pn (nth 0 pi)) + (pv (nth 1 pi)) + (bug (nth 2 pi)) + (cof (nth 3 pi)) + (osubproj (oref this subproj)) + (csubproj (or + ;; If DIST_SUBDIRS doesn't exist, then go for the + ;; static list of SUBDIRS. The DIST version should + ;; contain SUBDIRS plus extra stuff. + (makefile-macro-file-list "DIST_SUBDIRS") + (makefile-macro-file-list "SUBDIRS"))) + (csubprojexpanded nil) + (nsubproj nil) + ;; Targets are excluded here because they require + ;; special attention. + (dir (expand-file-name default-directory)) + (tmp nil) + (ntargets (project-am-scan-for-targets this dir)) + ) + + (and pn (string= (directory-file-name + (oref this directory)) + (directory-file-name + (project-am-find-topmost-level + (oref this directory)))) + (oset this name pn) + (and pv (oset this version pv)) + (and bug (oset this mailinglist bug)) + (oset this configureoutputfiles cof)) + +; ;; LISP is different. Here there is only one kind of lisp (that I know of +; ;; anyway) so it doesn't get mapped when it is found. +; (if (makefile-move-to-macro "lisp_LISP") +; (let ((tmp (project-am-lisp "lisp" +; :name "lisp" +; :path dir))) +; (project-rescan tmp) +; (setq ntargets (cons tmp ntargets)))) +; + ;; Now that we have this new list, chuck the old targets + ;; and replace it with the new list of targets I just created. + (oset this targets (nreverse ntargets)) + ;; We still have a list of targets. For all buffers, make sure + ;; their object still exists! + + ;; FIGURE THIS OUT + + (mapc (lambda (sp) + (let ((var (makefile-extract-varname-from-text sp)) + ) + (if (not var) + (setq csubprojexpanded (cons sp csubprojexpanded)) + ;; If it is a variable, expand that variable, and keep going. + (let ((varexp (makefile-macro-file-list var))) + (dolist (V varexp) + (setq csubprojexpanded (cons V csubprojexpanded))))) + )) + csubproj) + + ;; Ok, now lets look at all our sub-projects. + (mapc (lambda (sp) + (let* ((subdir (file-name-as-directory + (expand-file-name + sp (file-name-directory (oref this :file))))) + (submake (expand-file-name + "Makefile.am" + subdir))) + (if (string= submake (oref this :file)) + nil ;; don't recurse.. please! + + ;; For each project id found, see if we need to recycle, + ;; and if we do not, then make a new one. Check the deep + ;; rescan value for behavior patterns. + (setq tmp (object-assoc + submake + 'file osubproj)) + (if (not tmp) + (setq tmp + (condition-case nil + ;; In case of problem, ignore it. + (project-am-load-makefile subdir) + (error nil))) + ;; If we have tmp, then rescan it only if deep mode. + (if ede-deep-rescan + (project-rescan tmp))) + ;; Tac tmp onto our list of things to keep, but only + ;; if tmp was found. + (when tmp + ;;(message "Adding %S" (object-print tmp)) + (setq nsubproj (cons tmp nsubproj))))) + ) + (nreverse csubprojexpanded)) + (oset this subproj nsubproj) + ;; All elements should be updated now. + ))) + + +(defmethod project-rescan ((this project-am-program)) + "Rescan object THIS." + (oset this :source (makefile-macro-file-list (project-am-macro this))) + (oset this :ldadd (makefile-macro-file-list + (concat (oref this :name) "_LDADD")))) + +(defmethod project-rescan ((this project-am-lib)) + "Rescan object THIS." + (oset this :source (makefile-macro-file-list (project-am-macro this)))) + +(defmethod project-rescan ((this project-am-texinfo)) + "Rescan object THIS." + (oset this :include (makefile-macro-file-list (project-am-macro this)))) + +(defmethod project-rescan ((this project-am-man)) + "Rescan object THIS." + (oset this :source (makefile-macro-file-list (project-am-macro this)))) + +(defmethod project-rescan ((this project-am-lisp)) + "Rescan the lisp sources." + (oset this :source (makefile-macro-file-list (project-am-macro this)))) + +(defmethod project-rescan ((this project-am-header)) + "Rescan the Header sources for object THIS." + (oset this :source (makefile-macro-file-list (project-am-macro this)))) + +(defmethod project-rescan ((this project-am-built-src)) + "Rescan built sources for object THIS." + (oset this :source (makefile-macro-file-list "BUILT_SOURCES"))) + +(defmethod project-rescan ((this project-am-extra-dist)) + "Rescan object THIS." + (oset this :source (makefile-macro-file-list "EXTRA_DIST"))) + ;; NOTE: The below calls 'file' then checks that it is some sort of + ;; text file. The file command may not be available on all platforms + ;; and some files may not exist yet. (ie - auto-generated) + + ;;(mapc + ;; (lambda (f) + ;; ;; prevent garbage to be parsed, could we use :aux ? + ;; (if (and (not (member f (oref this :source))) + ;; (string-match-p "ASCII\\|text" + ;; (shell-command-to-string + ;; (concat "file " f)))) + ;; (oset this :source (cons f (oref this :source))))) + ;; (makefile-macro-file-list "EXTRA_DIST"))) + +(defmethod project-am-macro ((this project-am-objectcode)) + "Return the default macro to 'edit' for this object type." + (concat (subst-char-in-string ?- ?_ (oref this :name)) "_SOURCES")) + +(defmethod project-am-macro ((this project-am-header-noinst)) + "Return the default macro to 'edit' for this object." + "noinst_HEADERS") + +(defmethod project-am-macro ((this project-am-header-inst)) + "Return the default macro to 'edit' for this object." + "include_HEADERS") + +(defmethod project-am-macro ((this project-am-header-pkg)) + "Return the default macro to 'edit' for this object." + "pkginclude_HEADERS") + +(defmethod project-am-macro ((this project-am-header-chk)) + "Return the default macro to 'edit' for this object." + "check_HEADERS") + +(defmethod project-am-macro ((this project-am-texinfo)) + "Return the default macro to 'edit' for this object type." + (concat (file-name-sans-extension (oref this :name)) "_TEXINFOS")) + +(defmethod project-am-macro ((this project-am-man)) + "Return the default macro to 'edit' for this object type." + (oref this :name)) + +(defmethod project-am-macro ((this project-am-lisp)) + "Return the default macro to 'edit' for this object." + "lisp_LISP") + +(defun project-am-buffer-object (amf buffer) + "Return an object starting with AMF associated with BUFFER. +nil means that this buffer belongs to no-one." + (if (not amf) + nil + (if (ede-buffer-mine amf buffer) + amf + (let ((targ (oref amf targets)) + (sobj (oref amf subproj)) + (obj nil)) + (while (and targ (not obj)) + (if (ede-buffer-mine (car targ) buffer) + (setq obj (car targ))) + (setq targ (cdr targ))) + (while (and sobj (not obj)) + (setq obj (project-am-buffer-object (car sobj) buffer) + sobj (cdr sobj))) + obj)))) + +(defmethod ede-buffer-mine ((this project-am-makefile) buffer) + "Return t if object THIS lays claim to the file in BUFFER." + (let ((efn (expand-file-name (buffer-file-name buffer)))) + (or (string= (oref this :file) efn) + (string-match "/configure\\.ac$" efn) + (string-match "/configure\\.in$" efn) + (string-match "/configure$" efn) + ;; Search output files. + (let ((ans nil)) + (dolist (f (oref this configureoutputfiles)) + (when (string-match (concat (regexp-quote f) "$") efn) + (setq ans t))) + ans) + ))) + +(defmethod ede-buffer-mine ((this project-am-objectcode) buffer) + "Return t if object THIS lays claim to the file in BUFFER." + (member (file-name-nondirectory (buffer-file-name buffer)) + (oref this :source))) + +(defmethod ede-buffer-mine ((this project-am-texinfo) buffer) + "Return t if object THIS lays claim to the file in BUFFER." + (let ((bfn (buffer-file-name buffer))) + (or (string= (oref this :name) (file-name-nondirectory bfn)) + (member (file-name-nondirectory bfn) (oref this :include))))) + +(defmethod ede-buffer-mine ((this project-am-man) buffer) + "Return t if object THIS lays claim to the file in BUFFER." + (string= (oref this :name) (buffer-file-name buffer))) + +(defmethod ede-buffer-mine ((this project-am-lisp) buffer) + "Return t if object THIS lays claim to the file in BUFFER." + (member (file-name-nondirectory (buffer-file-name buffer)) + (oref this :source))) + +(defmethod project-am-subtree ((ampf project-am-makefile) subdir) + "Return the sub project in AMPF specified by SUBDIR." + (object-assoc (expand-file-name subdir) 'file (oref ampf subproj))) + +(defmethod project-compile-target-command ((this project-am-target)) + "Default target to use when compiling a given target." + ;; This is a pretty good default for most. + "") + +(defmethod project-compile-target-command ((this project-am-objectcode)) + "Default target to use when compiling an object code target." + (oref this :name)) + +(defmethod project-compile-target-command ((this project-am-texinfo)) + "Default target t- use when compling a texinfo file." + (let ((n (oref this :name))) + (if (string-match "\\.texi?\\(nfo\\)?" n) + (setq n (replace-match ".info" t t n))) + n)) + + +;;; Generic useful functions + +(defun project-am-last-dir (file) + "Return the last part of a directory name. +Argument FILE is the file to extract the end directory name from." + (let* ((s (file-name-directory file)) + (d (directory-file-name s)) + ) + (file-name-nondirectory d)) + ) + +(defun project-am-preferred-target-type (file) + "For FILE, return the preferred type for that file." + (cond ((string-match "\\.texi?\\(nfo\\)$" file) + project-am-texinfo) + ((string-match "\\.[0-9]$" file) + project-am-man) + ((string-match "\\.el$" file) + project-am-lisp) + (t + project-am-program))) + +(defmethod ede-buffer-header-file((this project-am-objectcode) buffer) + "There are no default header files." + (or (call-next-method) + (let ((s (oref this source)) + (found nil)) + (while (and s (not found)) + ;; Add more logic here if applicable. + (if (string-match "\\.\\(h\\|H\\|hh\\|hpp\\)" (car s)) + (setq found (car s))) + (setq s (cdr s))) + found))) + +(defmethod ede-documentation ((this project-am-texinfo)) + "Return a list of files that provides documentation. +Documentation is not for object THIS, but is provided by THIS for other +files in the project." + (let* ((src (append (oref this source) + (oref this include))) + (proj (ede-target-parent this)) + (dir (oref proj directory)) + (out nil)) + ;; Loop over all entries and expand + (while src + (setq out (cons + (expand-file-name (car src) dir) + out)) + (setq src (cdr src))) + ;; return it + out)) + + +;;; Configure.in queries. +;; +(defvar project-am-autoconf-file-options + '("configure.in" "configure.ac") + "List of possible configure files to look in for project info.") + +(defun project-am-autoconf-file (dir) + "Return the name of the autoconf file to use in DIR." + (let ((ans nil)) + (dolist (L project-am-autoconf-file-options) + (when (file-exists-p (expand-file-name L dir)) + (setq ans (expand-file-name L dir)))) + ans)) + +(defmacro project-am-with-config-current (file &rest forms) + "Set the Configure FILE in the top most directory above DIR as current. +Run FORMS in the configure file. +Kill the Configure buffer if it was not already in a buffer." + `(save-excursion + (let ((fb (generate-new-buffer ,file))) + (set-buffer fb) + (erase-buffer) + (insert-file-contents ,file) + (prog1 ,@forms + (kill-buffer fb))))) + +(put 'project-am-with-config-current 'lisp-indent-function 1) + +(add-hook 'edebug-setup-hook + (lambda () + (def-edebug-spec project-am-with-config-current + (form def-body)))) + +(defmacro project-am-extract-shell-variable (var) + "Extract the value of the shell variable VAR from a shell script." + (save-excursion + (goto-char (point-min)) + (when (re-search-forward (concat "^" (regexp-quote var) "\\s-*=\\s-*") + nil t) + (buffer-substring-no-properties (point) (point-at-eol))))) + +(defun project-am-extract-package-info (dir) + "Extract the package information for directory DIR." + (let ((conf-in (project-am-autoconf-file dir)) + (conf-sh (expand-file-name "configure" dir)) + (name (file-name-nondirectory + (directory-file-name dir))) + (ver "1.0") + (bugrep nil) + (configfiles nil) + ) + (cond + ;; Try configure.in or configure.ac + (conf-in + (require 'ede/autoconf-edit) + (project-am-with-config-current conf-in + (let ((aci (autoconf-parameters-for-macro "AC_INIT")) + (aia (autoconf-parameters-for-macro "AM_INIT_AUTOMAKE")) + (acf (autoconf-parameters-for-macro "AC_CONFIG_FILES")) + (aco (autoconf-parameters-for-macro "AC_OUTPUT")) + ) + (cond + ;; AC init has more than 1 parameter + ((> (length aci) 1) + (setq name (nth 0 aci) + ver (nth 1 aci) + bugrep (nth 2 aci))) + ;; The init automake has more than 1 parameter + ((> (length aia) 1) + (setq name (nth 0 aia) + ver (nth 1 aia) + bugrep (nth 2 aia))) + ) + ;; AC_CONFIG_FILES, or AC_OUTPUT lists everything that + ;; should be detected as part of this PROJECT, but not in a + ;; particular TARGET. + (let ((outfiles (cond (aco (list (car aco))) + (t acf)))) + (if (> (length outfiles) 1) + (setq configfiles outfiles) + (setq configfiles (split-string (car outfiles) " " t))) + ) + )) + ) + ;; Else, try the script + ((file-exists-p conf-sh) + (project-am-with-config-current conf-sh + (setq name (project-am-extract-shell-variable "PACKAGE_NAME") + ver (project-am-extract-shell-variable "PACKAGE_VERSION") + ) + )) + ;; Don't know what else.... + (t + nil)) + ;; Return stuff + (list name ver bugrep configfiles) + )) + +(defun project-am-package-info (dir) + "Get the package information for directory topmost project dir over DIR. +Calcultes the info with `project-am-extract-package-info'." + (let ((top (ede-toplevel))) + (when top (setq dir (oref top :directory))) + (project-am-extract-package-info dir))) + +(provide 'ede/project-am) + +;;; ede/project-am.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/cedet/ede/simple.el Sun Sep 20 15:06:05 2009 +0000 @@ -0,0 +1,108 @@ +;;; ede/simple.el --- Overlay an EDE structure on an existing project + +;; Copyright (C) 2007, 2008, 2009 Free Software Foundation, Inc. + +;; Author: Eric M. Ludlam <eric@siege-engine.com> + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; A vast majority of projects use non-EDE project techniques, such +;; as hand written Makefiles, or other IDE's. +;; +;; The EDE-SIMPLE project type allows EDE to wrap an existing mechanism +;; with minimal configuration, and then provides project-root +;; information to Semantic or other tools, and also provides structure +;; information for in-project include header discovery, or speedbar +;; support. +;; +;; It will also support a the minimal EDE UI for compilation and +;; configuration. + +;; @todo - Add support for cpp-root as an ede-simple project. +;; @todo - Allow ede-simple to store locally. + +(require 'ede) +(require 'cedet-files) + +;;; Code: + +(defcustom ede-simple-save-directory "~/.ede" + "*Directory where simple EDE project overlays are saved." + :group 'ede + :type 'directory) + +(defcustom ede-simple-save-file-name "ProjSimple.ede" + "*File name used for simple project wrappers." + :group 'ede + :type 'string) + +(defun ede-simple-projectfile-for-dir (&optional dir) + "Return a full file name to the project file stored in the current directory. +The directory has three parts: + <STORAGE ROOT>/<PROJ DIR AS FILE>/ProjSimple.ede" + (let ((d (or dir default-directory))) + (concat + ;; Storage root + (file-name-as-directory (expand-file-name ede-simple-save-directory)) + ;; Convert directory to filename + (cedet-directory-name-to-file-name d) + ;; Filename + ede-simple-save-file-name) + )) + +(defun ede-simple-load (dir &optional rootproj) + "Load a project of type `Simple' for the directory DIR. +Return nil if there isn't one. +ROOTPROJ is nil, since we will only create a single EDE project here." + (let ((pf (ede-simple-projectfile-for-dir dir)) + (obj nil)) + (when pf + (setq obj (eieio-persistent-read pf)) + (oset obj :directory dir) + ) + obj)) + +(defclass ede-simple-target (ede-target) + () + "EDE Simple project target. +All directories need at least one target.") + +(defclass ede-simple-project (ede-project eieio-persistent) + ((extension :initform ".ede") + (file-header-line :initform ";; EDE Simple Project") + ) + "EDE Simple project class. +Each directory needs a a project file to control it.") + +(defmethod ede-commit-project ((proj ede-simple-project)) + "Commit any change to PROJ to its file." + (when (not (file-exists-p ede-simple-save-directory)) + (if (y-or-n-p (concat ede-simple-save-directory + " doesn't exist. Create? ")) + (make-directory ede-simple-save-directory) + (error "No save directory for new project"))) + (eieio-persistent-save proj)) + +(defmethod ede-find-subproject-for-directory ((proj ede-simple-project) + dir) + "Return PROJ, for handling all subdirs below DIR." + proj) + +(provide 'ede/simple) + +;;; ede/simple.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/cedet/ede/source.el Sun Sep 20 15:06:05 2009 +0000 @@ -0,0 +1,170 @@ +;; ede/source.el --- EDE source code object + +;;; Copyright (C) 2000, 2008 Free Software Foundation, Inc. + +;; Author: Eric M. Ludlam <zappo@gnu.org> +;; Keywords: project, make + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Manage different types of source code. A master list of source code types +;; will be maintained, and used to track target objects, what they accept, +;; and what compilers can be used. + +(require 'eieio-base) + +;;; Code: +(defclass ede-sourcecode (eieio-instance-inheritor) + ((name :initarg :name + :type string + :documentation + "The name of this type of source code. +Such as \"C\" or \"Emacs Lisp\"") + (sourcepattern :initarg :sourcepattern + :initform ".*" + :type string + :documentation + "Emacs regexp matching sourcecode this target accepts.") + (auxsourcepattern :initarg :auxsourcepattern + :initform nil + :type (or null string) + :documentation + "Emacs regexp matching auxiliary source code this target accepts. +Aux source are source code files needed for compilation, which are not compiled +themselves.") + (enable-subdirectories :initarg :enable-subdirectories + :initform nil + :type boolean + :documentation + "Non nil if this sourcecode type uses subdirectories. +If sourcecode always lives near the target creating it, this should be nil. +If sourcecode can, or typically lives in a subdirectory of the owning +target, set this to t.") + (garbagepattern :initarg :garbagepattern + :initform nil + :type list + :documentation + "Shell file regexp matching files considered as garbage. +This is a list of items added to an `rm' command when executing a `clean' +type directive.") + ) + "Description of some type of source code. +Objects will use sourcecode objects to define the types of source +that they are willing to use.") + +(defvar ede-sourcecode-list nil + "The master list of all EDE compilers.") + +;;; Methods +;; +(defmethod initialize-instance :AFTER ((this ede-sourcecode) &rest fields) + "Make sure that all ede compiler objects are cached in +`ede-compiler-list'." + (let ((lst ede-sourcecode-list)) + ;; Find an object of the same name. + (while (and lst (not (string= (oref this name) (oref (car lst) name)))) + (setq lst (cdr lst))) + (if lst + ;; Replace old definition + (setcar lst this) + ;; Add to the beginning of the list. + (setq ede-sourcecode-list (cons this ede-sourcecode-list))))) + +(defmethod ede-want-file-p ((this ede-sourcecode) filename) + "Return non-nil if sourcecode definition THIS will take FILENAME." + (or (ede-want-file-source-p this filename) + (ede-want-file-auxiliary-p this filename))) + +(defmethod ede-want-file-source-p ((this ede-sourcecode) filename) + "Return non-nil if THIS will take FILENAME as an auxiliary ." + (let ((case-fold-search nil)) + (string-match (oref this sourcepattern) filename))) + +(defmethod ede-want-file-auxiliary-p ((this ede-sourcecode) filename) + "Return non-nil if THIS will take FILENAME as an auxiliary ." + (let ((case-fold-search nil)) + (and (slot-boundp this 'auxsourcepattern) + (oref this auxsourcepattern) + (string-match (oref this auxsourcepattern) filename)))) + +(defmethod ede-want-any-source-files-p ((this ede-sourcecode) filenames) + "Return non-nil if THIS will accept any source files in FILENAMES." + (let (found) + (while (and (not found) filenames) + (setq found (ede-want-file-source-p this (pop filenames)))))) + +(defmethod ede-want-any-auxiliary-files-p ((this ede-sourcecode) filenames) + "Return non-nil if THIS will accept any aux files in FILENAMES." + (let (found) + (while (and (not found) filenames) + (setq found (ede-want-file-auxiliary-p this (pop filenames)))))) + +(defmethod ede-want-any-files-p ((this ede-sourcecode) filenames) + "Return non-nil if THIS will accept any files in FILENAMES." + (let (found) + (while (and (not found) filenames) + (setq found (ede-want-file-p this (pop filenames)))))) + +(defmethod ede-buffer-header-file ((this ede-sourcecode) filename) + "Return a list of file names of header files for THIS with FILENAME. +Used to guess header files, but uses the auxsource regular expression." + (let ((dn (file-name-directory filename)) + (ts (file-name-sans-extension (file-name-nondirectory filename))) + (ae (oref this auxsourcepattern))) + (if (not ae) + nil + (directory-files dn t (concat (regexp-quote ts) ae))))) + +;;; Utility functions +;; +(when nil + ;; not used at the moment. +(defun ede-source-find (name) + "Find the sourcecode object based on NAME." + (object-assoc name :name ede-sourcecode-list)) + +(defun ede-source-match (file) + "Find the list of soucecode objects which matches FILE." + (let ((lst ede-sourcecode-list) + (match nil)) + (while lst + ;; ede-file-mine doesn't exist yet + (if (ede-file-mine (car lst) file) + (setq match (cons (car lst) match))) + (setq lst (cdr lst))) + match)) +) +;;; Master list of source code types +;; +;; This must appear at the end so that the init method will work. +(defvar ede-source-scheme + (ede-sourcecode "ede-source-scheme" + :name "Scheme" + :sourcepattern "\\.scm$") + "Scheme source code definition.") + +;;(defvar ede-source- +;; (ede-sourcecode "ede-source-" +;; :name "" +;; :sourcepattern "\\.$" +;; :garbagepattern '("*.")) +;; " source code definition.") + +(provide 'ede/source) + +;;; ede/source.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/cedet/ede/speedbar.el Sun Sep 20 15:06:05 2009 +0000 @@ -0,0 +1,353 @@ +;;; ede/speedbar.el --- Speedbar viewing of EDE projects + +;;; Copyright (C) 1998, 1999, 2000, 2001, 2003, 2005, 2007, 2008, 2009 +;;; Free Software Foundation, Inc. + +;; Author: Eric M. Ludlam <zappo@gnu.org> +;; Keywords: project, make, tags + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; Display a project's hierarchy in speedbar. +;; + +;;; Code: +(require 'speedbar) +(require 'eieio-speedbar) +(require 'ede) + +;;; Speedbar support mode +;; +(defvar ede-speedbar-key-map nil + "A Generic object based speedbar display keymap.") + +(defun ede-speedbar-make-map () + "Make the generic object based speedbar keymap." + (setq ede-speedbar-key-map (speedbar-make-specialized-keymap)) + + ;; General viewing things + (define-key ede-speedbar-key-map "\C-m" 'speedbar-edit-line) + (define-key ede-speedbar-key-map "+" 'speedbar-expand-line) + (define-key ede-speedbar-key-map "=" 'speedbar-expand-line) + (define-key ede-speedbar-key-map "-" 'speedbar-contract-line) + (define-key ede-speedbar-key-map " " 'speedbar-toggle-line-expansion) + + ;; Some object based things + (define-key ede-speedbar-key-map "C" 'eieio-speedbar-customize-line) + + ;; Some project based things + (define-key ede-speedbar-key-map "R" 'ede-speedbar-remove-file-from-target) + (define-key ede-speedbar-key-map "b" 'ede-speedbar-compile-line) + (define-key ede-speedbar-key-map "B" 'ede-speedbar-compile-project) + (define-key ede-speedbar-key-map "D" 'ede-speedbar-make-distribution) + (define-key ede-speedbar-key-map "E" 'ede-speedbar-edit-projectfile) + ) + +(defvar ede-speedbar-menu + '([ "Compile" ede-speedbar-compile-line t] + [ "Compile Project" ede-speedbar-compile-project + (ede-project-child-p (speedbar-line-token)) ] + "---" + [ "Edit File/Tag" speedbar-edit-line + (not (eieio-object-p (speedbar-line-token)))] + [ "Expand" speedbar-expand-line + (save-excursion (beginning-of-line) + (looking-at "[0-9]+: *.\\+. "))] + [ "Contract" speedbar-contract-line + (save-excursion (beginning-of-line) + (looking-at "[0-9]+: *.-. "))] + "---" + [ "Remove File from Target" ede-speedbar-remove-file-from-target + (stringp (speedbar-line-token)) ] + [ "Customize Project/Target" eieio-speedbar-customize-line + (eieio-object-p (speedbar-line-token)) ] + [ "Edit Project File" ede-speedbar-edit-projectfile t] + [ "Make Distribution" ede-speedbar-make-distribution + (ede-project-child-p (speedbar-line-token)) ] + ) + "Menu part in easymenu format used in speedbar while browsing objects.") + +(eieio-speedbar-create 'ede-speedbar-make-map + 'ede-speedbar-key-map + 'ede-speedbar-menu + "Project" + 'ede-speedbar-toplevel-buttons) + + +(defun ede-speedbar () + "EDE development environment project browser for speedbar." + (interactive) + (speedbar-frame-mode 1) + (speedbar-change-initial-expansion-list "Project") + (speedbar-get-focus) + ) + +(defun ede-speedbar-toplevel-buttons (dir) + "Return a list of objects to display in speedbar. +Argument DIR is the directory from which to derive the list of objects." + ede-projects + ) + +;;; Some special commands useful in EDE +;; +(defun ede-speedbar-remove-file-from-target () + "Remove the file at point from it's target." + (interactive) + (if (stringp (speedbar-line-token)) + (progn + (speedbar-edit-line) + (ede-remove-file)))) + +(defun ede-speedbar-compile-line () + "Compile/Build the project or target on this line." + (interactive) + (let ((obj (eieio-speedbar-find-nearest-object))) + (if (not (eieio-object-p obj)) + nil + (cond ((obj-of-class-p obj ede-project) + (project-compile-project obj)) + ((obj-of-class-p obj ede-target) + (project-compile-target obj)) + (t (error "Error in speedbar structure")))))) + +(defun ede-speedbar-get-top-project-for-line () + "Return a project object for this line." + (interactive) + (let ((obj (eieio-speedbar-find-nearest-object))) + (if (not (eieio-object-p obj)) + (error "Error in speedbar or ede structure") + (if (obj-of-class-p obj ede-target) + (setq obj (ede-target-parent obj))) + (if (obj-of-class-p obj ede-project) + obj + (error "Error in speedbar or ede structure"))))) + +(defun ede-speedbar-compile-project () + "Compile/Build the project which owns this line." + (interactive) + (project-compile-project (ede-speedbar-get-top-project-for-line))) + +(defun ede-speedbar-compile-file-project () + "Compile/Build the target which the current file belongs to." + (interactive) + (let* ((file (speedbar-line-file)) + (buf (find-file-noselect file)) + (bwin (get-buffer-window buf 0))) + (if bwin + (progn + (select-window bwin) + (raise-frame (window-frame bwin))) + (dframe-select-attached-frame speedbar-frame) + (set-buffer buf) + (ede-compile-target)))) + +(defun ede-speedbar-make-distribution () + "Edit the project file based on this line." + (interactive) + (project-make-dist (ede-speedbar-get-top-project-for-line))) + +(defun ede-speedbar-edit-projectfile () + "Edit the project file based on this line." + (interactive) + (project-edit-file-target (ede-speedbar-get-top-project-for-line))) + +;;; Speedbar Project Methods +;; +(defun ede-find-nearest-file-line () + "Go backwards until we find a file." + (save-excursion + (beginning-of-line) + (looking-at "^\\([0-9]+\\):") + (let ((depth (string-to-number (match-string 1)))) + (while (not (re-search-forward "[]] [^ ]" + (save-excursion (end-of-line) + (point)) + t)) + (re-search-backward (format "^%d:" (1- depth))) + (setq depth (1- depth))) + (speedbar-line-token)))) + +(defmethod eieio-speedbar-derive-line-path ((obj ede-project) &optional depth) + "Return the path to OBJ. +Optional DEPTH is the depth we start at." + (file-name-directory (oref obj file)) + ) + +(defmethod eieio-speedbar-derive-line-path ((obj ede-target) &optional depth) + "Return the path to OBJ. +Optional DEPTH is the depth we start at." + (let ((proj (ede-target-parent obj))) + ;; Check the type of line we are currently on. + ;; If we are on a child, we need a file name too. + (save-excursion + (let ((lt (speedbar-line-token))) + (if (or (eieio-object-p lt) (stringp lt)) + (eieio-speedbar-derive-line-path proj) + ;; a child element is a token. Do some work to get a filename too. + (concat (eieio-speedbar-derive-line-path proj) + (ede-find-nearest-file-line))))))) + +(defmethod eieio-speedbar-description ((obj ede-project)) + "Provide a speedbar description for OBJ." + (ede-description obj)) + +(defmethod eieio-speedbar-description ((obj ede-target)) + "Provide a speedbar description for OBJ." + (ede-description obj)) + +(defmethod eieio-speedbar-child-description ((obj ede-target)) + "Provide a speedbar description for a plain-child of OBJ. +A plain child is a child element which is not an EIEIO object." + (or (speedbar-item-info-file-helper) + (speedbar-item-info-tag-helper))) + +(defmethod eieio-speedbar-object-buttonname ((object ede-project)) + "Return a string to use as a speedbar button for OBJECT." + (if (ede-parent-project object) + (ede-name object) + (concat (ede-name object) " " (oref object version)))) + +(defmethod eieio-speedbar-object-buttonname ((object ede-target)) + "Return a string to use as a speedbar button for OBJECT." + (ede-name object)) + +(defmethod eieio-speedbar-object-children ((this ede-project)) + "Return the list of speedbar display children for THIS." + (condition-case nil + (with-slots (subproj targets) this + (append subproj targets)) + (error nil))) + +(defmethod eieio-speedbar-object-children ((this ede-target)) + "Return the list of speedbar display children for THIS." + (oref this source)) + +(defmethod eieio-speedbar-child-make-tag-lines ((this ede-target) depth) + "Create a speedbar tag line for a child of THIS. +It has depth DEPTH." + (with-slots (source) this + (mapcar (lambda (car) + (speedbar-make-tag-line 'bracket ?+ + 'speedbar-tag-file + car + car + 'ede-file-find + car + 'speedbar-file-face depth)) + source))) + +;;; Generic file management for TARGETS +;; +(defun ede-file-find (text token indent) + "Find the file TEXT at path TOKEN. +INDENT is the current indentation level." + (speedbar-find-file-in-frame + (expand-file-name token (speedbar-line-directory indent))) + (speedbar-maybee-jump-to-attached-frame)) + +(defun ede-create-tag-buttons (filename indent) + "Create the tag buttons associated with FILENAME at INDENT." + (let* ((lst (speedbar-fetch-dynamic-tags filename))) + ;; if no list, then remove expando button + (if (not lst) + (speedbar-change-expand-button-char ??) + (speedbar-with-writable + ;; We must do 1- because indent was already incremented. + (speedbar-insert-generic-list (1- indent) + lst + 'ede-tag-expand + 'ede-tag-find))))) + +(defun ede-tag-expand (text token indent) + "Expand a tag sublist. Imenu will return sub-lists of specialized tag types. +Etags does not support this feature. TEXT will be the button +string. TOKEN will be the list, and INDENT is the current indentation +level." + (cond ((string-match "+" text) ;we have to expand this file + (speedbar-change-expand-button-char ?-) + (speedbar-with-writable + (save-excursion + (end-of-line) (forward-char 1) + (speedbar-insert-generic-list indent token + 'ede-tag-expand + 'ede-tag-find)))) + ((string-match "-" text) ;we have to contract this node + (speedbar-change-expand-button-char ?+) + (speedbar-delete-subblock indent)) + (t (error "Ooops... not sure what to do"))) + (speedbar-center-buffer-smartly)) + +(defun ede-tag-find (text token indent) + "For the tag TEXT in a file TOKEN, goto that position. +INDENT is the current indentation level." + (let ((file (ede-find-nearest-file-line))) + (speedbar-find-file-in-frame file) + (save-excursion (speedbar-stealthy-updates)) + ;; Reset the timer with a new timeout when cliking a file + ;; in case the user was navigating directories, we can cancel + ;; that other timer. +; (speedbar-set-timer speedbar-update-speed) + (goto-char token) + (run-hooks 'speedbar-visiting-tag-hook) + ;;(recenter) + (speedbar-maybee-jump-to-attached-frame) + )) + +;;; EDE and the speedbar FILE display +;; +;; This will add a couple keybindings and menu items into the +;; FILE display for speedbar. + +(defvar ede-speedbar-file-menu-additions + '("----" + ["Create EDE Target" ede-new-target (ede-current-project) ] + ["Add to project" ede-speedbar-file-add-to-project (ede-current-project) ] + ["Compile project" ede-speedbar-compile-project (ede-current-project) ] + ["Compile file target" ede-speedbar-compile-file-target (ede-current-project) ] + ["Make distribution" ede-make-dist (ede-current-project) ] + ) + "Set of menu items to splice into the speedbar menu.") + +(defvar ede-speedbar-file-keymap + (let ((km (make-sparse-keymap))) + (define-key km "a" 'ede-speedbar-file-add-to-project) + (define-key km "t" 'ede-new-target) + (define-key km "s" 'ede-speedbar) + (define-key km "C" 'ede-speedbar-compile-project) + (define-key km "c" 'ede-speedbar-compile-file-target) + (define-key km "d" 'ede-make-dist) + km) + "Keymap spliced into the speedbar keymap.") + +(defun ede-speedbar-file-setup () + "Setup some keybindings in the Speedbar File display." + (setq speedbar-easymenu-definition-special + (append speedbar-easymenu-definition-special + ede-speedbar-file-menu-additions + )) + (define-key speedbar-file-key-map "." ede-speedbar-file-keymap) + ;; Finally, if the FILES mode is loaded, force a refresh + ;; of the menus and such. + (when (and (string= speedbar-initial-expansion-list-name "files") + (buffer-live-p speedbar-buffer) + ) + (speedbar-change-initial-expansion-list "files"))) + +(provide 'ede/speedbar) + +;;; ede/speedbar.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/cedet/ede/system.el Sun Sep 20 15:06:05 2009 +0000 @@ -0,0 +1,137 @@ +;;; ede-system.el --- EDE working with the system (VC, FTP, ETC) + +;;; Copyright (C) 2001, 2002, 2003 Free Software Foundation, Inc. + +;; Author: Eric M. Ludlam <zappo@gnu.org> +;; Keywords: project, make, vc + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; EDE system contains some routines to work with EDE projects saved in +;; CVS repositories, and services such as sourceforge which lets you +;; perform releases via FTP. + +(require 'ede) + +;;; Code: + +;;; Web/FTP site node. +;; +(defun ede-web-browse-home () + "Browse the home page of the current project." + (interactive) + (if (not (ede-toplevel)) + (error "No project")) + (let ((home (oref (ede-toplevel) web-site-url))) + (if (string= "" home) + (error "Now URL is stored in this project")) + (require 'browse-url) + (browse-url home) + )) + + +(defun ede-edit-web-page () + "Edit the web site for this project." + (interactive) + (let* ((toplevel (ede-toplevel)) + (dir (oref toplevel web-site-directory)) + (file (oref toplevel web-site-file)) + (endfile (concat (file-name-as-directory dir) file))) + (if (string-match "^/r[:@]" endfile) + (require 'tramp)) + (when (not (file-exists-p endfile)) + (setq endfile file) + (if (string-match "^/r[:@]" endfile) + (require 'tramp)) + (if (not (file-exists-p endfile)) + (error "No project file found"))) + (find-file endfile))) + + +(defun ede-upload-distribution () + "Upload the current distribution to the correct location. +Use /user@ftp.site.com: file names for FTP sites. +Download tramp, and use /r:machine: for names on remote sites w/out FTP access." + (interactive) + (let* ((files (project-dist-files (ede-toplevel))) + (upload (if (string= (oref (ede-toplevel) ftp-upload-site) "") + (oref (ede-toplevel) ftp-site) + (oref (ede-toplevel) ftp-upload-site)))) + (when (or (string= upload "") + (not (file-exists-p upload))) + (error "Upload directory %S does not exist" upload)) + (while files + (let ((localfile (concat (file-name-directory (oref (ede-toplevel) file)) + (car files)))) + (if (not (file-exists-p localfile)) + (progn + (message "File %s does not exist yet. Building a distribution" + localfile) + (ede-make-dist) + (error "File %s does not exist yet. Building a distribution" + localfile) + )) + (setq upload + (concat (directory-file-name upload) + "/" + (file-name-nondirectory localfile))) + (copy-file localfile upload) + (setq files (cdr files))))) + (message "Done uploading files...") + ) + +(defun ede-upload-html-documentation () + "Upload the current distributions documentation as HTML. +Use /user@ftp.site.com: file names for FTP sites. +Download tramp, and use /r:machine: for names on remote sites w/out FTP access." + (interactive) + (let* ((files nil) ;(ede-html-doc-files (ede-toplevel))) + (upload (if (string= (oref (ede-toplevel) ftp-upload-site) "") + (oref (ede-toplevel) ftp-site) + (oref (ede-toplevel) ftp-upload-site)))) + (when (or (string= upload "") + (not (file-exists-p upload))) + (error "Upload directory %S does not exist" upload)) + (while files + (let ((localfile (concat (file-name-directory (oref (ede-toplevel) file)) + (car files)))) + (if (not (file-exists-p localfile)) + (progn + (message "File %s does not exist yet. Building a distribution" + localfile) + ;;(project-compile-target ... ) + (error "File %s does not exist yet. Building a distribution" + localfile) + )) + (copy-file localfile upload) + (setq files (cdr files))))) + (message "Done uploading files...") + ) + +;;; Version Control +;; +;; Do a few nice things with Version control systems. +(defun ede-vc-project-directory () + "Run `vc-dir' on the current project." + (interactive) + (let ((top (ede-toplevel-project-or-nil default-directory))) + (vc-dir top nil))) + +(provide 'ede/system) + +;;; ede/system.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/cedet/ede/util.el Sun Sep 20 15:06:05 2009 +0000 @@ -0,0 +1,106 @@ +;;; ede/util.el --- EDE utilities + +;;; Copyright (C) 2000, 2005 Free Software Foundation, Inc. + +;; Author: Eric M. Ludlam <zappo@gnu.org> +;; Keywords: project, make + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; Utilities that may not require project specific help, and oporate +;; on generic EDE structures. Provide user level commands for activities +;; not directly related to source code organization or makefile generation. + +(require 'ede) + +;;; Code: + +;;; Updating the version of a project. +;;;###autoload +(defun ede-update-version (newversion) + "Update the current projects main version number. +Argument NEWVERSION is the version number to use in the current project." + (interactive (list (let* ((o (ede-toplevel)) + (v (oref o version))) + (read-string (format "Update Version (was %s): " v) + v nil v)))) + (let ((ede-object (ede-toplevel))) + ;; Don't update anything if there was no change. + (unless (string= (oref ede-object :version) newversion) + (oset ede-object :version newversion) + (project-update-version ede-object) + (ede-update-version-in-source ede-object newversion)))) + +(defmethod project-update-version ((ot ede-project)) + "The :version of the project OT has been updated. +Handle saving, or other detail." + (error "project-update-version not supported by %s" (object-name ot))) + +(defmethod ede-update-version-in-source ((this ede-project) version) + "Change occurrences of a version string in sources. +In project THIS, cycle over all targets to give them a chance to set +their sources to VERSION." + (ede-map-targets this (lambda (targ) + (ede-update-version-in-source targ version)))) + +(defmethod ede-update-version-in-source ((this ede-target) version) + "In sources for THIS, change version numbers to VERSION." + (if (and (slot-boundp this 'versionsource) + (oref this versionsource)) + (let ((vs (oref this versionsource))) + (while vs + (save-excursion + (set-buffer (find-file-noselect + (ede-expand-filename this (car vs)))) + (goto-char (point-min)) + (let ((case-fold-search t)) + (if (re-search-forward "version:\\s-*\\([^ \t\n]+\\)" nil t) + (progn + (save-match-data + (ede-make-buffer-writable)) + (delete-region (match-beginning 1) + (match-end 1)) + (goto-char (match-beginning 1)) + (insert version))))) + (setq vs (cdr vs)))))) + +;;; Writable files +;; +;; Utils for EDE when it needs to write a file that could be covered by a +;; version control system. +(defun ede-make-buffer-writable (&optional buffer) + "Make sure that BUFFER is writable. +If BUFFER isn't specified, use the current buffer." + (save-excursion + (if buffer (set-buffer buffer)) + (if buffer-read-only + (if (and vc-mode + (y-or-n-p (format "Check out %s? " (buffer-file-name)))) + (vc-toggle-read-only) + (if (not vc-mode) + (toggle-read-only -1)))))) + +(provide 'ede/util) + +;; Local variables: +;; generated-autoload-file: "loaddefs.el" +;; generated-autoload-feature: ede/loaddefs +;; generated-autoload-load-name: "ede/util" +;; End: + +;;; ede/util.el ends here
--- a/lisp/cedet/semantic/symref/filter.el Sun Sep 20 14:22:30 2009 +0000 +++ b/lisp/cedet/semantic/symref/filter.el Sun Sep 20 15:06:05 2009 +0000 @@ -34,11 +34,13 @@ ;;; Code: (require 'semantic) +(require 'semantic/analyze) (declare-function srecode-active-template-region "srecode/fields") (declare-function srecode-delete "srecode/fields") (declare-function srecode-field "srecode/fields") (declare-function srecode-template-inserted-region "srecode/fields") (declare-function srecode-overlaid-activate "srecode/fields") +(declare-function semantic-idle-summary-useful-context-p "semantic/idle") ;;; FILTERS ;; @@ -65,6 +67,7 @@ ( START END PREFIX ) Search occurs in the current buffer between START and END." + (require 'semantic/idle) (save-excursion (goto-char start) (let* ((str (semantic-tag-name target))