tool/sqltclsh.tcl

   1 # Try to open the executable as a database and read the "scripts.data"
   2 # field where "scripts.name" is 'main.tcl'
   3 #
   4 catch {
   5   if {![file exists $argv0] && [file exists $argv0.exe]} {
   6     append argv0 .exe
   7   }
   8   sqlite3 db $argv0 -vfs apndvfs -create 0
   9   set mainscript [db one {
  10       SELECT sqlar_uncompress(data,sz) FROM sqlar WHERE name='main.tcl'
  11   }]
  12 }
  13 if {[info exists mainscript]} {
  14   eval $mainscript
  15   return
  16 } else {
  17   catch {db close}
  18 }
  19
  20 # Try to open file named in the first argument as a database and
  21 # read the "scripts.data" field where "scripts.name" is 'main.tcl'
  22 #
  23 if {[llength $argv]>0 && [file readable [lindex $argv 0]]} {
  24   catch {
  25     sqlite3 db [lindex $argv 0] -vfs apndvfs -create 0
  26     set mainscript [db one {SELECT data FROM scripts WHERE name='main.tcl'}]
  27     set argv0 [lindex $argv 0]
  28     set argv [lrange $argv 1 end]
  29   }
  30   if {[info exists mainscript]} {
  31     eval $mainscript
  32     return
  33   } else {
  34     catch {db close}
  35   }
  36   if {[string match *.tcl [lindex $argv 0]]} {
  37     set fd [open [lindex $argv 0] rb]
  38     set mainscript [read $fd]
  39     close $fd
  40     unset fd
  41     set argv0 [lindex $argv 0]
  42     set argv [lrange $argv 1 end]
  43   }
  44   if {[info exists mainscript]} {
  45     eval $mainscript
  46     return
  47   }
  48 }
  49
  50 # If all else fails, do an interactive loop
  51 #
  52 set line {}
  53 while {![eof stdin]} {
  54   if {$line!=""} {
  55     puts -nonewline "> "
  56   } else {
  57     puts -nonewline "% "
  58   }
  59   flush stdout
  60   append line [gets stdin]
  61   if {[info complete $line]} {
  62     if {[catch {uplevel #0 $line} result]} {
  63       puts stderr "Error: $result"
  64     } elseif {$result!=""} {
  65       puts $result
  66     }
  67     set line {}
  68   } else {
  69     append line \\n"
  70   }
  71 }