mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-12-21 10:24:55 +00:00
fae4e5b9f5
(autoload-rubric): Don't use any more. * cedet/semantic/fw.el (semantic/loaddefs): * cedet/srecode.el (srecode/loaddefs): * cedet/ede.el (ede/loaddefs): Load rather than require. * lisp/cedet/ede/cpp-root.el: * lisp/cedet/ede/emacs.el: * lisp/cedet/ede/files.el: * lisp/cedet/ede/linux.el: * lisp/cedet/ede/locate.el: * lisp/cedet/ede/make.el: * lisp/cedet/ede/shell.el: * lisp/cedet/ede/speedbar.el: * lisp/cedet/ede/system.el: * lisp/cedet/ede/util.el: * lisp/cedet/semantic/analyze.el: * lisp/cedet/semantic/bovine.el: * lisp/cedet/semantic/complete.el: * lisp/cedet/semantic/ctxt.el: * lisp/cedet/semantic/db-file.el: * lisp/cedet/semantic/db-find.el: * lisp/cedet/semantic/db-global.el: * lisp/cedet/semantic/db-mode.el: * lisp/cedet/semantic/db-typecache.el: * lisp/cedet/semantic/db.el: * lisp/cedet/semantic/debug.el: * lisp/cedet/semantic/dep.el: * lisp/cedet/semantic/doc.el: * lisp/cedet/semantic/edit.el: * lisp/cedet/semantic/find.el: * lisp/cedet/semantic/format.el: * lisp/cedet/semantic/html.el: * lisp/cedet/semantic/ia-sb.el: * lisp/cedet/semantic/ia.el: * lisp/cedet/semantic/idle.el: * lisp/cedet/semantic/lex-spp.el: * lisp/cedet/semantic/lex.el: * lisp/cedet/semantic/mru-bookmark.el: * lisp/cedet/semantic/scope.el: * lisp/cedet/semantic/senator.el: * lisp/cedet/semantic/sort.el: * lisp/cedet/semantic/symref.el: * lisp/cedet/semantic/tag-file.el: * lisp/cedet/semantic/tag-ls.el: * lisp/cedet/semantic/tag-write.el: * lisp/cedet/semantic/tag.el: * lisp/cedet/semantic/util-modes.el: * lisp/cedet/semantic/analyze/complete.el: * lisp/cedet/semantic/analyze/refs.el: * lisp/cedet/semantic/bovine/c.el: * lisp/cedet/semantic/bovine/gcc.el: * lisp/cedet/semantic/bovine/make.el: * lisp/cedet/semantic/bovine/scm.el: * lisp/cedet/semantic/decorate/include.el: * lisp/cedet/semantic/decorate/mode.el: * lisp/cedet/semantic/symref/cscope.el: * lisp/cedet/semantic/symref/global.el: * lisp/cedet/semantic/symref/grep.el: * lisp/cedet/semantic/symref/idutils.el: * lisp/cedet/semantic/symref/list.el: * lisp/cedet/semantic/wisent/java-tags.el: * lisp/cedet/semantic/wisent/javascript.el: * lisp/cedet/srecode/compile.el: * lisp/cedet/srecode/cpp.el: * lisp/cedet/srecode/document.el: * lisp/cedet/srecode/el.el: * lisp/cedet/srecode/expandproto.el: * lisp/cedet/srecode/getset.el: * lisp/cedet/srecode/insert.el: * lisp/cedet/srecode/java.el: * lisp/cedet/srecode/map.el: * lisp/cedet/srecode/mode.el: * lisp/cedet/srecode/template.el: * lisp/cedet/srecode/texi.el: Remove the file-local setting of generated-autoload-feature.
2001 lines
69 KiB
EmacsLisp
2001 lines
69 KiB
EmacsLisp
;;; 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 'cedet)
|
||
(require 'eieio)
|
||
(require 'eieio-speedbar)
|
||
(require 'ede/source)
|
||
(load "ede/loaddefs" nil 'nomessage)
|
||
|
||
(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 should 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 vectors 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)) ]
|
||
)
|
||
[ "Run target" ede-run-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)
|
||
("R" . ede-run-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
|
||
(locate-user-emacs-file "ede-projects.el" ".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-map
|
||
(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)
|
||
(define-key pmap "R" 'ede-run-target)
|
||
;; bind our submap into map
|
||
(define-key map "\C-c." pmap)
|
||
map)
|
||
"Keymap used in project minor mode.")
|
||
|
||
(defvar global-ede-mode-map
|
||
(let ((map (make-sparse-keymap)))
|
||
(define-key map [menu-bar cedet-menu]
|
||
(cons "Development" cedet-menu-map))
|
||
map)
|
||
"Keymap used in `global-ede-mode'.")
|
||
|
||
;; Activate the EDE items in cedet-menu-map
|
||
|
||
(define-key cedet-menu-map [ede-find-file]
|
||
'(menu-item "Find File in Project..." ede-find-file :enable ede-object
|
||
:visible global-ede-mode))
|
||
(define-key cedet-menu-map [ede-speedbar]
|
||
'(menu-item "View Project Tree" ede-speedbar :enable ede-object
|
||
:visible global-ede-mode))
|
||
(define-key cedet-menu-map [ede]
|
||
'(menu-item "Load Project" ede
|
||
:visible global-ede-mode))
|
||
(define-key cedet-menu-map [ede-new]
|
||
'(menu-item "Create Project" ede-new
|
||
:enable (not ede-object)
|
||
:visible global-ede-mode))
|
||
(define-key cedet-menu-map [ede-target-options]
|
||
'(menu-item "Target Options" ede-target-options
|
||
:filter ede-target-forms-menu
|
||
:visible global-ede-mode))
|
||
(define-key cedet-menu-map [ede-project-options]
|
||
'(menu-item "Project Options" ede-project-options
|
||
:filter ede-project-forms-menu
|
||
:visible global-ede-mode))
|
||
(define-key cedet-menu-map [ede-build-forms-menu]
|
||
'(menu-item "Build Project" ede-build-forms-menu
|
||
:filter ede-build-forms-menu
|
||
:enable ede-object
|
||
:visible global-ede-mode))
|
||
|
||
(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)
|
||
(eval (cons '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
|
||
(and (ede-current-project)
|
||
(oref (ede-current-project) targets)) ]
|
||
[ "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 obj
|
||
(setq targ (when (slot-boundp obj 'targets)
|
||
(oref obj targets)))
|
||
;; 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)))
|
||
|
||
(define-minor-mode ede-minor-mode
|
||
"Toggle EDE (Emacs Development Environment) minor mode.
|
||
With non-nil argument ARG, enable EDE minor mode if ARG is
|
||
positive; otherwise, disable it.
|
||
|
||
If this file is contained, or could be contained in an EDE
|
||
controlled project, then this mode is activated automatically
|
||
provided `global-ede-mode' is enabled."
|
||
:group 'ede
|
||
(cond ((or (eq major-mode 'dired-mode)
|
||
(eq major-mode 'vc-dired-mode))
|
||
(ede-dired-minor-mode (if ede-minor-mode 1 -1)))
|
||
(ede-minor-mode
|
||
(if (and (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.
|
||
(ede-minor-mode -1)))))
|
||
|
||
(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
|
||
(define-minor-mode global-ede-mode
|
||
"Toggle global EDE (Emacs Development Environment) mode.
|
||
With non-nil argument ARG, enable global EDE mode if ARG is
|
||
positive; otherwise, disable it.
|
||
|
||
This global minor mode enables `ede-minor-mode' in all buffers in
|
||
an EDE controlled project."
|
||
:global t
|
||
:group 'ede
|
||
(if global-ede-mode
|
||
;; Turn on global-ede-mode
|
||
(progn
|
||
(if semantic-mode
|
||
(define-key cedet-menu-map [cedet-menu-separator] '("--")))
|
||
(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)
|
||
(ede-reset-all-buffers 1))
|
||
;; Turn off global-ede-mode
|
||
(define-key cedet-menu-map [cedet-menu-separator] nil)
|
||
(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 -1)))
|
||
|
||
(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-existent 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 associated target."
|
||
(interactive)
|
||
(ede-invoke-method 'project-debug-target))
|
||
|
||
(defun ede-run-target ()
|
||
"Debug the current buffer's assocated target."
|
||
(interactive)
|
||
(ede-invoke-method 'project-run-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-run-target ((obj ede-target))
|
||
"Run the current project target OBJ."
|
||
(error "run-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."
|
||
(with-current-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."
|
||
(with-current-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."
|
||
(with-current-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
|
||
(with-current-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
|
||
(with-current-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 controlled by an EDE object."
|
||
(let ((bl (buffer-list))
|
||
(pl nil))
|
||
(while bl
|
||
(with-current-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 controlled 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."
|
||
(eval (cons '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)))
|
||
(dolist (b (ede-project-buffers project))
|
||
(with-current-buffer b
|
||
(make-local-variable variable)))))
|
||
|
||
(defmethod ede-set-project-variables ((project ede-project) &optional buffer)
|
||
"Set variables local to PROJECT in BUFFER."
|
||
(if (not buffer) (setq buffer (current-buffer)))
|
||
(with-current-buffer buffer
|
||
(dolist (v (oref project local-variables))
|
||
(make-local-variable (car v))
|
||
;; set it's value here?
|
||
(set (car v) (cdr v)))))
|
||
|
||
(defun ede-set (variable value &optional proj)
|
||
"Set the project local VARIABLE to VALUE.
|
||
If VARIABLE is not project local, just use set. Optional argument PROJ
|
||
is the project to use, instead of `ede-current-project'."
|
||
(let ((p (or proj (ede-current-project)))
|
||
a)
|
||
(if (and p (setq a (assoc variable (oref p local-variables))))
|
||
(progn
|
||
(setcdr a value)
|
||
(dolist (b (ede-project-buffers p))
|
||
(with-current-buffer b
|
||
(set variable value))))
|
||
(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))
|
||
|
||
|
||
;;; 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))))
|
||
|
||
(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))
|
||
|
||
;; arch-tag: 0e1e0eba-484f-4119-abdb-30951f725705
|
||
;;; ede.el ends here
|