CVS update by michaels packages/xemacs-packages/cedet-common
ChangeLog
xemacs-cvs at xemacs.org
xemacs-cvs at xemacs.org
Mon Nov 26 10:07:27 EST 2007
User: michaels
Date: 07/11/26 16:07:27
Added: packages/xemacs-packages/cedet-common ChangeLog
ChangeLog.upstream Makefile Makefile.upstream
Project.ede cedet-autogen.el cedet-compat.el
cedet-edebug.el cedet-files.el cedet-load.el
cedet-loaddefs.el cedet.el ezimage.el
ezimage.el.upstream fame.el inversion.el
mode-local.el package-info.in pprint.el sformat.el
working.el
packages/xemacs-packages/cedet-common/icons Makefile
Project.ede bits.xpm bitsbang.xpm box-minus.xpm
box-plus.xpm box.xpm checkmark.xpm dir-minus.xpm
dir-plus.xpm dir.xpm doc-minus.xpm doc-plus.xpm
doc.xpm info.xpm key.xpm label.xpm lock.xpm
mail.xpm page-minus.xpm page-plus.xpm page.xpm
tag-gt.xpm tag-minus.xpm tag-plus.xpm tag-type.xpm
tag-v.xpm tag.xpm unlock.xpm
Log:
Import cedet-common from CEDET 1.0pre4.
Revision Changes Path
1.1 XEmacs/packages/xemacs-packages/cedet-common/ChangeLog
Index: ChangeLog
===================================================================
2007-10-30 Mike Sperber <mike at xemacs.org>
* cedet.el (cedet-version):
* ezimage.el: Comment out load-path hackery.
(ezimage-find-image-on-load-path): Fix superfluous slashes in
directory search.
* Makefile (AUTHOR_VERSION): Import from CEDET 1.0pre4.
1.1 XEmacs/packages/xemacs-packages/cedet-common/ChangeLog.upstream
Index: ChangeLog.upstream
===================================================================
2007-06-06 Eric M. Ludlam <zappo at gnu.org>
* Project.ede ("common"): regress to prerelease 4
* Makefile (VERSION): Regress to prerelease 4
* cedet.el (cedet-version): Regress back to prerelease 4
(cedet-packages): Regress some packages back to prerelease 4
2007-05-20 Eric M. Ludlam <zappo at gnu.org>
* Makefile (common_LISP): Added cedet-files.el.
* Project.ede ("common"): Add cedet-files.el.
* cedet-files.el (cedet-dir-sep-char): Replace semanticdb-dir-sep-char.
(cedet-directory-name-to-file-name): New.
Copied from semanticdb-file.el, semanticdb-file-name-directory.
* cedet-compat.el (subst-char-in-string):
Compat fcn if it doesn't exist.
2007-05-10 Eric M. Ludlam <zappo at gnu.org>
* cedet-edebug.el (edebug-setup-hook, debugger-mode-hook):
Add "A" binding into adebug
for displaying the values of some variables.
2007-02-19 Eric M. Ludlam <zappo at gnu.org>
* working.el: (working-mode-line-update)
(working-run-with-timer, working-cancel-timer): Fix byte-comp issues.
* inversion.el (inversion-decode-version): Use string-to-number.
(inversion-find-version): Add autoload cookie.
* cedet.el (cedet-version): Move. Try to fix byte-comp warnings.
2006-02-09 Eric M. Ludlam <zappo at gnu.org>
* inversion.el (inversion-find-version):
Don't load in the whole file while
scanning for revision numbers.
(inversion-add-to-load-path): After adding a load path, make
sure the new file has the correct revision number.
2006-02-08 David Ponce <david at dponce.com>
* inversion.el (inversion-add-to-load-path):
Don't signal an error when shadowing
an outdated package.
2006-02-08 Eric M. Ludlam <zappo at gnu.org>
* icons/Makefile (VERSION): Updated
* Project.ede (:version): updated (removed)
* Makefile (VERSION): updated
* cedet.el (cedet-version): Updated
(cedet-packages): Revised all version numbers.
(cedet-version): Improved output table for use w/ PRERELEASE CHECKIST.
* inversion.el (inversion-version): Update version number
(inversion-add-to-load-path): Throw error if revision mismatch.
2006-01-30 David Ponce <david at dponce.com>
* mode-local.el (define-mode-local-override):
Set the `definition-name' of the
symbol generated for the mode local function, so find-func (since
Emacs 22) can locate it.
2005-12-07 Eric M. Ludlam <zappo at gnu.org>
* ezimage.el: Doc Fixes.
2005-10-13 David Ponce <david at dponce.com>
* cedet.el (cedet-packages): Update speedbar version requirement.
2005-09-30 Eric M. Ludlam <zappo at gnu.org>
* cedet.el, working.el, pprint.el, mode-local.el, inversion.el, fame.el, ezimage.el, cedet-load.el, cedet-compat.el, cedet-autogen.el:
Update all GPL headers with script from savannah.gnu.org.
* inversion.el (inversion-decoders):
Make more robust to some spacing issues.
(inversion-decode-version): Allow for empty alpha/beta values. (Assume 1)
(inversion-unit-test): Apply some whitespace issues to prove robustness.
2005-09-29 Eric M. Ludlam <zappo at gnu.org>
* mode-local.el (find-func): New require.
2005-09-01 Eric M. Ludlam <zappo at gnu.org>
* inversion.el (inversion-check-version): doc fix
2005-06-30 Eric M. Ludlam <zappo at gnu.org>
* Project.ede (:version): Updated.
* icons/Makefile, Makefile (VERSION): Updated.
* cedet.el (cedet-version): Updated
(cedet-packages): Updated
* cedet.el (cedet-version): New command.
2005-05-06 Eric M. Ludlam <zappo at gnu.org>
* icons/Makefile (VERSION): Updated version.
* Project.ede ("common"): Updated version.
* Makefile (VERSION): Updated
(autoloads,init,setup,common): Quotes around EMACS.
* cedet.el (cedet-version): Update revision
(cedet-packages): Update revisions of dependent packages.
2005-04-20 Eric M. Ludlam <zappo at gnu.org>
* inversion.el (inversion-version): Updated
(inversion-unit-test): Added tests for new "prerelease" decoder.
2005-04-19 David Ponce <david at dponce.com>
* inversion.el (inversion-decoders):
Rename from inversion-decoder-ring. Define
as constant. Fix prerelease regexp and doc string.
(inversion-decode-version)
(inversion-release-to-number): Update.
2005-04-19 Eric M. Ludlam <zappo at gnu.org>
* inversion.el (speedbar-incompatible-version):
Support pre-release notation.
* icons/Makefile, Makefile (VERSION): Updated.
* Project.ede ("common"): Update Version number
* cedet.el: Update Version Numbers.
2005-03-24 David Ponce <david at dponce.com>
* mode-local.el (activate-mode-local-bindings):
Fix call to `local-variable-p' for
XEmacs compatibility.
2005-02-22 Eric M. Ludlam <zappo at gnu.org>
* mode-local.el (find-function-regexp):
Modify it so that `find-function' can find
overloaded symbols.
2005-02-03 Eric M. Ludlam <zappo at gnu.org>
* icons/Makefile (VERSION): Updated version number
* cedet.el (cedet-version): Update version number.
* Makefile (VERSION): Update version number
* Project.ede ("common"): Update versin number.
2005-01-10 David Ponce <david at dponce.com>
* mode-local.el (activate-mode-local-bindings):
Return previous bindings of
buffer-local variables overridden by mode-local bindings.
(with-mode-local): Restore buffer-local bindings overridden by
mode-local bindings.
2004-12-13 David Ponce <david at dponce.com>
* working.el (working-noninteractive): Fixed definition.
2004-11-29 David Ponce <david at dponce.com>
* fame.el: (fame-valid-level-values)
(fame-display-choice): Accept 'temp-nolog and 'nolog.
(fame-level-widget, fame-channel-widget): Format change.
(fame-temp-message-internal): New function.
(fame-temp-message): Use it.
(fame-temp-message-nolog): New function.
(fame-send-functions-alist): New internal constant.
(fame-send): Use it.
(define-fame-channel): Accept a doc string. Fix generated doc
string.
2004-11-25 David Ponce <david at dponce.com>
* Makefile: Re-generate.
* Project.ede ("common"): Add fame.el to source.
* working.el (fame): Require.
(working-noninteractive): New function.
(working-message-echo): Use it and `fame-message-nolog'.
(working-message-emacs, working-message-xemacs): Remove.
(working-current-message): Alias of `fame-current-message'.
(working-temp-message): Alias of `fame-temp-message'.
(working-temp-message-timer, working-temp-message-delay)
(working-temp-restore-message): Remove.
* fame.el: New library.
2004-09-08 David Ponce <david at dponce.com>
* working.el (working-temp-restore-message):
Fix error when saved message text
contains percent characters.
2004-07-30 Eric M. Ludlam <zappo at gnu.org>
* mode-local.el: Updated Commentary.
* cedet.el: Update required version of semantic.
2004-07-21 Eric M. Ludlam <zappo at gnu.org>
* icons/Makefile (VERSION): update to beta3
(Makefile): Regenerated
* Makefile (VERSION): Update to beta3
* Project.ede ("common"): Update version number.
* cedet.el (cedet-version): Updated to beta3
2004-07-20 Eric M. Ludlam <zappo at gnu.org>
* Makefile (misc_AUX): New
(dist): Add misc_AUX
* Project.ede ("misc"): New target.
2004-06-29 David Ponce <david at dponce.com>
* working.el: New feature to display messages temporarily.
(working-temp-message-delay, working-temp-message-timer)
(working-temp-message-saved): New variables.
(working-temp-restore-message)
(working-temp-message): New functions.
2004-06-24 David Ponce <david at dponce.com>
* mode-local.el (mode-local-define-derived-mode-needed-p):
New function.
(define-derived-mode): Advice if the above returns non-nil.
(mode-local--init-mode): New variable.
(mode-local-initialized-p): New function.
(mode-local-post-major-mode-change): Use it.
(activate-mode-local-bindings): Register the major mode for which
bindings have been activated in current buffer.
(deactivate-mode-local-bindings): Unregister it.
* cedet.el:
Run every package setup after the `load-path' has been changed.
2004-05-12 David Ponce <david at dponce.com>
* mode-local.el (cl): Require at compile time.
(define-derived-mode): Advise to workaround a bug in XEmacs
implementation, which don't set the `derived-mode-parent'
property.
2004-04-29 David Ponce <david at dponce.com>
* icons/Makefile, Makefile: Rebuild.
* Project.ede ("common"): Add mode-local.el to source.
2004-04-28 David Ponce <david at dponce.com>
* mode-local.el: New file.
2004-04-11 Eric M. Ludlam <zappo at gnu.org>
* Makefile (dist): Add autoloads
2004-04-08 David Ponce <david at dponce.com>
* pprint.el (pprint-nil): Remove.
(pprint-nil-as-list): New function.
(pprint-lambda, pprint-defun): Use it.
(pprint-let): Likewise. Improve pretty-printing of let bindings.
(pprint-function): Fix error message.
2004-04-06 Eric M. Ludlam <zappo at gnu.org>
* Makefile (dist): Distribute the autoload file
2004-03-30 Eric M. Ludlam <zappo at gnu.org>
* Makefile (Makefile):
Updated with info for when Makefile is out of date.
2004-03-28 David Ponce <david at dponce.com>
* cedet.el (let): Revert previous change.
2004-03-28 Eric M. Ludlam <zappo at gnu.org>
* cedet.el (cedet-packages): Added cedet-contrib
(inline code): Allow both package-load and package to be loaded.
2004-03-11 Eric M. Ludlam <zappo at gnu.org>
* cedet-autogen.el (cedet-batch-update-autoloads):
When an error occurs, display both the
error message, and the more friendly usage message.
2004-02-12 Eric M. Ludlam <zappo at gnu.org>
* cedet.el (cedet-version): Updated.
* icons/Makefile (VERSION): updated.
* Makefile (common_LISP): Added cedet-edebug.
(VERSION): Updated.
(all lisp compilation rules): updated EDE.
* Project.ede (version): Update to beta 2.
* Project.ede (common): Added cedet-edebug.el.
* cedet-edebug.el (eieio,semantic-tag): Removed these dependencies.
(cedet-edebug-prin1-extensions): Removed contents.
(cedet-edebug-rebuild-prin1): Change name of generated function.
(cedet-edebug-prin1-to-string): New fcn.
(cedet-edebug-add-print-override): New utility function.
(edebug-setup-hook): Add autoload cookie.
2003-12-29 Eric M. Ludlam <zappo at gnu.org>
* working.el: Zajcev Evgeny:
(senator-try-expand-semantic): Better check for minibuffer in a window.
2003-12-11 Eric M. Ludlam <zappo at gnu.org>
* cedet-edebug.el: Extensions to edebug for projects in CEDET.
2003-11-20 Eric M. Ludlam <zappo at gnu.org>
* cedet-autogen.el, ezimage.el: Merged with cedet-1p0beta1 branch.
2003-11-17 David Ponce <david at dponce.com>
* cedet-autogen.el (cedet-autogen-ensure-default-file):
Split "Local variables:"
string that confuses `hack-local-variables'.
2003-11-14 David Ponce <david at dponce.com>
* cedet-autogen.el (cedet-autogen-kill-xemacs-autoloads-feature):
Fix regexp.
(cedet-autogen-ensure-default-file): New function.
(cedet-update-autoloads): Use it.
2003-11-09 Eric M. Ludlam <zappo at gnu.org>
* ezimage.el (ezimage-image-over-string):
Always return the string, even if we do
not put an image over it.
2003-10-22 Eric M. Ludlam <zappo at gnu.org>
* icons/Makefile: EDE Makefile for icons.
* icons/Project.ede: EDE Project file for icons.
2003-10-02 Eric M. Ludlam <zappo at gnu.org>
* Project.ede: Now a meta-subproject.
* Makefile (dist): Remove local creation of tar file.
(icons): New target
(all): add icons.
2003-10-01 David Ponce <david at dponce.com>
* Makefile: Re-generate.
* Project.ede (common): Add cedet-compat.el to target sources.
* cedet-compat.el: New file.
2003-09-24 David Ponce <david at dponce.com>
* cedet.el (cedet-packages): Update minimum version requirements.
* Makefile: Re-generate.
* Project.ede (common):
Add sformat.el and working.el to target sources.
* sformat.el, working.el: New file, moved from semantic.
2003-09-23 David Ponce <david at dponce.com>
* inversion.el (inversion-add-to-load-path):
INSTALLDIR actually specifies where
PACKAGE is installed.
* cedet.el (cedet-version): Change to 1.0beta1.
(cedet-packages): Add "cedet".
Handle package installed in a directory with a different name.
* Makefile, Project.ede, cedet-load.el: New file.
2003-09-17 David Ponce <david at dponce.com>
* cedet.el (cedet-packages):
No more need an explicit setup file to load.
Automatically require the PACKAGE-load feature.
2003-09-08 David Ponce <david at dponce.com>
* cedet.el (cl): Require at compile time.
(cedet-packages): Update versions. Add autoloads setup.
(main let): Don't setq default-directory. Use dolist. load the
setup library, don't require it. Don't stop if failed to load a setup
library. Print an error message and continue.
2003-09-06 Eric M. Ludlam <zappo at gnu.org>
* inversion.el (inversion-version): Update current version.
* inversion.el (inversion-require, inversion-upgrade-package):
add autoload cookie.
* cedet-autogen.el (cedet-update-autoloads): Autoload cookie.
2003-09-05 David Ponce <david at dponce.com>
* cedet-autogen.el (cedet-update-autoloads):
Also accept an explicit list of
directories to scan for autoloads.
2003-09-03 David Ponce <david at dponce.com>
* cedet-autogen.el: New file.
2003-08-06 David Ponce <david at dponce.com>
* ezimage.el (defezimage):
Fix typo in definition that uses `make-glyph'.
2003-07-23 Eric M. Ludlam <zappo at gnu.org>
* inversion.el (inversion-version): set to 1.0
2003-07-18 Eric M. Ludlam <zappo at gnu.org>
* ezimage.el (ezimage-insert-image-button-maybe):
Use when instead of if.
(ezimage-insert-over-text): Only do logic if images enabled.
(ezimage-image-over-string): New fcn.
* icons/bitsbang.xpm, icons/key.xpm, icons/lock.xpm, icons/unlock.xpm:
*** empty log message ***
2003-07-17 Eric M. Ludlam <zappo at gnu.org>
* icons/bits.xpm, icons/box-minus.xpm, icons/box-plus.xpm, icons/box.xpm, icons/checkmark.xpm, icons/dir-minus.xpm, icons/dir-plus.xpm, icons/dir.xpm, icons/doc-minus.xpm, icons/doc-plus.xpm, icons/doc.xpm, icons/info.xpm, icons/key.xpm, icons/label.xpm, icons/lock.xpm, icons/mail.xpm, icons/page-minus.xpm, icons/page-plus.xpm, icons/page.xpm, icons/tag-gt.xpm, icons/tag-minus.xpm, icons/tag-plus.xpm, icons/tag-type.xpm, icons/tag-v.xpm, icons/tag.xpm, icons/unlock.xpm:
*** empty log message ***
* ezimage.el: Image display code; extracted from speedbar.
2003-03-04 Eric M. Ludlam <zappo at gnu.org>
* inversion.el (inversion-package-version): Fixed output messages.
2003-03-03 Eric M. Ludlam <zappo at gnu.org>
* inversion.el (inversion-require): Make file argument optional.
2003-03-02 Eric M. Ludlam <zappo at gnu.org>
* inversion.el (inversion-test): Fix typo.
* inversion.el (inversion-reverse-test): New function.
* inversion.el (inversion-unit-test):
New fcn built from previously inline code.
2003-02-17 David Ponce <david at dponce.com>
* pprint.el (pprint-defvar): Fixed.
(pprint-to-string): Escape left parenthesis at beginning of line
in strings.
2003-01-28 David Ponce <david at dponce.com>
* cedet.el: New file.
* inversion.el (inversion-add-to-load-path):
Don't change the `load-path' if the
package directory don't exist.
2002-12-19 David Ponce <david at dponce.com>
* inversion.el (inversion-find-version):
Use `locate-library' to avoid compatibility
problems.
2002-12-13 David Ponce <david at dponce.com>
* inversion.el (inversion-version): Changed to 1.0beta4.
(inversion-decoder-ring): Doc fix.
(inversion-recode): Implemented.
(inversion-check-version): New function.
(inversion-test): Use it.
(inversion-add-to-load-path): New function.
2002-12-11 David Ponce <david at dponce.com>
* inversion.el: (inversion-incompatible-version)
(inversion-test): Doc fix.
(inversion-find-data): New constant.
(inversion-find-version): New function.
(inversion-upgrade-package 'semantic): Commented out.
2002-09-05 Eric M. Ludlam <zappo at gnu.org>
* inversion.el: Updated tesets.
(inversion-incompatible-version): Changed for testing
(inversion-<): Logic updates
(inversion-test): More tests
(inversion-require): Added DIRECTORY where new versions to be found.
(inversion-locate-package-files, inversion-locate-package-files-and-split)
(inversion-download-package-ask, inversion-upgrade-package): New functions.
2002-09-03 Eric M. Ludlam <zappo at gnu.org>
* inversion.el: Update tests.
* inversion.el (inversion-test): Indentation issues.
* inversion.el (inversion-test): fixed typo.
* inversion.el: Added history.
Checkdoc fixes.
* inversion.el: Changed version number.
2002-08-21 Eric M. Ludlam <zappo at gnu.org>
* inversion.el: Version checking functionality.
2002-03-11 David Ponce <david at dponce.com>
* pprint.el (pprint-cond): New function.
(pprint-with): New function.
(pprint-setup-standard-printers): Use them to pretty print `cond' and
`with-...' forms. Added pretty printing of `dotimes' and
`unwind-protect'.
* pprint.el (pprint-min-width): Moved before used.
(pprint-close-list): Ditto. Deleted code commented out.
2002-03-10 David Ponce <david at dponce.com>
* pprint.el (pprint-sexp-try): Renamed from `pprint-sexp-width'.
(pprint-list): Use it. Handle whole list.
(pprint-close-list): Commented out code that break line.
(pprint-sexp): Simplified.
* pprint.el (pprint-no-break-p):
Check that MOTIONS stay on the same line.
(pprint-close-list): Check for a newline instead of counting lines.
(pprint-min-width): Replaced `defconst' by `defvar'.
(pprint-to-string): Locally bind `inhibit-modification-hooks' to
non-nil.
* pprint.el: A flexible Elisp pretty-printer. Initial revision.
1.1 XEmacs/packages/xemacs-packages/cedet-common/Makefile
Index: Makefile
===================================================================
# Makefile for Cedet/Common lisp code
# This file is part of XEmacs.
# XEmacs 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 2, or (at your option) any
# later version.
# XEmacs 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 XEmacs; see the file COPYING. If not, write to
# the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
# Boston, MA 02111-1307, USA.
VERSION = 1.0
AUTHOR_VERSION = 1.0pre4
MAINTAINER = XEmacs Development Team <xemacs-beta at xemacs.org>
AUTHOR = Eric M. Ludlam <zappo at gnu.org>
PACKAGE = cedet-common
PKG_TYPE = regular
REQUIRES = xemacs-base edebug
CATEGORY = standard
ELCS = cedet.elc cedet-compat.elc cedet-autogen.elc \
cedet-compat.elc cedet-edebug.elc \
cedet-files.elc cedet-load.elc \
ezimage.elc fame.elc \
inversion.elc mode-local.elc \
pprint.elc sformat.elc working.elc
EXTRA_SOURCES = ChangeLog.upstream
DATA_1_FILES = $(wildcard icons/*.xpm)
DATA_1_DEST = ezimage
include ../../XEmacs.rules
1.1 XEmacs/packages/xemacs-packages/cedet-common/Makefile.upstream
Index: Makefile.upstream
===================================================================
# Automatically Generated Makefile by EDE.
# For use with: make
#
# DO NOT MODIFY THIS FILE OR YOUR CHANGES MAY BE LOST.
# EDE is the Emacs Development Environment.
# http://cedet.sourceforge.net/ede.shtml
#
top=
ede_FILES=Project.ede Makefile
misc_AUX=ChangeLog
EMACS=emacs
LOADPATH= ./
LOADDEFS=cedet-loaddefs.el
LOADDIRS=.
init_LISP=cedet-load.el
EMACS=emacs
setup_LISP=cedet.el
common_LISP=cedet-autogen.el cedet-compat.el ezimage.el inversion.el pprint.el sformat.el fame.el working.el cedet-edebug.el mode-local.el cedet-files.el
VERSION=1.0pre4
DISTDIR=$(top)common-$(VERSION)
all: autoloads init setup common icons
.PHONY: autoloads
autoloads:
@echo "(add-to-list 'load-path nil)" > $@-compile-script
for loadpath in . ${LOADPATH}; do \
echo "(add-to-list 'load-path \"$$loadpath\")" >> $@-compile-script; \
done;
@echo "(require 'cedet-autogen)" >> $@-compile-script
"$(EMACS)" -batch --no-site-file -l $@-compile-script -f cedet-batch-update-autoloads $(LOADDEFS) $(LOADDIRS)
.PHONY: init
init: $(init_LISP)
@echo "(add-to-list 'load-path nil)" > $@-compile-script
for loadpath in . ${LOADPATH}; do \
echo "(add-to-list 'load-path \"$$loadpath\")" >> $@-compile-script; \
done;
@echo "(setq debug-on-error t)" >> $@-compile-script
"$(EMACS)" -batch --no-site-file -l $@-compile-script -f batch-byte-compile $^
.PHONY: setup
setup: $(setup_LISP)
@echo "(add-to-list 'load-path nil)" > $@-compile-script
for loadpath in . ${LOADPATH}; do \
echo "(add-to-list 'load-path \"$$loadpath\")" >> $@-compile-script; \
done;
@echo "(setq debug-on-error t)" >> $@-compile-script
"$(EMACS)" -batch --no-site-file -l $@-compile-script -f batch-byte-compile $^
.PHONY: common
common: $(common_LISP)
@echo "(add-to-list 'load-path nil)" > $@-compile-script
for loadpath in . ${LOADPATH}; do \
echo "(add-to-list 'load-path \"$$loadpath\")" >> $@-compile-script; \
done;
@echo "(setq debug-on-error t)" >> $@-compile-script
"$(EMACS)" -batch --no-site-file -l $@-compile-script -f batch-byte-compile $^
.PHONY:icons
icons:
cd icons; $(MAKE)
tags:
cd icons/; make $(MFLAGS) $@
clean:
rm -f *.elc
.PHONY: dist
dist: autoloads
mkdir $(DISTDIR)
cp $(misc_AUX) cedet-loaddefs.el $(init_LISP) $(setup_LISP) $(common_LISP) $(ede_FILES) $(DISTDIR)
cd icons; $(MAKE) $(MFLAGS) DISTDIR=$(DISTDIR)/icons dist
Makefile: Project.ede
@echo Makefile is out of date! It needs to be regenerated by EDE.
@echo If you have not modified Project.ede, you can use 'touch' to update the Makefile time stamp.
@false
# End of Makefile
1.1 XEmacs/packages/xemacs-packages/cedet-common/Project.ede
Index: Project.ede
===================================================================
;; Object common
;; EDE project file.
(ede-proj-project "common"
:name "common"
:version "1.0pre4"
:file "Project.ede"
:targets (list
(ede-proj-target-aux "misc"
:name "misc"
:path ""
:source '("ChangeLog")
)
(ede-proj-target-elisp-autoloads "autoloads"
:name "autoloads"
:path ""
:autoload-file "cedet-loaddefs.el"
)
(ede-proj-target-elisp "init"
:name "init"
:path ""
:source '("cedet-load.el")
)
(ede-proj-target-elisp "setup"
:name "setup"
:path ""
:source '("cedet.el")
:versionsource '("cedet.el")
)
(ede-proj-target-elisp "common"
:name "common"
:path ""
:source '("cedet-autogen.el" "cedet-compat.el" "ezimage.el" "inversion.el" "pprint.el" "sformat.el" "fame.el" "working.el" "cedet-edebug.el" "mode-local.el" "cedet-files.el")
)
)
:web-site-url "http://cedet.sourceforge.net/"
:web-site-directory "/r at scp:shell.sourceforge.net:cedet/htdocs"
:ftp-upload-site "/ftp at upload.sourceforge.net:/incoming"
:configuration-variables 'nil
:metasubproject 't
)
1.1 XEmacs/packages/xemacs-packages/cedet-common/cedet-autogen.el
Index: cedet-autogen.el
===================================================================
;;; cedet-autogen.el --- Generate autoloads for CEDET libraries
;; Copyright (C) 2003, 2004 David Ponce
;; Author: David Ponce <david at dponce.com>
;; Created: 22 Aug 2003
;; Keywords: maint
;; X-CVS: $Id: cedet-autogen.el,v 1.1 2007/11/26 15:06:38 michaels Exp $
;; This file is not part of GNU Emacs.
;; This program 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 2, or (at your option)
;; any later version.
;; This software 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; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;
;; Automatically generate autoloads for CEDET libraries.
;;
;;; History:
;;
;;; Code:
;;
(require 'autoload)
(eval-when-compile (require 'cl))
;;; Compatibility
(defun cedet-autogen-noninteractive ()
"Return non-nil if running non-interactively."
(if (featurep 'xemacs)
(noninteractive)
noninteractive))
(if (fboundp 'keywordp)
(defalias 'cedet-autogen-keywordp 'keywordp)
(defun cedet-autogen-keywordp (object)
"Return t if OBJECT is a keyword.
This means that it is a symbol with a print name beginning with `:'
interned in the initial obarray."
(and (symbolp object)
(char-equal ?: (aref 0 (symbol-name object)))))
)
(when (cedet-autogen-noninteractive)
;; If the user is doing this non-interactively, we need to set up
;; these conveniences.
(add-to-list 'load-path nil)
(setq find-file-hooks nil
find-file-suppress-same-file-warnings t)
)
(defadvice make-autoload (before cedet-make-autoload activate)
"Extend `make-autoload' with support for particular CEDET forms.
When a such form, like defclass, defmethod, etc., is recognized, it is
replaced with side effect by an equivalent known form before calling
the true `make-autoload' function."
(if (consp (ad-get-arg 0))
(let* ((form (ad-get-arg 0))
(car (car-safe form))
name args doc
)
(cond
((eq car 'define-overload)
(setcar form 'defun)
)
((eq car 'defmethod)
(setq name (nth 1 form)
args (nthcdr 2 form))
(if (cedet-autogen-keywordp (car args))
(setq args (cdr args)))
(setq doc (nth 1 args)
args (car args))
(setcar form 'defun)
(setcdr form (list name args (if (stringp doc) doc)))
)
((eq car 'defclass)
(setq name (nth 1 form)
args (nth 2 form)
doc (nth 4 form))
(setcar form 'defun)
(setcdr form (list name args (if (stringp doc) doc)))
))
)))
(defconst cedet-autogen-header
"Auto-generated CEDET autoloads"
"Header of the auto-generated autoloads file.")
(defconst cedet-autogen-tagfile ".cedet-lisp"
"Dummy file that indicates to scan this directory for autoloads.")
(defun cedet-autogen-kill-xemacs-autoloads-feature ()
"Remove Xemacs autoloads feature from this buffer."
(save-excursion
(goto-char (point-min))
(while (re-search-forward "(\\(featurep\\|provide\\) '\\sw+-autoloads" nil t)
(condition-case nil
(while t (up-list -1))
(error nil))
(kill-region (point) (save-excursion (forward-list) (point)))
)))
(defun cedet-autogen-update-header ()
"Update header of the auto-generated autoloads file.
Run as `write-contents-hooks'."
(when (string-equal generated-autoload-file (buffer-file-name))
(let ((tag (format ";;; %s ---" (file-name-nondirectory
(buffer-file-name)))))
(message "Updating header...")
(goto-char (point-min))
(cond
;; Replace existing header line
((re-search-forward (concat "^" (regexp-quote tag)) nil t)
(beginning-of-line)
(kill-line 1)
)
;; Insert header before first ^L encountered (XEmacs)
((re-search-forward "^ " nil t)
(beginning-of-line)
))
(insert tag " " cedet-autogen-header)
(newline)
(when (featurep 'xemacs)
(cedet-autogen-kill-xemacs-autoloads-feature))
(message "Updating header...done")
nil ;; Say not already written.
)))
(defun cedet-autogen-subdirs (root-dir)
"Return autoload candidate sub directories of ROOT-DIR.
That is, those where a `cedet-autogen-tagfile' file is found.
Return a list of directory names, relative to ROOT-DIR."
(let (dirs)
(dolist (dir (directory-files default-directory))
(and (file-directory-p dir) (not (string-match dir "\\`..?\\'"))
(let* ((default-directory (expand-file-name dir))
(subdirs (cedet-autogen-subdirs root-dir)))
(when (file-exists-p cedet-autogen-tagfile)
(push (file-relative-name default-directory root-dir)
subdirs))
(setq dirs (nconc dirs subdirs)))))
dirs))
(defun cedet-autogen-ensure-default-file (file)
"Make sure that the autoload file FILE exists and if not create it."
;; If file don't exist, and is not automatically created...
(unless (or (file-exists-p file)
(fboundp 'autoload-ensure-default-file))
;; Create a file buffer.
(find-file file)
;; Use Unix EOLs, so that the file is portable to all platforms.
(setq buffer-file-coding-system 'raw-text-unix)
(unless (featurep 'xemacs)
;; Insert a GNU Emacs loaddefs skeleton.
(insert ";;; " (file-name-nondirectory file)
" --- automatically extracted autoloads\n"
";;\n"
";;; Code:\n\n"
" \n;; Local" " Variables:\n"
";; version-control: never\n"
";; no-byte-compile: t\n"
";; no-update-autoloads: t\n"
";; End:\n"
";;; " (file-name-nondirectory file)
" ends here\n"))
;; Insert the header so that the buffer is not empty.
(cedet-autogen-update-header))
file)
;;;###autoload
(defun cedet-update-autoloads (loaddefs &optional directory &rest directories)
"Update autoloads in file LOADDEFS from sources.
Optional argument DIRECTORY, specifies the directory to scan for
autoloads. It defaults to the current directory.
DIRECTORIES is a list of extra directory to scan. Those directory
names are relative to DIRECTORY. If DIRECTORIES is nil try to scan
sub directories of DIRECTORY where a `cedet-autogen-tagfile' file
exists."
(interactive "FLoaddefs file: \nDDirectory: ")
(let* ((generated-autoload-file (expand-file-name loaddefs))
(default-directory
(file-name-as-directory
(expand-file-name (or directory default-directory))))
(extra-dirs (or directories
(cedet-autogen-subdirs default-directory)))
(write-contents-hooks '(cedet-autogen-update-header))
(command-line-args-left (cons default-directory extra-dirs))
)
(cedet-autogen-ensure-default-file generated-autoload-file)
(batch-update-autoloads)))
(defun cedet-batch-update-autoloads ()
"Update autoloads in batch mode.
Usage: emacs -batch -f cedet-batch-update-autoloads LOADDEFS [DIRECTORY]
See the command `cedet-update-autoloads' for the meaning of the
LOADDEFS and DIRECTORY arguments."
(unless (cedet-autogen-noninteractive)
(error "\
`cedet-batch-update-autoloads' is to be used only with -batch"))
(condition-case err
(apply 'cedet-update-autoloads command-line-args-left)
(error
(error "%S\n\
Usage: emacs -batch -f cedet-batch-update-autoloads LOADDEFS [DIRECTORY]"
err))
))
(provide 'cedet-autogen)
;;; cedet-autogen.el ends here
1.1 XEmacs/packages/xemacs-packages/cedet-common/cedet-compat.el
Index: cedet-compat.el
===================================================================
;;; cedet-compat.el --- Compatibility across (X)Emacs versions
;; Copyright (C) 2003, 2007 David Ponce
;; Author: David Ponce <david at dponce.com>
;; Maintainer: David Ponce <david at dponce.com>
;; Keywords: compatibility
;; X-RCS: $Id: cedet-compat.el,v 1.1 2007/11/26 15:06:38 michaels Exp $
;; This file is not part of Emacs
;; This program 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 2, or (at
;; your option) any later version.
;; This program 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 this program; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;
;; This library provides functions to allow running CEDET packages on
;; a variety of [X]Emacs versions.
;;; Code:
(when (not (fboundp 'compare-strings))
;; XEmacs does not have the `compare-strings' function. Here is an
;; implementation in Emacs Lisp, derived from the C implementation
;; found in src/fns.c, in GNU Emacs 21.3.1 sources.
;;;###autoload
(defun compare-strings (str1 start1 end1 str2 start2 end2 &optional ignore-case)
"Compare the contents of two strings.
In string STR1, skip the first START1 characters and stop at END1.
In string STR2, skip the first START2 characters and stop at END2.
END1 and END2 default to the full lengths of the respective strings.
Case is significant in this comparison if IGNORE-CASE is nil.
The value is t if the strings (or specified portions) match.
If string STR1 is less, the value is a negative number N;
- 1 - N is the number of characters that match at the beginning.
If string STR1 is greater, the value is a positive number N;
N - 1 is the number of characters that match at the beginning."
(or start1 (setq start1 0))
(or start2 (setq start2 0))
(setq end1 (if end1
(min end1 (length str1))
(length str1)))
(setq end2 (if end2
(min end2 (length str2))
(length str2)))
(let ((i1 start1)
(i2 start2)
result c1 c2)
(while (and (not result) (< i1 end1) (< i2 end2))
(setq c1 (aref str1 i1)
c2 (aref str2 i2)
i1 (1+ i1)
i2 (1+ i2))
(if ignore-case
(setq c1 (upcase c1)
c2 (upcase c2)))
(setq result (cond ((< c1 c2) (- i1))
((> c1 c2) i1))))
(or result
(cond ((< i1 end1) (1+ (- i1 start1)))
((< i2 end2) (1- (- start1 i1)))
(t)))
))
)
;; subst-char-in-string is not found on the XEmacs <= 21.4. Provide
;; here for compatibility.
(if (not (fboundp 'subst-char-in-string))
;;;###autoload
(defun subst-char-in-string (fromchar tochar string &optional inplace)
;; From Emacs 21.3/lisp/subr.el
"Replace FROMCHAR with TOCHAR in STRING each time it occurs.
Unless optional argument INPLACE is non-nil, return a new string."
(let ((i (length string))
(newstr (if inplace string (copy-sequence string))))
(while (> i 0)
(setq i (1- i))
(if (eq (aref newstr i) fromchar)
(aset newstr i tochar)))
newstr))
)
(provide 'cedet-compat)
;;; cedet-compat.el ends here
1.1 XEmacs/packages/xemacs-packages/cedet-common/cedet-edebug.el
Index: cedet-edebug.el
===================================================================
;;; cedet-edebug.el --- Special EDEBUG augmentation code
;;;
;; Copyright (C) 2003, 2004, 2007 Eric M. Ludlam
;;
;; This program 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 2, or (at your option)
;; any later version.
;;
;; This program 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 this program; if not, you can either send email to this
;; program's author (see below) or write to:
;;
;; The Free Software Foundation, Inc.
;; 675 Mass Ave.
;; Cambridge, MA 02139, USA.
;;
;; Please send bug reports, etc. to zappo at gnu.org
;;; 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.
(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" 'semantic-adebug-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" 'semantic-adebug-edebug-expr)
))
(provide 'cedet-edebug)
;;; cedet-edebug.el ends here
1.1 XEmacs/packages/xemacs-packages/cedet-common/cedet-files.el
Index: cedet-files.el
===================================================================
;;; cedet-files.el --- Common routines dealing with file names.
;; Copyright (C) 2007 Eric M. Ludlam
;; Author: Eric M. Ludlam <eric at siege-engine.com>
;; X-RCS: $Id: cedet-files.el,v 1.1 2007/11/26 15:06:39 michaels Exp $
;; This program 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 2, or (at
;; your option) any later version.
;; This program 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 this program; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;
;; Various useful routines for dealing with file names in the tools
;; which are a part of CEDET.
;;; Code:
(defvar cedet-dir-sep-char (if (boundp 'directory-sep-char)
(symbol-value 'directory-sep-char)
?/)
"Character used for directory separation.
Obsoleted in some versions of Emacs. Needed in others.")
(defun cedet-directory-name-to-file-name (referencedir)
"Convert the REFERENCEDIR (a full path name) into a filename.
Converts directory seperation characters into ! characters."
(let ((file referencedir)
dir-sep-string)
;; Expand to full file name
(or (file-name-absolute-p file)
(setq file (expand-file-name 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 (memq system-type '(windows-nt ms-dos))
;; Replace any invalid file-name characters (for the
;; case of backing up remote files).
(setq file (expand-file-name (convert-standard-filename file)))
(setq dir-sep-string (char-to-string cedet-dir-sep-char))
;; Normalize DOSish file names: convert all slashes to
;; directory-sep-char, downcase the drive letter, if any,
;; and replace the leading "x:" with "/drive_x".
(if (eq (aref file 1) ?:)
(setq file (concat dir-sep-string
"drive_"
(char-to-string (downcase (aref file 0)))
(if (eq (aref file 2) cedet-dir-sep-char)
""
dir-sep-string)
(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
cedet-dir-sep-char ?!
(replace-regexp-in-string "!" "!!" file)))
file))
(provide 'cedet-files)
;;; cedet-files.el ends here
1.1 XEmacs/packages/xemacs-packages/cedet-common/cedet-load.el
Index: cedet-load.el
===================================================================
;;; cedet-load.el --- Load definitions for CEDET's common libraries
;;; Copyright (C) 2003 David Ponce
;; Author: David Ponce <david at dponce.com>
;; X-RCS: $Id: cedet-load.el,v 1.1 2007/11/26 15:06:39 michaels Exp $
;; CEDET 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 2, or (at your option)
;; any later version.
;; This software 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; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;
;; Initialize CEDET's common libraries for all supported conditions.
;;; Code:
;;
;;; Common autoloads
;;
(load "cedet-loaddefs" nil t)
(provide 'cedet-load)
;;; cedet-load.el ends here
1.1 XEmacs/packages/xemacs-packages/cedet-common/cedet-loaddefs.el
Index: cedet-loaddefs.el
===================================================================
;;; cedet-loaddefs.el --- Auto-generated CEDET autoloads
;;
;;; Code:
;;;### (autoloads (cedet-update-autoloads) "cedet-autogen" "cedet-autogen.el"
;;;;;; (17213 39666))
;;; Generated autoloads from cedet-autogen.el
(autoload (quote cedet-update-autoloads) "cedet-autogen" "\
Update autoloads in file LOADDEFS from sources.
Optional argument DIRECTORY, specifies the directory to scan for
autoloads. It defaults to the current directory.
DIRECTORIES is a list of extra directory to scan. Those directory
names are relative to DIRECTORY. If DIRECTORIES is nil try to scan
sub directories of DIRECTORY where a `cedet-autogen-tagfile' file
exists." t nil)
;;;***
;;;### (autoloads nil "cedet-edebug" "cedet-edebug.el" (17987 16568))
;;; Generated autoloads from cedet-edebug.el
(add-hook (quote edebug-setup-hook) (lambda nil (require (quote cedet-edebug)) (defalias (quote edebug-prin1-to-string) (quote cedet-edebug-prin1-to-string)) (define-key edebug-mode-map "A" (quote semantic-adebug-edebug-expr))))
(add-hook (quote debugger-mode-hook) (lambda nil (require (quote cedet-edebug)) (define-key debugger-mode-map "A" (quote semantic-adebug-edebug-expr))))
;;;***
;;;### (autoloads (define-fame-channel) "fame" "fame.el" (17213 39681))
;;; Generated autoloads from fame.el
(autoload (quote define-fame-channel) "fame" "\
Define the new message channel CHANNEL.
CHANNEL must be a non-nil symbol.
The optional argument DEFAULT specifies the default value of message
levels for this channel. By default it is the value of
`fame-default-level-values'.
DOCSTRING is an optional channel documentation.
This defines the option `CHANNEL-fame-levels' to customize the current
value of message levels. And the functions `CHANNEL-send-debug',
`CHANNEL-send-info', `CHANNEL-send-warning', and `CHANNEL-send-error',
that respectively send debug, informational, warning, and error
messages to CHANNEL." nil (quote macro))
;;;***
;;;### (autoloads (inversion-upgrade-package inversion-add-to-load-path
;;;;;; inversion-find-version inversion-require) "inversion" "inversion.el"
;;;;;; (17881 43289))
;;; Generated autoloads from inversion.el
(autoload (quote inversion-require) "inversion" "\
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." nil nil)
(autoload (quote inversion-find-version) "inversion" "\
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." nil nil)
(autoload (quote inversion-add-to-load-path) "inversion" "\
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." nil nil)
(autoload (quote inversion-upgrade-package) "inversion" "\
Try to upgrade PACKAGE in DIRECTORY is available." t nil)
;;;***
;;;### (autoloads (pprint-function pprint pprint-to-string) "pprint"
;;;;;; "pprint.el" (17213 39693))
;;; Generated autoloads from pprint.el
(autoload (quote pprint-to-string) "pprint" "\
Return a string containing the pretty-printed representation of OBJECT.
OBJECT can be any Lisp object. Quoting characters are used as needed
to make output that `read' can handle, whenever this is possible. The
pretty printer try as much as possible to limit the length of lines to
given WIDTH. WIDTH value defaults to `fill-column'." nil nil)
(autoload (quote pprint) "pprint" "\
Output the pretty-printed representation of OBJECT, any Lisp object.
Quoting characters are printed as needed to make output that `read'
can handle, whenever this is possible. Output stream is STREAM, or
value of `standard-output' (which see). The pretty printer try as
much as possible to limit the length of lines to given WIDTH. WIDTH
value defaults to `fill-column'." nil nil)
(autoload (quote pprint-function) "pprint" "\
See a pretty-printed representation of FUNCTION-NAME." t nil)
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; cedet-loaddefs.el ends here
1.1 XEmacs/packages/xemacs-packages/cedet-common/cedet.el
Index: cedet.el
===================================================================
;;; cedet.el --- Setup CEDET environment
;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 by David Ponce
;; Author: David Ponce <david at dponce.com>
;; Maintainer: CEDET developers <http://sf.net/projects/cedet>
;; Created: 09 Dec 2002
;; Keywords: syntax
;; X-RCS: $Id: cedet.el,v 1.1 2007/11/26 15:06:40 michaels Exp $
;; This file is not part of Emacs
;; This program 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 2, or (at
;; your option) any later version.
;; This program 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 this program; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;
;; This library automatically setups your [X]Emacs to use CEDET tools.
;;
;; First download the latest CEDET distribution, provided in a
;; cedet-<VERSION>.tar.gz tarball, from the project page at:
;; <http://sf.net/projects/cedet>.
;;
;; Unpack the tarball in a directory of your choice. It will install
;; the following directory tree:
;;
;; cedet
;; |
;; +- common
;; |
;; +- cogre
;; |
;; +- ede
;; |
;; +- eieio
;; |
;; +- semantic
;; |
;; +- speedbar
;; |
;; \- contrib
;;
;; Then, add the following into your ~/.emacs startup file:
;;
;; (load-file "<INSTALL-PATH>/cedet/common/cedet.el")
;;
;; 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)
;; (load-file "<INSTALL-PATH>/cedet/common/cedet.el")
;;
;; That's it!
;;
;;; History:
;;
;;; Code:
(eval-when-compile
(require 'cl)
)
;;;###autoload
(defconst cedet-version "1.0pre4"
"Current version of CEDET.")
(defconst cedet-packages
`(
;;PACKAGE MIN-VERSION INSTALLDIR
(cedet ,cedet-version "common" )
(cogre "0.5" )
(ede "1.0pre4" )
(eieio "1.0" )
(semantic "2.0pre4" )
(speedbar "1.0.1" )
(cedet-contrib "1.0pre4" "contrib" )
)
"Table of CEDET packages to install.")
;; This file must be in "<INSTALL-DIR>/cedet/common"!
(let ((default-directory
(file-name-directory
(or load-file-name (buffer-file-name)))))
;; Add "<INSTALL-DIR>/cedet/common" to `load-path'.
(add-to-list 'load-path default-directory)
(message "%S added to `load-path'" default-directory)
;; Require the inversion library.
(require 'inversion)
;; Go up to the parent "<INSTALL-DIR>/cedet" directory.
(let ((default-directory (expand-file-name ".."))
package min-version installdir)
;; Add the CEDET packages subdirectories to the `load-path' if
;; necessary.
(dolist (package-spec cedet-packages)
(setq package (nth 0 package-spec)
min-version (nth 1 package-spec)
installdir (nth 2 package-spec))
(when installdir
(setq installdir (expand-file-name installdir)))
(inversion-add-to-load-path package min-version installdir))
;; Then run every package setup.
(dolist (package-spec cedet-packages)
(setq package (nth 0 package-spec))
(message "Setting up %s..." package)
(condition-case err
(progn
(require (intern (format "%s-load" package)))
(message "Setting up %s...done" package))
(error
(message "%s" (error-message-string err)))))
))
(eval-when-compile
(require '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)
(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
1.1 XEmacs/packages/xemacs-packages/cedet-common/ezimage.el
Index: ezimage.el
===================================================================
;;; ezimage --- Generalized Image management
;;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2005 Free Software Foundation
;; Author: Eric M. Ludlam <zappo at gnu.org>
;; Keywords: file, tags, tools
;; X-RCS: $Id: ezimage.el,v 1.1 2007/11/26 15:06:40 michaels Exp $
;; 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 2, 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; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;
;; A few routines for placing an image over text that will work for any
;; Emacs implementation without error. When images are not supported, then
;; they are just not displayed.
;;
;; The idea is that gui buffers (trees, buttons, etc) will have text
;; representations of the GUI elements. These routines will replace the text
;; with an image when images are available.
;;
;; This file requires the `image' package if it is available.
(condition-case nil
(require 'image)
(error nil))
;;; Code:
(defcustom ezimage-use-images
(and (or (fboundp 'defimage) ; emacs 21
(fboundp 'make-image-specifier)) ; xemacs
(if (fboundp 'display-graphic-p) ; emacs 21
(display-graphic-p)
window-system) ; old emacs & xemacs
(or (not (fboundp 'image-type-available-p)) ; xemacs?
(image-type-available-p 'xpm))) ; emacs 21
"*Non-nil if ezimage should display icons."
:group 'ezimage
:version "21.1"
:type 'boolean)
;;; Create our own version of defimage
(eval-and-compile
(if (fboundp 'defimage)
(progn
(defmacro defezimage (variable imagespec docstring)
"Define VARIABLE as an image if `defimage' is not available.
IMAGESPEC is the image data, and DOCSTRING is documentation for the image."
`(progn
(defimage ,variable ,imagespec ,docstring)
(put (quote ,variable) 'ezimage t)))
; (defalias 'defezimage 'defimage)
;; This hack is for the ezimage install which has an icons direcory for
;; the default icons to be used.
;; XEmacs:
;(add-to-list 'load-path
; (concat (file-name-directory
; (locate-library "ezimage.el"))
; "icons"))
)
(if (not (fboundp 'make-glyph))
(defmacro defezimage (variable imagespec docstring)
"Don't bother loading up an image...
Argument VARIABLE is the variable to define.
Argument IMAGESPEC is the list defining the image to create.
Argument DOCSTRING is the documentation for VARIABLE."
`(defvar ,variable nil ,docstring))
;; ELSE
(defun ezimage-find-image-on-load-path (image)
"Find the image file IMAGE on the load path."
(let ((l (cons
;; In XEmacs, try the data directory first (for an
;; install in XEmacs proper.) Search the load
;; path next (for user installs)
(locate-data-directory "ezimage")
load-path))
(r nil))
(while (and l (not r))
(if (file-exists-p (concat (file-name-directory (car l)) image))
(setq r (concat (file-name-directory (car l)) image))
(if (file-exists-p (concat (file-name-directory (car l)) "icons/" image))
(setq r (concat (file-name-directory (car l)) image))
))
(setq l (cdr l)))
r))
(defun ezimage-convert-emacs21-imagespec-to-xemacs (spec)
"Convert the Emacs21 image SPEC into an XEmacs image spec.
The Emacs 21 spec is what I first learned, and is easy to convert."
(let* ((sl (car spec))
(itype (nth 1 sl))
(ifile (nth 3 sl)))
(vector itype ':file (ezimage-find-image-on-load-path ifile))))
(defmacro defezimage (variable imagespec docstring)
"Define VARIABLE as an image if `defimage' is not available.
IMAGESPEC is the image data, and DOCSTRING is documentation for the image."
`(progn
(defvar ,variable
;; The Emacs21 version of defimage looks just like the XEmacs image
;; specifier, except that it needs a :type keyword. If we line
;; stuff up right, we can use this cheat to support XEmacs specifiers.
(condition-case nil
(make-glyph
(make-image-specifier
(ezimage-convert-emacs21-imagespec-to-xemacs (quote ,imagespec)))
'buffer)
(error nil))
,docstring)
(put ',variable 'ezimage t)))
)))
(defezimage ezimage-directory
((:type xpm :file "dir.xpm" :ascent center))
"Image used for empty directories.")
(defezimage ezimage-directory-plus
((:type xpm :file "dir-plus.xpm" :ascent center))
"Image used for closed directories with stuff in them.")
(defezimage ezimage-directory-minus
((:type xpm :file "dir-minus.xpm" :ascent center))
"Image used for open directories with stuff in them.")
(defezimage ezimage-page-plus
((:type xpm :file "page-plus.xpm" :ascent center))
"Image used for closed files with stuff in them.")
(defezimage ezimage-page-minus
((:type xpm :file "page-minus.xpm" :ascent center))
"Image used for open files with stuff in them.")
(defezimage ezimage-page
((:type xpm :file "page.xpm" :ascent center))
"Image used for files with nothing interesting in it.")
(defezimage ezimage-tag
((:type xpm :file "tag.xpm" :ascent center))
"Image used for tags.")
(defezimage ezimage-tag-plus
((:type xpm :file "tag-plus.xpm" :ascent center))
"Image used for closed tag groups.")
(defezimage ezimage-tag-minus
((:type xpm :file "tag-minus.xpm" :ascent center))
"Image used for open tags.")
(defezimage ezimage-tag-gt
((:type xpm :file "tag-gt.xpm" :ascent center))
"Image used for closed tags (with twist arrow).")
(defezimage ezimage-tag-v
((:type xpm :file "tag-v.xpm" :ascent center))
"Image used for open tags (with twist arrow).")
(defezimage ezimage-tag-type
((:type xpm :file "tag-type.xpm" :ascent center))
"Image used for tags that represent a data type.")
(defezimage ezimage-box-plus
((:type xpm :file "box-plus.xpm" :ascent center))
"Image of a closed box.")
(defezimage ezimage-box-minus
((:type xpm :file "box-minus.xpm" :ascent center))
"Image of an open box.")
(defezimage ezimage-mail
((:type xpm :file "mail.xpm" :ascent center))
"Image if an envelope.")
(defezimage ezimage-checkout
((:type xpm :file "checkmark.xpm" :ascent center))
"Image representing a checkmark. For files checked out of a VC.")
(defezimage ezimage-object
((:type xpm :file "bits.xpm" :ascent center))
"Image representing bits (an object file.)")
(defezimage ezimage-object-out-of-date
((:type xpm :file "bitsbang.xpm" :ascent center))
"Image representing bits with a ! in it. (an out of data object file.)")
(defezimage ezimage-label
((:type xpm :file "label.xpm" :ascent center))
"Image used for label prefix.")
(defezimage ezimage-lock
((:type xpm :file "lock.xpm" :ascent center))
"Image of a lock. Used for Read Only, or private.")
(defezimage ezimage-unlock
((:type xpm :file "unlock.xpm" :ascent center))
"Image of an unlocked lock.")
(defezimage ezimage-key
((:type xpm :file "key.xpm" :ascent center))
"Image of a key.")
(defezimage ezimage-document-tag
((:type xpm :file "doc.xpm" :ascent center))
"Image used to indicate documentation available.")
(defezimage ezimage-document-plus
((:type xpm :file "doc-plus.xpm" :ascent center))
"Image used to indicate closed documentation.")
(defezimage ezimage-document-minus
((:type xpm :file "doc-minus.xpm" :ascent center))
"Image used to indicate open documentation.")
(defezimage ezimage-info-tag
((:type xpm :file "info.xpm" :ascent center))
"Image used to indicate more information available.")
(defvar ezimage-expand-image-button-alist
'(
;; here are some standard representations
("<+>" . ezimage-directory-plus)
("<->" . ezimage-directory-minus)
("< >" . ezimage-directory)
("[+]" . ezimage-page-plus)
("[-]" . ezimage-page-minus)
("[?]" . ezimage-page)
("[ ]" . ezimage-page)
("{+}" . ezimage-box-plus)
("{-}" . ezimage-box-minus)
;; Some vaguely representitive entries
("*" . ezimage-checkout)
("#" . ezimage-object)
("!" . ezimage-object-out-of-date)
("%" . ezimage-lock)
)
"List of text and image associations.")
(defun ezimage-insert-image-button-maybe (start length &optional string)
"Insert an image button based on text starting at START for LENGTH chars.
If buttontext is unknown, just insert that text.
If we have an image associated with it, use that image.
Optional argument STRING is a string upon which to add text properties."
(when ezimage-use-images
(let* ((bt (buffer-substring start (+ length start)))
(a (assoc bt ezimage-expand-image-button-alist)))
;; Regular images (created with `insert-image' are intangible
;; which (I suppose) make them more compatible with XEmacs 21.
;; Unfortunatly, there is a giant pile o code dependent on the
;; underlying text. This means if we leave it tangible, then I
;; don't have to change said giant piles o code.
(if (and a (symbol-value (cdr a)))
(ezimage-insert-over-text (symbol-value (cdr a))
start
(+ start (length bt))))))
string)
(defun ezimage-image-over-string (string &optional alist)
"Insert over the text in STRING an image found in ALIST.
Return STRING with properties applied."
(if ezimage-use-images
(let ((a (assoc string alist)))
(if (and a (symbol-value (cdr a)))
(ezimage-insert-over-text (symbol-value (cdr a))
0 (length string)
string)
string))
string))
(defun ezimage-insert-over-text (image start end &optional string)
"Place IMAGE over the text between START and END.
Assumes the image is part of a gui and can be clicked on.
Optional argument STRING is a string upon which to add text properties."
(when ezimage-use-images
(if (featurep 'xemacs)
(add-text-properties start end
(list 'end-glyph image
'rear-nonsticky (list 'display)
'invisible t
'detachable t)
string)
(add-text-properties start end
(list 'display image
'rear-nonsticky (list 'display))
string)))
string)
(defun ezimage-image-association-dump ()
"Dump out the current state of the Ezimage image alist.
See `ezimage-expand-image-button-alist' for details."
(interactive)
(with-output-to-temp-buffer "*Ezimage Images*"
(save-excursion
(set-buffer "*Ezimage Images*")
(goto-char (point-max))
(insert "Ezimage image cache.\n\n")
(let ((start (point)) (end nil))
(insert "Image\tText\tImage Name")
(setq end (point))
(insert "\n")
(put-text-property start end 'face 'underline))
(let ((ia ezimage-expand-image-button-alist))
(while ia
(let ((start (point)))
(insert (car (car ia)))
(insert "\t")
(ezimage-insert-image-button-maybe start
(length (car (car ia))))
(insert (car (car ia)) "\t" (format "%s" (cdr (car ia))) "\n"))
(setq ia (cdr ia)))))))
(defun ezimage-image-dump ()
"Dump out the current state of the Ezimage image alist.
See `ezimage-expand-image-button-alist' for details."
(interactive)
(with-output-to-temp-buffer "*Ezimage Images*"
(save-excursion
(set-buffer "*Ezimage Images*")
(goto-char (point-max))
(insert "Ezimage image cache.\n\n")
(let ((start (point)) (end nil))
(insert "Image\tImage Name")
(setq end (point))
(insert "\n")
(put-text-property start end 'face 'underline))
(let ((ia (ezimage-all-images)))
(while ia
(let ((start (point)))
(insert "cm")
(ezimage-insert-over-text (symbol-value (car ia)) start (point))
(insert "\t" (format "%s" (car ia)) "\n"))
(setq ia (cdr ia)))))))
(defun ezimage-all-images ()
"Return a list of all variables containing ez images."
(let ((ans nil))
(mapatoms (lambda (sym)
(if (get sym 'ezimage) (setq ans (cons sym ans))))
)
(setq ans (sort ans (lambda (a b)
(string< (symbol-name a) (symbol-name b)))))
ans)
)
(provide 'ezimage)
;;; sb-image.el ends here
1.1 XEmacs/packages/xemacs-packages/cedet-common/ezimage.el.upstream
Index: ezimage.el.upstream
===================================================================
;;; ezimage --- Generalized Image management
;;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2005 Free Software Foundation
;; Author: Eric M. Ludlam <zappo at gnu.org>
;; Keywords: file, tags, tools
;; X-RCS: $Id: ezimage.el.upstream,v 1.1 2007/11/26 15:06:40 michaels Exp $
;; 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 2, 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; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;
;; A few routines for placing an image over text that will work for any
;; Emacs implementation without error. When images are not supported, then
;; they are just not displayed.
;;
;; The idea is that gui buffers (trees, buttons, etc) will have text
;; representations of the GUI elements. These routines will replace the text
;; with an image when images are available.
;;
;; This file requires the `image' package if it is available.
(condition-case nil
(require 'image)
(error nil))
;;; Code:
(defcustom ezimage-use-images
(and (or (fboundp 'defimage) ; emacs 21
(fboundp 'make-image-specifier)) ; xemacs
(if (fboundp 'display-graphic-p) ; emacs 21
(display-graphic-p)
window-system) ; old emacs & xemacs
(or (not (fboundp 'image-type-available-p)) ; xemacs?
(image-type-available-p 'xpm))) ; emacs 21
"*Non-nil if ezimage should display icons."
:group 'ezimage
:version "21.1"
:type 'boolean)
;;; Create our own version of defimage
(eval-and-compile
(if (fboundp 'defimage)
(progn
(defmacro defezimage (variable imagespec docstring)
"Define VARIABLE as an image if `defimage' is not available.
IMAGESPEC is the image data, and DOCSTRING is documentation for the image."
`(progn
(defimage ,variable ,imagespec ,docstring)
(put (quote ,variable) 'ezimage t)))
; (defalias 'defezimage 'defimage)
;; This hack is for the ezimage install which has an icons direcory for
;; the default icons to be used.
(add-to-list 'load-path
(concat (file-name-directory
(locate-library "ezimage.el"))
"icons"))
)
(if (not (fboundp 'make-glyph))
(defmacro defezimage (variable imagespec docstring)
"Don't bother loading up an image...
Argument VARIABLE is the variable to define.
Argument IMAGESPEC is the list defining the image to create.
Argument DOCSTRING is the documentation for VARIABLE."
`(defvar ,variable nil ,docstring))
;; ELSE
(defun ezimage-find-image-on-load-path (image)
"Find the image file IMAGE on the load path."
(let ((l (cons
;; In XEmacs, try the data directory first (for an
;; install in XEmacs proper.) Search the load
;; path next (for user installs)
(locate-data-directory "ezimage")
load-path))
(r nil))
(while (and l (not r))
(if (file-exists-p (concat (car l) "/" image))
(setq r (concat (car l) "/" image))
(if (file-exists-p (concat (car l) "/icons/" image))
(setq r (concat (car l) "/icons/" image))
))
(setq l (cdr l)))
r))
(defun ezimage-convert-emacs21-imagespec-to-xemacs (spec)
"Convert the Emacs21 image SPEC into an XEmacs image spec.
The Emacs 21 spec is what I first learned, and is easy to convert."
(let* ((sl (car spec))
(itype (nth 1 sl))
(ifile (nth 3 sl)))
(vector itype ':file (ezimage-find-image-on-load-path ifile))))
(defmacro defezimage (variable imagespec docstring)
"Define VARIABLE as an image if `defimage' is not available.
IMAGESPEC is the image data, and DOCSTRING is documentation for the image."
`(progn
(defvar ,variable
;; The Emacs21 version of defimage looks just like the XEmacs image
;; specifier, except that it needs a :type keyword. If we line
;; stuff up right, we can use this cheat to support XEmacs specifiers.
(condition-case nil
(make-glyph
(make-image-specifier
(ezimage-convert-emacs21-imagespec-to-xemacs (quote ,imagespec)))
'buffer)
(error nil))
,docstring)
(put ',variable 'ezimage t)))
)))
(defezimage ezimage-directory
((:type xpm :file "dir.xpm" :ascent center))
"Image used for empty directories.")
(defezimage ezimage-directory-plus
((:type xpm :file "dir-plus.xpm" :ascent center))
"Image used for closed directories with stuff in them.")
(defezimage ezimage-directory-minus
((:type xpm :file "dir-minus.xpm" :ascent center))
"Image used for open directories with stuff in them.")
(defezimage ezimage-page-plus
((:type xpm :file "page-plus.xpm" :ascent center))
"Image used for closed files with stuff in them.")
(defezimage ezimage-page-minus
((:type xpm :file "page-minus.xpm" :ascent center))
"Image used for open files with stuff in them.")
(defezimage ezimage-page
((:type xpm :file "page.xpm" :ascent center))
"Image used for files with nothing interesting in it.")
(defezimage ezimage-tag
((:type xpm :file "tag.xpm" :ascent center))
"Image used for tags.")
(defezimage ezimage-tag-plus
((:type xpm :file "tag-plus.xpm" :ascent center))
"Image used for closed tag groups.")
(defezimage ezimage-tag-minus
((:type xpm :file "tag-minus.xpm" :ascent center))
"Image used for open tags.")
(defezimage ezimage-tag-gt
((:type xpm :file "tag-gt.xpm" :ascent center))
"Image used for closed tags (with twist arrow).")
(defezimage ezimage-tag-v
((:type xpm :file "tag-v.xpm" :ascent center))
"Image used for open tags (with twist arrow).")
(defezimage ezimage-tag-type
((:type xpm :file "tag-type.xpm" :ascent center))
"Image used for tags that represent a data type.")
(defezimage ezimage-box-plus
((:type xpm :file "box-plus.xpm" :ascent center))
"Image of a closed box.")
(defezimage ezimage-box-minus
((:type xpm :file "box-minus.xpm" :ascent center))
"Image of an open box.")
(defezimage ezimage-mail
((:type xpm :file "mail.xpm" :ascent center))
"Image if an envelope.")
(defezimage ezimage-checkout
((:type xpm :file "checkmark.xpm" :ascent center))
"Image representing a checkmark. For files checked out of a VC.")
(defezimage ezimage-object
((:type xpm :file "bits.xpm" :ascent center))
"Image representing bits (an object file.)")
(defezimage ezimage-object-out-of-date
((:type xpm :file "bitsbang.xpm" :ascent center))
"Image representing bits with a ! in it. (an out of data object file.)")
(defezimage ezimage-label
((:type xpm :file "label.xpm" :ascent center))
"Image used for label prefix.")
(defezimage ezimage-lock
((:type xpm :file "lock.xpm" :ascent center))
"Image of a lock. Used for Read Only, or private.")
(defezimage ezimage-unlock
((:type xpm :file "unlock.xpm" :ascent center))
"Image of an unlocked lock.")
(defezimage ezimage-key
((:type xpm :file "key.xpm" :ascent center))
"Image of a key.")
(defezimage ezimage-document-tag
((:type xpm :file "doc.xpm" :ascent center))
"Image used to indicate documentation available.")
(defezimage ezimage-document-plus
((:type xpm :file "doc-plus.xpm" :ascent center))
"Image used to indicate closed documentation.")
(defezimage ezimage-document-minus
((:type xpm :file "doc-minus.xpm" :ascent center))
"Image used to indicate open documentation.")
(defezimage ezimage-info-tag
((:type xpm :file "info.xpm" :ascent center))
"Image used to indicate more information available.")
(defvar ezimage-expand-image-button-alist
'(
;; here are some standard representations
("<+>" . ezimage-directory-plus)
("<->" . ezimage-directory-minus)
("< >" . ezimage-directory)
("[+]" . ezimage-page-plus)
("[-]" . ezimage-page-minus)
("[?]" . ezimage-page)
("[ ]" . ezimage-page)
("{+}" . ezimage-box-plus)
("{-}" . ezimage-box-minus)
;; Some vaguely representitive entries
("*" . ezimage-checkout)
("#" . ezimage-object)
("!" . ezimage-object-out-of-date)
("%" . ezimage-lock)
)
"List of text and image associations.")
(defun ezimage-insert-image-button-maybe (start length &optional string)
"Insert an image button based on text starting at START for LENGTH chars.
If buttontext is unknown, just insert that text.
If we have an image associated with it, use that image.
Optional argument STRING is a string upon which to add text properties."
(when ezimage-use-images
(let* ((bt (buffer-substring start (+ length start)))
(a (assoc bt ezimage-expand-image-button-alist)))
;; Regular images (created with `insert-image' are intangible
;; which (I suppose) make them more compatible with XEmacs 21.
;; Unfortunatly, there is a giant pile o code dependent on the
;; underlying text. This means if we leave it tangible, then I
;; don't have to change said giant piles o code.
(if (and a (symbol-value (cdr a)))
(ezimage-insert-over-text (symbol-value (cdr a))
start
(+ start (length bt))))))
string)
(defun ezimage-image-over-string (string &optional alist)
"Insert over the text in STRING an image found in ALIST.
Return STRING with properties applied."
(if ezimage-use-images
(let ((a (assoc string alist)))
(if (and a (symbol-value (cdr a)))
(ezimage-insert-over-text (symbol-value (cdr a))
0 (length string)
string)
string))
string))
(defun ezimage-insert-over-text (image start end &optional string)
"Place IMAGE over the text between START and END.
Assumes the image is part of a gui and can be clicked on.
Optional argument STRING is a string upon which to add text properties."
(when ezimage-use-images
(if (featurep 'xemacs)
(add-text-properties start end
(list 'end-glyph image
'rear-nonsticky (list 'display)
'invisible t
'detachable t)
string)
(add-text-properties start end
(list 'display image
'rear-nonsticky (list 'display))
string)))
string)
(defun ezimage-image-association-dump ()
"Dump out the current state of the Ezimage image alist.
See `ezimage-expand-image-button-alist' for details."
(interactive)
(with-output-to-temp-buffer "*Ezimage Images*"
(save-excursion
(set-buffer "*Ezimage Images*")
(goto-char (point-max))
(insert "Ezimage image cache.\n\n")
(let ((start (point)) (end nil))
(insert "Image\tText\tImage Name")
(setq end (point))
(insert "\n")
(put-text-property start end 'face 'underline))
(let ((ia ezimage-expand-image-button-alist))
(while ia
(let ((start (point)))
(insert (car (car ia)))
(insert "\t")
(ezimage-insert-image-button-maybe start
(length (car (car ia))))
(insert (car (car ia)) "\t" (format "%s" (cdr (car ia))) "\n"))
(setq ia (cdr ia)))))))
(defun ezimage-image-dump ()
"Dump out the current state of the Ezimage image alist.
See `ezimage-expand-image-button-alist' for details."
(interactive)
(with-output-to-temp-buffer "*Ezimage Images*"
(save-excursion
(set-buffer "*Ezimage Images*")
(goto-char (point-max))
(insert "Ezimage image cache.\n\n")
(let ((start (point)) (end nil))
(insert "Image\tImage Name")
(setq end (point))
(insert "\n")
(put-text-property start end 'face 'underline))
(let ((ia (ezimage-all-images)))
(while ia
(let ((start (point)))
(insert "cm")
(ezimage-insert-over-text (symbol-value (car ia)) start (point))
(insert "\t" (format "%s" (car ia)) "\n"))
(setq ia (cdr ia)))))))
(defun ezimage-all-images ()
"Return a list of all variables containing ez images."
(let ((ans nil))
(mapatoms (lambda (sym)
(if (get sym 'ezimage) (setq ans (cons sym ans))))
)
(setq ans (sort ans (lambda (a b)
(string< (symbol-name a) (symbol-name b)))))
ans)
)
(provide 'ezimage)
;;; sb-image.el ends here
1.1 XEmacs/packages/xemacs-packages/cedet-common/fame.el
Index: fame.el
===================================================================
;;; fame.el --- Framework for Applications' MEssages
;;
;; Copyright (C) 2004 David Ponce
;;
;; Author: David Ponce <david at dponce.com>
;; Maintainer: David Ponce <david at dponce.com>
;; Created: 28 Oct 2004
;; Keywords: status
;; X-RCS: $Id: fame.el,v 1.1 2007/11/26 15:06:41 michaels Exp $
;;
;; This file is not part of GNU Emacs.
;;
;; This program 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 2, or (at
;; your option) any later version.
;;
;; This software 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; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;
;; This library provides a convenient framework for applications to
;; send messages distinguished by their level of importance, allowing
;; to customize how they will be actually rendered.
;;
;; The principle is to define a `channel' where to send messages at
;; particular levels, depending on their importance. A channel is
;; identified by a non-nil symbol. For example this library could
;; send its messages to the `fame' channel. Four levels of importance
;; are recognized, for debug, informational, warning and error
;; messages.
;;
;; Messages at any particular level can be either discarded,
;; temporarily displayed, recorded in the message log buffer without
;; showing them in the echo area, or shown the usual way like through
;; the `message' function. Messages shown in the echo area can be
;; recorded or not in the message log buffer.
;;
;; The `define-fame-channel' macro permits to easily define a new
;; channel, that is an option to customize how to display the message
;; levels for this channel, and the level specific functions to use to
;; send messages to this channel.
;;
;; Here is a small example:
;;
;; (require 'fame)
;; ...
;; (define-fame-channel feature)
;; ...
;; (feature-send-debug "Some useful debug message")
;; ...
;; (condition-case err
;; ...
;; (error
;; (feature-send-error "%s" (error-message-string err))))
;; ...
;; (feature-send-info "Some useful informational message")
;; ...
;; (provide 'feature)
;;; History:
;;
;;; Code:
;;; Constants and options
;;
(defconst fame-valid-levels
'(:error :warning :info :debug)
"Valid message levels.")
(defconst fame-valid-level-values
'(t nolog temp temp-nolog log none)
"Valid message level values.")
(defconst fame-default-level-values
'(:debug log :info temp :warning t :error t)
"Default display value of message levels.")
(define-widget 'fame-display-choice 'radio-button-choice
"Widget to choose the display value of a level."
:format "%v\n"
:entry-format " %v%b"
:args '((const :format "%v" :value t)
(const :format "%v" :value nolog)
(const :format "%v" :value temp)
(const :format "%v" :value temp-nolog)
(const :format "%v" :value log)
(const :format "%v" :value none)))
(define-widget 'fame-level-widget 'const
"Widget to display a level symbol."
:format " %t")
(define-widget 'fame-channel-widget 'list
"Widget to customize the messages levels of a channel."
:tag "Display value of message levels"
:format "%{%t%}:\n%v\n"
:args '((fame-level-widget :tag ":debug " :value :debug)
(fame-display-choice)
(fame-level-widget :tag ":info " :value :info)
(fame-display-choice)
(fame-level-widget :tag ":warning" :value :warning)
(fame-display-choice)
(fame-level-widget :tag ":error " :value :error)
(fame-display-choice)))
(defgroup fame nil
"Framework for Applications' MEssages."
:prefix "fame"
:group 'lisp)
(defcustom fame-temp-message-delay 1
"*Lifetime of a temporary message, in seconds."
:group 'fame
:type 'number)
;;; Core message functions
;;
(eval-and-compile
;;;; Read the message currently displayed in the echo area.
(defalias 'fame-current-message
(if (fboundp 'current-message)
'current-message
'ignore))
;;;; Show a message in the echo area without logging it.
(if (fboundp 'lmessage)
;; XEmacs
(defun fame-message-nolog (&rest args)
"Display but don't log a message on the echo area.
ARGS are like those of the function `message'."
(and args (apply 'lmessage 'no-log args)))
;; Emacs
(defun fame-message-nolog (&rest args)
"Display but don't log a message on the echo area.
ARGS will be passed to the function `message'."
(and args
(let ((message-log-max nil)) ;; No logging
(apply 'message args))))
)
;;;; Log a message without showing it in the echo area.
(if (fboundp 'log-message)
;; XEmacs
(defun fame-log-message (&rest args)
"Log but don't display a message.
ARGS are like those of the function `message'."
(and args (log-message 'message (apply 'format args))))
;; Emacs
(defun fame-log-message (&rest args)
"Log but don't display a message.
ARGS will be passed to the function `message'."
(and args
(let ((executing-kbd-macro t)) ;; Inhibit display!
(apply 'message args))))
)
;; If the above definition fails, here is a portable implementation
;; of a `log-message' function.
'(defun fame-log-message (&rest args)
"Log but don't display a message.
ARGS are like those of the function `message'."
(when args
(let ((text (apply 'format args)))
(with-current-buffer
(get-buffer-create (if (featurep 'xemacs)
" *Message-Log*"
"*Messages*"))
(goto-char (point-max))
(or (bobp) (bolp) (insert "\n"))
(forward-line -1)
(if (search-forward text nil t)
(if (looking-at " \\[\\([0-9]+\\) times\\]")
(replace-match
(number-to-string
(1+ (string-to-number (match-string 1))))
nil nil nil 1)
(end-of-line)
(insert " [2 times]"))
(forward-line 1)
(insert text))))))
;;;; Log and temporarily show a message in the echo area.
(condition-case nil
(require 'timer)
(error nil))
;; We need timers to display messages temporarily.
(if (not (fboundp 'run-with-timer))
(defun fame-temp-message-internal (fun &rest args)
"Display a message temporarily through the function FUN.
ARGS are like those of the function `message'."
;; Without timers just call FUN.
(and args (apply fun args)))
(defvar fame-temp-message-timer nil)
(defvar fame-temp-message-saved nil)
(defun fame-temp-restore-message ()
"Restore a message previously displayed in the echo area."
(when (timerp fame-temp-message-timer)
(cancel-timer fame-temp-message-timer)
(setq fame-temp-message-timer nil))
(when fame-temp-message-saved
(prog1 (fame-message-nolog "%s" fame-temp-message-saved)
(setq fame-temp-message-saved nil))))
(defun fame-temp-message-internal (fun &rest args)
"Display a message temporarily through the function FUN.
ARGS are like those of the function `message'."
(when args
(condition-case nil
(progn
(fame-temp-restore-message)
(setq fame-temp-message-saved (fame-current-message))
(prog1 (apply fun args)
(setq fame-temp-message-timer
(run-with-timer fame-temp-message-delay nil
'fame-temp-restore-message))))
(error
(fame-temp-restore-message)))))
)
)
(defsubst fame-temp-message (&rest args)
"Display a message temporarily and log it.
ARGS are like those of the function `message'.
The original message is restored to the echo area after
`fame-temp-message-delay' seconds."
(apply 'fame-temp-message-internal 'message args))
(defsubst fame-temp-message-nolog (&rest args)
"Display a message temporarily without logging it.
ARGS are like those of the function `message'.
The original message is restored to the echo area after
`fame-temp-message-delay' seconds."
(apply 'fame-temp-message-internal 'fame-message-nolog args))
;;; Handling of message levels
;;
(defun fame-check-level (level)
"Check that LEVEL is a valid message level.
If valid, return LEVEL. Signal an error otherwise."
(if (memq level fame-valid-levels)
level
(signal 'wrong-type-argument
(list fame-valid-levels level))))
(defun fame-check-level-value (value)
"Check that VALUE is a valid message level value.
If valid, return VALUE. Signal an error otherwise."
(if (memq value fame-valid-level-values)
value
(signal 'wrong-type-argument
(list fame-valid-level-values value))))
(defun fame-check-channel (channel)
"Check that CHANNEL is a non-nil symbol.
If valid, return CHANNEL. Signal an error otherwise."
(if (and channel (symbolp channel))
channel
(signal 'wrong-type-argument
(list 'symbolp channel))))
(defun fame-check-channel-levels (levels)
"Check that LEVELS is a valid specification of channel levels.
If valid, return a normalized form of the specification.
Signal an error otherwise."
(let (spec)
(dolist (level fame-valid-levels)
(push (fame-check-level-value
;; A nil level value means to use the default value.
(or (plist-get levels level)
(plist-get fame-default-level-values level))) spec)
(push level spec))
spec))
(defsubst fame-channel-symbol (channel)
"Return the symbol whose value is CHANNEL's levels."
(intern (format "%s-fame-levels" (fame-check-channel channel))))
(defun fame-channel-levels (channel)
"Return the message levels display values of CHANNEL.
If CHANNEL doesn't exist return the default value in constant
`fame-default-level-values'."
(let ((symbol (fame-channel-symbol channel)))
(if (boundp symbol)
(symbol-value symbol)
fame-default-level-values)))
(defsubst fame-level-display (channel level)
"For CHANNEL, return the display value of LEVEL.
See also the option `fame-channels'."
(plist-get (fame-channel-levels channel)
(fame-check-level level)))
;;; Sending messages to channels
;;
(defconst fame-send-functions-alist
'((none . nil)
(log . fame-log-message)
(temp . fame-temp-message)
(temp-nolog . fame-temp-message-nolog)
(nolog . fame-message-nolog)
(t . message)
))
(defun fame-send (channel level &rest args)
"Send a message to CHANNEL at level LEVEL.
ARGS are like those of the function `message'.
The message will be displayed according to what is specified for
CHANNEL in the `fame-channels' option."
(let ((sender (cdr (assq (fame-level-display channel level)
fame-send-functions-alist))))
(and sender (apply sender args))))
(defsubst fame-send-debug (channel &rest args)
"Send a debug message to CHANNEL.
CHANNEL must be a non-nil symbol.
ARGS will be passed to the function `fame-send'."
(apply 'fame-send channel :debug args))
(defsubst fame-send-info (channel &rest args)
"Send an informational message to CHANNEL.
CHANNEL must be a non-nil symbol.
ARGS will be passed to the function `fame-send'."
(apply 'fame-send channel :info args))
(defsubst fame-send-warning (channel &rest args)
"Send a warning message to CHANNEL.
CHANNEL must be a non-nil symbol.
ARGS will be passed to the function `fame-send'."
(apply 'fame-send channel :warning args))
(defsubst fame-send-error (channel &rest args)
"Send an error message to CHANNEL.
CHANNEL must be a non-nil symbol.
ARGS will be passed to the function `fame-send'."
(apply 'fame-send channel :error args))
;;; Defining new channels
;;
;;;###autoload
(defmacro define-fame-channel (channel &optional default docstring)
"Define the new message channel CHANNEL.
CHANNEL must be a non-nil symbol.
The optional argument DEFAULT specifies the default value of message
levels for this channel. By default it is the value of
`fame-default-level-values'.
DOCSTRING is an optional channel documentation.
This defines the option `CHANNEL-fame-levels' to customize the current
value of message levels. And the functions `CHANNEL-send-debug',
`CHANNEL-send-info', `CHANNEL-send-warning', and `CHANNEL-send-error',
that respectively send debug, informational, warning, and error
messages to CHANNEL."
(let ((c-opt (fame-channel-symbol channel)))
`(eval-when-compile
(defcustom ,c-opt ',(fame-check-channel-levels default)
,(format "*Display value of message levels in the %s channel.
%s
This is a plist where a message level is a property whose value
defines how messages at this level will be displayed.
The possible levels are :debug, :info, :warning, and :error.
Level values can be:
- t to show and log messages the standard way.
- nolog to show messages without logging them.
- temp to show messages temporarily and log them.
- temp-nolog to show messages temporarily without logging them.
- log to log but not show messages.
- none to discard messages.
The default behavior is specified in `fame-default-level-values'."
channel
(if docstring (format "%s\n" docstring) ""))
:group 'fame
:type 'fame-channel-widget)
(defsubst ,(intern (format "%s-send-debug" channel))
(&rest args)
,(format "Send a debug message to the `%s' channel.
ARGS will be passed to the function `fame-send'.
To customize how such messages will be displayed, see the option
`%s'." channel c-opt)
(apply 'fame-send ',channel :debug args))
(defsubst ,(intern (format "%s-send-info" channel))
(&rest args)
,(format "Send an informational message to the `%s' channel.
ARGS will be passed to the function `fame-send'.
To customize how such messages will be displayed, see the option
`%s'." channel c-opt)
(apply 'fame-send ',channel :info args))
(defsubst ,(intern (format "%s-send-warn" channel))
(&rest args)
,(format "Send a warning message to the `%s' channel.
ARGS will be passed to the function `fame-send'.
To customize how such messages will be displayed, see the option
`%s'." channel c-opt)
(apply 'fame-send ',channel :warning args))
(defsubst ,(intern (format "%s-send-error" channel))
(&rest args)
,(format "Send an error message to the `%s' channel.
ARGS will be passed to the function `fame-send'.
To customize how such messages will be displayed, see the option
`%s'." channel c-opt)
(apply 'fame-send ',channel :error args))
;; Return the CHANNEL symbol
',c-opt)))
(provide 'fame)
;;; fame.el ends here
1.1 XEmacs/packages/xemacs-packages/cedet-common/inversion.el
Index: inversion.el
===================================================================
;;; inversion.el --- When you need something in version XX.XX
;;; Copyright (C) 2002, 2003, 2005, 2006, 2007 Eric M. Ludlam
;; Author: Eric M. Ludlam <zappo at gnu.org>
;; X-RCS: $Id: inversion.el,v 1.1 2007/11/26 15:06:41 michaels Exp $
;;; 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.")
;; InVersion 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 2, or (at your option)
;; any later version.
;; This software 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; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; 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.
(defconst inversion-decoders
'(
(alpha "^\\([0-9]+\\)\\.\\([0-9]+\\)\\s-*alpha\\([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)
(point "^\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)$" 3)
)
"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))
;; 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)))
(or (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))
(count 0)
)
;; 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."))))
;;;###autoload
(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)))))
(defconst inversion-find-data
'("(def\\(var\\|const\\)\\s-+%s-%s\\s-+\"\\([^\"]+\\)" 2)
"Regexp template and match data index of a version string.")
;;;###autoload
(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))
;;;###autoload
(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")))
(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)
;; 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))
;; 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 at 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.