(declare-function ede-directory-safe-p "ede")
(declare-function ede-add-project-to-global-list "ede")
+(defclass ede-project-autoload-dirmatch ()
+ ((fromconfig :initarg :fromconfig
+ :initform nil
+ :documentation
+ "A config file within which the match pattern lives.")
+ (configregex :initarg :configregex
+ :initform nil
+ :documentation
+ "A regexp to identify the dirmatch pattern.")
+ (configregexidx :initarg :configregexidx
+ :initform nil
+ :documentation
+ "An index into the match-data of `configregex'.")
+ (configdatastash :initform nil
+ :documentation
+ "Save discovered match string.")
+ )
+ "Support complex matches for projects that live in named directories.
+For most cases, a simple string is sufficient. If, however, a project
+location is varied dependent on other complex criteria, this class
+can be used to define that match without loading the specific project
+into memory.")
+
+(defmethod ede-dirmatch-installed ((dirmatch ede-project-autoload-dirmatch))
+ "Return non-nil if the tool DIRMATCH might match is installed on the system."
+ (let ((fc (oref dirmatch fromconfig)))
+
+ (cond
+ ;; If the thing to match is stored in a config file.
+ ((stringp fc)
+ (file-exists-p fc))
+
+ ;; Add new types of dirmatches here.
+
+ ;; Error for wierd stuff
+ (t (error "Unknown dirmatch type.")))))
+
+
+(defmethod ede-do-dirmatch ((dirmatch ede-project-autoload-dirmatch) file)
+ "Does DIRMATCH match the filename FILE."
+ (let ((fc (oref dirmatch fromconfig)))
+
+ (cond
+ ;; If the thing to match is stored in a config file.
+ ((stringp fc)
+ (when (file-exists-p fc)
+ (let ((matchstring (oref dirmatch configdatastash)))
+ (unless matchstring
+ (save-current-buffer
+ (let* ((buff (get-file-buffer fc))
+ (readbuff
+ (let ((find-file-hook nil)) ;; Disable ede from recursing
+ (find-file-noselect fc))))
+ (set-buffer readbuff)
+ (save-excursion
+ (goto-char (point-min))
+ (when (re-search-forward (oref dirmatch configregex) nil t)
+ (setq matchstring
+ (match-string (or (oref dirmatch configregexidx) 0)))))
+ (if (not buff) (kill-buffer readbuff))))
+ ;; Save what we find in our cache.
+ (oset dirmatch configdatastash matchstring))
+ ;; Match against our discovered string
+ (and matchstring (string-match (regexp-quote matchstring) file))
+ )))
+
+ ;; Add new matches here
+ ;; ((stringp somenewslot ...)
+ ;; )
+
+ ;; Error if none others known
+ (t
+ (error "Unknown dirmatch object match style.")))
+ ))
+
+(declare-function ede-directory-safe-p "ede")
+(declare-function ede-add-project-to-global-list "ede")
+
(defclass ede-project-autoload ()
((name :initarg :name
:documentation "Name of this project type")
:documentation "The lisp file belonging to this class.")
(proj-file :initarg :proj-file
:documentation "Name of a project file of this type.")
+ (proj-root-dirmatch :initarg :proj-root-dirmatch
+ :initform ""
+ :type (or string ede-project-autoload-dirmatch)
+ :documentation
+ "To avoid loading a project, check if the directory matches this.
+For projects that use directory name matches, a function would load that project.
+Specifying this matcher will allow EDE to check without loading the project.")
(proj-root :initarg :proj-root
:type function
:documentation "A function symbol to call for the project root.
:documentation "Fn symbol used to load this project file.")
(class-sym :initarg :class-sym
:documentation "Symbol representing the project class to use.")
+ (generic-p :initform nil
+ :documentation
+ "Generic projects are added to the project list at the end.
+The add routine will set this to non-nil so that future non-generic placement will
+be successful.")
(new-p :initarg :new-p
:initform t
:documentation
:proj-file "Makefile.am"
:load-type 'project-am-load
:class-sym 'project-am-makefile
- :new-p nil))
+ :new-p nil
+ :safe-p t)
+ )
"List of vectors defining how to determine what type of projects exist.")
(put 'ede-project-class-files 'risky-local-variable t)
+(defun ede-add-project-autoload (projauto &optional flag)
+ "Add PROJAUTO, an EDE autoload definition to `ede-project-class-files'.
+Optional argument FLAG indicates how this autoload should be
+added. Possible values are:
+ 'generic - A generic project type. Keep this at the very end.
+ 'unique - A unique project type for a specific project. Keep at the very
+ front of the list so more generic projects don't get priority."
+ ;; First, can we identify PROJAUTO as already in the list? If so, replace.
+ (let ((projlist ede-project-class-files)
+ (projname (object-name-string projauto)))
+ (while (and projlist (not (string= (object-name-string (car projlist)) projname)))
+ (setq projlist (cdr projlist)))
+
+ (if projlist
+ ;; Stick the new one into the old slot.
+ (setcar projlist projauto)
+
+ ;; Else, see where to insert it.
+ (cond ((and flag (eq flag 'unique))
+ ;; Unique items get stuck right onto the front.
+ (setq ede-project-class-files
+ (cons projauto ede-project-class-files)))
+
+ ;; Generic Projects go at the very end of the list.
+ ((and flag (eq flag 'generic))
+ (oset projauto generic-p t)
+ (setq ede-project-class-files
+ (append ede-project-class-files
+ (list projauto))))
+
+ ;; Normal projects go at the end of the list, but
+ ;; before the generic projects.
+ (t
+ (let ((prev nil)
+ (next ede-project-class-files))
+ (while (and next (not (oref (car next) generic-p)))
+ (setq prev next
+ next (cdr next)))
+ (when (not prev)
+ (error "ede-project-class-files not initialized"))
+ ;; Splice into the list.
+ (setcdr prev (cons projauto next))))))))
+
;;; EDE project-autoload methods
;;
(defmethod ede-project-root ((this ede-project-autoload))
Allows for one-project-object-for-a-tree type systems."
nil)
+(defun ede-project-dirmatch-p (file dirmatch)
+ "Return non-nil if FILE matches DIRMATCH.
+DIRMATCH could be nil (no match), a string (regexp match),
+or an `ede-project-autoload-dirmatch' object."
+ ;; If dirmatch is a string, then we simply match it against
+ ;; the file we are testing.
+ (if (stringp dirmatch)
+ (string-match dirmatch file)
+ ;; if dirmatch is instead a dirmatch object, we test against
+ ;; that object instead.
+ (if (ede-project-autoload-dirmatch-p dirmatch)
+ (ede-do-dirmatch dirmatch file)
+ (error "Unknown project directory match type."))
+ ))
+
(defmethod ede-project-root-directory ((this ede-project-autoload)
&optional file)
"If a project knows its root, return it here.
(when (not file)
(setq file default-directory))
(when (slot-boundp this :proj-root)
- (let ((rootfcn (oref this proj-root)))
+ (let ((dirmatch (oref this proj-root-dirmatch))
+ (rootfcn (oref this proj-root))
+ (callfcn t))
(when rootfcn
- (condition-case nil
- (funcall rootfcn file)
- (error
- (funcall rootfcn)))
+ (if ;; If the dirmatch (an object) is not installed, then we
+ ;; always skip doing a match.
+ (and (ede-project-autoload-dirmatch-p dirmatch)
+ (not (ede-dirmatch-installed dirmatch)))
+ (setq callfcn nil)
+ ;; Other types of dirmatch:
+ (when (and
+ ;; If the Emacs Lisp file handling this project hasn't
+ ;; been loaded, we will use the quick dirmatch feature.
+ (not (featurep (oref this file)))
+ ;; If the dirmatch is an empty string, then we always
+ ;; skip doing a match.
+ (not (and (stringp dirmatch) (string= dirmatch "")))
+ )
+ ;; If this file DOES NOT match dirmatch, we set the callfcn
+ ;; to nil, meaning don't load the ede support file for this
+ ;; type of project. If it does match, we will load the file
+ ;; and use a more accurate programatic match from there.
+ (unless (ede-project-dirmatch-p file dirmatch)
+ (setq callfcn nil))))
+ ;; Call into the project support file for a match.
+ (when callfcn
+ (condition-case nil
+ (funcall rootfcn file)
+ (error
+ (funcall rootfcn))))
))))
(defmethod ede-dir-to-projectfile ((this ede-project-autoload) dir)
(let* ((d (file-name-as-directory dir))
(root (ede-project-root-directory this d))
(pf (oref this proj-file))
+ (dm (oref this proj-root-dirmatch))
(f (cond ((stringp pf)
(expand-file-name pf (or root d)))
((and (symbolp pf) (fboundp pf))
- (funcall pf (or root d)))))
+ ;; If there is a symbol to call, lets make extra
+ ;; sure we really can call it without loading in
+ ;; other EDE projects. This happens if the file is
+ ;; already loaded, or if there is a dirmatch, but
+ ;; root is empty.
+ (when (and (featurep (oref this file))
+ (or (not (stringp dm))
+ (not (string= dm "")))
+ root)
+ (funcall pf (or root d))))))
)
(when (and f (file-exists-p f))
f)))
HCoop / bpt / emacs.git / blobdiff