sqlitecon.tcl

sqlite-3.4.1,嵌入式数据库.是一个功能强大的开源数据库,给学习和研发以及小型公司的发展带来了全所未有的好处.

      set ln {}
      set dash ---------------------------------------------------------------
      append dash ------------------------------------------------------------
      foreach col $x(*) {
        if {![info exists cw($col)] || $cw($col)<[string length $col]} {
           set cw($col) [string length $col]
        }
        lappend hdr $col
        lappend ln [string range $dash 1 $cw($col)]
      }
      set y [concat $hdr $ln $y]
    }
    if {[info exists x(*)]} {
      set format {}
      set arglist {}
      set arglist2 {}
      set i 0
      foreach col $x(*) {
        lappend arglist x$i
        append arglist2 " \$x$i"
        incr i
        append format "  %-$cw($col)s"
      }
      set format [string trimleft $format]\n
      if {[llength $arglist]>0} {
        foreach $arglist $y "append res \[format [list $format] $arglist2\]"
      }
    }
  } elseif {$mode=="multicolumn"} {
    set y [$v(db) eval $cmd]
    set max 0
    foreach e $y {
      if {$max<[string length $e]} {set max [string length $e]}
    }
    set ncol [expr {int(80/($max+2))}]
    if {$ncol<1} {set ncol 1}
    set nelem [llength $y]
    set nrow [expr {($nelem+$ncol-1)/$ncol}]
    set format "%-${max}s"
    for {set i 0} {$i<$nrow} {incr i} {
      set j $i
      while 1 {
        append res [format $format [lindex $y $j]]
        incr j $nrow
        if {$j>=$nelem} break
        append res {  }
      }
      append res \n
    }
  } else {
    $v(db) eval $cmd x {
      foreach col $x(*) {append res "$col = $x($col)\n"}
      append res \n
    }
  }
  return [string trimright $res]
}

# Change the line to the previous line
#
proc sqlitecon::Prior w {
  upvar #0 $w v
  if {$v(current)<=0} return
  incr v(current) -1
  set line [lindex $v(history) $v(current)]
  sqlitecon::SetLine $w $line
}

# Change the line to the next line
#
proc sqlitecon::Next w {
  upvar #0 $w v
  if {$v(current)>=$v(historycnt)} return
  incr v(current) 1
  set line [lindex $v(history) $v(current)]
  sqlitecon::SetLine $w $line
}

# Change the contents of the entry line
#
proc sqlitecon::SetLine {w line} {
  upvar #0 $w v
  scan [$w index insert] %d.%d row col
  set start $row.$v(plength)
  $w delete $start end
  $w insert end $line
  $w mark set insert end
  $w yview insert
}

# Called when the mouse button is pressed at position $x,$y on
# the console widget.
#
proc sqlitecon::Button1 {w x y} {
  global tkPriv
  upvar #0 $w v
  set v(mouseMoved) 0
  set v(pressX) $x
  set p [sqlitecon::nearestBoundry $w $x $y]
  scan [$w index insert] %d.%d ix iy
  scan $p %d.%d px py
  if {$px==$ix} {
    $w mark set insert $p
  }
  $w mark set anchor $p
  focus $w
}

# Find the boundry between characters that is nearest
# to $x,$y
#
proc sqlitecon::nearestBoundry {w x y} {
  set p [$w index @$x,$y]
  set bb [$w bbox $p]
  if {![string compare $bb ""]} {return $p}
  if {($x-[lindex $bb 0])<([lindex $bb 2]/2)} {return $p}
  $w index "$p + 1 char"
}

# This routine extends the selection to the point specified by $x,$y
#
proc sqlitecon::SelectTo {w x y} {
  upvar #0 $w v
  set cur [sqlitecon::nearestBoundry $w $x $y]
  if {[catch {$w index anchor}]} {
    $w mark set anchor $cur
  }
  set anchor [$w index anchor]
  if {[$w compare $cur != $anchor] || (abs($v(pressX) - $x) >= 3)} {
    if {$v(mouseMoved)==0} {
      $w tag remove sel 0.0 end
    }
    set v(mouseMoved) 1
  }
  if {[$w compare $cur < anchor]} {
    set first $cur
    set last anchor
  } else {
    set first anchor
    set last $cur
  }
  if {$v(mouseMoved)} {
    $w tag remove sel 0.0 $first
    $w tag add sel $first $last
    $w tag remove sel $last end
    update idletasks
  }
}

# Called whenever the mouse moves while button-1 is held down.
#
proc sqlitecon::B1Motion {w x y} {
  upvar #0 $w v
  set v(y) $y
  set v(x) $x
  sqlitecon::SelectTo $w $x $y
}

# Called whenever the mouse leaves the boundries of the widget
# while button 1 is held down.
#
proc sqlitecon::B1Leave {w x y} {
  upvar #0 $w v
  set v(y) $y
  set v(x) $x
  sqlitecon::motor $w
}

# This routine is called to automatically scroll the window when
# the mouse drags offscreen.
#
proc sqlitecon::motor w {
  upvar #0 $w v
  if {![winfo exists $w]} return
  if {$v(y)>=[winfo height $w]} {
    $w yview scroll 1 units
  } elseif {$v(y)<0} {
    $w yview scroll -1 units
  } else {
    return
  }
  sqlitecon::SelectTo $w $v(x) $v(y)
  set v(timer) [after 50 sqlitecon::motor $w]
}

# This routine cancels the scrolling motor if it is active
#
proc sqlitecon::cancelMotor w {
  upvar #0 $w v
  catch {after cancel $v(timer)}
  catch {unset v(timer)}
}

# Do a Copy operation on the stuff currently selected.
#
proc sqlitecon::Copy w {
  if {![catch {set text [$w get sel.first sel.last]}]} {
     clipboard clear -displayof $w
     clipboard append -displayof $w $text
  }
}

# Return 1 if the selection exists and is contained
# entirely on the input line.  Return 2 if the selection
# exists but is not entirely on the input line.  Return 0
# if the selection does not exist.
#
proc sqlitecon::canCut w {
  set r [catch {
    scan [$w index sel.first] %d.%d s1x s1y
    scan [$w index sel.last] %d.%d s2x s2y
    scan [$w index insert] %d.%d ix iy
  }]
  if {$r==1} {return 0}
  if {$s1x==$ix && $s2x==$ix} {return 1}
  return 2
}

# Do a Cut operation if possible.  Cuts are only allowed
# if the current selection is entirely contained on the
# current input line.
#
proc sqlitecon::Cut w {
  if {[sqlitecon::canCut $w]==1} {
    sqlitecon::Copy $w
    $w delete sel.first sel.last
  }
}

# Do a paste opeation.
#
proc sqlitecon::Paste w {
  if {[sqlitecon::canCut $w]==1} {
    $w delete sel.first sel.last
  }
  if {[catch {selection get -displayof $w -selection CLIPBOARD} topaste]
    && [catch {selection get -displayof $w -selection PRIMARY} topaste]} {
    return
  }
  if {[info exists ::$w]} {
    set prior 0
    foreach line [split $topaste \n] {
      if {$prior} {
        sqlitecon::Enter $w
        update
      }
      set prior 1
      $w insert insert $line
    }
  } else {
    $w insert insert $topaste
  }
}

# Enable or disable entries in the Edit menu
#
proc sqlitecon::EnableEditMenu w {
  upvar #0 $w.t v
  set m $v(editmenu)
  if {$m=="" || ![winfo exists $m]} return
  switch [sqlitecon::canCut $w.t] {
    0 {
      $m entryconf Copy -state disabled
      $m entryconf Cut -state disabled
    }
    1 {
      $m entryconf Copy -state normal
      $m entryconf Cut -state normal
    }
    2 {
      $m entryconf Copy -state normal
      $m entryconf Cut -state disabled
    }
  }
}

# Prompt the user for the name of a writable file.  Then write the
# entire contents of the console screen to that file.
#
proc sqlitecon::SaveFile w {
  set types {
    {{Text Files}  {.txt}}
    {{All Files}    *}
  }
  set f [tk_getSaveFile -filetypes $types -title "Write Screen To..."]
  if {$f!=""} {
    if {[catch {open $f w} fd]} {
      tk_messageBox -type ok -icon error -message $fd
    } else {
      puts $fd [string trimright [$w get 1.0 end] \n]
      close $fd
    }
  }
}

# Erase everything from the console above the insertion line.
#
proc sqlitecon::Clear w {
  $w delete 1.0 {insert linestart}
}

# An in-line editor for SQL
#
proc sqlitecon::_edit {origtxt {title {}}} {
  for {set i 0} {[winfo exists .ed$i]} {incr i} continue
  set w .ed$i
  toplevel $w
  wm protocol $w WM_DELETE_WINDOW "$w.b.can invoke"
  wm title $w {Inline SQL Editor}
  frame $w.b
  pack $w.b -side bottom -fill x
  button $w.b.can -text Cancel -width 6 -command [list set ::$w 0]
  button $w.b.ok -text OK -width 6 -command [list set ::$w 1]
  button $w.b.cut -text Cut -width 6 -command [list ::sqlitecon::Cut $w.t]
  button $w.b.copy -text Copy -width 6 -command [list ::sqlitecon::Copy $w.t]
  button $w.b.paste -text Paste -width 6 -command [list ::sqlitecon::Paste $w.t]
  set ::$w {}
  pack $w.b.cut $w.b.copy $w.b.paste $w.b.can $w.b.ok\
     -side left -padx 5 -pady 5 -expand 1
  if {$title!=""} {
    label $w.title -text $title
    pack $w.title -side top -padx 5 -pady 5
  }
  text $w.t -bg white -fg black -yscrollcommand [list $w.sb set]
  pack $w.t -side left -fill both -expand 1
  scrollbar $w.sb -orient vertical -command [list $w.t yview]
  pack $w.sb -side left -fill y
  $w.t insert end $origtxt

  vwait ::$w

  if {[set ::$w]} {
    set txt [string trimright [$w.t get 1.0 end]]
  } else {
    set txt $origtxt
  }
  destroy $w
  return $txt
}