Overview
| Comment: | Improved Critcl support |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA1: | a461844cd4c06ef333b92614ff6e64e338e5ad41 |
| User & Date: | rkeene on 2020-04-15 05:19:57 |
| Other Links: | manifest | tags |
Context
|
2020-05-02
| ||
| 21:00 | Fixed bug building SDK check-in: 18e328360d user: rkeene tags: trunk | |
|
2020-04-15
| ||
| 05:19 | Improved Critcl support check-in: a461844cd4 user: rkeene tags: trunk | |
| 04:07 | Added start of critcl support check-in: 528526c7d9 user: peter.piwowarski tags: trunk | |
Changes
Modified .fossil-settings/ignore-glob from [7f514b50e1] to [cfb0f49b9a].
83 83 zlib/build.log 84 84 zlib/inst 85 85 zlib/inst/* 86 86 zlib/out 87 87 zlib/out/* 88 88 zlib/src 89 89 zlib/src/* 90 +critcl/build/* 91 +critcl/build.log 92 +critcl/inst/* 93 +critcl/out/* 94 +critcl/src/* 90 95 tcc4tcl/build 91 96 tcc4tcl/build/* 92 97 tcc4tcl/build.log 93 98 tcc4tcl/inst 94 99 tcc4tcl/inst/* 95 100 tcc4tcl/out 96 101 tcc4tcl/out/*
Modified critcl/build.sh from [a9ff88ca8e] to [c2e5b35e3d].
1 1 #! /usr/bin/env bash 2 2 3 3 # BuildCompatible: KitCreator 4 4 5 5 version='3.1.18.1' 6 6 url="http://github.com/andreas-kupries/critcl/tarball/${version}/critcl-${version}.tar.gz" 7 7 sha256='c26893bda46dfda332d2e7d7410ae998eafda697169ea25b4256295d293089de' 8 +deps_dir="$(pwd)/deps" 8 9 9 10 function configure() { 10 11 : 11 12 } 12 13 13 14 function build() { 14 15 : 15 16 } 16 17 17 18 function install() { 18 19 local tclmajminvers 19 20 local critcl_cdir 21 + local critcl_target_info 22 + 23 + # Setup cross-compilation in the way Critcl expects, as best as possible 24 + if [ "${KC_CROSSCOMPILE}" = '0' ]; then 25 + critcl_target_info=() 26 + else 27 + critcl_target_info=(-target) 28 + case "${KC_CROSSCOMPILE_HOST_OS}" in 29 + aarch64-*-linux|aarch64-*-linux-*) 30 + critcl_target_info+=('linux-64-aarch64') 31 + ;; 32 + arm-*-linux-*|arm-*-linux) 33 + critcl_target_info+=('linux-arm') 34 + ;; 35 + i?86-*-linux-*|i?86-*-linux) 36 + critcl_target_info+=('linux-32-x86') 37 + ;; 38 + hppa64-*-hpux*) 39 + critcl_target_info+=('hpux-parisc64-cc') 40 + ;; 41 + i?86-*-solaris2.*) 42 + critcl_target_info+=('solaris-ix86-cc') 43 + #critcl_target_info+=('solaris-x86_64-cc') 44 + ;; 45 + i?86-*-mingw32*) 46 + critcl_target_info+=('mingw32') 47 + ;; 48 + x86_64-*-mingw32*) 49 + critcl_target_info+=('mingw32') 50 + ;; 51 + mips-*-linux-*|mips-*-linux|mipsel-*-linux-*|mipsel-*-linux|mipseb-*-linux-*|mipseb-*-linux) 52 + critcl_target_info+=('linux-32-mips') 53 + ;; 54 + powerpc-*-aix*) 55 + critcl_target_info+=('aix-powerpc-cc') 56 + ;; 57 + sparc-*-solaris2.*) 58 + critcl_target_info+=('solaris-sparc-cc') 59 + #critcl_target_info+=('solaris-sparc64-cc') 60 + ;; 61 + x86_64-*-linux-*|x86_64-*-linux) 62 + critcl_target_info+=('linux-64-x86_64') 63 + ;; 64 + *) 65 + echo "error: Critcl does not support cross-compiling to ${KC_CROSSCOMPILE_HOST_OS}" >&2 66 + return 1 67 + ;; 68 + esac 69 + fi 70 + 71 + # Include our Tcl packages directory, to ensure Critcl can be run 72 + export TCLLIBPATH="${deps_dir}" 20 73 74 + # Call the Critcl installer 21 75 mkdir -p "${installdir}/lib" || return 1 76 + "${TCLSH_NATIVE}" ./build.tcl install "${critcl_target_info[@]}" "${installdir}/lib" || return 1 22 77 23 - tclmajminvers="$(echo "${TCLVERS}" | cut -f 1-2 -d .)" 78 + # Critcl returns success even if it fails, so we need to double-check its work 79 + if [ "${KC_CROSSCOMPILE}" = '0' ]; then 80 + if [ ! -d "$(echo "${installdir}"/lib/*md5c*/)" ]; then 81 + return 1 82 + fi 83 + fi 24 84 25 - "${TCLSH_NATIVE}" ./build.tcl install "${installdir}/lib" || return 1 26 - 85 + # We only need to keep headers for a single version of Tcl, the one the kit was compiled 86 + # for 87 + tclmajminvers="$(echo "${TCLVERS}" | cut -f 1-2 -d .)" 27 88 critcl_cdir="$(echo "${installdir}/lib"/critcl*/critcl_c)" 28 89 29 90 mv "${critcl_cdir}/tcl${tclmajminvers}" "${critcl_cdir}/.keep-tcl" || return 1 30 91 rm -rf "${critcl_cdir}"/tcl*/ 31 92 mv "${critcl_cdir}/.keep-tcl" "${critcl_cdir}/tcl${tclmajminvers}" || return 1 32 93 33 94 return 0 34 95 }
Added critcl/deps/cmdline-1.5/cmdline.tcl version [1f5b095f09].
1 +# cmdline.tcl -- 2 +# 3 +# This package provides a utility for parsing command line 4 +# arguments that are processed by our various applications. 5 +# It also includes a utility routine to determine the 6 +# application name for use in command line errors. 7 +# 8 +# Copyright (c) 1998-2000 by Ajuba Solutions. 9 +# Copyright (c) 2001-2015 by Andreas Kupries <andreas_kupries@users.sf.net>. 10 +# Copyright (c) 2003 by David N. Welton <davidw@dedasys.com> 11 +# See the file "license.terms" for information on usage and redistribution 12 +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. 13 +# 14 +# RCS: @(#) $Id: cmdline.tcl,v 1.28 2011/02/23 17:41:52 andreas_kupries Exp $ 15 + 16 +package require Tcl 8.2 17 +package provide cmdline 1.5 18 + 19 +namespace eval ::cmdline { 20 + namespace export getArgv0 getopt getKnownOpt getfiles getoptions \ 21 + getKnownOptions usage 22 +} 23 + 24 +# ::cmdline::getopt -- 25 +# 26 +# The cmdline::getopt works in a fashion like the standard 27 +# C based getopt function. Given an option string and a 28 +# pointer to an array or args this command will process the 29 +# first argument and return info on how to proceed. 30 +# 31 +# Arguments: 32 +# argvVar Name of the argv list that you 33 +# want to process. If options are found the 34 +# arg list is modified and the processed arguments 35 +# are removed from the start of the list. 36 +# optstring A list of command options that the application 37 +# will accept. If the option ends in ".arg" the 38 +# getopt routine will use the next argument as 39 +# an argument to the option. Otherwise the option 40 +# is a boolean that is set to 1 if present. 41 +# optVar The variable pointed to by optVar 42 +# contains the option that was found (without the 43 +# leading '-' and without the .arg extension). 44 +# valVar Upon success, the variable pointed to by valVar 45 +# contains the value for the specified option. 46 +# This value comes from the command line for .arg 47 +# options, otherwise the value is 1. 48 +# If getopt fails, the valVar is filled with an 49 +# error message. 50 +# 51 +# Results: 52 +# The getopt function returns 1 if an option was found, 0 if no more 53 +# options were found, and -1 if an error occurred. 54 + 55 +proc ::cmdline::getopt {argvVar optstring optVar valVar} { 56 + upvar 1 $argvVar argsList 57 + upvar 1 $optVar option 58 + upvar 1 $valVar value 59 + 60 + set result [getKnownOpt argsList $optstring option value] 61 + 62 + if {$result < 0} { 63 + # Collapse unknown-option error into any-other-error result. 64 + set result -1 65 + } 66 + return $result 67 +} 68 + 69 +# ::cmdline::getKnownOpt -- 70 +# 71 +# The cmdline::getKnownOpt works in a fashion like the standard 72 +# C based getopt function. Given an option string and a 73 +# pointer to an array or args this command will process the 74 +# first argument and return info on how to proceed. 75 +# 76 +# Arguments: 77 +# argvVar Name of the argv list that you 78 +# want to process. If options are found the 79 +# arg list is modified and the processed arguments 80 +# are removed from the start of the list. Note that 81 +# unknown options and the args that follow them are 82 +# left in this list. 83 +# optstring A list of command options that the application 84 +# will accept. If the option ends in ".arg" the 85 +# getopt routine will use the next argument as 86 +# an argument to the option. Otherwise the option 87 +# is a boolean that is set to 1 if present. 88 +# optVar The variable pointed to by optVar 89 +# contains the option that was found (without the 90 +# leading '-' and without the .arg extension). 91 +# valVar Upon success, the variable pointed to by valVar 92 +# contains the value for the specified option. 93 +# This value comes from the command line for .arg 94 +# options, otherwise the value is 1. 95 +# If getopt fails, the valVar is filled with an 96 +# error message. 97 +# 98 +# Results: 99 +# The getKnownOpt function returns 1 if an option was found, 100 +# 0 if no more options were found, -1 if an unknown option was 101 +# encountered, and -2 if any other error occurred. 102 + 103 +proc ::cmdline::getKnownOpt {argvVar optstring optVar valVar} { 104 + upvar 1 $argvVar argsList 105 + upvar 1 $optVar option 106 + upvar 1 $valVar value 107 + 108 + # default settings for a normal return 109 + set value "" 110 + set option "" 111 + set result 0 112 + 113 + # check if we're past the end of the args list 114 + if {[llength $argsList] != 0} { 115 + 116 + # if we got -- or an option that doesn't begin with -, return (skipping 117 + # the --). otherwise process the option arg. 118 + switch -glob -- [set arg [lindex $argsList 0]] { 119 + "--" { 120 + set argsList [lrange $argsList 1 end] 121 + } 122 + "--*" - 123 + "-*" { 124 + set option [string range $arg 1 end] 125 + if {[string equal [string range $option 0 0] "-"]} { 126 + set option [string range $arg 2 end] 127 + } 128 + 129 + # support for format: [-]-option=value 130 + set idx [string first "=" $option 1] 131 + if {$idx != -1} { 132 + set _val [string range $option [expr {$idx+1}] end] 133 + set option [string range $option 0 [expr {$idx-1}]] 134 + } 135 + 136 + if {[lsearch -exact $optstring $option] != -1} { 137 + # Booleans are set to 1 when present 138 + set value 1 139 + set result 1 140 + set argsList [lrange $argsList 1 end] 141 + } elseif {[lsearch -exact $optstring "$option.arg"] != -1} { 142 + set result 1 143 + set argsList [lrange $argsList 1 end] 144 + 145 + if {[info exists _val]} { 146 + set value $_val 147 + } elseif {[llength $argsList]} { 148 + set value [lindex $argsList 0] 149 + set argsList [lrange $argsList 1 end] 150 + } else { 151 + set value "Option \"$option\" requires an argument" 152 + set result -2 153 + } 154 + } else { 155 + # Unknown option. 156 + set value "Illegal option \"-$option\"" 157 + set result -1 158 + } 159 + } 160 + default { 161 + # Skip ahead 162 + } 163 + } 164 + } 165 + 166 + return $result 167 +} 168 + 169 +# ::cmdline::getoptions -- 170 +# 171 +# Process a set of command line options, filling in defaults 172 +# for those not specified. This also generates an error message 173 +# that lists the allowed flags if an incorrect flag is specified. 174 +# 175 +# Arguments: 176 +# arglistVar The name of the argument list, typically argv. 177 +# We remove all known options and their args from it. 178 +# optlist A list-of-lists where each element specifies an option 179 +# in the form: 180 +# (where flag takes no argument) 181 +# flag comment 182 +# 183 +# (or where flag takes an argument) 184 +# flag default comment 185 +# 186 +# If flag ends in ".arg" then the value is taken from the 187 +# command line. Otherwise it is a boolean and appears in 188 +# the result if present on the command line. If flag ends 189 +# in ".secret", it will not be displayed in the usage. 190 +# usage Text to include in the usage display. Defaults to 191 +# "options:" 192 +# 193 +# Results 194 +# Name value pairs suitable for using with array set. 195 + 196 +proc ::cmdline::getoptions {arglistVar optlist {usage options:}} { 197 + upvar 1 $arglistVar argv 198 + 199 + set opts [GetOptionDefaults $optlist result] 200 + 201 + set argc [llength $argv] 202 + while {[set err [getopt argv $opts opt arg]]} { 203 + if {$err < 0} { 204 + set result(?) "" 205 + break 206 + } 207 + set result($opt) $arg 208 + } 209 + if {[info exist result(?)] || [info exists result(help)]} { 210 + Error [usage $optlist $usage] USAGE 211 + } 212 + return [array get result] 213 +} 214 + 215 +# ::cmdline::getKnownOptions -- 216 +# 217 +# Process a set of command line options, filling in defaults 218 +# for those not specified. This ignores unknown flags, but generates 219 +# an error message that lists the correct usage if a known option 220 +# is used incorrectly. 221 +# 222 +# Arguments: 223 +# arglistVar The name of the argument list, typically argv. This 224 +# We remove all known options and their args from it. 225 +# optlist A list-of-lists where each element specifies an option 226 +# in the form: 227 +# flag default comment 228 +# If flag ends in ".arg" then the value is taken from the 229 +# command line. Otherwise it is a boolean and appears in 230 +# the result if present on the command line. If flag ends 231 +# in ".secret", it will not be displayed in the usage. 232 +# usage Text to include in the usage display. Defaults to 233 +# "options:" 234 +# 235 +# Results 236 +# Name value pairs suitable for using with array set. 237 + 238 +proc ::cmdline::getKnownOptions {arglistVar optlist {usage options:}} { 239 + upvar 1 $arglistVar argv 240 + 241 + set opts [GetOptionDefaults $optlist result] 242 + 243 + # As we encounter them, keep the unknown options and their 244 + # arguments in this list. Before we return from this procedure, 245 + # we'll prepend these args to the argList so that the application 246 + # doesn't lose them. 247 + 248 + set unknownOptions [list] 249 + 250 + set argc [llength $argv] 251 + while {[set err [getKnownOpt argv $opts opt arg]]} { 252 + if {$err == -1} { 253 + # Unknown option. 254 + 255 + # Skip over any non-option items that follow it. 256 + # For now, add them to the list of unknownOptions. 257 + lappend unknownOptions [lindex $argv 0] 258 + set argv [lrange $argv 1 end] 259 + while {([llength $argv] != 0) \ 260 + && ![string match "-*" [lindex $argv 0]]} { 261 + lappend unknownOptions [lindex $argv 0] 262 + set argv [lrange $argv 1 end] 263 + } 264 + } elseif {$err == -2} { 265 + set result(?) "" 266 + break 267 + } else { 268 + set result($opt) $arg 269 + } 270 + } 271 + 272 + # Before returning, prepend the any unknown args back onto the 273 + # argList so that the application doesn't lose them. 274 + set argv [concat $unknownOptions $argv] 275 + 276 + if {[info exist result(?)] || [info exists result(help)]} { 277 + Error [usage $optlist $usage] USAGE 278 + } 279 + return [array get result] 280 +} 281 + 282 +# ::cmdline::GetOptionDefaults -- 283 +# 284 +# This internal procedure processes the option list (that was passed to 285 +# the getopt or getKnownOpt procedure). The defaultArray gets an index 286 +# for each option in the option list, the value of which is the option's 287 +# default value. 288 +# 289 +# Arguments: 290 +# optlist A list-of-lists where each element specifies an option 291 +# in the form: 292 +# flag default comment 293 +# If flag ends in ".arg" then the value is taken from the 294 +# command line. Otherwise it is a boolean and appears in 295 +# the result if present on the command line. If flag ends 296 +# in ".secret", it will not be displayed in the usage. 297 +# defaultArrayVar The name of the array in which to put argument defaults. 298 +# 299 +# Results 300 +# Name value pairs suitable for using with array set. 301 + 302 +proc ::cmdline::GetOptionDefaults {optlist defaultArrayVar} { 303 + upvar 1 $defaultArrayVar result 304 + 305 + set opts {? help} 306 + foreach opt $optlist { 307 + set name [lindex $opt 0] 308 + if {[regsub -- {\.secret$} $name {} name] == 1} { 309 + # Need to hide this from the usage display and getopt 310 + } 311 + lappend opts $name 312 + if {[regsub -- {\.arg$} $name {} name] == 1} { 313 + 314 + # Set defaults for those that take values. 315 + 316 + set default [lindex $opt 1] 317 + set result($name) $default 318 + } else { 319 + # The default for booleans is false 320 + set result($name) 0 321 + } 322 + } 323 + return $opts 324 +} 325 + 326 +# ::cmdline::usage -- 327 +# 328 +# Generate an error message that lists the allowed flags. 329 +# 330 +# Arguments: 331 +# optlist As for cmdline::getoptions 332 +# usage Text to include in the usage display. Defaults to 333 +# "options:" 334 +# 335 +# Results 336 +# A formatted usage message 337 + 338 +proc ::cmdline::usage {optlist {usage {options:}}} { 339 + set str "[getArgv0] $usage\n" 340 + foreach opt [concat $optlist \ 341 + {{- "Forcibly stop option processing"} {help "Print this message"} {? "Print this message"}}] { 342 + set name [lindex $opt 0] 343 + if {[regsub -- {\.secret$} $name {} name] == 1} { 344 + # Hidden option 345 + continue 346 + } 347 + if {[regsub -- {\.arg$} $name {} name] == 1} { 348 + set default [lindex $opt 1] 349 + set comment [lindex $opt 2] 350 + append str [format " %-20s %s <%s>\n" "-$name value" \ 351 + $comment $default] 352 + } else { 353 + set comment [lindex $opt 1] 354 + append str [format " %-20s %s\n" "-$name" $comment] 355 + } 356 + } 357 + return $str 358 +} 359 + 360 +# ::cmdline::getfiles -- 361 +# 362 +# Given a list of file arguments from the command line, compute 363 +# the set of valid files. On windows, file globbing is performed 364 +# on each argument. On Unix, only file existence is tested. If 365 +# a file argument produces no valid files, a warning is optionally 366 +# generated. 367 +# 368 +# This code also uses the full path for each file. If not 369 +# given it prepends [pwd] to the filename. This ensures that 370 +# these files will never conflict with files in our zip file. 371 +# 372 +# Arguments: 373 +# patterns The file patterns specified by the user. 374 +# quiet If this flag is set, no warnings will be generated. 375 +# 376 +# Results: 377 +# Returns the list of files that match the input patterns. 378 + 379 +proc ::cmdline::getfiles {patterns quiet} { 380 + set result {} 381 + if {$::tcl_platform(platform) == "windows"} { 382 + foreach pattern $patterns { 383 + set pat [file join $pattern] 384 + set files [glob -nocomplain -- $pat] 385 + if {$files == {}} { 386 + if {! $quiet} { 387 + puts stdout "warning: no files match \"$pattern\"" 388 + } 389 + } else { 390 + foreach file $files { 391 + lappend result $file 392 + } 393 + } 394 + } 395 + } else { 396 + set result $patterns 397 + } 398 + set files {} 399 + foreach file $result { 400 + # Make file an absolute path so that we will never conflict 401 + # with files that might be contained in our zip file. 402 + set fullPath [file join [pwd] $file] 403 + 404 + if {[file isfile $fullPath]} { 405 + lappend files $fullPath 406 + } elseif {! $quiet} { 407 + puts stdout "warning: no files match \"$file\"" 408 + } 409 + } 410 + return $files 411 +} 412 + 413 +# ::cmdline::getArgv0 -- 414 +# 415 +# This command returns the "sanitized" version of argv0. It will strip 416 +# off the leading path and remove the ".bin" extensions that our apps 417 +# use because they must be wrapped by a shell script. 418 +# 419 +# Arguments: 420 +# None. 421 +# 422 +# Results: 423 +# The application name that can be used in error messages. 424 + 425 +proc ::cmdline::getArgv0 {} { 426 + global argv0 427 + 428 + set name [file tail $argv0] 429 + return [file rootname $name] 430 +} 431 + 432 +## 433 +# ### ### ### ######### ######### ######### 434 +## 435 +# Now the typed versions of the above commands. 436 +## 437 +# ### ### ### ######### ######### ######### 438 +## 439 + 440 +# typedCmdline.tcl -- 441 +# 442 +# This package provides a utility for parsing typed command 443 +# line arguments that may be processed by various applications. 444 +# 445 +# Copyright (c) 2000 by Ross Palmer Mohn. 446 +# See the file "license.terms" for information on usage and redistribution 447 +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. 448 +# 449 +# RCS: @(#) $Id: cmdline.tcl,v 1.28 2011/02/23 17:41:52 andreas_kupries Exp $ 450 + 451 +namespace eval ::cmdline { 452 + namespace export typedGetopt typedGetoptions typedUsage 453 + 454 + # variable cmdline::charclasses -- 455 + # 456 + # Create regexp list of allowable character classes 457 + # from "string is" error message. 458 + # 459 + # Results: 460 + # String of character class names separated by "|" characters. 461 + 462 + variable charclasses 463 + #checker exclude badKey 464 + catch {string is . .} charclasses 465 + variable dummy 466 + regexp -- {must be (.+)$} $charclasses dummy charclasses 467 + regsub -all -- {, (or )?} $charclasses {|} charclasses 468 + unset dummy 469 +} 470 + 471 +# ::cmdline::typedGetopt -- 472 +# 473 +# The cmdline::typedGetopt works in a fashion like the standard 474 +# C based getopt function. Given an option string and a 475 +# pointer to a list of args this command will process the 476 +# first argument and return info on how to proceed. In addition, 477 +# you may specify a type for the argument to each option. 478 +# 479 +# Arguments: 480 +# argvVar Name of the argv list that you want to process. 481 +# If options are found, the arg list is modified 482 +# and the processed arguments are removed from the 483 +# start of the list. 484 +# 485 +# optstring A list of command options that the application 486 +# will accept. If the option ends in ".xxx", where 487 +# xxx is any valid character class to the tcl 488 +# command "string is", then typedGetopt routine will 489 +# use the next argument as a typed argument to the 490 +# option. The argument must match the specified 491 +# character classes (e.g. integer, double, boolean, 492 +# xdigit, etc.). Alternatively, you may specify 493 +# ".arg" for an untyped argument. 494 +# 495 +# optVar Upon success, the variable pointed to by optVar 496 +# contains the option that was found (without the 497 +# leading '-' and without the .xxx extension). If 498 +# typedGetopt fails the variable is set to the empty 499 +# string. SOMETIMES! Different for each -value! 500 +# 501 +# argVar Upon success, the variable pointed to by argVar 502 +# contains the argument for the specified option. 503 +# If typedGetopt fails, the variable is filled with 504 +# an error message. 505 +# 506 +# Argument type syntax: 507 +# Option that takes no argument. 508 +# foo 509 +# 510 +# Option that takes a typeless argument. 511 +# foo.arg 512 +# 513 +# Option that takes a typed argument. Allowable types are all 514 +# valid character classes to the tcl command "string is". 515 +# Currently must be one of alnum, alpha, ascii, control, 516 +# boolean, digit, double, false, graph, integer, lower, print, 517 +# punct, space, true, upper, wordchar, or xdigit. 518 +# foo.double 519 +# 520 +# Option that takes an argument from a list. 521 +# foo.(bar|blat) 522 +# 523 +# Argument quantifier syntax: 524 +# Option that takes an optional argument. 525 +# foo.arg? 526 +# 527 +# Option that takes a list of arguments terminated by "--". 528 +# foo.arg+ 529 +# 530 +# Option that takes an optional list of arguments terminated by "--". 531 +# foo.arg* 532 +# 533 +# Argument quantifiers work on all argument types, so, for 534 +# example, the following is a valid option specification. 535 +# foo.(bar|blat|blah)? 536 +# 537 +# Argument syntax miscellany: 538 +# Options may be specified on the command line using a unique, 539 +# shortened version of the option name. Given that program foo 540 +# has an option list of {bar.alpha blah.arg blat.double}, 541 +# "foo -b fob" returns an error, but "foo -ba fob" 542 +# successfully returns {bar fob} 543 +# 544 +# Results: 545 +# The typedGetopt function returns one of the following: 546 +# 1 a valid option was found 547 +# 0 no more options found to process 548 +# -1 invalid option 549 +# -2 missing argument to a valid option 550 +# -3 argument to a valid option does not match type 551 +# 552 +# Known Bugs: 553 +# When using options which include special glob characters, 554 +# you must use the exact option. Abbreviating it can cause 555 +# an error in the "cmdline::prefixSearch" procedure. 556 + 557 +proc ::cmdline::typedGetopt {argvVar optstring optVar argVar} { 558 + variable charclasses 559 + 560 + upvar $argvVar argsList 561 + 562 + upvar $optVar retvar 563 + upvar $argVar optarg 564 + 565 + # default settings for a normal return 566 + set optarg "" 567 + set retvar "" 568 + set retval 0 569 + 570 + # check if we're past the end of the args list 571 + if {[llength $argsList] != 0} { 572 + 573 + # if we got -- or an option that doesn't begin with -, return (skipping 574 + # the --). otherwise process the option arg. 575 + switch -glob -- [set arg [lindex $argsList 0]] { 576 + "--" { 577 + set argsList [lrange $argsList 1 end] 578 + } 579 + 580 + "-*" { 581 + # Create list of options without their argument extensions 582 + 583 + set optstr "" 584 + foreach str $optstring { 585 + lappend optstr [file rootname $str] 586 + } 587 + 588 + set _opt [string range $arg 1 end] 589 + 590 + set i [prefixSearch $optstr [file rootname $_opt]] 591 + if {$i != -1} { 592 + set opt [lindex $optstring $i] 593 + 594 + set quantifier "none" 595 + if {[regexp -- {\.[^.]+([?+*])$} $opt dummy quantifier]} { 596 + set opt [string range $opt 0 end-1] 597 + } 598 + 599 + if {[string first . $opt] == -1} { 600 + set retval 1 601 + set retvar $opt 602 + set argsList [lrange $argsList 1 end] 603 + 604 + } elseif {[regexp -- "\\.(arg|$charclasses)\$" $opt dummy charclass] 605 + || [regexp -- {\.\(([^)]+)\)} $opt dummy charclass]} { 606 + if {[string equal arg $charclass]} { 607 + set type arg 608 + } elseif {[regexp -- "^($charclasses)\$" $charclass]} { 609 + set type class 610 + } else { 611 + set type oneof 612 + } 613 + 614 + set argsList [lrange $argsList 1 end] 615 + set opt [file rootname $opt] 616 + 617 + while {1} { 618 + if {[llength $argsList] == 0 619 + || [string equal "--" [lindex $argsList 0]]} { 620 + if {[string equal "--" [lindex $argsList 0]]} { 621 + set argsList [lrange $argsList 1 end] 622 + } 623 + 624 + set oneof "" 625 + if {$type == "arg"} { 626 + set charclass an 627 + } elseif {$type == "oneof"} { 628 + set oneof ", one of $charclass" 629 + set charclass an 630 + } 631 + 632 + if {$quantifier == "?"} { 633 + set retval 1 634 + set retvar $opt 635 + set optarg "" 636 + } elseif {$quantifier == "+"} { 637 + set retvar $opt 638 + if {[llength $optarg] < 1} { 639 + set retval -2 640 + set optarg "Option requires at least one $charclass argument$oneof -- $opt" 641 + } else { 642 + set retval 1 643 + } 644 + } elseif {$quantifier == "*"} { 645 + set retval 1 646 + set retvar $opt 647 + } else { 648 + set optarg "Option requires $charclass argument$oneof -- $opt" 649 + set retvar $opt 650 + set retval -2 651 + } 652 + set quantifier "" 653 + } elseif {($type == "arg") 654 + || (($type == "oneof") 655 + && [string first "|[lindex $argsList 0]|" "|$charclass|"] != -1) 656 + || (($type == "class") 657 + && [string is $charclass [lindex $argsList 0]])} { 658 + set retval 1 659 + set retvar $opt 660 + lappend optarg [lindex $argsList 0] 661 + set argsList [lrange $argsList 1 end] 662 + } else { 663 + set oneof "" 664 + if {$type == "arg"} { 665 + set charclass an 666 + } elseif {$type == "oneof"} { 667 + set oneof ", one of $charclass" 668 + set charclass an 669 + } 670 + set optarg "Option requires $charclass argument$oneof -- $opt" 671 + set retvar $opt 672 + set retval -3 673 + 674 + if {$quantifier == "?"} { 675 + set retval 1 676 + set optarg "" 677 + } 678 + set quantifier "" 679 + } 680 + if {![regexp -- {[+*]} $quantifier]} { 681 + break; 682 + } 683 + } 684 + } else { 685 + Error \ 686 + "Illegal option type specification: must be one of $charclasses" \ 687 + BAD OPTION TYPE 688 + } 689 + } else { 690 + set optarg "Illegal option -- $_opt" 691 + set retvar $_opt 692 + set retval -1 693 + } 694 + } 695 + default { 696 + # Skip ahead 697 + } 698 + } 699 + } 700 + 701 + return $retval 702 +} 703 + 704 +# ::cmdline::typedGetoptions -- 705 +# 706 +# Process a set of command line options, filling in defaults 707 +# for those not specified. This also generates an error message 708 +# that lists the allowed options if an incorrect option is 709 +# specified. 710 +# 711 +# Arguments: 712 +# arglistVar The name of the argument list, typically argv 713 +# optlist A list-of-lists where each element specifies an option 714 +# in the form: 715 +# 716 +# option default comment 717 +# 718 +# Options formatting is as described for the optstring 719 +# argument of typedGetopt. Default is for optionally 720 +# specifying a default value. Comment is for optionally 721 +# specifying a comment for the usage display. The 722 +# options "--", "-help", and "-?" are automatically included 723 +# in optlist. 724 +# 725 +# Argument syntax miscellany: 726 +# Options formatting and syntax is as described in typedGetopt. 727 +# There are two additional suffixes that may be applied when 728 +# passing options to typedGetoptions. 729 +# 730 +# You may add ".multi" as a suffix to any option. For options 731 +# that take an argument, this means that the option may be used 732 +# more than once on the command line and that each additional 733 +# argument will be appended to a list, which is then returned 734 +# to the application. 735 +# foo.double.multi 736 +# 737 +# If a non-argument option is specified as ".multi", it is 738 +# toggled on and off for each time it is used on the command 739 +# line. 740 +# foo.multi 741 +# 742 +# If an option specification does not contain the ".multi" 743 +# suffix, it is not an error to use an option more than once. 744 +# In this case, the behavior for options with arguments is that 745 +# the last argument is the one that will be returned. For 746 +# options that do not take arguments, using them more than once 747 +# has no additional effect. 748 +# 749 +# Options may also be hidden from the usage display by 750 +# appending the suffix ".secret" to any option specification. 751 +# Please note that the ".secret" suffix must be the last suffix, 752 +# after any argument type specification and ".multi" suffix. 753 +# foo.xdigit.multi.secret 754 +# 755 +# Results 756 +# Name value pairs suitable for using with array set. 757 + 758 +proc ::cmdline::typedGetoptions {arglistVar optlist {usage options:}} { 759 + variable charclasses 760 + 761 + upvar 1 $arglistVar argv 762 + 763 + set opts {? help} 764 + foreach opt $optlist { 765 + set name [lindex $opt 0] 766 + if {[regsub -- {\.secret$} $name {} name] == 1} { 767 + # Remove this extension before passing to typedGetopt. 768 + } 769 + if {[regsub -- {\.multi$} $name {} name] == 1} { 770 + # Remove this extension before passing to typedGetopt. 771 + 772 + regsub -- {\..*$} $name {} temp 773 + set multi($temp) 1 774 + } 775 + lappend opts $name 776 + if {[regsub -- "\\.(arg|$charclasses|\\(.+).?\$" $name {} name] == 1} { 777 + # Set defaults for those that take values. 778 + # Booleans are set just by being present, or not 779 + 780 + set dflt [lindex $opt 1] 781 + if {$dflt != {}} { 782 + set defaults($name) $dflt 783 + } 784 + } 785 + } 786 + set argc [llength $argv] 787 + while {[set err [typedGetopt argv $opts opt arg]]} { 788 + if {$err == 1} { 789 + if {[info exists result($opt)] 790 + && [info exists multi($opt)]} { 791 + # Toggle boolean options or append new arguments 792 + 793 + if {$arg == ""} { 794 + unset result($opt) 795 + } else { 796 + set result($opt) "$result($opt) $arg" 797 + } 798 + } else { 799 + set result($opt) "$arg" 800 + } 801 + } elseif {($err == -1) || ($err == -3)} { 802 + Error [typedUsage $optlist $usage] USAGE 803 + } elseif {$err == -2 && ![info exists defaults($opt)]} { 804 + Error [typedUsage $optlist $usage] USAGE 805 + } 806 + } 807 + if {[info exists result(?)] || [info exists result(help)]} { 808 + Error [typedUsage $optlist $usage] USAGE 809 + } 810 + foreach {opt dflt} [array get defaults] { 811 + if {![info exists result($opt)]} { 812 + set result($opt) $dflt 813 + } 814 + } 815 + return [array get result] 816 +} 817 + 818 +# ::cmdline::typedUsage -- 819 +# 820 +# Generate an error message that lists the allowed flags, 821 +# type of argument taken (if any), default value (if any), 822 +# and an optional description. 823 +# 824 +# Arguments: 825 +# optlist As for cmdline::typedGetoptions 826 +# 827 +# Results 828 +# A formatted usage message 829 + 830 +proc ::cmdline::typedUsage {optlist {usage {options:}}} { 831 + variable charclasses 832 + 833 + set str "[getArgv0] $usage\n" 834 + foreach opt [concat $optlist \ 835 + {{help "Print this message"} {? "Print this message"}}] { 836 + set name [lindex $opt 0] 837 + if {[regsub -- {\.secret$} $name {} name] == 1} { 838 + # Hidden option 839 + 840 + } else { 841 + if {[regsub -- {\.multi$} $name {} name] == 1} { 842 + # Display something about multiple options 843 + } 844 + 845 + if {[regexp -- "\\.(arg|$charclasses)\$" $name dummy charclass] 846 + || [regexp -- {\.\(([^)]+)\)} $opt dummy charclass]} { 847 + regsub -- "\\..+\$" $name {} name 848 + set comment [lindex $opt 2] 849 + set default "<[lindex $opt 1]>" 850 + if {$default == "<>"} { 851 + set default "" 852 + } 853 + append str [format " %-20s %s %s\n" "-$name $charclass" \ 854 + $comment $default] 855 + } else { 856 + set comment [lindex $opt 1] 857 + append str [format " %-20s %s\n" "-$name" $comment] 858 + } 859 + } 860 + } 861 + return $str 862 +} 863 + 864 +# ::cmdline::prefixSearch -- 865 +# 866 +# Search a Tcl list for a pattern; searches first for an exact match, 867 +# and if that fails, for a unique prefix that matches the pattern 868 +# (i.e, first "lsearch -exact", then "lsearch -glob $pattern*" 869 +# 870 +# Arguments: 871 +# list list of words 872 +# pattern word to search for 873 +# 874 +# Results: 875 +# Index of found word is returned. If no exact match or 876 +# unique short version is found then -1 is returned. 877 + 878 +proc ::cmdline::prefixSearch {list pattern} { 879 + # Check for an exact match 880 + 881 + if {[set pos [::lsearch -exact $list $pattern]] > -1} { 882 + return $pos 883 + } 884 + 885 + # Check for a unique short version 886 + 887 + set slist [lsort $list] 888 + if {[set pos [::lsearch -glob $slist $pattern*]] > -1} { 889 + # What if there is nothing for the check variable? 890 + 891 + set check [lindex $slist [expr {$pos + 1}]] 892 + if {[string first $pattern $check] != 0} { 893 + return [::lsearch -exact $list [lindex $slist $pos]] 894 + } 895 + } 896 + return -1 897 +} 898 +# ::cmdline::Error -- 899 +# 900 +# Internal helper to throw errors with a proper error-code attached. 901 +# 902 +# Arguments: 903 +# message text of the error message to throw. 904 +# args additional parts of the error code to use, 905 +# with CMDLINE as basic prefix added by this command. 906 +# 907 +# Results: 908 +# An error is thrown, always. 909 + 910 +proc ::cmdline::Error {message args} { 911 + return -code error -errorcode [linsert $args 0 CMDLINE] $message 912 +}
Added critcl/deps/cmdline-1.5/pkgIndex.tcl version [ecb143145f].
1 +if {![package vsatisfies [package provide Tcl] 8.2]} {return} 2 +package ifneeded cmdline 1.5 [list source [file join $dir cmdline.tcl]]
Added critcl/patches/critcl-3.1.18.1-usetclmd5.diff version [3e38fa90c6].
1 +diff -uNr andreas-kupries-critcl-f7fdaa5.orig/build.tcl andreas-kupries-critcl-f7fdaa5-usetclmd5/build.tcl 2 +--- andreas-kupries-critcl-f7fdaa5.orig/build.tcl 2020-02-18 22:07:06.000000000 -0600 3 ++++ andreas-kupries-critcl-f7fdaa5-usetclmd5/build.tcl 2020-04-15 00:14:19.173179709 -0500 4 +@@ -486,6 +486,10 @@ 5 + 6 + puts "${prefix}Installed application: $theapp" 7 + 8 ++ # Critcl does not meaningfully support cross-compilation, elide 9 ++ # these packages when being cross-compiled 10 ++if {$target eq {}} { 11 ++ 12 + # Special package: critcl_md5c 13 + # Local MD5 hash implementation. 14 + 15 +@@ -558,6 +562,7 @@ 16 + puts "${prefix}Installed package: $dst" 17 + puts "${prefix}Installed headers: [ 18 + file join $dsti critcl_callback]" 19 ++} 20 + 21 + } msg]} { 22 + if {![string match {*permission denied*} $msg]} { 23 +diff -uNr andreas-kupries-critcl-f7fdaa5.orig/lib/critcl/critcl.tcl andreas-kupries-critcl-f7fdaa5-usetclmd5/lib/critcl/critcl.tcl 24 +--- andreas-kupries-critcl-f7fdaa5.orig/lib/critcl/critcl.tcl 2020-02-18 22:07:06.000000000 -0600 25 ++++ andreas-kupries-critcl-f7fdaa5-usetclmd5/lib/critcl/critcl.tcl 2020-04-15 00:15:51.782180320 -0500 26 +@@ -55,8 +55,8 @@ 27 + if {$v::uuidcounter} { 28 + return [format %032d [incr v::uuidcounter]] 29 + } 30 +- package require critcl_md5c 31 +- binary scan [md5c $s] H* md; return $md 32 ++ package require md5 33 ++ binary scan [::md5 $s] H* md; return $md 34 + } 35 + 36 + # # ## ### ##### ######## ############# #####################