procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

* cedet/cedet-cscope.el:

Browse source 
* cedet/cedet-files.el:
* cedet/cedet-global.el:
* cedet/cedet-idutils.el:
* cedet/data-debug.el:
* cedet/inversion.el:
* cedet/pulse.el: New files.
This commit is contained in:
Chong Yidong 2009-09-28 01:28:41 +00:00
parent 748e162f10
commit 666fd2cc65
8 changed files with 2483 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
lisp/ChangeLog
View file

@ -8,6 +8,14 @@
* emacs-lisp/eieio-speedbar.el:
* emacs-lisp/eieio.el: New files.
* cedet/cedet-cscope.el:
* cedet/cedet-files.el:
* cedet/cedet-global.el:
* cedet/cedet-idutils.el:
* cedet/data-debug.el:
* cedet/inversion.el:
* cedet/pulse.el: New files.
2009-09-27 Chong Yidong <cyd@stupidchicken.com>
* menu-bar.el: Remove menu-bar-ediff-misc-menu from the Tools

157
lisp/cedet/cedet-cscope.el Normal file
View file

@ -0,0 +1,157 @@
;;; cedet-cscope.el --- CScope support for CEDET
;;; Copyright (C) 2009 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:
(declare-function inversion-check-version "inversion")
(defvar cedet-cscope-min-version "16.0"
"Minimum version of CScope 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))))
(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 CScope 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

92
lisp/cedet/cedet-files.el Normal file
View file

@ -0,0 +1,92 @@
;;; cedet-files.el --- Common routines dealing with file names.
;;; 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:
;;
;; Various useful routines for dealing with file names in the tools
;; which are a part of CEDET.
;;; Code:
(defun cedet-directory-name-to-file-name (referencedir &optional testmode)
"Convert the REFERENCEDIR (a full path name) into a filename.
Convert directory seperation characters into ! characters.
Optional argument TESTMODE is used by tests to avoid conversion
to the file's truename, and dodging platform tricks."
(let ((file referencedir))
;; Expand to full file name
(when (not testmode)
(setq file (file-truename file)))
;; If FILE is a directory, then force it to end in /.
(when (file-directory-p file)
(setq file (file-name-as-directory file)))
;; Handle Windows Special cases
(when (or (memq system-type '(windows-nt ms-dos)) testmode)
;; Replace any invalid file-name characters (for the
;; case of backing up remote files).
(when (not testmode)
(setq file (expand-file-name (convert-standard-filename file))))
;; Normalize DOSish file names.
(if (eq (aref file 1) ?:)
(setq file (concat "/"
"drive_"
(char-to-string (downcase (aref file 0)))
(if (eq (aref file 2) ?/)
""
"/")
(substring file 2)))))
;; Make the name unique by substituting directory
;; separators. It may not really be worth bothering about
;; doubling `!'s in the original name...
(setq file (subst-char-in-string
?/ ?!
(replace-regexp-in-string "!" "!!" file)))
file))
(defun cedet-file-name-to-directory-name (referencefile &optional testmode)
"Reverse the process of `cedet-directory-name-to-file-name'.
Convert REFERENCEFILE to a directory name replacing ! with /.
Optional TESTMODE is used in tests to avoid doing some platform
specific conversions during tests."
(let ((file referencefile))
;; Replace the ! with /
(setq file (subst-char-in-string ?! ?/ file))
;; Occurances of // meant there was once a single !.
(setq file (replace-regexp-in-string "//" "!" file))
;; Handle Windows special cases
(when (or (memq system-type '(windows-nt ms-dos)) testmode)
;; Handle drive letters from DOSish file names.
(when (string-match "^/drive_\\([a-z]\\)/" file)
(let ((driveletter (match-string 1 file))
)
(setq file (concat driveletter ":"
(substring file (match-end 1))))))
;; Handle the \\file\name nomenclature on some windows boxes.
(when (string-match "^!" file)
(setq file (concat "//" (substring file 1)))))
file))
(provide 'cedet-files)
;;; cedet-files.el ends here

162
lisp/cedet/cedet-global.el Normal file
View file

@ -0,0 +1,162 @@
;;; 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.
(declare-function inversion-check-version "inversion")
(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)))))))
(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

181
lisp/cedet/cedet-idutils.el Normal file
View file

@ -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:
(declare-function inversion-check-version "inversion")
(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)))))
(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

1085
lisp/cedet/data-debug.el Normal file
View file

File diff suppressed because it is too large Load diff

541
lisp/cedet/inversion.el Normal file
View file

@ -0,0 +1,541 @@
;;; 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)))
)))))
;;; 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))))))
;;; How we upgrade packages in Emacs has yet to be ironed out.
;; (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
;; ))
(provide 'inversion)
;;; inversion.el ends here

257
lisp/cedet/pulse.el Normal file
View file

@ -0,0 +1,257 @@
;;; 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)
;;; 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))))
;;; 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."
(overlay-put o 'original-face (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
(overlay-put o 'face (or face 'pulse-highlight-start-face))
(add-hook 'pre-command-hook
'pulse-momentary-unhighlight)
)
;; pulse it.
(unwind-protect
(progn
(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)
(overlay-put ol 'face (overlay-get ol 'original-face))
(overlay-put ol 'original-face nil)
;; Clear the overlay if it needs deleting.
(when (overlay-get ol 'pulse-delete) (delete-overlay 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 (make-overlay start end)))
;; Mark it for deletion
(overlay-put o 'pulse-delete t)
(pulse-momentary-highlight-overlay o face)))
;;; Random integration with other tools
(defvar pulse-command-advice-flag nil)
(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))))
(provide 'pulse)
;;; pulse.el ends here