Documentation Source Text

#!/bin/wish
#
# Run this wish script to generate syntax bubble diagrams from
# text descriptions.
#

# Top-level displays
#
toplevel .bb
canvas .c -bg white
pack .c -side top -fill both -expand 1
wm withdraw .

# Graphs:
#
set all_graphs {
  create-table-stmt {
    stack
       {line CREATE {or {} TEMP TEMPORARY} TABLE}
       {opt {line IF NOT EXISTS}}
       {line {opt {line database-name .}} table-name}
       {tailbranch
          {line ( {loop column-def ,} {loop {} {, constraint}} )}
          {line AS select}
       }
  }
  create-table-stmt-long {
    stack
       {line CREATE {or {} TEMP TEMPORARY} TABLE {opt {line IF NOT EXISTS}}}
       {line {opt {line database-name .}} table-name
          {tailbranch
            {line ( {loop column-def ,} {loop {} {, constraint}} )}
            {line AS select}
          }
       }
  }
  column-def {
    line column-name {or
        {}
        {line type-name}
        {line type-name ( number )}
        {line type-name ( number , number )}
    } {loop {} column-constraint}
  }
  column-def-b {
    line column-name {opt
        {line type-name 
            {opt
               {line ( number {opt {line , number}} )}
            }
        }
    } {loop {} column-constraint}
  }
  column-constraint {
    line
      {opt {line CONSTRAINT name}}
      {or
         {line PRIMARY KEY conflict-clause {opt AUTOINCREMENT}}
         {line NOT NULL conflict-clause}
         {line UNIQUE conflict-clause}
         {line CHECK ( expr )}
         {line DEFAULT {or value {line ( expr )}}}
         {line COLLATE collation-name}
      }
  }
  constraint {
     or
       {line {or {line PRIMARY KEY} UNIQUE}
             ( column-list ) conflict-clause}
       {line CHECK ( expr )}
  }
  conflict-clause {
    opt {line ON CONFLICT {or ROLLBACK ABORT FAIL IGNORE REPLACE}}
  }
}

# Draw the button bar
#
set bn 0
foreach {name graph} $all_graphs {
  incr bn
  set b .bb.b$bn
  button $b -text $name -command [list draw_graph $name $graph]
  pack $b -side top -fill x -expand 1
}

set tagcnt 0                      ;# tag counter
set font1 {Helvetica 16 bold}     ;# default token font
set font2 {Helvetica 15 italic}   ;# default variable font
set RADIUS 13                     ;# default turn radius


# Draw a right-hand turn around.  Approximately a ")"
#
proc draw_right_turnback {tag x y0 y1} {
  global RADIUS
  if {$y0 + 2*$RADIUS < $y1} {

  incr tagcnt
  set tag x$tagcnt
  if {[regexp {^[a-z]} $txt]} {
    set font $::font2
  } else {
    set font $::font1
  }
  set id1 [.c create text 0 0 -anchor c -text $txt -font $font -tags $tag]
  foreach {x0 y0 x1 y1} [.c bbox $id1] break
  set h [expr {$y1-$y0+2}]
  set rad [expr {($h+1)/2}]
  set top [expr {$y0-2}]
  set btm [expr {$y1}]
  set left [expr {$x0+2}]
  set right [expr {$x1-2}]
  if {$left>$right} {
    set left [expr {($x0+$x1)/2}]
    set right $left
  }
  .c create arc [expr {$left-$rad}] $top [expr {$left+$rad}] $btm \
       -width 2 -start 90 -extent 180 -style arc -tags $tag
  .c create arc [expr {$right-$rad}] $top [expr {$right+$rad}] $btm \

    set m($i) [set mx [draw_diagram $term]]
    set tx [lindex $mx 0]
    foreach {x0 y0 x1 y1} [.c bbox $tx] break
    set w [expr {$x1-$x0}]
    if {$w>$mxw} {set mxw $w}
    incr i
  }
  set mxw [expr {$mxw+20}]        ;# extra space for arrowheads

  set x0 0                        ;# entry x
  set x1 $sep                     ;# decender 
  set x2 [expr {$sep*2}]          ;# start of choice
  set x3 [expr {$mxw+$x2}]        ;# end of choice
  set x4 [expr {$x3+$sep}]        ;# accender
  set x5 [expr {$x4+$sep}]        ;# exit x

      set btm [expr {$ty1+$dy}]
    }
    .c addtag $tag withtag $t
    .c dtag $t $t
  }
  return [list $tag $x5 $exy]   
}

proc draw_tail_branch {lx} {
  global tagcnt
  incr tagcnt
  set tag x$tagcnt
  set sep $::RADIUS
  set vsep [expr {$sep/2}]
  set n [llength $lx]
  set i 0
  foreach term $lx {
    set m($i) [set mx [draw_diagram $term]]
    incr i
  }

  set x0 0                        ;# entry x
  set x1 $sep                     ;# decender 
  set x2 [expr {$sep*2}]          ;# start of choice

  for {set i 0} {$i<$n} {incr i} {
    foreach {t texx texy} $m($i) break
    foreach {tx0 ty0 tx1 ty1} [.c bbox $t] break
    set dx [expr {$x2+10}]
    .c move $t $dx 0
    foreach {tx0 ty0 tx1 ty1} [.c bbox $t] break
    if {$i==0} {
      .c create line 0 0 $dx 0 -width 2 -tags $tag -arrow last
      .c create arc -$sep 0 $sep [expr {$sep*2}] \
         -width 2 -start 90 -extent -90 -tags $tag -style arc
      set btm $ty1
    } else {
      set dy [expr {$btm - $ty0 + $vsep}]
      if {$dy<2*$sep} {set dy [expr {2*$sep}]}
      .c move $t 0 $dy
      if {$dx>$x2} {
        .c create line $x2 $dy $dx $dy -width 2 -tags $tag -arrow last
      }
      set y1 [expr {$dy-2*$sep}]
      .c create arc $x1 $y1 [expr {$x1+2*$sep}] $dy \
          -width 2 -start 180 -extent 90 -style arc -tags $tag
      if {$i==$n-1} {
        .c create line $x1 [expr {$dy-$sep}] $x1 $sep -width 2 -tags $tag
      }
      set btm [expr {$ty1+$dy}]
    }
    .c addtag $tag withtag $t
    .c dtag $t $t
  }
  return [list $tag 0 0]
}

proc draw_diagram {spec} {
  set n [llength $spec]
  if {$n==1} {
    return [draw_bubble $spec]
  }
  if {$n==0} {

  }
  if {$cmd=="loop"} {
    return [draw_loop [lindex $spec 1] [lindex $spec 2]]
  }
  if {$cmd=="or"} {
    return [draw_or [lrange $spec 1 end]]
  }
  if {$cmd=="opt"} {
    return [draw_or [list {} [lindex $spec 1]]]
  }
  if {$cmd=="tailbranch"} {
    return [draw_tail_branch [lrange $spec 1 end]]
  }





  error "unknown operator: $cmd"


}


proc draw_graph {name spec} {
  .c delete all
  wm deiconify .
  wm title . $name
  draw_diagram $spec
  foreach {x0 y0 x1 y1} [.c bbox all] break
  .c move all [expr {-$x0}] [expr {-$y0}]
  foreach {x0 y0 x1 y1} [.c bbox all] break
  .c config -width $x1 -height $y1
  update
  .c postscript -file $name.ps -width $x1 -height $y1
  exec convert -density 72x72 -antialias $name.ps $name.gif
  exec xv $name.gif &
}