git.gag.com Git - fw/openocd/blob - src/helper/startup.tcl

   1 # Defines basic Tcl procs that must exist for OpenOCD scripts to work.
   2 #
   3 # Embedded into OpenOCD executable
   4 #
   5
   6
   7 # We need to explicitly redirect this to the OpenOCD command
   8 # as Tcl defines the exit proc
   9 proc exit {} {
  10         ocd_throw exit
  11 }
  12
  13 # Help text list. A list of command + help text pairs.
  14 proc cmd_help {cmdname h indent} {
  15         set indent [expr $indent * 2]
  16
  17         set fmt_str [format "%%%ds%%-%ds %%s" $indent [expr 25 - $indent]]
  18         set w [expr 50 - $indent]
  19         set n 0
  20
  21         while 1 {
  22                 if {$n > [string length $h]} {break}
  23
  24                 set next_a [expr $n + $w]
  25                 if {[string length $h] > $n + $w} \
  26                 {
  27                         set xxxx [string range $h $n [expr $n + $w]]
  28                         for {set lastpos [expr [string length $xxxx] - 1]} \
  29                                 {$lastpos >= 0 && [string compare \
  30                                         [string range $xxxx $lastpos $lastpos] " "] != 0} \
  31                                 {set lastpos [expr $lastpos - 1]} \
  32                         {
  33                         }
  34                         #set next_a -1
  35                         if {$lastpos != -1} {
  36                                 set next_a [expr $lastpos + $n + 1]
  37                         }
  38                 }
  39
  40                 puts [format $fmt_str "" $cmdname \
  41                                 [string range $h $n [expr $next_a - 1]] ]
  42                 set cmdname ""
  43                 set n [expr $next_a]
  44         }
  45 }
  46
  47 # Try flipping / and \ to find file if the filename does not
  48 # match the precise spelling
  49 proc find {filename} {
  50         if {[catch {ocd_find $filename} t]==0} {
  51                 return $t
  52         }
  53         if {[catch {ocd_find [string map {\ /} $filename} t]==0} {
  54                 return $t
  55         }
  56         if {[catch {ocd_find [string map {/ \\} $filename} t]==0} {
  57                 return $t
  58         }
  59         # make sure error message matches original input string
  60         return -code error "Can't find $filename"
  61 }
  62 add_help_text find "<file> - print full path to file according to OpenOCD search rules"
  63
  64 # Run script
  65 proc script {filename} {
  66         source [find $filename]
  67 }
  68
  69 add_help_text script "<filename> - filename of OpenOCD script (tcl) to run"
  70
  71 #########
  72
  73 # catch any exceptions, capture output and return output
  74 proc capture_catch {a} {
  75         catch {
  76                 capture {uplevel $a}
  77         } result
  78         return $result
  79 }