A sample RCL script that is used to pre-process the
RSF generated with
cparse for Rigi has been written by
JohannesMartin. The RCL script is generic and works for most C programs. He also used the script (with slight modifications) to look at web site structures.
Note that the preprocessing takes away detail and creates a specific structure in the graph. For example, all of the standard library is filtered out. You can use the script as a starting point and modify it to suit your own, specific needs.
# load rsf file and perform some preliminary modifications
proc load_cprog {filename} {
set_domain cparse 0
rcl_win_set_drawing 0
rcl_load_rsf $filename
puts "Delete standard library nodes..."
c_delete_std
puts "Delete disconnected variables..."
c_delete_disconnected Variable
puts "Delete disconnected prototypes..."
c_delete_disconnected Prototype
puts "Delete disconnected datatypes..."
c_delete_disconnected Datatype
puts "Delete disconnected constants..."
c_delete_disconnected Constant
puts "Delete disconnected functions..."
c_delete_disconnected Function
puts "Delete disconnected unknowns..."
c_delete_disconnected Unknown
puts "Redirecting prototypes..."
c_redirect Prototype prototypes
puts "Redirecting external variable declarations..."
c_redirect Variable declares
c_redirect Constant declares
puts "Redirecting datatypes..."
c_redirect Datatype isTheSameAs
puts "Collapsing function parameters..."
c_collapse2 Function isDefinedIn in
puts "Delete disconnected variables..."
c_delete_disconnected Variable
puts "Delete disconnected prototypes..."
c_delete_disconnected Prototype
puts "Delete disconnected datatypes..."
c_delete_disconnected Datatype
puts "Delete disconnected constants..."
c_delete_disconnected Constant
puts "Delete disconnected functions..."
c_delete_disconnected Function
puts "Delete disconnected unknowns..."
c_delete_disconnected Unknown
rcl_grid_all
rcl_win_set_drawing 1
rcl_refresh
}
# Delete every nodes that represent artifacts out of the standard library
# (/usr/include/*) and standard data types.
proc c_delete_std { } {
rcl_select_none
rcl_select_grep ".*/usr/include/.*"
rcl_select_name int 1
rcl_select_name char 1
rcl_select_name long 1
rcl_select_name void 1
rcl_select_name float 1
rcl_select_name double 1
set winnodes [rcl_select_get_list]
rcl_select_none
foreach node $winnodes {
rcl_node_delete $node
}
}
# For all nodes of type ntype (winnodes), find a target node
# (destination) for a first (and only) outgoing arc of type atype (arc1).
# Redirect all incoming arcs of nodes belonging to 'winnodes' to enter
# node 'destination'.
# Delete winnodes and their dependencies out of the graph
# an example of usage: c_redirect Prototype prototypes
proc c_redirect {ntype atype} {
rcl_select_none
rcl_select_type $ntype
set winnodes [rcl_select_get_list]
rcl_select_none
foreach node $winnodes {
set arclist [rcl_node_get_arclist $node $atype out 0 0]
if { [llength $arclist] >= 1 } {
set arc1 [lindex $arclist 0]
set enterings [rcl_node_get_arclist_in_window $node any in]
set destination [rcl_get_arc_dst $arc1]
foreach arc2 $enterings {
set type [rcl_get_arc_type $arc2]
if { [rcl_get_arctype level] != $type } {
set source [rcl_get_arc_src $arc2]
rcl_arc_create2 $source $destination $type
}
}
rcl_node_delete $node
}
}
rcl_refresh
}
# For all nodes of type ntype, collapse them and all nodes
# that are connected to them with an arc of type atype
# (the direction of the connection is dir)
# to a single node (the collapsed node is given the same name as
# the original ntype type nodes).
# an exampe of usage: c_collapse Function isDefinedIn in
proc c_collapse {ntype atype dir} {
rcl_select_none
rcl_select_type $ntype
set winnodes [rcl_select_get_list]
rcl_select_none
foreach node $winnodes {
rcl_select_id $node
set name [rcl_get_node_name $node]
select_neighbors $atype $dir 1
if {[rcl_collapse Collapse $name] == 0} { return }
}
}
# For all nodes of type ntype:
# - collapse all nodes that are connected to the node with an arc of
# type atype (the direction of the connection is dir) to a single node.
# - redirect all arcs going to or coming from the node to the
# new collapsed node.
# - give the new collapsed node the name of the original node
# delete the original node
# an exampe of usage: c_collapse Function isDefinedIn in
proc c_collapse2 {ntype atype dir} {
rcl_select_none
rcl_select_type $ntype
set winnodes [rcl_select_get_list]
rcl_select_none
foreach node $winnodes {
rcl_select_id $node
select_neighbors $atype $dir 1
rcl_select_deselect_id $node
if { [ llength [ rcl_select_get_list ] ] >= 1 } {
if { [ rcl_collapse $ntype [ rcl_get_node_name $node ] ] == 0} {
return
}
set id [rcl_select_get_list]
set arclist [ rcl_node_get_arclist $node any out 1 1 ]
foreach arc $arclist {
set type [rcl_get_arc_type $arc]
set dst [rcl_get_arc_dst $arc]
if { $id != $dst } {
rcl_arc_create2 $id $dst $type
}
}
set arclist [ rcl_node_get_arclist $node any in 1 1 ]
foreach arc $arclist {
set type [rcl_get_arc_type $arc]
set src [rcl_get_arc_src $arc]
if { $src != $id } {
rcl_arc_create2 $src $id $type
}
}
rcl_node_delete $node
}
}
}
# Delete disconnected nodes of type 'ntype' from the graph
# an example of usage: c_delete_disconnected Variable
proc c_delete_disconnected {ntype} {
rcl_select_none
rcl_select_type $ntype
set winnodes [rcl_select_get_list]
rcl_select_none
foreach node $winnodes {
set nnodes [rcl_node_get_neighbors_in_window $node any any]
if {[llength $nnodes] < 1} {
rcl_node_delete $node
}
}
rcl_refresh
}
# Find partitions of the graph that are connected with arcs of type atype
# and make them into subsystems.
proc c_partition {atype} {
rcl_set_current_arctype $atype
while { 1 } {
rcl_select_all
set nodes [rcl_select_get_list]
foreach id $nodes {
rcl_select_id $id
set oldnum 0
set newnum 1
while { $newnum > $oldnum } {
rcl_select_forward_tree
rcl_select_reverse_tree
set oldnum $newnum
set newnum [rcl_select_num_nodes]
}
if { $newnum > 1 } {
puts "Collapsing $newnum nodes..."
rcl_collapse Collapse "Subsystem ($newnum children)"
set id 0
break
}
}
if { $id != 0 } {
break
}
}
}
# Find partitions of the graph by node names and make them into subsystems.
# Name is a regular expression characterizing the names of all nodes to be
# collapsed.
proc c_partition_by_name {name} {
rcl_select_none
rcl_select_grep "$name"
set num [rcl_select_num_nodes]
if { $num > 1 } {
puts "Collapsing $num nodes for library $name..."
rcl_collapse Collapse "$name Subsystem ($num children)"
}
}
# Remove mangling from names and move into annotate attribute
proc c_unmangle_names {} {
rcl_select_all
set nodes [rcl_select_get_list]
foreach id $nodes {
set name [rcl_get_node_name $id]
if { [regsub {^([^^]*)\^.*} "$name" {\1} newname] > 0 } {
rcl_set_node_name $id $newname
regsub {^([^^]*)\^(.*)} "$name" {\2} annotate
rcl_set_node_attr $id annotate $annotate
}
}
rcl_refresh
}
CategoryRigi