]> git.eshelyaron.com Git - emacs.git/commitdiff
cedet-cscope.el, cedet-edebug.el, cedet-global.el, cedet-idutils.el,
authorChong Yidong <cyd@stupidchicken.com>
Sat, 22 Aug 2009 19:04:43 +0000 (19:04 +0000)
committerChong Yidong <cyd@stupidchicken.com>
Sat, 22 Aug 2009 19:04:43 +0000 (19:04 +0000)
cedet.el, inversion.el, pulse.el: Initial version, from CEDET's
common/ directory.

lisp/cedet/cedet-cscope.el [new file with mode: 0644]
lisp/cedet/cedet-edebug.el [new file with mode: 0644]
lisp/cedet/cedet-global.el [new file with mode: 0644]
lisp/cedet/cedet-idutils.el [new file with mode: 0644]
lisp/cedet/cedet.el [new file with mode: 0644]
lisp/cedet/inversion.el [new file with mode: 0644]
lisp/cedet/pulse.el [new file with mode: 0644]

diff --git a/lisp/cedet/cedet-cscope.el b/lisp/cedet/cedet-cscope.el
new file mode 100644 (file)
index 0000000..4355ea3
--- /dev/null
@@ -0,0 +1,157 @@
+;;; cedet-cscope.el --- CScope support for CEDET
+
+;;; Copyright (C) Free Software Foundation, Inc.
+
+;; Author: Eric M. Ludlam <zappo@gnu.org>
+
+;; 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 using CScope for symbol lookups.
+
+;;; Code:
+
+(defvar cedet-cscope-min-version "16.0"
+  "Minimum version of GNU global required.")
+
+(defcustom cedet-cscope-command "cscope"
+  "Command name for the CScope executable."
+  :type 'string
+  :group 'cedet)
+
+(defun cedet-cscope-search (searchtext texttype type scope)
+  "Perform a search with CScope, return the created buffer.
+SEARCHTEXT is text to find.
+TEXTTYPE is the type of text, such as 'regexp, 'string, 'tagname,
+'tagregexp, or 'tagcompletions.
+TYPE is the type of search, meaning that SEARCHTEXT is compared to
+filename, tagname (tags table), references (uses of a tag) , or
+symbol (uses of something not in the tag table.)
+SCOPE is the scope of the search, such as 'project or 'subdirs."
+  ;; CScope is an interactive program.  It uses number flags
+  ;; in order to perform command line searches.  Useful for this
+  ;; tool are:
+  ;;
+  ;; -0 = Find C symbol
+  ;; -1 = Find global definition
+  ;; -3 = Find references
+  ;; -6 = Find egrep pattern
+  ;; -7 = Find file
+  (let ((idx (cond ((eq type 'file)
+                   "-7")
+                  ;; Non files are symbols and such
+                  ((eq texttype 'tagname)
+                   "-1")
+                  ((eq texttype 'tagregexp)
+                   "-0")
+                  ((eq texttype 'tagcompletions)
+                   (setq searchtext (concat "^" searchtext ".*"))
+                   "-1")
+                  ((eq texttype 'regexp)
+                   "-5")
+                  (t
+                   "-3")
+                  )
+            )
+       )
+    (cedet-cscope-call (list "-d" "-L" idx searchtext))))
+
+(defun cedet-cscope-call (flags)
+  "Call CScope with the list of FLAGS."
+  (let ((b (get-buffer-create "*CEDET CScope*"))
+       (cd default-directory)
+       )
+    (save-excursion
+      (set-buffer b)
+      (setq default-directory cd)
+      (erase-buffer))
+    (apply 'call-process cedet-cscope-command
+          nil b nil
+          flags)
+    b))
+
+(defun cedet-cscope-expand-filename (filename)
+  "Expand the FILENAME with CScope.
+Return a fully qualified filename."
+  (interactive "sFile: ")
+  (let* ((ans1 (save-excursion
+                (set-buffer (cedet-cscope-call (list "-d" "-L" "-7" filename)))
+                (goto-char (point-min))
+                (if (looking-at "[^ \n]*cscope: ")
+                    (error "CScope not available")
+                  (split-string (buffer-string) "\n" t))))
+        (ans2 (mapcar (lambda (hit)
+                        (expand-file-name (car (split-string hit " "))))
+                      ans1)))
+    (when (interactive-p)
+      (if ans2
+         (if (= (length ans2) 1)
+             (message "%s" (car ans2))
+           (message "%s + %d others" (car ans2)
+                    (length (cdr ans2))))
+       (error "No file found")))
+    ans2))
+
+(defun cedet-cscope-support-for-directory (&optional dir)
+  "Return non-nil if CScope has a support file for DIR.
+If DIR is not supplied, use the current default directory.
+This works by running cscope on a bogus symbol, and looking for
+the error code."
+  (save-excursion
+    (let ((default-directory (or dir default-directory)))
+      (set-buffer (cedet-cscope-call (list "-d" "-L" "-7" "moose")))
+      (goto-char (point-min))
+      (if (looking-at "[^ \n]*cscope: ")
+         nil
+       t))))
+
+(declare-function inversion-check-version "inversion")
+
+(defun cedet-cscope-version-check (&optional noerror)
+  "Check the version of the installed CScope command.
+If optional programatic argument NOERROR is non-nil, then
+instead of throwing an error if Global isn't available, then
+return nil."
+  (interactive)
+  (require 'inversion)
+  (let ((b (condition-case nil
+              (cedet-cscope-call (list "-V"))
+            (error nil)))
+       (rev nil))
+    (if (not b)
+       (progn
+         (when (interactive-p)
+           (message "CScope not found."))
+         nil)
+      (save-excursion
+       (set-buffer b)
+       (goto-char (point-min))
+       (re-search-forward "cscope: version \\([0-9.]+\\)" nil t)
+       (setq rev (match-string 1))
+       (if (inversion-check-version rev nil cedet-cscope-min-version)
+           (if noerror
+               nil
+             (error "Version of CScope is %s.  Need at least %s"
+                    rev cedet-cscope-min-version))
+         ;; Else, return TRUE, as in good enough.
+         (when (interactive-p)
+           (message "CScope %s  - Good enough for CEDET." rev))
+         t)))))
+
+(provide 'cedet-cscope)
+
+;;; cedet-cscope.el ends here
diff --git a/lisp/cedet/cedet-edebug.el b/lisp/cedet/cedet-edebug.el
new file mode 100644 (file)
index 0000000..9548e27
--- /dev/null
@@ -0,0 +1,126 @@
+;;; cedet-edebug.el --- Special EDEBUG augmentation code
+
+;;; Copyright (C) 2003, 2004, 2007, 2008 Free Software Foundation, Inc.
+
+;; Author: Eric M. Ludlam  <zappo@gnu.org>
+;; Version: 0.2
+;; Keywords: OO, lisp
+
+;; 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:
+;;
+;; Some aspects of EDEBUG are not extensible.  It is possible to extend
+;; edebug through other means, such as alias or advice, but those don't stack
+;; very well when there are multiple tools trying to do the same sort of thing.
+;;
+;; This package provides a way to extend some aspects of edebug, such as value
+;; printing.
+
+;;; Code:
+(defvar cedet-edebug-prin1-extensions nil
+  "An alist of of code that can extend PRIN1 for edebug.
+Each entry has the value: (CONDITION . PRIN1COMMAND).")
+
+(defun cedet-edebug-prin1-recurse (object)
+  "Recurse into OBJECT for prin1 on `cedet-edebug-prin1-to-string'."
+  (concat "(" (mapconcat 'cedet-edebug-prin1-to-string object " ") ")"))
+
+(defun cedet-edebug-rebuild-prin1 ()
+  "Rebuild the function `cedet-edebug-prin1-to-string'.
+Use the values of `cedet-edebug-prin1-extensions' as the means of
+constructing the function."
+  (interactive)
+  (let ((c cedet-edebug-prin1-extensions)
+       (code nil))
+    (while c
+      (setq code (append (list (list (car (car c))
+                                    (cdr (car c))))
+                        code))
+      (setq c (cdr c)))
+    (fset 'cedet-edebug-prin1-to-string-inner
+         `(lambda (object &optional noescape)
+            "Display eieio OBJECT in fancy format.  Overrides the edebug default.
+Optional argument NOESCAPE is passed to `prin1-to-string' when appropriate."
+            (cond
+             ,@(nreverse code)
+             (t (prin1-to-string object noescape)))))
+    ))
+
+(defun cedet-edebug-prin1-to-string (object &optional noescape)
+  "CEDET version of `edebug-prin1-to-string' that adds specialty
+print methods for very large complex objects."
+  (if (not (fboundp 'cedet-edebug-prin1-to-string-inner))
+      ;; Recreate the official fcn now.
+      (cedet-edebug-rebuild-prin1))
+
+  ;; Call the auto-generated version.
+  ;; This is not going to be available at compile time.
+  (with-no-warnings
+    (cedet-edebug-prin1-to-string-inner object noescape)))
+
+
+(defun cedet-edebug-add-print-override (testfcn printfcn)
+  "Add a new EDEBUG print override.
+TESTFCN is a routine that returns nil if the first argument
+passed to it is not to use PRINTFCN.
+PRINTFCN accepts an object identified by TESTFCN and
+returns a string.
+New tests are always added to the END of the list of tests.
+See `cedet-edebug-prin1-extensions' for the official list."
+  (condition-case nil
+      (add-to-list 'cedet-edebug-prin1-extensions
+                  (cons testfcn printfcn)
+                  t)
+    (error ;; That failed, it must be an older version of Emacs
+     ;; withouth the append argument for `add-to-list'
+     ;; Doesn't handle the don't add twice case, but that's a
+     ;; development thing and developers probably use new emacsen.
+     (setq cedet-edebug-prin1-extensions
+          (append cedet-edebug-prin1-extensions
+                  (list (cons testfcn printfcn))))))
+  ;; whack the old implementation to force a rebuild.
+  (fmakunbound 'cedet-edebug-prin1-to-string-inner))
+
+;; ;;; NOTE TO SELF.  Make this system used as an extension
+;; ;;; and then autoload the below.
+;; ;;;###autoload
+;; (add-hook 'edebug-setup-hook
+;;       (lambda ()
+;;         (require 'cedet-edebug)
+;;         ;; I suspect this isn't the best way to do this, but when
+;;         ;; cust-print was used on my system all my objects
+;;         ;; appeared as "#1 =" which was not useful.  This allows
+;;         ;; edebug to print my objects in the nice way they were
+;;         ;; meant to with `object-print' and `class-name'
+;;         (defalias 'edebug-prin1-to-string 'cedet-edebug-prin1-to-string)
+;;         ;; Add a fancy binding into EDEBUG's keymap for ADEBUG.
+;;         (define-key edebug-mode-map "A" 'data-debug-edebug-expr)
+;;         ))
+
+;; ;;; DEBUG MODE TOO
+;; ;; This seems like as good a place as any to stick this hack.
+;; ;;;###autoload
+;; (add-hook 'debugger-mode-hook
+;;       (lambda ()
+;;         (require 'cedet-edebug)
+;;         ;; Add a fancy binding into the debug mode map for ADEBUG.
+;;         (define-key debugger-mode-map "A" 'data-debug-edebug-expr)
+;;         ))
+
+(provide 'cedet-edebug)
+
+;;; cedet-edebug.el ends here
diff --git a/lisp/cedet/cedet-global.el b/lisp/cedet/cedet-global.el
new file mode 100644 (file)
index 0000000..2cc74f6
--- /dev/null
@@ -0,0 +1,165 @@
+;;; cedet-global.el --- GNU Global support for CEDET.
+
+;; 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:
+;;
+;; Basic support for calling GNU Global, and testing version numbers.
+
+(defvar cedet-global-min-version "5.0"
+  "Minimum version of GNU global required.")
+
+(defcustom cedet-global-command "global"
+  "Command name for the GNU Global executable."
+  :type 'string
+  :group 'cedet)
+
+;;; Code:
+(defun cedet-gnu-global-search (searchtext texttype type scope)
+  "Perform a search with GNU Global, return the created buffer.
+SEARCHTEXT is text to find.
+TEXTTYPE is the type of text, such as 'regexp, 'string, 'tagname,
+'tagregexp, or 'tagcompletions.
+TYPE is the type of search, meaning that SEARCHTEXT is compared to
+filename, tagname (tags table), references (uses of a tag) , or
+symbol (uses of something not in the tag table.)
+SCOPE is the scope of the search, such as 'project or 'subdirs."
+  (let ((flgs (cond ((eq type 'file)
+                    "-a")
+                   (t "-xa")))
+       (scopeflgs (cond
+                   ((eq scope 'project)
+                    ""
+                    )
+                   ((eq scope 'target)
+                    "l")))
+       (stflag (cond ((or (eq texttype 'tagname)
+                          (eq texttype 'tagregexp))
+                      "")
+                     ((eq texttype 'tagcompletions)
+                      "c")
+                     ((eq texttype 'regexp)
+                      "g")
+                     (t "r")))
+       )
+    (cedet-gnu-global-call (list (concat flgs scopeflgs stflag)
+                                searchtext))))
+
+(defun cedet-gnu-global-call (flags)
+  "Call GNU Global with the list of FLAGS."
+  (let ((b (get-buffer-create "*CEDET Global*"))
+       (cd default-directory)
+       )
+    (save-excursion
+      (set-buffer b)
+      (setq default-directory cd)
+      (erase-buffer))
+    (apply 'call-process cedet-global-command
+          nil b nil
+          flags)
+    b))
+
+(defun cedet-gnu-global-expand-filename (filename)
+  "Expand the FILENAME with GNU Global.
+Return a fully qualified filename."
+  (interactive "sFile: ")
+  (let ((ans (save-excursion
+              (set-buffer (cedet-gnu-global-call (list "-Pa" filename)))
+              (goto-char (point-min))
+              (if (looking-at "global: ")
+                  (error "GNU Global not available")
+                (split-string (buffer-string) "\n" t)))))
+    (when (interactive-p)
+      (if ans
+         (if (= (length ans) 1)
+             (message "%s" (car ans))
+           (message "%s + %d others" (car ans)
+                    (length (cdr ans))))
+       (error "No file found")))
+    ans))
+
+(defun cedet-gnu-global-show-root ()
+  "Show the root of a GNU Global area under the current buffer."
+  (interactive)
+  (message "%s" (cedet-gnu-global-root)))
+
+(defun cedet-gnu-global-root (&optional dir)
+  "Return the root of any GNU Global scanned project.
+If a default starting DIR is not specified, the current buffer's
+`default-directory' is used."
+  (let ((default-directory (or dir default-directory))
+       )
+    (save-excursion
+      (set-buffer (cedet-gnu-global-call (list "-pq")))
+      (goto-char (point-min))
+      (when (not (eobp))
+       (file-name-as-directory
+        (buffer-substring (point) (point-at-eol)))))))
+
+(declare-function inversion-check-version "inversion")
+
+(defun cedet-gnu-global-version-check (&optional noerror)
+  "Check the version of the installed GNU Global command.
+If optional programatic argument NOERROR is non-nil, then
+instead of throwing an error if Global isn't available, then
+return nil."
+  (interactive)
+  (require 'inversion)
+  (let ((b (condition-case nil
+              (cedet-gnu-global-call (list "--version"))
+            (error nil)))
+       (rev nil))
+    (if (not b)
+       (progn
+         (when (interactive-p)
+           (message "GNU Global not found."))
+         nil)
+      (save-excursion
+       (set-buffer b)
+       (goto-char (point-min))
+       (re-search-forward "GNU GLOBAL \\([0-9.]+\\)" nil t)
+       (setq rev (match-string 1))
+       (if (inversion-check-version rev nil cedet-global-min-version)
+           (if noerror
+               nil
+             (error "Version of GNU Global is %s.  Need at least %s"
+                    rev cedet-global-min-version))
+         ;; Else, return TRUE, as in good enough.
+         (when (interactive-p)
+           (message "GNU Global %s  - Good enough for CEDET." rev))
+         t)))))
+
+(defun cedet-gnu-global-scan-hits (buffer)
+  "Scan all the hits from the GNU Global output BUFFER."
+  (let ((hits nil)
+       (r1 "^\\([^ ]+\\) +\\([0-9]+\\) \\([^ ]+\\) "))
+    (save-excursion
+      (set-buffer buffer)
+      (goto-char (point-min))
+      (while (re-search-forward r1 nil t)
+       (setq hits (cons (cons (string-to-number (match-string 2))
+                              (match-string 3))
+                        hits)))
+      ;; Return the results
+      (nreverse hits))))
+
+(provide 'cedet-global)
+
+;;; cedet-global.el ends here
diff --git a/lisp/cedet/cedet-idutils.el b/lisp/cedet/cedet-idutils.el
new file mode 100644 (file)
index 0000000..f550e2a
--- /dev/null
@@ -0,0 +1,181 @@
+;;; cedet-idutils.el --- ID Utils support for CEDET.
+
+;;; Copyright (C) 2009 Free Software Foundation, Inc.
+
+;; Author: Eric M. Ludlam <eric@siege-engine.com>
+;; Version: 0.2
+;; Keywords: OO, lisp
+
+;; 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:
+;;
+;; Basic support calling ID Utils functions, and checking version
+;; numbers.
+
+;;; Code:
+
+(defvar cedet-idutils-min-version "4.0"
+  "Minimum version of ID Utils required.")
+
+(defcustom cedet-idutils-file-command "fnid"
+  "Command name for the ID Utils executable for searching file names."
+  :type 'string
+  :group 'cedet)
+
+(defcustom cedet-idutils-token-command "lid"
+  "Command name for the ID Utils executable for searching for tokens."
+  :type 'string
+  :group 'cedet)
+
+(defun cedet-idutils-search (searchtext texttype type scope)
+  "Perform a search with IDUtils, return the created buffer.
+SEARCHTEXT is text to find.
+TEXTTYPE is the type of text, such as 'regexp, 'string, 'tagname,
+'tagregexp, or 'tagcompletions.
+TYPE is the type of search, meaning that SEARCHTEXT is compared to
+filename, tagname (tags table), references (uses of a tag) , or
+symbol (uses of something not in the tag table.)
+SCOPE is the scope of the search, such as 'project or 'subdirs.
+Note: Scope is not yet supported."
+  (if (eq type 'file)
+      ;; Calls for file stuff is very simple.
+      (cedet-idutils-fnid-call (list searchtext))
+    ;; Calls for text searches is more complex.
+    (let* ((resultflg (if (eq texttype 'tagcompletions)
+                         (list "--key=token")
+                       (list "--result=grep")))
+          (scopeflgs nil) ; (cond ((eq scope 'project) "" ) ((eq scope 'target) "l")))
+          (stflag (cond ((or (eq texttype 'tagname)
+                             (eq texttype 'tagregexp))
+                         (list "-r" "-w"))
+                        ((eq texttype 'tagcompletions)
+                         ;; Add regex to search text for beginning of char.
+                         (setq searchtext (concat "^" searchtext))
+                         (list "-r" "-s" ))
+                        ((eq texttype 'regexp)
+                         (list "-r"))
+                        ;; t means 'symbol
+                        (t (list "-l" "-w"))))
+          )
+      (cedet-idutils-lid-call (append resultflg scopeflgs stflag (list searchtext))))
+    ))
+
+(defun cedet-idutils-fnid-call (flags)
+  "Call ID Utils fnid with the list of FLAGS.
+Return the created buffer with with program output."
+  (let ((b (get-buffer-create "*CEDET fnid*"))
+       (cd default-directory)
+       )
+    (save-excursion
+      (set-buffer b)
+      (setq default-directory cd)
+      (erase-buffer))
+    (apply 'call-process cedet-idutils-file-command
+          nil b nil
+          flags)
+    b))
+
+(defun cedet-idutils-lid-call (flags)
+  "Call ID Utils lid with the list of FLAGS.
+Return the created buffer with with program output."
+  (let ((b (get-buffer-create "*CEDET lid*"))
+       (cd default-directory)
+       )
+    (save-excursion
+      (set-buffer b)
+      (setq default-directory cd)
+      (erase-buffer))
+    (apply 'call-process cedet-idutils-token-command
+          nil b nil
+          flags)
+    b))
+
+;;; UTIL CALLS
+;;
+(defun cedet-idutils-expand-filename (filename)
+  "Expand the FILENAME with IDUtils.
+Return a filename relative to the default directory."
+  (interactive "sFile: ")
+  (let ((ans (save-excursion
+              (set-buffer (cedet-idutils-fnid-call (list filename)))
+              (goto-char (point-min))
+              (if (looking-at "[^ \n]*fnid: ")
+                  (error "ID Utils not available")
+                (split-string (buffer-string) "\n" t)))))
+    (setq ans (mapcar 'expand-file-name ans))
+    (when (interactive-p)
+      (if ans
+         (if (= (length ans) 1)
+             (message "%s" (car ans))
+           (message "%s + %d others" (car ans)
+                    (length (cdr ans))))
+       (error "No file found")))
+    ans))
+
+(defun cedet-idutils-support-for-directory (&optional dir)
+  "Return non-nil if IDUtils has a support file for DIR.
+If DIR is not supplied, use the current default directory.
+This works by running lid on a bogus symbol, and looking for
+the error code."
+  (save-excursion
+    (let ((default-directory (or dir default-directory)))
+      (condition-case nil
+         (progn
+           (set-buffer (cedet-idutils-fnid-call '("moose")))
+           (goto-char (point-min))
+           (if (looking-at "[^ \n]*fnid: ")
+               nil
+             t))
+       (error nil)))))
+
+(declare-function inversion-check-version "inversion")
+
+(defun cedet-idutils-version-check (&optional noerror)
+  "Check the version of the installed ID Utils command.
+If optional programatic argument NOERROR is non-nil, then
+instead of throwing an error if Global isn't available, then
+return nil."
+  (interactive)
+  (require 'inversion)
+  (let ((b (condition-case nil
+              (cedet-idutils-fnid-call (list "--version"))
+            (error nil)))
+       (rev nil))
+    (if (not b)
+       (progn
+         (when (interactive-p)
+           (message "ID Utils not found."))
+         nil)
+      (save-excursion
+       (set-buffer b)
+       (goto-char (point-min))
+       (re-search-forward "fnid - \\([0-9.]+\\)" nil t)
+       (setq rev (match-string 1))
+       (if (inversion-check-version rev nil cedet-idutils-min-version)
+           (if noerror
+               nil
+             (error "Version of ID Utis is %s.  Need at least %s"
+                    rev cedet-idutils-min-version))
+         ;; Else, return TRUE, as in good enough.
+         (when (interactive-p)
+           (message "ID Utils %s  - Good enough for CEDET." rev))
+         t)))))
+
+
+(provide 'cedet-idutils)
+
+;;; cedet-idutils.el ends here
diff --git a/lisp/cedet/cedet.el b/lisp/cedet/cedet.el
new file mode 100644 (file)
index 0000000..4e76083
--- /dev/null
@@ -0,0 +1,130 @@
+;;; cedet.el --- Setup CEDET environment
+
+;;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
+;;; Free Software Foundation, Inc.
+
+;; Author: David Ponce <david@dponce.com>
+;; Maintainer: Eric M. Ludlam  <zappo@gnu.org>
+;; Version: 0.2
+;; Keywords: OO, lisp
+
+;; 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 library automatically setups your [X]Emacs to use CEDET tools.
+;;
+;;   (require 'cedet)
+;;
+;; If you want to turn on useful or all Semantic features by default,
+;; respectively add:
+;;
+;;   (setq semantic-load-turn-useful-things-on t)
+;; or
+;;   (setq semantic-load-turn-everything-on t)
+;;
+;; before loading this file, like this:
+;;
+;;   (setq semantic-load-turn-useful-things-on t)
+;;   (require 'cedet)
+;;
+;; That's it!
+
+;;; Code:
+
+(eval-when-compile
+  (require 'cl))
+
+(defconst cedet-version "1.0pre7"
+  "Current version of CEDET.")
+
+(require 'eieio)
+;; (require 'semantic)
+;; (require 'srecode)
+;; (require 'ede)
+(require 'speedbar)
+
+(defconst cedet-packages
+  `(
+    ;;PACKAGE   MIN-VERSION
+    (cedet         ,cedet-version)
+    (eieio         "1.2")
+    (semantic      "2.0pre7")
+    (srecode       "0.2")
+    (ede           "1.0pre7")
+    (speedbar      "1.0.3"))
+  "Table of CEDET packages to install.")
+
+(declare-function inversion-find-version "inversion")
+
+(defun cedet-version ()
+  "Display all active versions of CEDET and Dependant packages.
+
+The PACKAGE column is the name of a given package from CEDET.
+
+REQUESTED VERSION is the version requested by the CEDET load script.
+See `cedet-packages' for details.
+
+FILE VERSION is the version number found in the source file
+for the specificed PACKAGE.
+
+LOADED VERSION is the version of PACKAGE current loaded in Emacs
+memory and (presumably) running in this Emacs instance.  Value is X
+if the package has not been loaded."
+  (interactive)
+  (require 'inversion)
+  (with-output-to-temp-buffer "*CEDET*"
+    (princ "CEDET Version:\t") (princ cedet-version)
+    (princ "\n  \t\t\tRequested\tFile\t\tLoaded")
+    (princ "\n  Package\t\tVersion\t\tVersion\t\tVersion")
+    (princ "\n  ----------------------------------------------------------")
+    (let ((p cedet-packages))
+      (while p
+       (let ((sym (symbol-name (car (car p)))))
+         (princ "\n  ")
+         (princ sym)
+         (princ ":\t")
+         (if (< (length sym) 5)
+             (princ "\t"))
+         (if (< (length sym) 13)
+             (princ "\t"))
+         (let ((reqver (nth 1 (car p)))
+               (filever (car (inversion-find-version sym)))
+               (loadver (when (featurep (car (car p)))
+                          (symbol-value (intern-soft (concat sym "-version"))))))
+           (princ reqver)
+           (if (< (length reqver) 8) (princ "\t"))
+           (princ "\t")
+           (if (string= filever reqver)
+               ;; I tried the words "check" and "match", but that
+               ;; just looked lame.
+               (princ "ok\t")
+             (princ filever)
+             (if (< (length filever) 8) (princ "\t")))
+           (princ "\t")
+           (if loadver
+               (if (string= loadver reqver)
+                   (princ "ok")
+                 (princ loadver))
+             (princ "Not Loaded"))
+           ))
+       (setq p (cdr p))))
+    (princ "\n\n\nC-h f cedet-version RET\n  for details on output format.")
+    ))
+
+(provide 'cedet)
+
+;;; cedet.el ends here
diff --git a/lisp/cedet/inversion.el b/lisp/cedet/inversion.el
new file mode 100644 (file)
index 0000000..95608c4
--- /dev/null
@@ -0,0 +1,601 @@
+;;; inversion.el --- When you need something in version XX.XX
+
+;;; Copyright (C) 2002, 2003, 2005, 2006, 2007, 2008, 2009
+;;; Free Software Foundation, Inc.
+
+;; Author: Eric M. Ludlam <zappo@gnu.org>
+;; Version: 0.2
+;; Keywords: OO, lisp
+
+;; 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:
+;;
+;; Keeping track of rapidly developing software is a tough thing to
+;; do, especially if you want to have co-dependent packages which all
+;; move at different rates.
+;;
+;; This library provides a framework for specifying version numbers
+;; and (as side effect) have a flexible way of getting a desired feature set.
+;;
+;; If you would like to use this package to satisfy dependency replace this:
+;;
+;; (require 'spiffy)
+;;
+;; with this:
+;;
+;; (require 'inversion)
+;; (inversion-require 'spiffy "1.0")
+;;
+;; If you feel the need to not throw errors, you can do this instead:
+;;
+;; (let ((err (inversion-test 'spiffy "1.0")))
+;;    (if err (your-stuff-here)))
+;;
+;; If you new package (2.0) needs to make sure a load file from your
+;; package is compatible, use this test:
+;;
+;; (if (not (inversion-reverse-test 'spiffy version-from-file))
+;;       ;; Everything ok
+;;       (do stuff)
+;;    ;; Out of date
+;;    (import-old-code))
+;;
+;; If you would like to make inversion optional, do this:
+;;
+;; (or (require 'inversion nil t)
+;;     (defun inversion-test (p v)
+;;       (string= v (symbol-value
+;;               (intern-soft (concat (symbol-string p) "-version"))))))
+;;
+;; Or modify to specify `inversion-require' instead.
+;;
+;; TODO:
+;;  Offer to download newer versions of a package.
+
+;;; History:
+;;
+;; Sept 3, 2002:  First general publication.
+
+;;; Code:
+
+(defvar inversion-version "1.3"
+  "Current version of InVersion.")
+(defvar inversion-incompatible-version "0.1alpha1"
+  "An earlier release which is incompatible with this release.")
+
+(defconst inversion-decoders
+  '(
+    (alpha  "^\\([0-9]+\\)\\.\\([0-9]+\\)\\s-*alpha\\([0-9]+\\)?$" 3)
+    (beta   "^\\([0-9]+\\)\\.\\([0-9]+\\)\\s-*beta\\([0-9]+\\)?$" 3)
+    (beta   "^\\([0-9]+\\)\\.\\([0-9]+\\)\\s-*(beta\\([0-9]+\\)?)" 3)
+    (prerelease "^\\([0-9]+\\)\\.\\([0-9]+\\)\\s-*pre\\([0-9]+\\)?$" 3)
+    (full   "^\\([0-9]+\\)\\.\\([0-9]+\\)$" 2)
+    (fullsingle "^\\([0-9]+\\)$" 1)
+    (patch  "^\\([0-9]+\\)\\.\\([0-9]+\\) (patch \\([0-9]+\\))" 3)
+    (point  "^\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)$" 3)
+    (build  "^\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\).\\([0-9]+\\)$" 4)
+    )
+  "List of decoders for version strings.
+Each decoder is of the form:
+
+  ( RELEASE-TYPE REGEXP MAX )
+
+RELEASE-TYPE is a symbol specifying something like `beta' or `alpha'.
+REGEXP is the regular expression to match a version string.
+MAX is the maximum number of match-numbers in the release number.
+Decoders must be ordered to decode least stable versions before the
+more stable ones.")
+
+;;; Version Checking
+;;
+(defun inversion-decode-version (version-string)
+  "Decode VERSION-STRING into an encoded list.
+Return value is of the form:
+  (RELEASE MAJOR MINOR ...)
+where RELEASE is a symbol such as `full', or `beta'."
+  (let ((decoders inversion-decoders)
+       (result nil))
+    (while (and decoders (not result))
+      (if (string-match (nth 1 (car decoders)) version-string)
+         (let ((ver nil)
+               (num-left (nth 2 (car decoders)))
+               (count 1))
+           (while (<= count num-left)
+             (setq ver (cons
+                        (if (match-beginning count)
+                            (string-to-number
+                             (substring version-string
+                                        (match-beginning count)
+                                        (match-end count)))
+                          1)
+                        ver)
+                   count (1+ count)))
+           (setq result (cons (caar decoders) (nreverse ver))))
+        (setq decoders (cdr decoders))))
+    result))
+
+(defun inversion-package-version (package)
+  "Return the decoded version for PACKAGE."
+  (let ((ver (symbol-value
+             (intern-soft
+              (concat (symbol-name package)
+                      "-version"))))
+       (code nil))
+    (unless ver
+      (error "Package %S does not define %S-version" package package))
+    ;; Decode the code
+    (setq code (inversion-decode-version ver))
+    (unless code
+      (error "%S-version value cannot be decoded" package))
+    code))
+
+(defun inversion-package-incompatibility-version (package)
+  "Return the decoded incompatibility version for PACKAGE.
+The incompatibility version is specified by the programmer of
+a package when a package is not backward compatible.  It is
+not an indication of new features or bug fixes."
+  (let ((ver (symbol-value
+             (intern-soft
+              (concat (symbol-name package)
+                      "-incompatible-version")))))
+    (if (not ver)
+       nil
+      ;; Decode the code
+      (inversion-decode-version ver))))
+
+(defun inversion-recode (code)
+  "Convert CODE into a string."
+  (let ((r (nth 0 code))               ; release-type
+       (n (nth 1 code))                ; main number
+       (i (nth 2 code))                ; first increment
+       (p (nth 3 code)))               ; second increment
+    (cond
+     ((eq r 'full)
+      (setq r "" p ""))
+     ((eq r 'point)
+      (setq r ".")))
+    (format "%s.%s%s%s" n i r p)))
+
+(defun inversion-release-to-number (release-symbol)
+  "Convert RELEASE-SYMBOL into a number."
+  (let* ((ra (assoc release-symbol inversion-decoders))
+        (rn (- (length inversion-decoders)
+               (length (member ra inversion-decoders)))))
+    rn))
+
+(defun inversion-= (ver1 ver2)
+  "Return non-nil if VER1 is equal to VER2."
+  (equal ver1 ver2))
+
+(defun inversion-< (ver1 ver2)
+  "Return non-nil if VER1 is less than VER2."
+  (let ((v1-0 (inversion-release-to-number (nth 0 ver1)))
+       (v1-1 (nth 1 ver1))
+       (v1-2 (nth 2 ver1))
+       (v1-3 (nth 3 ver1))
+       (v1-4 (nth 4 ver1))
+       ;; v2
+       (v2-0 (inversion-release-to-number (nth 0 ver2)))
+       (v2-1 (nth 1 ver2))
+       (v2-2 (nth 2 ver2))
+       (v2-3 (nth 3 ver2))
+       (v2-4 (nth 4 ver2))
+       )
+    (or (and (= v1-0 v2-0)
+            (= v1-1 v2-1)
+            (= v1-2 v2-2)
+            (= v1-3 v2-3)
+            v1-4 v2-4          ; all or nothin if elt - is =
+            (< v1-4 v2-4))
+       (and (= v1-0 v2-0)
+            (= v1-1 v2-1)
+            (= v1-2 v2-2)
+            v1-3 v2-3          ; all or nothin if elt - is =
+            (< v1-3 v2-3))
+       (and (= v1-1 v2-1)
+            (< v1-2 v2-2))
+       (and (< v1-1 v2-1))
+       (and (< v1-0 v2-0)
+            (= v1-1 v2-1)
+            (= v1-2 v2-2)
+            )
+       )))
+
+(defun inversion-check-version (version incompatible-version
+                                       minimum &rest reserved)
+  "Check that a given version meets the minimum requirement.
+VERSION, INCOMPATIBLE-VERSION and MINIMUM are of similar format to
+return entries of `inversion-decode-version', or a classic version
+string.         INCOMPATIBLE-VERSION can be nil.
+RESERVED arguments are kept for a later use.
+Return:
+- nil if everything is ok
+- 'outdated if VERSION is less than MINIMUM.
+- 'incompatible if VERSION is not backward compatible with MINIMUM.
+- t if the check failed."
+  (let ((code (if (stringp version)
+                 (inversion-decode-version version)
+               version))
+       (req (if (stringp minimum)
+                (inversion-decode-version minimum)
+              minimum))
+       )
+    ;; Perform a test.
+    (cond
+     ((inversion-= code req)
+      ;; Same version.. Yay!
+      nil)
+     ((inversion-< code req)
+      ;; Version is too old!
+      'outdated)
+     ((inversion-< req code)
+      ;; Newer is installed.  What to do?
+      (let ((incompatible
+            (if (stringp incompatible-version)
+                (inversion-decode-version incompatible-version)
+              incompatible-version)))
+       (cond
+        ((not incompatible) nil)
+        ((or (inversion-= req incompatible)
+             (inversion-< req incompatible))
+         ;; The requested version is = or < than what the package
+         ;; maintainer says is incompatible.
+         'incompatible)
+        ;; Things are ok.
+        (t nil))))
+     ;; Check failed
+     (t t))))
+
+(defun inversion-test (package minimum &rest reserved)
+  "Test that PACKAGE meets the MINIMUM version requirement.
+PACKAGE is a symbol, similar to what is passed to `require'.
+MINIMUM is of similar format to return entries of
+`inversion-decode-version', or a classic version string.
+RESERVED arguments are kept for a later user.
+This depends on the symbols `PACKAGE-version' and optionally
+`PACKAGE-incompatible-version' being defined in PACKAGE.
+Return nil if everything is ok.         Return an error string otherwise."
+  (let ((check (inversion-check-version
+               (inversion-package-version package)
+               (inversion-package-incompatibility-version package)
+               minimum reserved)))
+    (cond
+     ((null check)
+      ;; Same version.. Yay!
+      nil)
+     ((eq check 'outdated)
+      ;; Version is too old!
+      (format "You need to upgrade package %s to %s" package minimum))
+     ((eq check 'incompatible)
+      ;; Newer is installed but the requested version is = or < than
+      ;; what the package maintainer says is incompatible, then throw
+      ;; that error.
+      (format "Package %s version is not backward compatible with %s"
+             package minimum))
+     ;; Check failed
+     (t "Inversion version check failed."))))
+
+(defun inversion-reverse-test (package oldversion &rest reserved)
+  "Test that PACKAGE at OLDVERSION is still compatible.
+If something like a save file is loaded at OLDVERSION, this
+test will identify if OLDVERSION is compatible with the current version
+of PACKAGE.
+PACKAGE is a symbol, similar to what is passed to `require'.
+OLDVERSION is of similar format to return entries of
+`inversion-decode-version', or a classic version string.
+RESERVED arguments are kept for a later user.
+This depends on the symbols `PACKAGE-version' and optionally
+`PACKAGE-incompatible-version' being defined in PACKAGE.
+Return nil if everything is ok.         Return an error string otherwise."
+  (let ((check (inversion-check-version
+               (inversion-package-version package)
+               (inversion-package-incompatibility-version package)
+               oldversion reserved)))
+    (cond
+     ((null check)
+      ;; Same version.. Yay!
+      nil)
+     ((eq check 'outdated)
+      ;; Version is too old!
+      (format "Package %s version %s is not compatible with current version"
+             package oldversion))
+     ((eq check 'incompatible)
+      ;; Newer is installed but the requested version is = or < than
+      ;; what the package maintainer says is incompatible, then throw
+      ;; that error.
+      (format "Package %s version is not backward compatible with %s"
+             package oldversion))
+     ;; Check failed
+     (t "Inversion version check failed."))))
+
+(defun inversion-require (package version &optional file directory
+                                 &rest reserved)
+  "Declare that you need PACKAGE with at least VERSION.
+PACKAGE might be found in FILE.  (See `require'.)
+Throws an error if VERSION is incompatible with what is installed.
+Optional argument DIRECTORY is a location where new versions of
+this tool can be located.  If there is a versioning problem and
+DIRECTORY is provided, inversion will offer to download the file.
+Optional argument RESERVED is saved for later use."
+  (require package file)
+  (let ((err (inversion-test package version)))
+    (when err
+      (if directory
+         (inversion-download-package-ask err package directory version)
+       (error err)))
+    ;; Return the package symbol that was required.
+    package))
+
+(defun inversion-require-emacs (emacs-ver xemacs-ver)
+  "Declare that you need either EMACS-VER, or XEMACS-VER.
+Only checks one based on which kind of Emacs is being run."
+  (let ((err (inversion-test 'emacs
+                            (if (featurep 'xemacs)
+                                xemacs-ver
+                              emacs-ver))))
+    (if err (error err)
+      ;; Something nice...
+      t)))
+
+(defconst inversion-find-data
+  '("(def\\(var\\|const\\)\\s-+%s-%s\\s-+\"\\([^\"]+\\)" 2)
+  "Regexp template and match data index of a version string.")
+
+(defun inversion-find-version (package)
+  "Search for the version and incompatible version of PACKAGE.
+Does not load PACKAGE nor requires that it has been previously loaded.
+Search in the directories in `load-path' for a PACKAGE.el library.
+Visit the file found and search for the declarations of variables or
+constants `PACKAGE-version' and `PACKAGE-incompatible-version'.  The
+value of these variables must be a version string.
+
+Return a pair (VERSION-STRING . INCOMPATIBLE-VERSION-STRING) where
+INCOMPATIBLE-VERSION-STRING can be nil.
+Return nil when VERSION-STRING was not found."
+  (let* ((file (locate-library (format "%s.el" package) t))
+        (tag (car inversion-find-data))
+        (idx (nth 1 inversion-find-data))
+        version)
+    (when file
+      (with-temp-buffer
+       ;; The 3000 is a bit arbitrary, but should cut down on
+       ;; fileio as version info usually is at the very top
+       ;; of a file.  AFter a long commentary could be bad.
+       (insert-file-contents-literally file nil 0 3000)
+       (goto-char (point-min))
+       (when (re-search-forward (format tag package 'version) nil t)
+         (setq version (list (match-string idx)))
+         (goto-char (point-min))
+         (when (re-search-forward
+                (format tag package 'incompatible-version) nil t)
+           (setcdr version (match-string idx))))))
+    version))
+
+(defun inversion-add-to-load-path (package minimum
+                                          &optional installdir
+                                          &rest subdirs)
+  "Add the PACKAGE path to `load-path' if necessary.
+MINIMUM is the minimum version requirement of PACKAGE.
+Optional argument INSTALLDIR is the base directory where PACKAGE is
+installed.  It defaults to `default-directory'/PACKAGE.
+SUBDIRS are sub-directories to add to `load-path', following the main
+INSTALLDIR path."
+  (let ((ver (inversion-find-version package)))
+    ;; If PACKAGE not found or a bad version already in `load-path',
+    ;; prepend the new PACKAGE path, so it will be loaded first.
+    (when (or (not ver)
+              (and
+               (inversion-check-version (car ver) (cdr ver) minimum)
+               (message "Outdated %s %s shadowed to meet minimum version %s"
+                        package (car ver) minimum)
+               t))
+      (let* ((default-directory
+               (or installdir
+                   (expand-file-name (format "./%s" package))))
+             subdir)
+        (when (file-directory-p default-directory)
+          ;; Add SUBDIRS
+          (while subdirs
+            (setq subdir  (expand-file-name (car subdirs))
+                  subdirs (cdr subdirs))
+            (when (file-directory-p subdir)
+              ;;(message "%S added to `load-path'" subdir)
+              (add-to-list 'load-path subdir)))
+          ;; Add the main path
+          ;;(message "%S added to `load-path'" default-directory)
+          (add-to-list 'load-path default-directory))
+       ;; We get to this point iff we do not accept or there is no
+       ;; system file.  Lets check the version of what we just
+       ;; installed... just to be safe.
+       (let ((newver (inversion-find-version package)))
+         (if (not newver)
+             (error "Failed to find version for newly installed %s"
+                    package))
+         (if (inversion-check-version (car newver) (cdr newver) minimum)
+             (error "Outdated %s %s just installed" package (car newver)))
+         )))))
+
+;;; Inversion tests
+;;
+(defun inversion-unit-test ()
+  "Test inversion to make sure it can identify different version strings."
+  (interactive)
+  (let ((c1 (inversion-package-version 'inversion))
+       (c1i (inversion-package-incompatibility-version 'inversion))
+       (c2 (inversion-decode-version  "1.3alpha2"))
+       (c3 (inversion-decode-version  "1.3beta4"))
+       (c4 (inversion-decode-version  "1.3 beta5"))
+       (c5 (inversion-decode-version  "1.3.4"))
+       (c6 (inversion-decode-version  "2.3alpha"))
+       (c7 (inversion-decode-version  "1.3"))
+       (c8 (inversion-decode-version  "1.3pre1"))
+       (c9 (inversion-decode-version  "2.4 (patch 2)"))
+       (c10 (inversion-decode-version "2.4 (patch 3)"))
+       (c11 (inversion-decode-version "2.4.2.1"))
+       (c12 (inversion-decode-version "2.4.2.2"))
+       )
+    (if (not (and
+             (inversion-= c1 c1)
+             (inversion-< c1i c1)
+             (inversion-< c2 c3)
+             (inversion-< c3 c4)
+             (inversion-< c4 c5)
+             (inversion-< c5 c6)
+             (inversion-< c2 c4)
+             (inversion-< c2 c5)
+             (inversion-< c2 c6)
+             (inversion-< c3 c5)
+             (inversion-< c3 c6)
+             (inversion-< c7 c6)
+             (inversion-< c4 c7)
+             (inversion-< c2 c7)
+             (inversion-< c8 c6)
+             (inversion-< c8 c7)
+             (inversion-< c4 c8)
+             (inversion-< c2 c8)
+             (inversion-< c9 c10)
+             (inversion-< c10 c11)
+             (inversion-< c11 c12)
+             ;; Negatives
+             (not (inversion-< c3 c2))
+             (not (inversion-< c4 c3))
+             (not (inversion-< c5 c4))
+             (not (inversion-< c6 c5))
+             (not (inversion-< c7 c2))
+             (not (inversion-< c7 c8))
+             (not (inversion-< c12 c11))
+             ;; Test the tester on inversion
+             (not (inversion-test 'inversion inversion-version))
+             ;; Test that we throw an error
+             (inversion-test 'inversion "0.0.0")
+             (inversion-test 'inversion "1000.0")
+             ))
+       (error "Inversion tests failed")
+      (message "Inversion tests passed."))))
+
+;;; URL and downloading code
+;;
+(defun inversion-locate-package-files (package directory &optional version)
+  "Get a list of distributions of PACKAGE from DIRECTORY.
+DIRECTORY can be an ange-ftp compatible filename, such as:
+ \"/ftp@ftp1.sourceforge.net/pub/sourceforge/PACKAGE\"
+If it is a URL, wget will be used for download.
+Optional argument VERSION will restrict the list of available versions
+to the file matching VERSION exactly, or nil."
+;;DIRECTORY should also allow a URL:
+;; \"http://ftp1.sourceforge.net/PACKAGE\"
+;; but then I can get file listings easily.
+  (if (symbolp package) (setq package (symbol-name package)))
+  (directory-files directory t
+                  (if version
+                      (concat "^" package "-" version "\\>")
+                    package)))
+
+(defvar inversion-package-common-tails '( ".tar.gz"
+                                        ".tar"
+                                        ".zip"
+                                        ".gz"
+                                        )
+  "Common distribution mechanisms for Emacs Lisp packages.")
+
+(defun inversion-locate-package-files-and-split (package directory &optional version)
+  "Use `inversion-locate-package-files' to get a list of PACKAGE files.
+DIRECTORY is the location where distributions of PACKAGE are.
+VERSION is an optional argument specifying a version to restrict to.
+The return list is an alist with the version string in the CAR,
+and the full path name in the CDR."
+  (if (symbolp package) (setq package (symbol-name package)))
+  (let ((f (inversion-locate-package-files package directory version))
+       (out nil))
+    (while f
+      (let* ((file (car f))
+            (dist (file-name-nondirectory file))
+            (tails inversion-package-common-tails)
+            (verstring nil))
+       (while (and tails (not verstring))
+         (when (string-match (concat (car tails) "$") dist)
+           (setq verstring
+                 (substring dist (1+ (length package)) (match-beginning 0))))
+         (setq tails (cdr tails)))
+       (if (not verstring)
+           (error "Cannot decode version for %s" dist))
+       (setq out
+             (cons
+              (cons verstring file)
+              out))
+       (setq f (cdr f))))
+    out))
+
+(defun inversion-download-package-ask (err package directory version)
+  "Due to ERR, offer to download PACKAGE from DIRECTORY.
+The package should have VERSION available for download."
+  (if (symbolp package) (setq package (symbol-name package)))
+  (let ((files (inversion-locate-package-files-and-split
+               package directory version)))
+    (if (not files)
+       (error err)
+      (if (not (y-or-n-p (concat err ": Download update? ")))
+         (error err)
+       (let ((dest (read-directory-name (format "Download %s to: "
+                                                package)
+                                        t)))
+         (if (> (length files) 1)
+             (setq files
+                   (list
+                    "foo" ;; ignored
+                    (read-file-name "Version to download: "
+                                    directory
+                                    files
+                                    t
+                                    (concat
+                                     (file-name-as-directory directory)
+                                     package)
+                                    nil))))
+
+         (copy-file (cdr (car files)) dest))))))
+
+(defun inversion-upgrade-package (package &optional directory)
+  "Try to upgrade PACKAGE in DIRECTORY is available."
+  (interactive "sPackage to upgrade: ")
+  (if (stringp package) (setq package (intern package)))
+  (if (not directory)
+      ;; Hope that the package maintainer specified.
+      (setq directory (symbol-value (or (intern-soft
+                                        (concat (symbol-name package)
+                                                "-url"))
+                                       (intern-soft
+                                        (concat (symbol-name package)
+                                                "-directory"))))))
+  (let ((files (inversion-locate-package-files-and-split
+               package directory))
+       (cver (inversion-package-version package))
+       (newer nil))
+    (mapc (lambda (f)
+           (if (inversion-< cver (inversion-decode-version (car f)))
+               (setq newer (cons f newer))))
+           files)
+    newer
+    ))
+
+;; (inversion-upgrade-package
+;;  'semantic
+;;  "/ftp@ftp1.sourceforge.net:/pub/sourceforge/cedet")
+
+;; "/ftp@ftp1.sourceforge.net:/pub/sourceforge/cedet"
+(provide 'inversion)
+
+;;; inversion.el ends here
diff --git a/lisp/cedet/pulse.el b/lisp/cedet/pulse.el
new file mode 100644 (file)
index 0000000..e8a9b11
--- /dev/null
@@ -0,0 +1,397 @@
+;;; pulse.el --- Pulsing Overlays
+
+;;; 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:
+;;
+;; Manage temporary pulsing of faces and overlays.
+;;
+;; This is a temporal decoration technique where something is to be
+;; highlighted briefly.  This adds a gentle pulsing style to the text
+;; decorated this way.
+;;
+;; Useful user functions:
+;;
+;; `pulse-enable-integration-advice' - Turn on advice to make various
+;;      Emacs commands pulse, such as `goto-line', or `find-tag'.
+;;
+;; The following are useful entry points:
+;;
+;; `pulse' - Cause `pulse-highlight-face' to shift toward background color.
+;;      Assumes you are using a version of Emacs that supports pulsing.
+;;
+;;
+;; `pulse-momentary-highlight-one-line' - Pulse a single line at POINT.
+;; `pulse-momentary-highlight-region' - Pulse a region.
+;; `pulse-momentary-highlight-overlay' - Pulse an overlay
+;;      These three functions will just blink the specified area if
+;;      the version of Emacs you are using doesn't support pulsing.
+;;
+;; `pulse-line-hook-function' - A simple function that can be used in a
+;;      hook that will pulse whatever line the cursor is on.
+;;
+;;; History:
+;;
+;; The original pulse code was written for semantic tag highlighting.
+;; It has been extracted, and adapted for general purpose pulsing.
+;;
+;; Pulse is a part of CEDET.  http://cedet.sf.net
+
+
+(defun  pulse-available-p ()
+  "Return non-nil if pulsing is available on the current frame."
+  (condition-case nil
+      (let ((v (color-values (face-background 'default))))
+       (numberp (car-safe v)))
+    (error nil)))
+
+(defcustom pulse-flag (pulse-available-p)
+  "*Non-nil means to pulse the overlay face for momentary highlighting.
+Pulsing involves a bright highlight that slowly shifts to the background
+color.  Non-nil just means to highlight with an unchanging color for a short
+time.
+
+If `pulse-flag' is non-nil, but `pulse-available-p' is nil, then
+this flag is ignored."
+  :group 'pulse
+  :type 'boolean)
+
+(defface pulse-highlight-start-face
+  '((((class color) (background dark))
+     (:background "#AAAA33"))
+    (((class color) (background light))
+     (:background "#FFFFAA")))
+  "*Face used at beginning of a highight."
+  :group 'pulse)
+
+(defface pulse-highlight-face
+  '((((class color) (background dark))
+     (:background "#AAAA33"))
+    (((class color) (background light))
+     (:background "#FFFFAA")))
+  "*Face used during a pulse for display.  *DO NOT CUSTOMIZE*
+Face used for temporary highlighting of tags for effect."
+  :group 'pulse)
+
+;;; Compatibility
+(defalias 'pulse-overlay-live-p 'overlay-buffer)
+(defalias 'pulse-overlay-put 'overlay-put)
+(defalias 'pulse-overlay-get 'overlay-get)
+(defalias 'pulse-overlay-delete 'delete-overlay)
+(defalias 'pulse-make-overlay 'make-overlay)
+
+(when (featurep 'xemacs)
+  (defalias 'pulse-overlay-live-p
+    (lambda (o)
+      (and (extent-live-p o)
+          (not (extent-detached-p o))
+          (bufferp (extent-buffer o)))))
+  (defalias 'pulse-overlay-put 'set-extent-property)
+  (defalias 'pulse-overlay-get 'extent-property)
+  (defalias 'pulse-overlay-delete 'delete-extent)
+  (defalias 'pulse-make-overlay 'make-extent))
+
+;;; Code:
+;;
+(defun pulse-int-to-hex (int &optional nb-digits)
+  "Convert integer argument INT to a #XXXXXXXXXXXX format hex string.
+Each X in the output string is a hexadecimal digit.
+NB-DIGITS is the number of hex digits.  If INT is too large to be
+represented with NB-DIGITS, then the result is truncated from the
+left.  So, for example, INT=256 and NB-DIGITS=2 returns \"00\", since
+the hex equivalent of 256 decimal is 100, which is more than 2 digits.
+
+This function was blindly copied from hexrgb.el by Drew Adams.
+http://www.emacswiki.org/cgi-bin/wiki/hexrgb.el"
+  (setq nb-digits (or nb-digits 4))
+  (substring (format (concat "%0" (int-to-string nb-digits) "X") int) (- nb-digits)))
+
+(defun pulse-color-values-to-hex (values)
+  "Convert list of rgb color VALUES to a hex string, #XXXXXXXXXXXX.
+Each X in the string is a hexadecimal digit.
+Input VALUES is as for the output of `x-color-values'.
+
+This function was blindly copied from hexrgb.el by Drew Adams.
+http://www.emacswiki.org/cgi-bin/wiki/hexrgb.el"
+  (concat "#"
+          (pulse-int-to-hex (nth 0 values) 4) ; red
+          (pulse-int-to-hex (nth 1 values) 4) ; green
+          (pulse-int-to-hex (nth 2 values) 4))) ; blue
+
+(defcustom pulse-iterations 10
+  "Number of iterations in a pulse operation."
+  :group 'pulse
+  :type 'number)
+(defcustom pulse-delay .03
+  "Delay between face lightening iterations, as used by `sit-for'."
+  :group 'pulse
+  :type 'number)
+
+(defun pulse-lighten-highlight ()
+  "Lighten the face by 1/`pulse-iterations' toward the background color.
+Return t if there is more drift to do, nil if completed."
+  (if (>= (get 'pulse-highlight-face :iteration) pulse-iterations)
+      nil
+    (let* ((frame (color-values (face-background 'default)))
+          (start (color-values (face-background
+                                (get 'pulse-highlight-face
+                                     :startface))))
+          (frac  (list (/ (- (nth 0 frame) (nth 0 start)) pulse-iterations)
+                       (/ (- (nth 1 frame) (nth 1 start)) pulse-iterations)
+                       (/ (- (nth 2 frame) (nth 2 start)) pulse-iterations)))
+          (it (get 'pulse-highlight-face :iteration))
+          )
+      (set-face-background 'pulse-highlight-face
+                          (pulse-color-values-to-hex
+                           (list
+                            (+ (nth 0 start) (* (nth 0 frac) it))
+                            (+ (nth 1 start) (* (nth 1 frac) it))
+                            (+ (nth 2 start) (* (nth 2 frac) it)))))
+      (put 'pulse-highlight-face :iteration (1+ it))
+      (if (>= (1+ it) pulse-iterations)
+         nil
+       t))))
+
+(defun pulse-reset-face (&optional face)
+  "Reset the pulse highlighting FACE."
+  (set-face-background 'pulse-highlight-face
+                      (if face
+                          (face-background face)
+                        (face-background 'pulse-highlight-start-face)
+                        ))
+  (put 'pulse-highlight-face :startface (or face
+                                           'pulse-highlight-start-face))
+  (put 'pulse-highlight-face :iteration 0))
+
+(defun pulse (&optional face)
+  "Pulse the colors on our highlight face.
+If optional FACE is provide, reset the face to FACE color,
+instead of `pulse-highlight-start-face'.
+Be sure to call `pulse-reset-face' after calling pulse."
+  (unwind-protect
+      (progn
+       (pulse-reset-face face)
+       (while (and (pulse-lighten-highlight)
+                   (sit-for pulse-delay))
+         nil))
+    ))
+
+(defun pulse-test (&optional no-error)
+  "Test the lightening function for pulsing a line.
+When optional NO-ERROR Don't throw an error if we can't run tests."
+  (interactive)
+  (if (or (not pulse-flag) (not (pulse-available-p)))
+      (if no-error
+         nil
+       (error (concat "Pulse test only works on versions of Emacs"
+                      " that support pulsing")))
+    ;; Run the tests
+    (when (interactive-p)
+      (message "<Press a key> Pulse one line.")
+      (read-char))
+    (pulse-momentary-highlight-one-line (point))
+    (when (interactive-p)
+      (message "<Press a key> Pulse a region.")
+      (read-char))
+    (pulse-momentary-highlight-region (point)
+                                     (save-excursion
+                                       (condition-case nil
+                                           (forward-char 30)
+                                         (error nil))
+                                       (point)))
+    (when (interactive-p)
+      (message "<Press a key> Pulse line a specific color.")
+      (read-char))
+    (pulse-momentary-highlight-one-line (point) 'modeline)
+    (when (interactive-p)
+      (message "<Press a key> Pulse a pre-existing overlay.")
+      (read-char))
+    (let* ((start (point-at-bol))
+          (end (save-excursion
+                 (end-of-line)
+                 (when (not (eobp))
+                   (forward-char 1))
+                 (point)))
+          (o (pulse-make-overlay start end))
+          )
+      (pulse-momentary-highlight-overlay o)
+      (if (pulse-overlay-live-p o)
+         (pulse-overlay-delete o)
+       (error "Non-temporary overlay was deleted!"))
+      )
+    (when (interactive-p)
+      (message "Done!"))))
+
+
+;;; Convenience Functions
+;;
+(defvar pulse-momentary-overlay nil
+  "The current pulsing overlay.")
+
+(defun pulse-momentary-highlight-overlay (o &optional face)
+  "Pulse the overlay O, unhighlighting before next command.
+Optional argument FACE specifies the fact to do the highlighting."
+  (pulse-overlay-put o 'original-face (pulse-overlay-get o 'face))
+  (add-to-list 'pulse-momentary-overlay o)
+  (if (or (not pulse-flag) (not (pulse-available-p)))
+      ;; Provide a face... clear on next command
+      (progn
+       (pulse-overlay-put o 'face (or face 'pulse-highlight-start-face))
+       (add-hook 'pre-command-hook
+                 'pulse-momentary-unhighlight)
+       )
+    ;; pulse it.
+    (unwind-protect
+       (progn
+         (pulse-overlay-put o 'face 'pulse-highlight-face)
+         ;; The pulse function puts FACE onto 'pulse-highlight-face.
+         ;; Thus above we put our face on the overlay, but pulse
+         ;; with a reference face needed for the color.
+         (pulse face))
+      (pulse-momentary-unhighlight))
+    )
+  )
+
+(defun pulse-momentary-unhighlight ()
+  "Unhighlight a line recently highlighted."
+  ;; If someone passes in an overlay, then pulse-momentary-overlay
+  ;; will still be nil, and won't need modifying.
+  (when pulse-momentary-overlay
+    ;; clear the starting face
+    (mapc
+     (lambda (ol)
+       (pulse-overlay-put ol 'face (pulse-overlay-get ol 'original-face))
+       (pulse-overlay-put ol 'original-face nil)
+       ;; Clear the overlay if it needs deleting.
+       (when (pulse-overlay-get ol 'pulse-delete) (pulse-overlay-delete ol)))
+     pulse-momentary-overlay)
+
+    ;; Clear the variable.
+    (setq pulse-momentary-overlay nil))
+
+  ;; Reset the pulsing face.
+  (pulse-reset-face)
+
+  ;; Remove this hook.
+  (remove-hook 'pre-command-hook 'pulse-momentary-unhighlight)
+  )
+
+(defun pulse-momentary-highlight-one-line (point &optional face)
+  "Highlight the line around POINT, unhighlighting before next command.
+Optional argument FACE specifies the face to do the highlighting."
+  (let ((start (point-at-bol))
+       (end (save-excursion
+              (end-of-line)
+              (when (not (eobp))
+                (forward-char 1))
+              (point))))
+    (pulse-momentary-highlight-region start end face)
+    ))
+
+(defun pulse-momentary-highlight-region (start end &optional face)
+  "Highlight between START and END, unhighlighting before next command.
+Optional argument FACE specifies the fact to do the highlighting."
+  (let ((o (pulse-make-overlay start end)))
+    ;; Mark it for deletion
+    (pulse-overlay-put o 'pulse-delete t)
+    (pulse-momentary-highlight-overlay o face)))
+
+;;; Random integration with other tools
+;;
+(defvar pulse-command-advice-flag nil
+  "Non-nil means pulse advice is active.
+To active pulse advice, use `pulse-enable-integration-advice'.")
+
+(defun pulse-toggle-integration-advice (arg)
+  "Toggle activation of advised functions that will now pulse.
+Wint no ARG, toggle the pulse advice.
+With a negative ARG, disable pulse advice.
+With a positive ARG, enable pulse advice.
+Currently advised functions include:
+  `goto-line'
+  `exchange-point-and-mark'
+  `find-tag'
+  `tags-search'
+  `tags-loop-continue'
+  `pop-tag-mark'
+  `imenu-default-goto-function'
+Pulsing via `pulse-line-hook-function' has also been added to
+the following hook:
+  `next-error-hook'"
+  (interactive "P")
+  (if (null arg)
+      (setq pulse-command-advice-flag (not pulse-command-advice-flag))
+    (if (< (prefix-numeric-value arg) 0)
+       (setq pulse-command-advice-flag nil)
+      (setq pulse-command-advice-flag t)
+      )
+    )
+  (if pulse-command-advice-flag
+      (message "Pulse advice enabled")
+    (message "Pulse advice disabled"))
+  )
+
+(defadvice goto-line (after pulse-advice activate)
+  "Cause the line that is `goto'd to pulse when the cursor gets there."
+  (when (and pulse-command-advice-flag (interactive-p))
+    (pulse-momentary-highlight-one-line (point))))
+
+(defadvice exchange-point-and-mark (after pulse-advice activate)
+  "Cause the line that is `goto'd to pulse when the cursor gets there."
+  (when (and pulse-command-advice-flag (interactive-p)
+            (> (abs (- (point) (mark))) 400))
+    (pulse-momentary-highlight-one-line (point))))
+
+(defadvice find-tag (after pulse-advice activate)
+  "After going to a tag, pulse the line the cursor lands on."
+  (when (and pulse-command-advice-flag (interactive-p))
+    (pulse-momentary-highlight-one-line (point))))
+
+(defadvice tags-search (after pulse-advice activate)
+  "After going to a hit, pulse the line the cursor lands on."
+  (when (and pulse-command-advice-flag (interactive-p))
+    (pulse-momentary-highlight-one-line (point))))
+
+(defadvice tags-loop-continue (after pulse-advice activate)
+  "After going to a hit, pulse the line the cursor lands on."
+  (when (and pulse-command-advice-flag (interactive-p))
+    (pulse-momentary-highlight-one-line (point))))
+
+(defadvice pop-tag-mark (after pulse-advice activate)
+  "After going to a hit, pulse the line the cursor lands on."
+  (when (and pulse-command-advice-flag (interactive-p))
+    (pulse-momentary-highlight-one-line (point))))
+
+(defadvice imenu-default-goto-function (after pulse-advice activate)
+  "After going to a tag, pulse the line the cursor lands on."
+  (when pulse-command-advice-flag
+    (pulse-momentary-highlight-one-line (point))))
+
+(defun pulse-line-hook-function ()
+  "Function used in hooks to pulse the current line.
+Only pulses the line if `pulse-command-advice-flag' is non-nil."
+  (when pulse-command-advice-flag
+    (pulse-momentary-highlight-one-line (point))))
+
+(add-hook 'next-error-hook 'pulse-line-hook-function)
+
+(provide 'pulse)
+
+;;; pulse.el ends here