Commit 3d00f8a6 authored by Pascal J. Bourguignon's avatar Pascal J. Bourguignon

Updated generation of system-graph.

parent 9dd9fc70
......@@ -43,7 +43,8 @@ all::
include implementations.mk
help::
@printf 'NOTE: Most of this makefile is obsolete.\n Please use ASDF or QUICKLISP to compile and load these systems.\n'
help::
@for c in $(COMPILERS) ; do printf $(HELP_FMT) "compile-with-$$c" "Compile with $$c." ; done
@printf $(HELP_FMT) 'all' 'Compile with all the available compilers.'
......@@ -69,7 +70,7 @@ PREFIX=$(HOME)/quicklisp/local-projects
PACKAGES=$(PREFIX)
PACKAGE_PATH=com/informatimago
MODULES= common-lisp clext clmisc clisp susv3 rdp
MODULES= common-lisp clext clmisc clisp susv3 rdp small-cl-pgms/botihn
......@@ -198,6 +199,14 @@ help::
try:
$(call eval_with_sbcl,'(progn (load #P"~/quicklisp/setup.lisp") (funcall (find-symbol "QUICKLOAD" "QL") :com.informatimago.tools.try-systems) (funcall (find-symbol "TRY-SYSTEMS" "COM.INFORMATIMAGO.TOOLS.TRY-SYSTEMS")))')
help::
@printf $(HELP_FMT) 'system-index.txt' 'Builds a list of all asd files.'
clean::
-rm -f system-index.txt
system-index.txt:
@find * -name \*.asd | while read line ; do echo "$${#line}:$${line}" ; done | sort -t: -k 1n | awk -F: '{print $$2;}' > system-index.txt
# quicklisp-tag: quicklisp-tag-remove quicklisp-tag-add
#
# quicklisp-tag-remove:
......
......@@ -32,31 +32,44 @@
# along with this program. If not, see http://www.gnu.org/licenses/
#*****************************************************************************
PREFIX=/usr/local
all:: doc
include ../implementations.mk
help::
@printf $(HELP_FMT) 'doc' 'Generate documentation.'
doc::documentation
documentation:: README.pdf
html:: README.html
help::
@echo "make iana-character-sets.data # downloads the IANA character sets data file."
@printf $(HELP_FMT) 'iana-character-sets.data' 'Downloads the IANA character sets data file.'
iana-character-sets.data:
wget http://www.iana.org/assignments/character-sets -O $@
help::
@printf $(HELP_FMT) 'system-graph.ps' 'Generate graph of systems.'
@printf $(HELP_FMT) 'system-graph.eps' 'Generate graph of systems.'
@printf $(HELP_FMT) 'system-graph.dot' 'Generate graph of systems.'
clean::
-@rm -f system-graph.dot system-graph.ps system-graph.eps
system-graph.dot:Makefile gen-lib-graph.lisp $(shell find . -name \*.asd)
ccl -n -e '(handler-case (progn (load "gen-lib-graph.lisp") (ccl:quit)) (error (err) (princ err *error-output*) (terpri *error-output*) (ccl:quit 1)))'
system-graph.ps:system-graph.dot
dot -Tps -o system-graph.ps system-graph.dot
system-graph.eps:system-graph.ps
ps2epsi system-graph.ps system-graph.eps
lc -u system-graph.eps
help::
@printf $(HELP_FMT) 'README.pdf' 'Generate README.'
clean::
-@rm -f README.html README.pdf
README.pdf:README system-graph.eps
rst2pdf < README > README.pdf
README.html:README system-graph.eps
rst2html < README > README.html
doc::documentation
documentation:: README.pdf
html:: README.html
compile::
./compile.sh
......
This diff is collapsed.
......@@ -36,6 +36,7 @@
(setf *readtable* (copy-readtable nil)))
(in-package "COMMON-LISP-USER")
(require 'asdf)
(setf asdf:*central-registry*
(append (remove-duplicates
......@@ -46,13 +47,14 @@
asdf:*central-registry*))
(asdf-load :com.informatimago.common-lisp.graphviz)
(asdf:oos 'asdf:load-op :com.informatimago.common-lisp.graphviz)
(defpackage "COM.INFORMATIMAGO.TOOLS.GEN-LIB-GRAPH"
(:use "COMMON-LISP"
"COM.INFORMATIMAGO.COMMON-LISP.CESARUM.GRAPH"
"COM.INFORMATIMAGO.COMMON-LISP.CESARUM.SEQUENCE"
"COM.INFORMATIMAGO.COMMON-LISP.GRAPHVIZ.GRAPH-DOT"))
(in-package "COM.INFORMATIMAGO.TOOLS.GEN-LIB-GRAPH")
......@@ -61,34 +63,70 @@
(defun read-asd-file (path)
(with-open-file (asd path)
(read asd nil nil)))
(defun asd-name (asd) (second asd))
(defun asd-depends-on (asd) (getf (cddr asd) :depends-on))
(defun make-system-graph (asd-files graph-path)
(let* ((asds (mapcar (function read-asd-file) asd-files))
(let ((*package* *package*)
(result '()))
(labels ((collect (sexp)
(push sexp result))
(process (sexp)
(cond
((atom sexp))
((eql 'eval-when (first sexp))
(when (intersection '(:load-toplevel :execute load eval)
(second sexp))
(dolist (sexp (cddr sexp))
(process sexp))))
((eql 'progn (first sexp))
(dolist (sexp (cdr sexp))
(process sexp)))
((eql 'in-package (first sexp))
(eval sexp))
((eql 'asdf:defsystem (first sexp))
(collect sexp)))))
(with-open-file (asd path)
(loop
:for sexp := (ignore-errors (read asd nil asd))
:until (eql sexp asd)
:do (process sexp))))
(nreverse result)))
(defun asd-name (asd)
(string-downcase (second asd)))
(defun asd-depends-on (asd)
(mapcar (function string-downcase)
(getf (cddr asd) :depends-on)))
(defmethod dot-label ((element element-class))
(getf (properties element) :dot-label))
(defun make-system-graph (asd-files graph-path &key test)
(let* ((asds (let ((asds (mapcan (function read-asd-file) asd-files)))
(if test
(remove-if-not test asds)
asds)))
(nodes (mapcar (lambda (asd)
(format *trace-output* ";; read ~A~%" (asd-name asd))
(force-output *trace-output*)
(make-instance 'element-class
:ident (asd-name asd)
:properties (list :asd asd
:dot-label (subseq (string (asd-name asd))
(length "com.informatimago.common-lisp.")))))
:ident (asd-name asd)
:properties (list :asd asd
:dot-label (subseq (string (asd-name asd))
(length "com.informatimago.common-lisp.")))))
asds))
(g (make-instance 'graph-class :edge-class 'directed-edge-class)))
(add-nodes g nodes)
(loop
:for node :in nodes
:for dependencies = (mapcar (lambda (asd-name)
(find asd-name nodes
:test (function member)
:key (lambda (node) (get-property node :asd))))
(asd-depends-on (get-property node :asd)))
:do (loop
:for dependency :in dependencies
:do (add-edge-between-nodes g node dependency)))
:for node :in nodes
:for dependencies = (mapcar (lambda (asd-name)
(find asd-name nodes
:test (function equal)
:key (lambda (node) (asd-name (get-property node :asd)))))
(asd-depends-on (get-property node :asd)))
:do (loop
:for dependency :in dependencies
:when dependency
:do (format *trace-output* "~A -> ~A~%" (dot-label node) (dot-label dependency))
(add-edge-between-nodes g node dependency)))
(set-property g :dot-rankdir "LR")
(set-property g :dot-concentrate t)
(with-open-file (out graph-path
......@@ -98,7 +136,8 @@
(princ (generate-dot g) out))))
(make-system-graph *asd-files* "system-graph.dot")
(make-system-graph *asd-files* "system-graph.dot"
:test (lambda (asd) (not (suffixp ".test" (asd-name asd)))))
;;;; THE END ;;;;
......@@ -195,9 +195,9 @@ NOTE: dot graphs are directed.
"splines=true;~%"
"// common attributes of NODES:~%"
"node [height=0.2 width=0.5 shape=box fontsize=8 fontname=Futura] ;~%"))
(map-elements (nodes self) (lambda (node) (generate-dot node)))
(map-elements 'list (nodes self) (lambda (node) (generate-dot node)))
(format nil "// common attributes of edges:~%edge [style=solid];~%")
(map-elements (edges self) (lambda (edge) (generate-dot edge)))
(map-elements 'list (edges self) (lambda (edge) (generate-dot edge)))
(format nil "}~%")))))
......
digraph Untitled
{
rankdir=LR;
concentrate=true;
// attributes of graph:
// page=8,11.4; // page size (NeXTprinter:A4).
// size=30,8; // graph size (please edit to fit).
// rotate=90; // graph orientation (please edit to fit).
// ratio=fill; // fill the size (or compress, auto, aspect/ratio).
nodesep=0.3;
ranksep=0.3;
center=1;
// common attributes of NODES:
node [height=0.2 width=0.5 shape=box fontsize=8 fontname=Times] ;
ELEMENTCLASS42903 [ style=filled color=black fillcolor=LightYellow label="HEAP" ];
ELEMENTCLASS42902 [ style=filled color=black fillcolor=LightYellow label="REGEXP" ];
ELEMENTCLASS42901 [ style=filled color=black fillcolor=LightYellow label="FILE" ];
ELEMENTCLASS42900 [ style=filled color=black fillcolor=LightYellow label="CESARUM" ];
ELEMENTCLASS42899 [ style=filled color=black fillcolor=LightYellow label="DATA-ENCODING" ];
ELEMENTCLASS42898 [ style=filled color=black fillcolor=LightYellow label="INTERACTIVE" ];
ELEMENTCLASS42897 [ style=filled color=black fillcolor=LightYellow label="CXX" ];
ELEMENTCLASS42896 [ style=filled color=black fillcolor=LightYellow label="HTML-GENERATOR" ];
ELEMENTCLASS42895 [ style=filled color=black fillcolor=LightYellow label="RFC2822" ];
ELEMENTCLASS42894 [ style=filled color=black fillcolor=LightYellow label="ED" ];
ELEMENTCLASS42893 [ style=filled color=black fillcolor=LightYellow label="HTML-PARSER" ];
ELEMENTCLASS42892 [ style=filled color=black fillcolor=LightYellow label="GRAPHVIZ" ];
ELEMENTCLASS42891 [ style=filled color=black fillcolor=LightYellow label="LISP" ];
ELEMENTCLASS42890 [ style=filled color=black fillcolor=LightYellow label="LISP-READER" ];
ELEMENTCLASS42889 [ style=filled color=black fillcolor=LightYellow label="HTTP" ];
ELEMENTCLASS42888 [ style=filled color=black fillcolor=LightYellow label="BANK" ];
ELEMENTCLASS42887 [ style=filled color=black fillcolor=LightYellow label="CSV" ];
ELEMENTCLASS42886 [ style=filled color=black fillcolor=LightYellow label="PARSER" ];
ELEMENTCLASS42885 [ style=filled color=black fillcolor=LightYellow label="UNIX" ];
ELEMENTCLASS42884 [ style=filled color=black fillcolor=LightYellow label="LISP-SEXP" ];
ELEMENTCLASS42883 [ style=filled color=black fillcolor=LightYellow label="RFC3548" ];
ELEMENTCLASS42882 [ style=filled color=black fillcolor=LightYellow label="LISP-TEXT" ];
ELEMENTCLASS42881 [ style=filled color=black fillcolor=LightYellow label="PICTURE" ];
ELEMENTCLASS42880 [ style=filled color=black fillcolor=LightYellow label="ARITHMETIC" ];
ELEMENTCLASS42879 [ style=filled color=black fillcolor=LightYellow label="INVOICE" ];
ELEMENTCLASS42878 [ style=filled color=black fillcolor=LightYellow label="HTML-BASE" ];
ELEMENTCLASS42877 [ style=filled color=black fillcolor=LightYellow label="DIAGRAM" ];
// common attributes of edges:
edge [style=solid];
ELEMENTCLASS42903 -> ELEMENTCLASS42900 ;
ELEMENTCLASS42902 -> ELEMENTCLASS42881 ;
ELEMENTCLASS42902 -> ELEMENTCLASS42900 ;
ELEMENTCLASS42901 -> ELEMENTCLASS42900 ;
ELEMENTCLASS42900 -> ELEMENTCLASS42884 ;
ELEMENTCLASS42899 -> ELEMENTCLASS42900 ;
ELEMENTCLASS42898 -> ELEMENTCLASS42900 ;
ELEMENTCLASS42897 -> ELEMENTCLASS42900 ;
ELEMENTCLASS42896 -> ELEMENTCLASS42900 ;
ELEMENTCLASS42895 -> ELEMENTCLASS42900 ;
ELEMENTCLASS42894 -> ELEMENTCLASS42902 ;
ELEMENTCLASS42894 -> ELEMENTCLASS42900 ;
ELEMENTCLASS42893 -> ELEMENTCLASS42878 ;
ELEMENTCLASS42893 -> ELEMENTCLASS42900 ;
ELEMENTCLASS42892 -> ELEMENTCLASS42900 ;
ELEMENTCLASS42890 -> ELEMENTCLASS42884 ;
ELEMENTCLASS42889 -> ELEMENTCLASS42896 ;
ELEMENTCLASS42889 -> ELEMENTCLASS42900 ;
ELEMENTCLASS42888 -> ELEMENTCLASS42900 ;
ELEMENTCLASS42887 -> ELEMENTCLASS42900 ;
ELEMENTCLASS42886 -> ELEMENTCLASS42900 ;
ELEMENTCLASS42885 -> ELEMENTCLASS42900 ;
ELEMENTCLASS42883 -> ELEMENTCLASS42900 ;
ELEMENTCLASS42882 -> ELEMENTCLASS42890 ;
ELEMENTCLASS42881 -> ELEMENTCLASS42900 ;
ELEMENTCLASS42880 -> ELEMENTCLASS42900 ;
ELEMENTCLASS42879 -> ELEMENTCLASS42900 ;
ELEMENTCLASS42878 -> ELEMENTCLASS42884 ;
ELEMENTCLASS42878 -> ELEMENTCLASS42900 ;
ELEMENTCLASS42877 -> ELEMENTCLASS42900 ;
}
This diff is collapsed.
......@@ -19,10 +19,10 @@ install::botihn
install -m 755 botihn /usr/local/sbin/botihn
doc::html
pandoc -f rst -t asciidoc < botihn.txt >botihn-fr.asc
pandoc -f rst -t asciidoc < botihn.txt > botihn-fr.asc
clean::
- rm -f botihn-fr.html botihn-fr.html.in
- rm -f botihn-fr.html botihn-fr.html.in botihn-fr.asc
html::botihn-fr.html
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment