CVS update by michaels packages/xemacs-packages/cogre ChangeLog
ChangeLog.upstream
xemacs-cvs at xemacs.org
xemacs-cvs at xemacs.org
Mon Nov 26 10:04:30 EST 2007
User: michaels
Date: 07/11/26 16:04:30
Added: packages/xemacs-packages/cogre ChangeLog ChangeLog.upstream
INSTALL Makefile Makefile.upstream Project.ede
cogre-load.el cogre-loaddefs.el cogre-mode.el
cogre-uml.el cogre.el cogre.texi custom-load.el
package-info.in picture-hack.el uml-create.el
wisent-dot-wy.el wisent-dot.el wisent-dot.wy
Log:
Import cogre from CEDET 1.0pre4.
Revision Changes Path
1.1 XEmacs/packages/xemacs-packages/cogre/ChangeLog
Index: ChangeLog
===================================================================
2007-11-26 Mike Sperber <mike at xemacs.org>
* Import cogre 0.5 from CEDET 1.0pre4.
1.1 XEmacs/packages/xemacs-packages/cogre/ChangeLog.upstream
Index: ChangeLog.upstream
===================================================================
2007-04-15 Eric M. Ludlam <zappo at gnu.org>
* uml-create.el (cogre-graph::cogre-save): Deleted from this file.
(cogre-semantic-uml-graph::cogre-save): Allow saving.
(cogre-semantic-class::initialize-instance): Copy the tag found.
* uml-create.el (cogre-graph::cogre-save):
Add comment about why we can't save.
* cogre.el (cogre-load-graph): Stop using a temporary graph.
2007-03-18 Eric M. Ludlam <zappo at gnu.org>
* Makefile (LOADPATH): Stripped down version
(wy): Spelling fix.
(autoloads, init, dot, Mode, hacks, COGRE, dist):
Various changes from EDE patches.
2007-02-19 Eric M. Ludlam <zappo at gnu.org>
* uml-create.el (semanticdb-find): Add require
(cogre-semantic-class::initialize-instance)
(cogre-read-class-name)
(cogre-uml-quick-class)
(cogre-uml-create): Convert to new semanticdb search.
* cogre-mode.el (cogre-mode): Add semantic-match-any-mode feature.
* cogre.el (cogre-load, picture-hack): Add requires for byte-comp.
(cogre): Add to tools group.
2007-02-03 Eric M. Ludlam <zappo at gnu.org>
* uml-create.el: (cogre-semantic-class::cogre-uml-stoken->uml):
Disable images in semantic formatted strings.
2005-09-30 Eric M. Ludlam <zappo at gnu.org>
* wisent-dot.wy, wisent-dot.el, uml-create.el, picture-hack.el, cogre-uml.el, cogre-mode.el, cogre-load.el, cogre.el:
Update all GPL headers with script from savannah.gnu.org.
2005-02-03 Eric M. Ludlam <zappo at gnu.org>
* Project.ede ("COGRE"): Update version number.
* Makefile (VERSION, Makefile): Updated from project file.
* cogre.el (cogre-version): Update version number.
2004-09-28 Eric M. Ludlam <zappo at gnu.org>
* uml-create.el (semantic-grammar-batch-build-packages):
Use new semantic :type.
2004-05-25 David Ponce <david at dponce.com>
* Makefile: Re-generated to start Emacs with --no-site-file.
2004-04-11 Eric M. Ludlam <zappo at gnu.org>
* Makefile (dist): Add autoloads
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 (clean): Update info garbage pattern.
2004-03-28 David Ponce <david at dponce.com>
* Makefile: Rebuild.
* Project.ede (wisent): Rename target to "wy".
(COGRE): Remove semantic-el dependency. Add dependency on
inversion and speedbar.
* cogre-uml.el (cogre-class): Doc fix.
2004-03-25 David Ponce <david at dponce.com>
* wisent-dot.el (semantic-wisent): Require instead of wisent-bovine.
2004-02-29 Eric M. Ludlam <zappo at gnu.org>
* INSTALL: Revamped. We are a part of a CEDET install now.
2004-02-02 David Ponce <david at dponce.com>
* wisent-dot.el (semantic-tag-components):
New override for `graphviz-dot-mode'.
2004-01-23 David Ponce <david at dponce.com>
* wisent-dot.wy: Some code cleanup.
(<keyword>, <symbol>, <string>, <number>): Declare as type.
(<punctuation>, <block>): Use type defaults.
(epilogue): Define `wisent-dot-lexer' here.
* wisent-dot.el (wisent-dot-lexer): Remove. Defined in grammar.
2004-01-15 Eric M. Ludlam <zappo at gnu.org>
* wisent-dot.el (semantic-lex-dot-blocks): Deleted.
(wisent-dot-lexer): Remove old style analyzers. Replace with
auto-generated ones.
* wisent-dot.wy (punctuation, block):
Use new %type command to build lexers.
2003-10-02 Eric M. Ludlam <zappo at gnu.org>
* Project.ede: Now a meta-subproject.
* Makefile (dist): Remove local creation of tar file.
2003-09-24 Eric M. Ludlam <zappo at gnu.org>
* Project.ede, Makefile, cogre.el: Update version to 0.4beta1.
2003-09-18 David Ponce <david at dponce.com>
* Makefile: Re-generated.
* Project.ede (init): New target.
2003-09-17 David Ponce <david at dponce.com>
* cogre-load.el: New file.
* Makefile: Re-generated.
* Project.ede (autoloads): Change cogre-defs.el by cogre-loaddefs.el.
2003-09-16 David Ponce <david at dponce.com>
* Makefile: Re-generated.
* Project.ede (target COGRE):
Remove non existing file cogre-lay.el from target.
2003-09-14 David Ponce <david at dponce.com>
* wisent-dot.el (wisent-dot-setup-parser): Fix use of obsolete names.
2003-09-10 David Ponce <david at dponce.com>
* Makefile: Re-generated.
2003-09-07 Eric M. Ludlam <zappo at gnu.org>
* Makefile: Makefile.
* Project.ede ("wisent"): New
("autoloads"): New
("dot"): New
("mode"): New.
* uml-create.el:
(initialize-instance, cogre-token->uml-function, cogre-uml-stoken->uml)
(cogre-uml-browse-token-highlight-hook-fn, cogre-uml-source-marker)
(cogre-read-class-name, cogre-uml-quick-class): New semantic API
* cogre-mode.el: Coped elements from cogre.el
* cogre.el (cogre-box-face, cogre-box-first-face, cogre-box-last-face):
Removed
(cogre-graph-element): made abstract
(cogre-node): made abstract
(cogre-link): made abstract
(cogre-mode-map, cogre-substitute, cogre-insert-class-list)
(cogre-insert-forms-menu, cogre-change-forms-menu): Removed
(cogre): autoload cookie.
(cogre-mode, & many others): Removed
(cogre-default-node, cogre-default-link): Use 4th arg to
eieio-read-subclass.
(cogre-load-graph): autoload
* wisent-dot.wy: Removed obsolete code.
* wisent-dot.el (wisent-dot-automaton, other autogen): Deleted
(wisent-dot-setup-parser): Removed autogen parts, copied in parts
that used to be in the .wy file.
2003-07-23 Eric M. Ludlam <zappo at gnu.org>
* wisent-dot.wy (languagemode): Set to graphviz-dot-mode
2003-03-26 Eric M. Ludlam <zappo at gnu.org>
* test.dot: Sample dot file for dot parser.
* wisent-dot.el:
(wisent-dot-automaton, wisent-dot-keywords, wisent-dot-tokens)
(wisent-dot-setup-parser): Updated from grammar.
* wisent-dot.wy (FONTNAME, FONTSIZE): New tokens.
(DILINK, LINK): Now of punctuation type.
(number): New token class.
(graph-contents): Added graph-attributes
(graph-attributes): New
(links): Optional semicolon and attribute vector.
* wisent-dot.el:
Lexer, Grammar and support for parsing graphviz dot files.
* wisent-dot.wy: Grammar file for graphviz dot files
2003-02-25 Eric M. Ludlam <zappo at gnu.org>
* uml-create.el (initialize-instance):
Use new function that calculates externally
defined children of a type.
(cogre-uml-quick-class): typo
2001-12-05 Eric M. Ludlam <zappo at gnu.org>
* Project.ede: Version.
New layout code.
* uml-create.el (cogre-save): New method.
(initialize-instance): Enable classes and structures.
Add default name for unfound classes in semantic.
(cogre-uml-stoken->uml): Get buffer from objectified class.
(cogre-uml-quick-class): Get the superclass instead of just the parent.
* picture-hack.el (picture-insert): Fix for older versions of Emacs.
* cogre-uml.el (cogre-class): Add :custom specifiers to some slots.
* cogre.el (cogre-graph): Added extension.
(cogre-node): Remove initargs from fields not to be saved.
(cogre-link): Enable STRINGS as node entries for intermediate save state.
(cogre-loading-from-file): New variable.
(cogre-mode-map): Supress the keymap. Add save command.
(cogre-mode-menu): Added Save and Save As entries.
(cogre-map-elements, cogre-map-graph-elements): New fcn
(initialize-instance): Do not initialize when loading from a file.
(cogre-render-buffer): Use new map-lements command.
(cogre-element-pre-serialize, cogre-element-post-serialize): New methods.
(cogre-save-graph-as, cogre-save-graph, cogre-load-graph): New commands.
2001-08-17 Eric M. Ludlam <zappo at gnu.org>
* uml-create.el (cogre-uml-browse-token-hook): New hook.
(cogre-uml-browse-token-highlight-hook-fn): New function for above.
(cogre-uml-source-marker): Use hook instead of always highlighting a token.
* uml-create.el (cogre-token->uml-function): New variable.
(cogre-uml-stoken->uml): Use above to generate text.
(cogre-uml-source-marker): Momentary highlight tokens.
* picture-hack.el (picture-insert):
Fix move-to-column typo from previous checkin.
* cogre.el: Update version.
(eieio-base): require
(cogre-custom-originating-graph-buffer): New local variable.
(cogre-activate): Track the originating buffer before customizing.
(eieio-done-customizing::cogre-graph-element): Set buffer to the
graph before forcing a re-render.
2001-08-14 Eric M. Ludlam <zappo at gnu.org>
* picture-hack.el:
Use `move-to-column' instead of `move-to-column-force' for backward
compatibility.
2001-08-08 Eric M. Ludlam <zappo at gnu.org>
* Project.ede: Project file for cogre.
* cogre.texi: Outline of a cogre manual
* picture-hack.el (picture-insert-rectangle):
Added Emacs 21 compatibility comment.
(clear-rectangle): New compatibility function.
* cogre.el: Support latest EIEIO changes.
(cogre-new-node): Pass prefix arg to `cogre-default-node'.
(cogre-new-link): Pass prefix arg to `cogre-default-link'.
(cogre-layout): Remove these methods.
2001-07-20 Eric M. Ludlam <zappo at gnu.org>
* cogre-uml.el: Added comment about ASCII UML.
2001-07-12 Eric M. Ludlam <zappo at gnu.org>
* cogre.el: Use :class instead of class for allocation of slots.
2001-06-12 Eric M. Ludlam <zappo at gnu.org>
* INSTALL: Installation instructions for COGRE.
2001-06-06 Eric M. Ludlam <zappo at gnu.org>
* picture-hack.el: (Colin Marquardt):
Added XEmacs compatibility functions.
2001-06-05 Eric M. Ludlam <zappo at gnu.org>
* uml-create.el (cogre-uml-stoken->uml):
Call abbreviate token from the originating buffer.
2001-05-21 Eric M. Ludlam <zappo at gnu.org>
* cogre.el (cogre-string-with-face):
Fixed bug in last fix that colorized everything.
* uml-create.el: do not use window-list, it is Emacs 21 only.
* cogre.el:
Stopped using `plist-member' which appears to be Emacs 21 only.
2001-05-19 Eric M. Ludlam <zappo at gnu.org>
* uml-create.el (cogre-semantic-uml-graph): New class.
(cogre-insert-clas-slist:cogre-semantic-uml-graph): New method.
(cogre-uml-source-marker:cogre-semantic-class): New method
(cogre-uml-source-display): Split into cogre-uml-source-marker for
getting the position to jump to.
(cogre-activate:cogre-semantic-class): New method.
(cogre-uml-quick-class): Make sure all tokens are in buffers.
Create the graph from cogre-semantic-uml-graph.
* cogre.el (cogre-node): Fixed documentation.
(cogre-substitute): Doc fix.
(cogre-mode-map): Added RETURN binding to edit/view.
(cogre-insert-class-list:cogre-graph): New method
(cogre-insert-forms-menu): Call graph method for things to insert.
(cogre): accept an argument for the class of the graph to create.
(cogre-activate-element): New function.
(cogre-activate:cogre-graph-element): New method.
2001-05-18 Eric M. Ludlam <zappo at gnu.org>
* uml-create.el: Code from `cogre-uml.el' specific to semantic.
New code handles graph/source interactions.
* cogre-uml.el: Moved out semnatic specific UML into `uml-create.el'
(cogre-uml-stoken->uml): New function.
(cogre-node-slots): Use above.
* cogre.el (*-face): Under/Over lines match default foreground color.
(cogre-link): Types are now the explicit class name (return of eieio feature).
(cogre-move-node): Inhibit motion hooks.
(cogre-render-buffer): Inhibit motion hooks.
(cogre-entered, cogre-left: cogre-graph-element): New methods.
(cogre-node-rebuild): Use underlining when possible instead of overlining.
(cogre-string-with-face): Propagate properties on passed in strings.
Conglomerate new face with old faces.
2001-05-09 Eric M. Ludlam <zappo at gnu.org>
* cogre.el: Converted to use the new eieio-named base class.
Added "Delete" to the menu.
* cogre-uml.el: Converted to use the new eieio-named base class.
2001-05-07 Eric M. Ludlam <zappo at gnu.org>
* cogre-uml.el (cogre-class): Set the alignment to left.
(cogre-node-slots): Use the new uml-abbreviate method.
(cogre-read-class-name): Fix bugs w/ current class under cursor.
(cogre-uml-quick-class): Added recentering code.
* cogre.el (cogre-horizontal-margins, cogre-vertical-margins):
New variables
(cogre-graph-element): Added `menu' field.
(cogre-node): Added `alignment' field.
Added menu to minor mode keymap.
(cogre-insert-forms-menu, cogre-change-forms-menu): New fcn.
(cogre-new-node,cogre-new-link): Only rerender if interactive.
(cogre-move-node): Pulled out guts into a method.
(cogre-move, cogre-move-detla): New Node mehtods.
(cogre-rebuild:cogre-node): Added alignment when rebuilding the rect.
(cogre-string-with-face): Handle an alignment argument.
(cogre-current-element): Make the passed in point optional.
2001-05-02 Eric M. Ludlam <zappo at gnu.org>
* cogre-uml.el: Messed with some link icons.
Added a class slot to the class node.
Added cogre-uml-quick-class, and got most of it working.
2001-04-25 Eric M. Ludlam <zappo at gnu.org>
* cogre-uml.el: Added new default names to nodes.
Initialize a CLASS node by asking for a class, derived from semantic,
from which the the details are created.
Fixed typo for ratio.
Fixed `cogre-read-class-name'.
* cogre.el:
Added a layout direction to links so they can choose a preferred layout.
Moved cogre-substitute so it wouldn't throw an error.
Always truncate lines in a graph.
Fixed bug when choosing the face of the last slot in a box.
Updated widest-string method to also take slots into account.
Fixed anchor calculation for endpoint down links.
Added mock functions for the layout engine.
2001-04-24 Eric M. Ludlam <zappo at gnu.org>
* cogre-uml.el: *** empty log message ***
2001-04-23 Eric M. Ludlam <zappo at gnu.org>
* cogre.el:
Allow links to contain a start/end which is a child of cogre-node.
Added support for start/end glyps on lines.
Added new fns to handle default node/link insertion. Thus, you will
always insert the same type of node as done previously unless you
explicitly call something to set the defualt node, or use c-u prefix.
2001-04-18 Eric M. Ludlam <zappo at gnu.org>
* cogre.el: Moved many bits to picture-hack.el where appropriate.
Added a preference-ratio and a stop-position to links.
Added a DELETE command to delete items.
Added more *-at-point-interactive functions.
Support links when TABing between items.
Added utils for calculating distances and anchors between nodes.
Fixed up link render to be simpler with the new utils.
* picture-hack.el: Hacks to override and augment picture.el
2001-04-14 Eric M. Ludlam <zappo at gnu.org>
* cogre.el: *** empty log message ***
1.1 XEmacs/packages/xemacs-packages/cogre/INSTALL
Index: INSTALL
===================================================================
How to install COGRE
1) Byte compile COGRE (optional, but recommended)
Follow the INSTALL file in the top level of this distribution.
1.1 XEmacs/packages/xemacs-packages/cogre/Makefile
Index: Makefile
===================================================================
# Makefile for cogre 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 = 0.5
MAINTAINER = XEmacs Development Team <xemacs-beta at xemacs.org>
AUTHOR = Eric M. Ludlam <zappo at gnu.org>
PACKAGE = cogre
PKG_TYPE = regular
REQUIRES = xemacs-base edebug xemacs-devel cedet-common eieio semantic
CATEGORY = standard
ELCS = cogre-mode.elc cogre-uml.elc cogre.elc \
picture-hack.elc uml-create.elc \
wisent-dot-wy.elc wisent-dot.elc
EXTRA_SOURCES = ChangeLog.upstream
STANDARD_DOCS = t
include ../../XEmacs.rules
1.1 XEmacs/packages/xemacs-packages/cogre/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
wy_SEMANTIC_GRAMMAR=wisent-dot.wy
EMACS=emacs
LOADPATH= ../common/ ../semantic/ ../eieio/\
../semantic/wisent/ ../speedbar/ ../semantic/bovine/
wy_SEMANTIC_GRAMMAR_EL=wisent-dot-wy.el
EMACS=emacs
LOADDEFS=cogre-loaddefs.el
LOADDIRS=.
init_LISP=cogre-load.el
EMACS=emacs
dot_LISP=wisent-dot.el
Mode_LISP=cogre-mode.el
info_TEXINFOS=cogre.texi
MAKEINFO=makeinfo
misc_MISC=INSTALL ChangeLog
hacks_LISP=picture-hack.el
COGRE_LISP=cogre.el cogre-uml.el uml-create.el
VERSION=0.5
DISTDIR=$(top)COGRE-$(VERSION)
all: wy autoloads init dot Mode cogre.info misc hacks COGRE
.PHONY: wy
wy: $(wy_SEMANTIC_GRAMMAR)
@echo "(add-to-list 'load-path nil)" > grammar-make-script
@for loadpath in . ${LOADPATH}; do \
echo "(add-to-list 'load-path \"$$loadpath\")" >> grammar-make-script; \
done;
@echo "(require 'semantic-load)" >> grammar-make-script
@echo "(require 'semantic-grammar)" >> grammar-make-script
"$(EMACS)" -batch --no-site-file -l grammar-make-script -f semantic-grammar-batch-build-packages $^
.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: dot
dot: $(dot_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: Mode
Mode: $(Mode_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 $^
cogre.info: $(info_TEXINFOS)
$(MAKEINFO) $<
misc:
@
.PHONY: hacks
hacks: $(hacks_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: COGRE
COGRE: $(COGRE_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 $^
tags:
clean:
rm -f *.elc *.html *.info*
.PHONY: dist
dist: $(wy_SEMANTIC_GRAMMAR_EL) autoloads cogre.info
mkdir $(DISTDIR)
cp $(wy_SEMANTIC_GRAMMAR) $(wy_SEMANTIC_GRAMMAR_EL) cogre-loaddefs.el $(init_LISP) $(dot_LISP) $(Mode_LISP) $(info_TEXINFOS) cogre.info* $(misc_MISC) $(hacks_LISP) $(COGRE_LISP) $(ede_FILES) $(DISTDIR)
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/cogre/Project.ede
Index: Project.ede
===================================================================
;; Object COGRE
;; EDE project file.
(ede-proj-project "COGRE"
:name "COGRE"
:version "0.5"
:file "Project.ede"
:targets (list
(semantic-ede-proj-target-grammar "wy"
:name "wy"
:path ""
:source '("wisent-dot.wy")
)
(ede-proj-target-elisp-autoloads "autoloads"
:name "autoloads"
:path ""
:autoload-file "cogre-loaddefs.el"
)
(ede-proj-target-elisp "init"
:name "init"
:path ""
:source '("cogre-load.el")
)
(ede-proj-target-elisp "dot"
:name "dot"
:path ""
:source '("wisent-dot.el")
:aux-packages '("wisent")
)
(ede-proj-target-elisp "Mode"
:name "Mode"
:path ""
:source '("cogre-mode.el")
)
(ede-proj-target-makefile-info "info"
:name "info"
:path ""
:source '("cogre.texi")
)
(ede-proj-target-makefile-miscelaneous "misc"
:name "misc"
:path ""
:source '("INSTALL" "ChangeLog")
)
(ede-proj-target-elisp "hacks"
:name "hacks"
:path ""
:source '("picture-hack.el")
)
(ede-proj-target-elisp "(cogre.el cogre-uml.el uml-create.el)"
:name "COGRE"
:path ""
:source '("cogre.el" "cogre-uml.el" "uml-create.el")
:versionsource '("cogre.el")
:aux-packages '("eieio" "semantic" "semantic-el" "inversion" "speedbar")
)
)
:web-site-url "http://cedet.sourceforge.net/cogre.shtml"
:web-site-directory "/r at scp:shell.sourceforge.net:cedet/htdocs"
:web-site-file "cogre.shtml"
:ftp-upload-site "/ftp at upload.sourceforge.net:/incoming"
:metasubproject 't
)
1.1 XEmacs/packages/xemacs-packages/cogre/cogre-load.el
Index: cogre-load.el
===================================================================
;;; cogre-load.el --- Autoload definitions for COGRE
;;; Copyright (C) 2003 David Ponce
;; Author: David Ponce <david at dponce.com>
;; X-RCS: $Id: cogre-load.el,v 1.1 2007/11/26 15:04:22 michaels Exp $
;; COGRE 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 COGRE for all supported conditions.
;;; Code:
;;
;;; COGRE autoloads
;;
(load "cogre-loaddefs" nil t)
(provide 'cogre-load)
;;; cogre-load.el ends here
1.1 XEmacs/packages/xemacs-packages/cogre/cogre-loaddefs.el
Index: cogre-loaddefs.el
===================================================================
;;; cogre-loaddefs.el --- Auto-generated CEDET autoloads
;;
;;; Code:
;;;### (autoloads (cogre-load-graph cogre) "cogre" "cogre.el" (17953
;;;;;; 30523))
;;; Generated autoloads from cogre.el
(autoload (quote cogre) "cogre" "\
Create a new graph with the Connected Graph Editor.
The new graph will be given NAME. See `cogre-mode' for details.
Optional argument GRAPH-CLASS indicates the type of graph to create." t nil)
(autoload (quote cogre-load-graph) "cogre" "\
Load a graph from FILE into a new graph buffer." t nil)
;;;***
;;;### (autoloads (cogre-mode) "cogre-mode" "cogre-mode.el" (17881
;;;;;; 2107))
;;; Generated autoloads from cogre-mode.el
(autoload (quote cogre-mode) "cogre-mode" "\
Connected Graph Editor Mode.
\\{cogre-mode-map}" t nil)
;;;***
;;;### (autoloads (cogre-uml-create cogre-uml-quick-class) "uml-create"
;;;;;; "uml-create.el" (17954 15791))
;;; Generated autoloads from uml-create.el
(autoload (quote cogre-uml-quick-class) "uml-create" "\
Create a new UML diagram based on CLASS showing only immediate lineage.
The parent to CLASS, CLASS, and all of CLASSes children will be shown." t nil)
(autoload (quote cogre-uml-create) "uml-create" "\
Create a new UML diagram, with CLASS as the root node.
CLASS must be a type in the current project." t nil)
;;;***
;;;### (autoloads (wisent-dot-setup-parser) "wisent-dot" "wisent-dot.el"
;;;;;; (17213 39659))
;;; Generated autoloads from wisent-dot.el
(autoload (quote wisent-dot-setup-parser) "wisent-dot" "\
Setup buffer for parse." nil nil)
(add-hook (quote graphviz-dot-mode-hook) (quote wisent-dot-setup-parser))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; cogre-loaddefs.el ends here
1.1 XEmacs/packages/xemacs-packages/cogre/cogre-mode.el
Index: cogre-mode.el
===================================================================
;;; cogre-mode.el --- Graph editing mode
;;; Copyright (C) 2001, 2002, 2003, 2007 Eric M. Ludlam
;; This file is not part of GNU Emacs.
;; This 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:
;;
;; COGRE mode is based on a generic editor that can render arbitrary
;; graphs as specified by the COGRE core classes.
;; This depends on EIEIO for graph management. COGRE mode depends on
;; `picture-mode' for drawing.
;;
;; Because COGRE graphs are meant to be edited in some fashion, COGRE
;; graphs depend on the custom widget library to provide text
;; controls, or toggle buttons for editing state in a graph.
(require 'picture-hack)
(require 'eieio)
(require 'eieio-opt)
(require 'eieio-base)
(require 'cogre)
;;; Code:
(defface cogre-box-face '((((class color) (background dark))
(:background "gray30" :foreground "white"))
(((class color) (background light))
(:background "gray" :foreground "black")))
"Face used for rectangles of boxes displaying data."
:group 'cogre)
(defface cogre-box-first-face '((((class color) (background dark))
(:background "gray30" :foreground "white" :overline "white"))
(((class color) (background light))
(:background "gray" :foreground "black" :overline "black")))
"Face used for the first data item in rectangles of boxes displaying data.
This has the `overline' property set to display borders between sections
within a box."
:group 'cogre)
(defface cogre-box-last-face '((((class color) (background dark))
(:background "gray30" :foreground "white" :underline "white"))
(((class color) (background light))
(:background "gray" :foreground "black" :underline "black")))
"Face used for the first data item in rectangles of boxes displaying data.
This has the `overline' property set to display borders between sections
within a box."
:group 'cogre)
(defvar cogre-mode-map nil
"Keymap used for COGRE mode.")
(defun cogre-substitute (oldfun newfun)
"Substitue a key binding in ghe `cogre-mode-map'.
Argument OLDFUN is removed NEWFUN is substituted in."
(substitute-key-definition oldfun newfun cogre-mode-map global-map))
(if cogre-mode-map
nil
(setq cogre-mode-map (make-keymap))
(suppress-keymap cogre-mode-map)
;; Structure Information
(define-key cogre-mode-map "\C-m" 'cogre-activate-element)
;; Structure changes
(define-key cogre-mode-map "R" 'cogre-refresh)
(define-key cogre-mode-map "N" 'cogre-new-node)
(define-key cogre-mode-map "L" 'cogre-new-link)
(define-key cogre-mode-map "D" 'cogre-delete)
;; Changing and Setting Defaults
(define-key cogre-mode-map "\C-c\C-n" 'cogre-default-node)
(define-key cogre-mode-map "\C-c\C-l" 'cogre-default-link)
;; Modifications
(define-key cogre-mode-map "n" 'cogre-set-element-name)
(define-key cogre-mode-map "l" 'cogre-edit-label)
;; Move nodes around
(define-key cogre-mode-map [(meta left)] 'cogre-move-node-left)
(define-key cogre-mode-map [(meta right)] 'cogre-move-node-right)
(define-key cogre-mode-map [(meta down)] 'cogre-move-node-down)
(define-key cogre-mode-map [(meta up)] 'cogre-move-node-up)
(define-key cogre-mode-map "\M-b" 'cogre-move-node-left)
(define-key cogre-mode-map "\M-f" 'cogre-move-node-right)
(define-key cogre-mode-map "\M-n" 'cogre-move-node-down)
(define-key cogre-mode-map "\M-p" 'cogre-move-node-up)
;; Cursor Movement
(define-key cogre-mode-map "\C-i" 'cogre-next-node)
(define-key cogre-mode-map "\M-\C-i" 'cogre-prev-node)
(cogre-substitute 'forward-char 'picture-forward-column)
(cogre-substitute 'backward-char 'picture-backward-column)
(cogre-substitute 'next-line 'picture-move-down)
(cogre-substitute 'previous-line 'picture-move-up)
;; File IO
(define-key cogre-mode-map "\C-x\C-s" 'cogre-save-graph)
)
(easy-menu-define
cogre-mode-menu cogre-mode-map "Connected Graph Menu"
'("Graph"
("Insert" :filter cogre-insert-forms-menu)
("Navigate"
["Next Element" cogre-next-node t ]
["Prev Element" cogre-prev-node t ]
["Move Node Up" cogre-move-node-up (cogre-node-child-p (cogre-current-element)) ]
["Move Node Down" cogre-move-node-down (cogre-node-child-p (cogre-current-element)) ]
["Move Node Left" cogre-move-node-left (cogre-node-child-p (cogre-current-element)) ]
["Move Node right" cogre-move-node-right (cogre-node-child-p (cogre-current-element)) ]
)
("Change" :filter cogre-change-forms-menu)
"--"
[ "Delete" cogre-delete (cogre-current-element) ]
[ "Refresh" cogre-refresh t ]
[ "Save Graph" cogre-save-graph t ]
[ "Save Graph As" cogre-save-graph-as t ]
))
(defmethod cogre-insert-class-list ((graph cogre-graph))
"Return a list of classes GRAPH will accept."
(eieio-build-class-alist 'cogre-graph-element))
(defun cogre-insert-forms-menu (menu-def)
"Create a menu for cogre INSERT item.
Argument MENU-DEF is the easy-menu definition."
(easy-menu-filter-return
(easy-menu-create-menu
"Insert Forms"
(let ((obj (cogre-current-element))
(elements (cogre-insert-class-list cogre-graph))
(newmenu nil))
(while elements
;; Added (car elements) to the menu.
(setq newmenu (cons
(vector (car (car elements))
`(progn
(cogre-new-node
(point)
(intern ,(car (car elements))))
(cogre-render-buffer cogre-graph)
)
t)
newmenu))
(setq elements (cdr elements)))
(append (list [ "New Link" cogre-new-link t ]
[ "New Node" cogre-new-node t ]
)
(nreverse newmenu))
))))
(defun cogre-change-forms-menu (menu-def)
"Create a menu for cogre CHANGE item.
Argument MENU-DEF is the easy-menu definition."
(easy-menu-filter-return
(easy-menu-create-menu
"Change Forms"
(let* ((obj (cogre-current-element))
(newmenu (if obj (oref obj menu))))
(append '( [ "Name" cogre-set-element-name (cogre-current-element) ]
[ "View/Edit" cogre-activate-element (cogre-current-element) ]
)
(nreverse newmenu))
))))
;;; Major Mode
;;
;;;###autoload
(defun cogre-mode ()
"Connected Graph Editor Mode.
\\{cogre-mode-map}"
(interactive)
(setq major-mode 'cogre-mode
mode-name "Cogre")
(use-local-map cogre-mode-map)
(setq truncate-lines t)
(run-hooks 'cogre-mode-hook)
(cogre-render-buffer cogre-graph t)
)
(put 'cogre-mode 'semantic-match-any-mode t)
;;; Interactive utility functions
;;
(defun cogre-node-at-point-interactive (&optional pos)
"Return the node under POS.
Throw an error if there is no node."
(let ((e (cogre-current-element (or pos (point)))))
(if (or (not e) (not (obj-of-class-p e cogre-node)))
(error "No graph node under point")
e)))
(defun cogre-link-at-point-interactive (&optional pos)
"Return the node under POS.
Throw an error if there is no node."
(let ((e (cogre-current-element (or pos (point)))))
(if (or (not e) (not (obj-of-class-p e cogre-link)))
(error "No graph node under point")
e)))
(defun cogre-element-at-point-interactive (&optional pos)
"Return the node under POS.
Throw an error if there is no node."
(let ((e (cogre-current-element (or pos (point)))))
(if (not e)
(error "No graph node under point")
e)))
;;; Edit/View elements
;;
(defun cogre-activate-element (element)
"View/Edit the ELEMENT.
The default ELEMENT is the one found under the cursor."
(interactive (list (cogre-current-element)))
(if element
(cogre-activate element)
(error "The cursor is not on an object")))
;;; Insert/Delete
;;
(defun cogre-new-node (point nodetype)
"Insert a new node at the current point.
Argument POINT is a position to insert this node to.
NODETYPE is the eieio class name for the node to insert."
(interactive (list (point) (cogre-default-node nil current-prefix-arg)))
(save-excursion
(goto-char point)
(if (not nodetype) (setq nodetype 'cogre-node))
(let* ((x (current-column))
(y (cogre-current-line))
(n (make-instance nodetype (oref nodetype name-default)
:position (vector x y)))
)
(if (interactive-p)
(cogre-render-buffer cogre-graph))
)))
(defun cogre-new-link (mark point &optional linktype)
"Insert a new link from the node at MARK to POINT of LINKTYPE.
MARK is the node within which the current mark is set.
POINT is the node the cursor is in.
LINKTYPE is the eieio class name for the link to insert."
(interactive (list (cogre-node-at-point-interactive (mark))
(cogre-node-at-point-interactive (point))
(cogre-default-link nil current-prefix-arg)))
(if (not linktype) (setq linktype cogre-link))
(make-instance linktype "Link" :start mark :end point)
(if (interactive-p)
(cogre-render-buffer cogre-graph))
)
(defvar cogre-delete-dont-ask nil
"Track if we should ask about deleting an object from the graph.")
(defun cogre-delete (element)
"Delete the graph ELEMENT under the cursor."
(interactive (list (cogre-element-at-point-interactive (point))))
(if (or cogre-delete-dont-ask
(y-or-n-p (format "Really delete %s? " (object-name element))))
(let ((cogre-delete-dont-ask t))
(if (obj-of-class-p element cogre-node)
(let ((el (oref cogre-graph elements))
(test nil))
(while el
(setq test (car el)
el (cdr el))
(if (and (obj-of-class-p test cogre-link)
(or (eq element (oref test start))
(eq element (oref test end))))
(cogre-delete test)))))
(cogre-erase element)
(cogre-delete-element cogre-graph element))
))
;;; Navigation
;;
(defun cogre-next-node (&optional arg)
"Move forward ARG nodes in the hierarchy.
If ARG is unspecified, assume 1."
(interactive "p")
(let ((n (cogre-current-element (point)))
(e (oref cogre-graph elements))
(next nil))
(if (not n)
;; Not on the node? Tab around.
(setq next (car e))
(let* ((l (length e))
(i (- l (length (member n e))))
(ni (+ i arg)))
(if (< ni 0) (setq ni (+ l ni))
(if (>= ni l) (setq ni (- ni l))))
(setq next (nth ni e))))
(if (obj-of-class-p next cogre-node)
(let ((p (oref next position)))
(picture-goto-coordinate (aref p 0) (aref p 1)))
;; Else, we have a link
(with-slots (stop-position) next
(apply 'picture-goto-coordinate stop-position)
))))
(defun cogre-prev-node (&optional arg)
"Move backward ARG nodes in the hierarchy.
If ARG is unspecified, assume 1."
(interactive "p")
(cogre-next-node (- arg)))
;;; Node Modification
;;
(defun cogre-set-element-name (node name)
"Set the name of the current NODE to NAME."
(interactive (let ((e (cogre-node-at-point-interactive)))
(list e (read-string "New Name: " ""
nil (oref e object-name)))))
(cogre-erase node)
(oset node object-name (cogre-unique-name cogre-graph name))
(if (interactive-p)
(cogre-render-buffer cogre-graph))
)
(defun cogre-move-node (x y)
"Set NODE to postion X, Y."
(interactive "nX: \nnY: ")
(let ((inhibit-point-motion-hooks t)
(e (cogre-current-element (point))))
(cogre-erase e)
(cogre-move e x y)
(picture-goto-coordinate x y))
(if (interactive-p)
(cogre-render-buffer cogre-graph)))
(defun cogre-move-node-left (arg)
"Move NODE left by ARG columns."
(interactive "p")
(let* ((e (cogre-current-element (point)))
(p (oref e position)))
(cogre-move-node (- (aref p 0) arg) (aref p 1))
(if (interactive-p)
(cogre-render-buffer cogre-graph))))
(defun cogre-move-node-right (arg)
"Move NODE right by ARG columns."
(interactive "p")
(let* ((e (cogre-current-element (point)))
(p (oref e position)))
(cogre-move-node (+ (aref p 0) arg) (aref p 1))
(if (interactive-p)
(cogre-render-buffer cogre-graph))))
(defun cogre-move-node-up (arg)
"Move NODE up by ARG columns."
(interactive "p")
(let* ((e (cogre-current-element (point)))
(p (oref e position)))
(cogre-move-node (aref p 0) (- (aref p 1) arg))
(if (interactive-p)
(cogre-render-buffer cogre-graph))))
(defun cogre-move-node-down (arg)
"Move NODE down by ARG columns."
(interactive "p")
(let* ((e (cogre-current-element (point)))
(p (oref e position)))
(cogre-move-node (aref p 0) (+ (aref p 1) arg))
(if (interactive-p)
(cogre-render-buffer cogre-graph))))
(provide 'cogre-mode)
;;; cogre-mode.el ends here
1.1 XEmacs/packages/xemacs-packages/cogre/cogre-uml.el
Index: cogre-uml.el
===================================================================
;;; cogre-uml.el --- UML support for COGRE
;;; Copyright (C) 2001 Eric M. Ludlam
;; Author: Eric M. Ludlam <zappo at gnu.org>
;; Keywords: oop, uml
;; X-RCS: $Id: cogre-uml.el,v 1.1 2007/11/26 15:04:23 michaels Exp $
;; This file is not part of GNU Emacs.
;; This 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:
;;
;; Provides UML support for COGRE.
;;
;; See http://c2.com/cgi/wiki?UmlAsciiArt for more examples of using
;; ASCII to draw UML diagrams.
(require 'cogre)
;;; Code:
(defclass cogre-package (cogre-node)
((name-default :initform "Package")
(blank-lines-top :initform 0)
(blank-lines-bottom :initform 0)
(alignment :initform left)
(subgraph :initarg :subgraph
:initform nil
:type (or null cogre-graph)
:documentation
"A graph which represents the classes within this package.
The subgraph should be scanned to extract all the elements drawn into
the package node.")
)
"A Package node.
Packages represent other class diagrams, and list the major nodes
within them. They can be linked by dependency links.")
(defmethod cogre-node-slots ((package cogre-package))
"Return a list containing the list of classes in PACKAGE.
The `subgraph' slot must be scanned for this information."
(list nil)
)
(defclass cogre-class (cogre-node)
((name-default :initform "Class")
(blank-lines-top :initform 0)
(blank-lines-bottom :initform 0)
(alignment :initform left)
(class :initarg :class
:initform nil
:type (or string list)
:custom sexp
:documentation
"The semantic token representing the class this is drawing.")
(attributes :initarg :attributes
:initform nil
:type list
:custom sexp
:documentation
"A list of attributes belonging to this Class representation.
Each attribute must in the form of a semantic token. ei.
(\"object-name\" variable \"type\" ... )
See `semantic-fetch-tags' for details on possible token forms.
These items do not need to be REAL semantic tokens, however.
Only the format is needed to get the name/typing information.")
(methods :initarg :methods
:initform nil
:type list
:custom sexp
:documentation
"A list of methods belonging to this Class representation.
See `attribute' slot for details on the form of each token in this list.")
)
"A Class node.
Class nodes represent a class, and can list the attributes and methods
within them. Classes can have attribute links, and class hierarchy links.")
(defmethod cogre-uml-stoken->uml ((class cogre-class) stoken &optional text)
"For CLASS convert a Semantic style token STOKEN into a uml definition.
It also adds properties that enable editing, and interaction with
this node. Optional argument TEXT is a preformatted string."
(let ((newtext
(or text
(concat (car stoken) ":"
(cond ((stringp (nth 2 stoken))
(nth 2 stoken))
((listp (nth 2 stoken))
(car (nth 2 stoken)))
(t ""))))))
;; Add in some useful properties
(add-text-properties 0 (length newtext)
(list 'semantic stoken
)
newtext)
;; Return the string
newtext))
(defmethod cogre-node-slots ((class cogre-class))
"Return a list of each section, including title, attributes, and methods.
Argument CLASS is the class whose slots are referenced."
(list
(mapcar (lambda (s) (cogre-uml-stoken->uml class s)) (oref class attributes))
(mapcar (lambda (s) (cogre-uml-stoken->uml class s)) (oref class methods))
))
(defclass cogre-inherit (cogre-link)
((end-glyph :initform [ (" ^ " "/_\\")
("_|_" "\\ /" " V ")
(" /|" "< |" " \\|")
("|\\" "|/") ])
(horizontal-preference-ratio :initform .1)
)
"This type of link indicates that the two nodes reference infer inheritance.
The `start' node is the child, and the `end' node is the parent.
This is supposed to infer that START inherits from END.")
(defclass cogre-aggrigate (cogre-link)
((start-glyph :initform [ ("/\\ " "\\/" )
("/\\ " "\\/" )
("<>") ("<>") ])
(horizontal-preference-ratio :initform 1)
)
"This type of link indicates aggregation.
The `start' node is the owner of the aggregation, the `end' node is
the item being aggregated.
This is supposed to infer that START contains END.")
(provide 'cogre-uml)
;;; cogre-uml.el ends here
1.1 XEmacs/packages/xemacs-packages/cogre/cogre.el
Index: cogre.el
===================================================================
;;; cogre.el --- COnnected GRaph Editor for Emacs
;;; Copyright (C) 2001, 2002, 2003, 2005, 2007 Eric M. Ludlam
;; Author: Eric M. Ludlam <zappo at gnu.org>
;; Keywords: graph, oop, extensions, outlines
;; X-RCS: $Id: cogre.el,v 1.1 2007/11/26 15:04:23 michaels Exp $
(defvar cogre-version "0.5"
"Current version of Cogre.")
;; This file is not part of GNU Emacs.
;; This 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:
;;
;; Many types of code can be displayed as a series of connected
;; graphs, such as UML class or sequence diagrams. COGRE attempts to
;; allow Emacs to display such graphs with data generated from
;; source code.
;;
(require 'cogre-load)
(require 'eieio)
(require 'eieio-opt)
(require 'eieio-base)
(require 'semantic)
(eval-when-compile
(require 'picture-hack))
;;; Code:
;;; Display Faces
(defgroup cogre nil
"COnnected GRaph Editor."
:group 'tools)
(defcustom cogre-horizontal-margins 10
"*Horizontal margins between nodes when they are being layed out."
:group 'cogre
:type 'number)
(defcustom cogre-vertical-margins 7
"*Horizontal margins between nodes when they are being layed out."
:group 'cogre
:type 'number)
;;; Classes
(defclass cogre-graph (eieio-persistent)
((extension :initform ".cgr") ;; Override the default
(name :initarg :name
:initform "NewGraph"
:type string
:custom string
:documentation
"The name of this graph.
The save file name is based on this name.")
(buffer :initarg :buffer
:initform nil
:type (or null buffer)
:documentation
"When this graph is active, this is the buffer the graph is
displayed in.")
(elements :initarg :elements
:initform nil
:type list
:documentation
"The list of elements in this graph.")
)
"A Connected Graph.
a connected graph contains a series of nodes and links which are
rendered in a buffer, or serialized to disk.")
(defclass cogre-graph-element (eieio-named)
((dirty :initform t
:documentation
"Non-nil if this graph element is dirty.
Elements are made dirty when they are erased from the screen.
Elements must be erased before any graphical fields are changed.")
(name-default :initform "Name"
:type string
:custom string
:allocation :class
:documentation
"The object-name of this node.
Node object-names must be unique within the current graph so that save
references in links can be restored.")
(menu :initform nil
:type list
:allocation :class
:documentation
"List of menu items in Easymenu format of changeable things.
Any given element may have several entries of details which are
modifiable.
Examples could be Add/Removing/Renaming slots, or changing linkages."
)
)
"A Graph Element.
Graph elements are anything that is drawn into a `cogre-graph'.
Graph elements have a method for marking themselves dirty."
:abstract t)
(defclass cogre-node (cogre-graph-element)
((position :initarg :position
:initform [ 0 0 ]
:type vector
:custom (vector integer integer)
:documentation
"The X,Y [COL ROW] position as a vector for this node.
The Width/Height if this node is determined by RECTANGLE, which is
a list of strings representing the body of the node."
)
(blank-lines-top :allocation :class
:initform 1
:documentation
"Number of blank lines above the object-name.")
(blank-lines-bottom :allocation :class
:initform 1
:documentation
"Number of blank lines below the last line of text.")
(alignment :initform nil
:type symbol
:allocation :class
:documentation
"Alignment of text when displayed in the box.")
(rectangle :initform nil
:type list
:documentation
"A List of strings representing an Emacs rectangle.
This rectangle is used for inserting and moving the block of
characters that represent this node in a buffer.
The rectangle is NOT SAVED.
Other fields in the node are used to build a new RECTANGLE of strings
at load time.")
)
"Connected Graph node.
Nodes are regions with a fill color, and some amount of text representing
a status, or values."
)
(defclass cogre-link (cogre-graph-element)
((start :initarg :start
:initform nil
:type (or null string cogre-node)
:documentation "The starting node.
As a string, the object-name of the node we start on.
As an object, the node we start on.")
(end :initarg :end
:initform nil
:type (or null string cogre-node)
:documentation "The ending node.
As a string, the object-name of the node we end on.
As an object, the node we end on.")
(start-glyph :initform [ nil nil nil nil ]
:allocation :class
:type vector
:documentation "The starting glyph.
A Glyph can be NULL, meaning nothing, or a vector.
A Vector must be 4 elements long. This represents glyphs on
the [ TOP BOTTOM LEFT RIGHT ] of the attached node.
Each element of the vector must be a list representing a rectangle.")
(end-glyph :initform [ nil nil nil nil ]
:allocation :class
:type vector
:documentation "The ending glyph.
See slot `start-glyph'")
(horizontal-preference-ratio
:initform .5
:allocation :class
:documentation
"When choosing a link's direction, a weight applied to horizontal.
Since characters are not square, this ratio attempts to handle the visible
space the link spans, not the number of characters in the coordinate
system being used.
Also, some links may want to be vertical or horizontal as often as
possible, thus values of 0 or 10 are also fine to advance a
preference." )
(stop-position :initform nil
:documentation
"After drawing this link, store a place for a tab stop.")
(layout-direction
:initform 'any
:documentation
"When using the layout engine, the preferred direction this link points.
This can have a value of 'up, 'down, 'left, 'right, 'horizontal,
'vertical, or 'any.")
)
"Connected Graph link.
Links are lines drawn between two nodes, or possibly loose in space
as an intermediate step. Some links have text describing what they
do, and most links have special markers on one end or another, such as
arrows or circles.")
;;; Connecte Graph variables
;;
(defvar cogre-loading-from-file nil
"Flag indicating that we are loading a graph from a file.")
(defcustom cogre-mode-hooks nil
"Hooks run in `cogre-mode'."
:group 'cogre
:type 'hook)
(defvar cogre-graph nil
"The current connected graph.")
(make-variable-buffer-local 'cogre-graph)
;;; Buffer initialization
;;
;;;###autoload
(defun cogre (name &optional graph-class)
"Create a new graph with the Connected Graph Editor.
The new graph will be given NAME. See `cogre-mode' for details.
Optional argument GRAPH-CLASS indicates the type of graph to create."
(interactive "sGraph Name: ")
(let ((newgraph (if graph-class
(funcall graph-class name :name name)
(cogre-graph name :name name))))
(switch-to-buffer (get-buffer-create (concat "*Graph " name "*")))
(setq cogre-graph newgraph)
;;(toggle-read-only 1)
(require 'cogre-mode)
(cogre-mode)
))
;;; Default management
;;
;; Defaults provide a way of quickly creating a bunch of the same type
;; of node/link, or whatever. By using these functions in `interactive'
;; commands, a set of defaults can be specified which are used
;; continuously.
(defvar cogre-node-history nil
"The history for reading in node class names.")
(defvar cogre-default-node nil
"The last node type queried.
Used as the default node type when a user wants a node, and no request
to change it has been made.")
(defun cogre-default-node (&optional node prefix)
"Return the default node type.
If run interactively, query for a new node to make the default.
If called non-interactivly there is no default, query for one.
If NODE is supplied, use that.
If there is a PREFIX argument, then force a query for one."
(interactive (list (eieio-read-subclass "Node Type: "
cogre-node
'cogre-node-history
t)
current-prefix-arg))
;; Save whatever is being set.
(if node (setq cogre-default-node node))
;; If we are not interactive, then check the prefix.
(if (or prefix (not cogre-default-node))
(setq cogre-default-node (eieio-read-subclass "Node Type: "
cogre-node
'cogre-node-history
t)))
;; Return the cached node.
cogre-default-node
)
(defvar cogre-link-history nil
"The history for reading in link class names.")
(defvar cogre-default-link nil
"The last link type queried.
Used as the default link type when a user wants a link, and no request
to change it has been made.")
(defun cogre-default-link (&optional link prefix)
"Return the default link type.
If run interactively, query for a new link to make the default.
If called non-interactivly there is no default, query for one.
If LINK is supplied, use that.
If there is a PREFIX argument, then force a query for one."
(interactive (list (eieio-read-subclass "Link Type: "
cogre-link
'cogre-link-history
t)
current-prefix-arg))
;; Save whatever is being set.
(if link (setq cogre-default-link link))
;; If we are not interactive, then check the prefix.
(if (or prefix (not cogre-default-link))
(setq cogre-default-link (eieio-read-subclass "Link Type: "
cogre-link
'cogre-link-history
t)))
;; Return the cached link.
cogre-default-link
)
;;; Commands for Graph Mode
;;
(defun cogre-refresh ()
"Refresh the current display completely."
(interactive)
(cogre-render-buffer cogre-graph t))
;;; Utilities
;;
(defun cogre-map-elements (function)
"Map FUNCTION onto all current graph elements."
(cogre-map-graph-elements cogre-graph function))
(defun cogre-map-graph-elements (graph function)
"For elements of GRAPH, call FUNCTION.
Function must take one argument, which is the element.
This function can also be a method.
Returns a list of return values from each call of function."
(mapcar function (oref graph elements)))
;;; State Management
;;
(defvar cogre-custom-originating-graph-buffer nil
"The graph from which a custom buffer originated.")
(make-variable-buffer-local 'cogre-custom-originating-graph-buffer)
(defmethod cogre-activate ((element cogre-graph-element))
"Activate ELEMENT.
This could be as simple as displaying the current state,
customizing the object, or performing some complex task."
(let ((b (current-buffer)))
(require 'eieio-custom)
(customize-object element)
(setq cogre-custom-originating-graph-buffer b))
)
(defmethod eieio-done-customizing ((element cogre-graph-element))
"Finish customizing a graph element."
(cogre-set-dirty element t)
(save-excursion
(set-buffer cogre-custom-originating-graph-buffer)
(cogre-render-buffer cogre-graph))
)
(defmethod cogre-add-element ((graph cogre-graph) elt)
"Add to GRAPH a new element ELT."
(object-add-to-list graph 'elements elt t))
(defmethod cogre-delete-element ((graph cogre-graph) elt)
"Delete from GRAPH the element ELT."
(object-remove-from-list graph 'elements elt))
(defmethod cogre-unique-name ((graph cogre-graph) name)
"Within GRAPH, make NAME unique."
(let ((newname name)
(obj (object-assoc name :object-name (oref graph elements)))
(inc 1))
(while obj
(setq newname (concat name (int-to-string inc)))
(setq inc (1+ inc))
(setq obj (object-assoc newname :object-name (oref graph elements))))
newname))
(defmethod cogre-set-dirty ((element cogre-graph-element) dirty-state)
"Set the dirty state for ELEMENT to DIRTY-STATE."
(oset element dirty dirty-state))
(defmethod cogre-set-dirty ((node cogre-node) dirty-state)
"Set the dirty state for NODE to DIRTY-STATE."
(if dirty-state (oset node rectangle nil))
(call-next-method))
(defmethod initialize-instance ((elt cogre-graph-element) fields)
"Initialize ELT's name before the main FIELDS are initialized."
(unless cogre-loading-from-file
(let ((n (oref elt name-default)))
(object-set-name-string elt n)))
(call-next-method))
(defmethod initialize-instance :AFTER ((elt cogre-graph-element) fields)
"When creating a new element, add it to the current graph.
Argument ELT is the element being created.
Argument FIELDS are ignored."
(unless cogre-loading-from-file
(let ((n (oref elt object-name)))
;; make sure our name is unique.
(oset elt object-name (cogre-unique-name cogre-graph n)))
(cogre-add-element cogre-graph elt)))
;;; Buffer Rendering
;;
(defmethod cogre-render-buffer ((graph cogre-graph) &optional erase)
"Render the current graph GRAPH.
If optional argument ERASE is non-nil, then erase the buffer,
and render everything. If ERASE is nil, then only redraw items
with dirty flags set."
(let ((inhibit-read-only t)
(x (current-column))
(y (1- (picture-current-line)))
(inhibit-point-motion-hooks t))
(save-excursion
(if erase
(progn
(erase-buffer)
(cogre-map-elements (lambda (e) (cogre-set-dirty e t)))))
(cogre-map-elements 'cogre-render))
(picture-goto-coordinate x y)))
(defmethod cogre-render ((element cogre-graph-element))
"Render ELEMENT.
By default, an ELEMENT has nothing to see, but assume we
are called from `call-next-method', so reset our dirty flag."
(cogre-set-dirty element nil))
(defmethod cogre-erase ((element cogre-graph-element))
"Erase ELEMENT.
By default, an ELEMENT has nothing to erase, but assume we
are called from `call-next-method', so set our dirty flag."
(cogre-set-dirty element t))
(defmethod cogre-element-pre-serialize ((elt cogre-graph-element))
"Prepare the current node to be serialized.
Remove all pointers to objects (such as links), and replace
with something reversable."
)
(defmethod cogre-element-post-serialize ((elt cogre-graph-element))
"Restore object pointers after being loaded from disk.
Also called after a graph was saved to restore all objects.
Reverses `cogre-graph-pre-serialize'."
)
(defmethod cogre-entered ((element cogre-graph-element) start end)
"Method called when the cursor enters ELEMENT.
START and END cover the region with the property."
(message "%s" (object-name element)))
(defmethod cogre-left ((element cogre-graph-element) start end)
"Method called when the cursor exits ELEMENT.
START and END cover the region with the property."
nil)
;;; Nodes
(defmethod cogre-erase ((node cogre-node))
"Erase NODE from the screen."
(let ((position (oref node position))
(rectangle (cogre-node-rectangle node))
(links (cogre-node-links node)))
(cogre-erase-rectangle (aref position 0) (aref position 1)
(length (car rectangle))
(length rectangle))
(mapcar 'cogre-erase links))
(call-next-method))
(defmethod cogre-node-links ((node cogre-node))
"Return a list of links which reference NODE."
(with-slots (elements) cogre-graph
(let ((links nil))
(mapcar (lambda (n) (if (and (obj-of-class-p n cogre-link)
(or (eq (oref n start) node)
(eq (oref n end) node)))
(setq links (cons n links))))
elements)
links)))
(defmethod cogre-node-rectangle ((node cogre-node))
"Fetch the rectangle representation for NODE."
(or (oref node rectangle)
(cogre-node-rebuild node)))
(defmethod cogre-render ((node cogre-node))
"Render NODE in the current graph."
(cogre-node-rectangle node)
(with-slots (position rectangle) node
(picture-goto-coordinate (aref position 0) (aref position 1))
(picture-insert-rectangle rectangle nil))
(call-next-method))
(defmethod cogre-node-rebuild ((node cogre-node))
"Create a new value for `:rectangle' in NODE.
The `:rectangle' slot is inserted with rectangle commands.
A Rectangle is basically a list of equal length strings.
Those strings must have the proper face values on them.
Always make the width 2 greater than the widest string."
(let* ((width (+ (cogre-node-widest-string node) 2))
(top-lines (oref node blank-lines-top))
(bottom-lines (oref node blank-lines-bottom))
(title (cogre-node-title node))
(slots (cogre-node-slots node))
(align (oref node alignment))
(first t)
(rect nil))
(while (> top-lines 0)
(setq rect (cons (cogre-string-with-face
""
(if first
(progn (setq first nil)
'cogre-box-first-face)
'cogre-box-face)
node width align)
rect)
top-lines (1- top-lines)))
(setq title (nreverse title))
(while title
(let ((face (cond ((and first (null (cdr title)))
'(cogre-box-first-face cogre-box-last-face))
(first
'cogre-box-first-face)
((and (null (cdr title))
(not (and (null slots)
(/= bottom-lines 0))))
'cogre-box-last-face)
(t 'cogre-box-face))))
(setq rect (cons (cogre-string-with-face
(car title) face
node width align)
rect)
title (cdr title))))
(while slots
(let ((sl (car slots)))
;; If a subnode has nil here, make sure we put in a blank
;; line placeholder.
(if (not sl) (setq sl (list "")))
(while sl
(let ((face (cond ((and (= bottom-lines 0)
(null (cdr sl)))
'cogre-box-last-face)
(t 'cogre-box-face))))
(setq rect (cons (cogre-string-with-face
(car sl) face
node width align)
rect)
sl (cdr sl)))))
(setq slots (cdr slots)))
(while (> bottom-lines 0)
(setq rect (cons (cogre-string-with-face
""
(if (= bottom-lines 1)
'cogre-box-last-face
'cogre-box-face)
node width align)
rect)
bottom-lines (1- bottom-lines)))
(oset node rectangle (nreverse rect))))
(defmethod cogre-move-delta ((node cogre-node) dx dy)
"Move NODE's position by DX, DY."
(let ((p (oref node position)))
(cogre-move node (+ (aref p 0) dx) (+ (aref p 1) dy))))
(defmethod cogre-move ((node cogre-node) x y)
"Move NODE to position X, Y."
(if (> 0 x) (setq x 0))
(if (> 0 y) (setq y 0))
(oset node position (vector x y))
)
(defmethod cogre-node-title ((node cogre-node))
"Return a list of strings representing the title of the NODE.
For example: ( \"Title\" ) or ( \"<Type>\" \"Title\" )"
(list (oref node object-name)))
(defmethod cogre-node-slots ((node cogre-node))
"For NODE, return a list of slot lists.
Slots are individual lines of text appearing in the body of a node.
Each list will be prefixed with a line before it."
nil)
(defmethod cogre-node-widest-string ((node cogre-node))
"Return the widest string in NODE."
(let ((namel (length (oref node object-name)))
(slots (cogre-node-slots node))
(names nil)
(ws 0))
(while slots
(setq names (car slots))
(while names
(if (> (length (car names)) ws)
(setq ws (length (car names))))
(setq names (cdr names)))
(setq slots (cdr slots)))
(if (> ws namel) ws namel)))
(defun cogre-node-horizontal-distance (node1 node2)
"Calculate the horizontal distance between NODE1 and NODE2.
This number is positive or negative, depending on the direction
of distance."
;; Make sure their rectangle's are up to date.
(cogre-node-rebuild node1)
(cogre-node-rebuild node2)
;; Get all the details
(let* ((p1 (oref node1 position)) ;position vector
(p2 (oref node2 position))
(x1 (aref p1 0)) ;X,Y for NODE1
(x2 (aref p2 0)) ;X,Y for NODE2
)
(if (< x1 x2)
;; positive distance.
(- x2 x1 (length (car (cogre-node-rectangle node1))))
(- x1 x2 (length (car (cogre-node-rectangle node2))))
)))
(defun cogre-node-vertical-distance (node1 node2)
"Calculate the vertical distance between NODE1 and NODE2.
This number is positive or negative, depending on the direction
of distance."
;; Make sure their rectangle's are up to date.
(cogre-node-rebuild node1)
(cogre-node-rebuild node2)
;; Get all the details
(let* ((p1 (oref node1 position)) ;position vector
(p2 (oref node2 position))
(y1 (aref p1 1)) ;X,Y for NODE1
(y2 (aref p2 1)) ;X,Y for NODE2
)
(if (< y1 y2)
;; positive distance.
(- y2 y1 (length (cogre-node-rectangle node1)))
(- y1 y2 (length (cogre-node-rectangle node2)))
)))
(defun cogre-choose-horizontal-link-anchors (node1 node2)
"Choose horizontal link anchor points between NODE1 and NODE2.
The data returned is (X1 Y1 X2 Y2)."
(let* ((p1 (oref node1 position)) ;position vector
(p2 (oref node2 position))
(x1 (aref p1 0)) ;X,Y for START
(y1 (aref p1 1))
(x2 (aref p2 0)) ;X,Y for END
(y2 (aref p2 1))
(r1 (cogre-node-rectangle node1)) ;rectangle text
(r2 (cogre-node-rectangle node2))
(h1 (length r1)) ;Height
(h2 (length r2))
(w1 (length (car r1))) ;Width
(w2 (length (car r2)))
)
(if (< x1 x2)
(list (+ x1 w1) (+ y1 (/ h1 2)) (1- x2) (+ y2 (/ h2 2)))
(list (1- x1) (+ y1 (/ h1 2)) (+ x2 w2) (+ y2 (/ h2 2))))
))
(defun cogre-choose-vertical-link-anchors (node1 node2)
"Choose vertical link anchor points between NODE1 and NODE2.
The data returned is (X1 Y1 X2 Y2)."
(let* ((p1 (oref node1 position)) ;position vector
(p2 (oref node2 position))
(x1 (aref p1 0)) ;X,Y for START
(y1 (aref p1 1))
(x2 (aref p2 0)) ;X,Y for END
(y2 (aref p2 1))
(r1 (cogre-node-rectangle node1)) ;rectangle text
(r2 (cogre-node-rectangle node2))
(h1 (length r1)) ;Height
(h2 (length r2))
(w1 (length (car r1))) ;Width
(w2 (length (car r2)))
)
(if (< y1 y2)
(list (+ x1 (/ w1 2)) (+ y1 h1) (+ x2 (/ w2 2)) (1- y2))
(list (+ x1 (/ w1 2)) (1- y1) (+ x2 (/ w2 2)) (+ y2 h2)))
))
;;; Links
;;
(defmethod cogre-element-pre-serialize ((link cogre-link))
"Prepare the current node to be serialized.
Remove all pointers to objects (such as links), and replace
with something reversable."
(call-next-method)
;; Remove the node objects from ourselves, and remove ourselves
;; from the nodes we point to.
(with-slots (start end) link
(setf start (oref start :object-name))
(setf end (oref end :object-name))
)
)
(defmethod cogre-element-post-serialize ((link cogre-link))
"Restore object pointers in LINK after being loaded from disk.
Also called after a graph was saved to restore all objects.
Reverses `cogre-graph-pre-serialize'."
(call-next-method)
;; Convert the textual names back to object references from the
;; current graphs element list.
(with-slots (start end) link
(setf start
(object-assoc start :object-name (oref cogre-graph elements)))
(setf end
(object-assoc end :object-name (oref cogre-graph elements)))
)
)
(defvar cogre-erase-mode nil
"Non nil means we are in erase mode while rendering this link.")
(defmethod cogre-erase ((link cogre-link))
"Erase LINK from the screen."
(let ((picture-rectangle-ctl ? )
(picture-rectangle-ctr ? )
(picture-rectangle-cbl ? )
(picture-rectangle-cbr ? )
(picture-rectangle-v ? )
(picture-rectangle-h ? ))
;; Links use picture line drawing teqnique to wander about.
;; By setting the picture line characters to spaces, we can
;; erase the line with the render command.
(let ((cogre-erase-mode t))
(cogre-render link))
(call-next-method)))
(defmethod cogre-render ((link cogre-link))
"Render LINK in the current graph."
(with-slots (start end start-glyph end-glyph) link
(let* ((hd (cogre-node-horizontal-distance start end))
(vd (cogre-node-vertical-distance start end))
linkcoords
dir
)
;; Calculate starting points in relation to our attached nodes.
(if (> (* hd (oref link horizontal-preference-ratio)) vd)
;; In this case, the X delta is larger than the Y delta,
;; so the line is going mostly left/right.
(setq linkcoords (cogre-choose-horizontal-link-anchors start end)
dir 'horizontal)
(setq linkcoords (cogre-choose-vertical-link-anchors start end)
dir 'vertical))
(oset link stop-position (list (car linkcoords) (car (cdr linkcoords))))
;; Now draw a rectiliniar line
(apply 'picture-draw-rectilinear-line
(append linkcoords (list dir 'face nil 'element link)))
;; Handle start/end glyps.
(if (and (not start-glyph) (not end-glyph))
;; We need to do nothing if we have no glyphs.
nil
(let* (startrect endrect x1 y1 x2 y2)
;; Calculate the modificates needed to the end points for
;; creating the textual glyph.
(setq x1 (nth 0 linkcoords)
y1 (nth 1 linkcoords)
x2 (nth 2 linkcoords)
y2 (nth 3 linkcoords))
(if (eq dir 'horizontal)
(progn
(if (< x1 x2)
(setq startrect (aref start-glyph 2)
endrect (aref end-glyph 3)
x2 (- x2 -1 (length (car endrect))))
(setq startrect (aref start-glyph 3)
endrect (aref end-glyph 2)
x1 (- x1 -1 (length (car startrect)))))
(setq y1 (- y1 (/ (length startrect) 2))
y2 (- y2 (/ (length endrect) 2))))
(if (< y1 y2)
(setq startrect (aref start-glyph 0)
endrect (aref end-glyph 1)
y2 (- y2 -1 (length endrect)))
(setq startrect (aref start-glyph 1)
endrect (aref end-glyph 0)
y1 (- y1 -1 (length startrect))))
(setq x1 (- x1 (/ (length (car startrect)) 2))
x2 (- x2 (/ (length (car endrect)) 2))))
;; Ok, splat the glyph
(if cogre-erase-mode
(progn
(cogre-erase-rectangle x1 y1
(length (car startrect))
(length startrect))
(cogre-erase-rectangle x2 y2
(length (car endrect))
(length endrect))
)
(picture-goto-coordinate x1 y1)
(picture-insert-rectangle startrect nil)
(picture-goto-coordinate x2 y2)
(picture-insert-rectangle endrect nil)
)
))))
(call-next-method))
;;; Files
;;
;; Save and restore graphs to disk
(defun cogre-save-graph-as (file)
"Save the current graph into FILE.
This can change the current file assocaited with the current graph."
(interactive "fFile: ")
(oset cogre-graph file file)
(cogre-save cogre-graph))
(defun cogre-save-graph (file)
"Save the current graph to FILE."
(interactive (list
(eieio-persistent-save-interactive cogre-graph
"Save In: "
(oref cogre-graph name))))
(cogre-save cogre-graph))
(defmethod cogre-save ((graph cogre-graph))
"Save the current graph."
(cogre-map-elements 'cogre-element-pre-serialize)
(unwind-protect
(eieio-persistent-save cogre-graph)
(cogre-map-elements 'cogre-element-post-serialize))
)
;;;###autoload
(defun cogre-load-graph (file)
"Load a graph from FILE into a new graph buffer."
(interactive "fFile: ")
(let ((graph nil)
(cogre-loading-from-file t))
(setq graph (eieio-persistent-read file))
(oset graph file file)
(cogre (oref graph name))
(setq cogre-graph graph)
(cogre-map-elements 'cogre-element-post-serialize)
(cogre-render-buffer graph t)))
;;; Low Level Rendering and status
;;
(defun cogre-string-with-face (string face element &optional length align)
"Using text STRING, apply FACE to that text.
The string in question belongs to the graph ELEMENT.
If optional argument LENGTH is supplied, pad STRING on the left and
right so that it is centered. If optional argument ALIGN is non-nil,
the align the string either 'left or 'right.
Return the new string."
(if length
(let* ((preprops (copy-sequence (text-properties-at 0 string)))
(ws (- length (length string)))
(sws (cond ((not align)
(make-string (/ ws 2) ? ))
((eq align 'right)
(make-string (1- ws) ? ))
((eq align 'left)
" ")
(t "")
))
(ews (cond ((not align)
(make-string (+ (/ ws 2) (% ws 2)) ? ))
((eq align 'left)
(make-string (1- ws) ? ))
((eq align 'right)
" ")
(t "")
))
)
(let ((pm (plist-get preprops 'face)))
(when pm
;; We don't want to modify the face on this based
;; on the first character.
(setq preprops (delq 'face preprops))
(setq preprops (delq pm preprops))))
(setq string (concat sws string ews))
(add-text-properties 0 (length string) preprops string)
))
;; Add our faces on. Preserve previously applied faces.
(when face
(alter-text-property 0 (length string) 'face
(lambda (current-face)
(let ((cf
(cond ((facep current-face)
(list current-face))
((listp current-face)
current-face)
(t nil)))
(nf
(cond ((facep face)
(list face))
((listp face)
face)
(t nil))))
(append cf nf)))
string))
;; Add on other properties.
(add-text-properties 0 (length string)
(list 'rear-nonsticky t
'detachable t ;; xemacs
'element element
;; 'local-map
;; 'modification-hooks
'point-entered
(lambda (s e)
(let ((inhibit-point-motion-hooks t))
(when (cogre-current-element)
(cogre-entered (cogre-current-element) s e))))
'point-left
(lambda (s e)
(let* ((inhibit-point-motion-hooks t)
(el
(save-excursion
(goto-char s)
(cogre-current-element))))
(when el (cogre-left el s e)))))
string)
string)
(defun cogre-erase-rectangle (x y width height)
"Clear out the rectangle at X Y, with dimensions WIDTH HEIGHT."
(picture-goto-coordinate x y)
(clear-rectangle (point)
(save-excursion
(picture-goto-coordinate (+ x width)
(+ y height))
(point))
t))
(defun cogre-current-element (&optional point)
"Return the element under POINT."
(get-text-property (or point (point)) 'element))
(defun cogre-current-line ()
"Get the current line."
(cond ((eq (point-min) (point))
0)
(t (1- (count-lines (point-min) (point))))))
(provide 'cogre)
;;; cogre.el ends here
1.1 XEmacs/packages/xemacs-packages/cogre/cogre.texi
Index: cogre.texi
===================================================================
\input texinfo @c -*-texinfo-*-
@c
@c $Id: cogre.texi,v 1.1 2007/11/26 15:04:24 michaels Exp $
@c
@setfilename cogre.info
@settitle COGRE: COnnected GRaph Editor
@ifinfo
@format
START-INFO-DIR-ENTRY
* cogre: (cogre). Graphs & UML for Emacs
END-INFO-DIR-ENTRY
@end format
@end ifinfo
@titlepage
@sp 10
@center @titlefont{cogre}
@vskip 0pt plus 1 fill
Copyright @copyright{} 2001 Eric M. Ludlam
@end titlepage
@node Top, , , (dir)Top
@comment node-name, next, previous, up
COGRE is a package that enables Emacs to display UML diagrams in a
text buffer. Any kind of graph can be supported through object
inheritance via EIEIO @xref{(eieio)Top}.
Warning: Very little in this manual has been written.
@menu
* Getting Started:: Graphs, Nodes, and Links
* Class Diagrams:: Creating Class diagrams
* Semantic Support:: Emacs can make diagrams for you
* Index::
@end menu
@node Getting Started, Class Diagrams, Top, Top
@comment node-name, next, previous, up
@chapter Getting Started
There are three basic parts to any COGRE interface.
@enumerate
@item Graph
The graph consists of a buffer, and all child elements in that graph.
The graph is treated as any other Emacs buffer. When that buffer is
selected, Graph editing commands are available.
@item Node
A Node consists of a square region of screen space, and usually a
name. Nodes can be anything, but common examples are Classes,
Packages, or other ``object like'' things.
@item Link
A Link is a line that connects two nodes. A link may not exist
without a node at both ends. When a node is deleted, all links
connected to it in some way are also deleted.
@end enumerate
@menu
* Creating Nodes and Links ::
* Moving Nodes ::
* Customizing Nodes ::
@end menu
@node Creating Nodes and Links, Moving Nodes, Getting Started, Getting Started
@comment node-name, next, previous, up
@node Moving Nodes, Customizing Nodes, Creating Nodes and Links, Getting Started
@comment node-name, next, previous, up
@node Customizing Nodes, , Moving Nodes, Getting Started
@comment node-name, next, previous, up
@node Class Diagrams, Semantic Support, Getting Started, Top
@comment node-name, next, previous, up
@chapter Class Diagrams
Add text here
@node Semantic Support, Index ,Class Diagrams, Top
@comment node-name, next, previous, up
@chapter Semantic Support
Add text here
@node Index, , Semantic Support, Top
@comment node-name, next, previous, up
@contents
@bye
1.1 XEmacs/packages/xemacs-packages/cogre/custom-load.el
Index: custom-load.el
===================================================================
;;; custom-load.el --- automatically extracted custom dependencies
;;; Code:
;old-cus-dep-hash: #s(hash-table test equal size 12 data ("/afs/informatik.uni-tuebingen.de/home/sperber/build/xemacs-package-source/xemacs-packages/cogre/auto-autoloads.el" nil "/afs/informatik.uni-tuebingen.de/home/sperber/build/xemacs-package-source/xemacs-packages/cogre/picture-hack.el" nil "/afs/informatik.uni-tuebingen.de/home/sperber/build/xemacs-package-source/xemacs-packages/cogre/_pkg.el" nil "/afs/informatik.uni-tuebingen.de/home/sperber/build/xemacs-package-source/xemacs-packages/cogre/cogre-load.el" nil "/afs/informatik.uni-tuebingen.de/home/sperber/build/xemacs-package-source/xemacs-packages/cogre/cogre-mode.el" ((cogre-box-last-face . "cogre-mode") (cogre-box-first-face . "cogre-mode") (cogre-box-face . "cogre-mode")) "/afs/informatik.uni-tuebingen.de/home/sperber/build/xemacs-package-source/xemacs-packages/cogre/cogre-uml.el" nil "/afs/informatik.uni-tuebingen.de/home/sperber/build/xemacs-package-source/xemacs-packages/cogre/wisent-dot.el" nil "/afs/informati!
k.uni-tuebingen.de/home/sperber/build/xemacs-package-source/xemacs-packages/cogre/cogre-loaddefs.el" nil "/afs/informatik.uni-tuebingen.de/home/sperber/build/xemacs-package-source/xemacs-packages/cogre/wisent-dot-wy.el" nil "/afs/informatik.uni-tuebingen.de/home/sperber/build/xemacs-package-source/xemacs-packages/cogre/custom-load.el" nil "/afs/informatik.uni-tuebingen.de/home/sperber/build/xemacs-package-source/xemacs-packages/cogre/cogre.el" ((cogre-mode-hooks . "cogre") (cogre-vertical-margins . "cogre") (cogre-horizontal-margins . "cogre") (cogre . "cogre")) "/afs/informatik.uni-tuebingen.de/home/sperber/build/xemacs-package-source/xemacs-packages/cogre/uml-create.el" ((cogre-uml-source-display-window-size . "uml-create") (cogre-uml-browse-token-hook . "uml-create") (cogre-uml-source-display-method . "uml-create") (cogre-token->uml-function . "uml-create"))))
(autoload 'custom-add-loads "cus-load")
;;; custom-load.el ends here
1.1 XEmacs/packages/xemacs-packages/cogre/package-info.in
Index: package-info.in
===================================================================
(cedet-common
(standards-version 1.1
version VERSION
author-version AUTHOR_VERSION
date DATE
build-date BUILD_DATE
maintainer MAINTAINER
distribution xemacs
priority low
category CATEGORY
dump nil
description "Graph editing mode."
filename FILENAME
md5sum MD5SUM
size SIZE
provides (cogre-mode cogre-uml cogre picture-hack uml-create wisent-dot-wy wisent-dot)
requires (REQUIRES)
type regular
))
1.1 XEmacs/packages/xemacs-packages/cogre/picture-hack.el
Index: picture-hack.el
===================================================================
;;; picture-hack.el --- Updates to picture mode
;;; Copyright (C) 2001 Eric M. Ludlam
;; Author: Eric M. Ludlam <zappo at gnu.org>
;; Keywords: picture
;; X-RCS: $Id: picture-hack.el,v 1.1 2007/11/26 15:04:25 michaels Exp $
;; Semantic 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:
;;
;; Picture-hack is a series of modifications to functions in picture.el
;; and rect.el.
;; It also contains new functions which should live in picture.el
;;
;; These are hacks needed by COGRE. Long term, I would like to see
;; these features merged back into picture mode.
(require 'picture)
(require 'rect)
;;; Code:
;;; XEmacs is missing some stuff
;;
(unless (fboundp 'picture-current-line)
;; copied from Emacs 20.6:
(defun picture-current-line ()
"Return the vertical position of point. Top line is 1."
(+ (count-lines (point-min) (point))
(if (= (current-column) 0) 1 0))))
(unless (fboundp 'picture-update-desired-column)
;; copied from Emacs 20.6:
;; If the value of picture-desired-column is far from the current
;; column, or if the arg ADJUST-TO-CURRENT is non-nil, set it to the
;; current column. Return the current column.
(defun picture-update-desired-column (adjust-to-current)
(let ((current-column (current-column)))
(if (or adjust-to-current
(< picture-desired-column (1- current-column))
(> picture-desired-column (1+ current-column)))
(setq picture-desired-column current-column))
current-column)))
(unless (fboundp 'char-width)
(defun char-width (CH)
"XEmacs doesn't have this, always return 1."
1))
(unless (boundp 'picture-rectangle-v)
(defcustom picture-rectangle-v ?|
"*Character `picture-draw-rectangle' uses for vertical lines."
:type 'character
:group 'picture))
(unless (boundp 'picture-rectangle-h)
(defcustom picture-rectangle-h ?-
"*Character `picture-draw-rectangle' uses for horizontal lines."
:type 'character
:group 'picture))
;;; Changes to exsiting functions
;;
(defun picture-insert-rectangle (rectangle &optional insertp)
"Overlay RECTANGLE with upper left corner at point.
Optional argument INSERTP, if non-nil causes RECTANGLE to be inserted.
Leaves the region surrounding the rectangle."
(let ((indent-tabs-mode nil))
(if (not insertp)
(save-excursion
(delete-rectangle (point)
(progn
(picture-forward-column
(length (car rectangle)))
(picture-move-down (1- (length rectangle)))
(point)))))
;; This line is different from the one in Emacs 21, and enables
;; the mark to only be pushed if it is interactivly called.
(if (interactive-p) (push-mark))
(insert-rectangle rectangle)))
(if (condition-case nil
(and (clear-rectangle 0 0 t)
nil)
(error t))
;; In emacs 20, FILL is not an argument to clear rectangle as it is
;; in emacs 21. Add it here. Fortunatly, `operate-on-rectangle' does
;; take a fill argument.
(defun clear-rectangle (start end &optional fill)
"Blank out rectangle with corners at point and mark.
The text previously in the region is overwritten by the blanks.
When called from a program, requires two args which specify the corners."
(interactive "r")
(operate-on-rectangle 'clear-rectangle-line start end t))
)
;; This is a modified version which takes text properties
(defun picture-insert (ch arg &rest textproperties)
"Insert character CH, and move in the current picture motion direction.
Repeat ARG times.
Apply TEXTPROPERTIES to the character inserted."
(let* ((width (char-width ch))
;; We must be sure that the succeeding insertion won't delete
;; the just inserted character.
(picture-horizontal-step
(if (and (= picture-vertical-step 0)
(> width 1)
(< (abs picture-horizontal-step) 2))
(* picture-horizontal-step 2)
picture-horizontal-step)))
(while (> arg 0)
(setq arg (1- arg))
;; The following is in Emacs 21, but it hoses over earlier Emacsen
;; which do not have `picture-desired-column'
;;
;; (if (/= picture-desired-column (current-column))
;; (move-to-column picture-desired-column t))
(let ((col (+ (current-column) width)))
(or (eolp)
(let ((pos (point)))
(move-to-column col t)
(delete-region pos (point)))))
(insert ch)
(forward-char -1)
(if textproperties
(add-text-properties (point) (1+ (point))
(append
;; These two are special defaults
;; useful for pictures.
'(rear-nonsticky t detachable t)
textproperties))
)
(picture-move))))
;;; New functions
;;
(defun picture-goto-coordinate (x y)
"Goto coordinate X, Y."
(goto-char (point-min))
(picture-newline y)
(move-to-column x t)
)
(defun picture-set-motion (vert horiz)
"Set VERTICAL and HORIZONTAL increments for movement in Picture mode.
The mode line is updated to reflect the current direction."
(setq picture-vertical-step vert
picture-horizontal-step horiz)
(if (eq major-mode 'picture-mode)
(progn
(setq mode-name
(format "Picture:%s"
(nth (+ 2 (% horiz 3) (* 5 (1+ (% vert 2))))
'(wnw nw up ne ene Left left none right Right
wsw sw down se ese))))
(force-mode-line-update)
(message ""))))
(defun picture-draw-rectilinear-line (x1 y1 x2 y2 &optional direction
&rest textproperties)
"Draw a line from X1, Y1 to X2, Y2.
If optional argument DIRECTION is specified as 'verticle, or 'horizontal,
then the line is drawn with the major direction in that orientation.
If DIRECTION is not specified, the greatest distance between X or Y
coordinates is used to choose.
Arguments TEXTPROPERTIES are applied to the characters inserted.
The line is drawn in a rectilinear fashion."
;; A rectilinear line for us (short term) is a line travelling
;; in the direction of greatest distance, with a jog in the middle.
(let (xdir ydir halfway htwiddle
)
;; Travelling
(if (> x1 x2)
(setq xdir -1)
(setq xdir 1))
(if (> y1 y2)
(setq ydir -1)
(setq ydir 1))
;; Get there
(picture-goto-coordinate x1 y1)
(picture-update-desired-column t)
;; Determine primary direction
(if (or (and direction (eq direction 'horizontal))
(and (not direction) (> (abs (- x1 x2)) (abs (- y1 y2)))))
;; This means that X is primary direction
(progn
(setq halfway (/ (abs (- x1 x2)) 2)
htwiddle (% (abs (- x1 x2)) 2))
(picture-set-motion 0 xdir)
(apply 'picture-insert picture-rectangle-h (+ halfway htwiddle)
textproperties)
(if (/= y1 y2)
(progn
(picture-set-motion ydir 0)
(apply 'picture-insert picture-rectangle-ctl 1
textproperties)
(apply 'picture-insert picture-rectangle-v (1- (abs (- y1 y2)))
textproperties)
(picture-set-motion 0 xdir)
(apply 'picture-insert picture-rectangle-ctl 1
textproperties)
;;(setq halfway (1- halfway))
)
(apply 'picture-insert picture-rectangle-h 1
textproperties)
)
(apply 'picture-insert picture-rectangle-h halfway
textproperties)
)
;; This means that Y is the primary direction
(setq halfway (/ (abs (- y1 y2)) 2)
htwiddle (% (abs (- y1 y2)) 2))
(picture-set-motion ydir 0)
(apply 'picture-insert picture-rectangle-v (+ halfway htwiddle)
textproperties)
(if (/= x1 x2)
(progn
(picture-set-motion 0 xdir)
(apply 'picture-insert picture-rectangle-ctl 1
textproperties)
(apply 'picture-insert picture-rectangle-h (1- (abs (- x1 x2)))
textproperties)
(picture-set-motion ydir 0)
(apply 'picture-insert picture-rectangle-ctl 1
textproperties)
;(setq halfway (1- halfway))
)
(apply 'picture-insert picture-rectangle-v 1
textproperties)
)
(apply 'picture-insert picture-rectangle-v halfway
textproperties)
)
))
(provide 'picture-hack)
;;; picture-hack.el ends here
1.1 XEmacs/packages/xemacs-packages/cogre/uml-create.el
Index: uml-create.el
===================================================================
;;; cogre-uml.el --- UML support for COGRE
;;; Copyright (C) 2001, 2002, 2003, 2004, 2007 Eric M. Ludlam
;; Author: Eric M. Ludlam <zappo at gnu.org>
;; Keywords: oop, uml
;; X-RCS: $Id: uml-create.el,v 1.1 2007/11/26 15:04:26 michaels Exp $
;; This file is not part of GNU Emacs.
;; This 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:
;;
;; Routines used to create UML diagrams from Semantic generated reverse
;; engineered token databases.
(require 'cogre-uml)
(require 'semantic)
(require 'semanticdb)
(require 'semanticdb-find)
;;; Code:
(defclass cogre-semantic-uml-graph (cogre-graph)
nil
"This graph is for semantic oriented UML diagrams.")
(defmethod cogre-insert-class-list ((graph cogre-semantic-uml-graph))
"Return a list of classes GRAPH will accept."
(append (eieio-build-class-alist 'cogre-link)
(eieio-build-class-alist 'cogre-semantic-class)
(eieio-build-class-alist 'cogre-package)))
(defclass cogre-semantic-class (cogre-class)
nil
"A Class node linked to semantic parsed buffers.
Inherits from the default UML class node type, and adds user
interfacing which links working with this node directly to source
code.")
(defmethod cogre-save ((graph cogre-semantic-uml-graph))
"Save the current GRAPH."
;; Autogenerated graphcs have semantic tags in them which are often
;; linked via overlay into a buffer. We need to write something
;; special to unlink (clone?) those tags so they are saveable.
;;(error "You cannot save autogenerated graphs")
;; Doing this allows the graph to be saved. Some bugs in saving
;; these graphs have been made. Try it out for a while.
(call-next-method)
)
(defmethod initialize-instance ((this cogre-semantic-class) &optional fields)
"When interactively creating a class node THIS, query for the class name.
Optional argument FIELDS are not used."
(call-next-method)
(if (string-match "^Class[0-9]*" (oref this object-name))
;; In this case, we have a default class object-name, so try and query
;; for the real class (from sources) which we want to use.
(let* ((class (or (oref this class) (cogre-read-class-name)))
(tag (if (semantic-tag-p class)
class
(car
(semanticdb-strip-find-results
(semanticdb-brute-deep-find-tags-by-name class)
t))))
)
(when tag
;; We need to clone the tag to unlink our storage from any
;; buffer it may be associated with.
(setq tag (semantic-tag-copy tag nil t)))
(if (semantic-tag-p class) (setq class (semantic-tag-name class)))
(if (and tag (eq (semantic-tag-class tag) 'type)
(or (string= (semantic-tag-type tag) "class")
(string= (semantic-tag-type tag) "struct")))
(let ((slots (semantic-tag-type-members tag))
(extmeth (semantic-tag-external-member-children tag t))
attrib method)
;; Bin them up
(while slots
(cond
;; A plain string, a simple language, just do attributes.
((stringp (car slots))
(setq attrib (cons (list (car slots) 'variable nil)
attrib))
)
;; Variable decl is an attribute
((eq (semantic-tag-class (car slots)) 'variable)
(setq attrib (cons (car slots) attrib)))
;; A function decle is a method.
((eq (semantic-tag-class (car slots)) 'function)
(setq method (cons (car slots) method)))
)
(setq slots (cdr slots)))
;; Add in all those extra methods
(while extmeth
(let ((sl (cdr (car extmeth))))
(while sl
(if (eq (semantic-tag-class (car sl)) 'function)
(setq method (cons (car sl) method)))
(setq sl (cdr sl))))
(setq extmeth (cdr extmeth)))
;; Put them into the class.
(oset this object-name class)
(oset this class tag)
(oset this attributes (nreverse attrib))
(oset this methods (nreverse method))
;; Tada!
)
;; We couldn't find a semantic tag for this class, so just
;; put the name in there.
(cond ((stringp class)
(oset this object-name class))
((and (listp class)
(stringp (car class)))
(oset this object-name (car class)))
(t nil))
(oset this class nil)
(oset this attributes nil)
(oset this methods nil)
)))
this)
;; Saving such graphs is not good! We can't reliably restore the overlays
;; since we should switch to the originating buffer for every one! Yuck!
;; (defmethod cogre-element-pre-serialize ((node cogre-semantic-class))
;; "Prepare the current NODE to be serialized.
;; Deoverlay all semantic tokens referenced."
;; (call-next-method)
;; (semantic-deoverlay-list (oref node class))
;; (semantic-deoverlay-list (oref node attributes))
;; (semantic-deoverlay-list (oref node methods))
;; )
;; (defmethod cogre-element-post-serialize ((node cogre-semantic-class))
;; "Restore overlays in NODE after being loaded from disk.
;; Also called after a graph was saved to restore all objects.
;; Reverses `cogre-graph-pre-serialize'."
;; (call-next-method)
;; (semantic-overlay-list (oref node class))
;; (semantic-overlay-list (oref node attributes))
;; (semantic-overlay-list (oref node methods))
;; )
(defcustom cogre-token->uml-function 'semantic-uml-abbreviate-nonterminal
"Function to use to create strings for tokens in CLASS nodes."
:group 'cogre
:type semantic-format-tag-functions)
(defmethod cogre-uml-stoken->uml ((class cogre-semantic-class) stoken &optional text)
"For CLASS convert a Semantic token STOKEN into a uml definition.
Optional TEXT property is passed down."
;; We need to disable images because our diagram is still
;; pretty unstable.
(let ((semantic-format-use-images-flag nil))
(call-next-method class stoken
(save-excursion
(let ((tb (or (semantic-tag-buffer stoken)
(semantic-tag-buffer (oref class class)))))
(if tb (set-buffer tb))
(funcall cogre-token->uml-function
stoken
(oref class class)
t))))
))
(defmethod cogre-entered ((class cogre-semantic-class) start end)
"Method called when the cursor enters CLASS.
START and END cover the region with the property."
(cogre-uml-source-display class (point))
(call-next-method))
(defmethod cogre-left ((class cogre-semantic-class) start end)
"Method called when the cursor exits CLASS.
START and END cover the region with the property."
(call-next-method))
;;; Screen Manager
;;
;; Manage the display of the source buffer somewhere near the class diagram
;; in a nice way.
(defcustom cogre-uml-source-display-method
'cogre-uml-source-display-bottom
"A Function called to display a source buffer associated with a Graph.
This function can be anything, or nil, though the following options
are preferred:
`cogre-uml-source-display-bottom' - in a window on the bottom of the frame.
`cogre-uml-source-display-top' - in a window on the top of the frame.
The function specified must take a `point-marker' to specify the
location that is to be displayed."
:group 'cogre
:type '(choice (const 'cogre-uml-source-display-bottom)
(const 'cogre-uml-source-display-top)
))
(defcustom cogre-uml-browse-token-hook nil
"*Hooks run when a token is browsed by the COGRE graph.
Each hook takes one argument, and one optional argument, the token
being browsed too, and a containing parent token, if available.
This is run when the token is first found, not during the actual
browse. The token will be under point when this hook is called.
Changing window configurations is not recommended."
:group 'cogre
:type 'function
)
(defun cogre-uml-browse-token-highlight-hook-fn (tok &optional parent)
"Momentarilly highlight TOK. Ignore PARENT.
Function useable by `cogre-uml-browse-token-hook'."
(semantic-momentary-highlight-tag tok))
(defmethod cogre-uml-source-marker ((class cogre-semantic-class) token)
"Return a marker position for a CLASS containing TOKEN.
This returned marker will be in the source file of the attribute,
method, or class definition. nil if there is not match."
(let ((semc (oref class class))
(p nil))
(cond ((and token (semantic-tag-with-position-p token))
(setq p (save-excursion
(semantic-go-to-tag token)
(run-hook-with-args
'cogre-uml-browse-token-hook
token)
(point-marker))
))
((and token (semantic-tag-with-position-p semc))
(setq p (save-excursion
(semantic-go-to-tag token semc)
(run-hook-with-args
'cogre-uml-browse-token-hook
token semc)
(point-marker))
))
((and semc (semantic-tag-with-position-p semc))
(setq p (save-excursion
(semantic-go-to-tag semc)
(run-hook-with-args
'cogre-uml-browse-token-hook
semc)
(point-marker))
))
(t nil))
p))
(defmethod cogre-uml-source-display ((class cogre-semantic-class) point)
"Display source code associated with CLASS based on text at POINT.
The text must be handled by an overlay of some sort which has the
semantic token we need as a property. If not, then nothing happens.
Uses `cogre-uml-source-display-method'."
(let* ((sem (get-text-property point 'semantic))
(p (cogre-uml-source-marker class sem)))
(when p
(save-excursion
(funcall cogre-uml-source-display-method p))
))
)
(defmethod cogre-activate ((class cogre-semantic-class))
"Activate CLASS.
This could be as simple as displaying the current state,
customizing the object, or performing some complex task."
(let* ((sem (get-text-property (point) 'semantic))
(p (cogre-uml-source-marker class sem))
(cp (point-marker)))
(if (not p)
(error "No source to jump to")
;; Activating is the reverse of just showing the sorce
(switch-to-buffer (marker-buffer p))
(funcall cogre-uml-source-display-method cp)
))
)
(defcustom cogre-uml-source-display-window-size 5
"Size of same-frame window displaying source code."
:group 'cogre
:type 'integer)
(defun cogre-uml-source-display-bottom (m)
"Display point M in a small buffer on the bottom of the current frame."
(if (not (eq (next-window) (selected-window)))
(cogre-uml-source-display-other-window m)
(split-window-vertically (- (window-height)
cogre-uml-source-display-window-size
1))
(other-window 1)
(switch-to-buffer (marker-buffer m) t)
(recenter 1)
(goto-char m)
(other-window -1))
)
(defun cogre-uml-source-display-other-window (m)
"Display point M in other window."
(other-window 1)
(switch-to-buffer (marker-buffer m) t)
(goto-char m)
(recenter 1)
(other-window -1)
)
;;; Auto-Graph generation
;;
;; Functions for creating a graph from semantic parts.
(defvar cogre-class-history nil
"History for inputting class names.")
(defun cogre-read-class-name ()
"Read in a class name to be used by a cogre node."
(let ((finddefaultlist (semantic-find-tag-by-overlay))
class prompt stream
)
;; Assume the top most item is the all encompassing class.
(if finddefaultlist
(setq class (car finddefaultlist)))
;; Make sure our class is really a class
(if (not (and
class
(eq (semantic-tag-class class) 'type)
(string= (semantic-tag-type class) "class")))
(setq class nil)
(setq class (semantic-tag-name class)))
;; Create a prompt
(setq prompt (if class (concat "Class (default " class "): ") "Class: "))
;; Get the stream used for completion.
(let ((types (semanticdb-strip-find-results
(semanticdb-brute-find-tags-by-class 'type)
;; Don't find-file-match. Just need names.
)))
(setq stream (semantic-find-tags-by-type "class" types)))
;; Do the query
(completing-read prompt stream
nil nil nil 'cogre-class-history
class)
))
;;;###autoload
(defun cogre-uml-quick-class (class)
"Create a new UML diagram based on CLASS showing only immediate lineage.
The parent to CLASS, CLASS, and all of CLASSes children will be shown."
(interactive (list (cogre-read-class-name)))
(let* ((class-tok (car (semanticdb-strip-find-results
(semanticdb-brute-deep-find-tags-by-name class) t)))
(class-node nil)
(parent (semantic-tag-type-superclasses class-tok))
(parent-nodes nil)
(children (semanticdb-find-nonterminal-by-function
(lambda (stream sp si)
(semantic-brute-find-tag-by-function
(lambda (tok)
(and (eq (semantic-tag-class tok) 'type)
(or (member class
(semantic-tag-type-superclasses tok))
(member class
(semantic-tag-type-interfaces tok)))))
stream sp si))
nil nil nil t t))
(children-nodes nil)
(ymax 0)
(xmax 0)
(x-accum 0)
(y-accum 0))
;; Create a new graph
(cogre class 'cogre-semantic-uml-graph)
(goto-char (point-min))
;; Create all the parent nodes in the graph, and align them.
(while parent
(setq parent-nodes
(cons (make-instance cogre-semantic-class
:position (vector x-accum y-accum)
:class (car parent))
parent-nodes))
(cogre-node-rebuild (car parent-nodes))
(setq x-accum (+ x-accum
(length (car (oref (car parent-nodes) rectangle)))
cogre-horizontal-margins))
(setq ymax (max ymax (length (oref (car parent-nodes) rectangle))))
(setq parent (cdr parent)))
(setq xmax (- x-accum cogre-horizontal-margins))
;; Create this class
(setq x-accum 0)
(setq y-accum (+ y-accum ymax cogre-vertical-margins))
(setq class-node
(make-instance 'cogre-semantic-class
:position (vector x-accum y-accum)
:class class-tok))
(cogre-node-rebuild class-node)
(setq ymax (length (oref class-node rectangle)))
;; Creawte all the children nodes, and align them.
(setq x-accum 0)
(setq y-accum (+ y-accum ymax cogre-vertical-margins))
(while children
(let ((c (cdr (car children))))
(while c
(setq children-nodes
(cons (make-instance 'cogre-semantic-class
:position (vector x-accum y-accum)
:class (car c))
children-nodes))
(cogre-node-rebuild (car children-nodes))
(setq x-accum (+ x-accum
(length (car (oref (car children-nodes) rectangle)))
cogre-horizontal-margins))
(setq c (cdr c))))
(setq children (cdr children)))
(setq xmax (max xmax (- x-accum cogre-horizontal-margins)))
;; Center all the nodes to eachother.
(let ((shift 0)
(delta 0)
(lines (list parent-nodes
(list class-node)
children-nodes))
(maxn nil)
)
(while lines
(setq maxn (car (car lines)))
(when maxn
;;(cogre-node-rebuild maxn)
(setq delta (- xmax (aref (oref maxn position) 0)
(length (car (oref maxn rectangle)))))
(when (> delta 0)
(setq shift (/ delta 2))
(mapcar (lambda (n) (cogre-move-delta n shift 0))
(car lines))))
(setq lines (cdr lines)))
)
;; Link everyone together
(let ((n parent-nodes))
(while n
(make-instance 'cogre-inherit :start class-node :end (car n))
(setq n (cdr n)))
(setq n children-nodes)
(while n
(make-instance 'cogre-inherit :start (car n) :end class-node)
(setq n (cdr n))))
;; Refresh the graph
(cogre-refresh)
))
;;;###autoload
(defun cogre-uml-create (class)
"Create a new UML diagram, with CLASS as the root node.
CLASS must be a type in the current project."
(interactive (list (cogre-read-class-name)))
(let ((root (semanticdb-strip-find-results
(semanticdb-find-tags-by-name class) t))
)
;; Implement this some day.
))
(provide 'uml-create)
;;; uml-create.el ends here
1.1 XEmacs/packages/xemacs-packages/cogre/wisent-dot-wy.el
Index: wisent-dot-wy.el
===================================================================
;;; wisent-dot-wy.el --- Generated parser support file
;; Copyright (C) 2003, 2004 Eric M. Ludlam
;; Author: Eric M. Ludlam <zappo at projectile.siege-engine.com>
;; Created: 2007-06-05 21:48:08-0400
;; Keywords: syntax
;; X-RCS: $Id: wisent-dot-wy.el,v 1.1 2007/11/26 15:04:26 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:
;;
;; PLEASE DO NOT MANUALLY EDIT THIS FILE! It is automatically
;; generated from the grammar file wisent-dot.wy.
;;; History:
;;
;;; Code:
;;; Prologue
;;
;;; Declarations
;;
(defconst wisent-dot-wy--keyword-table
(semantic-lex-make-keyword-table
'(("digraph" . DIGRAPH)
("graph" . GRAPH)
("subgraph" . SUBGRAPH)
("node" . NODE)
("shape" . SHAPE)
("label" . LABEL)
("color" . COLOR)
("style" . STYLE)
("len" . LEN)
("fontname" . FONTNAME)
("fontsize" . FONTSIZE)
("width" . WIDTH)
("height" . HEIGHT)
("splines" . SPLINES)
("overlap" . OVERLAP))
'(("fontsize" summary "fontsize=<font-size-number>")
("fontname" summary "fontname=<font-spec>")
("len" summary "len=<value>")
("style" summary "style=<style-spec>")
("color" summary "color=<color-spec>")
("label" summary "label=\"string\"")
("shape" summary "shape=<shape-type>")
("node" summary "node [<attribute>...];")
("subgraph" summary "subgraph <name> { <graph elements> ... }")
("graph" summary "graph <name> { <graph elements> ... }")
("digraph" summary "digraph <name> { <graph elements> ... }")))
"Table of language keywords.")
(defconst wisent-dot-wy--token-table
(semantic-lex-make-type-table
'(("number"
(number))
("string"
(string))
("symbol"
(symbol))
("close-paren"
(RPAREN . ")")
(RBRACKET . "]")
(RBRACE . "}"))
("open-paren"
(LPAREN . "(")
(LBRACKET . "[")
(LBRACE . "{"))
("block"
(PAREN_BLOCK . "(LPAREN RPAREN)")
(BRACE_BLOCK . "(LBRACE RBRACE)")
(BRACKET_BLOCK . "(LBRACKET RBRACKET)"))
("punctuation"
(COMMA . ",")
(SEMI . ";")
(EQUAL . "=")
(LINK . "--")
(DILINK . "->")))
'(("number" :declared t)
("string" :declared t)
("symbol" :declared t)
("block" :declared t)
("punctuation" syntax "\\s.+")
("punctuation" :declared t)
("keyword" :declared t)))
"Table of lexical tokens.")
(defconst wisent-dot-wy--parse-table
(progn
(eval-when-compile
(require 'wisent-comp))
(wisent-compile-grammar
'((DIGRAPH GRAPH SUBGRAPH NODE SHAPE LABEL COLOR STYLE LEN FONTNAME FONTSIZE WIDTH HEIGHT SPLINES OVERLAP DILINK LINK EQUAL SEMI COMMA BRACKET_BLOCK BRACE_BLOCK PAREN_BLOCK LBRACE RBRACE LBRACKET RBRACKET LPAREN RPAREN symbol string number)
nil
(dot_file
((digraph))
((graph)))
(digraph
((DIGRAPH symbol BRACE_BLOCK)
(wisent-raw-tag
(semantic-tag $2 'digraph :members
(semantic-parse-region
(car $region3)
(cdr $region3)
'graph-contents 1)))))
(graph
((GRAPH symbol BRACE_BLOCK)
(wisent-raw-tag
(semantic-tag $2 'graph :members
(semantic-parse-region
(car $region3)
(cdr $region3)
'graph-contents 1)))))
(graph-contents
((LBRACE)
nil)
((RBRACE)
nil)
((label))
((style))
((graph-attributes))
((subgraph))
((node))
((named-node))
((links)))
(label
((LABEL EQUAL string SEMI)
(wisent-raw-tag
(semantic-tag $3 'label))))
(style
((STYLE EQUAL symbol SEMI)
(wisent-raw-tag
(semantic-tag $3 'style))))
(subgraph
((SUBGRAPH symbol BRACE_BLOCK)
(wisent-raw-tag
(semantic-tag $2 'graph :members
(semantic-parse-region
(car $region3)
(cdr $region3)
'graph-contents 1)))))
(node
((NODE BRACKET_BLOCK SEMI)
(wisent-raw-tag
(semantic-tag "NODE" 'generic-node :attributes
(semantic-parse-region
(car $region2)
(cdr $region2)
'node-description 1)))))
(graph-attributes
((GRAPH BRACKET_BLOCK SEMI)
(wisent-raw-tag
(semantic-tag "GRAPH" 'graph-attributes :attributes
(semantic-parse-region
(car $region2)
(cdr $region2)
'node-description 1)))))
(named-node
((symbol BRACKET_BLOCK SEMI)
(wisent-raw-tag
(semantic-tag $1 'node :attributes
(semantic-parse-region
(car $region2)
(cdr $region2)
'node-description 1)))))
(node-description
((LBRACKET)
nil)
((RBRACKET)
nil)
((COMMA)
nil)
((SHAPE EQUAL symbol)
(wisent-raw-tag
(semantic-tag $1 'attribute :value $3)))
((LABEL EQUAL string)
(wisent-raw-tag
(semantic-tag $1 'attribute :value $3)))
((FONTNAME EQUAL string)
(wisent-raw-tag
(semantic-tag $1 'attribute :value $3)))
((FONTSIZE EQUAL number)
(wisent-raw-tag
(semantic-tag $1 'attribute :value $3)))
((symbol EQUAL symbol)
(wisent-raw-tag
(semantic-tag $1 'attribute :value $3))))
(links
((symbol DILINK symbol opt-link-attributes opt-semi)
(wisent-raw-tag
(semantic-tag $1 'link :to $3 :attributes $4)))
((BRACE_BLOCK)))
(opt-semi
((SEMI)
nil)
(nil))
(opt-link-attributes
((BRACKET_BLOCK)
(semantic-parse-region
(car $region1)
(cdr $region1)
'node-description 1))
(nil)))
'(dot_file graph-contents node-description)))
"Parser table.")
(defun wisent-dot-wy--install-parser ()
"Setup the Semantic Parser."
(semantic-install-function-overrides
'((parse-stream . wisent-parse-stream)))
(setq semantic-parser-name "LALR"
semantic--parse-table wisent-dot-wy--parse-table
semantic-debug-parser-source "wisent-dot.wy"
semantic-flex-keywords-obarray wisent-dot-wy--keyword-table
semantic-lex-types-obarray wisent-dot-wy--token-table)
;; Collect unmatched syntax lexical tokens
(semantic-make-local-hook 'wisent-discarding-token-functions)
(add-hook 'wisent-discarding-token-functions
'wisent-collect-unmatched-syntax nil t))
;;; Analyzers
;;
(require 'semantic-lex)
(define-lex-keyword-type-analyzer wisent-dot-wy--<keyword>-keyword-analyzer
"keyword analyzer for <keyword> tokens."
"\\(\\sw\\|\\s_\\)+")
(define-lex-block-type-analyzer wisent-dot-wy--<block>-block-analyzer
"block analyzer for <block> tokens."
"\\s(\\|\\s)"
'((("[" LBRACKET BRACKET_BLOCK)
("{" LBRACE BRACE_BLOCK)
("(" LPAREN PAREN_BLOCK))
("]" RBRACKET)
("}" RBRACE)
(")" RPAREN))
)
(define-lex-regex-type-analyzer wisent-dot-wy--<symbol>-regexp-analyzer
"regexp analyzer for <symbol> tokens."
"\\(\\sw\\|\\s_\\)+"
nil
'symbol)
(define-lex-sexp-type-analyzer wisent-dot-wy--<string>-sexp-analyzer
"sexp analyzer for <string> tokens."
"\\s\""
'string)
(define-lex-regex-type-analyzer wisent-dot-wy--<number>-regexp-analyzer
"regexp analyzer for <number> tokens."
semantic-lex-number-expression
nil
'number)
(define-lex-string-type-analyzer wisent-dot-wy--<punctuation>-string-analyzer
"string analyzer for <punctuation> tokens."
"\\s.+"
'((COMMA . ",")
(SEMI . ";")
(EQUAL . "=")
(LINK . "--")
(DILINK . "->"))
'punctuation)
;;; Epilogue
;;
(define-lex wisent-dot-lexer
"Lexical analyzer that handles DOT buffers.
It ignores whitespace, newlines and comments."
semantic-lex-ignore-whitespace
semantic-lex-ignore-newline
semantic-lex-ignore-comments
wisent-dot-wy--<keyword>-keyword-analyzer
wisent-dot-wy--<symbol>-regexp-analyzer
wisent-dot-wy--<block>-block-analyzer
;; ?? semantic-lex-close-paren
wisent-dot-wy--<number>-regexp-analyzer
wisent-dot-wy--<string>-sexp-analyzer
wisent-dot-wy--<punctuation>-string-analyzer
semantic-lex-default-action
)
(provide 'wisent-dot-wy)
;;; wisent-dot-wy.el ends here
1.1 XEmacs/packages/xemacs-packages/cogre/wisent-dot.el
Index: wisent-dot.el
===================================================================
;;; wisent-dot.el --- GraphViz DOT parser
;; Copyright (C) 2003, 2004 Eric M. Ludlam
;; Author: Eric Ludlam <zappo at gnu.org>
;; Keywords: syntax
;; X-RCS: $Id: wisent-dot.el,v 1.1 2007/11/26 15:04:27 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 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:
;;
;; Parser for GraphViz DOT language.
;; The language is declaritive and the whole thing is parsed.
;; The result could be used as a data structure representing a graph.
;; This depends on graphics dot mode by
;; Pieter E.J. Pareit <pieter.pareit at planetinternet.be>
;; http://users.skynet.be/ppareit/graphviz-dot-mode.el
;; with the following patch:
;;
;;
;; *** graphviz-dot-mode.el 2003/03/23 17:14:22 1.1
;; --- graphviz-dot-mode.el 2003/03/26 03:39:21
;; ***************
;; *** 98,103 ****
;; --- 98,109 ----
;; (modify-syntax-entry ?/ ". 124b" st)
;; (modify-syntax-entry ?* ". 23" st)
;; (modify-syntax-entry ?\n "> b" st)
;; + (modify-syntax-entry ?= "." st)
;; + (modify-syntax-entry ?, "." st)
;; + (modify-syntax-entry ?\; "." st)
;; + (modify-syntax-entry ?- "." st)
;; + (modify-syntax-entry ?> "." st)
;; + (modify-syntax-entry ?< "." st)
;; st)
;; "Syntax table for `graphviz-dot-mode'.")
;;
;;; Code:
(require 'semantic-wisent)
(require 'semantic)
(require 'wisent-dot-wy)
(define-mode-overload-implementation semantic-tag-components
graphviz-dot-mode (tag)
"Return the children of tag TAG."
(cond
((memq (semantic-tag-class tag)
'(generic-node graph-attributes node link))
(semantic-tag-get-attribute tag :attributes)
)
((memq (semantic-tag-class tag)
'(digraph graph))
(semantic-tag-get-attribute tag :members)
)))
;;;###autoload
(defun wisent-dot-setup-parser ()
"Setup buffer for parse."
(wisent-dot-wy--install-parser)
(setq
;; Lexical Analysis
semantic-lex-analyzer 'wisent-dot-lexer
;; Parsing
;; Environment
semantic-imenu-summary-function 'semantic-format-tag-name
imenu-create-index-function 'semantic-create-imenu-index
semantic-command-separation-character ";"
;; Speedbar
semantic-symbol->name-assoc-list
'((graph . "Graph")
(digraph . "Directed Graph")
(node . "Node")
)
;; Navigation
senator-step-at-tag-classes '(graph digraph)
))
;;;###autoload
(add-hook 'graphviz-dot-mode-hook 'wisent-dot-setup-parser)
(provide 'wisent-dot)
;;; wisent-dot.el ends here
1.1 XEmacs/packages/xemacs-packages/cogre/wisent-dot.wy
Index: wisent-dot.wy
===================================================================
;;; wisent-dot.wy --- GraphViz DOT file parser
;; Copyright (C) 2003, 2004 Eric M. Ludlam
;; Author: Eric Ludlam <zappo at gnu.org>
;; Keywords: syntax
;; X-RCS: $Id: wisent-dot.wy,v 1.1 2007/11/26 15:04:27 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