scripts/baseconfig.itcl

   1 # vim: foldmarker=<<<,>>>
   2
   3 class tlc::Baseconfig {
   4         constructor {args} {}
   5
   6         public {
   7                 variable configfile                     "config"
   8
   9                 if {[info exists tlc::theme]} {
  10                         variable textbackground         [$tlc::theme setting textbackground]
  11                         variable disabledbackground     [$tlc::theme setting disabledbackground]
  12                         variable enabledbackground      [$tlc::theme setting textbackground]
  13                         variable disabledforeground     [$tlc::theme setting disabledforeground]
  14                         variable enabledforeground      [$tlc::theme setting enabledforeground]
  15                         variable fixedfont                      [$tlc::theme setting fixedfont]
  16                         variable selectbackground       [$tlc::theme setting selectbackground]
  17                         variable selectforeground       [$tlc::theme setting selectforeground]
  18                         variable background                     [$tlc::theme setting background]
  19                         variable highlighttextbackground        [$tlc::theme setting background]
  20                         variable hidebg                         [$tlc::theme setting hidebg]
  21                         variable tinyfont                       [$tlc::theme setting tinyfont]
  22                         variable smallfont                      [$tlc::theme setting smallfont]
  23                         variable normalfont                     [$tlc::theme setting font]
  24                         variable boldfont                       [$tlc::theme setting boldfont]
  25                         variable hugefont                       [$tlc::theme setting hugefont]
  26                 }
  27
  28                 method dump_config {}
  29                 method get {key {default ""}}
  30                 method show_options {}
  31                 method app_specific_opts {}
  32                 method rest {}
  33         }
  34
  35         protected {
  36                 variable descriptions
  37         }
  38
  39         private {
  40                 variable general_opts   {
  41                         configfile background fixedfont tinyfont smallfont normalfont
  42                         boldfont hugefont disabledbackground hidebg disabledforeground
  43                         selectbackground enabledbackground selectforeground textbackground
  44                         texthighlightbackground enabledforeground
  45                 }
  46                 variable rest           {}
  47
  48                 method format_desc {in padding}
  49         }
  50 }
  51
  52
  53 body tlc::Baseconfig::constructor {args} { #<<<1
  54         array set descriptions {
  55                 help            "Display this help"
  56                 configfile      "The path of the config file\nOverride to point at a new location"
  57                 background      "The background colour of app"
  58                 fixedfont       ""
  59                 tinyfont        ""
  60                 smallfont       ""
  61                 normalfont      ""
  62                 boldfont        ""
  63                 hugefont        ""
  64         }
  65
  66         # Handle "--" marking end of args <<<
  67         set build       {}
  68         set rest        {}
  69         set divider     0
  70         set expecting_arg       1
  71         foreach a $args {
  72                 if {$divider} {
  73                         lappend rest    $a
  74                 } else {
  75                         if {$expecting_arg} {
  76                                 if {$a == "--"} {
  77                                         set divider     1
  78                                 } elseif {[string index $a 0] != "-"} {
  79                                         set divider     1
  80                                         lappend rest    $a
  81                                 } else {
  82                                         lappend build   $a
  83                                 }
  84                         } else {
  85                                 lappend build   $a
  86                         }
  87
  88                         set expecting_arg       [expr {!($expecting_arg)}]
  89                 }
  90         }
  91         set args        $build
  92         # Handle "--" marking end of args >>>
  93
  94         if {[lsearch $args -h] != -1 || [lsearch $args --help] != -1 || [lsearch $args -help] != -1} {
  95                 puts stderr ""
  96                 show_options
  97                 puts stderr ""
  98                 set ::errorInfo         ""
  99                 exit -1
 100         }
 101
 102         # for the configfile
 103         if {[catch {eval configure $args} msg]} {
 104                 puts stderr "$msg\n"
 105                 show_options
 106                 puts stderr ""
 107                 set ::errorInfo     ""
 108                 exit -1
 109         }
 110
 111         if {[file isfile $configfile]} {
 112                 set fp  [open $configfile r]
 113                 set dat [tlc::decomment [read $fp]]
 114                 close $fp
 115
 116                 foreach {option value} $dat {
 117                         if {$option == ""} continue
 118
 119                         configure -$option $value
 120                         set option      ""
 121                 }
 122         }
 123
 124         # allow the command line specified options to override the config file
 125         eval configure $args
 126 }
 127
 128 body tlc::Baseconfig::dump_config {} { #<<<1
 129         set build               {}
 130         foreach item [configure] {
 131                 foreach {name default value} $item {break}
 132                 lappend build [string range $name 1 end] $value
 133         }
 134
 135         return $build
 136 }
 137
 138
 139 body tlc::Baseconfig::get {key {default ""}} { #<<<1
 140         if {[catch {set value [cget -$key]} msg]} {
 141                 set value       $default
 142         }
 143
 144         return $value
 145 }
 146
 147
 148 body tlc::Baseconfig::show_options {} { #<<<1
 149         set general             {--help ""}
 150         set specific    {}
 151
 152         set options_header      "Options"
 153         set default_header      "Default Value"
 154         set desc_header         "Description"
 155
 156         set max_arg_len         [string length $options_header]
 157         set max_default_len     [string length $default_header]
 158         foreach opt [$this configure] {
 159                 foreach {name default current} $opt break
 160                 if {[string length $name] > $max_arg_len} {
 161                         set max_arg_len         [string length $name]
 162                 }
 163
 164                 if {[string length $default] > $max_default_len} {
 165                         set max_default_len     [string length $default]
 166                 }
 167
 168                 if {[lsearch $general_opts [string trimleft $name -]] == -1} {
 169                         lappend specific        $name $default
 170                 } else {
 171                         lappend general         $name $default
 172                 }
 173         }
 174
 175         incr max_default_len 2
 176         incr max_arg_len         4
 177
 178         puts stderr [format "%-${max_arg_len}s  %-${max_default_len}s  %-s" \
 179                         $options_header \
 180                         $default_header \
 181                         $desc_header]
 182
 183         set padding     [format "%-${max_arg_len}s  %-${max_default_len}s  " "" ""]
 184
 185         puts stderr "\nGeneral Options:"
 186         foreach {name default} $general {
 187                 set desc        ""
 188                 if {[info exists descriptions([string trimleft $name -])]} {
 189                         set desc        $descriptions([string trimleft $name -])
 190                 }
 191                 puts stderr [format "%-${max_arg_len}s  %-${max_default_len}s  %-s" \
 192                                 "    $name" \
 193                                 \"$default\" \
 194                                 [format_desc $desc $padding]]
 195         }
 196
 197         puts stderr "\nApplication Specific Options:"
 198         foreach {name default} $specific {
 199                 set desc        ""
 200                 if {[info exists descriptions([string trimleft $name -])]} {
 201                         set desc        $descriptions([string trimleft $name -])
 202                 }
 203                 puts stderr [format "%-${max_arg_len}s  %-${max_default_len}s  %-s" \
 204                                 "    $name" \
 205                                 \"$default\" \
 206                                 [format_desc $desc $padding]]
 207         }
 208 }
 209
 210
 211 body tlc::Baseconfig::format_desc {in padding} { #<<<1
 212         set desc        {}
 213         set i           0
 214         set width       [expr {80 - [string length $padding]}]
 215         set part        ""
 216         foreach char [split $in {}] {
 217                 if {$char == "\n"} {
 218                         lappend desc    [string trim $part]
 219                         set part        ""
 220                         set i           0
 221                         continue
 222                 }
 223                 append part $char
 224                 incr i
 225                 if {$i > $width} {
 226                         set idx         [string wordstart $part $i]
 227                         lappend desc    [string trim [string range $part 0 [expr {$idx-1}]]]
 228                         set part        [string range $part $idx end]
 229                         set i           [string length $part]
 230                 }
 231         }
 232         if {$part != ""} {
 233                 lappend desc    [string trim $part]
 234         }
 235
 236         return [join $desc "\n$padding"]
 237 }
 238
 239
 240 body tlc::Baseconfig::app_specific_opts {} { #<<<1
 241         set specific    {}
 242
 243         foreach opt [$this configure] {
 244                 foreach {name default current} $opt break
 245
 246                 if {[lsearch $general_opts [string trimleft $name -]] == -1} {
 247                         lappend specific        $name $default
 248                 }
 249         }
 250
 251         return $specific
 252 }
 253
 254
 255 body tlc::Baseconfig::rest {} { #<<<1
 256         return $rest
 257 }
 258
 259