Documentation Source Text

wm withdraw .

# Graphs:
#
set all_graphs {
  alter-table-stmt {
    stack
       {line ALTER TABLE {optx database-name .} table-name}
       {tailbranch
          {line RENAME TO new-table-name}
          {line ADD {optx COLUMN} column-def}
       }
  }
  analyze-stmt {
     line ANALYZE {optx database-name .} table-name
  }
  attach-stmt {
     line ATTACH {or DATABASE nil} database-filename AS attachment-name
  }
  begin-stmt {
     line BEGIN {or nil DEFERRED IMMEDIATE EXCLUSIVE}
          {optx TRANSACTION {optx name}}
  }
  commit-stmt {
     line {or COMMIT END} {optx TRANSACTION {optx name}}
  }
  rollback-stmt {
     line ROLLBACK {optx TRANSACTION {optx name}}
  }
  create-index-stmt {
    stack

       {line CREATE {opt UNIQUE} INDEX {opt IF NOT EXISTS}}
       {line {optx database-name .} index-name

             ON table-name ( {loop indexed-column {}} )}

  }
  indexed-column {
      line column-name {optx COLLATE collation-name} {or ASC DESC nil} 
  }
  create-table-stmt {
    stack
       {line CREATE {or {} TEMP TEMPORARY} TABLE {opt IF NOT EXISTS}}
       {line {optx database-name .} table-name
          {tailbranch
            {line ( {loop column-def ,} {loop {} {, table-constraint}} )}
            {line AS select-stmt}
          }
       }
  }
  column-def {
    line column-name {or type-name nil} {loop {} column-constraint}
  }
  type-name {
     line {loop name {}} {or {}
        {line ( number )}
        {line ( number , number )}
     }
  }

















  column-constraint {
    stack
      {optx 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}
         {line foreign-key-clause}

      }
  }
  table-constraint {
     stack
       {optx CONSTRAINT name}
       {or
          {line {or {line PRIMARY KEY} UNIQUE}
                ( column-list ) conflict-clause}
          {line CHECK ( expr )}
          {line FOREIGN KEY ( column-list ) foreign-key-clause }
       }
  }
  foreign-key-clause {
      stack 
        {line REFERENCES foreign-table {optx ( column-list )}}
        {toploop
           {or
              {line ON {or DELETE UPDATE INSERT}
                       {or {line SET NULL} {line SET DEFAULT}
                           CASCADE RESTRICT
                       }
              }
              {line MATCH name}
              nil
           }
           {}
        }
        {or
          {line {optx NOT} DEFERRABLE 
             {or 

                {line INITIALLY DEFERRED}
                {line INITIALLY IMMEDIATE}
                {}
             }
          }
          nil
        }
  }
  conflict-clause {
    opt {line ON CONFLICT {or ROLLBACK ABORT FAIL IGNORE REPLACE}}
  }
  expr {
    or
     {line literal-value}
     {line {optx {optx database-name .} table-name .}  column-name}
     {line unary-operator expr}
     {line expr binary-operator expr}
     {line function-name ( {or {toploop expr ,} *} )}
     {line ( expr )}
     {line CAST ( expr AS type-name )}
     {line expr COLLATE collation-name}
     {line expr {optx NOT} {or LIKE GLOB REGEXP MATCH} expr
           {optx ESCAPE expr}}



     {line expr {or ISNULL NOTNULL {line IS NULL} {line NOT NULL}}}
     {line expr {optx NOT} BETWEEN expr AND expr}
     {line expr {optx NOT} IN 
            {or

               {line ( select-stmt )}
               {line ( {loop expr ,} )}
               {line {optx database-name .} table-name}
            }
     }

     {line {optx {optx NOT} EXISTS} ( select-stmt )}
     {line CASE {optx expr} {loop {line WHEN expr THEN expr} {}}
           {optx ELSE expr} END}
  }
}

# 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
}
incr bn
set b .bb.b$bn
button $b -text Everything -command {draw_all_graphs}
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}          ;# default variable font
set RADIUS 9                      ;# default turn radius
set HSEP 17                       ;# horizontal separation
set VSEP 9                        ;# vertical separation
set DPI 80                        ;# dots per inch


# Draw a right-hand turn around.  Approximately a ")"
#
proc draw_right_turnback {tag x y0 y1} {
  global RADIUS

# Draw a bubble containing $txt. 
#
proc draw_bubble {txt} {
  global tagcnt
  incr tagcnt
  set tag x$tagcnt
  if {$txt=="nil"} {
    .c create line 0 0 1 0 -width 2 -tags $tag
    return [list $tag 1 0]
  }
  if {[regexp {^[a-z]} $txt]} {
    set font $::font2
    set istoken 0
  } else {
    set font $::font1
    set istoken 1

# descripts a single term.
#
proc draw_line {lx} {
  global tagcnt
  incr tagcnt
  set tag x$tagcnt

  set sep $::HSEP
  set exx 0
  set exy 0
  foreach term $lx {
    set m [draw_diagram $term]
    foreach {t texx texy} $m break
    if {$exx>0} {
      set xn [expr {$exx+$sep}]

# Draw a sequence of terms from right to left.
#
proc draw_backwards_line {lx} {
  global tagcnt
  incr tagcnt
  set tag x$tagcnt

  set sep $::HSEP
  set exx 0
  set exy 0
  set lb {}
  set n [llength $lx]
  for {set i [expr {$n-1}]} {$i>=0} {incr i -1} {
    lappend lb [lindex $lx $i]
  }

# Draw a sequence of terms from top to bottom.
#
proc draw_stack {lx} {
  global tagcnt
  incr tagcnt
  set tag x$tagcnt

  set sep $::VSEP
  set btm 0
  foreach term $lx {
    set m [draw_diagram $term]
    foreach {t exx exy} $m break
    foreach {tx0 ty0 tx1 ty1} [.c bbox $t] break
    if {$btm==0} {
      set btm $ty1

  return [list $tag $exit_x $exit_y]
}

proc draw_loop {forward back} {
  global tagcnt
  incr tagcnt
  set tag x$tagcnt
  set sep $::VSEP
  set vsep [expr {$sep/2}]

  foreach {ft fexx fexy} [draw_diagram $forward] break
  foreach {fx0 fy0 fx1 fy1} [.c bbox $ft] break
  set fw [expr {$fx1-$fx0}]
  foreach {bt bexx bexy} [draw_backwards_line $back] break
  foreach {bx0 by0 bx1 by1} [.c bbox $bt] break

  return [list $tag $x1 $fexy]
}

proc draw_toploop {forward back} {
  global tagcnt
  incr tagcnt
  set tag x$tagcnt
  set sep $::VSEP
  set vsep [expr {$sep/2}]

  foreach {ft fexx fexy} [draw_diagram $forward] break
  foreach {fx0 fy0 fx1 fy1} [.c bbox $ft] break
  set fw [expr {$fx1-$fx0}]
  foreach {bt bexx bexy} [draw_backwards_line $back] break
  foreach {bx0 by0 bx1 by1} [.c bbox $bt] break

  return [list $tag $x1 $fexy]
}

proc draw_or {lx} {
  global tagcnt
  incr tagcnt
  set tag x$tagcnt
  set sep $::VSEP
  set vsep [expr {$sep/2}]
  set n [llength $lx]
  set i 0
  set mxw 0
  foreach term $lx {
    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 {$i>0} {set w [expr {$w+20}]}  ;# extra space for arrowheads
    if {$w>$mxw} {set mxw $w}
    incr i
  }


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

  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 w [expr {$tx1-$tx0}]
    set dx [expr {($mxw-$w)/2 + $x2}]
    .c move $t $dx 0
    set texx [expr {$texx+$dx}]
    set m($i) [list $t $texx $texy]
    foreach {tx0 ty0 tx1 ty1} [.c bbox $t] break
    if {$i==0} {
      if {$dx>$x2} {set ax last} {set ax none}
      .c create line 0 0 $dx 0 -width 2 -tags $tag -arrow $ax
      .c create line $texx $texy [expr {$x5+1}] $texy -width 2 -tags $tag
      set exy $texy
      .c create arc -$sep 0 $sep [expr {$sep*2}] \
         -width 2 -start 90 -extent -90 -tags $tag -style arc
      .c create arc $x4 0 [expr {$x4+2*$sep}] [expr {2*$sep}] \
         -width 2 -start 180 -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
      set texy [expr {$texy+$dy}]
      if {$dx>$x2} {
        .c create line $x2 $dy $dx $dy -width 2 -tags $tag -arrow last
        if {$dx<$xc-2} {set ax last} {set ax none}
        .c create line $texx $texy $x3 $texy -width 2 -tags $tag -arrow $ax
      }
      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
      set y2 [expr {$texy-2*$sep}]
      .c create arc [expr {$x3-$sep}] $y2 $x4 $texy \
          -width 2 -start 270 -extent 90 -style arc -tags $tag

  return [list $tag $x5 $exy]   
}

proc draw_tail_branch {lx} {
  global tagcnt
  incr tagcnt
  set tag x$tagcnt
  set sep $::VSEP
  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
  }

proc draw_diagram {spec} {
  set n [llength $spec]
  if {$n==1} {
    return [draw_bubble $spec]
  }
  if {$n==0} {
    return [draw_bubble nil]
  }
  set cmd [lindex $spec 0]
  if {$cmd=="line"} {
    return [draw_line [lrange $spec 1 end]]
  }
  if {$cmd=="stack"} {
    return [draw_stack [lrange $spec 1 end]]
  }
  if {$cmd=="loop"} {
    return [draw_loop [lindex $spec 1] [lindex $spec 2]]
  }
  if {$cmd=="toploop"} {
    return [draw_toploop [lindex $spec 1] [lindex $spec 2]]
  }
  if {$cmd=="or"} {
    return [draw_or [lrange $spec 1 end]]
  }
  if {$cmd=="opt"} {
    set args [lrange $spec 1 end]
    if {[llength $args]==1} {
      return [draw_or [list nil [lindex $args 0]]]
    } else {
      return [draw_or [list nil "line $args"]]
    }
  }
  if {$cmd=="optx"} {
    set args [lrange $spec 1 end]
    if {[llength $args]==1} {
      return [draw_or [list [lindex $args 0] nil]]
    } else {
      return [draw_or [list "line $args" nil]]
    }
  }
  if {$cmd=="tailbranch"} {
    return [draw_tail_branch [lrange $spec 1 end]]
  }
  error "unknown operator: $cmd"
}