Mercurial > nand-ecoscentric
annotate packages/pkgconf.tcl @ 14:01ce82f3e11a ecos-sw-1999-06-11
Merge from eCos master repository on 1999-06-11-17:05:41-BST
| author | jlarmour |
|---|---|
| date | Fri, 11 Jun 1999 09:36:56 +0000 |
| parents | 4cc3eff958ab |
| children | 41bd4f3a90de |
| rev | line source |
|---|---|
| 0 | 1 # {{{ Banner |
| 2 | |
| 3 #=============================================================================== | |
| 4 # | |
| 5 # pkgconf.tcl | |
| 6 # | |
| 7 # A temporary build system for target-side software. | |
| 8 # | |
| 9 #=============================================================================== | |
| 10 #####COPYRIGHTBEGIN#### | |
| 11 # | |
| 12 # ------------------------------------------- | |
| 13 # The contents of this file are subject to the Cygnus eCos Public License | |
| 14 # Version 1.0 (the "License"); you may not use this file except in | |
| 15 # compliance with the License. You may obtain a copy of the License at | |
| 16 # http://sourceware.cygnus.com/ecos | |
| 17 # | |
| 18 # Software distributed under the License is distributed on an "AS IS" | |
| 19 # basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the | |
| 20 # License for the specific language governing rights and limitations under | |
| 21 # the License. | |
| 22 # | |
| 23 # The Original Code is eCos - Embedded Cygnus Operating System, released | |
| 24 # September 30, 1998. | |
| 25 # | |
| 26 # The Initial Developer of the Original Code is Cygnus. Portions created | |
| 2 | 27 # by Cygnus are Copyright (C) 1998,1999 Cygnus Solutions. All Rights Reserved. |
| 0 | 28 # ------------------------------------------- |
| 29 # | |
| 30 #####COPYRIGHTEND#### | |
| 31 #=============================================================================== | |
| 32 ######DESCRIPTIONBEGIN#### | |
| 33 # | |
| 34 # Author(s): bartv | |
| 35 # Contributors: bartv | |
| 36 # Date: 1998-04-10 | |
| 37 # Purpose: To generate a build tree (aka a configuration directory) | |
| 38 # and fill in basic configurability information. | |
| 39 # Description: | |
| 40 # Usage: | |
| 41 # | |
| 42 #####DESCRIPTIONEND#### | |
| 43 #=============================================================================== | |
| 44 # | |
| 45 | |
| 46 # }}} | |
| 47 | |
| 48 # {{{ Version check | |
| 49 | |
| 50 # ---------------------------------------------------------------------------- | |
| 51 # pkgconf.tcl requires at least version 8.0 of Tcl, since it makes use of | |
| 52 # namespaces. It is possible that some users still have older versions. | |
| 53 | |
| 54 if { [info tclversion] < 8.0 } { | |
| 55 puts "You are running Tcl version [info tclversion], patchlevel [info patchlevel]" | |
| 56 puts "The pkgconf.tcl script requires version 8.0 or later." | |
| 57 puts "Tcl is open source software and can be readily obtained via the internet." | |
| 58 puts "Good starting places for more information include www.tclconsortium.org" | |
| 59 puts "and www.scriptics.com" | |
| 60 exit 0 | |
| 61 } | |
| 62 | |
| 63 # }}} | |
| 64 # {{{ Namespace definition | |
| 65 | |
| 66 # ---------------------------------------------------------------------------- | |
| 67 # Namespaces. All code and variables in this script are kept in the namespace | |
| 68 # "pkgconf". This is not really necessary for stand-alone operation, but if it | |
| 69 # ever becomes desirable to embed this script in a larger application then | |
| 70 # using a namespace is a lot easier. | |
| 71 # | |
| 72 # As a fringe benefit, all global variables can be declared inside this | |
| 73 # namespace and initialised. | |
| 74 # | |
| 75 | |
| 76 namespace eval pkgconf { | |
| 77 | |
| 78 # Is this program running on a real operating system or under Windows ? | |
| 79 variable windows_host [expr {$tcl_platform(platform) == "windows"}] | |
| 80 | |
| 81 # Is this script running in command-line or GUI mode ? This is determined | |
| 82 # in large part by the command used to invoke the script. | |
| 83 variable gui_mode 0 | |
| 84 | |
| 85 # Keep track of whether or not GUI mode is possible at all. If | |
| 86 # TK is not loaded into the current interpreter then only | |
| 87 # command-line operation is possible. | |
| 88 variable gui_possible 0 | |
| 89 | |
| 90 # Where is the component repository ? The following input sources | |
| 91 # are available: | |
| 92 # 1) the command line argument --srcdir. This requires | |
| 93 # the arguments to be parsed early on. | |
| 94 # 2) the environment variable PKGCONF_COMPONENT_REPOSITORY. | |
| 95 # 3) $argv0 should correspond to the location of the pkgconf.tcl | |
| 96 # script. | |
| 97 # | |
| 98 variable component_repository "" | |
| 99 if { [info exists ::env(PKGCONF_COMPONENT_REPOSITORY)] } { | |
| 100 set component_repository $::env(PKGCONF_COMPONENT_REPOSITORY) | |
| 101 } else { | |
| 102 # Care has to be taken not to end up with a spurious /. at the end, | |
| 103 # since that would confuse later checks of component_repository != build_tree | |
| 104 set component_repository [pwd] | |
| 105 if { [file dirname $argv0] != "." } { | |
| 106 set component_repository [file join $component_repository [file dirname $argv0]] | |
| 107 } | |
| 108 } | |
| 109 | |
| 110 # Where is the build tree ? This can be specified using the command | |
| 111 # line argument --builddir, the environment variable PKGCONF_BUILD_TREE, | |
| 112 # or it defaults to the current directory (in accordance with the | |
| 113 # normal behaviour of configure scripts). | |
| 114 variable build_tree "" | |
| 115 if { [info exists ::env(PKGCONF_BUILD_TREE)] } { | |
| 116 set build_tree $::env(PKGCONF_BUILD_TREE) | |
| 117 } else { | |
| 118 set build_tree [pwd] | |
| 119 } | |
| 120 | |
| 121 # Details of the command line arguments, if any. | |
| 122 variable list_targets_arg 0; # --targets | |
| 123 variable list_packages_arg 0; # --packages | |
| 124 variable list_pkgdata_arg 0; # --pkgdata | |
| 125 variable list_flags_arg 0; # --flags | |
| 126 variable no_windows_arg 0; # --nw | |
| 127 variable target_arg ""; # --target=abc | |
| 128 variable platform_arg ""; # --platform=sim | |
| 129 variable startup_arg ""; # --platform=rom | |
| 130 variable prefix_arg ""; # --prefix=/tmp/install | |
| 131 variable disable_args ""; # --disable-uitron | |
| 132 # This is a list of all disabled packages. | |
| 133 variable enable_args ""; # --enable-uitron, as above. | |
| 134 array set version_args {}; # --kernel_version=v0.3 | |
| 135 # This is an array indexed by package name. | |
| 136 array set cflags_args {}; # DBGFLAGS="-Wall -Werror" | |
| 137 # This is an array indexed by flag name. | |
| 138 variable force_arg 0; # Forcibly overwrite configuration files. | |
| 139 variable defaults_arg 0; # Do not use the values from the save file. | |
| 140 variable use_links_arg 0; # Make use of symbolic links. | |
| 141 variable use_copies_arg 0; # The inverse. | |
| 2 | 142 variable debug_arg 0; # --debug, control infrastructure options |
| 143 variable nodebug_arg 0; # --nodebug, ditto | |
| 0 | 144 |
| 145 # Details of all known packages. These come out of the packages file. | |
| 146 # The variable known_packages is a simple list, and the rest of the | |
| 147 # data is held in an array package_data(). | |
| 148 variable known_packages "" | |
| 149 array set package_data {}; | |
| 150 | |
| 151 # Details of all known targets, as supplied by the targets file. | |
| 152 # The variable known_targets is a simple list, and the rest of the | |
| 153 # data is held in an array target_data. | |
| 154 variable known_targets "" | |
| 155 array set target_data {}; | |
| 156 | |
| 157 # Details of all the compiler flags that can be used within the | |
| 158 # build system. | |
| 159 variable known_compiler_flags { | |
| 160 ARCHFLAGS CARCHFLAGS CXXARCHFLAGS LDARCHFLAGS | |
| 161 ERRFLAGS CERRFLAGS CXXERRFLAGS LDERRFLAGS | |
| 162 LANGFLAGS CLANGFLAGS CXXLANGFLAGS LDLANGFLAGS | |
| 163 DBGFLAGS CDBGFLAGS CXXDBGFLAGS LDDBGFLAGS | |
| 164 EXTRAFLAGS CEXTRAFLAGS CXXEXTRAFLAGS LDEXTRAFLAGS | |
| 165 } | |
| 166 | |
| 167 # Details of the current configuration values. It is convenient | |
| 168 # to store these in an array as well. The array gets filled in by | |
| 169 # pkgconf::setup_defaults | |
| 170 array set config_data {}; | |
| 171 | |
| 172 # Contents of the current save file, if any. | |
| 173 array set saved_data {}; | |
| 174 | |
| 175 # These variables are used by the code that creates the build tree | |
| 176 variable inc_dirs; # For each package with exported header | |
| 177 # files, the path to those header files | |
| 178 # relative to either the component repository | |
| 179 # or the build tree. | |
| 2 | 180 variable misc_dirs; # Ditto for package misc directories. |
| 0 | 181 variable tests_dirs; # Ditto for package tests directories. |
| 182 variable src_dirs; # Ditto for src directories. | |
| 183 | |
| 184 variable install_inc_dirs; # Names of all the directories that should | |
| 185 # exist below install/include, including pkgconf. | |
| 186 variable install_inc_files; # Ditto for all the files, but excluding | |
| 187 # ones in pkgconf. | |
| 188 variable pkgconf_files; # Names of all the configuration headers | |
| 189 variable install_test_dirs; # What directories should be created in install/tests | |
| 190 | |
| 191 # What routines should be invoked for outputting fatal errors and | |
| 192 # for warning messages ? | |
| 193 variable fatal_error_handler pkgconf::cli_fatal_error | |
| 194 variable warning_handler pkgconf::cli_warning | |
| 195 variable report_handler pkgconf::cli_report | |
| 196 } | |
| 197 | |
| 198 # }}} | |
| 199 # {{{ Infrastructure | |
| 200 | |
| 201 # ---------------------------------------------------------------------------- | |
| 202 # Minimal infrastructure support. | |
| 203 # | |
| 204 # There must be some way of reporting fatal errors, of outputting warnings, | |
| 205 # and of generating report messages. The implementation of these things | |
| 206 # obviously depends on whether or not TK is present. In addition, if this | |
| 207 # script is being run inside a larger application then that larger | |
| 208 # application must be able to install its own versions of the routines. | |
| 209 # | |
| 210 # Once it is possible to report fatal errors, an assertion facility becomes | |
| 211 # feasible. | |
| 212 # | |
| 213 | |
| 214 # | |
| 215 # These routines output fatal errors, warnings or miscellaneous messages. | |
| 216 # Their implementations depend on the mode in which this script is operating. | |
| 217 # | |
| 218 proc pkgconf::fatal_error { msg } { | |
| 219 $pkgconf::fatal_error_handler "$msg" | |
| 220 } | |
| 221 | |
| 222 proc pkgconf::warning { msg } { | |
| 223 $pkgconf::warning_handler "$msg" | |
| 224 } | |
| 225 | |
| 226 proc pkgconf::report { msg } { | |
| 227 $pkgconf::report_handler "$msg" | |
| 228 } | |
| 229 | |
| 230 # | |
| 231 # Command line versions. | |
| 232 # NOTE: some formatting so that there are linebreaks at ~72 columns would be | |
| 233 # a good idea. | |
| 234 # | |
| 235 proc pkgconf::cli_fatal_error_handler { msg } { | |
| 236 puts "pkgconf fatal error: $msg" | |
| 237 exit 1 | |
| 238 } | |
| 239 | |
| 240 proc pkgconf::cli_warning_handler { msg } { | |
| 241 puts "pkgconf warning: $msg" | |
| 242 } | |
| 243 | |
| 244 proc pkgconf::cli_report_handler { msg } { | |
| 245 puts "$msg" | |
| 246 } | |
| 247 | |
| 248 # | |
| 249 # Determine the default destination for warnings and for fatal errors. | |
| 250 # In GUI mode message boxes should be used, otherwise the text should just | |
| 251 # go to stdout (stderr is more dubious). | |
| 252 # | |
| 253 # This routine gets invoked before any command line arguments have | |
| 254 # been processed, to set up a sensible default. It gets invoked again | |
| 255 # afterwards, since there may have been a change between GUI and CLI | |
| 256 # mode. | |
| 257 # | |
| 258 # After the first call to this function it is possible to use assertions. | |
| 259 # | |
| 260 proc pkgconf::initialise_error_handling { } { | |
| 261 | |
| 262 if { $pkgconf::gui_mode } { | |
| 263 set pkgconf::fatal_error_handler pkgconf::gui_fatal_error_handler | |
| 264 set pkgconf::warning_handler pkgconf::gui_warning_handler | |
| 265 set pkgconf::report_handler pkgconf::gui_report_handler | |
| 266 } else { | |
| 267 set pkgconf::fatal_error_handler pkgconf::cli_fatal_error_handler | |
| 268 set pkgconf::warning_handler pkgconf::cli_warning_handler | |
| 269 set pkgconf::report_handler pkgconf::cli_report_handler | |
| 270 } | |
| 271 } | |
| 272 | |
| 273 # | |
| 274 # These routines can be used by containing programs to provide their | |
| 275 # own error handling. | |
| 276 # | |
| 277 proc pkgconf::set_fatal_error_handler { fn } { | |
| 278 ASSERT { $fn != "" } | |
| 279 set pkgconf::fatal_error_handler $fn | |
| 280 } | |
| 281 | |
| 282 proc pkgconf::set_warning_handler { fn } { | |
| 283 ASSERT { $fn != "" } | |
| 284 set pkgconf::warning_handler $fn | |
| 285 } | |
| 286 | |
| 287 proc pkgconf::set_report_handler { fn } { | |
| 288 ASSERT { $fn != "" } | |
| 289 set pkgconf::report_handler $fn | |
| 290 } | |
| 291 | |
| 292 # | |
| 293 # A very simple assertion facility. It takes a single argument, an expression | |
| 294 # that should be evaluated in the calling function's scope, and on failure it | |
| 295 # should generate a fatal error. | |
| 296 # | |
| 297 proc pkgconf::ASSERT { condition } { | |
| 298 | |
| 299 set result [uplevel 1 [list expr $condition]] | |
| 300 | |
| 301 if { $result == 0 } { | |
| 302 fatal_error "Assertion failure.\nPredicate \"$condition\"\nThe failure occurred in \"[info level -1]\"" | |
| 303 } | |
| 304 } | |
| 305 | |
| 306 # }}} | |
| 307 # {{{ Utilities | |
| 308 | |
| 309 # ---------------------------------------------------------------------------- | |
| 310 # cdl_compare_version. This is a partial implementation of the full | |
| 311 # cdl_compare_version facility defined in the product specification. Its | |
| 312 # purpose is to order the various versions of a given package with | |
| 313 # the most recent version first. As a special case, "current" is | |
| 314 # always considered the most recent. | |
| 315 # | |
| 316 # There are similarities between cdl_compare_version and with Tcl's | |
| 317 # package vcompare, but cdl_compare_version is more general. | |
| 318 # | |
| 319 | |
| 320 proc pkgconf::cdl_compare_version { arg1 arg2 } { | |
| 321 | |
| 322 if { $arg1 == $arg2 } { | |
| 323 return 0 | |
| 324 } | |
| 325 if { $arg1 == "current"} { | |
| 326 return -1 | |
| 327 } | |
| 328 if { $arg2 == "current" } { | |
| 329 return 1 | |
| 330 } | |
| 331 | |
| 332 set index1 0 | |
| 333 set index2 0 | |
| 334 set ch1 "" | |
| 335 set ch2 "" | |
| 336 set num1 "" | |
| 337 set num2 "" | |
| 338 | |
| 339 while { 1} { | |
| 340 | |
| 341 set ch1 [string index $arg1 $index1] | |
| 342 set ch2 [string index $arg2 $index2] | |
| 343 set num1 "" | |
| 344 set num2 "" | |
| 345 | |
| 346 if { ($ch1 == "") && ($ch2 == "") } { | |
| 347 | |
| 348 # Both strings have terminated at the same time. There may have | |
| 349 # been some spurious leading zeroes in numbers. | |
| 350 return 0 | |
| 351 | |
| 352 } elseif { $ch1 == "" } { | |
| 353 | |
| 354 # The first string has ended first. If ch2 is a separator then | |
| 355 # arg2 is a derived version, e.g. v0.3.p1 and hence newer. Otherwise ch2 | |
| 356 # is an experimental version v0.3beta and hence older. | |
| 357 if { [string match \[-._\] $ch2] } { | |
| 358 return 1 | |
| 359 } else { | |
| 360 return -1 | |
| 361 } | |
| 362 } elseif { $ch2 == "" } { | |
| 363 | |
| 364 # Equivalent to the above. | |
| 365 if { [string match \[-._\] $ch1] } { | |
| 366 return -1 | |
| 367 } else { | |
| 368 return 1 | |
| 369 } | |
| 370 } | |
| 371 | |
| 372 # There is still data to be processed. | |
| 373 # Check for both strings containing numbers at the current index. | |
| 374 if { ( [string match \[0-9\] $ch1] ) && ( [string match \[0-9\] $ch2] ) } { | |
| 375 | |
| 376 # Extract the entire numbers from the version string. | |
| 377 while { [string match \[0-9\] $ch1] } { | |
| 378 set num1 "$num1$ch1" | |
| 379 incr index1 | |
| 380 set ch1 [string index $arg1 $index1] | |
| 381 } | |
| 382 while { [string match \[0-9\] $ch2] } { | |
| 383 set num2 "$num2$ch2" | |
| 384 incr index2 | |
| 385 set ch2 [string index $arg2 $index2] | |
| 386 } | |
| 387 | |
| 388 if { $num1 < $num2 } { | |
| 389 return 1 | |
| 390 } elseif { $num1 > $num2 } { | |
| 391 return -1 | |
| 392 } | |
| 393 continue | |
| 394 } | |
| 395 | |
| 396 # This is not numerical data. If the two characters are the same then | |
| 397 # move on. | |
| 398 if { $ch1 == $ch2 } { | |
| 399 incr index1 | |
| 400 incr index2 | |
| 401 continue | |
| 402 } | |
| 403 | |
| 404 # Next check if both strings are at a separator. All separators can be | |
| 405 # used interchangeably. | |
| 406 if { ( [string match \[-._\] $ch1] ) && ( [string match \[-._\] $ch2] ) } { | |
| 407 incr index1 | |
| 408 incr index2 | |
| 409 continue | |
| 410 } | |
| 411 | |
| 412 # There are differences in the characters and they are not interchangeable. | |
| 413 # Just return a standard string comparison. | |
| 414 return [string compare $ch1 $ch2] | |
| 415 } | |
| 416 } | |
| 417 | |
| 418 if { 0 } { | |
| 419 | |
| 420 puts "compare current v0.1 : [pkgconf::cdl_compare_version current v0.1]" | |
| 421 puts "compare v0.1 current : [pkgconf::cdl_compare_version v0.1 current]" | |
| 422 puts "compare current current : [pkgconf::cdl_compare_version current current]" | |
| 423 puts "compare v0.1 v0.1 : [pkgconf::cdl_compare_version v0.1 v0.1]" | |
| 424 puts "compare v0_1 v0.1 : [pkgconf::cdl_compare_version v0_1 v0.1]" | |
| 425 puts "compare v0.1 v0_1 : [pkgconf::cdl_compare_version v0.1 v0_1]" | |
| 426 puts "compare v0_1 v0-1 : [pkgconf::cdl_compare_version v0_1 v0-1]" | |
| 427 puts "compare v0-1 v0_1 : [pkgconf::cdl_compare_version v0-1 v0_1]" | |
| 428 puts "compare v0.2 v0.1 : [pkgconf::cdl_compare_version v0.2 v0.1]" | |
| 429 puts "compare v0.1 v0.2 : [pkgconf::cdl_compare_version v0.1 v0.2]" | |
| 430 puts "compare v0.10 v0.2 : [pkgconf::cdl_compare_version v0.10 v0.2]" | |
| 431 puts "compare v0.2 v0.10 : [pkgconf::cdl_compare_version v0.2 v0.10]" | |
| 432 puts "compare 980410 980412 : [pkgconf::cdl_compare_version 980410 980412]" | |
| 433 puts "compare 980412 980410 : [pkgconf::cdl_compare_version 980412 980410]" | |
| 434 puts "compare ss980410 ss980412 : [pkgconf::cdl_compare_version ss980410 ss980412]" | |
| 435 puts "compare ss980412 ss980410 : [pkgconf::cdl_compare_version ss980412 ss980410]" | |
| 436 puts "compare v0.1.2 v0.1.3 : [pkgconf::cdl_compare_version v0.1.2 v0.1.3]" | |
| 437 puts "compare v0.1.3 v0.1.2 : [pkgconf::cdl_compare_version v0.1.3 v0.1.2]" | |
| 438 puts "compare v1.0 v0.1.3 : [pkgconf::cdl_compare_version v1.0 v0.1.3]" | |
| 439 puts "compare v0.1.3 v1.0 : [pkgconf::cdl_compare_version v0.1.3 v1.0]" | |
| 440 puts "compare v1.0beta v1.0 : [pkgconf::cdl_compare_version v1.0beta v1.0]" | |
| 441 puts "compare v1.0 v1.0beta : [pkgconf::cdl_compare_version v1.0 v1.0beta]" | |
| 442 puts "compare v1.0.p1 v1.0 : [pkgconf::cdl_compare_version v1.0.p1 v1.0]" | |
| 443 puts "compare v1.0 v1.0.p1 : [pkgconf::cdl_compare_version v1.0 v1.0.p1]" | |
| 444 } | |
| 445 | |
| 446 # }}} | |
| 447 # {{{ Argument parsing | |
| 448 | |
| 449 # ---------------------------------------------------------------------------- | |
| 450 # Parsing the arguments. The following arguments should be accepted for | |
| 451 # backwards compatibility reasons. | |
| 452 # | |
| 453 # --target=<arch_name> | |
| 454 # --platform=sim | |
| 455 # --startup=rom or --startup=ram | |
| 456 # --prefix=<directory> | |
| 457 # --disable-uitron | |
| 458 # --disable-libc | |
| 459 # | |
| 460 # There was also a --disable-kernel_c_api, but that is no longer supported. | |
| 461 # For now disabling only applies to entire packages, not to components | |
| 462 # within a package. The argument --release=debug has also been disabled | |
| 463 # because it affects too many things (the makevars file, various #define's, | |
| 464 # etc.). | |
| 465 # | |
| 466 # Also it was possible to use --disable-uitron=yes, but that was | |
| 467 # undocumented and is not worth supporting. | |
| 468 # | |
| 469 # Configure allowed --srcdir=xxx, although it did not need it. It is useful | |
| 470 # to support this, and to add --builddir. --installdir as a prefix alias | |
| 471 # then makes sense. | |
| 472 # | |
| 473 # --help should be supported if present as a single argument. | |
| 474 # | |
| 475 # It is desirable to support additional arguments of the form: | |
| 476 # | |
| 477 # --enable-uitron (to undo a disable in the saved data) | |
| 478 # --kernel-version=current | |
| 479 # --uitron-version=v0.3 | |
| 480 # | |
| 481 # Similarly it is desirable to allow users to control compiler flags, e.g. | |
| 482 # DBGFLAGS="-Wall -Werror" | |
| 483 # | |
| 2 | 484 # --debug can be used to set appropriate debug options in the |
| 485 # infrastructure. This should probably be --enable-debug, but that | |
| 486 # could cause confusion. There is also a --nodebug option. | |
| 487 # | |
| 0 | 488 # A new argument is --nw, to disable the GUI environment. Other new |
| 489 # arguments are: | |
| 490 # --targets and --packages to display the appropriate details | |
| 491 # --force to force files to be copied across from the repository | |
| 492 # --defaults to cause the program to ignore the values in the save file. | |
| 493 # --linkhdrs and --copyhdrs to control how header files should be handled. | |
| 494 # | |
| 495 # It is also a good idea to be a bit more flexible about the format | |
| 496 # of the command line arguments, for example -target=xxx should work, | |
| 497 # as should -target xxx | |
| 498 # | |
| 499 # The argv0 argument should be the name of this script. It can be used | |
| 500 # to get at the component repository location. If this script has been | |
| 501 # run incorrectly then currently it will fail: in future it may be | |
| 502 # desirable to check an environment variable instead. | |
| 503 # | |
| 504 # The argv argument is a string containing the rest of the arguments. | |
| 505 # If any of the arguments contain spaces then this argument will be | |
| 506 # surrounded by braces. If any of the arguments contain braces then | |
| 507 # things will break. | |
| 508 # | |
| 509 | |
| 510 proc pkgconf::parse_arguments { argv0 argv } { | |
| 511 | |
| 512 # First, check for --help or any of the variants. If this script | |
| 513 # is running in a larger program then it is assumed that the | |
| 514 # containing program will not pass --help as an argument. | |
| 515 if { ( $argv == "--help" ) || ( $argv == "-help" ) || | |
| 516 ( $argv == "--H" ) || ( $argv == "-H" ) } { | |
| 517 | |
| 518 argument_help | |
| 519 exit 0 | |
| 520 } | |
| 521 | |
| 522 if { $argv != "" } { | |
| 523 | |
| 524 # There are arguments. If any of the arguments contained | |
| 525 # spaces then these arguments will have been surrounded | |
| 526 # by braces, which is a nuisance. So start by turning the | |
| 527 # arguments into a numerically indexed array. | |
| 528 | |
| 529 set argc 0 | |
| 530 array set args { } | |
| 531 foreach arg $argv { | |
| 532 set args([incr argc]) $arg | |
| 533 } | |
| 534 | |
| 535 # Now examine each argument with regular expressions. It is | |
| 536 # useful to have some variables filled in by the regexp | |
| 537 # matching. | |
| 538 set dummy "" | |
| 539 set match1 "" | |
| 540 set match2 "" | |
| 541 for { set i 1 } { $i <= $argc } { incr i } { | |
| 542 | |
| 543 # Check for -nw. The regexp allows an optional -, followed by | |
| 544 # the text -nw, and nothing else. | |
| 545 if { [regexp -- {^-?-nw$} $args($i)] == 1 } { | |
| 546 set pkgconf::no_windows_arg 1 | |
| 547 continue | |
| 548 } | |
| 549 | |
| 550 # Check for --packages and the other simple ones. | |
| 551 if { [regexp -- {^-?-packages$} $args($i)] == 1 } { | |
| 552 set pkgconf::list_packages_arg 1 | |
| 553 continue | |
| 554 } | |
| 555 if { [regexp -- {^-?-pkgdata$} $args($i)] == 1 } { | |
| 556 set pkgconf::list_pkgdata_arg 1 | |
| 557 continue | |
| 558 } | |
| 559 if { [regexp -- {^-?-targets$} $args($i)] == 1 } { | |
| 560 set pkgconf::list_targets_arg 1 | |
| 561 continue | |
| 562 } | |
| 563 if { [regexp -- {^-?-flags$} $args($i)] == 1 } { | |
| 564 set pkgconf::list_flags_arg 1 | |
| 565 continue | |
| 566 } | |
| 567 if { [regexp -- {^-?-force$} $args($i)] == 1 } { | |
| 568 set pkgconf::force_arg 1 | |
| 569 continue | |
| 570 } | |
| 571 if { [regexp -- {^-?-defaults$} $args($i)] == 1 } { | |
| 572 set pkgconf::defaults_arg 1 | |
| 573 continue | |
| 574 } | |
| 575 if { [regexp -- {^-?-linkhdrs$} $args($i)] == 1 } { | |
| 576 set pkgconf::use_links_arg 1 | |
| 577 continue | |
| 578 } | |
| 579 if { [regexp -- {^-?-copyhdrs$} $args($i)] == 1 } { | |
| 580 set pkgconf::use_copies_arg 1 | |
| 581 continue | |
| 582 } | |
| 2 | 583 if { [regexp -- {^-?-debug$} $args($i)] == 1 } { |
| 584 set pkgconf::debug_arg 1 | |
| 585 continue | |
| 586 } | |
| 587 if { [regexp -- {^-?-nodebug$} $args($i)] == 1 } { | |
| 588 set pkgconf::nodebug_arg 1 | |
| 589 continue | |
| 590 } | |
| 0 | 591 |
| 592 # Now for the directories. srcdir and builddir will have | |
| 593 # been calculated already, but may be overridden here. | |
| 594 if { [regexp -- {^-?-src_?dir=?(.*)$} $args($i) dummy match1] == 1 } { | |
| 595 if { $match1 != "" } { | |
| 596 set pkgconf::component_repository $match1 | |
| 597 } else { | |
| 598 if { $i == $argc } { | |
| 599 fatal_error "pkgconf: missing argument after --srcdir" | |
| 600 } else { | |
| 601 set pkgconf::component_repository $args([incr i]) | |
| 602 } | |
| 603 } | |
| 604 continue | |
| 605 } | |
| 606 if { [regexp -- {^-?-build_?dir=?(.*)$} $args($i) dummy match1] == 1 } { | |
| 607 if { $match1 != "" } { | |
| 608 set pkgconf::build_tree $match1 | |
| 609 } else { | |
| 610 if { $i == $argc } { | |
| 611 fatal_error "pkgconf: missing argument after --builddir" | |
| 612 } else { | |
| 613 set pkgconf::build_tree $args([incr i]) | |
| 614 } | |
| 615 } | |
| 616 continue | |
| 617 } | |
| 618 | |
| 619 # And prefix, before moving on to the more interesting ones. | |
| 620 # Prefix is a pathname so spaces are legitimate, as are dots, | |
| 621 # directory separators, and drive indicators. | |
| 622 # | |
| 623 # NOTE: strictly speaking the pattern should be platform specific. | |
| 624 if { [regexp -- {^-?-prefix=?(.*)$} $args($i) dummy match1] == 1 } { | |
| 625 if { $match1 != "" } { | |
| 626 set pkgconf::prefix_arg $match1 | |
| 627 } else { | |
| 628 if { $i == $argc } { | |
| 629 fatal_error "pkgconf: missing argument after --prefix" | |
| 630 } else { | |
| 631 set pkgconf::prefix_arg $args([incr i]) | |
| 632 } | |
| 633 } | |
| 634 continue | |
| 635 } | |
| 636 | |
| 637 # --installdir is a useful alias for prefix. | |
| 638 if { [regexp -- {^-?-install_?dir=?(.*)$} $args($i) dummy match1] == 1 } { | |
| 639 if { $match1 != "" } { | |
| 640 set pkgconf::prefix_arg $match1 | |
| 641 } else { | |
| 642 if { $i == $argc } { | |
| 643 fatal_error "pkgconf: missing argument after --installdir" | |
| 644 } else { | |
| 645 set pkgconf::prefix_arg $args([incr i]) | |
| 646 } | |
| 647 } | |
| 648 continue | |
| 649 } | |
| 650 | |
| 651 | |
| 652 # Now check for a --target arg. The -target must match exactly, | |
| 653 # but there can be one leading hyphen that gets ignored. The | |
| 654 # target can be part of the same argument (with an = in between) | |
| 655 # or it can be all of the next argument. | |
| 656 # | |
| 657 # This code will match spuriously with --targetxxx, i.e. the | |
| 658 # = is optional. This is harmless. | |
| 659 # | |
| 660 # The target is not validated at this point, that happens after | |
| 661 # reading in the targets file. It is possible to specify | |
| 662 # several --target arguments, and only the last one takes | |
| 663 # effect. | |
| 664 if { [regexp -- {^-?-target=?([_a-zA-Z0-9]*)$} $args($i) dummy match1] == 1 } { | |
| 665 if { $match1 != "" } { | |
| 666 set pkgconf::target_arg $match1 | |
| 667 } else { | |
| 668 if { $i == $argc } { | |
| 669 fatal_error "pkgconf: missing argument after --target" | |
| 670 } else { | |
| 671 set pkgconf::target_arg $args([incr i]) | |
| 672 } | |
| 673 } | |
| 674 continue | |
| 675 } | |
| 676 | |
| 677 # Ditto for --platform. | |
| 678 if { [regexp -- {^-?-platform=?([_a-zA-Z0-9]*)$} $args($i) dummy match1] == 1 } { | |
| 679 if { $match1 != "" } { | |
| 680 set pkgconf::platform_arg $match1 | |
| 681 } else { | |
| 682 if { $i == $argc } { | |
| 683 fatal_error "pkgconf: missing argument after --platform" | |
| 684 } else { | |
| 685 set pkgconf::platform_arg $args([incr i]) | |
| 686 } | |
| 687 } | |
| 688 continue | |
| 689 } | |
| 690 | |
| 691 # And for --startup. | |
| 692 if { [regexp -- {^-?-startup=?([_a-zA-Z0-9]*)$} $args($i) dummy match1] == 1 } { | |
| 693 if { $match1 != "" } { | |
| 694 set pkgconf::startup_arg $match1 | |
| 695 } else { | |
| 696 if { $i == $argc } { | |
| 697 fatal_error "pkgconf: missing argument after --startup" | |
| 698 } else { | |
| 699 set pkgconf::startup_arg $args([incr i]) | |
| 700 } | |
| 701 } | |
| 702 continue | |
| 703 } | |
| 704 | |
| 705 # Now for --disable-<package>. The disabled packages are stored | |
| 706 # in a simple list. | |
| 707 if { [regexp -- {^-?-disable-?=?([_a-zA-Z0-9]*)$} $args($i) dummy match1] == 1 } { | |
| 708 if { $match1 != "" } { | |
| 709 lappend pkgconf::disable_args $match1 | |
| 710 } else { | |
| 711 if { $i == $argc } { | |
| 712 fatal_error "pkgconf: missing argument after --disable" | |
| 713 } else { | |
| 714 lappend pkgconf::disable_args $args([incr i]) | |
| 715 } | |
| 716 } | |
| 717 continue | |
| 718 } | |
| 719 | |
| 720 # The same for --enable-<package>. | |
| 721 if { [regexp -- {^-?-enable-?=?([_a-zA-Z0-9]*)$} $args($i) dummy match1] == 1 } { | |
| 722 if { $match1 != "" } { | |
| 723 lappend pkgconf::enable_args $match1 | |
| 724 } else { | |
| 725 if { $i == $argc } { | |
| 726 fatal_error "pkgconf: missing argument after --enable" | |
| 727 } else { | |
| 728 lappend pkgconf::enable_args $args([incr i]) | |
| 729 } | |
| 730 } | |
| 731 continue | |
| 732 } | |
| 733 | |
| 734 # And for --<package>-version=xxx | |
| 735 # These versions are stored in an array indexed by the | |
| 736 # package string. | |
| 737 if {[regexp -- {^-?-([_a-zA-Z0-9]+)-?version=?([_\.a-zA-Z0-9]*)$} $args($i) dummy match1 match2] == 1} { | |
| 738 if { $match2 != "" } { | |
| 739 set pkgconf::version_args($match1) $match2 | |
| 740 } else { | |
| 741 if { $i == $argc } { | |
| 742 fatal_error "pkgconf: missing argument after --$match1-version" | |
| 743 } else { | |
| 744 set pkgconf::version_args($match1) $args([incr i]) | |
| 745 } | |
| 746 } | |
| 747 continue | |
| 748 } | |
| 749 | |
| 750 # For each of the known compiler flags, check for a definition of | |
| 751 # this flag. The flags are stored in an array cflags_args(). | |
| 752 # Note that an empty string is legal, so that the default flags | |
| 753 # from the targets file can be disabled. | |
| 754 set its_a_flag 0 | |
| 755 foreach flag $pkgconf::known_compiler_flags { | |
| 756 if { [regexp -- "^[set flag]=(.*)\$" $args($i) dummy match1] == 1 } { | |
| 757 set pkgconf::cflags_args($flag) $match1 | |
| 758 set its_a_flag 1 | |
| 759 break | |
| 760 } | |
| 761 } | |
| 762 if { $its_a_flag != 0 } { | |
| 763 continue | |
| 764 } | |
| 765 | |
| 766 # An unrecognised argument. | |
| 767 fatal_error "pkgconf: invalid argument $args($i)" | |
| 768 } | |
| 769 } | |
| 770 | |
| 771 # Under Windows it is desirable to do some checking on any directories that | |
| 772 # have been provided. Some cygwin pathnames that a user might supply are | |
| 773 # not acceptable to Tcl. | |
| 774 if { $pkgconf::windows_host } { | |
| 775 set pkgconf::component_repository [get_pathname_for_tcl $pkgconf::component_repository] | |
| 776 set pkgconf::build_tree [get_pathname_for_tcl $pkgconf::build_tree] | |
| 777 if { $pkgconf::prefix_arg != "" } { | |
| 778 set pkgconf::prefix_arg [get_pathname_for_tcl $pkgconf::prefix_arg] | |
| 779 } | |
| 780 } | |
| 781 | |
| 782 # Enabling this facilitates testing of the parsing code. | |
| 783 if { 0 } { | |
| 784 puts "component repository is $pkgconf::component_repository" | |
| 785 puts "build tree is $pkgconf::build_tree" | |
| 786 puts "prefix_arg is $pkgconf::prefix_arg" | |
| 787 puts "list_targets_arg is $pkgconf::list_targets_arg" | |
| 788 puts "list_packages_arg is $pkgconf::list_packages_arg" | |
| 789 puts "list_pkgdata_arg is $pkgconf::list_pkgdata_arg" | |
| 790 puts "list_flags_arg is $pkgconf::list_flags_arg" | |
| 791 puts "no_windows_arg is $pkgconf::no_windows_arg" | |
| 792 puts "target_arg is $pkgconf::target_arg" | |
| 793 puts "platform_arg is $pkgconf::platform_arg" | |
| 794 puts "startup_arg is $pkgconf::startup_arg" | |
| 795 puts "disable_args is $pkgconf::disable_args" | |
| 796 puts "enable_args is $pkgconf::enable_args" | |
| 797 puts "force_arg is $pkgconf::force_arg" | |
| 798 puts "defaults_arg is $pkgconf::defaults_arg" | |
| 799 puts "use_links_arg is $pkgconf::use_links_arg" | |
| 800 puts "use_copies_arg is $pkgconf::use_copies_arg" | |
| 2 | 801 puts "debug_arg is $pkgconf::debug_arg" |
| 802 puts "nodebug_arg is $pkgconf::nodebug_arg" | |
| 0 | 803 foreach i [array names pkgconf::version_args] { |
| 804 puts "Package $i needs version $pkgconf::version_args($i)" | |
| 805 } | |
| 806 foreach flag [array names pkgconf::cflags_args] { | |
| 807 puts "Compiler flag $flag has value $pkgconf::cflags_args($flag)" | |
| 808 } | |
| 809 exit 0 | |
| 810 } | |
| 811 | |
| 812 } | |
| 813 | |
| 814 # | |
| 815 # Display help information if the user has typed --help, -H, --H, or -help. | |
| 816 # The help text uses two hyphens for consistency with configure. | |
| 817 # Arguably this should change. | |
| 818 # | |
| 819 # Not all legal command line arguments are listed. Some of the command | |
| 820 # line arguments like --flags are intended for internal use only. | |
| 821 # | |
| 822 # NOTE: if this command is being invoked from a shell script that sets | |
| 823 # the defaults for a particular architecture then the information will not | |
| 824 # be completely accurate. There is no easy solution for this problem. | |
| 825 # | |
| 826 # NOTE: it would be a really good idea to give an example command line. | |
| 827 # Unfortunately this command line must include a target architecture, | |
| 828 # and there is no sensible default for that. | |
| 829 # | |
| 830 proc pkgconf::argument_help { } { | |
| 831 | |
| 832 puts "Usage: pkgconf \[options\]" | |
| 833 puts "Available options are:" | |
| 834 puts " --help : display this text." | |
| 835 puts " --packages : list all packages." | |
| 836 puts " --targets : list all possible targets." | |
| 837 puts " --target=<arch> : target the specified architecture." | |
| 838 puts " --platform=sim : target the simulator rather than hardware." | |
| 839 puts " --startup=rom : generate code suitable for ROMming." | |
| 840 puts " --disable-<pkg> : disable a given package." | |
| 841 puts " --enable-<pkg> : enable a given package." | |
| 842 puts " --<pkg>-version=v0.3 : use a specific version of a package." | |
| 843 puts " --defaults : use default settings instead of the save file." | |
| 844 puts " --srcdir=<dir> : specify location of the component repository." | |
| 845 puts " --builddir=<dir> : specify location of the build directory." | |
| 846 puts " --prefix=<dir> : specify location of the install directory." | |
| 847 } | |
| 848 | |
| 849 # }}} | |
| 850 # {{{ Packages file | |
| 851 | |
| 852 # ---------------------------------------------------------------------------- | |
| 853 # The component repository should contain a file "packages" containing details | |
| 854 # of all supported packages. This file is actually an executable Tcl script | |
| 855 # containing instances of the "package" command, which takes three arguments. | |
| 856 # It is necessary to update the variables pkgconf::known_packages and | |
| 857 # pkgconf::package_data. | |
| 858 # | |
| 859 | |
| 860 proc pkgconf::read_packages { } { | |
| 861 | |
| 862 ASSERT { $pkgconf::component_repository != "" } | |
| 863 ASSERT { [array names pkgconf::package_data] == "" } | |
| 864 ASSERT { $pkgconf::known_packages == "" } | |
| 865 | |
| 866 # A safe interpreter is used to process the packages file. | |
| 867 # This is somewhat overcautious, but it is also harmless. | |
| 868 # The following two commands are made accessible to the slave | |
| 869 # interpreter and are responsible for updating the actual data. | |
| 870 proc set_package_data { name value } { | |
| 2 | 871 set ::pkgconf::package_data($name) $value |
| 0 | 872 } |
| 873 proc add_known_package { name } { | |
| 2 | 874 lappend ::pkgconf::known_packages $name |
| 0 | 875 } |
| 876 | |
| 877 # Create the parser, add the aliased commands, and then define | |
| 878 # the routines that do the real work. | |
| 879 set parser [interp create -safe] | |
| 880 $parser alias set_package_data pkgconf::set_package_data | |
| 881 $parser alias add_known_package pkgconf::add_known_package | |
| 882 | |
| 883 $parser eval { | |
| 884 | |
| 885 set current_package "" | |
| 886 | |
| 887 proc package { name body } { | |
| 888 | |
| 889 add_known_package $name | |
| 890 set_package_data "$name,alias" $name | |
| 891 set_package_data "$name,dir" "" | |
| 892 set_package_data "$name,versions" "" | |
| 893 set_package_data "$name,default" 0 | |
| 894 set_package_data "$name,incdir" "" | |
| 895 set_package_data "$name,hardware" 0 | |
| 896 | |
| 897 # Evaluate the body such that the commands know what the current package is. | |
| 898 set ::current_package $name | |
| 899 eval $body | |
| 900 set ::current_package "" | |
| 901 } | |
| 902 | |
| 903 proc alias { str } { | |
| 904 set_package_data "$::current_package,alias" $str | |
| 905 } | |
| 906 | |
| 907 # The remaining commands are basically clones of alias. | |
| 908 proc directory { dir } { | |
| 909 set_package_data "$::current_package,dir" $dir | |
| 910 } | |
| 911 | |
| 912 proc default_value { val } { | |
| 913 set_package_data "$::current_package,default" $val | |
| 914 } | |
| 915 | |
| 916 proc include_dir { dir } { | |
| 917 set_package_data "$::current_package,incdir" $dir | |
| 918 } | |
| 919 | |
| 920 proc hardware { } { | |
| 921 set_package_data "$::current_package,hardware" 1 | |
| 922 } | |
| 923 } | |
| 924 | |
| 925 # The parser is ready to evaluate the script. To avoid having to give the | |
| 926 # safe interpreter file I/O capabilities, the file is actually read in | |
| 927 # here and then evaluated. | |
| 928 set filename [file join $pkgconf::component_repository "packages"] | |
| 929 set status [ catch { | |
| 930 set fd [open $filename r] | |
| 931 set script [read $fd] | |
| 932 close $fd | |
| 933 $parser eval $script | |
| 934 } message] | |
| 935 | |
| 936 if { $status != 0 } { | |
| 937 pkgconf::fatal_error "Unexpected error while processing $filename\n$message" | |
| 938 } | |
| 939 | |
| 940 # The interpreter and the aliased commands are no longer required. | |
| 941 rename set_package_data {} | |
| 942 rename add_known_package {} | |
| 943 interp delete $parser | |
| 944 | |
| 945 # At this stage the packages file has been read in. It is a good idea to | |
| 946 # check that all of these packages are present and correct, and incidentally | |
| 947 # figure out which versions are present. | |
| 948 foreach pkg $pkgconf::known_packages { | |
| 949 | |
| 950 set pkgdir [file join $pkgconf::component_repository $pkgconf::package_data($pkg,dir)] | |
| 951 if { ![file exists $pkgdir] || ![file isdir $pkgdir] } { | |
| 952 fatal_error \ | |
| 953 "The file [file join $pkgconf::component_repository "packages"] lists a package\ | |
| 954 $pkg which should be present in $pkgdir. This package is missing." | |
| 955 } | |
| 956 | |
| 957 # Each subdirectory should correspond to a release. A utility routine | |
| 958 # is available for this. | |
| 959 set pkgconf::package_data($pkg,versions) [locate_subdirs $pkgdir] | |
| 960 if { $pkgconf::package_data($pkg,versions) == "" } { | |
| 961 fatal_error "The package $pkg does not contain any version directories." | |
| 962 } | |
| 963 | |
| 964 # Sort all the versions using a version-aware comparison version | |
| 965 set pkgconf::package_data($pkg,versions) [ | |
| 966 lsort -command pkgconf::cdl_compare_version $pkgconf::package_data($pkg,versions) | |
| 967 ] | |
| 968 } | |
| 969 | |
| 970 # Handle the --packages argument. | |
| 971 if { $pkgconf::list_packages_arg != 0 } { | |
| 972 | |
| 973 # The user wants to know about all the arguments. Just to be fancy | |
| 974 # this code does some alignment. | |
| 975 set name_maxlen 0 | |
| 976 | |
| 977 foreach pkg $pkgconf::known_packages { | |
| 978 if { [string length $pkg] > $name_maxlen} { | |
| 979 set name_maxlen [string length $pkg] | |
| 980 } | |
| 981 } | |
| 982 | |
| 983 puts "Known packages are:" | |
| 984 foreach pkg $pkgconf::known_packages { | |
| 985 puts "[format " %-*s : " $name_maxlen $pkg]" | |
| 986 puts " Available versions: $pkgconf::package_data($pkg,versions)" | |
| 987 puts " Aliases : $pkgconf::package_data($pkg,alias)" | |
| 988 if { $pkgconf::package_data($pkg,hardware) } { | |
| 989 puts " This package is only available on specific hardware." | |
| 990 } | |
| 991 if { $pkgconf::package_data($pkg,default) } { | |
| 992 puts " This package is enabled by default." | |
| 993 } else { | |
| 994 puts " This package is disabled by default." | |
| 995 } | |
| 996 } | |
| 997 } | |
| 998 | |
| 999 # Ditto for the --pkgdata argument. In this case the data is intended for use | |
| 1000 # by other programs, and is not necessarily intelligible to users. | |
| 1001 if { $pkgconf::list_pkgdata_arg != 0 } { | |
| 1002 foreach pkg $pkgconf::known_packages { | |
| 1003 set dir [file join $pkgconf::package_data($pkg,dir) [lindex $pkgconf::package_data($pkg,versions) 0]] | |
| 1004 set dir [file nativename $dir] | |
| 1005 if { $pkgconf::windows_host != 0 } { | |
| 1006 regsub -all {\\} $dir {\\\\} dir | |
| 1007 } | |
| 1008 set alias [get_build_alias $pkg] | |
| 1009 puts "\"$pkg\" \"$alias\" \"$dir\"" | |
| 1010 } | |
| 1011 } | |
| 1012 } | |
| 1013 | |
| 1014 # | |
| 1015 # Given a package name as supplied by the user, return the internal package name. | |
| 1016 # This involves searching through the list of aliases. | |
| 1017 # | |
| 1018 proc pkgconf::find_package { name } { | |
| 1019 | |
| 1020 foreach pkg $pkgconf::known_packages { | |
| 1021 | |
| 1022 if { [string toupper $pkg] == [string toupper $name] } { | |
| 1023 return $pkg | |
| 1024 } | |
| 1025 | |
| 1026 foreach alias $pkgconf::package_data($pkg,alias) { | |
| 1027 if { [string toupper $alias] == [string toupper $name] } { | |
| 1028 return $pkg | |
| 1029 } | |
| 1030 } | |
| 1031 } | |
| 1032 | |
| 1033 return "" | |
| 1034 } | |
| 1035 | |
| 1036 # | |
| 1037 # Given a package name, return the first alias string. This is useful for | |
| 1038 # output code. | |
| 1039 # | |
| 1040 proc pkgconf::get_package_alias { name } { | |
| 1041 | |
| 1042 pkgconf::ASSERT { [lsearch -exact $pkgconf::known_packages $name] != -1 } | |
| 1043 set alias [lindex $pkgconf::package_data($name,alias) 0] | |
| 1044 return $alias | |
| 1045 } | |
| 1046 | |
| 1047 # | |
| 1048 # Does a given package actually exist ? This copes with aliases | |
| 1049 # as well. | |
| 1050 proc pkgconf::is_package { name } { | |
| 1051 | |
| 1052 ASSERT { $name != "" } | |
| 1053 | |
| 1054 set result 0 | |
| 1055 set name [find_package $name] | |
| 1056 if { $name != "" } { | |
| 1057 set result 1 | |
| 1058 } | |
| 1059 return $result | |
| 1060 } | |
| 1061 | |
| 1062 # | |
| 1063 # Is a particular package a hardware-specific package ? This code | |
| 1064 # deals with aliases as well | |
| 1065 proc pkgconf::is_hardware_package { name } { | |
| 1066 | |
| 1067 ASSERT { $name != "" } | |
| 1068 | |
| 1069 set name [find_package $name] | |
| 1070 ASSERT { $name != "" } | |
| 1071 | |
| 1072 set result 0 | |
| 1073 if { $pkgconf::package_data($name,hardware) != 0 } { | |
| 1074 set result 1 | |
| 1075 } | |
| 1076 return $result | |
| 1077 } | |
| 1078 | |
| 1079 # | |
| 1080 # Is a particular version string valid for the given package ? | |
| 1081 proc pkgconf::is_valid_version { pkg version } { | |
| 1082 | |
| 1083 ASSERT { $pkg != "" } | |
| 1084 ASSERT { $version != "" } | |
| 1085 | |
| 1086 set pkg [find_package $pkg] | |
| 1087 ASSERT { $pkg != "" } | |
| 1088 | |
| 1089 set result 0 | |
| 1090 set index [lsearch -exact $pkgconf::package_data($pkg,versions) $version] | |
| 1091 if { $index != -1 } { | |
| 1092 set result 1 | |
| 1093 } | |
| 1094 return $result | |
| 1095 } | |
| 1096 | |
| 1097 # }}} | |
| 1098 # {{{ Targets file | |
| 1099 | |
| 1100 # ---------------------------------------------------------------------------- | |
| 1101 # The handling of the targets file is similar to that for the packages file, | |
| 1102 # but a targets file is a bit more complicated. | |
| 1103 # | |
| 1104 | |
| 1105 proc pkgconf::read_targets { } { | |
| 1106 | |
| 1107 ASSERT { $pkgconf::component_repository != "" } | |
| 1108 ASSERT { [array names pkgconf::target_data] == "" } | |
| 1109 ASSERT { $pkgconf::known_targets == "" } | |
| 1110 ASSERT { $pkgconf::known_compiler_flags != "" } | |
| 1111 | |
| 1112 proc add_known_target { name } { | |
| 2 | 1113 lappend ::pkgconf::known_targets $name |
| 1114 set ::pkgconf::target_data($name,alias) $name | |
| 1115 set ::pkgconf::target_data($name,prefix) "" | |
| 1116 set ::pkgconf::target_data($name,known_platforms) "" | |
| 1117 set ::pkgconf::target_data($name,packages) "" | |
| 0 | 1118 } |
| 1119 proc add_known_platform { arch name } { | |
| 2 | 1120 lappend ::pkgconf::target_data($arch,known_platforms) $name |
| 1121 set ::pkgconf::target_data($arch,$name,alias) "" | |
| 1122 set ::pkgconf::target_data($arch,$name,startup) "" | |
| 1123 set ::pkgconf::target_data($arch,$name,packages) "" | |
| 0 | 1124 } |
| 1125 proc set_target_data { name value } { | |
| 2 | 1126 set ::pkgconf::target_data($name) $value |
| 0 | 1127 } |
| 1128 | |
| 1129 set parser [interp create -safe] | |
| 1130 interp share {} stdout $parser | |
| 1131 $parser alias set_target_data pkgconf::set_target_data | |
| 1132 $parser alias add_known_target pkgconf::add_known_target | |
| 1133 $parser alias add_known_platform pkgconf::add_known_platform | |
| 1134 $parser eval [list set known_compiler_flags $pkgconf::known_compiler_flags] | |
| 1135 | |
| 1136 $parser eval { | |
| 1137 | |
| 1138 set current_target "" | |
| 1139 set current_platform "" | |
| 1140 | |
| 1141 proc target { name body } { | |
| 1142 | |
| 1143 add_known_target $name | |
| 1144 | |
| 1145 # Evaluate the body such that the commands know what the current target is. | |
| 1146 set ::current_target $name | |
| 1147 eval $body | |
| 1148 set ::current_target "" | |
| 1149 } | |
| 1150 | |
| 1151 proc alias { str } { | |
| 1152 | |
| 1153 # If processing a platform body, update the platform data. Otherwise update the | |
| 1154 # target data. There should be only one alias command per body. | |
| 1155 if { $::current_platform != "" } { | |
| 1156 set_target_data "$::current_target,$::current_platform,alias" $str | |
| 1157 } else { | |
| 1158 set_target_data "$::current_target,alias" $str | |
| 1159 } | |
| 1160 } | |
| 1161 | |
| 1162 proc command_prefix { str } { | |
|
12
4cc3eff958ab
Merge from eCos master repository on 1999-06-04-22:24:56-BST
jlarmour
parents:
4
diff
changeset
|
1163 # Allow the command prefix to be overridden on a per-platform basis |
|
4cc3eff958ab
Merge from eCos master repository on 1999-06-04-22:24:56-BST
jlarmour
parents:
4
diff
changeset
|
1164 if { $::current_platform != "" } { |
|
4cc3eff958ab
Merge from eCos master repository on 1999-06-04-22:24:56-BST
jlarmour
parents:
4
diff
changeset
|
1165 set_target_data "$::current_target,$::current_platform,prefix" $str |
|
4cc3eff958ab
Merge from eCos master repository on 1999-06-04-22:24:56-BST
jlarmour
parents:
4
diff
changeset
|
1166 } else { |
|
4cc3eff958ab
Merge from eCos master repository on 1999-06-04-22:24:56-BST
jlarmour
parents:
4
diff
changeset
|
1167 set_target_data "$::current_target,prefix" $str |
|
4cc3eff958ab
Merge from eCos master repository on 1999-06-04-22:24:56-BST
jlarmour
parents:
4
diff
changeset
|
1168 } |
| 0 | 1169 } |
| 1170 | |
| 1171 proc packages { list } { | |
| 1172 if { $::current_platform != "" } { | |
| 1173 set_target_data "$::current_target,$::current_platform,packages" $list | |
| 1174 } else { | |
| 1175 set_target_data "$::current_target,packages" $list | |
| 1176 } | |
| 1177 } | |
| 1178 | |
| 1179 proc hal { dir } { | |
| 1180 if { $::current_platform != "" } { | |
| 1181 set_target_data "$::current_target,$::current_platform,haldir" $dir | |
| 1182 } else { | |
| 1183 set_target_data "$::current_target,haldir" $dir | |
| 1184 } | |
| 1185 } | |
| 1186 | |
|
12
4cc3eff958ab
Merge from eCos master repository on 1999-06-04-22:24:56-BST
jlarmour
parents:
4
diff
changeset
|
1187 proc base_platform { str } { |
|
4cc3eff958ab
Merge from eCos master repository on 1999-06-04-22:24:56-BST
jlarmour
parents:
4
diff
changeset
|
1188 if { $::current_platform != "" } { |
|
4cc3eff958ab
Merge from eCos master repository on 1999-06-04-22:24:56-BST
jlarmour
parents:
4
diff
changeset
|
1189 set_target_data "$::current_target,$::current_platform,base_platform" $str |
|
4cc3eff958ab
Merge from eCos master repository on 1999-06-04-22:24:56-BST
jlarmour
parents:
4
diff
changeset
|
1190 } else { |
|
4cc3eff958ab
Merge from eCos master repository on 1999-06-04-22:24:56-BST
jlarmour
parents:
4
diff
changeset
|
1191 set_target_data "$::current_target,base_platform" $str |
|
4cc3eff958ab
Merge from eCos master repository on 1999-06-04-22:24:56-BST
jlarmour
parents:
4
diff
changeset
|
1192 } |
|
4cc3eff958ab
Merge from eCos master repository on 1999-06-04-22:24:56-BST
jlarmour
parents:
4
diff
changeset
|
1193 } |
|
4cc3eff958ab
Merge from eCos master repository on 1999-06-04-22:24:56-BST
jlarmour
parents:
4
diff
changeset
|
1194 |
| 0 | 1195 proc platform { name body } { |
| 1196 | |
| 1197 add_known_platform $::current_target $name | |
| 1198 | |
| 1199 set ::current_platform $name | |
| 1200 eval $body | |
| 1201 set ::current_platform "" | |
| 1202 } | |
| 1203 | |
| 1204 proc startup { types } { | |
| 1205 set_target_data "$::current_target,$::current_platform,startup" $types | |
| 1206 } | |
| 1207 | |
| 1208 # The cflags command is much more complicated than the others. The argument | |
| 1209 # to cflags should be a list of paired data, e.g. ERRFLAGS -Wall. | |
| 1210 # The first entry in each pair should be one of the known compiler | |
| 1211 # flags, the second one should be its value. | |
| 1212 proc cflags { str } { | |
| 1213 | |
| 1214 set arg_count [llength $str] | |
| 1215 if { ($arg_count % 2) != 0 } { | |
| 1216 error "Invalid argument list to cflags command in $current_target" | |
| 1217 } | |
| 1218 for { set i 0 } { $i < $arg_count } { incr i 2 } { | |
| 1219 set flag [lindex $str $i] | |
| 1220 set value [lindex $str [expr $i + 1]] | |
| 1221 if { [lsearch -exact $::known_compiler_flags $flag] == -1 } { | |
| 1222 error "Invalid compiler flag $flag for target $::current_target" | |
| 1223 } | |
| 1224 if { $::current_platform != "" } { | |
| 1225 set_target_data "$::current_target,$::current_platform,cflags,$flag" $value | |
| 1226 } else { | |
| 1227 set_target_data "$::current_target,cflags,$flag" $value | |
| 1228 } | |
| 1229 } | |
| 1230 } | |
| 1231 | |
| 1232 } | |
| 1233 | |
| 1234 # The parser is ready to evaluate the script. To avoid having to give the | |
| 1235 # safe interpreter file I/O capabilities, the file is actually read in | |
| 1236 # here and then evaluated. | |
| 1237 set filename [file join $pkgconf::component_repository "targets"] | |
| 1238 set status [ catch { | |
| 1239 set fd [open $filename r] | |
| 1240 set script [read $fd] | |
| 1241 close $fd | |
| 1242 $parser eval $script | |
| 1243 } message] | |
| 1244 | |
| 1245 if { $status != 0 } { | |
| 1246 puts "Unexpected error while processing $filename\n$message" | |
| 1247 exit 1 | |
| 1248 } | |
| 1249 | |
| 1250 # The interpreter and the aliased commands are no longer required. | |
| 1251 rename add_known_target {} | |
| 1252 rename add_known_platform {} | |
| 1253 rename set_target_data {} | |
| 1254 interp delete $parser | |
| 1255 | |
| 1256 # The targets file has been read in, so it is time for some consistency checks. | |
| 1257 foreach target $pkgconf::known_targets { | |
| 1258 | |
| 1259 # If this target involves some special packages, check that these | |
| 1260 # packages were actually defined in the packages file. Also check | |
| 1261 # that these packages are listed as hardware packages so that | |
| 1262 # they will not be enabled by default. | |
| 1263 ASSERT { [info exists pkgconf::target_data($target,packages)] } | |
| 1264 foreach pkg $pkgconf::target_data($target,packages) { | |
| 1265 | |
| 1266 if { [is_package $pkg] == 0 } { | |
| 1267 fatal_error \ | |
| 1268 "The targets file $filename lists a package $pkg\ | |
| 1269 for the $target architecture. This package is not listed\ | |
| 1270 in the packages file." | |
| 1271 | |
| 1272 } elseif { [is_hardware_package $pkg] == 0 } { | |
| 1273 | |
| 1274 fatal_error \ | |
| 1275 "The targets file $filename lists a package $pkg\ | |
| 1276 for the $target architecture. According to the packages\ | |
| 1277 file this package is not hardware-specific." | |
| 1278 } | |
| 1279 } | |
| 1280 | |
| 1281 ASSERT { [info exists pkgconf::target_data($target,known_platforms)] } | |
| 1282 foreach platform $pkgconf::target_data($target,known_platforms) { | |
| 1283 | |
| 1284 ASSERT { [info exists pkgconf::target_data($target,$platform,packages)] } | |
| 1285 foreach pkg $pkgconf::target_data($target,packages) { | |
| 1286 | |
| 1287 if { [is_package $pkg] == 0 } { | |
| 1288 | |
| 1289 fatal_error \ | |
| 1290 "The target file $filename lists a package $pkg\ | |
| 1291 for the $target architecture and the $platform platform.\ | |
| 1292 This package is not listed in the packages file." | |
| 1293 | |
| 1294 } elseif { [is_hardware_package $pkg] == 0 } { | |
| 1295 | |
| 1296 fatal_error \ | |
| 1297 "The target file $filename lists a package $pkg\ | |
| 1298 for the $target architecture and the $platform platform.\ | |
| 1299 According to the packages file this package is not hardware-specific." | |
| 1300 } | |
| 1301 } | |
| 1302 } | |
| 1303 | |
| 1304 # Also check that all required data for all targets and platforms has | |
| 1305 # been supplied. A command prefix is required, as is a startup list. | |
| 1306 | |
| 1307 if { [llength $pkgconf::target_data($target,known_platforms)] == 0 } { | |
| 1308 warning "The targets file $filename lists the $target architecture but no platforms." | |
| 1309 set index [lsearch -exact $pkgconf::known_targets $target] | |
| 1310 ASSERT { $index != -1 } | |
| 1311 set pkgconf::known_targets [lreplace $pkgconf::known_targets $index $index] | |
| 1312 continue | |
| 1313 } | |
| 1314 | |
| 1315 if { $pkgconf::target_data($target,prefix) == "" } { | |
| 1316 fatal_error "The targets file $filename does not list a command prefix for the $target architecture." | |
| 1317 } | |
| 1318 | |
| 1319 foreach platform $pkgconf::target_data($target,known_platforms) { | |
| 1320 if { [llength $pkgconf::target_data($target,$platform,startup)] == 0 } { | |
| 1321 fatal_error \ | |
| 1322 "The targets file $filename does not list any startup options for target $target, platform $platform." | |
| 1323 } | |
| 1324 } | |
| 1325 } | |
| 1326 | |
| 1327 # At this stage there may be no targets left over. | |
| 1328 if { [llength $pkgconf::known_targets] == 0 } { | |
| 1329 fatal_error "The targets file $filename does not list any usable targets." | |
| 1330 } | |
| 1331 | |
| 1332 # All the directories exist. Did the user ask for a list of all targets ? | |
| 1333 if { $pkgconf::list_targets_arg } { | |
| 1334 | |
| 1335 # The user wants to know about all the targets. Just to be fancy | |
| 1336 # this code does some alignment. | |
| 1337 set name_maxlen 0 | |
| 1338 | |
| 1339 foreach target $pkgconf::known_targets { | |
| 1340 if { [string length $target] > $name_maxlen} { | |
| 1341 set name_maxlen [string length $target] | |
| 1342 } | |
| 1343 } | |
| 1344 | |
| 1345 puts "Known targets:" | |
| 1346 foreach target $pkgconf::known_targets { | |
| 1347 | |
| 1348 puts "[format " %-*s : aliases $pkgconf::target_data($target,alias)" $name_maxlen $target]" | |
| 1349 | |
| 1350 set packages $pkgconf::target_data($target,packages) | |
| 1351 if { [llength $packages] > 0 } { | |
| 1352 puts " Required packages" | |
| 1353 foreach package $packages { | |
| 1354 puts " [pkgconf::get_package_alias $package] ($package)" | |
| 1355 } | |
| 1356 } | |
| 1357 | |
| 1358 foreach platform $pkgconf::target_data($target,known_platforms) { | |
| 1359 puts " Platform $platform, supported startups $pkgconf::target_data($target,$platform,startup)" | |
| 1360 set packages $pkgconf::target_data($target,$platform,packages) | |
| 1361 if { [llength $packages] > 0 } { | |
| 1362 puts " Required packages" | |
| 1363 foreach package $packages { | |
| 1364 puts " [pkgconf::get_package_alias $package] ($package)" | |
| 1365 } | |
| 1366 } | |
| 1367 } | |
| 1368 } | |
| 1369 } | |
| 1370 } | |
| 1371 | |
| 1372 # | |
| 1373 # Given a target name as supplied by the user, return the internal target name. | |
| 1374 # This involves searching through the list of aliases. | |
| 1375 # | |
| 1376 proc pkgconf::find_target { name } { | |
| 1377 | |
| 1378 foreach target $pkgconf::known_targets { | |
| 1379 | |
| 1380 if { [string toupper $target] == [string toupper $name] } { | |
| 1381 return $target | |
| 1382 } | |
| 1383 | |
| 1384 foreach alias $pkgconf::target_data($target,alias) { | |
| 1385 if { [string toupper $alias] == [string toupper $name] } { | |
| 1386 return $target | |
| 1387 } | |
| 1388 } | |
| 1389 } | |
| 1390 | |
| 1391 return "" | |
| 1392 } | |
| 1393 | |
| 1394 # | |
| 1395 # Ditto but for a given platform name. The target name must be known already. | |
| 1396 # | |
| 1397 | |
| 1398 proc pkgconf::find_platform { target name } { | |
| 1399 | |
| 1400 pkgconf::ASSERT { [lsearch -exact $pkgconf::known_targets $target] != -1 } | |
| 1401 | |
| 1402 foreach platform $pkgconf::target_data($target,known_platforms) { | |
| 1403 | |
| 1404 if { [string toupper $platform] == [string toupper $name] } { | |
| 1405 return $platform | |
| 1406 } | |
| 1407 | |
| 1408 foreach alias $pkgconf::target_data($target,$platform,alias) { | |
| 1409 | |
| 1410 if { [string toupper $alias] == [string toupper $name] } { | |
| 1411 return $platform | |
| 1412 } | |
| 1413 } | |
| 1414 } | |
| 1415 return "" | |
| 1416 } | |
| 1417 | |
| 1418 # | |
| 1419 # Given a target name, return the first alias. This is useful for output | |
| 1420 # code. | |
| 1421 # | |
| 1422 proc pkgconf::get_target_alias { name } { | |
| 1423 | |
| 1424 pkgconf::ASSERT { [lsearch -exact $pkgconf::known_targets $name] != -1 } | |
| 1425 | |
| 1426 set alias [lindex $pkgconf::target_data($name,alias) 0] | |
| 1427 return $alias | |
| 1428 } | |
| 1429 | |
| 1430 # | |
| 1431 # Ditto for platforms. | |
| 1432 # | |
| 1433 proc pkgconf::get_platform_alias { target name } { | |
| 1434 | |
| 1435 pkgconf::ASSERT { [lsearch -exact $pkgconf::known_targets $target] != -1 } | |
| 1436 pkgconf::ASSERT { [lsearch -exact $pkgconf::target_data($target,known_platforms) $name] != -1 } | |
| 1437 | |
| 1438 set alias [lindex $pkgconf::target_data($target,$name,alias) 0] | |
| 1439 return $alias | |
| 1440 } | |
| 1441 | |
| 1442 # | |
| 1443 # For a given target and platform, return an appropriate set of compiler flags. | |
| 1444 # | |
| 1445 proc pkgconf::get_platform_cflags { target platform flag } { | |
| 1446 | |
| 1447 ASSERT { [lsearch -exact $pkgconf::known_targets $target] != -1 } | |
| 1448 ASSERT { [lsearch -exact $pkgconf::target_data($target,known_platforms) $platform] != -1 } | |
| 1449 ASSERT { [lsearch -exact $pkgconf::known_compiler_flags $flag] != -1 } | |
| 1450 | |
| 1451 # A particular flag may be defined specifically for a platform. | |
| 1452 # Or it may come from the target information. Or there may not be | |
| 1453 # a default value. | |
| 1454 if { [info exists pkgconf::target_data($target,$platform,cflags,$flag)] != 0 } { | |
| 1455 return $pkgconf::target_data($target,$platform,cflags,$flag) | |
| 1456 } elseif { [info exists pkgconf::target_data($target,cflags,$flag)] != 0 } { | |
| 1457 return $pkgconf::target_data($target,cflags,$flag) | |
| 1458 } else { | |
| 1459 return "" | |
| 1460 } | |
| 1461 } | |
| 1462 | |
| 1463 # | |
| 1464 # Is a given target or platform actually valid ? This code copes | |
| 1465 # with aliases as well. | |
| 1466 proc pkgconf::is_target { name } { | |
| 1467 | |
| 1468 ASSERT { $name != "" } | |
| 1469 | |
| 1470 set name [find_target $name] | |
| 1471 set result 0 | |
| 1472 if { $name != "" } { | |
| 1473 set result 1 | |
| 1474 } | |
| 1475 return $result | |
| 1476 } | |
| 1477 | |
| 1478 proc pkgconf::is_platform { target name } { | |
| 1479 | |
| 1480 ASSERT { $target != "" } | |
| 1481 ASSERT { $name != "" } | |
| 1482 | |
| 1483 set target [find_target $target] | |
| 1484 ASSERT { $target != "" } | |
| 1485 | |
| 1486 set name [find_platform $target $name] | |
| 1487 set result 0 | |
| 1488 if { $name != "" } { | |
| 1489 set result 1 | |
| 1490 } | |
| 1491 return $result | |
| 1492 } | |
| 1493 | |
| 1494 proc pkgconf::is_startup { target platform name } { | |
| 1495 | |
| 1496 ASSERT { $target != "" } | |
| 1497 ASSERT { $name != "" } | |
| 1498 | |
| 1499 set target [find_target $target] | |
| 1500 ASSERT { $target != "" } | |
| 1501 | |
| 1502 set platform [find_platform $target $platform] | |
| 1503 ASSERT { $platform != "" } | |
| 1504 | |
| 1505 set index [lsearch -exact $pkgconf::target_data($target,$platform,startup) $name] | |
| 1506 set result 0 | |
| 1507 if { $index != -1 } { | |
| 1508 set result 1 | |
| 1509 } | |
| 1510 return $result | |
| 1511 } | |
| 1512 | |
| 1513 # | |
| 1514 # Get hold of the default platform and startup for a given target. | |
| 1515 | |
| 1516 proc pkgconf::get_default_platform { target } { | |
| 1517 | |
| 1518 ASSERT { $target != "" } | |
| 1519 | |
| 1520 set target [find_target $target] | |
| 1521 ASSERT { $target != "" } | |
| 1522 | |
| 1523 set platform [lindex $pkgconf::target_data($target,known_platforms) 0] | |
| 1524 return $platform | |
| 1525 } | |
| 1526 | |
|
12
4cc3eff958ab
Merge from eCos master repository on 1999-06-04-22:24:56-BST
jlarmour
parents:
4
diff
changeset
|
1527 proc pkgconf::get_base_platform { target platform } { |
|
4cc3eff958ab
Merge from eCos master repository on 1999-06-04-22:24:56-BST
jlarmour
parents:
4
diff
changeset
|
1528 |
|
4cc3eff958ab
Merge from eCos master repository on 1999-06-04-22:24:56-BST
jlarmour
parents:
4
diff
changeset
|
1529 ASSERT { $target != "" } |
|
4cc3eff958ab
Merge from eCos master repository on 1999-06-04-22:24:56-BST
jlarmour
parents:
4
diff
changeset
|
1530 ASSERT { $platform != "" } |
|
4cc3eff958ab
Merge from eCos master repository on 1999-06-04-22:24:56-BST
jlarmour
parents:
4
diff
changeset
|
1531 |
|
4cc3eff958ab
Merge from eCos master repository on 1999-06-04-22:24:56-BST
jlarmour
parents:
4
diff
changeset
|
1532 set target [find_target $target] |
|
4cc3eff958ab
Merge from eCos master repository on 1999-06-04-22:24:56-BST
jlarmour
parents:
4
diff
changeset
|
1533 ASSERT { $target != "" } |
|
4cc3eff958ab
Merge from eCos master repository on 1999-06-04-22:24:56-BST
jlarmour
parents:
4
diff
changeset
|
1534 set platform [find_platform $target $platform] |
|
4cc3eff958ab
Merge from eCos master repository on 1999-06-04-22:24:56-BST
jlarmour
parents:
4
diff
changeset
|
1535 ASSERT { $platform != "" } |
|
4cc3eff958ab
Merge from eCos master repository on 1999-06-04-22:24:56-BST
jlarmour
parents:
4
diff
changeset
|
1536 |
|
4cc3eff958ab
Merge from eCos master repository on 1999-06-04-22:24:56-BST
jlarmour
parents:
4
diff
changeset
|
1537 if [info exists pkgconf::target_data($target,$platform,base_platform) ] { |
|
4cc3eff958ab
Merge from eCos master repository on 1999-06-04-22:24:56-BST
jlarmour
parents:
4
diff
changeset
|
1538 set base_platform [lindex $pkgconf::target_data($target,$platform,base_platform) 0] |
|
4cc3eff958ab
Merge from eCos master repository on 1999-06-04-22:24:56-BST
jlarmour
parents:
4
diff
changeset
|
1539 } else { |
|
4cc3eff958ab
Merge from eCos master repository on 1999-06-04-22:24:56-BST
jlarmour
parents:
4
diff
changeset
|
1540 set base_platform $platform |
|
4cc3eff958ab
Merge from eCos master repository on 1999-06-04-22:24:56-BST
jlarmour
parents:
4
diff
changeset
|
1541 } |
|
4cc3eff958ab
Merge from eCos master repository on 1999-06-04-22:24:56-BST
jlarmour
parents:
4
diff
changeset
|
1542 return $base_platform |
|
4cc3eff958ab
Merge from eCos master repository on 1999-06-04-22:24:56-BST
jlarmour
parents:
4
diff
changeset
|
1543 } |
|
4cc3eff958ab
Merge from eCos master repository on 1999-06-04-22:24:56-BST
jlarmour
parents:
4
diff
changeset
|
1544 |
| 0 | 1545 proc pkgconf::get_default_startup { target platform } { |
| 1546 | |
| 1547 ASSERT { $target != "" } | |
| 1548 ASSERT { $platform != "" } | |
| 1549 | |
| 1550 set target [find_target $target] | |
| 1551 ASSERT { $target != "" } | |
| 1552 set platform [find_platform $target $platform] | |
| 1553 ASSERT { $platform != "" } | |
| 1554 | |
| 1555 set startup [lindex $pkgconf::target_data($target,$platform,startup) 0] | |
| 1556 return $startup | |
| 1557 } | |
| 1558 | |
| 1559 # }}} | |
| 1560 # {{{ Configuration Data | |
| 1561 | |
| 1562 # {{{ setup_defaults | |
| 1563 | |
| 1564 # ---------------------------------------------------------------------------- | |
| 1565 # The setup_defaults routine is responsible for deciding on default values. | |
| 1566 # If there is only one supported architecture then this can be selected, | |
| 1567 # and then it is also possible to select a platform and a startup mode. | |
| 1568 # All known packages can be enabled by default, and the latest version | |
| 1569 # of each package can be selected. | |
| 1570 # | |
| 1571 # All configuration data is held in the array config_data(). It is | |
| 1572 # important to make sure that all fields are initialised. | |
| 1573 # | |
| 1574 | |
| 1575 proc pkgconf::setup_defaults { } { | |
| 1576 | |
| 1577 ASSERT { [llength [array names pkgconf::config_data] ] == 0 } | |
| 1578 ASSERT { $pkgconf::known_packages != "" } | |
| 1579 ASSERT { $pkgconf::known_targets != "" } | |
| 1580 ASSERT { $pkgconf::build_tree != "" } | |
| 1581 | |
| 1582 set pkgconf::config_data(target) "" | |
| 1583 set pkgconf::config_data(platform) "" | |
|
12
4cc3eff958ab
Merge from eCos master repository on 1999-06-04-22:24:56-BST
jlarmour
parents:
4
diff
changeset
|
1584 set pkgconf::config_data(base_platform) "" |
| 0 | 1585 set pkgconf::config_data(startup) "" |
| 1586 set pkgconf::config_data(prefix) "" | |
| 1587 set pkgconf::config_data(use_links) 0 | |
| 1588 | |
| 1589 # Packages fall into a number of different categories. | |
| 1590 # | |
| 1591 # 1) some packages are hardware-specific. They should be enabled | |
| 1592 # by default if that hardware has been selected, but the user | |
| 1593 # must still be able to disable them in case they cause problems. | |
| 1594 # | |
| 1595 # 2) some packages are enabled by default, but can be disabled by | |
| 1596 # the user. There are actually some packages that should never | |
| 1597 # be disabled, especially infra, but that would complicate things. | |
| 1598 # | |
| 1599 # 3) some packages are disabled by default, but can be enabled by | |
| 1600 # the user. | |
| 1601 # | |
| 1602 # The easiest way to track this information is to store the target | |
| 1603 # and platform data, which gives us the hardware packages, plus | |
| 1604 # separate lists of which packages are explicitly enabled or disabled. | |
| 1605 # All other information can be derived from that. | |
| 1606 set pkgconf::config_data(enabled_packages) "" | |
| 1607 set pkgconf::config_data(disabled_packages) "" | |
| 1608 | |
| 1609 # For each package fill in a default version number. | |
| 1610 foreach pkg $pkgconf::known_packages { | |
| 1611 | |
| 1612 ASSERT { $pkgconf::package_data($pkg,versions) != "" } | |
| 1613 ASSERT { [info exists pkgconf::config_data($pkg,version)] == 0 } | |
| 1614 set pkgconf::config_data($pkg,version) [lindex $pkgconf::package_data($pkg,versions) 0] | |
| 1615 } | |
| 1616 | |
| 1617 # If there is only one target architecture, default to it. Also | |
| 1618 # default to the first platform for that target and the first | |
| 1619 # startup for that platform. | |
| 1620 if { [llength $pkgconf::known_targets] == 1 } { | |
| 1621 set pkgconf::config_data(target) [lindex $pkgconf::known_targets 0] | |
| 1622 | |
| 1623 ASSERT { $pkgconf::target_data($pkgconf::config_data(target),known_platforms) != "" } | |
| 1624 set pkgconf::config_data(platform) [get_default_platform $pkgconf::config_data(target)] | |
|
12
4cc3eff958ab
Merge from eCos master repository on 1999-06-04-22:24:56-BST
jlarmour
parents:
4
diff
changeset
|
1625 set pkgconf::config_data(base_platform) [get_base_platform $pkgconf::config_data(target) $pkgconf::config_data(platform)] |
| 0 | 1626 |
| 1627 ASSERT { $pkgconf::target_data($pkgconf::config_data(target),$pkgconf::config_data(platform),startup) != "" } | |
| 1628 set pkgconf::config_data(startup) [get_default_startup $pkgconf::config_data(target) $pkgconf::config_data(platform)] | |
| 1629 } | |
| 1630 | |
| 1631 if { [info exists ::env(PKGCONF_USE_LINKS)] } { | |
| 1632 set pkgconf::config_data(use_links) 1 | |
| 1633 } | |
| 1634 | |
| 1635 if { 0 } { | |
| 1636 foreach i [array names pkgconf::config_data] { | |
| 1637 puts "pkgconf::config_data($i) : $pkgconf::config_data($i)" | |
| 1638 } | |
| 1639 exit 0 | |
| 1640 } | |
| 1641 } | |
| 1642 | |
| 1643 # }}} | |
| 1644 # {{{ read_save_file | |
| 1645 | |
| 1646 # ---------------------------------------------------------------------------- | |
| 1647 # The build tree may have a save file. The aim here is that | |
| 1648 # if the user wants to change some aspects of the configuration, e.g. to | |
| 1649 # switch between the eval board and the simulator, it should not be | |
| 1650 # necessary to pass all the command line arguments again. Instead the | |
| 1651 # system should work out past settings and re-use those where possible. | |
| 1652 # | |
| 1653 # This routine should be invoked after the defaults are set up but | |
| 1654 # before the command line arguments take effect. | |
| 1655 # | |
| 1656 # There is a command line argument --defaults which stops the saved | |
| 1657 # values from taking effect. The save file is still read in because | |
| 1658 # it is useful to know what is in the build tree at the moment. | |
| 1659 # | |
| 1660 | |
| 1661 proc pkgconf::read_save_file { } { | |
| 1662 | |
| 1663 ASSERT { $pkgconf::build_tree != "" } | |
| 1664 | |
| 1665 # Get rid of any old settings that might be hanging around. | |
| 1666 foreach i [array names pkgconf::saved_data] { | |
| 1667 unset pkgconf::saved_data($i) | |
| 1668 } | |
| 1669 | |
| 1670 set filename [file join $pkgconf::build_tree "pkgconf.sav"] | |
| 1671 if { [file exists $filename] && [file isfile $filename] } { | |
| 1672 | |
| 1673 # Read in the saved data. A safe interpreter is used, just in case. | |
| 1674 proc set_saved_data { name value } { | |
| 1675 set pkgconf::saved_data($name) $value | |
| 1676 } | |
| 1677 set parser [interp create -safe] | |
| 1678 $parser alias set_saved_data pkgconf::set_saved_data | |
| 1679 | |
| 1680 set status [ catch { | |
| 1681 set fd [open $filename r] | |
| 1682 set script [read $fd] | |
| 1683 close $fd | |
| 1684 $parser eval $script | |
| 1685 } message] | |
| 1686 if { $status != 0 } { | |
| 1687 pkgconf::fatal_error "Unexpected error while reading back save file $filename\n$message" | |
| 1688 } | |
| 1689 | |
| 1690 rename set_saved_data {} | |
| 1691 interp delete $parser | |
| 1692 } | |
| 1693 | |
| 1694 # It is a good idea to check that the data read back is consistent. | |
| 1695 # It is also a good idea to check some aliases, in case something | |
| 1696 # has been renamed between releases. | |
| 1697 if { [info exists pkgconf::saved_data(target)] } { | |
| 1698 | |
| 1699 set target_name [find_target $pkgconf::saved_data(target)] | |
| 1700 if { $target_name == "" } { | |
| 1701 warning "The save file $filename contained an invalid target $pkgconf::saved_data(target). This has been ignored." | |
| 1702 } else { | |
| 1703 set pkgconf::saved_data(target) $target_name | |
| 1704 set pkgconf::config_data(target) $target_name | |
| 1705 set pkgconf::config_data(platform) [get_default_platform $pkgconf::config_data(target)] | |
|
12
4cc3eff958ab
Merge from eCos master repository on 1999-06-04-22:24:56-BST
jlarmour
parents:
4
diff
changeset
|
1706 set pkgconf::config_data(base_platform) [get_base_platform $pkgconf::config_data(target) $pkgconf::config_data(platform)] |
| 0 | 1707 set pkgconf::config_data(startup) \ |
| 1708 [get_default_startup $pkgconf::config_data(target) $pkgconf::config_data(platform)] | |
| 1709 } | |
| 1710 } | |
| 1711 | |
| 1712 # There is no point in validating platform or startup unless the target is known. | |
| 1713 if { $pkgconf::config_data(target) != "" } { | |
| 1714 | |
| 1715 ASSERT { $pkgconf::target_data($pkgconf::config_data(target),known_platforms) != "" } | |
| 1716 | |
| 1717 if { [info exists pkgconf::saved_data(platform)] } { | |
| 1718 | |
| 1719 set platform_name [find_platform $pkgconf::config_data(target) $pkgconf::saved_data(platform)] | |
| 1720 if { $platform_name == "" } { | |
| 1721 warning \ | |
| 1722 "The save file $filename specified an unknown platform $pkgconf::saved_data(platform).\ | |
| 1723 The platform $pkgconf::config_data(platform) has been substituted." | |
| 1724 } else { | |
| 1725 set pkgconf::saved_data(platform) $platform_name | |
| 1726 set pkgconf::config_data(platform) $platform_name | |
|
12
4cc3eff958ab
Merge from eCos master repository on 1999-06-04-22:24:56-BST
jlarmour
parents:
4
diff
changeset
|
1727 set pkgconf::config_data(base_platform) [get_base_platform $pkgconf::config_data(target) $pkgconf::saved_data(platform)] |
| 0 | 1728 set pkgconf::config_data(startup) [get_default_startup $pkgconf::config_data(target) $platform_name] |
| 1729 } | |
| 1730 | |
| 1731 } | |
| 1732 | |
| 1733 # Currently if there is a target then there is always a platform, | |
| 1734 # possibly the default one. | |
| 1735 ASSERT { $pkgconf::target_data($pkgconf::config_data(target),$pkgconf::config_data(platform),startup) != "" } | |
| 1736 | |
| 1737 if { [info exists pkgconf::saved_data(startup)] } { | |
| 1738 | |
| 1739 if { [is_startup $pkgconf::config_data(target) $pkgconf::config_data(platform) $pkgconf::saved_data(startup)] \ | |
| 1740 == 0 } { | |
| 1741 warning \ | |
| 1742 "The save file $filename specified an unknown startup $pkgconf::saved_data(startup).\ | |
| 1743 $pkgconf::config_data(startup) startup has been substituted." | |
| 1744 } else { | |
| 1745 set pkgconf::config_data(startup) $pkgconf::saved_data(startup) | |
| 1746 } | |
| 1747 } | |
| 1748 } | |
| 1749 | |
| 1750 # There should be an entry listing all packages for which there is | |
| 1751 # a version entry. This can be used to update the version numbers | |
| 1752 # which should be used in this configuration. | |
| 1753 if { [info exists pkgconf::saved_data(versioned_packages) ] != 0 } { | |
| 1754 foreach pkg $pkgconf::saved_data(versioned_packages) { | |
| 1755 | |
| 1756 # Check that there is a saved version string for this package. | |
| 1757 # There should be, but it is not worth worrying about. | |
| 1758 if { [info exists pkgconf::saved_data($pkg,version)] == 0 } { | |
| 1759 continue | |
| 1760 } | |
| 1761 set version $pkgconf::saved_data($pkg,version) | |
| 1762 | |
| 1763 # Does this package still exist ? | |
| 1764 if { [is_package $pkg] == 0 } { | |
| 1765 warning \ | |
| 1766 "The save file $filename specified version $version for package $pkg.\ | |
| 1767 This package does not exist in the current repository, so the version string\ | |
| 1768 has been ignored." | |
| 1769 continue | |
| 1770 } | |
| 1771 set pkg [find_package $pkg] | |
| 1772 ASSERT { $pkg != "" } | |
| 1773 | |
| 1774 # Is the version valid ? | |
| 1775 if { [is_valid_version $pkg $version] == 0 } { | |
| 1776 warning \ | |
| 1777 "The save file $filename specified version $version for package $pkg.\ | |
| 1778 This version is not present in the current repository so the version\ | |
| 1779 string has been ignored." | |
| 1780 } else { | |
| 1781 set pkgconf::config_data($pkg,version) $version | |
| 1782 } | |
| 1783 } | |
| 1784 } | |
| 1785 | |
| 1786 # Now check that all the packages listed in the save file are known. | |
| 1787 # If any are missing then they are just discarded. Known packages | |
| 1788 # are used to update the appropriate current configuration data. | |
| 1789 if { [info exists pkgconf::saved_data(enabled_packages)] == 0 } { | |
| 1790 set pkgconf::saved_data(enabled_packages) "" | |
| 1791 } | |
| 1792 if { [info exists pkgconf::saved_data(disabled_packages)] == 0 } { | |
| 1793 set pkgconf::saved_data(disabled_packages) "" | |
| 1794 } | |
| 1795 | |
| 1796 foreach pkg $pkgconf::saved_data(enabled_packages) { | |
| 1797 | |
| 1798 if { [is_package $pkg] == 0 } { | |
| 1799 warning \ | |
| 1800 "The save file $filename mentioned a package $pkg.\ | |
| 1801 This package does not exist in the current repository and | |
| 1802 has been ignored." | |
| 1803 continue | |
| 1804 } | |
| 1805 | |
| 1806 set pkg [find_package $pkg] | |
| 1807 set index [lsearch -exact $pkgconf::config_data(enabled_packages) $pkg] | |
| 1808 if { $index == -1 } { | |
| 1809 lappend pkgconf::config_data(enabled_packages) $pkg | |
| 1810 } | |
| 1811 } | |
| 1812 | |
| 1813 foreach pkg $pkgconf::saved_data(disabled_packages) { | |
| 1814 | |
| 1815 if { [is_package $pkg] == 0 } { | |
| 1816 warning \ | |
| 1817 "The save file $filename mentioned a package $pkg.\ | |
| 1818 This package does not exist in the current repository and | |
| 1819 has been ignored." | |
| 1820 continue | |
| 1821 } | |
| 1822 | |
| 1823 set pkg [find_package $pkg] | |
| 1824 set index [lsearch -exact $pkgconf::config_data(disabled_packages) $pkg] | |
| 1825 if { $index == -1 } { | |
| 1826 lappend pkgconf::config_data(disabled_packages) $pkg | |
| 1827 } | |
| 1828 | |
| 1829 # Better make sure that a package is not simultaneously enabled and disabled. | |
| 1830 set index [lsearch -exact $pkgconf::config_data(enabled_packages) $pkg] | |
| 1831 if { $index != -1 } { | |
| 1832 set pkgconf::config_data(enabled_packages) [lreplace $pkgconf::config_data(enabled_packages) $index $index] | |
| 1833 } | |
| 1834 } | |
| 1835 | |
| 1836 # Now check for any compiler flags | |
| 1837 foreach flag $pkgconf::known_compiler_flags { | |
| 1838 if { [info exists pkgconf::saved_data(cflags,$flag)] } { | |
| 1839 set pkgconf::config_data(cflags,$flag) $pkgconf::saved_data(cflags,$flag) | |
| 1840 } | |
| 1841 } | |
| 1842 | |
| 1843 # Update the install directory if appropriate. | |
| 1844 # There is not a lot of checking that can be done here. | |
| 1845 if { [info exists pkgconf::saved_data(prefix) ] } { | |
| 1846 set pkgconf::config_data(prefix) $pkgconf::saved_data(prefix) | |
| 1847 } | |
| 1848 | |
| 1849 # And check for the use_links option | |
| 1850 if { [info exists pkgconf::saved_data(use_links)] } { | |
| 1851 set pkgconf::config_data(use_links) $pkgconf::saved_data(use_links) | |
| 1852 } | |
| 1853 | |
| 1854 # Now, possibly undo all of this if the user specified --defaults. | |
| 1855 if { $pkgconf::defaults_arg != 0 } { | |
| 1856 foreach entry [array names pkgconf::config_data] { | |
| 1857 unset pkgconf::config_data($entry) | |
| 1858 } | |
| 1859 setup_defaults | |
| 1860 } | |
| 1861 | |
| 1862 if { 0 } { | |
| 1863 foreach i [array names pkgconf::config_data] { | |
| 1864 puts "pkgconf::config_data($i) : $pkgconf::config_data($i)" | |
| 1865 } | |
| 1866 exit 0 | |
| 1867 } | |
| 1868 } | |
| 1869 | |
| 1870 # }}} | |
| 1871 # {{{ write_save_file | |
| 1872 | |
| 1873 # ---------------------------------------------------------------------------- | |
| 1874 # Outputting the save file. This is a relatively simple operation assuming | |
| 1875 # no file I/O errors happen. The saved_data array is updated with the new | |
| 1876 # contents of the save file. It is not yet clear whether this will be useful, | |
| 1877 # but it should not cause any problems either. | |
| 1878 # | |
| 1879 | |
| 1880 proc pkgconf::write_save_file { } { | |
| 1881 | |
| 1882 # Check for minimal consistency. If any variables are missing then | |
| 1883 # this will be handled (poorly) by the catch statement. | |
| 1884 ASSERT { [info exists pkgconf::config_data(target)] } | |
| 1885 ASSERT { $pkgconf::build_tree != "" } | |
| 1886 | |
| 1887 set savename [file join $pkgconf::build_tree "pkgconf.sav"] | |
| 1888 set open_file "" | |
| 1889 | |
| 1890 set status [catch { | |
| 1891 | |
| 1892 set open_file [open $savename w] | |
| 1893 output_banner $open_file "pkgconf.sav" | |
| 1894 | |
| 1895 if { $pkgconf::config_data(target) != "" } { | |
| 1896 puts $open_file "set_saved_data target $pkgconf::config_data(target)" | |
| 1897 set pkgconf::saved_data(target) $pkgconf::config_data(target) | |
| 1898 } | |
| 1899 if { $pkgconf::config_data(platform) != "" } { | |
| 1900 puts $open_file "set_saved_data platform $pkgconf::config_data(platform)" | |
| 1901 set pkgconf::saved_data(platform) $pkgconf::config_data(platform) | |
| 1902 } | |
|
12
4cc3eff958ab
Merge from eCos master repository on 1999-06-04-22:24:56-BST
jlarmour
parents:
4
diff
changeset
|
1903 if { $pkgconf::config_data(base_platform) != "" } { |
|
4cc3eff958ab
Merge from eCos master repository on 1999-06-04-22:24:56-BST
jlarmour
parents:
4
diff
changeset
|
1904 puts $open_file "set_saved_data base_platform $pkgconf::config_data(base_platform)" |
|
4cc3eff958ab
Merge from eCos master repository on 1999-06-04-22:24:56-BST
jlarmour
parents:
4
diff
changeset
|
1905 set pkgconf::saved_data(base_platform) $pkgconf::config_data(base_platform) |
|
4cc3eff958ab
Merge from eCos master repository on 1999-06-04-22:24:56-BST
jlarmour
parents:
4
diff
changeset
|
1906 } |
| 0 | 1907 if { $pkgconf::config_data(startup) != "" } { |
| 1908 puts $open_file "set_saved_data startup $pkgconf::config_data(startup)" | |
| 1909 set pkgconf::saved_data(startup) $pkgconf::config_data(startup) | |
| 1910 } | |
| 1911 if { $pkgconf::config_data(enabled_packages) != "" } { | |
| 1912 # The use of the list command here avoids problems with multiple | |
| 1913 # arguments when the file is read back. | |
| 1914 puts $open_file "set_saved_data enabled_packages [list $pkgconf::config_data(enabled_packages)]" | |
| 1915 set pkgconf::saved_data(enabled_packages) $pkgconf::config_data(enabled_packages) | |
| 1916 } | |
| 1917 if { $pkgconf::config_data(disabled_packages) != "" } { | |
| 1918 puts $open_file "set_saved_data disabled_packages [list $pkgconf::config_data(disabled_packages)]" | |
| 1919 set pkgconf::saved_data(disabled_packages) $pkgconf::config_data(disabled_packages) | |
| 1920 } | |
| 1921 foreach pkg $pkgconf::known_packages { | |
| 1922 ASSERT { [info exists pkgconf::config_data($pkg,version)] } | |
| 1923 puts $open_file "set_saved_data \"$pkg,version\" $pkgconf::config_data($pkg,version)" | |
| 1924 set pkgconf::saved_data($pkg,version) $pkgconf::config_data($pkg,version) | |
| 1925 } | |
| 1926 # This allows the versions to be read back in more easily, even if | |
| 1927 # there is a change to the number of packages. | |
| 1928 puts $open_file "set_saved_data versioned_packages [list $pkgconf::known_packages]" | |
| 1929 | |
| 1930 foreach flag $pkgconf::known_compiler_flags { | |
| 1931 if { [info exists pkgconf::config_data(cflags,$flag)] != 0 } { | |
| 1932 puts $open_file "set_saved_data \"cflags,$flag\" \"$pkgconf::config_data(cflags,$flag)\"" | |
| 1933 } | |
| 1934 } | |
| 1935 if { $pkgconf::config_data(use_links) != 0 } { | |
| 1936 puts $open_file "set_saved_data use_links 1" | |
| 1937 } | |
| 1938 | |
| 1939 puts $open_file "set_saved_data prefix \"$pkgconf::config_data(prefix)\"" | |
| 1940 set pkgconf::saved_data(prefix) $pkgconf::config_data(prefix) | |
| 1941 | |
| 1942 puts $open_file "\n# End of $savename" | |
| 1943 close $open_file | |
| 1944 } message ] | |
| 1945 | |
| 1946 if { $status != 0 } { | |
| 1947 | |
| 1948 if { $open_file != "" } { | |
| 1949 # Whatever error occurred, it happened after the file was opened. | |
| 1950 # This is bad news, the file may be corrupt. To avoid complications, | |
| 1951 # try to delete it. | |
| 1952 catch { | |
| 1953 close $open_file | |
| 1954 file delete $savename | |
| 1955 } | |
| 1956 # Also get rid of the saved_data array. | |
| 1957 foreach i [array names saved_data] { | |
| 1958 unset saved_data($i) | |
| 1959 } | |
| 1960 } | |
| 1961 fatal_error "An unexpected error occurred while generating the save file $savename: $message" | |
| 1962 } | |
| 1963 } | |
| 1964 | |
| 1965 # }}} | |
| 1966 # {{{ process_arguments() | |
| 1967 | |
| 1968 # ---------------------------------------------------------------------------- | |
| 1969 # This procedure takes care of updating the configuration information using | |
| 1970 # the command line arguments, for example if there was an argument specifying | |
| 1971 # a different version for a particular package then it is this procedure | |
| 1972 # which takes care of it. This procedure also takes care of validating the | |
| 1973 # arguments. | |
| 1974 # | |
| 1975 # This procedure should be invoked after setup_defaults has filled in the | |
| 1976 # default values for all configuration data, and after read_save_file | |
| 1977 # has updated them with saved data. | |
| 1978 # | |
| 1979 # There is a separate validation routine which gets invoked first. | |
| 1980 # This takes care of serious errors in the command line arguments. | |
| 1981 # | |
| 1982 | |
| 1983 proc pkgconf::process_arguments { } { | |
| 1984 | |
| 1985 variable known_compiler_flags | |
| 1986 variable known_packages | |
| 1987 variable package_data | |
| 1988 variable known_targets | |
| 1989 variable target_data | |
| 1990 | |
| 1991 variable config_data | |
| 1992 variable target_arg | |
| 1993 variable platform_arg | |
| 1994 variable startup_arg | |
| 1995 variable prefix_arg | |
| 1996 variable disable_args | |
| 1997 variable enable_args | |
| 1998 variable version_args | |
| 1999 variable use_links_arg | |
| 2000 variable use_copies_arg | |
| 2001 variable cflags_args | |
| 2002 | |
| 2003 # Constructing the file name strings here facilitates generating | |
| 2004 # error messages. | |
| 2005 set packages_file [file join $pkgconf::component_repository "packages"] | |
| 2006 set targets_file [file join $pkgconf::component_repository "targets"] | |
| 2007 | |
| 2008 # The target, platform, and startup values are used throughout so it | |
| 2009 # is convenient to have locals. | |
| 2010 set target $pkgconf::config_data(target) | |
| 2011 set platform $pkgconf::config_data(platform) | |
| 2012 set startup $pkgconf::config_data(startup) | |
| 2013 | |
| 2014 # Start by validating the --target argument This target must | |
| 2015 # be present in the known_targets list. If it is then the | |
| 2016 # target architecture can be updated. | |
| 2017 | |
| 2018 if { $pkgconf::target_arg != "" } { | |
| 2019 | |
| 2020 set target [find_target $pkgconf::target_arg] | |
| 2021 if { $target == "" } { | |
| 2022 fatal_error "Invalid argument --target=$target_arg, this target is not listed in $targets_file" | |
| 2023 } | |
| 2024 set pkgconf::config_data(target) $target | |
| 2025 | |
| 2026 # It is possible that the platform and startup data from the save file | |
| 2027 # are no longer valid because of a change in the target. If so then the | |
| 2028 # relevant fields have to be cleared. | |
| 2029 if { $platform != "" } { | |
| 2030 set platform [find_platform $target $platform] | |
| 2031 set pkgconf::config_data(platform) $platform | |
|
12
4cc3eff958ab
Merge from eCos master repository on 1999-06-04-22:24:56-BST
jlarmour
parents:
4
diff
changeset
|
2032 set pkgconf::config_data(base_platform) [get_base_platform $target $platform] |
| 0 | 2033 if { ($platform != "") && ($startup != "") } { |
| 2034 if { [lsearch -exact $pkgconf::target_data($target,$platform,startup) $startup] == -1 } { | |
| 2035 set startup "" | |
| 2036 set pkgconf::config_data(startup) "" | |
| 2037 } | |
| 2038 } | |
| 2039 } | |
| 2040 | |
| 2041 # Next, if the platform and startup are not currently known then | |
| 2042 # it is possible to set up defaults for this target. | |
| 2043 if { $platform == "" } { | |
| 2044 set platform [lindex $pkgconf::target_data($target,known_platforms) 0] | |
| 2045 set pkgconf::config_data(platform) $platform | |
| 2046 } | |
| 2047 if { $startup == "" } { | |
| 2048 set startup [lindex $pkgconf::target_data($target,$platform,startup) 0] | |
| 2049 set pkgconf::config_data(startup) $startup | |
| 2050 } | |
| 2051 } | |
| 2052 | |
| 2053 # If the target is known then it is possible to verify platform and startup | |
| 2054 # arguments. Without a target these arguments are meaningless. | |
| 2055 | |
| 2056 if { ($target != "") && ($pkgconf::platform_arg != "") } { | |
| 2057 | |
| 2058 set platform [find_platform $target $pkgconf::platform_arg] | |
| 2059 if { $platform == "" } { | |
| 2060 fatal_error "Invalid argument --platform=$pkgconf::platform_arg, this platform is not listed in $targets_file" | |
| 2061 } | |
| 2062 set pkgconf::config_data(platform) $platform | |
| 2063 } | |
| 2064 | |
|
14
01ce82f3e11a
Merge from eCos master repository on 1999-06-11-17:05:41-BST
jlarmour
parents:
12
diff
changeset
|
2065 if { ($target != "") && ($platform != "") } { |
|
01ce82f3e11a
Merge from eCos master repository on 1999-06-11-17:05:41-BST
jlarmour
parents:
12
diff
changeset
|
2066 set pkgconf::config_data(base_platform) [get_base_platform $target $platform] |
|
01ce82f3e11a
Merge from eCos master repository on 1999-06-11-17:05:41-BST
jlarmour
parents:
12
diff
changeset
|
2067 } |
|
12
4cc3eff958ab
Merge from eCos master repository on 1999-06-04-22:24:56-BST
jlarmour
parents:
4
diff
changeset
|
2068 |
| 0 | 2069 if { ($target != "") && ($platform != "") && ($pkgconf::startup_arg != "" ) } { |
| 2070 | |
| 2071 if { [lsearch -exact $pkgconf::target_data($target,$platform,startup) $pkgconf::startup_arg] == -1 } { | |
| 2072 fatal_error "Invalid argument --startup=$startup_arg, this startup is not listed in $targets_file" | |
| 2073 } | |
| 2074 set startup $pkgconf::startup_arg | |
| 2075 set config_data(startup) $startup | |
| 2076 } | |
| 2077 | |
| 2078 # It is not really possible to validate the prefix argument. | |
| 2079 if { $pkgconf::prefix_arg != "" } { | |
| 2080 set pkgconf::config_data(prefix) $pkgconf::prefix_arg | |
| 2081 } | |
| 2082 | |
| 2083 # Cope with the use of symbolic links vs. copies | |
| 2084 if { $pkgconf::use_links_arg } { | |
| 2085 set pkgconf::config_data(use_links) 1 | |
| 2086 } | |
| 2087 if { $pkgconf::use_copies_arg } { | |
| 2088 set pkgconf::config_data(use_links) 0 | |
| 2089 } | |
| 2090 | |
| 2091 # For each package that is being disabled, make sure it is on the | |
| 2092 # list of disabled packages and not on the list of enabled packages. | |
| 2093 # The former operation is actually unnecessary if the package is | |
| 2094 # disabled by default, but harmless. | |
| 2095 foreach pkg $pkgconf::disable_args { | |
| 2096 set match [find_package $pkg] | |
| 2097 if { $match == "" } { | |
| 2098 fatal_error "Invalid argument --disable-$pkg, package $pkg is not listed in $packages_file." | |
| 2099 } | |
| 2100 | |
| 2101 set index [lsearch -exact $pkgconf::config_data(enabled_packages) $match] | |
| 2102 if { $index != -1 } { | |
| 2103 set pkgconf::config_data(enabled_packages) [lreplace $pkgconf::config_data(enabled_packages) $index $index] | |
| 2104 } | |
| 2105 set index [lsearch -exact $pkgconf::config_data(disabled_packages) $match] | |
| 2106 if { $index == -1 } { | |
| 2107 lappend pkgconf::config_data(disabled_packages) $match | |
| 2108 } | |
| 2109 } | |
| 2110 | |
| 2111 # For each package that should be enabled, add it to the list of enabled | |
| 2112 # packages and remove it from the list of disabled packages. Again the | |
| 2113 # former is actually unnecessary if the package is enabled by default. | |
| 2114 foreach pkg $pkgconf::enable_args { | |
| 2115 set match [find_package $pkg] | |
| 2116 if { $match == "" } { | |
| 2117 fatal_error "Invalid argument --enable-$pkg, package $pkg is not listed in $packages_file." | |
| 2118 } | |
| 2119 | |
| 2120 set index [lsearch -exact $pkgconf::config_data(disabled_packages) $match] | |
| 2121 if { $index != -1 } { | |
| 2122 set pkgconf::config_data(disabled_packages) [lreplace $pkgconf::config_data(disabled_packages) $index $index] | |
| 2123 } | |
| 2124 set index [lsearch -exact $pkgconf::config_data(enabled_packages) $match] | |
| 2125 if { $index == -1 } { | |
| 2126 lappend config_data(enabled_packages) $match | |
| 2127 } | |
| 2128 } | |
| 2129 | |
| 2130 # For each package where a version has been specified, validate this | |
| 2131 # version and use it. Also make sure that the package is enabled. | |
| 2132 foreach pkg [array names pkgconf::version_args] { | |
| 2133 | |
| 2134 set match [find_package $pkg] | |
| 2135 if { $match == "" } { | |
| 2136 fatal_error "Invalid argument --$pkg-version, package $pkg is not listed in $packages_file." | |
| 2137 } | |
| 2138 if { [lsearch -exact $pkgconf::package_data($match,versions) $pkgconf::version_args($pkg)] == -1 } { | |
| 2139 fatal_error "Invalid argument --$pkg-version=$pkgconf::version_args($pkg), that version is not available." | |
| 2140 } | |
| 2141 set pkgconf::config_data($match,version) $pkgconf::version_args($pkg) | |
| 2142 | |
| 2143 set index [lsearch -exact $pkgconf::config_data(disabled_packages) $match] | |
| 2144 if { $index != -1 } { | |
| 2145 set pkgconf::config_data(disabled_packages) [lreplace $pkgconf::config_data(disabled_packages) $index $index] | |
| 2146 } | |
| 2147 if { ($pkgconf::package_data($match,hardware) == 1) || ($pkgconf::package_data($match,default) == 0) } { | |
| 2148 set index [lsearch -exact $pkgconf::config_data(enabled_packages) $match] | |
| 2149 if { $index == -1 } { | |
| 2150 lappend config_data(enabled_packages) $match | |
| 2151 } | |
| 2152 } | |
| 2153 } | |
| 2154 | |
| 2155 # For each compiler flag that has been specified explicitly on the command line, | |
| 2156 # store it in the configuration data | |
| 2157 foreach flag [array names pkgconf::cflags_args] { | |
| 2158 set pkgconf::config_data(cflags,$flag) $pkgconf::cflags_args($flag) | |
| 2159 } | |
| 2160 } | |
| 2161 | |
| 2162 # }}} | |
| 2163 # {{{ reset_data() | |
| 2164 | |
| 2165 # ---------------------------------------------------------------------------- | |
| 2166 # This routine gets rid of all data. It can be used if the script is | |
| 2167 # switching from one configuration to a different one. | |
| 2168 # | |
| 2169 proc pkgconf::reset_data { } { | |
| 2170 | |
| 2171 foreach i [array names pkgconf::config_data] { | |
| 2172 unset pkgconf::config_data($i) | |
| 2173 } | |
| 2174 foreach i [array names pkgconf::saved_data] { | |
| 2175 unset pkgconf::saved_data($i) | |
| 2176 } | |
| 2177 } | |
| 2178 | |
| 2179 # }}} | |
| 2180 | |
| 2181 # }}} | |
| 2182 # {{{ GUI | |
| 2183 | |
| 2184 # {{{ GUI variables | |
| 2185 | |
| 2186 namespace eval pkgconf { | |
| 2187 | |
| 2188 namespace export gui | |
| 2189 | |
| 2190 # Which editor should be used for fine-grained configuration options ? | |
| 2191 # The VISUAL environment variable is the correct way to obtain this | |
| 2192 # information on Unix operating systems. Windows machines do not | |
| 2193 # seem to have an obvious equivalent. | |
| 2194 variable editor "" | |
| 2195 if { [info exists ::env(VISUAL)] } { | |
| 2196 set editor $::env(VISUAL) | |
| 2197 } | |
| 2198 | |
| 2199 # The names of the pages in the notebook. These names are | |
| 2200 # invented by the notebook widget. | |
| 2201 variable target_frame "" | |
| 2202 variable packages_frame "" | |
| 2203 variable options_frame "" | |
| 2204 variable flags_frame "" | |
| 2205 variable build_frame "" | |
| 2206 | |
| 2207 # It is convenient to keep track of whether or not certain information | |
| 2208 # has changed. This simplifies the task of deciding whether or not | |
| 2209 # a page in the notebook needs redrawing. | |
| 2210 # | |
| 2211 # Note: currently if the user makes a change and then undoes that | |
| 2212 # change the variable remains set. It is possible to get around this, | |
| 2213 # but that would require a bit more work. | |
| 2214 variable packages_page_needs_refresh 0 | |
| 2215 variable options_page_needs_refresh 0 | |
| 2216 variable build_page_needs_refresh 0 | |
| 2217 | |
| 2218 # Is it currently possible to do a build, or is it necessary to | |
| 2219 # update the build tree first. | |
| 2220 variable build_tree_needs_update 0 | |
| 2221 | |
| 2222 # Each notebook page is given its own array of global data. | |
| 2223 array set target_page_data {}; | |
| 2224 array set packages_page_data {}; | |
| 2225 array set options_page_data {}; | |
| 2226 array set flags_page_data {}; | |
| 2227 array set build_page_data {}; | |
| 2228 | |
| 2229 # The state of the build output window. There are two flags to consider: | |
| 2230 # whether the output window is visible or not; and whether the output | |
| 2231 # window is docked or not. | |
| 2232 variable output_docked 1 | |
| 2233 variable output_visible 0 | |
| 2234 | |
| 2235 # For gui mode, what is the name of the toplevel window ? | |
| 2236 # If this script is embedded in a larger application then it can | |
| 2237 # be made to run inside a frame in that window. | |
| 2238 namespace export set_toplevel_window | |
| 2239 variable toplevel ".pkgconf" | |
| 2240 } | |
| 2241 | |
| 2242 # }}} | |
| 2243 # {{{ Effective Tcl support | |
| 2244 | |
| 2245 # ---------------------------------------------------------------------------- | |
| 2246 # For now the intention is to allow this script to be run from a completely | |
| 2247 # standard wish or tclsh interpreter, version 8.0 or later. This means it is | |
| 2248 # not possible to use extensions such as TIX or ITCL. However in the GUI | |
| 2249 # it is still desirable to have a notebook widget, so here is an | |
| 2250 # implementation in vanilla TK. The balloon widget from the same source | |
| 2251 # is used as well. | |
| 2252 # | |
| 2253 # The code derives from the book Effective Tcl/Tk programming by Mark | |
| 2254 # Harrison and Michael McLennan. The actual source code was obtained from | |
| 2255 # the Addison-Wesley web site and contains the following copyright. | |
| 2256 # | |
| 2257 # This distribution contains examples from the "Effective Tcl/Tk | |
| 2258 # Programming" book. You can study these examples as you read | |
| 2259 # through the book, and you can steal the code for your own | |
| 2260 # applications! | |
| 2261 # | |
| 2262 # | |
| 2263 # The code is enclosed in a separate namespace. Also I have modified | |
| 2264 # the code in a number of places to make it more general-purpose. | |
| 2265 # | |
| 2266 namespace eval pkgconf::efftcl { | |
| 2267 | |
| 2268 # ---------------------------------------------------------------------- | |
| 2269 # EXAMPLE: tabnotebook that can dial up pages | |
| 2270 # ---------------------------------------------------------------------- | |
| 2271 # Effective Tcl/Tk Programming | |
| 2272 # Mark Harrison, DSC Communications Corp. | |
| 2273 # Michael McLennan, Bell Labs Innovations for Lucent Technologies | |
| 2274 # Addison-Wesley Professional Computing Series | |
| 2275 # ====================================================================== | |
| 2276 # Copyright (c) 1996-1997 Lucent Technologies Inc. and Mark Harrison | |
| 2277 # ====================================================================== | |
| 2278 | |
| 2279 # BLV fix: this script may execute in tclsh rather than in wish, | |
| 2280 # so the option command may not be available. | |
| 2281 if { [info command "option"] == "option"} { | |
| 2282 | |
| 2283 # BLV: I do not like this background colour for the tabs. | |
| 2284 if { 0 } { | |
| 2285 option add *Tabnotebook.tabs.background #666666 widgetDefault | |
| 2286 } | |
| 2287 option add *Tabnotebook.margin 6 widgetDefault | |
| 2288 option add *Tabnotebook.tabColor #a6a6a6 widgetDefault | |
| 2289 option add *Tabnotebook.activeTabColor #d9d9d9 widgetDefault | |
| 2290 option add *Tabnotebook.tabFont \ | |
| 2291 -*-helvetica-bold-r-normal--*-120-* widgetDefault | |
| 2292 } | |
| 2293 | |
| 2294 # BLV fix: replace global variables with per-namespace ones. | |
| 2295 array set tnInfo {} | |
| 2296 array set bhInfo {} | |
| 2297 | |
| 2298 proc tabnotebook_create {win} { | |
| 2299 variable tnInfo | |
| 2300 | |
| 2301 frame $win -class Tabnotebook | |
| 2302 canvas $win.tabs -highlightthickness 0 | |
| 2303 pack $win.tabs -fill x | |
| 2304 | |
| 2305 notebook_create $win.notebook | |
| 2306 pack $win.notebook -expand yes -fill both | |
| 2307 | |
| 2308 set tnInfo($win-tabs) "" | |
| 2309 set tnInfo($win-current) "" | |
| 2310 set tnInfo($win-pending) "" | |
| 2311 return $win | |
| 2312 } | |
| 2313 | |
| 2314 # | |
| 2315 # BLV fix: add three arguments, one specifying a function to be | |
| 2316 # invoked when the tab becomes visible, another for when the user | |
| 2317 # leaves the tab, and a text string for balloon help. This function can | |
| 2318 # be used to redraw a page if this is necessary due to changes in other | |
| 2319 # pages, and an empty string can be used if desired. An empty string | |
| 2320 # can also be used for the balloon help. | |
| 2321 # | |
| 2322 | |
| 2323 proc tabnotebook_page {win name enterfn leavefn help} { | |
| 2324 variable tnInfo | |
| 2325 | |
| 2326 set page [notebook_page $win.notebook $name] | |
| 2327 lappend tnInfo($win-tabs) $name | |
| 2328 set tnInfo($name-enterfn) $enterfn | |
| 2329 set tnInfo($name-leavefn) $leavefn | |
| 2330 set tnInfo($name-help) $help | |
| 2331 | |
| 2332 if {$tnInfo($win-pending) == ""} { | |
| 2333 set id [after idle [list pkgconf::efftcl::tabnotebook_refresh $win]] | |
| 2334 set tnInfo($win-pending) $id | |
| 2335 } | |
| 2336 return $page | |
| 2337 } | |
| 2338 | |
| 2339 proc tabnotebook_refresh {win} { | |
| 2340 variable tnInfo | |
| 2341 | |
| 2342 $win.tabs delete all | |
| 2343 | |
| 2344 set margin [option get $win margin Margin] | |
| 2345 set color [option get $win tabColor Color] | |
| 2346 set font [option get $win tabFont Font] | |
| 2347 set x 2 | |
| 2348 set maxh 0 | |
| 2349 | |
| 2350 foreach name $tnInfo($win-tabs) { | |
| 2351 set id [$win.tabs create text \ | |
| 2352 [expr $x+$margin+2] [expr -0.5*$margin] \ | |
| 2353 -anchor sw -text $name -font $font \ | |
| 2354 -tags [list $name]] | |
| 2355 | |
| 2356 set bbox [$win.tabs bbox $id] | |
| 2357 set wd [expr [lindex $bbox 2]-[lindex $bbox 0]] | |
| 2358 set ht [expr [lindex $bbox 3]-[lindex $bbox 1]] | |
| 2359 if {$ht > $maxh} { | |
| 2360 set maxh $ht | |
| 2361 } | |
| 2362 | |
| 2363 $win.tabs create polygon 0 0 $x 0 \ | |
| 2364 [expr $x+$margin] [expr -$ht-$margin] \ | |
| 2365 [expr $x+$margin+$wd] [expr -$ht-$margin] \ | |
| 2366 [expr $x+$wd+2*$margin] 0 \ | |
| 2367 2000 0 2000 10 0 10 \ | |
| 2368 -outline black -fill $color \ | |
| 2369 -tags [list $name tab tab-$name] | |
| 2370 | |
| 2371 $win.tabs raise $id | |
| 2372 | |
| 2373 $win.tabs bind $name <ButtonPress-1> \ | |
| 2374 [list pkgconf::efftcl::tabnotebook_display $win $name] | |
| 2375 | |
| 2376 # BLV - add support for balloon help | |
| 2377 if { $tnInfo($name-help) != "" } { | |
| 2378 balloonhelp_canvas_for $win.tabs $name $tnInfo($name-help) | |
| 2379 } | |
| 2380 set x [expr $x+$wd+2*$margin] | |
| 2381 } | |
| 2382 set height [expr $maxh+2*$margin] | |
| 2383 $win.tabs move all 0 $height | |
| 2384 | |
| 2385 $win.tabs configure -width $x -height [expr $height+4] | |
| 2386 | |
| 2387 if {$tnInfo($win-current) != ""} { | |
| 2388 tabnotebook_display $win $tnInfo($win-current) | |
| 2389 } else { | |
| 2390 tabnotebook_display $win [lindex $tnInfo($win-tabs) 0] | |
| 2391 } | |
| 2392 set tnInfo($win-pending) "" | |
| 2393 } | |
| 2394 | |
| 2395 proc tabnotebook_display {win name} { | |
| 2396 variable tnInfo | |
| 2397 variable nbInfo | |
| 2398 | |
| 2399 # BLV: invoke appropriate callbacks in the current and new | |
| 2400 # tabs. | |
| 2401 set old_tab $tnInfo($win-current) | |
| 2402 if { ($old_tab != "") && ($tnInfo($old_tab-leavefn) != "") } { | |
| 2403 $tnInfo($old_tab-leavefn) $nbInfo($win.notebook-page-$old_tab)) | |
| 2404 } | |
| 2405 if { $tnInfo($name-enterfn) != "" } { | |
| 2406 $tnInfo($name-enterfn) $nbInfo($win.notebook-page-$name) | |
| 2407 } | |
| 2408 | |
| 2409 notebook_display $win.notebook $name | |
| 2410 | |
| 2411 set normal [option get $win tabColor Color] | |
| 2412 $win.tabs itemconfigure tab -fill $normal | |
| 2413 | |
| 2414 set active [option get $win activeTabColor Color] | |
| 2415 $win.tabs itemconfigure tab-$name -fill $active | |
| 2416 $win.tabs raise $name | |
| 2417 | |
| 2418 set tnInfo($win-current) $name | |
| 2419 } | |
| 2420 | |
| 2421 # ---------------------------------------------------------------------- | |
| 2422 # EXAMPLE: simple notebook that can dial up pages | |
| 2423 # ---------------------------------------------------------------------- | |
| 2424 # Effective Tcl/Tk Programming | |
| 2425 # Mark Harrison, DSC Communications Corp. | |
| 2426 # Michael McLennan, Bell Labs Innovations for Lucent Technologies | |
| 2427 # Addison-Wesley Professional Computing Series | |
| 2428 # ====================================================================== | |
| 2429 # Copyright (c) 1996-1997 Lucent Technologies Inc. and Mark Harrison | |
| 2430 # ====================================================================== | |
| 2431 | |
| 2432 # BLV - again check for TK being present. | |
| 2433 if { [info command option] == "option" } { | |
| 2434 option add *Notebook.borderWidth 2 widgetDefault | |
| 2435 option add *Notebook.relief sunken widgetDefault | |
| 2436 } | |
| 2437 | |
| 2438 # BLV: replace nbInfo global with a per-namespace variable | |
| 2439 array set nbInfo {} | |
| 2440 | |
| 2441 proc notebook_create {win} { | |
| 2442 variable nbInfo | |
| 2443 | |
| 2444 frame $win -class Notebook | |
| 2445 pack propagate $win 0 | |
| 2446 | |
| 2447 set nbInfo($win-count) 0 | |
| 2448 set nbInfo($win-pages) "" | |
| 2449 set nbInfo($win-current) "" | |
| 2450 return $win | |
| 2451 } | |
| 2452 | |
| 2453 proc notebook_page {win name} { | |
| 2454 variable nbInfo | |
| 2455 | |
| 2456 set page "$win.page[incr nbInfo($win-count)]" | |
| 2457 lappend nbInfo($win-pages) $page | |
| 2458 set nbInfo($win-page-$name) $page | |
| 2459 | |
| 2460 frame $page | |
| 2461 | |
| 2462 if {$nbInfo($win-count) == 1} { | |
| 2463 after idle [list pkgconf::efftcl::notebook_display $win $name] | |
| 2464 } | |
| 2465 | |
| 2466 return $page | |
| 2467 } | |
| 2468 | |
| 2469 proc notebook_display {win name} { | |
| 2470 variable nbInfo | |
| 2471 | |
| 2472 set page "" | |
| 2473 if {[info exists nbInfo($win-page-$name)]} { | |
| 2474 set page $nbInfo($win-page-$name) | |
| 2475 } elseif {[winfo exists $win.page$name]} { | |
| 2476 set page $win.page$name | |
| 2477 } | |
| 2478 if {$page == ""} { | |
| 2479 error "bad notebook page \"$name\"" | |
| 2480 } | |
| 2481 | |
| 2482 notebook_fix_size $win | |
| 2483 | |
| 2484 if {$nbInfo($win-current) != ""} { | |
| 2485 pack forget $nbInfo($win-current) | |
| 2486 } | |
| 2487 pack $page -expand yes -fill both | |
| 2488 set nbInfo($win-current) $page | |
| 2489 } | |
| 2490 | |
| 2491 proc notebook_fix_size {win} { | |
| 2492 variable nbInfo | |
| 2493 | |
| 2494 update idletasks | |
| 2495 | |
| 2496 set maxw 0 | |
| 2497 set maxh 0 | |
| 2498 foreach page $nbInfo($win-pages) { | |
| 2499 set w [winfo reqwidth $page] | |
| 2500 if {$w > $maxw} { | |
| 2501 set maxw $w | |
| 2502 } | |
| 2503 set h [winfo reqheight $page] | |
| 2504 if {$h > $maxh} { | |
| 2505 set maxh $h | |
| 2506 } | |
| 2507 } | |
| 2508 set bd [$win cget -borderwidth] | |
| 2509 set maxw [expr $maxw+2*$bd] | |
| 2510 set maxh [expr $maxh+2*$bd] | |
| 2511 $win configure -width $maxw -height $maxh | |
| 2512 } | |
| 2513 | |
| 2514 # ---------------------------------------------------------------------- | |
| 2515 # EXAMPLE: use "wm" commands to manage a balloon help window | |
| 2516 # ---------------------------------------------------------------------- | |
| 2517 # Effective Tcl/Tk Programming | |
| 2518 # Mark Harrison, DSC Communications Corp. | |
| 2519 # Michael McLennan, Bell Labs Innovations for Lucent Technologies | |
| 2520 # Addison-Wesley Professional Computing Series | |
| 2521 # ====================================================================== | |
| 2522 # Copyright (c) 1996-1997 Lucent Technologies Inc. and Mark Harrison | |
| 2523 # ====================================================================== | |
| 2524 | |
| 2525 # BLV fix: again this script may execute in tclsh rather than in wish. | |
| 2526 if { [info command "option"] == "option" } { | |
| 2527 option add *Balloonhelp*background white widgetDefault | |
| 2528 option add *Balloonhelp*foreground black widgetDefault | |
| 2529 option add *Balloonhelp.info.wrapLength 3i widgetDefault | |
| 2530 option add *Balloonhelp.info.justify left widgetDefault | |
| 2531 option add *Balloonhelp.info.font \ | |
| 2532 -*-lucida-medium-r-normal-sans-*-120-* widgetDefault | |
| 2533 | |
| 2534 toplevel .balloonhelp -class Balloonhelp \ | |
| 2535 -background black -borderwidth 1 -relief flat | |
| 2536 | |
| 2537 # BLV fix: I want to create the arrow image inline rather than | |
| 2538 # read it in from a file. | |
| 2539 image create bitmap arrow -data "\ | |
| 2540 #define arrow_width 8 | |
| 2541 #define arrow_height 8 | |
| 2542 static unsigned char arrow_bits[] = { | |
| 2543 0x1f, 0x0f, 0x0f, 0x1f, 0x39, 0x70, 0x20, 0x00}; | |
| 2544 " | |
| 2545 label .balloonhelp.arrow -anchor nw -image arrow | |
| 2546 | |
| 2547 # label .balloonhelp.arrow -anchor nw \ | |
| 2548 # -bitmap @[file join $env(EFFTCL_LIBRARY) images arrow.xbm] | |
| 2549 pack .balloonhelp.arrow -side left -fill y | |
| 2550 | |
| 2551 label .balloonhelp.info | |
| 2552 pack .balloonhelp.info -side left -fill y | |
| 2553 | |
| 2554 wm overrideredirect .balloonhelp 1 | |
| 2555 wm withdraw .balloonhelp | |
| 2556 } | |
| 2557 | |
| 2558 # ---------------------------------------------------------------------- | |
| 2559 # USAGE: balloonhelp_for <win> <mesg> | |
| 2560 # | |
| 2561 # Adds balloon help to the widget named <win>. Whenever the mouse | |
| 2562 # pointer enters this widget and rests within it for a short delay, | |
| 2563 # a balloon help window will automatically appear showing the | |
| 2564 # help <mesg>. | |
| 2565 # ---------------------------------------------------------------------- | |
| 2566 | |
| 2567 proc balloonhelp_for {win mesg} { | |
| 2568 variable bhInfo | |
| 2569 set bhInfo($win) $mesg | |
| 2570 | |
| 2571 bind $win <Enter> {pkgconf::efftcl::balloonhelp_pending %W %W} | |
| 2572 bind $win <Leave> {pkgconf::efftcl::balloonhelp_cancel} | |
| 2573 } | |
| 2574 | |
| 2575 # BLV: a variant that can be used for canvas items. | |
| 2576 | |
| 2577 proc balloonhelp_canvas_for { canvas id mesg } { | |
| 2578 variable bhInfo | |
| 2579 set bhInfo($canvas-$id) $mesg | |
| 2580 | |
| 2581 $canvas bind $id <Enter> [list pkgconf::efftcl::balloonhelp_pending $canvas $canvas-$id] | |
| 2582 $canvas bind $id <Leave> {pkgconf::efftcl::balloonhelp_cancel} | |
| 2583 } | |
| 2584 | |
| 2585 # ---------------------------------------------------------------------- | |
| 2586 # USAGE: balloonhelp_control <state> | |
| 2587 # | |
| 2588 # Turns balloon help on/off for the entire application. | |
| 2589 # ---------------------------------------------------------------------- | |
| 2590 set bhInfo(active) 1 | |
| 2591 | |
| 2592 proc balloonhelp_control {state} { | |
| 2593 variable bhInfo | |
| 2594 | |
| 2595 if {$state} { | |
| 2596 set bhInfo(active) 1 | |
| 2597 } else { | |
| 2598 balloonhelp_cancel | |
| 2599 set bhInfo(active) 0 | |
| 2600 } | |
| 2601 } | |
| 2602 | |
| 2603 # ---------------------------------------------------------------------- | |
| 2604 # USAGE: balloonhelp_pending <win> | |
| 2605 # | |
| 2606 # Used internally to mark the point in time when a widget is first | |
| 2607 # touched. Sets up an "after" event so that balloon help will appear | |
| 2608 # if the mouse remains within the current window. | |
| 2609 # ---------------------------------------------------------------------- | |
| 2610 | |
| 2611 # BLV - the first argument identifies the window, the second the help | |
| 2612 # string. | |
| 2613 proc balloonhelp_pending {win id} { | |
| 2614 variable bhInfo | |
| 2615 | |
| 2616 balloonhelp_cancel | |
| 2617 set bhInfo(pending) [after 1500 [list pkgconf::efftcl::balloonhelp_show $win $id]] | |
| 2618 } | |
| 2619 | |
| 2620 # ---------------------------------------------------------------------- | |
| 2621 # USAGE: balloonhelp_cancel | |
| 2622 # | |
| 2623 # Used internally to mark the point in time when the mouse pointer | |
| 2624 # leaves a widget. Cancels any pending balloon help requested earlier | |
| 2625 # and hides the balloon help window, in case it is visible. | |
| 2626 # ---------------------------------------------------------------------- | |
| 2627 proc balloonhelp_cancel {} { | |
| 2628 variable bhInfo | |
| 2629 | |
| 2630 if {[info exists bhInfo(pending)]} { | |
| 2631 after cancel $bhInfo(pending) | |
| 2632 unset bhInfo(pending) | |
| 2633 } | |
| 2634 wm withdraw .balloonhelp | |
| 2635 } | |
| 2636 | |
| 2637 # ---------------------------------------------------------------------- | |
| 2638 # USAGE: balloonhelp_show <win> | |
| 2639 # | |
| 2640 # Used internally to display the balloon help window for the | |
| 2641 # specified <win>. | |
| 2642 # ---------------------------------------------------------------------- | |
| 2643 | |
| 2644 # BLV - the first argument identifies the window, the second the | |
| 2645 # help message. | |
| 2646 | |
| 2647 proc balloonhelp_show {win id} { | |
| 2648 variable bhInfo | |
| 2649 | |
| 2650 if {$bhInfo(active)} { | |
| 2651 .balloonhelp.info configure -text $bhInfo($id) | |
| 2652 | |
| 2653 # BLV: switched from using window-relative positions | |
| 2654 # to mouse relative position. | |
| 2655 if { 0 } { | |
| 2656 set x [expr [winfo rootx $win]+10] | |
| 2657 set y [expr [winfo rooty $win]+[winfo height $win]] | |
| 2658 } else { | |
| 2659 set coords [winfo pointerxy $win] | |
| 2660 set x [expr [lindex $coords 0] + 15] | |
| 2661 set y [expr [lindex $coords 1] + 15] | |
| 2662 } | |
| 2663 if { ($x >= 0) && ($y >= 0) } { | |
| 2664 wm geometry .balloonhelp +$x+$y | |
| 2665 wm deiconify .balloonhelp | |
| 2666 raise .balloonhelp | |
| 2667 } | |
| 2668 } | |
| 2669 unset bhInfo(pending) | |
| 2670 } | |
| 2671 | |
| 2672 } | |
| 2673 | |
| 2674 # }}} | |
| 2675 # {{{ standalone initialisation | |
| 2676 | |
| 2677 # ---------------------------------------------------------------------------- | |
| 2678 # GUI Start-up. It is necessary to work out a few things about the operating | |
| 2679 # environment. | |
| 2680 # | |
| 2681 # 1) is this script being run via tclsh or via wish ? If the former then only | |
| 2682 # command line operation is possible. If the latter then a GUI environment | |
| 2683 # can be provided as well. | |
| 2684 # | |
| 2685 # 2) if TK is present, has it been extended with Tix ? If so use the standard | |
| 2686 # TK color scheme etc., not the Tix variant. | |
| 2687 # | |
| 2688 # 3) if TK is present, get rid of the top-level window. | |
| 2689 # | |
| 2690 # If this command is not being run stand-alone then it is the responsibility | |
| 2691 # of the calling code to take appropriate action, e.g. to enable gui mode | |
| 2692 # and to set up the appropriate options. | |
| 2693 # | |
| 2694 | |
| 2695 proc pkgconf::gui_standalone_init { } { | |
| 2696 | |
| 2697 variable gui_possible | |
| 2698 | |
| 2699 if { [info command tk] == "tk" } { | |
| 2700 | |
| 2701 # TK is loaded. For now allow GUI mode, but the actual decision | |
| 2702 # depends on command line arguments. | |
| 2703 set gui_possible 1 | |
| 2704 | |
| 2705 # Get rid of the top-level window. Otherwise this might pop up if the | |
| 2706 # script performs a blocking operation too early. | |
| 2707 wm withdraw . | |
| 2708 | |
| 2709 # If TIX is also present, prevent the TIX color scheme etc. from taking | |
| 2710 # effect. | |
| 2711 if { [info command tix] == "tix" } { | |
| 2712 tix resetoptions TK TK | |
| 2713 } | |
| 2714 | |
| 2715 # It is probably not a good idea to accept "send" messages. However | |
| 2716 # setting the appname also affects option handling, which is more | |
| 2717 # useful. Note that the send command is not available in all versions | |
| 2718 # of Tcl. | |
| 2719 if { [info command send] == "send" } { | |
| 2720 rename send {} | |
| 2721 } | |
| 2722 tk appname pkgconf | |
| 2723 | |
| 2724 } else { | |
| 2725 | |
| 2726 # TK is not loaded, so gui mode is not possible. | |
| 2727 set gui_possible 0 | |
| 2728 } | |
| 2729 } | |
| 2730 | |
| 2731 # }}} | |
| 2732 # {{{ set toplevel window | |
| 2733 | |
| 2734 # ---------------------------------------------------------------------------- | |
| 2735 # Allow a containing program, if any, to specify the window in which | |
| 2736 # this script should do its funky stuff. It is not possible to change | |
| 2737 # this window while pkgconf is active, so if for any reason it is | |
| 2738 # necessary to change the toplevel window then the old one must be | |
| 2739 # destroyed first, the new name must be installed, and then there | |
| 2740 # must be a new call to pkgconf::gui to redraw the window. | |
| 2741 # | |
| 2742 | |
| 2743 proc pkgconf::set_toplevel_window { name } { | |
| 2744 variable toplevel | |
| 2745 set toplevel $name | |
| 2746 } | |
| 2747 | |
| 2748 # }}} | |
| 2749 # {{{ main GUI draw routine | |
| 2750 | |
| 2751 # ---------------------------------------------------------------------------- | |
| 2752 # The main GUI code. | |
| 2753 # | |
| 2754 # The routine pkgconf::gui is responsible for creating the various windows. | |
| 2755 # These are as follows: | |
| 2756 # | |
| 2757 # 1) a menu bar containing menus for File, Window and Help. Currently the only | |
| 2758 # entry in File is Exit, and the entries in Help are all disabled. The | |
| 2759 # Window menu allows the output window to be hidden or shown. | |
| 2760 # | |
| 2761 # 2) a notebook frame containing four pages: | |
| 2762 # | |
| 2763 # a) target hardware. This lists all known target architectures, | |
| 2764 # and allows the user to select the appropriate one using a | |
| 2765 # set of radio buttons. | |
| 2766 # | |
| 2767 # b) packages. This lists all known packages and the versions for | |
| 2768 # each package. Unfortunately neither radio buttons nor checkbuttons | |
| 2769 # provide entirely the right paradigm here, but checkbuttons are | |
| 2770 # good enough. | |
| 2771 # | |
| 2772 # c) an edit page. This allows the user to invoke a text editor for | |
| 2773 # any of the fine-grained configuration headers. | |
| 2774 # | |
| 2775 # d) a compiler flags page. This allows the user to manipulate the | |
| 2776 # compiler flags etc. | |
| 2777 # | |
| 2778 # e) a build page. This allows the user to create the build tree and to | |
| 2779 # invoke make, make tests, make clean, etc. There is also an entry | |
| 2780 # field to allow the install directory to be changed. | |
| 2781 # | |
| 2782 # 3) a label field along the bottom, which can be used by the various | |
| 2783 # frames to display warning messages. | |
| 2784 # | |
| 2785 # 4) a separate frame to hold the outputs of builds. This can be either | |
| 2786 # docked below the main frame, or it can be a separate toplevel window. | |
| 2787 # The build frame contains a number of buttons to allow the text | |
| 2788 # screen to be cleared, removed from the display, docked/undocked, | |
| 2789 # or saved to a file. | |
| 2790 # | |
| 2791 # 5) the options database is consulted to decide whether the output | |
| 2792 # window should be docked or not by default. | |
| 2793 # | |
| 2794 # 6) if there is a file ~/.pkgconfrc this file gets executed. It is | |
| 2795 # assumed to contain valid Tcl code. | |
| 2796 # | |
| 2797 # If this script is running inside a large application then there may be | |
| 2798 # a frame $toplevel_window already. If so this frame should be used. | |
| 2799 # Otherwise a separate toplevel window should be created, complete with | |
| 2800 # menu bar. | |
| 2801 # | |
| 2802 | |
| 2803 proc pkgconf::gui { } { | |
| 2804 | |
| 2805 variable toplevel | |
| 2806 if { [winfo exists $toplevel] == 0 } { | |
| 2807 create_toplevel_window | |
| 2808 } | |
| 2809 | |
| 2810 # Now create a notebook, and add four pages to it. The names of these | |
| 2811 # pages have to be stored in separate variables. | |
| 2812 variable target_frame | |
| 2813 variable packages_frame | |
| 2814 variable options_frame | |
| 2815 variable flags_frame | |
| 2816 variable build_frame | |
| 2817 | |
| 2818 efftcl::tabnotebook_create $toplevel.notebook | |
| 2819 set target_frame [efftcl::tabnotebook_page $toplevel.notebook "Target" \ | |
| 2820 pkgconf::nbpage_targets_enter pkgconf::nbpage_targets_leave \ | |
| 2821 "Select target hardware"] | |
| 2822 set packages_frame [efftcl::tabnotebook_page $toplevel.notebook "Packages" \ | |
| 2823 pkgconf::nbpage_packages_enter pkgconf::nbpage_packages_leave \ | |
| 2824 "Select desired packages"] | |
| 2825 set options_frame [efftcl::tabnotebook_page $toplevel.notebook "Options" \ | |
| 2826 pkgconf::nbpage_options_enter pkgconf::nbpage_options_leave \ | |
| 2827 "Edit configuration options"] | |
| 2828 set flags_frame [efftcl::tabnotebook_page $toplevel.notebook "Flags" \ | |
| 2829 pkgconf::nbpage_flags_enter pkgconf::nbpage_flags_leave \ | |
| 2830 "Edit compiler flags"] | |
| 2831 set build_frame [efftcl::tabnotebook_page $toplevel.notebook "Build" \ | |
| 2832 pkgconf::nbpage_build_enter pkgconf::nbpage_build_leave \ | |
| 2833 "Build this configuration"] | |
| 2834 | |
| 2835 # By default the notebook is the widget that expands. If a build output | |
| 2836 # window is present instead then it is the output window that expands. | |
| 2837 pack $toplevel.notebook -side top -fill both -expand 1 | |
| 2838 | |
| 2839 # Make sure that the message window exists, since some of the | |
| 2840 # notebook update routines refer to it. | |
| 2841 label $toplevel.message -text "" -anchor w -relief raised -borderwidth 2 | |
| 2842 pack $toplevel.message -side top -fill x | |
| 2843 | |
| 2844 # Now create the notebook pages. | |
| 2845 nbpage_targets_initialise $target_frame | |
| 2846 nbpage_packages_initialise $packages_frame | |
| 2847 nbpage_options_initialise $options_frame | |
| 2848 nbpage_flags_initialise $flags_frame | |
| 2849 nbpage_build_initialise $build_frame | |
| 2850 | |
| 2851 # Create the output window, but leave it hidden for now. | |
| 2852 frame $toplevel.output | |
| 2853 frame $toplevel.output.buttons | |
| 2854 button $toplevel.output.buttons.hide -text "Hide" -command pkgconf::output_hide_window | |
| 2855 button $toplevel.output.buttons.undock -text "Undock" -command pkgconf::output_undock_window | |
| 2856 button $toplevel.output.buttons.clear -text "Clear" -command pkgconf::output_clear_window | |
| 2857 button $toplevel.output.buttons.save -text "Save..." -command pkgconf::output_save | |
| 2858 pack $toplevel.output.buttons.hide \ | |
| 2859 $toplevel.output.buttons.undock \ | |
| 2860 $toplevel.output.buttons.clear \ | |
| 2861 $toplevel.output.buttons.save -side left -expand 1 | |
| 2862 pack $toplevel.output.buttons -side top -fill x | |
| 2863 text $toplevel.output.text -wrap word -state disabled -yscrollcommand [list $toplevel.output.scroll set] | |
| 2864 pack $toplevel.output.text -side left -fill both -expand 1 | |
| 2865 scrollbar $toplevel.output.scroll -orient vertical -command [list $toplevel.output.text yview] | |
| 2866 pack $toplevel.output.scroll -side right -fill y | |
| 2867 | |
| 2868 # Create a toplevel window matching the output frame, but leave it | |
| 2869 # hidden for now. Give it the same bindings as the toplevel window. | |
| 2870 toplevel .pkgconf_output -menu .menubar -class Pkgconf | |
| 2871 wm withdraw .pkgconf_output | |
| 2872 wm title .pkgconf_output "pkgconf build output" | |
| 2873 wm protocol .pkgconf_output WM_DELETE_WINDOW { pkgconf::handle_exit } | |
| 2874 | |
| 2875 bind .pkgconf_output <Alt-q> { pkgconf::handle_exit } | |
| 2876 bind .pkgconf_output <Alt-f><KeyPress-x> { pkgconf::handle_exit } | |
| 2877 | |
| 2878 frame .pkgconf_output.buttons | |
| 2879 button .pkgconf_output.buttons.hide -text "Hide" -command pkgconf::output_hide_window | |
| 2880 button .pkgconf_output.buttons.undock -text "Dock" -command pkgconf::output_undock_window | |
| 2881 button .pkgconf_output.buttons.clear -text "Clear" -command pkgconf::output_clear_window | |
| 2882 button .pkgconf_output.buttons.save -text "Save..." -command pkgconf::output_save | |
| 2883 pack .pkgconf_output.buttons.hide \ | |
| 2884 .pkgconf_output.buttons.undock \ | |
| 2885 .pkgconf_output.buttons.clear \ | |
| 2886 .pkgconf_output.buttons.save -side left -expand 1 | |
| 2887 pack .pkgconf_output.buttons -side top -fill x | |
| 2888 text .pkgconf_output.text -wrap word -state disabled -yscrollcommand { .pkgconf_output.scroll set } | |
| 2889 pack .pkgconf_output.text -side left -fill both -expand 1 | |
| 2890 scrollbar .pkgconf_output.scroll -orient vertical -command { .pkgconf_output.text yview } | |
| 2891 pack .pkgconf_output.scroll -side right -fill y | |
| 2892 | |
| 2893 efftcl::balloonhelp_for $toplevel.output.buttons.hide \ | |
| 2894 "Remove the build output window, until more output appears." | |
| 2895 efftcl::balloonhelp_for .pkgconf_output.buttons.hide \ | |
| 2896 "Remove the build output window, until more output appears." | |
| 2897 efftcl::balloonhelp_for $toplevel.output.buttons.undock \ | |
| 2898 "Make the build output appear in a separate window." | |
| 2899 efftcl::balloonhelp_for .pkgconf_output.buttons.undock \ | |
| 2900 "Attach the build output to the main pkgconf window." | |
| 2901 efftcl::balloonhelp_for $toplevel.output.buttons.clear \ | |
| 2902 "Remove all build output text." | |
| 2903 efftcl::balloonhelp_for .pkgconf_output.buttons.clear \ | |
| 2904 "Remove all build output text." | |
| 2905 efftcl::balloonhelp_for $toplevel.output.buttons.save \ | |
| 2906 "Save build output to a file." | |
| 2907 efftcl::balloonhelp_for .pkgconf_output.buttons.save \ | |
| 2908 "Save build output to a file." | |
| 2909 | |
| 2910 # Consult the options database. | |
| 2911 variable output_docked | |
| 2912 option add "*docked" 1 startupFile | |
| 2913 set output_docked [option get $toplevel docked Pkgconf] | |
| 2914 | |
| 2915 # Look for a file ~/.pkgconfrc and execute it. | |
| 2916 if { [file isfile [file join "~" ".pkgconfrc"]] } { | |
| 2917 if { [namespace eval :: { catch { source [file join "~" ".pkgconfrc"] } message } ] != 0 } { | |
| 2918 warning "The following error occurred while executing ~/.pkgconfrc: $message" | |
| 2919 } | |
| 2920 } | |
| 2921 } | |
| 2922 | |
| 2923 # ---------------------------------------------------------------------------- | |
| 2924 # This routine creates the toplevel window, if pkgconf is running | |
| 2925 # independently rather than inside a larger application. | |
| 2926 | |
| 2927 proc pkgconf::create_toplevel_window { } { | |
| 2928 | |
| 2929 variable toplevel | |
| 2930 | |
| 2931 # Start by creating the menubar. TK8's support for native menus is | |
| 2932 # used. | |
| 2933 menu .menubar -type menubar | |
| 2934 menu .menubar.config -tearoff 0 -type normal | |
| 2935 menu .menubar.edit -tearoff 0 -type normal | |
| 2936 menu .menubar.view -tearoff 0 -type normal | |
| 2937 menu .menubar.help -tearoff 0 -type normal | |
| 2938 | |
| 2939 .menubar.config add command -label "Exit" -command pkgconf::handle_exit -underline 1 \ | |
| 2940 -accelerator "Alt+Q" | |
| 2941 | |
| 2942 .menubar.edit add command -label "Undo" -state disabled | |
| 2943 .menubar.edit add command -label "Redo" -state disabled | |
| 2944 | |
| 2945 .menubar.view add checkbutton -label "Show output" \ | |
| 2946 -variable pkgconf::output_visible -onvalue 1 -offvalue 0 \ | |
| 2947 -command pkgconf::output_menu | |
| 2948 .menubar.view add checkbutton -label "Balloon help" \ | |
| 2949 -variable pkgconf::efftcl::bhInfo(active) -onvalue 1 -offvalue 0 | |
| 2950 | |
| 2951 .menubar.help add command -label "Help on pkgconf" -state disabled | |
| 2952 .menubar.help add command -label "Help on the system" -state disabled | |
| 2953 .menubar.help add command -label "Search" -state disabled | |
| 2954 .menubar.help add separator | |
| 2955 .menubar.help add command -label "About pkgconf" -state disabled | |
| 2956 | |
| 2957 .menubar add cascade -menu .menubar.config -label "Configuration" -underline 0 | |
| 2958 .menubar add cascade -menu .menubar.edit -label "Edit" -underline 0 | |
| 2959 .menubar add cascade -menu .menubar.view -label "View" -underline 0 | |
| 2960 .menubar add cascade -menu .menubar.help -label "Help" -underline 0 | |
| 2961 | |
| 2962 # Create the toplevel window, giving it a menubar and a name, | |
| 2963 # and establish the accelerator binding. | |
| 2964 toplevel $toplevel -menu .menubar -class Pkgconf | |
| 2965 wm title $toplevel pkgconf | |
| 2966 bind $toplevel <Alt-q> { pkgconf::handle_exit } | |
| 2967 wm protocol $toplevel WM_DELETE_WINDOW { pkgconf::handle_exit } | |
| 2968 | |
| 2969 # Although there is a Configuration menu instead of a file menu, it is | |
| 2970 # desirable to support alt-f-x as a reasonably standard way of exiting | |
| 2971 # the program. | |
| 2972 bind $toplevel <Alt-f><KeyPress-x> { pkgconf::handle_exit } | |
| 2973 } | |
| 2974 | |
| 2975 # ---------------------------------------------------------------------------- | |
| 2976 # This routine gets invoked for exit handling: when the user invokes the | |
| 2977 # exit entry on the file menu; or when the alt-q accelerator is used; or | |
| 2978 # when a window delete request is received. For now the code just exits, | |
| 2979 # but it might be an idea to offer to save configuration changes if any. | |
| 2980 # | |
| 2981 proc pkgconf::handle_exit { } { | |
| 2982 exit 0 | |
| 2983 } | |
| 2984 | |
| 2985 # }}} | |
| 2986 # {{{ Notebook pages | |
| 2987 | |
| 2988 # {{{ Targets page | |
| 2989 | |
| 2990 # ---------------------------------------------------------------------------- | |
| 2991 # The targets page. This allows the user to select the target architecture, | |
| 2992 # platform, and startup. The range of available target architectures cannot | |
| 2993 # change while the program is running, so this window is actually fixed. | |
| 2994 # | |
| 2995 | |
| 2996 proc pkgconf::nbpage_targets_initialise { win } { | |
| 2997 | |
| 2998 variable config_data | |
| 2999 variable known_targets | |
| 3000 variable target_data | |
| 3001 variable target_page_data | |
| 3002 | |
| 3003 # I need a variable that can be associated with the radiobuttons and | |
| 3004 # identifies the selected target uniquely. It is not really | |
| 3005 # possible to do this with the three variables in the config data | |
| 3006 # directly. | |
| 3007 set target_page_data(selection) [list $config_data(target) $config_data(platform) $config_data(startup)] | |
| 3008 | |
| 3009 # Conceivably the number of targets could be larger than can fit | |
| 3010 # conveniently on to one screen, so it is desirable use a scrollable | |
| 3011 # form. Start by creating a scrollbar, a canvas, and a frame within | |
| 3012 # that canvas, and set up a standard resize callback. The canvas | |
| 3013 # starts off small, but expands as necessary. The actual size will | |
| 3014 # therefore be determined by whichever page does not have a | |
| 3015 # vertical scrollbar, typically the build page. | |
| 3016 scrollbar $win.scrollbar -command "$win.viewport yview" -orient vertical | |
| 3017 pack $win.scrollbar -side right -fill y | |
| 3018 | |
| 3019 canvas $win.viewport -height 10m -yscrollcommand "$win.scrollbar set" | |
| 3020 pack $win.viewport -fill both -expand 1 -padx 20 -pady 20 | |
| 3021 | |
| 3022 frame $win.viewport.form | |
| 3023 $win.viewport create window 0 0 -anchor nw -window $win.viewport.form | |
| 3024 | |
| 3025 bind $win.viewport.form <Configure> "pkgconf::nbpage_form_resized $win" | |
| 3026 | |
| 3027 # Now fill in the form with details of all the targets. | |
| 3028 # These are arranged in a simple grid. | |
| 3029 set form $win.viewport.form | |
| 3030 set row 0 | |
| 3031 | |
| 3032 foreach target $known_targets { | |
| 3033 | |
| 3034 label $form.arch-$row -text "Target [get_target_alias $target]" -anchor w | |
| 3035 grid $form.arch-$row -row $row -column 0 -sticky w | |
| 3036 incr row | |
| 3037 | |
| 3038 foreach platform $target_data($target,known_platforms) { | |
| 3039 foreach startup $target_data($target,$platform,startup) { | |
| 3040 | |
| 3041 label $form.platform-$row -text " Platform [get_platform_alias $target $platform]," -anchor w | |
| 3042 grid $form.platform-$row -row $row -column 0 -sticky w | |
| 3043 label $form.startup-$row -text "$startup startup" -anchor w | |
| 3044 grid $form.startup-$row -row $row -column 1 -sticky w -ipadx 5 | |
| 3045 radiobutton $form.button-$row -variable pkgconf::target_page_data(selection) \ | |
| 3046 -value [list $target $platform $startup] \ | |
| 3047 -command pkgconf::clear_status_line | |
| 3048 grid $form.button-$row -row $row -column 2 -sticky w | |
| 3049 incr row | |
| 3050 } | |
| 3051 } | |
| 3052 } | |
| 3053 } | |
| 3054 | |
| 3055 # | |
| 3056 # The enter routine gets invoked when the user switches to the targets tab, | |
| 3057 # and also during start-up since the targets tab is the first one. It is | |
| 3058 # responsible for keeping track of the initial target selection, so that | |
| 3059 # when the user switches to a different tab it is possible to know whether | |
| 3060 # or not the target has actually changed. | |
| 3061 # | |
| 3062 # As a useful side effect, the routine updates the status line. | |
| 3063 # | |
| 3064 proc pkgconf::nbpage_targets_enter { win } { | |
| 3065 | |
| 3066 variable config_data | |
| 3067 variable target_page_data | |
| 3068 | |
| 3069 set target_page_data(initial_selection) $target_page_data(selection) | |
| 3070 | |
| 3071 if { ($config_data(target) == "") || ($config_data(platform) == "") || ($config_data(startup) == "") } { | |
| 3072 set_status_line "Please select a target system." | |
| 3073 } else { | |
| 3074 clear_status_line | |
| 3075 } | |
| 3076 } | |
| 3077 | |
| 3078 proc pkgconf::nbpage_targets_leave { win } { | |
| 3079 | |
| 3080 variable target_page_data | |
| 3081 | |
| 3082 if { $target_page_data(selection) != $target_page_data(initial_selection) } { | |
| 3083 variable config_data | |
| 3084 variable build_tree_needs_update | |
| 3085 | |
| 3086 set config_data(target) [lindex $target_page_data(selection) 0] | |
| 3087 set config_data(platform) [lindex $target_page_data(selection) 1] | |
|
12
4cc3eff958ab
Merge from eCos master repository on 1999-06-04-22:24:56-BST
jlarmour
parents:
4
diff
changeset
|
3088 set config_data(base_platform) [get_base_platform $config_data(target) $config_data(platform)] |
| 0 | 3089 set config_data(startup) [lindex $target_page_data(selection) 2] |
| 3090 set build_tree_needs_update 1 | |
| 3091 | |
| 3092 # A change of target has implications for the compiler flags, which | |
| 3093 # must be handled immediately. The user may not go into the flags | |
| 3094 # tab so the changes cannot be done in the flags tab enter/leave | |
| 3095 # routines. | |
| 3096 update_compiler_flags | |
| 3097 } | |
| 3098 } | |
| 3099 | |
| 3100 # | |
| 3101 # This routine take care of resize operations. Whenever the size | |
| 3102 # of the form changes the canvas' scroll region needs to be adjusted. | |
| 3103 # | |
| 3104 # Note that this code is also used for the packages page. | |
| 3105 # | |
| 3106 proc pkgconf::nbpage_form_resized { win } { | |
| 3107 | |
| 3108 set bbox [$win.viewport bbox all] | |
| 3109 set old_bbox [$win.viewport cget -scrollregion] | |
| 3110 set width [winfo width $win.viewport.form] | |
| 3111 set old_width [$win.viewport cget -width] | |
| 3112 if { ("$bbox" != "$old_bbox") || ($width != $old_width) } { | |
| 3113 $win.viewport configure -width $width -scrollregion $bbox | |
| 3114 } | |
| 3115 } | |
| 3116 | |
| 3117 # }}} | |
| 3118 # {{{ Packages page | |
| 3119 | |
| 3120 # ---------------------------------------------------------------------------- | |
| 3121 # The packages page. This is mostly similar to the targets page. | |
| 3122 # It is necessary to provide a mechanism for disabling packages. | |
| 3123 # It is also necessary to worry about changes to the target architecture. | |
| 3124 # The initialise() routine takes care of most of these things. | |
| 3125 | |
| 3126 proc pkgconf::nbpage_packages_initialise { win } { | |
| 3127 | |
| 3128 variable config_data | |
| 3129 variable known_packages | |
| 3130 variable package_data | |
| 3131 variable target_data | |
| 3132 variable packages_page_data | |
| 3133 | |
| 3134 # Start by storing details of the target that is currently | |
| 3135 # being displayed. | |
| 3136 set packages_page_data(current_target) $config_data(target) | |
| 3137 set packages_page_data(current_platform) $config_data(platform) | |
| 3138 | |
| 3139 # Typically the number of packages will be larger than can fit | |
| 3140 # conveniently on to one screen, so it is desirable use a scrollable | |
| 3141 # form. Start by creating a scrollbar, a canvas, and a frame within | |
| 3142 # that canvas, and set up a standard resize callback. The canvas | |
| 3143 # starts of small, but expands as necessary. The actual size will | |
| 3144 # therefore be determined by whichever page does not have a | |
| 3145 # vertical scrollbar, typically the build page. | |
| 3146 scrollbar $win.scrollbar -command "$win.viewport yview" -orient vertical | |
| 3147 pack $win.scrollbar -side right -fill y | |
| 3148 | |
| 3149 canvas $win.viewport -height 10m -yscrollcommand "$win.scrollbar set" | |
| 3150 pack $win.viewport -fill both -expand 1 -padx 20 -pady 20 | |
| 3151 | |
| 3152 frame $win.viewport.form | |
| 3153 $win.viewport create window 0 0 -anchor nw -window $win.viewport.form | |
| 3154 | |
| 3155 bind $win.viewport.form <Configure> "pkgconf::nbpage_form_resized $win" | |
| 3156 | |
| 3157 # Now fill in the form with details of all the packages. | |
| 3158 # These are arranged in a simple grid. | |
| 3159 set form $win.viewport.form | |
| 3160 set row 0 | |
| 3161 | |
| 3162 # Now handle the packages themselves. Each package can be in one | |
| 3163 # of the following states: | |
| 3164 # | |
| 3165 # 1) a hardware package is enabled by default if it is specified | |
| 3166 # for the current target or platform, disabled otherwise. | |
| 3167 # However the user should be able to explicitly enable or | |
| 3168 # disable it. This is handled by config_data(enabled_packages) | |
| 3169 # and config_data(disabled_packages). | |
| 3170 # | |
| 3171 # 2) a non-hardware package may be enabled or disabled by default, | |
| 3172 # but the user can change this. Again this is handled by | |
| 3173 # enabled_packages and disabled_packages. | |
| 3174 # | |
| 3175 # It is convenient to cache the list of target and platform specific | |
| 3176 # packages. | |
| 3177 set target_packages "" | |
| 3178 set platform_packages "" | |
| 3179 if { $config_data(target) != "" } { | |
| 3180 set target_packages $target_data($config_data(target),packages) | |
| 3181 if { $config_data(platform) != "" } { | |
| 3182 set platform_packages $target_data($config_data(target),$config_data(platform),packages) | |
| 3183 } | |
| 3184 } | |
| 3185 foreach pkg $known_packages { | |
| 3186 | |
| 3187 # What is the current version of each package ? | |
| 3188 set current_version "" | |
| 3189 | |
| 3190 if { $package_data($pkg,hardware) != 0 } { | |
| 3191 if { ([lsearch -exact $target_packages $pkg] != -1) || ([lsearch -exact $platform_packages $pkg] != -1)} { | |
| 3192 set current_version $config_data($pkg,version) | |
| 3193 } | |
| 3194 } elseif { $package_data($pkg,default) != 0 } { | |
| 3195 set current_version $config_data($pkg,version) | |
| 3196 } | |
| 3197 | |
| 3198 if { [lsearch -exact $config_data(enabled_packages) $pkg] != -1 } { | |
| 3199 set current_version $config_data($pkg,version) | |
| 3200 } | |
| 3201 if { [lsearch -exact $config_data(disabled_packages) $pkg] != -1 } { | |
| 3202 set current_version "" | |
| 3203 } | |
| 3204 | |
| 3205 # Store the current version, so that it is easier to figure out what | |
| 3206 # has changed. | |
| 3207 set packages_page_data($pkg,version) $current_version | |
| 3208 | |
| 3209 label $form.label-$row -text "[get_package_alias $pkg]:" | |
| 3210 grid $form.label-$row -row $row -column 0 -sticky w | |
| 3211 foreach version $package_data($pkg,versions) { | |
| 3212 label $form.version-$row -text "Version $version" | |
| 3213 grid $form.version-$row -row $row -column 1 -sticky w -ipady 5 | |
| 3214 | |
| 3215 radiobutton $form.button-$row -variable pkgconf::packages_page_data($pkg,version) \ | |
| 3216 -value $version -command [list pkgconf::nbpage_packages_change $pkg] | |
| 3217 grid $form.button-$row -row $row -column 2 -sticky w | |
| 3218 incr row | |
| 3219 } | |
| 3220 label $form.version-$row -text "Disable" | |
| 3221 grid $form.version-$row -row $row -column 1 -sticky w | |
| 3222 radiobutton $form.button-$row -variable pkgconf::packages_page_data($pkg,version) \ | |
| 3223 -value "" -command [list pkgconf::nbpage_packages_change $pkg] | |
| 3224 grid $form.button-$row -row $row -column 2 -sticky w | |
| 3225 incr row | |
| 3226 } | |
| 3227 } | |
| 3228 | |
| 3229 # | |
| 3230 # This routine gets invoked whenever there is a change to one of the | |
| 3231 # packages. It sets a flag indicating that the build tree is out of data. | |
| 3232 # It will also update the appropriate config_data. | |
| 3233 # | |
| 3234 proc pkgconf::nbpage_packages_change { pkg } { | |
| 3235 | |
| 3236 variable build_tree_needs_update | |
| 3237 set build_tree_needs_update 1 | |
| 3238 | |
| 3239 variable packages_page_data | |
| 3240 variable config_data | |
| 3241 | |
| 3242 set version $packages_page_data($pkg,version) | |
| 3243 if { $version == "" } { | |
| 3244 | |
| 3245 # This package is being explicitly disabled. | |
| 3246 set index [lsearch -exact $config_data(enabled_packages) $pkg] | |
| 3247 if { $index != -1 } { | |
| 3248 set config_data(enabled_packages) [lreplace $config_data(enabled_packages) $index $index] | |
| 3249 } | |
| 3250 | |
| 3251 set index [lsearch -exact $config_data(disabled_packages) $pkg] | |
| 3252 if { $index == -1 } { | |
| 3253 lappend config_data(disabled_packages) $pkg | |
| 3254 } | |
| 3255 } else { | |
| 3256 | |
| 3257 # A package version is being changed, possibly causing it to | |
| 3258 # be enabled. | |
| 3259 set config_data($pkg,version) $version | |
| 3260 | |
| 3261 set index [lsearch -exact $config_data(disabled_packages) $pkg] | |
| 3262 if { $index != -1 } { | |
| 3263 set config_data(disabled_packages) [lreplace $config_data(disabled_packages) $index $index] | |
| 3264 } | |
| 3265 | |
| 3266 set index [lsearch -exact $config_data(enabled_packages) $pkg] | |
| 3267 if { $index == -1 } { | |
| 3268 lappend config_data(enabled_packages) $pkg | |
| 3269 } | |
| 3270 } | |
| 3271 } | |
| 3272 | |
| 3273 # | |
| 3274 # The packages page needs to be redrawn every time a different target is | |
| 3275 # selected, so that the user can select which version of the HAL packages | |
| 3276 # should be used. The redraw can be achieved by deleting the existing | |
| 3277 # contents of the window and re-invoking the initialise function. | |
| 3278 | |
| 3279 proc pkgconf::nbpage_packages_enter { win } { | |
| 3280 | |
| 3281 variable packages_page_data | |
| 3282 variable config_data | |
| 3283 | |
| 3284 if { ($packages_page_data(current_target) != $config_data(target)) || | |
| 3285 ($packages_page_data(current_platform) != $config_data(platform)) } { | |
| 3286 | |
| 3287 foreach subwin [winfo children $win] { | |
| 3288 destroy $subwin | |
| 3289 } | |
| 3290 nbpage_packages_initialise $win | |
| 3291 } | |
| 3292 | |
| 3293 # If the target architecture is not yet known, remind the user. | |
| 3294 if { ($config_data(target) == "") || ($config_data(platform) == "") || ($config_data(startup) == "") } { | |
| 3295 set_status_line "Please select a target system." | |
| 3296 } else { | |
| 3297 clear_status_line | |
| 3298 } | |
| 3299 } | |
| 3300 | |
| 3301 # | |
| 3302 # Currently this code does nothing, instead it is left to the | |
| 3303 # nbpage_packages_change routine above to update the appropriate | |
| 3304 # global information. This is unfortunate in that if the user | |
| 3305 # makes a mistake and undoes it pkgconf still thinks that the | |
| 3306 # build tree is out of date. | |
| 3307 | |
| 3308 proc pkgconf::nbpage_packages_leave { win } { | |
| 3309 } | |
| 3310 | |
| 3311 # }}} | |
| 3312 # {{{ Options page | |
| 3313 | |
| 3314 # ---------------------------------------------------------------------------- | |
| 3315 # The options page. This consists of two frame arranged vertically. | |
| 3316 # The top frame allows the user to select the editor to use, which is | |
| 3317 # initialised from the VISUAL environment variable. The bottom frame | |
| 3318 # is another scrollable canvas allowing the user to select a header | |
| 3319 # file to edit. | |
| 3320 # | |
| 3321 # A number of special cases have to be allowed for. If there is no | |
| 3322 # text editor then all the buttons to edit a text file have to | |
| 3323 # be disabled. If there is no pkgconf directory in the build tree | |
| 3324 # yet then there will be no files to edit. Even if there is an | |
| 3325 # an pkgconf directory it may not contain all the files it is | |
| 3326 # supposed to, especially if the build tree is not up to date. | |
| 3327 # | |
| 3328 | |
| 3329 proc pkgconf::nbpage_options_initialise { win } { | |
| 3330 | |
| 3331 # Start with the top frame. This contains a label, an entry field, | |
| 3332 # and a button that invokes a file selector. | |
| 3333 # NOTE: these borderwidths should not be hardwired. | |
| 3334 variable editor | |
| 3335 frame $win.top -relief raised -borderwidth 2 | |
| 3336 label $win.top.label -text "Editor:" | |
| 3337 entry $win.top.entry -relief sunken -borderwidth 2 -textvariable pkgconf::editor | |
| 3338 button $win.top.button -text "Browse..." -command pkgconf::nbpage_options_browse | |
| 3339 pack $win.top.button -side right | |
| 3340 pack $win.top.entry -side right -fill x -expand 1 | |
| 3341 pack $win.top.label -side left | |
| 3342 pack $win.top -side top -fill x | |
| 3343 | |
| 3344 efftcl::balloonhelp_for $win.top.entry "The text editor that should be used." | |
| 3345 efftcl::balloonhelp_for $win.top.button "Select the text editor that should be used." | |
| 3346 | |
| 3347 # The entry widget does not support a command callback when | |
| 3348 # a string has been typed in, so it is necessary to use the | |
| 3349 # trace facility instead to enable or disable the buttons. | |
| 3350 # Note that this routine may get invoked from the update routine, | |
| 3351 # so it is necessary to clean up the old trace. | |
| 3352 trace vdelete pkgconf::editor w pkgconf::nbpage_options_editor_changed | |
| 3353 trace variable pkgconf::editor w pkgconf::nbpage_options_editor_changed | |
| 3354 | |
| 3355 # At this point there are now button widgets in this page. The | |
| 3356 # nbpage_options_editor_changed routine used this list. | |
| 3357 variable options_page_data | |
| 3358 set options_page_data(buttons) "" | |
| 3359 | |
| 3360 # Now check for editable files in the pkgconf directory. | |
| 3361 # Three of the files, makefile, pkgconf.mak and system.h are generated | |
| 3362 # and should not be edited by users. There may also be various .stamp | |
| 3363 # files used by the build system. | |
| 3364 variable build_tree | |
| 3365 set files "" | |
| 3366 foreach filename [glob -nocomplain [file join $build_tree "pkgconf" "*"]] { | |
| 3367 set filename [file tail $filename] | |
| 3368 if { [string match {*.stamp} $filename] } continue | |
| 3369 if { ($filename == "makefile") || ($filename == "pkgconf.mak") || ($filename == "system.h") } continue | |
| 3370 lappend files $filename | |
| 3371 } | |
| 3372 | |
| 3373 if { $files == "" } { | |
| 3374 | |
| 3375 # OK, just display a message. There is likely to be an appropriate | |
| 3376 # warning in the message frame at the bottom of the window already. | |
| 3377 label $win.message -text "There are no configuration files to edit." | |
| 3378 pack $win.message -fill both -expand 1 | |
| 3379 | |
| 3380 # A valid configuration always has a makevars file to edit, so the | |
| 3381 # implication is that the build tree is out of date. It probably | |
| 3382 # makes sense to set the relevant flag here. | |
| 3383 variable build_tree_needs_update | |
| 3384 set build_tree_needs_update 1 | |
| 3385 return | |
| 3386 } | |
| 3387 | |
| 3388 # The editable files are displayed in a scrollable frame, just | |
| 3389 # like the targets and packages pages. | |
| 3390 scrollbar $win.scrollbar -command "$win.viewport yview" -orient vertical | |
| 3391 pack $win.scrollbar -side right -fill y | |
| 3392 | |
| 3393 canvas $win.viewport -height 10m -yscrollcommand "$win.scrollbar set" | |
| 3394 pack $win.viewport -fill both -expand 1 -padx 20 -pady 20 | |
| 3395 | |
| 3396 frame $win.viewport.form | |
| 3397 $win.viewport create window 0 0 -anchor nw -window $win.viewport.form | |
| 3398 | |
| 3399 bind $win.viewport.form <Configure> "pkgconf::nbpage_form_resized $win" | |
| 3400 | |
| 3401 # Now fill in the form with all the buttons. | |
| 3402 set form $win.viewport.form | |
| 3403 set row 0 | |
| 3404 | |
| 3405 foreach file $files { | |
| 3406 | |
| 3407 button $form.button-$row -text "<pkgconf/$file>" -anchor w \ | |
| 3408 -command [list pkgconf::nbpage_options_edit $file] | |
| 3409 grid $form.button-$row -row $row -column 0 -sticky we -padx 10 -pady 5 | |
| 3410 label $form.label-$row -anchor w -text "Edit [file join $build_tree pkgconf $file]" | |
| 3411 grid $form.label-$row -row $row -column 1 -sticky w | |
| 3412 | |
| 3413 efftcl::balloonhelp_for $form.button-$row "Edit this configuration file." | |
| 3414 lappend options_page_data(buttons) $form.button-$row | |
| 3415 if { $editor == "" } { | |
| 3416 $form.button-$row configure -state disabled | |
| 3417 } | |
| 3418 incr row | |
| 3419 } | |
| 3420 } | |
| 3421 | |
| 3422 # The options page needs to be redrawn every time the build tree is | |
| 3423 # regenerated, since this may result in a different set of editable | |
| 3424 # configuration header files. | |
| 3425 | |
| 3426 proc pkgconf::nbpage_options_enter { win } { | |
| 3427 | |
| 3428 variable options_page_needs_refresh | |
| 3429 | |
| 3430 if { $options_page_needs_refresh != 0 } { | |
| 3431 set options_page_needs_refresh 0 | |
| 3432 foreach subwin [winfo children $win] { destroy $subwin } | |
| 3433 nbpage_options_initialise $win | |
| 3434 } | |
| 3435 | |
| 3436 # It is also desirable to display some warnings. | |
| 3437 variable config_data | |
| 3438 variable build_tree_needs_update | |
| 3439 variable editor | |
| 3440 variable options_page_data | |
| 3441 | |
| 3442 set options_page_data(no_editor) 0 | |
| 3443 | |
| 3444 if { ($config_data(target) == "") || ($config_data(platform) == "") || ($config_data(startup) == "") } { | |
| 3445 set_status_line "The target hardware has not yet been selected." | |
| 3446 } elseif { $build_tree_needs_update } { | |
| 3447 set_status_line "The build tree needs updating." | |
| 3448 } elseif { $editor == "" } { | |
| 3449 set options_page_data(no_editor) 1 | |
| 3450 set_status_line "No text editor has been defined yet." | |
| 3451 } else { | |
| 3452 clear_status_line | |
| 3453 } | |
| 3454 } | |
| 3455 | |
| 3456 # | |
| 3457 # There are no obvious actions to be taken if the user switches to | |
| 3458 # a different tab. Even if the user has invoked the editor on a | |
| 3459 # configuration file there is no guarantee that anything has actually | |
| 3460 # changed. | |
| 3461 proc pkgconf::nbpage_options_leave { win } { | |
| 3462 } | |
| 3463 | |
| 3464 # | |
| 3465 # This procedure allows the user to select a text editor. It gets invoked | |
| 3466 # from the browse button. | |
| 3467 # | |
| 3468 # NOTE: on windows it might be desirable to specify a .exe extension as | |
| 3469 # the type, but even that is optional under NT. | |
| 3470 # | |
| 3471 proc pkgconf::nbpage_options_browse { } { | |
| 3472 | |
| 3473 variable editor | |
| 3474 variable build_tree | |
| 3475 variable toplevel | |
| 3476 | |
| 3477 set filename [tk_getOpenFile -initialdir $build_tree -parent $toplevel -title "Select text editor"] | |
| 3478 if { $filename == "" } { | |
| 3479 return | |
| 3480 } | |
| 3481 set editor $filename | |
| 3482 } | |
| 3483 | |
| 3484 # | |
| 3485 # This procedure is invoked whenever the editor variable is changed. | |
| 3486 # Its purpose is to enable or disable the buttons for the various | |
| 3487 # configuration headers. | |
| 3488 # | |
| 3489 # The code does not actually check whether the current editor value corresponds | |
| 3490 # to a valid executable. It is just about possible to check for an existing | |
| 3491 # file somewhere in the path, but that is expensive and there is still no | |
| 3492 # guarantee that the file is a valid executable. | |
| 3493 # | |
| 3494 | |
| 3495 proc pkgconf::nbpage_options_editor_changed { name1 name2 mode } { | |
| 3496 | |
| 3497 variable editor | |
| 3498 variable options_page_data | |
| 3499 variable toplevel | |
| 3500 | |
| 3501 if { $editor == "" } { | |
| 3502 | |
| 3503 foreach button $options_page_data(buttons) { | |
| 3504 $button configure -state disabled | |
| 3505 } | |
| 3506 } else { | |
| 3507 if { $options_page_data(no_editor) } { | |
| 3508 $toplevel.message configure -text "" | |
| 3509 set options_page_data(no_editor) 0 | |
| 3510 } | |
| 3511 foreach button $options_page_data(buttons) { | |
| 3512 $button configure -state normal | |
| 3513 } | |
| 3514 } | |
| 3515 } | |
| 3516 | |
| 3517 # This routine gets invoked to edit a header file. It simply | |
| 3518 # executes the current editor in the background. No attempt is | |
| 3519 # made to wait for command completion, to prevent a single file | |
| 3520 # from being edited multiple times, or anything like that. | |
| 3521 | |
| 3522 proc pkgconf::nbpage_options_edit { filename } { | |
| 3523 | |
| 3524 variable editor | |
| 3525 variable build_tree | |
| 3526 | |
| 3527 run_command pkgconf::nbpage_options_ignore $editor [file join $build_tree pkgconf $filename] | |
| 3528 } | |
| 3529 | |
| 3530 # This callback gets invoked from the run_command code whenever the | |
| 3531 # editor sends output. In the case of emacsclient such output | |
| 3532 # is the unfortunate string "Waiting for Emacs...Done". In the case | |
| 3533 # of xterm -e vi there is no output. | |
| 3534 # | |
| 3535 # On the whole it is better to ignore the output. This may mean | |
| 3536 # that warning or error messages get discared. | |
| 3537 | |
| 3538 proc pkgconf::nbpage_options_ignore { msg } { | |
| 3539 | |
| 3540 } | |
| 3541 | |
| 3542 # }}} | |
| 3543 # {{{ Flags page | |
| 3544 | |
| 3545 # ---------------------------------------------------------------------------- | |
| 3546 # The flags page. This consists of a big grid, arranged vertically into | |
| 3547 # five separate categories of flags. Within each category there is a | |
| 3548 # label identifying the category and four separate entry fields for the | |
| 3549 # various variables. | |
| 3550 # | |
| 3551 # The data for a given flag can come from two sources. The default value | |
| 3552 # comes from the targets file, and in most cases this will be an empty | |
| 3553 # string. Alternatively the user can overwrite it, e.g. as a command | |
| 3554 # line argument or in the GUI, in which case the changed information | |
| 3555 # gets saved in the pkgconf save file. | |
| 3556 # | |
| 3557 | |
| 3558 proc pkgconf::nbpage_flags_initialise { win } { | |
| 3559 | |
| 3560 variable flags_page_data | |
| 3561 variable known_compiler_flags | |
| 3562 variable config_data | |
| 3563 | |
| 3564 # Start by creating array entries for all the known compiler flags. | |
| 3565 if { ($config_data(target) != "") && ($config_data(platform) != "") } { | |
| 3566 foreach flag $known_compiler_flags { | |
| 3567 set flags_page_data($flag) [get_platform_cflags $config_data(target) $config_data(platform) $flag] | |
| 3568 } | |
| 3569 } else { | |
| 3570 foreach flag $known_compiler_flags { | |
| 3571 set flags_page_data($flag) "" | |
| 3572 } | |
| 3573 } | |
| 3574 | |
| 3575 # If the current configuration information contains any compiler flags, | |
| 3576 # update the appropriate variable. | |
| 3577 foreach flag $known_compiler_flags { | |
| 3578 if { [info exists config_data(cflags,$flag)] } { | |
| 3579 set flags_page_data($flag) $config_data(cflags,$flag) | |
| 3580 } | |
| 3581 } | |
| 3582 | |
| 3583 # Keep track of which target and platform the current settings correspond to. | |
| 3584 set flags_page_data(target) $config_data(target) | |
| 3585 set flags_page_data(platform) $config_data(platform) | |
| 3586 | |
| 3587 # Time to actually create the interface. | |
| 3588 # Again this tab uses a frame inside a scrolled canvas. | |
| 3589 scrollbar $win.scrollbar -command "$win.viewport yview" -orient vertical | |
| 3590 pack $win.scrollbar -side right -fill y | |
| 3591 | |
| 3592 canvas $win.viewport -height 10m -yscrollcommand "$win.scrollbar set" | |
| 3593 pack $win.viewport -fill both -expand 1 -padx 20 -pady 20 | |
| 3594 | |
| 3595 frame $win.viewport.form | |
| 3596 $win.viewport create window 0 0 -anchor nw -window $win.viewport.form | |
| 3597 | |
| 3598 bind $win.viewport.form <Configure> "pkgconf::nbpage_form_resized $win" | |
| 3599 | |
| 3600 # Now fill in the form with details of all the flags. | |
| 3601 # These are arranged in a simple grid. | |
| 3602 set form $win.viewport.form | |
| 3603 set row 0 | |
| 3604 | |
| 3605 grid columnconfigure $form 1 -weight 1 | |
| 3606 label $form.archflags -text "Architecture-related compiler flags" | |
| 3607 grid $form.archflags -row $row -column 0 -columnspan 2 -sticky w | |
| 3608 incr row | |
| 3609 foreach flag { ARCHFLAGS CARCHFLAGS CXXARCHFLAGS LDARCHFLAGS } { | |
| 3610 label $form.label-$flag -text $flag | |
| 3611 grid $form.label-$flag -row $row -column 0 -sticky w | |
| 3612 entry $form.entry-$flag -textvariable pkgconf::flags_page_data($flag) -width 60 | |
| 3613 grid $form.entry-$flag -row $row -column 1 -sticky we | |
| 3614 incr row | |
| 3615 } | |
| 3616 | |
| 3617 label $form.errflags -text "Warnings and errors" | |
| 3618 grid $form.errflags -row $row -column 0 -columnspan 2 -sticky w | |
| 3619 incr row | |
| 3620 foreach flag { ERRFLAGS CERRFLAGS CXXERRFLAGS LDERRFLAGS } { | |
| 3621 label $form.label-$flag -text $flag | |
| 3622 grid $form.label-$flag -row $row -column 0 -sticky w | |
| 3623 entry $form.entry-$flag -textvariable pkgconf::flags_page_data($flag) | |
| 3624 grid $form.entry-$flag -row $row -column 1 -sticky we | |
| 3625 incr row | |
| 3626 } | |
| 3627 | |
| 3628 label $form.dbgflags -text "Debugging and optimization levels" | |
| 3629 grid $form.dbgflags -row $row -column 0 -columnspan 2 -sticky w | |
| 3630 incr row | |
| 3631 foreach flag { DBGFLAGS CDBGFLAGS CXXDBGFLAGS LDDBGFLAGS } { | |
| 3632 label $form.label-$flag -text $flag | |
| 3633 grid $form.label-$flag -row $row -column 0 -sticky w | |
| 3634 entry $form.entry-$flag -textvariable pkgconf::flags_page_data($flag) | |
| 3635 grid $form.entry-$flag -row $row -column 1 -sticky we | |
| 3636 incr row | |
| 3637 } | |
| 3638 | |
| 3639 label $form.langflags -text "Language-related flags" | |
| 3640 grid $form.langflags -row $row -column 0 -columnspan 2 -sticky w | |
| 3641 incr row | |
| 3642 foreach flag { LANGFLAGS CLANGFLAGS CXXLANGFLAGS LDLANGFLAGS } { | |
| 3643 label $form.label-$flag -text $flag | |
| 3644 grid $form.label-$flag -row $row -column 0 -sticky w | |
| 3645 entry $form.entry-$flag -textvariable pkgconf::flags_page_data($flag) | |
| 3646 grid $form.entry-$flag -row $row -column 1 -sticky we | |
| 3647 incr row | |
| 3648 } | |
| 3649 | |
| 3650 label $form.extraflags -text "Miscellaneous" | |
| 3651 grid $form.extraflags -row $row -column 0 -columnspan 2 -sticky w | |
| 3652 incr row | |
| 3653 foreach flag { EXTRAFLAGS CEXTRAFLAGS CXXEXTRAFLAGS LDEXTRAFLAGS } { | |
| 3654 label $form.label-$flag -text $flag | |
| 3655 grid $form.label-$flag -row $row -column 0 -sticky w | |
| 3656 entry $form.entry-$flag -textvariable pkgconf::flags_page_data($flag) | |
| 3657 grid $form.entry-$flag -row $row -column 1 -sticky we | |
| 3658 incr row | |
| 3659 } | |
| 3660 } | |
| 3661 | |
| 3662 # | |
| 3663 # There is nothing to be done on entry to this tab. If the target architecture | |
| 3664 # has changed then there will have been a separate call to update_compiler_flags | |
| 3665 # below. This cannot be delayed until the enter call because there is no | |
| 3666 # guarantee that the user will switch to the flags tab after changing target | |
| 3667 # architecture. | |
| 3668 # | |
| 3669 proc pkgconf::nbpage_flags_enter { win } { | |
| 3670 } | |
| 3671 | |
| 3672 # | |
| 3673 # On leaving the page it is necessary to check for any flags that are | |
| 3674 # different from the default settings, and update the config_data | |
| 3675 # settings appropriately. | |
| 3676 # | |
| 3677 proc pkgconf::nbpage_flags_leave { win } { | |
| 3678 | |
| 3679 variable config_data | |
| 3680 variable flags_page_data | |
| 3681 variable known_compiler_flags | |
| 3682 | |
| 3683 if { ($config_data(target) == "") && ($config_data(platform) == "") } { | |
| 3684 | |
| 3685 # If no target has been defined then it is not possible to compare | |
| 3686 # with the default setting. All that can be done is set or clear | |
| 3687 # the current config setting. | |
| 3688 foreach flag $known_compiler_flags { | |
| 3689 if { $flags_page_data($flag) == "" } { | |
| 3690 if { [info exists config_data(cflags,$flag) ] } { | |
| 3691 unset config_data(cflags,$flag) | |
| 3692 } | |
| 3693 } else { | |
| 3694 set config_data(cflags,$flag) $flags_page_data($flag) | |
| 3695 } | |
| 3696 } | |
| 3697 } else { | |
| 3698 | |
| 3699 # For any flag which currently has default settings, | |
| 3700 # clear the appropriate config_data() entry. Otherwise store | |
| 3701 # the flag data. | |
| 3702 foreach flag $known_compiler_flags { | |
| 3703 | |
| 3704 if { $flags_page_data($flag) == [get_platform_cflags $config_data(target) $config_data(platform) $flag] } { | |
| 3705 if { [info exists config_data(cflags,$flag) ] } { | |
| 3706 unset config_data(cflags,$flag) | |
| 3707 } | |
| 3708 } else { | |
| 3709 set config_data(cflags,$flag) $flags_page_data($flag) | |
| 3710 } | |
| 3711 } | |
| 3712 } | |
| 3713 } | |
| 3714 | |
| 3715 # | |
| 3716 # When the target architecture changes it is necessary to update the compiler | |
| 3717 # flags appropriately. Basically any flag that was defined by the old target | |
| 3718 # has to be cleared, and then any flag defined for the new target has to be | |
| 3719 # installed. There is a risk that some user changes will be lost, but there | |
| 3720 # is no easy solution to this. | |
| 3721 # | |
| 3722 proc pkgconf::update_compiler_flags { } { | |
| 3723 | |
| 3724 variable config_data | |
| 3725 variable flags_page_data | |
| 3726 variable known_compiler_flags | |
| 3727 | |
| 3728 foreach flag $known_compiler_flags { | |
| 3729 | |
| 3730 if { ($flags_page_data(target) == "") || ($flags_page_data(platform) == "") } { | |
| 3731 set old_default_flag "" | |
| 3732 } else { | |
| 3733 set old_default_flag [get_platform_cflags $flags_page_data(target) $flags_page_data(platform) $flag] | |
| 3734 } | |
| 3735 set new_default_flag [get_platform_cflags $config_data(target) $config_data(platform) $flag] | |
| 3736 | |
| 3737 # If there is no change to the default flags leave things well alone. | |
| 3738 # That way user changes will not get overwritten. | |
| 3739 if { $old_default_flag == $new_default_flag } { | |
| 3740 continue | |
| 3741 } | |
| 3742 | |
| 3743 # Otherwise always install the new settings, which may mean eliminating | |
| 3744 # user changes. | |
| 3745 set flags_page_data($flag) $new_default_flag | |
| 3746 if { [info exists config_data(cflags,$flag)] } { | |
| 3747 unset config_data(cflags,$flag) | |
| 3748 } | |
| 3749 } | |
| 3750 | |
| 3751 set flags_page_data(target) $config_data(target) | |
| 3752 set flags_page_data(platform) $config_data(platform) | |
| 3753 } | |
| 3754 | |
| 3755 # }}} | |
| 3756 # {{{ Build page | |
| 3757 | |
| 3758 # ---------------------------------------------------------------------------- | |
| 3759 # The build page. This consists of the following buttons, gridded, | |
| 3760 # with explanatory text. | |
| 3761 # | |
| 3762 # 1) Update build tree | |
| 3763 # 2) Make | |
| 3764 # 3) Make tests | |
| 2 | 3765 # 4) Make misc |
| 3766 # 5) Make clean | |
| 0 | 3767 # |
| 3768 # The make buttons should be disabled if the build tree is out of date. | |
| 3769 # This is controlled by the variable build_tree_needs_update, which | |
| 3770 # may have got set during the options page creation. An additional | |
| 3771 # check that needs to be made here is whether or not the makefile | |
| 3772 # exists. If the current config data does not specify the target | |
| 3773 # then even the "Update tree" button must be disabled. | |
| 3774 # | |
| 3775 # Whenever a make is in progress all the buttons should be disabled. | |
| 3776 # | |
| 3777 | |
| 3778 proc pkgconf::nbpage_build_initialise { win } { | |
| 3779 | |
| 3780 # Update the variable build_tree_needs_update if there is no | |
| 3781 # makefile in the build tree. | |
| 3782 variable build_tree_needs_update | |
| 3783 variable component_repository | |
| 3784 variable build_tree | |
| 3785 variable config_data | |
| 3786 | |
| 3787 if { [file isfile [file join $build_tree makefile]] == 0 } { | |
| 3788 set build_tree_needs_update 1 | |
| 3789 } | |
| 3790 if { ($config_data(target) == "") || ($config_data(platform) == "") || ($config_data(startup) == "") } { | |
| 3791 set build_tree_needs_update 1 | |
| 3792 } | |
| 3793 | |
| 3794 # Create three labels identifying the various trees. | |
| 3795 frame $win.top | |
| 3796 label $win.top.source_label -anchor w -text "Component repository:" | |
| 3797 label $win.top.source_value -anchor w -text "$component_repository" | |
| 3798 label $win.top.build_label -anchor w -text "Current build tree:" | |
| 3799 label $win.top.build_value -anchor w -text "$build_tree" | |
| 3800 label $win.top.install_label -anchor w -text "Current install tree:" | |
| 3801 label $win.top.install_value -anchor w -text "$config_data(prefix)" | |
| 3802 grid $win.top.source_label -row 0 -column 0 -sticky w | |
| 3803 grid $win.top.source_value -row 0 -column 1 -sticky we | |
| 3804 grid $win.top.build_label -row 1 -column 0 -sticky w | |
| 3805 grid $win.top.build_value -row 1 -column 1 -sticky we | |
| 3806 grid $win.top.install_label -row 2 -column 0 -sticky w | |
| 3807 grid $win.top.install_value -row 2 -column 1 -sticky we | |
| 3808 grid columnconfigure $win.top 1 -weight 1 | |
| 3809 pack $win.top -side top -fill x -padx 5 -pady 5 | |
| 3810 | |
| 3811 # Create a grid with the four buttons and with explanatory | |
| 3812 # messages. | |
| 3813 frame $win.grid | |
| 3814 pack $win.grid -fill both -expand 1 | |
| 3815 set win $win.grid | |
| 3816 | |
| 3817 button $win.tree -text "Update tree" -command pkgconf::nbpage_build_update_tree | |
| 3818 button $win.make -text "Make" -command pkgconf::nbpage_build_make | |
| 3819 button $win.tests -text "Make tests" -command pkgconf::nbpage_build_tests | |
| 2 | 3820 button $win.misc -text "Make misc" -command pkgconf::nbpage_build_misc |
| 0 | 3821 button $win.clean -text "Make clean" -command pkgconf::nbpage_build_clean |
| 3822 | |
| 3823 if { ($config_data(target) == "" ) || ($config_data(platform) == "") || ($config_data(startup) == "") } { | |
| 3824 $win.tree configure -state disabled | |
| 3825 } | |
| 3826 if { $build_tree_needs_update } { | |
| 3827 $win.make configure -state disabled | |
| 3828 $win.tests configure -state disabled | |
| 2 | 3829 $win.misc configure -state disabled |
| 0 | 3830 $win.clean configure -state disabled |
| 3831 } | |
| 3832 grid $win.tree -row 0 -column 0 -sticky we -padx 5 -pady 5 | |
| 3833 grid $win.make -row 1 -column 0 -sticky we -padx 5 -pady 5 | |
| 3834 grid $win.tests -row 2 -column 0 -sticky we -padx 5 -pady 5 | |
| 2 | 3835 grid $win.misc -row 3 -column 0 -sticky we -padx 5 -pady 5 |
| 3836 grid $win.clean -row 4 -column 0 -sticky we -padx 5 -pady 5 | |
| 0 | 3837 |
| 3838 message $win.treemsg -anchor w -justify left -width 300 -text \ | |
| 3839 "Create or update the build and install trees." | |
| 3840 message $win.makemsg -anchor w -justify left -width 300 -text \ | |
| 3841 "Build the current configuration, leaving libraries and header files in the install tree." | |
| 3842 message $win.testsmsg -anchor w -justify left -width 300 -text \ | |
| 3843 "Build the test executables for the current configuration. These executables will be\ | |
| 3844 placed in the install tree." | |
| 2 | 3845 message $win.miscmsg -anchor w -justify left -width 300 -text \ |
| 3846 "Build the misc executables for the current configuration. These executables will be\ | |
| 3847 placed in the misc directory." | |
| 0 | 3848 message $win.cleanmsg -anchor w -justify left -width 300 -text \ |
| 3849 "Perform a clean-up operation in the build and install trees." | |
| 3850 grid $win.treemsg -row 0 -column 1 -sticky we | |
| 3851 grid $win.makemsg -row 1 -column 1 -sticky we | |
| 3852 grid $win.testsmsg -row 2 -column 1 -sticky we | |
| 2 | 3853 grid $win.miscmsg -row 3 -column 1 -sticky we |
| 3854 grid $win.cleanmsg -row 4 -column 1 -sticky we | |
| 0 | 3855 grid columnconfigure $win 1 -weight 1 |
| 3856 } | |
| 3857 | |
| 3858 # The build page needs refreshing every time that the user changes the | |
| 3859 # target or one of the packages. The important question is whether or | |
| 3860 # not the build tree needs to be updated before any builds can take place. | |
| 3861 # Of course the build tree can only be generated if the target architecture | |
| 3862 # is known. | |
| 3863 | |
| 3864 proc pkgconf::nbpage_build_enter { win } { | |
| 3865 | |
| 3866 variable build_tree_needs_update | |
| 3867 variable build_frame | |
| 3868 variable toplevel | |
| 3869 | |
| 3870 if { $build_tree_needs_update } { | |
| 3871 $build_frame.grid.make configure -state disabled | |
| 3872 $build_frame.grid.tests configure -state disabled | |
| 2 | 3873 $build_frame.grid.misc configure -state disabled |
| 0 | 3874 $build_frame.grid.clean configure -state disabled |
| 3875 | |
| 3876 set_status_line "The build tree must be updated before this configuration can be built." | |
| 3877 } else { | |
| 3878 clear_status_line | |
| 3879 } | |
| 3880 | |
| 3881 variable config_data | |
| 3882 if { ($config_data(target) == "") || ($config_data(platform) == "") || ($config_data(startup) == "") } { | |
| 3883 $build_frame.grid.tree configure -state disabled | |
| 3884 set_status_line "The target hardware has not yet been selected." | |
| 3885 } else { | |
| 3886 $build_frame.grid.tree configure -state normal | |
| 3887 } | |
| 3888 } | |
| 3889 | |
| 3890 # | |
| 3891 # There are no actual settings that can be changed in this tab, | |
| 3892 # so no updates are required. | |
| 3893 # | |
| 3894 proc pkgconf::nbpage_build_leave { win } { | |
| 3895 } | |
| 3896 | |
| 3897 # | |
| 3898 # This callback function is invoked during the various makes. | |
| 3899 # If it is passed an empty string then the command has finished and | |
| 3900 # all the buttons can be reenabled. Otherwise it is necessary to send | |
| 3901 # some text to the output window. | |
| 3902 | |
| 3903 proc pkgconf::nbpage_build_handle_output { mesg } { | |
| 3904 | |
| 3905 if { $mesg == "" } { | |
| 3906 output_add_text "Build has finished.\n" | |
| 3907 nbpage_build_control_buttons 1 | |
| 3908 } else { | |
| 3909 output_add_text "$mesg\n" | |
| 3910 } | |
| 3911 } | |
| 3912 | |
| 3913 | |
| 3914 # This utility is used to control all the buttons in the build frame. | |
| 3915 proc pkgconf::nbpage_build_control_buttons { on } { | |
| 3916 | |
| 3917 variable build_frame | |
| 3918 set buttons [grid slaves $build_frame.grid -column 0] | |
| 3919 foreach button $buttons { | |
| 3920 if { $on } { | |
| 3921 $button configure -state normal | |
| 3922 } else { | |
| 3923 $button configure -state disabled | |
| 3924 } | |
| 3925 } | |
| 3926 } | |
| 3927 | |
| 3928 # | |
| 3929 # These functions get invoked for the buttons in the build page. | |
| 3930 # | |
| 3931 proc pkgconf::nbpage_build_update_tree { } { | |
| 3932 | |
| 3933 variable toplevel | |
| 3934 variable options_page_needs_refresh | |
| 3935 variable build_tree_needs_update | |
| 3936 | |
| 3937 nbpage_build_control_buttons 0 | |
| 3938 produce_build_tree | |
| 3939 nbpage_build_control_buttons 1 | |
| 3940 $toplevel.message configure -text "" | |
| 3941 set options_page_needs_refresh 1 | |
| 3942 set build_tree_needs_update 0 | |
| 3943 } | |
| 3944 | |
| 3945 proc pkgconf::nbpage_build_make { } { | |
| 3946 | |
| 3947 variable build_tree | |
| 3948 variable config_data | |
| 3949 | |
| 3950 nbpage_build_control_buttons 0 | |
| 3951 output_add_text "Building current configuration.\nBuild tree is $build_tree.\nInstall tree is $config_data(prefix)\n" | |
| 3952 run_command pkgconf::nbpage_build_handle_output make -C $build_tree | |
| 3953 } | |
| 3954 | |
| 3955 proc pkgconf::nbpage_build_tests { } { | |
| 3956 | |
| 3957 variable build_tree | |
| 3958 variable config_data | |
| 3959 nbpage_build_control_buttons 0 | |
| 3960 output_add_text \ | |
| 3961 "Building test executables.\nBuild tree is $build_tree\nInstall tree is $config_data(prefix)\n" | |
| 3962 run_command pkgconf::nbpage_build_handle_output make -C $build_tree tests | |
| 3963 } | |
| 3964 | |
| 2 | 3965 proc pkgconf::nbpage_build_misc { } { |
| 3966 | |
| 3967 variable build_tree | |
| 3968 variable config_data | |
| 3969 nbpage_build_control_buttons 0 | |
| 3970 output_add_text \ | |
| 3971 "Building misc executables.\nBuild tree is $build_tree\nInstall tree is $config_data(prefix)\n" | |
| 3972 run_command pkgconf::nbpage_build_handle_output make -C $build_tree misc | |
| 3973 } | |
| 3974 | |
| 0 | 3975 proc pkgconf::nbpage_build_clean { } { |
| 3976 | |
| 3977 variable build_tree | |
| 3978 nbpage_build_control_buttons 0 | |
| 3979 output_add_text "Cleaning build tree $build_tree.\n" | |
| 3980 run_command pkgconf::nbpage_build_handle_output make -C $build_tree clean | |
| 3981 } | |
| 3982 | |
| 3983 # }}} | |
| 3984 | |
| 3985 # }}} | |
| 3986 # {{{ Output window | |
| 3987 | |
| 3988 # ---------------------------------------------------------------------------- | |
| 3989 # These routines take care of the output window. There are two variables | |
| 3990 # describing the current state of the window: output_docked and | |
| 3991 # output_visible. There are four commands which can be invoked from | |
| 3992 # buttons, and a further command which can be invoked from the windows | |
| 3993 # menu. There is also a routine which can be used to add text to | |
| 3994 # the current output window, making it visible if necessary. | |
| 3995 # | |
| 3996 # The packing of the main .pkgconf window has to be redone every time | |
| 3997 # the output window is displayed or hidden, if the output window is | |
| 3998 # currently docked. To avoid duplicating code there are auxiliary | |
| 3999 # routine output_make_visible and output_make_invisible. | |
| 4000 # | |
| 4001 | |
| 4002 # This routine is invoked from the View menu. Its purpose is to | |
| 4003 # hide or display the output window, depending on the value of | |
| 4004 # output_visible. Note that output_visible indicates the desired | |
| 4005 # state of affairs, not the actual state of affairs. | |
| 4006 # | |
| 4007 proc pkgconf::output_menu { } { | |
| 4008 | |
| 4009 variable output_visible | |
| 4010 | |
| 4011 if { $output_visible == 0 } { | |
| 4012 output_make_invisible | |
| 4013 } else { | |
| 4014 output_make_visible | |
| 4015 } | |
| 4016 } | |
| 4017 | |
| 4018 proc pkgconf::output_make_visible { } { | |
| 4019 | |
| 4020 variable output_docked | |
| 4021 variable toplevel | |
| 4022 | |
| 4023 if { $output_docked == 0 } { | |
| 4024 # The output is in a separate window. Deiconifying it should make | |
| 4025 # it visible. | |
| 4026 wm deiconify .pkgconf_output | |
| 4027 } else { | |
| 4028 # It is necessary to repack the main window. This time it is the | |
| 4029 # output frame that should expand. | |
| 4030 pack forget $toplevel.notebook $toplevel.message | |
| 4031 pack $toplevel.notebook -side top -fill x | |
| 4032 pack $toplevel.message -side top -fill x | |
| 4033 pack $toplevel.output -side top -fill both -expand 1 | |
| 4034 } | |
| 4035 } | |
| 4036 | |
| 4037 proc pkgconf::output_make_invisible { } { | |
| 4038 | |
| 4039 variable output_docked | |
| 4040 variable toplevel | |
| 4041 | |
| 4042 if { $output_docked == 0 } { | |
| 4043 # The output is in a separate window, just withdraw it. | |
| 4044 wm withdraw .pkgconf_output | |
| 4045 } else { | |
| 4046 # It is necessary to repack the .pkgconf window without | |
| 4047 # the output window. This time it is the notebook which | |
| 4048 # should expand to fit all available space. | |
| 4049 pack forget $toplevel.notebook $toplevel.message $toplevel.output | |
| 4050 pack $toplevel.notebook -side top -fill both -expand 1 | |
| 4051 pack $toplevel.message -side top -fill x | |
| 4052 } | |
| 4053 } | |
| 4054 | |
| 4055 # | |
| 4056 # This routine is invoked when the output window is already visible | |
| 4057 # and the user has pressed the button in that window to make it | |
| 4058 # invisible. | |
| 4059 # | |
| 4060 proc pkgconf::output_hide_window { } { | |
| 4061 | |
| 4062 variable output_visible | |
| 4063 variable toplevel | |
| 4064 ASSERT { $output_visible != 0 } | |
| 4065 | |
| 4066 output_make_invisible | |
| 4067 set output_visible 0 | |
| 4068 } | |
| 4069 | |
| 4070 # | |
| 4071 # Switch between a docked and an undocked window. The window must | |
| 4072 # currently be visible. Any text must be copied across from | |
| 4073 # one widget to the other. | |
| 4074 # | |
| 4075 proc pkgconf::output_undock_window { } { | |
| 4076 | |
| 4077 variable output_visible | |
| 4078 variable output_docked | |
| 4079 variable toplevel | |
| 4080 | |
| 4081 ASSERT { $output_visible != 0 } | |
| 4082 | |
| 4083 output_make_invisible | |
| 4084 | |
| 4085 $toplevel.output.text configure -state normal | |
| 4086 .pkgconf_output.text configure -state normal | |
| 4087 | |
| 4088 if { $output_docked == 0 } { | |
| 4089 $toplevel.output.text insert end [.pkgconf_output.text get 1.0 "end - 1 chars"] | |
| 4090 .pkgconf_output.text delete 1.0 end | |
| 4091 set output_docked 1 | |
| 4092 } else { | |
| 4093 .pkgconf_output.text insert end [$toplevel.output.text get 1.0 "end - 1 chars"] | |
| 4094 $toplevel.output.text delete 1.0 end | |
| 4095 set output_docked 0 | |
| 4096 } | |
| 4097 | |
| 4098 $toplevel.output.text configure -state disabled | |
| 4099 .pkgconf_output.text configure -state disabled | |
| 4100 | |
| 4101 output_make_visible | |
| 4102 } | |
| 4103 | |
| 4104 # | |
| 4105 # Clear the text window, which should currently be visible. | |
| 4106 # | |
| 4107 proc pkgconf::output_clear_window { } { | |
| 4108 | |
| 4109 variable output_visible | |
| 4110 variable output_docked | |
| 4111 variable toplevel | |
| 4112 | |
| 4113 ASSERT { $output_visible != 0 } | |
| 4114 if { $output_docked == 0 } { | |
| 4115 .pkgconf_output.text configure -state normal | |
| 4116 .pkgconf_output.text delete 1.0 end | |
| 4117 .pkgconf_output.text configure -state disabled | |
| 4118 } else { | |
| 4119 $toplevel.output.text configure -state normal | |
| 4120 $toplevel.output.text delete 1.0 end | |
| 4121 $toplevel.output.text configure -state disabled | |
| 4122 } | |
| 4123 } | |
| 4124 | |
| 4125 # | |
| 4126 # Save the current contents of the text window to a file. | |
| 4127 # | |
| 4128 proc pkgconf::output_save { } { | |
| 4129 | |
| 4130 variable build_tree | |
| 4131 variable output_docked | |
| 4132 variable toplevel | |
| 4133 | |
| 4134 set filename [tk_getSaveFile -initialdir $build_tree -initialfile pkgconf.log \ | |
| 4135 -parent [expr { $output_docked ? "$toplevel" : ".pkgconf_output" } ] ] | |
| 4136 | |
| 4137 if { $filename == "" } { | |
| 4138 return | |
| 4139 } | |
| 4140 | |
| 4141 if { [catch { | |
| 4142 set file [open $filename w] | |
| 4143 if { $output_docked == 0 } { | |
| 4144 puts $file [.pkgconf_output.text get 1.0 "end - 1 chars"] | |
| 4145 } else { | |
| 4146 puts $file [$toplevel.output.text get 1.0 "end - 1 chars"] | |
| 4147 } | |
| 4148 close $file | |
| 4149 } message] != 0 } { | |
| 4150 warning "Failed to save build output to $filename: $message" | |
| 4151 } | |
| 4152 } | |
| 4153 | |
| 4154 # | |
| 4155 # Output some text. This gets invoked mainly during builds, but also | |
| 4156 # by the report() function when generating a build tree. It is | |
| 4157 # necessary to make sure that the text widget is visible. | |
| 4158 # | |
| 4159 proc pkgconf::output_add_text { msg } { | |
| 4160 | |
| 4161 variable output_visible | |
| 4162 variable output_docked | |
| 4163 variable toplevel | |
| 4164 | |
| 4165 if { $output_visible == 0 } { | |
| 4166 output_make_visible | |
| 4167 set output_visible 1 | |
| 4168 } | |
| 4169 | |
| 4170 if { $output_docked == 0 } { | |
| 4171 .pkgconf_output.text configure -state normal | |
| 4172 .pkgconf_output.text insert end $msg | |
| 4173 .pkgconf_output.text configure -state disabled | |
| 4174 .pkgconf_output.text see end | |
| 4175 } else { | |
| 4176 $toplevel.output.text configure -state normal | |
| 4177 $toplevel.output.text insert end $msg | |
| 4178 $toplevel.output.text configure -state disabled | |
| 4179 $toplevel.output.text see end | |
| 4180 } | |
| 4181 } | |
| 4182 | |
| 4183 # }}} | |
| 4184 # {{{ Status line | |
| 4185 | |
| 4186 # ---------------------------------------------------------------------------- | |
| 4187 # Some utility routines to update the status line. | |
| 4188 | |
| 4189 proc pkgconf::set_status_line { text } { | |
| 4190 variable toplevel | |
| 4191 $toplevel.message configure -text $text | |
| 4192 } | |
| 4193 | |
| 4194 proc pkgconf::clear_status_line { } { | |
| 4195 variable toplevel | |
| 4196 $toplevel.message configure -text "" | |
| 4197 } | |
| 4198 | |
| 4199 # }}} | |
| 4200 # {{{ Diagnostics | |
| 4201 | |
| 4202 # ---------------------------------------------------------------------------- | |
| 4203 # GUI versions of the same routines. For now tk_messageBox will have | |
| 4204 # to suffice for fatal error | |
| 4205 # | |
| 4206 proc pkgconf::gui_fatal_error_handler { msg } { | |
| 4207 | |
| 4208 variable toplevel | |
| 4209 | |
| 4210 if { [winfo exists $toplevel] } { | |
| 4211 tk_messageBox -parent $toplevel -icon error -title "pkgconf: fatal error" -type ok -message $msg | |
| 4212 } else { | |
| 4213 tk_messageBox -icon error -title "pkgconf: fatal error" -type ok -message $msg | |
| 4214 } | |
| 4215 exit 1 | |
| 4216 } | |
| 4217 | |
| 4218 proc pkgconf::gui_warning_handler { msg } { | |
| 4219 | |
| 4220 variable toplevel | |
| 4221 | |
| 4222 if { [winfo exists $toplevel] } { | |
| 4223 tk_messageBox -parent $toplevel -icon error -title "pkgconf: fatal error" -type ok -message $msg | |
| 4224 } else { | |
| 4225 tk_messageBox -icon error -title "pkgconf: fatal error" -type ok -message $msg | |
| 4226 } | |
| 4227 } | |
| 4228 | |
| 4229 proc pkgconf::gui_report_handler { msg } { | |
| 4230 | |
| 4231 output_add_text "$msg\n" | |
| 4232 update | |
| 4233 } | |
| 4234 | |
| 4235 # }}} | |
| 4236 # {{{ Executing external commands | |
| 4237 | |
| 4238 # ---------------------------------------------------------------------------- | |
| 4239 # This code is responsible for executing external commands. The broken nature | |
| 4240 # of pipes under Windows makes this somewhat more difficult than it should be. | |
| 4241 | |
| 4242 proc pkgconf::run_command { callback command args } { | |
| 4243 | |
| 4244 # Start up the specified command. Actually the main command is run such that | |
| 4245 # both stdout and stderr are piped into cat, thus making sure that the | |
| 4246 # stderr output is not discarded. | |
| 4247 set result [catch { set pipe [open "|[concat $command $args] 2>@ stdout" "r"] } message] | |
| 4248 if { $result != 0 } { | |
| 4249 warning "Failed to execute $command: $message" | |
| 4250 return | |
| 4251 } | |
| 4252 | |
| 4253 # Now set the pipe to non-blocking, to prevent the whole GUI from | |
| 4254 # locking up by accident. | |
| 4255 fconfigure $pipe -blocking 0 | |
| 4256 | |
| 4257 # Set up an event handler to read back any output. | |
| 4258 fileevent $pipe readable [list pkgconf::handle_command_output $pipe $callback] | |
| 4259 } | |
| 4260 | |
| 4261 # | |
| 4262 # This routine gets invoked whenever there may be data waiting on the | |
| 4263 # pipe. | |
| 4264 # | |
| 4265 proc pkgconf::handle_command_output { pipe callback } { | |
| 4266 | |
| 4267 set data "" | |
| 4268 set count [gets $pipe data] | |
| 4269 if { $count > 0 } { | |
| 4270 $callback $data | |
| 4271 } elseif { [eof $pipe] } { | |
| 4272 catch { close $pipe } | |
| 4273 $callback "" | |
| 4274 } | |
| 4275 } | |
| 4276 | |
| 4277 # }}} | |
| 4278 | |
| 4279 # }}} | |
| 4280 # {{{ Produce build tree | |
| 4281 | |
| 4282 # {{{ Description | |
| 4283 | |
| 4284 # ---------------------------------------------------------------------------- | |
| 4285 # Producing the build tree. This requires the following information: | |
| 4286 # | |
| 4287 # 1) the location of the component repository. This should be known. | |
| 4288 # | |
| 4289 # 2) the location of the build tree. This should also be known. | |
| 4290 # | |
| 4291 # 3) full details of the target architecture. These may not have been supplied | |
| 4292 # yet, which would result in a fatal error. | |
| 4293 # | |
| 4294 # 4) details of which packages are explicitly enabled or disabled. | |
| 4295 # | |
| 4296 # 5) details of which version of each package should be used. | |
| 4297 # | |
| 4298 # 6) prefix information, i.e. where the system will be installed. | |
| 4299 # The default value "" indicates an install directory relative to the | |
| 4300 # build tree. | |
| 4301 # | |
| 4302 # This routine may be called for an empty build tree, or it | |
| 4303 # may be used to update an existing build tree. | |
| 4304 # | |
| 4305 # The steps that have to be taken are as follows: | |
| 4306 # | |
| 4307 # 1) create a pkgconf directory, which is where all the editable | |
| 4308 # header files will end up. A few other files will end up there | |
| 4309 # as well. | |
| 4310 # | |
| 4311 # 2) examine all packages, including the hal packages. For each package: | |
| 4312 # | |
| 4313 # a) if there is a src directory in the component repository, reproduce | |
| 4314 # this in the build tree. If this src directory has any | |
| 4315 # sub-directories, these have to be created as well. | |
| 4316 # | |
| 4317 # The src directory should contain a file PKGconf.mak. This has to be | |
| 4318 # copied across as makefile. There may also be PKGconf.mak files in | |
| 4319 # subdirectories which should also get copied across. Typically the | |
| 4320 # latter will be for internal development purposes. | |
| 4321 # | |
| 4322 # b) if there is an include directory in the component repository, | |
| 4323 # make a matching directory in the build tree. Ditto for any | |
| 4324 # subdirectories other than pkgconf. | |
| 4325 # | |
| 4326 # The purpose of this include directory is to allow users to make | |
| 4327 # editable copies of the header files in the build tree. A makefile | |
| 4328 # is generated in this directory which will take care of updating the | |
| 4329 # header files that actually get used for building, i.e. those in the | |
| 4330 # include directory. The header files are not actually copied across | |
| 4331 # at this point, that will happen during the first make. | |
| 4332 # | |
| 4333 # The pkgconf directory is handled differently. Every file in | |
| 4334 # pkgconf is copied across to the build tree's pkgconf directory, | |
| 4335 # unless there is already a matching file in the build tree. | |
| 4336 # This avoids overwriting edits made by the user in the build | |
| 4337 # tree. The disadvantage is that if the version in the component | |
| 4338 # repository is edited it will have to be copied by hand, or the | |
| 4339 # -force command line argument will have to be used. | |
| 4340 # | |
| 4341 # c) if there is a tests directory in the component repository, make | |
| 4342 # a matching directory in the build tree and copy | |
| 4343 # across PKGconf.mak. If this tests directory has any subdirectories | |
| 4344 # then these must be created as well. | |
| 4345 # | |
| 2 | 4346 # d) similarly for any 'misc' directories |
| 4347 # | |
| 0 | 4348 # 3) create the install directory tree, complete with lib, include, and tests |
| 4349 # directories, and the include/pkgconf sub-directory. Additional | |
| 4350 # sub-directories within include need not be generated at this point, | |
| 4351 # that happens as such sub-directories are encountered within the | |
| 4352 # component repository. | |
| 4353 # | |
| 4354 # 4) copy across the makevars file. | |
| 4355 # | |
| 4356 # 5) generate the files specific to this configuration. | |
| 4357 # | |
| 4358 # Note that subdirectories corresponding to old packages are not | |
| 4359 # deleted, they simply get ignored. Arguably this should change, | |
| 4360 # but then you run the risk of deleting user changes in a package | |
| 4361 # that has been disabled only temporarily. | |
| 4362 # | |
| 4363 | |
| 4364 # }}} | |
| 4365 # {{{ Check requirements | |
| 4366 | |
| 4367 # ---------------------------------------------------------------------------- | |
| 4368 # It is not possible to generate a build tree unless certain requirements | |
| 4369 # are satisfied. Most of these will have been checked elsewhere. | |
| 4370 # | |
| 4371 proc pkgconf::check_requirements { } { | |
| 4372 | |
| 4373 ASSERT { $pkgconf::build_tree != "" } | |
| 4374 ASSERT { $pkgconf::component_repository != "" } | |
| 4375 | |
| 4376 if { $pkgconf::component_repository == $pkgconf::build_tree } { | |
| 4377 report "Builds of eCos cannot happen in the same directory as the sources." | |
| 4378 report "Currently your build tree is $pkgconf::build_tree." | |
| 4379 report "This is the same directory as your component repository." | |
| 4380 fatal_error "Unable to proceed with builds in this directory." | |
| 4381 } | |
| 4382 | |
| 4383 if { $pkgconf::config_data(target) == "" } { | |
| 4384 fatal_error "No target architecture has been specified." | |
| 4385 } | |
| 4386 if { $pkgconf::config_data(platform) == "" } { | |
| 4387 fatal_error "No target platform has been specified." | |
| 4388 } | |
| 4389 if { $pkgconf::config_data(startup) == "" } { | |
| 4390 fatal_error "No target startup mechanism has been specified." | |
| 4391 } | |
| 4392 } | |
| 4393 | |
| 4394 # }}} | |
| 4395 # {{{ Directory and file utilities | |
| 4396 | |
| 4397 # ---------------------------------------------------------------------------- | |
| 4398 # Start with a number of utility routines to access all files in | |
| 4399 # a directory, stripping out well-known files such as makefile.am. | |
| 4400 # The routines take an optional pattern argument if only certain | |
| 4401 # files are of interest. | |
| 4402 # | |
| 4403 # Note that symbolic links are returned as well as files. | |
| 4404 # | |
| 4405 proc pkgconf::locate_files { dir { pattern "*"} } { | |
| 4406 | |
| 4407 ASSERT { $dir != "" } | |
| 4408 | |
| 4409 # Start by getting a list of all the files. | |
| 4410 set filelist [glob -nocomplain -- [file join $dir $pattern]] | |
| 4411 | |
| 4412 # Eliminate the pathnames from all of these files | |
| 4413 set filenames "" | |
| 4414 foreach file $filelist { | |
| 2 | 4415 if { [string range $file end end] != "~" } { |
| 4416 lappend filenames [file tail $file] | |
| 4417 } | |
| 0 | 4418 } |
| 4419 | |
| 4420 # Eliminate any obviously spurious entries. | |
| 4421 foreach file { CVS Makefile.am Makefile.in makefile acinclude.m4 aclocal.m4 configure.in configure } { | |
| 4422 set index [lsearch -exact $filenames $file] | |
| 4423 if { $index != -1 } { | |
| 4424 set filenames [lreplace $filenames $index $index] | |
| 4425 } | |
| 4426 } | |
| 4427 | |
| 4428 # Eliminate any subdirectories. | |
| 4429 set subdirs "" | |
| 4430 foreach name $filenames { | |
| 4431 if { [file isdir [file join $dir $name]] } { | |
| 4432 lappend subdirs $name | |
| 4433 } | |
| 4434 } | |
| 4435 foreach subdir $subdirs { | |
| 4436 set index [lsearch -exact $filenames $subdir] | |
| 4437 set filenames [lreplace $filenames $index $index] | |
| 4438 } | |
| 4439 | |
| 4440 return $filenames | |
| 4441 } | |
| 4442 | |
| 4443 # | |
| 4444 # This utility returns all sub-directories, as opposed to all files. | |
| 4445 # A variant glob pattern is used here. This version is not recursive. | |
| 4446 proc pkgconf::locate_subdirs { dir { pattern "*" }} { | |
| 4447 | |
| 4448 ASSERT { $dir != "" } | |
| 4449 | |
| 4450 set dirlist [glob -nocomplain -- [file join $dir $pattern "."]] | |
| 4451 | |
| 4452 # Eliminate the pathnames and the spurious /. at the end of each entry | |
| 4453 set dirnames "" | |
| 4454 foreach dir $dirlist { | |
| 4455 lappend dirnames [file tail [file dirname $dir]] | |
| 4456 } | |
| 4457 | |
| 4458 # Get rid of the CVS directory, if any | |
| 4459 set index [lsearch -exact $dirnames "CVS"] | |
| 4460 if { $index != -1 } { | |
| 4461 set dirnames [lreplace $dirnames $index $index] | |
| 4462 } | |
| 4463 | |
| 4464 # That should be it. | |
| 4465 return $dirnames | |
| 4466 } | |
| 4467 | |
| 4468 # | |
| 4469 # A variant which is recursive. This one does not support a pattern. | |
| 4470 # | |
| 4471 proc pkgconf::locate_all_subdirs { dir } { | |
| 4472 | |
| 4473 ASSERT { $dir != "" } | |
| 4474 | |
| 4475 set result "" | |
| 4476 foreach subdir [locate_subdirs $dir] { | |
| 4477 lappend result $subdir | |
| 4478 foreach x [locate_all_subdirs [file join $dir $subdir]] { | |
| 4479 lappend result [file join $subdir $x] | |
| 4480 } | |
| 4481 } | |
| 4482 return $result | |
| 4483 } | |
| 4484 | |
| 4485 # | |
| 4486 # This routine returns a list of all the files in a given directory and in | |
| 4487 # all subdirectories, preserving the subdirectory name. | |
| 4488 # | |
| 4489 proc pkgconf::locate_all_files { dir { pattern "*" } } { | |
| 4490 | |
| 4491 ASSERT { $dir != "" } | |
| 4492 | |
| 4493 set files [locate_files $dir $pattern] | |
| 4494 set subdirs [locate_subdirs $dir] | |
| 4495 | |
| 4496 foreach subdir $subdirs { | |
| 4497 set subfiles [locate_all_files [file join $dir $subdir] $pattern] | |
| 4498 foreach file $subfiles { | |
| 4499 lappend files [file join $subdir $file] | |
| 4500 } | |
| 4501 } | |
| 4502 | |
| 4503 return $files | |
| 4504 } | |
| 4505 | |
| 4506 # | |
| 4507 # Sometimes a directory may be empty, or contain just a CVS subdirectory, | |
| 4508 # in which case there is no point in copying it across. | |
| 4509 # | |
| 4510 proc pkgconf::is_empty_directory { dir } { | |
| 4511 | |
| 4512 ASSERT { $dir != "" } | |
| 4513 | |
| 4514 set contents [glob -nocomplain -- [file join $dir "*"]] | |
| 4515 if { [llength $contents] == 0 } { | |
| 4516 return 1 | |
| 4517 } | |
| 4518 if { ([llength $contents] == 1) && [string match {*CVS} $contents] } { | |
| 4519 return 1 | |
| 4520 } | |
| 4521 return 0 | |
| 4522 } | |
| 4523 | |
| 4524 # ---------------------------------------------------------------------------- | |
| 4525 # Given a pathname such as kernel/current/include, this routine returns | |
| 4526 # a string which points at the build tree's pkgconf directory | |
| 4527 # complete with the appropriate number of ..'s in the pathname | |
| 4528 # | |
| 4529 proc pkgconf::get_dotdots_pkgconf { dir } { | |
| 4530 | |
| 4531 set result ".." | |
| 4532 | |
| 4533 while { 1} { | |
| 4534 set dir [file dirname $dir] | |
| 4535 if { ($dir == ".") || ($dir == ":") } { | |
| 4536 break | |
| 4537 } | |
| 4538 set result [file join $result ".."] | |
| 4539 } | |
| 4540 | |
| 4541 set result [file join $result "pkgconf"] | |
| 4542 return $result | |
| 4543 } | |
| 4544 | |
| 4545 # ---------------------------------------------------------------------------- | |
| 4546 # Internally this script works using native path names. When outputting the | |
| 4547 # makefile information it is necessary to output the paths in a format that | |
| 4548 # is understood by GnuMake. | |
| 4549 # | |
| 4550 proc pkgconf::get_pathname_for_make { dir } { | |
| 4551 | |
| 4552 # First of all, handle directory separators. Under Unix this is a no-op. | |
| 4553 # Under Windows the current directory separator may be \ instead of /. | |
| 4554 # It is not entirely clear under what circumstances Tcl's "file nativename" | |
| 4555 # facility uses / vs. \, but converting all existing backslashes to | |
| 4556 # forward slashes should be harmless. | |
| 4557 if { $pkgconf::windows_host != 0 } { | |
| 4558 regsub -all -- {\\} $dir "/" dir | |
| 4559 } | |
| 4560 | |
| 4561 # Next cope with spaces in pathnames. GnuMake does not always cope | |
| 4562 # sensibly with these, even if backslash quoting is used - there | |
| 4563 # are known problems with VPATH and with the wildcard function. Under | |
| 4564 # Unix there is no simple solution, but it is unlikely that the problem | |
| 4565 # will arise in the first place. Under Windows it is quite likely that | |
| 4566 # the problem will arise, but it is possible to work around it | |
| 4567 # by using a short file name. | |
| 4568 | |
| 4569 set index [string first " " $dir] | |
| 4570 if { $index != -1 } { | |
| 4571 if { $pkgconf::windows_host != 0 } { | |
| 4572 | |
| 4573 # This call will only work if the specified object already exists. | |
| 4574 # This should not be a problem, as the pathnames are likely to | |
| 4575 # be relative to the component repository, the build tree, or the | |
| 4576 # install tree. The component repository must already exist. The | |
| 4577 # build tree must already exist, since this call will only be | |
| 4578 # invoked when generating makefiles inside the build tree. The | |
| 4579 # install tree will have been created before pkgconf/pkgconf.mak | |
| 4580 # is written out, and that is the only place that needs to refer | |
| 4581 # to it. | |
| 4582 | |
| 4583 set dir [file attribute $dir -shortname] | |
| 4584 } else { | |
| 4585 fatal_error "Cannot cope with pathname \"$pathname\".\nPathnames with spaces are not supported on this platform." | |
| 4586 } | |
| 4587 } | |
| 4588 | |
| 4589 # Other characters that have special meaning include: []*?()$^|&#<>"'`; | |
| 4590 # At least, that is the list used within vmake. $ has to be quoted as $$, | |
| 4591 # the others should be quoted with a single backslash. | |
| 4592 regsub -all -- {\$} $dir {$$} dir | |
| 4593 foreach char { {\[} {\]} {\*} {\?} {\(} {\)} {\^} {\|} {\&} {\#} {\<} {\>} {\"} {\'} {\`} {\;} } { | |
| 4594 regsub -all -- $char $dir "\\$char" dir | |
| 4595 } | |
| 4596 | |
| 4597 # Now cope with Windows drive names. | |
| 4598 # | |
| 4599 # First, volume-relative filenames. If the directory string begins with | |
| 4600 # c:xxx, as opposed to c:/xxx, it is necessary to figure out what the | |
| 4601 # current directory is on drive c: and use this as prefix for the rest | |
| 4602 # of the string. | |
| 4603 # | |
| 4604 # Once volume-relative filenames have been handled the directory may be | |
| 4605 # along the lines of c:/Cygnus/eCos/whatever. This is problematical for | |
| 4606 # GnuMake since the colon character has special meaning in various places, | |
| 4607 # e.g. to identify static pattern rules. cygwin32 uses //c/ as an alias | |
| 4608 # for c:/ wherever appropriate. | |
| 4609 if { $pkgconf::windows_host != 0 } { | |
| 4610 | |
| 4611 set dummy "" | |
| 4612 set match1 "" | |
| 4613 set match2 "" | |
| 4614 set match3 "" | |
| 4615 | |
| 4616 if { [regexp -- {^([a-zA-Z]:)(/)?(.*)} $dir dummy match1 match2 match3] == 1 } { | |
| 4617 if { $match2 == "" } { | |
| 4618 set result [catch { | |
| 4619 set current_dir [pwd] | |
| 4620 cd $match1 | |
| 4621 set dir [pwd] | |
| 4622 regsub -all -- {\\} $dir "/" dir | |
| 4623 set dir [file join $dir $match3] | |
| 4624 cd $current_dir | |
| 4625 } message] | |
| 4626 if { $result != 0 } { | |
| 4627 fatal_error "Failed to determine current directory on drive $match1" | |
| 4628 } | |
| 4629 } | |
| 4630 } | |
| 4631 | |
| 4632 if { [regexp -- {^([a-zA-Z]):} $dir dummy match1] == 1 } { | |
| 4633 set dir "//$match1[string range $dir 2 end]" | |
| 4634 } | |
| 4635 } | |
| 4636 | |
| 4637 return $dir | |
| 4638 } | |
| 4639 | |
| 4640 # ---------------------------------------------------------------------------- | |
| 4641 # Take a cygwin32 filename such as //d/tmp/pkgobj and turn it into something | |
| 4642 # acceptable to Tcl, i.e. d:/tmp/pkgobj. There are a few other complications... | |
| 4643 | |
| 4644 proc pkgconf::get_pathname_for_tcl { name } { | |
| 4645 | |
| 4646 if { $pkgconf::windows_host } { | |
| 4647 set dummy "" | |
| 4648 set match1 "" | |
| 4649 set match2 "" | |
| 4650 | |
| 4651 # If the pathname is relative to ~, expand it now. | |
| 4652 if { [regexp -- {^~(.*)$} $name dummy match1] } { | |
| 4653 set name [file nativename $name] | |
| 4654 } | |
| 4655 | |
| 4656 # For consistency, get rid of any backslashes in the pathname. | |
| 4657 # Especially since the file nativename command above may have | |
| 4658 # introduced some. | |
| 4659 regsub -all -- {\\} $name "/" name | |
| 4660 | |
| 4661 # And now replace //d/tmp/pkgobj with d:/tmp/pkgobj | |
| 4662 if { [regexp -- {^//([a-zA-Z])(/.*)$} $name dummy match1 match2] == 1 } { | |
| 4663 set name "$match1:$match2" | |
| 4664 } | |
| 4665 | |
| 4666 # If the pathname is relative to the cygwin root, get hold of the | |
| 4667 # drive name. | |
| 4668 if { ([regexp -- {^/(.*)$} $name dummy match1] == 1) && ([regexp -- {^//.*$} $name dummy] == 0) } { | |
| 4669 set saved_dir [pwd] | |
| 4670 cd / | |
| 4671 set name [file join [pwd] $match1] | |
| 4672 cd $saved_dir | |
| 4673 } | |
| 4674 } | |
| 4675 return $name | |
| 4676 } | |
| 4677 | |
| 4678 # ---------------------------------------------------------------------------- | |
| 4679 # Output a standard banner to a generated file. | |
| 4680 # | |
| 4681 | |
| 4682 proc pkgconf::output_banner { file name } { | |
| 4683 | |
| 4684 puts $file \ | |
| 4685 "# | |
| 4686 # File $name | |
| 4687 # | |
| 4688 # This file is generated automatically by the pkgconf program. | |
| 4689 # It should not be edited. Any changes made to this file may | |
| 4690 # be overwritten by pkgconf. | |
| 4691 #" | |
| 4692 } | |
| 4693 | |
| 4694 # ---------------------------------------------------------------------------- | |
| 4695 # Make sure that a newly created or copied file is writable. This operation | |
| 4696 # is platform-specific. Under Unix at most the current user is given | |
| 4697 # permission, since there does not seem to be any easy way to get hold | |
| 4698 # of the real umask. | |
| 4699 | |
| 4700 proc pkgconf::make_writable { name } { | |
| 4701 | |
| 4702 ASSERT { $name != "" } | |
| 4703 ASSERT { [file isfile $name] } | |
| 4704 | |
| 4705 if { [file writable $name] == 0 } { | |
| 4706 if { $pkgconf::windows_host != 0 } { | |
| 4707 file attributes $name -readonly 0 | |
| 4708 } else { | |
| 4709 set mask [file attributes $name -permissions] | |
| 4710 set mask [expr $mask | 0200] | |
| 4711 file attributes $name -permissions $mask | |
| 4712 } | |
| 4713 } | |
| 4714 } | |
| 4715 | |
| 4716 # }}} | |
| 4717 # {{{ Other utilities | |
| 4718 | |
| 4719 # ---------------------------------------------------------------------------- | |
| 4720 # This code works out what packages should go into the current configuration. | |
| 4721 # The rules are as follows: | |
| 4722 # | |
| 4723 # 1) all hardware-specific packages should be disabled, unless they are | |
| 4724 # mentioned explicitly in the targets file for the current target or | |
| 4725 # platform, or unless they are enabled explicitly by the user. | |
| 4726 # | |
| 4727 # 2) all other packages which are enabled by default should be included, | |
| 4728 # unless they are disabled explicitly by the user. | |
| 4729 # | |
| 4730 # 3) all non-hardware packages which are disabled by default should be | |
| 4731 # left out, unless they are enabled explicitly by the user. | |
| 4732 | |
| 4733 proc pkgconf::get_current_packages { } { | |
| 4734 | |
| 4735 ASSERT { $pkgconf::config_data(target) != "" } | |
| 4736 ASSERT { $pkgconf::config_data(platform) != "" } | |
| 4737 ASSERT { [info exists pkgconf::target_data($pkgconf::config_data(target),packages)] } | |
| 4738 ASSERT { [info exists pkgconf::target_data($pkgconf::config_data(target),$pkgconf::config_data(platform),packages)] } | |
| 4739 ASSERT { [info exists pkgconf::config_data(enabled_packages)] } | |
| 4740 ASSERT { [info exists pkgconf::config_data(disabled_packages)] } | |
| 4741 | |
| 4742 set result "" | |
| 4743 set target_packages $pkgconf::target_data($pkgconf::config_data(target),packages) | |
| 4744 set platform_packages $pkgconf::target_data($pkgconf::config_data(target),$pkgconf::config_data(platform),packages) | |
| 4745 set enabled_packages $pkgconf::config_data(enabled_packages) | |
| 4746 set disabled_packages $pkgconf::config_data(disabled_packages) | |
| 4747 | |
| 4748 foreach pkg $pkgconf::known_packages { | |
| 4749 | |
| 4750 ASSERT { [info exists pkgconf::package_data($pkg,hardware)] } | |
| 4751 | |
| 4752 if { $pkgconf::package_data($pkg,hardware) } { | |
| 4753 | |
| 4754 if { [lsearch -exact $disabled_packages $pkg] != -1 } { | |
| 4755 continue | |
| 4756 } elseif { [lsearch -exact $target_packages $pkg] != -1 } { | |
| 4757 lappend result $pkg | |
| 4758 } elseif { [lsearch -exact $platform_packages $pkg] != -1 } { | |
| 4759 lappend result $pkg | |
| 4760 } elseif { [lsearch -exact $enabled_packages $pkg] != -1 } { | |
| 4761 lappend result $pkg | |
| 4762 } | |
| 4763 | |
| 4764 } elseif { $pkgconf::package_data($pkg,default) != 0 } { | |
| 4765 if { [lsearch -exact $disabled_packages $pkg] == -1 } { | |
| 4766 lappend result $pkg | |
| 4767 } | |
| 4768 } else { | |
| 4769 if { [lsearch -exact $enabled_packages $pkg] != -1 } { | |
| 4770 lappend result $pkg | |
| 4771 } | |
| 4772 } | |
| 4773 } | |
| 4774 | |
| 4775 return $result | |
| 4776 } | |
| 4777 | |
| 4778 # ---------------------------------------------------------------------------- | |
| 4779 # A utility to determine whether or not a particular setting has changed relative to | |
| 4780 # what is currently in the build tree. Information about the latter comes from | |
| 4781 # the save file, but may not exist the first time that the build tree is generated. | |
| 4782 # The config_data array itself may be sparsely populated, especially when it comes | |
| 4783 # to compiler flags. | |
| 4784 | |
| 4785 proc pkgconf::value_has_changed { name } { | |
| 4786 | |
| 4787 ASSERT {$name != ""} | |
| 4788 | |
| 4789 if { [info exists pkgconf::config_data($name)] == 0 } { | |
| 4790 | |
| 4791 if { [info exists pkgconf::saved_data($name)] == 0 } { | |
| 4792 return 0 | |
| 4793 } else { | |
| 4794 return 1 | |
| 4795 } | |
| 4796 | |
| 4797 } else { | |
| 4798 | |
| 4799 if { [info exists pkgconf::saved_data($name)] == 0 } { | |
| 4800 return 1 | |
| 4801 } | |
| 4802 if { $pkgconf::saved_data($name) != $pkgconf::config_data($name) } { | |
| 4803 return 1 | |
| 4804 } | |
| 4805 return 0 | |
| 4806 } | |
| 4807 } | |
| 4808 | |
| 4809 # ---------------------------------------------------------------------------- | |
| 4810 # Has there been a change in the packages in the system, either which packages | |
| 4811 # are present or any of their versions ? If there has been a change in the | |
| 4812 # packages then the amount of work that has to be done inside pkgconf is | |
| 4813 # increased significantly. | |
| 4814 | |
| 4815 proc pkgconf::packages_have_changed { } { | |
| 4816 | |
| 4817 if { [value_has_changed "target"] || [value_has_changed "platform"] } { | |
| 4818 return 1 | |
| 4819 } | |
| 4820 if { [value_has_changed "enabled_packages"] || [value_has_changed "disabled_packages"] } { | |
| 4821 return 1 | |
| 4822 } | |
| 4823 foreach pkg $pkgconf::known_packages { | |
| 4824 if { [value_has_changed "$pkg,version"] } { | |
| 4825 return 1 | |
| 4826 } | |
| 4827 } | |
| 4828 | |
| 4829 return 0 | |
| 4830 } | |
| 4831 | |
| 4832 | |
| 4833 # ---------------------------------------------------------------------------- | |
| 4834 # Given the name of a package, e.g. CYGPKG_KERNEL, return something which is | |
| 4835 # more acceptable in the build tree. Creating directories and files with | |
| 4836 # names containing lots of upper case characters is unacceptable. | |
| 4837 | |
| 4838 proc pkgconf::get_build_alias { name } { | |
| 4839 | |
| 4840 ASSERT { $name != ""} | |
| 4841 | |
| 4842 set index [string first "_" $name] | |
| 4843 if { $index != -1 } { | |
| 4844 set new_name [string range $name [incr index] end] | |
| 4845 if { $new_name != "" } { | |
| 4846 set name $new_name | |
| 4847 } | |
| 4848 } | |
| 4849 set name [string tolower $name] | |
| 4850 return $name | |
| 4851 } | |
| 4852 | |
| 4853 # }}} | |
| 4854 # {{{ Process a package | |
| 4855 | |
| 4856 # ---------------------------------------------------------------------------- | |
| 4857 # Process an entire package. The header files, the src directory, and the | |
| 4858 # tests directory are all handled separately. | |
| 4859 | |
| 4860 proc pkgconf::process_package { name dir } { | |
| 4861 | |
| 4862 report "Processing package $dir" | |
| 4863 | |
| 4864 set incdir [file join $dir "include"] | |
| 4865 if { [file isdir [file join $pkgconf::component_repository $incdir]] } { | |
| 4866 lappend pkgconf::inc_dirs $incdir | |
| 4867 process_package_includes $name $incdir | |
| 4868 } | |
| 4869 | |
| 4870 set srcdir [file join $dir "src"] | |
| 4871 if { [file isdir [file join $pkgconf::component_repository $srcdir]] } { | |
| 4872 if { [file isfile [file join $pkgconf::component_repository $srcdir PKGconf.mak]] } { | |
| 4873 lappend pkgconf::src_dirs $srcdir | |
| 4874 process_package_src $srcdir | |
| 4875 } | |
| 4876 } | |
| 4877 | |
| 4878 set testsdir [file join $dir "tests"] | |
| 4879 if { [file isdir [file join $pkgconf::component_repository $testsdir]] } { | |
| 4880 if { [file isfile [file join $pkgconf::component_repository $testsdir PKGconf.mak]] } { | |
| 4881 lappend pkgconf::tests_dirs $testsdir | |
| 4882 process_package_tests $name $testsdir | |
| 4883 } | |
| 4884 } | |
| 2 | 4885 |
| 4886 set miscdir [file join $dir "misc"] | |
| 4887 if { [file isdir [file join $pkgconf::component_repository $miscdir]] } { | |
| 4888 if { [file isfile [file join $pkgconf::component_repository $miscdir PKGconf.mak]] } { | |
| 4889 lappend pkgconf::misc_dirs $miscdir | |
| 4890 process_package_misc $miscdir | |
| 4891 } | |
| 4892 } | |
| 0 | 4893 } |
| 4894 | |
| 4895 # ---------------------------------------------------------------------------- | |
| 4896 # Processing the header files is somewhat complicated. The include directories | |
| 4897 # and any subdirectories except pkgconf have to be created in the build tree. | |
| 4898 # Details of these subdirectories get stored in the variable header_subdirs. | |
| 4899 # A pro-forma makefile has to be generated in the build tree, using details | |
| 4900 # of all the header files. These header files must also be appended to the | |
| 4901 # variable header_files. Any files in pkgconf have to be copied across | |
| 4902 # to the pkgconf directory, but must not overwrite the files that are | |
| 4903 # already there. | |
| 4904 # | |
| 4905 # As an additional complication, each package may define its own header | |
| 4906 # file directory. For example a package xyz may specify that all of its | |
| 4907 # exported header files should go into the xyz subdirectory of the install | |
| 4908 # include tree, not at the top level. There are special cases for the HAL. | |
| 4909 # | |
| 4910 # Note that if there are any spurious directories already present, these | |
| 4911 # do not get deleted. However the generated makefile will not reference | |
| 4912 # them so it should be harmless. | |
| 4913 # | |
| 4914 | |
| 4915 proc pkgconf::process_package_includes { name dir } { | |
| 4916 | |
| 4917 # What subdirectory in the install tree should be used ? | |
| 4918 ASSERT { [info exists pkgconf::package_data($name,incdir)] } | |
| 4919 set pkg_incdir $pkgconf::package_data($name,incdir) | |
| 4920 | |
| 4921 # Get information about the package's include directory. | |
| 4922 set pkg_inc_dirs [locate_all_subdirs [file join $pkgconf::component_repository $dir]] | |
| 4923 set pkg_pkgconf_files [locate_files [file join $pkgconf::component_repository $dir "pkgconf"]] | |
| 4924 set pkg_inc_files [locate_all_files [file join $pkgconf::component_repository $dir]] | |
| 4925 | |
| 4926 # Remove all pkgconf headers from the all_headers list. pkgconf headers | |
| 4927 # are handled by a separate makefile in the pkgconf directory. | |
| 4928 foreach hdr $pkg_pkgconf_files { | |
| 4929 set index [lsearch -exact $pkg_inc_files [file join pkgconf $hdr]] | |
| 4930 ASSERT { $index != -1 } | |
| 4931 set pkg_inc_files [lreplace $pkg_inc_files $index $index] | |
| 4932 } | |
| 4933 | |
| 4934 # Remove all unwanted subdirectories. These include pkgconf (which is handled | |
| 4935 # specially) and any empty subdirectories. | |
| 4936 set tmp "" | |
| 4937 foreach subdir $pkg_inc_dirs { | |
| 4938 if { ($subdir == "pkgconf") } { | |
| 4939 continue | |
| 4940 } | |
| 4941 if { [is_empty_directory [file join $pkgconf::component_repository $dir $subdir] ] } { | |
| 4942 continue | |
| 4943 } | |
| 4944 lappend tmp $subdir | |
| 4945 } | |
| 4946 set pkg_inc_dirs $tmp | |
| 4947 | |
| 4948 # Create the include directory in the build tree, plus any subdirectories. | |
| 4949 # This directory tree must map the structure of the source tree, so there is | |
| 4950 # no need to worry about thispkg_incdir. | |
| 4951 file mkdir [file join $pkgconf::build_tree $dir] | |
| 4952 foreach subdir $pkg_inc_dirs { | |
| 4953 file mkdir [file join $pkgconf::build_tree $dir $subdir] | |
| 4954 } | |
| 4955 | |
| 4956 # Copy across the pkgconf files that are not already present. | |
| 4957 # Also keep track of this information globally. | |
| 4958 foreach hdr $pkg_pkgconf_files { | |
| 4959 if { [lsearch -exact $pkgconf::pkgconf_files $hdr] != -1 } { | |
| 4960 return -code error "Duplicate configuration header file $hdr" | |
| 4961 } | |
| 4962 lappend pkgconf::pkgconf_files $hdr | |
| 4963 | |
| 4964 set src [file join $pkgconf::component_repository $dir "pkgconf" $hdr] | |
| 4965 set dest [file join $pkgconf::build_tree "pkgconf" $hdr] | |
| 4966 if { (! [file isfile $dest]) || ($pkgconf::force_arg != 0) } { | |
| 4967 file copy -force -- $src $dest | |
| 4968 make_writable $dest | |
| 4969 } | |
| 4970 } | |
| 4971 | |
| 4972 # Keep track of all the subdirectories that should be generated | |
| 4973 # in the install tree. Note that packages may share these | |
| 4974 # subdirectories, e.g. the sys subdirectory will be used by | |
| 4975 # both the C library and by a POSIX compatibily layer. | |
| 4976 # | |
| 4977 # It is necessary to list pkg_incdir separately, and all | |
| 4978 # of its parent directories. Otherwise it is not possible to | |
| 4979 # clean up the install tree correctly when packages get removed. | |
| 4980 if { $pkg_incdir != "" } { | |
| 4981 set current_path "" | |
| 4982 foreach field [file split $pkg_incdir] { | |
| 4983 set current_path [file join $current_path $field] | |
| 4984 if { [lsearch -exact $pkgconf::install_inc_dirs $current_path] == -1 } { | |
| 4985 lappend pkgconf::install_inc_dirs $current_path | |
| 4986 } | |
| 4987 } | |
| 4988 } | |
| 4989 foreach subdir $pkg_inc_dirs { | |
| 4990 set dest [file join $pkg_incdir $subdir] | |
| 4991 if { [lsearch -exact $pkgconf::install_inc_dirs $dest] == -1 } { | |
| 4992 lappend pkgconf::install_inc_dirs $dest | |
| 4993 } | |
| 4994 } | |
| 4995 | |
| 4996 # Keep track of all header files, checking for duplicates. | |
| 4997 foreach hdr $pkg_inc_files { | |
| 4998 set dest [file join $pkg_incdir $hdr] | |
| 4999 if { [lsearch -exact $pkgconf::install_inc_files $dest] != -1 } { | |
| 5000 return -code error "Duplicate header file $dest" | |
| 5001 } | |
| 5002 lappend pkgconf::install_inc_files $dest | |
| 5003 } | |
| 5004 | |
| 5005 # Generate the makefile in the target directory. First set up | |
| 5006 # some variables to contain the right sort of data for a makefile. | |
| 5007 if { $pkg_incdir == "" } { | |
| 5008 set pkg_incdir "." | |
| 5009 } else { | |
| 5010 set pkg_incdir [get_pathname_for_make $pkg_incdir] | |
| 5011 } | |
| 5012 set tmp "" | |
| 5013 foreach file $pkg_inc_files { | |
| 5014 lappend tmp [get_pathname_for_make $file] | |
| 5015 } | |
| 5016 set pkg_inc_files $tmp | |
| 5017 | |
| 5018 set filename [file join $dir "makefile"] | |
| 5019 set makefile [open [file join $pkgconf::build_tree $filename] "w"] | |
| 5020 output_banner $makefile $filename | |
| 5021 puts $makefile \ | |
| 5022 " | |
| 5023 include [get_pathname_for_make [file join [get_dotdots_pkgconf $dir] "pkgconf.mak"]] | |
| 5024 | |
| 2 | 5025 include [get_pathname_for_make [file join [get_dotdots_pkgconf $dir] "system.mak"]] |
| 5026 | |
| 0 | 5027 HEADERS := $pkg_inc_files |
| 5028 TARGETS := \$(foreach hdr,\$(HEADERS),\$(PREFIX)/include/$pkg_incdir/\$(hdr)) | |
| 5029 .PHONY : build clean | |
| 5030 VPATH := . [file join \$(COMPONENT_REPOSITORY) $dir] | |
| 5031 | |
| 5032 build: \$(TARGETS) | |
| 5033 | |
| 5034 " | |
| 5035 foreach hdr $pkg_inc_files { | |
| 5036 puts $makefile "\$(PREFIX)/include/$pkg_incdir/$hdr : $hdr" | |
| 5037 if { $pkgconf::config_data(use_links) == 0 } { | |
| 5038 puts $makefile "\t@\$(CP) \$< \$@" | |
| 5039 } else { | |
| 5040 puts $makefile "\t@\$(RM) \$@; ln -s \$< \$@" | |
| 5041 } | |
| 5042 puts $makefile "" | |
| 5043 } | |
| 5044 | |
| 5045 puts $makefile "clean:" | |
| 5046 foreach hdr $pkg_inc_files { | |
| 5047 puts $makefile "\t@\$(RM) \$(PREFIX)/include/$pkg_incdir/$hdr" | |
| 5048 } | |
| 5049 puts $makefile "\n# End of $filename" | |
| 5050 close $makefile | |
| 5051 } | |
| 5052 | |
| 5053 # ---------------------------------------------------------------------------- | |
| 5054 # Processing the src directory is relatively straightforward. It is | |
| 5055 # necessary to create the src directory in the build tree, plus any | |
| 5056 # subdirectories. It is also necessary to copy across the PKGconf.mak | |
| 5057 # file from the component repository to the build tree, assuming the | |
| 5058 # destination file does not already exist, and do the same in any | |
| 5059 # subdirectories. | |
| 5060 # | |
| 5061 proc pkgconf::process_package_src { dir } { | |
| 5062 | |
| 5063 set srcdir [file join $pkgconf::component_repository $dir] | |
| 5064 set destdir [file join $pkgconf::build_tree $dir] | |
| 5065 | |
| 5066 file mkdir $destdir | |
| 5067 set subdirs [locate_all_subdirs $srcdir] | |
| 5068 foreach subdir $subdirs { | |
| 5069 if { [is_empty_directory [file join $srcdir $subdir] ] } { | |
| 5070 continue | |
| 5071 } | |
| 5072 file mkdir [file join $destdir $subdir] | |
| 5073 } | |
| 5074 | |
| 5075 set makefiles [locate_all_files $srcdir "PKGconf.mak"] | |
| 5076 foreach makefile $makefiles { | |
| 5077 set destname [file join $destdir [file dirname $makefile] "makefile"] | |
| 5078 | |
| 5079 if { ([file isfile $destname] == 0) || $pkgconf::force_arg } { | |
| 5080 file copy -force -- [file join $srcdir $makefile] $destname | |
| 5081 make_writable $destname | |
| 5082 } | |
| 5083 } | |
| 5084 } | |
| 5085 | |
| 5086 # ---------------------------------------------------------------------------- | |
| 5087 # Processing the tests directories is just the same as the source | |
| 5088 # directories, for now. There is one additional complication in that | |
| 5089 # the test executables have to get installed, so it is necessary to | |
| 5090 # keep track of which directories are needed in the install tree. | |
| 5091 | |
| 5092 proc pkgconf::process_package_tests { name dir } { | |
| 5093 | |
| 5094 set srcdir [file join $pkgconf::component_repository $dir] | |
| 5095 set destdir [file join $pkgconf::build_tree $dir] | |
| 5096 | |
| 5097 lappend pkgconf::install_test_dirs [get_build_alias $name] | |
| 5098 | |
| 5099 file mkdir $destdir | |
| 5100 set subdirs [locate_all_subdirs $srcdir] | |
| 5101 | |
| 5102 foreach subdir $subdirs { | |
| 5103 lappend pkgconf::install_test_dirs [file join [get_build_alias $name] $subdir] | |
| 5104 file mkdir [file join $destdir $subdir] | |
| 5105 } | |
| 5106 | |
| 5107 set makefiles [locate_all_files $srcdir "PKGconf.mak"] | |
| 5108 foreach makefile $makefiles { | |
| 5109 set destname [file join $destdir [file dirname $makefile] "makefile"] | |
| 5110 if { ([file isfile $destname] == 0) || $pkgconf::force_arg } { | |
| 5111 file copy -force -- [file join $srcdir $makefile] $destname | |
| 5112 make_writable $destname | |
| 5113 } | |
| 5114 } | |
| 5115 } | |
| 5116 | |
| 2 | 5117 # ---------------------------------------------------------------------------- |
| 5118 # Processing the misc directory is just like the src directory. | |
| 5119 # | |
| 5120 proc pkgconf::process_package_misc { dir } { | |
| 5121 | |
| 5122 set miscdir [file join $pkgconf::component_repository $dir] | |
| 5123 set destdir [file join $pkgconf::build_tree $dir] | |
| 5124 | |
| 5125 file mkdir $destdir | |
| 5126 set subdirs [locate_all_subdirs $miscdir] | |
| 5127 foreach subdir $subdirs { | |
| 5128 if { [is_empty_directory [file join $miscdir $subdir] ] } { | |
| 5129 continue | |
| 5130 } | |
| 5131 file mkdir [file join $destdir $subdir] | |
| 5132 } | |
| 5133 | |
| 5134 set makefiles [locate_all_files $miscdir "PKGconf.mak"] | |
| 5135 foreach makefile $makefiles { | |
| 5136 set destname [file join $destdir [file dirname $makefile] "makefile"] | |
| 5137 | |
| 5138 if { ([file isfile $destname] == 0) || $pkgconf::force_arg } { | |
| 5139 file copy -force -- [file join $miscdir $makefile] $destname | |
| 5140 make_writable $destname | |
| 5141 } | |
| 5142 } | |
| 5143 } | |
| 5144 | |
| 5145 # }}} | |
| 5146 # {{{ Package debug options | |
| 5147 | |
| 5148 # ---------------------------------------------------------------------- | |
| 5149 # Enable appropriate debug options in various packages. Currently the | |
| 5150 # only option that is affected is CYGPKG_INFRA_DEBUG in pkgconf/infra.h | |
| 5151 | |
| 5152 proc pkgconf::enable_package_debug_options { } { | |
| 5153 | |
| 5154 report "Enabling debug-related options" | |
| 5155 | |
| 5156 set fd [open [file join $pkgconf::build_tree "pkgconf" "infra.h"] "r"] | |
| 5157 set data [read $fd] | |
| 5158 close $fd | |
| 5159 | |
| 5160 if { [regexp -- {undef[ ]+CYGPKG_INFRA_DEBUG} $data] } { | |
| 5161 regsub -- {undef[ ]+CYGPKG_INFRA_DEBUG} $data {define CYGPKG_INFRA_DEBUG} data | |
| 5162 set fd [open [file join $pkgconf::build_tree "pkgconf" "infra.h"] "w"] | |
| 5163 puts $fd $data | |
| 5164 close $fd | |
| 5165 } | |
| 5166 } | |
| 5167 | |
| 5168 # Or the inverse. | |
| 5169 proc pkgconf::disable_package_debug_options { } { | |
| 5170 | |
| 5171 report "Disabling debug-related options" | |
| 5172 | |
| 5173 set fd [open [file join $pkgconf::build_tree "pkgconf" "infra.h"] "r"] | |
| 5174 set data [read $fd] | |
| 5175 close $fd | |
| 5176 | |
| 5177 if { [regexp -- {define[ ]+CYGPKG_INFRA_DEBUG} $data] } { | |
| 5178 regsub -- {define[ ]+CYGPKG_INFRA_DEBUG} $data {undef CYGPKG_INFRA_DEBUG} data | |
| 5179 set fd [open [file join $pkgconf::build_tree "pkgconf" "infra.h"] "w"] | |
| 5180 puts $fd $data | |
| 5181 close $fd | |
| 5182 } | |
| 5183 } | |
| 5184 | |
| 0 | 5185 # }}} |
| 5186 # {{{ Install tree | |
| 5187 | |
| 5188 # ---------------------------------------------------------------------------- | |
| 5189 # These routines take care of the install tree. The routine | |
| 5190 # produce_install_tree gets invoked after details of all the packages | |
| 5191 # are known, and hence after details of all the subdirectories | |
| 5192 # are known. | |
| 5193 # | |
| 5194 # Currently this routine will empty out the lib and tests directory | |
| 5195 # completely. It will also get rid of any files and subdirectories in | |
| 5196 # include which are no longer of interest. | |
| 5197 # | |
| 5198 # Clearing out libtarget.a and any similar libraries avoids problems | |
| 5199 # if the target architecture has changed. Such a change should cause | |
| 5200 # all source files to be rebuilt via a dependency on the makefile | |
| 5201 # auxiliary files. However it would result in an attempt to create | |
| 5202 # a library archive containing a mixture of architectures, which could | |
| 5203 # cause all sorts of problems. To make sure that the library gets | |
| 5204 # regenerated during the next build all the stamp files have to be | |
| 5205 # deleted. | |
| 5206 # | |
| 5207 # It is not a good idea to manipulate header files unnecessarily, | |
| 5208 # since changing these would result in application code being | |
| 5209 # recompiled as well as system code. However if the old and new | |
| 5210 # configurations involve a header file with the same name but coming | |
| 5211 # from different packages, (e.g. a standard HAL header if you switch | |
| 5212 # targets or platforms, or a package header if you change the version | |
| 5213 # of that package) then there are complications. | |
| 5214 # | |
| 5215 # For now the code is draconian and just deletes everything. This | |
| 5216 # needs to be optimised. | |
| 5217 # | |
| 5218 | |
| 5219 proc pkgconf::produce_install_tree { } { | |
| 5220 | |
| 5221 ASSERT { $pkgconf::build_tree != "" } | |
| 5222 | |
| 5223 if { $pkgconf::config_data(prefix) != "" } { | |
| 5224 set prefix $pkgconf::config_data(prefix) | |
| 5225 } else { | |
| 5226 set prefix [file join $pkgconf::build_tree "install"] | |
| 5227 } | |
| 5228 ASSERT { $prefix != "" } | |
| 5229 | |
| 5230 # There should be at least an include/pkgconf subdirectory | |
| 5231 ASSERT { $pkgconf::install_inc_dirs != "" } | |
| 5232 | |
| 5233 # In Tcl the mkdir call is a no-op if the directory already exists. | |
| 5234 report "Generating install directory $prefix" | |
| 5235 file mkdir $prefix | |
| 5236 file mkdir [file join $prefix "include"] | |
| 5237 file mkdir [file join $prefix "lib"] | |
| 5238 file mkdir [file join $prefix "tests"] | |
| 5239 | |
| 5240 foreach subdir $pkgconf::install_inc_dirs { | |
| 5241 file mkdir [file join $prefix "include" $subdir] | |
| 5242 } | |
| 5243 foreach subdir $pkgconf::install_test_dirs { | |
| 5244 file mkdir [file join $prefix "tests" $subdir] | |
| 5245 } | |
| 5246 | |
| 5247 if { 0 } { | |
| 5248 | |
| 5249 # BLV - this code does not work with the makefiles that are now | |
| 5250 # generated for the various include directories. If the old | |
| 5251 # configuration involved a header file xyz.h from package A and | |
| 5252 # the new configuration involves a header file xyz.h from a | |
| 5253 # different package (or a different version of the same package) | |
| 5254 # then the old header file would hang around. A temporary | |
| 5255 # work-around is to delete all header files. A proper fix is | |
| 5256 # rather more complicated. | |
| 5257 | |
| 5258 # Examine all the files currently in the include directory. If | |
| 5259 # any of them are not recognised then they should be deleted. | |
| 5260 # Typically this happens if a package is removed. | |
| 5261 # | |
| 5262 # There may be problems if users put the install tree under | |
| 5263 # source code control, in that files just disappear. However even if | |
| 5264 # the source code control system restores an old file this should be | |
| 5265 # harmless. The directory routines ignore CVS subdirectories and all | |
| 5266 # hidden files. | |
| 5267 # | |
| 5268 # Files in pkgconf have to be treated specially. These are listed | |
| 5269 # in pkgconf_files, not header_files. | |
| 5270 | |
| 5271 set existing_headers [locate_all_files [file join $prefix "include"]] | |
| 5272 set pkgconf_headers [locate_all_files [file join $prefix "include" pkgconf]] | |
| 5273 | |
| 5274 foreach file $pkgconf_headers { | |
| 5275 if { [lsearch -exact $pkgconf::pkgconf_files $file] == -1 } { | |
| 5276 set filename [file join $prefix "include" $file] | |
| 5277 report "Deleting unnecessary file $filename" | |
| 5278 file delete -- $filename | |
| 5279 } | |
| 5280 | |
| 5281 # Make sure that this file does not get processed again in the | |
| 5282 # next loop. | |
| 5283 set file [file join "pkgconf" $file] | |
| 5284 set index [lsearch -exact $existing_headers $file] | |
| 5285 ASSERT { $index != -1 } | |
| 5286 set existing_headers [lreplace $existing_headers $index $index] | |
| 5287 } | |
| 5288 | |
| 5289 foreach file $existing_headers { | |
| 5290 if { [lsearch -exact $pkgconf::install_inc_files $file] == -1 } { | |
| 5291 set filename [file join $prefix "include" $file] | |
| 5292 report "Deleting unnecessary file $filename" | |
| 5293 file delete -- $filename | |
| 5294 } | |
| 5295 } | |
| 5296 | |
| 5297 # If the user has switched from symbolic links to file copies then | |
| 5298 # it is also necessary to delete the old symbolic links. The reverse | |
| 5299 # also applies. | |
| 5300 set existing_headers [locate_all_files [file join $prefix "include"]] | |
| 5301 set files_removed 0 | |
| 5302 foreach file $existing_headers { | |
| 5303 | |
| 5304 set filename [file join $prefix "include" $file] | |
| 5305 set type [file type $filename] | |
| 5306 | |
| 5307 if { ($pkgconf::config_data(use_links) == 0 ) && ($type == "link") } { | |
| 5308 file delete -- $filename | |
| 5309 set files_removed 1 | |
| 5310 } elseif { ($pkgconf::config_data(use_links) == 1 ) && ($type == "file") } { | |
| 5311 file delete -- $filename | |
| 5312 set files_removed 1 | |
| 5313 } | |
| 5314 } | |
| 5315 if { $files_removed != 0 } { | |
| 5316 if { $pkgconf::config_data(use_links) == 0 } { | |
| 5317 report "Symbolic links in [file join $prefix include] deleted." | |
| 5318 } else { | |
| 5319 report "Header file copies in [file join $prefix include] deleted." | |
| 5320 } | |
| 5321 } | |
| 5322 | |
| 5323 # Now get rid of any unwanted subdirectories. | |
| 5324 set existing_subdirs [locate_all_subdirs [file join $prefix "include"]] | |
| 5325 foreach subdir $existing_subdirs { | |
| 5326 if { [lsearch -exact $pkgconf::install_inc_dirs $subdir] == -1 } { | |
| 5327 set dirname [file join $prefix "include" $subdir] | |
| 5328 report "Deleting unnecessary directory $dirname" | |
| 5329 file delete -force -- $dirname | |
| 5330 } | |
| 5331 } | |
| 5332 | |
| 5333 } else { | |
| 5334 | |
| 5335 # BLV - delete all header files for now. This is inefficient but safe. | |
| 5336 | |
| 5337 set existing_headers [locate_all_files [file join $prefix "include"]] | |
| 5338 foreach file $existing_headers { | |
| 5339 set filename [file join $prefix "include" $file] | |
| 5340 file delete -- $filename | |
| 5341 } | |
| 5342 | |
| 5343 # Now get rid of any unwanted subdirectories. | |
| 5344 set existing_subdirs [locate_all_subdirs [file join $prefix "include"]] | |
| 5345 foreach subdir $existing_subdirs { | |
| 5346 if { [lsearch -exact $pkgconf::install_inc_dirs $subdir] == -1 } { | |
| 5347 set dirname [file join $prefix "include" $subdir] | |
| 5348 report "Deleting unnecessary directory $dirname" | |
| 5349 file delete -force -- $dirname | |
| 5350 } | |
| 5351 } | |
| 5352 } | |
| 5353 | |
| 5354 # Get rid of all the files in lib. | |
| 5355 set lib_files [locate_files [file join $prefix "lib"]] | |
| 5356 if { $lib_files != "" } { | |
| 5357 report "Deleting old library files $lib_files" | |
| 5358 foreach file $lib_files { | |
| 5359 file delete -- [file join $prefix "lib" $file] | |
| 5360 } | |
| 5361 } | |
| 5362 | |
| 5363 # And get rid of any stamp files spread around the object tree | |
| 5364 foreach src_dir $pkgconf::src_dirs { | |
| 5365 set dirname [file join $pkgconf::build_tree $src_dir] | |
| 5366 set stamp_files [locate_files $dirname "*.stamp"] | |
| 5367 foreach file $stamp_files { | |
| 5368 file delete -- [file join $dirname $file] | |
| 5369 } | |
| 5370 } | |
| 5371 | |
| 5372 # Ditto for tests | |
| 5373 set test_files [locate_all_files [file join $prefix "tests"]] | |
| 5374 if { $test_files != "" } { | |
| 5375 report "Deleting old test executables." | |
| 5376 foreach file $test_files { | |
| 5377 file delete -- [file join $prefix "tests" $file] | |
| 5378 } | |
| 5379 } | |
| 5380 foreach test_dir $pkgconf::tests_dirs { | |
| 5381 set dirname [file join $pkgconf::build_tree $test_dir] | |
| 5382 set stamp_files [locate_files $dirname "*.stamp"] | |
| 5383 foreach file $stamp_files { | |
| 5384 file delete -- [file join $dirname $file] | |
| 5385 } | |
| 5386 } | |
| 5387 | |
| 5388 # If there has been a change in the packages in the system | |
| 5389 # then the various makefile.deps files currently in the | |
| 5390 # build tree may contain references to header files that | |
| 5391 # are no longer present. Therefore it is necessary to | |
| 5392 # get rid of the makefile.deps files. Any changes to the | |
| 5393 # packages will result in a new pkgconf/pkgconf.mak file | |
| 5394 # and all object files depend on this, so everything that | |
| 5395 # needs to be rebuilt will still be rebuilt and new | |
| 5396 # dependency files will be generated. | |
| 5397 # | |
| 5398 # If there has not been a change to the packages then the | |
| 5399 # makefile.deps files must not be deleted, or there would | |
| 5400 # be problems when just a header file is changed. | |
| 5401 if { [packages_have_changed] } { | |
| 5402 | |
| 5403 foreach src_dir $pkgconf::src_dirs { | |
| 5404 set dirname [file join $pkgconf::build_tree $src_dir] | |
| 5405 set dep_files [locate_files $dirname "makefile.deps"] | |
| 5406 foreach file $dep_files { | |
| 5407 file delete -- [file join $dirname $file] | |
| 5408 } | |
| 5409 } | |
| 5410 | |
| 5411 foreach test_dir $pkgconf::tests_dirs { | |
| 5412 set dirname [file join $pkgconf::build_tree $test_dir] | |
| 5413 set dep_files [locate_files $dirname "makefile.deps"] | |
| 5414 foreach file $dep_files { | |
| 5415 file delete -- [file join $dirname $file] | |
| 5416 } | |
| 5417 } | |
| 5418 } | |
| 5419 } | |
| 5420 | |
| 5421 # }}} | |
| 5422 # {{{ Produce misc. files | |
| 5423 | |
| 5424 # ---------------------------------------------------------------------------- | |
| 5425 # Three files have to be generated, and one additional file can be copied. | |
| 5426 # | |
| 5427 # 1) pkgconf/makevars has to be copied from the component repository. | |
| 5428 # 2) pkgconf/makevars relies on pkgconf/pkgconf.mak, which is generated | |
| 5429 # 3) pkgconf/system.h has to be generated. | |
| 5430 # 5) pkgconf/makefile has to be generated. | |
| 5431 # | |
| 5432 | |
| 5433 proc pkgconf::produce_misc_files { } { | |
| 5434 | |
| 5435 report "Generating miscellaneous files." | |
| 5436 | |
| 5437 # Start by copying across pkgconf/makevars unless these files | |
| 5438 # already exist in the build tree. Note that these files are | |
| 5439 # user-editable so they cannot be overwritten automatically. | |
| 5440 set destname [file join $pkgconf::build_tree "pkgconf" "makevars"] | |
| 5441 set sourcename [file join $pkgconf::component_repository "pkgconf" "makevars"] | |
| 5442 if { (![file isfile $destname]) || ($pkgconf::force_arg != 0) } { | |
| 5443 file copy -force -- $sourcename $destname | |
| 5444 make_writable $destname | |
| 5445 } | |
| 5446 | |
| 5447 # Next generate the file pkgconf.mak. This should only happen if any | |
| 5448 # of the data in the file is changed, because there are file-level | |
| 5449 # dependencies in the various makefiles. Additions to the packages | |
| 5450 # file will normally be caught by a missing version number. Other | |
| 5451 # changes to the packages or targets file may not be caught. | |
| 5452 | |
| 5453 set config_changed 0 | |
| 5454 if { [packages_have_changed] } { | |
| 5455 set config_changed 1 | |
| 5456 } | |
| 5457 if { [value_has_changed "prefix"] } { | |
| 5458 set config_changed 1 | |
| 5459 } | |
| 5460 foreach flag $pkgconf::known_compiler_flags { | |
| 5461 if { [value_has_changed "cflags,$flag"] } { | |
| 5462 set config_changed 1 | |
| 5463 break | |
| 5464 } | |
| 5465 } | |
| 5466 if { ![file isfile [file join $pkgconf::build_tree "pkgconf" "pkgconf.mak"]] } { | |
| 5467 set config_changed 1 | |
| 5468 } | |
| 5469 if { $pkgconf::force_arg != 0 } { | |
| 5470 set config_changed 1 | |
| 5471 } | |
| 5472 | |
| 5473 if { $config_changed != 0 } { | |
| 5474 | |
| 5475 set filename [file join "pkgconf" "pkgconf.mak"] | |
| 5476 set file [open [file join $pkgconf::build_tree $filename] "w"] | |
| 5477 output_banner $file $filename | |
| 5478 | |
| 5479 # All PKGconf.mak files should include the master pkgconf.mak | |
| 5480 # file ASAP. It is desirable to have a goal at the top of that | |
| 5481 # file. This is likely to be the first goal detected by make, | |
| 5482 # and hence the default. | |
| 5483 puts $file "\ndefault: build\n" | |
| 5484 | |
|
12
4cc3eff958ab
Merge from eCos master repository on 1999-06-04-22:24:56-BST
jlarmour
parents:
4
diff
changeset
|
5485 set platform $pkgconf::config_data(platform) |
|
4cc3eff958ab
Merge from eCos master repository on 1999-06-04-22:24:56-BST
jlarmour
parents:
4
diff
changeset
|
5486 if [info exists pkgconf::target_data($pkgconf::config_data(target),$platform,prefix)] { |
|
4cc3eff958ab
Merge from eCos master repository on 1999-06-04-22:24:56-BST
jlarmour
parents:
4
diff
changeset
|
5487 set command_prefix $pkgconf::target_data($pkgconf::config_data(target),$platform,prefix) |
|
4cc3eff958ab
Merge from eCos master repository on 1999-06-04-22:24:56-BST
jlarmour
parents:
4
diff
changeset
|
5488 } else { |
|
4cc3eff958ab
Merge from eCos master repository on 1999-06-04-22:24:56-BST
jlarmour
parents:
4
diff
changeset
|
5489 set command_prefix $pkgconf::target_data($pkgconf::config_data(target),prefix) |
|
4cc3eff958ab
Merge from eCos master repository on 1999-06-04-22:24:56-BST
jlarmour
parents:
4
diff
changeset
|
5490 } |
| 0 | 5491 |
| 5492 puts $file "" | |
| 5493 puts $file "COMPONENT_REPOSITORY\t\t:= [get_pathname_for_make $pkgconf::component_repository]" | |
| 5494 puts $file "BUILD_TREE\t\t\t:= [get_pathname_for_make $pkgconf::build_tree]" | |
| 5495 | |
| 2 | 5496 # Provide details of target etc. so that packages can specify |
| 5497 # per-target files. | |
| 5498 puts $file "TARGET\t\t\t\t:= $pkgconf::config_data(target)" | |
| 5499 puts $file "PLATFORM\t\t\t:= $pkgconf::config_data(platform)" | |
|
12
4cc3eff958ab
Merge from eCos master repository on 1999-06-04-22:24:56-BST
jlarmour
parents:
4
diff
changeset
|
5500 puts $file "BASE_PLATFORM\t\t\t:= $pkgconf::config_data(base_platform)" |
| 2 | 5501 puts $file "STARTUP\t\t\t\t:= $pkgconf::config_data(startup)" |
| 5502 | |
| 0 | 5503 # The prefix (i.e. install directory) should default to somewhere |
| 5504 # relative to the build tree. | |
| 5505 set prefix $pkgconf::config_data(prefix) | |
| 5506 if { $prefix == "" } { | |
| 5507 set prefix [file join $pkgconf::build_tree "install"] | |
| 5508 } | |
| 5509 puts $file "PREFIX\t\t\t\t:= [get_pathname_for_make $prefix]" | |
| 5510 if { $pkgconf::windows_host != 0 } { | |
| 5511 puts $file "EXEEXT\t\t\t\t:= .exe" | |
| 5512 } | |
| 5513 puts $file "" | |
| 5514 puts $file "PKGCONF_CC\t\t\t:= $command_prefix-gcc" | |
| 5515 puts $file "PKGCONF_CXX\t\t\t:= $command_prefix-gcc" | |
| 5516 puts $file "PKGCONF_AR\t\t\t:= $command_prefix-ar" | |
| 5517 puts $file "PKGCONF_LD\t\t\t:= $command_prefix-ld" | |
| 5518 puts $file "PKGCONF_OBJCOPY\t\t\t:= $command_prefix-objcopy" | |
| 5519 puts $file "" | |
| 5520 | |
| 5521 foreach flag $pkgconf::known_compiler_flags { | |
| 5522 set value "" | |
| 5523 if { [info exists pkgconf::config_data(cflags,$flag)] != 0 } { | |
| 5524 set value $pkgconf::config_data(cflags,$flag) | |
| 5525 } else { | |
| 5526 set value [get_platform_cflags $pkgconf::config_data(target) $pkgconf::config_data(platform) $flag] | |
| 5527 } | |
| 5528 if { $value != "" } { | |
| 5529 puts $file "PKGCONF_[set flag]\t\t:= $value" | |
| 5530 } | |
| 5531 } | |
| 5532 puts $file "" | |
| 5533 | |
| 5534 foreach pkg [get_current_packages] { | |
| 5535 set varname "[get_build_alias $pkg]_DIR" | |
| 5536 set dirname [file join $pkgconf::package_data($pkg,dir) $pkgconf::config_data($pkg,version)] | |
| 5537 puts $file "$varname\t\t:= $dirname" | |
| 5538 } | |
| 5539 | |
| 5540 # There are several files containing information about make variables | |
| 5541 # rules. The current file, pkgconf.mak, contains information that | |
| 5542 # is known to the pkgconf script and should not be edited by users. | |
| 5543 # There may be a per-package file in the build tree's pkgconf | |
| 5544 # directory, containing per-package settings. And there is the | |
| 5545 # makevars file which users can edit to override anything else. | |
| 5546 # | |
| 5547 # The makefiles for the various packages should only | |
| 5548 # need to include one of these files, the rest can be handled | |
| 5549 # automatically. Since pkgconf.mak is generated it knows the | |
| 5550 # location of the build tree, making it a lot easier to find | |
| 5551 # the others. Therefore pkgconf.mak is included first, then | |
| 5552 # the per-package file, and finally the makevars file. | |
| 5553 | |
| 5554 puts $file " | |
| 5555 PACKAGE_RULES_FILE := \$(wildcard \$(BUILD_TREE)/pkgconf/\$(PACKAGE).mak) | |
| 5556 ifneq ($(PACKAGE_RULES_FILE),) | |
| 5557 include $(PACKAGE_RULES_FILE) | |
| 5558 endif" | |
| 5559 | |
| 5560 puts $file "\ninclude \$(BUILD_TREE)/pkgconf/makevars" | |
| 5561 | |
| 5562 puts $file "\n# End of $filename" | |
| 5563 close $file | |
| 5564 } | |
| 5565 | |
| 5566 # And the file system.h | |
| 5567 # | |
| 5568 # Again, because of file-level dependencies this file should only | |
| 5569 # be written out if anything has actually changed. | |
| 5570 set config_changed 0 | |
| 5571 if { [packages_have_changed] || [value_has_changed "startup"] } { | |
| 5572 set config_changed 1 | |
| 5573 } | |
| 5574 if { ![file isfile [file join $pkgconf::build_tree "pkgconf" "system.h"]] } { | |
| 5575 set config_changed 1 | |
| 5576 } | |
| 5577 if { $pkgconf::force_arg != 0 } { | |
| 5578 set config_changed 1 | |
| 5579 } | |
| 5580 | |
| 5581 if { $config_changed != 0 } { | |
| 5582 | |
| 5583 set filename [file join "pkgconf" "system.h"] | |
| 5584 set file [open [file join $pkgconf::build_tree $filename] "w"] | |
| 5585 puts $file \ | |
| 5586 "#ifndef CYGONCE_PKGCONF_SYSTEM_H | |
| 5587 #define CYGONCE_PKGCONF_SYSTEM_H | |
| 5588 /* | |
| 5589 * File $filename | |
| 5590 * | |
| 5591 * This file is generated automatically by the pkgconf program. | |
| 5592 * It should not be edited. Any changes to this file may be | |
| 5593 * overwritten by pkgconf. | |
| 5594 */ | |
| 5595 " | |
| 5596 puts $file "#define CYG_HAL_[string toupper $pkgconf::config_data(target)]" | |
| 5597 puts $file \ | |
| 5598 "#define CYG_HAL_[string toupper $pkgconf::config_data(target)]_[string toupper $pkgconf::config_data(platform)]" | |
| 5599 puts $file "#define CYG_HAL_STARTUP_[string toupper $pkgconf::config_data(startup)]" | |
| 5600 puts $file "" | |
| 5601 set current_packages [get_current_packages] | |
| 5602 foreach pkg $pkgconf::known_packages { | |
| 5603 if { [lsearch -exact $current_packages $pkg] == -1 } { | |
| 5604 puts $file "#undef $pkg" | |
| 5605 } else { | |
| 5606 puts $file "#define $pkg" | |
| 5607 } | |
| 5608 } | |
| 5609 | |
| 2 | 5610 # Additions for the MLT |
| 5611 puts $file "\n" | |
|
14
01ce82f3e11a
Merge from eCos master repository on 1999-06-11-17:05:41-BST
jlarmour
parents:
12
diff
changeset
|
5612 puts $file "#define CYGHWR_MEMORY_LAYOUT_LDI <pkgconf/mlt_[set pkgconf::config_data(target)]_[set pkgconf::config_data(platform)]_[set pkgconf::config_data(startup)].ldi>" |
|
01ce82f3e11a
Merge from eCos master repository on 1999-06-11-17:05:41-BST
jlarmour
parents:
12
diff
changeset
|
5613 puts $file "#define CYGHWR_MEMORY_LAYOUT_H <pkgconf/mlt_[set pkgconf::config_data(target)]_[set pkgconf::config_data(platform)]_[set pkgconf::config_data(startup)].h>" |
|
4
1d7f19c9e4d1
Merge from eCos master repository on 1999-05-11-21:11:10-BST
jlarmour
parents:
2
diff
changeset
|
5614 |
|
1d7f19c9e4d1
Merge from eCos master repository on 1999-05-11-21:11:10-BST
jlarmour
parents:
2
diff
changeset
|
5615 # Also output details of the HAL header files that should be included |
|
1d7f19c9e4d1
Merge from eCos master repository on 1999-05-11-21:11:10-BST
jlarmour
parents:
2
diff
changeset
|
5616 puts $file "\n" |
|
1d7f19c9e4d1
Merge from eCos master repository on 1999-05-11-21:11:10-BST
jlarmour
parents:
2
diff
changeset
|
5617 puts $file "#define CYGBLD_HAL_TARGET_H <pkgconf/hal_[set pkgconf::config_data(target)].h>" |
|
12
4cc3eff958ab
Merge from eCos master repository on 1999-06-04-22:24:56-BST
jlarmour
parents:
4
diff
changeset
|
5618 puts $file "#define CYGBLD_HAL_PLATFORM_H <pkgconf/hal_[set pkgconf::config_data(target)]_[set pkgconf::config_data(base_platform)].h>" |
| 2 | 5619 |
| 0 | 5620 puts $file "\ |
| 5621 \n#endif /* CYGONCE_PKGCONF_SYSTEM_H */ | |
| 5622 /* EOF $filename */" | |
| 5623 close $file | |
| 5624 } | |
| 5625 | |
| 2 | 5626 # 'system.mak' has the same basic information, but in a form |
| 5627 # that can be used by makefile fragments. | |
| 5628 | |
| 5629 if { $config_changed != 0 } { | |
| 5630 | |
| 5631 set filename [file join "pkgconf" "system.mak"] | |
| 5632 set file [open [file join $pkgconf::build_tree $filename] "w"] | |
| 5633 puts $file \ | |
| 5634 "# | |
| 5635 # File $filename | |
| 5636 # | |
| 5637 # This file is generated automatically by the pkgconf program. | |
| 5638 # It should not be edited. Any changes to this file may be | |
| 5639 # overwritten by pkgconf. | |
| 5640 # | |
| 5641 " | |
| 5642 puts $file "CYG_HAL_[string toupper $pkgconf::config_data(target)]=1" | |
| 5643 puts $file \ | |
| 5644 "CYG_HAL_[string toupper $pkgconf::config_data(target)]_[string toupper $pkgconf::config_data(platform)]=1" | |
| 5645 puts $file "CYG_HAL_STARTUP_[string toupper $pkgconf::config_data(startup)]=1" | |
| 5646 puts $file "" | |
| 5647 set current_packages [get_current_packages] | |
| 5648 foreach pkg $pkgconf::known_packages { | |
| 5649 if { [lsearch -exact $current_packages $pkg] != -1 } { | |
| 5650 puts $file "$pkg=1" | |
| 5651 } | |
| 5652 } | |
| 5653 puts $file "\n# /* EOF $filename */" | |
| 5654 close $file | |
| 5655 } | |
| 5656 | |
| 0 | 5657 # Always output a makefile in the pkgconf directory. This is harmless |
| 5658 # because there should be no file-level dependencies on this file (just | |
| 5659 # like the toplevel makefile). | |
| 5660 set filename [file join "pkgconf" "makefile"] | |
| 5661 set makefile [open [file join $pkgconf::build_tree $filename] "w"] | |
| 5662 output_banner $makefile $filename | |
| 5663 | |
| 5664 puts $makefile \ | |
| 5665 "include pkgconf.mak | |
| 5666 | |
| 5667 .PHONY : build clean | |
| 5668 HEADERS := $pkgconf::pkgconf_files | |
| 5669 TARGETS := \$(foreach hdr,\$(HEADERS),\$(PREFIX)/include/pkgconf/\$(hdr)) | |
| 5670 | |
| 5671 build: \$(TARGETS) | |
| 5672 " | |
| 5673 | |
| 5674 foreach hdr $pkgconf::pkgconf_files { | |
| 5675 puts $makefile "\$(PREFIX)/include/pkgconf/$hdr : $hdr" | |
| 5676 if { $pkgconf::config_data(use_links) == 0 } { | |
| 5677 puts $makefile "\t@\$(CP) \$< \$@" | |
| 5678 } else { | |
| 5679 puts $makefile "\t@\$(RM) \$@; ln -s \$< \$@" | |
| 5680 } | |
| 5681 puts $makefile "" | |
| 5682 } | |
| 5683 | |
| 5684 puts $makefile "clean:" | |
| 5685 foreach hdr $pkgconf::pkgconf_files { | |
| 5686 puts $makefile "\t@\$(RM) \$(PREFIX)/include/pkgconf/$hdr" | |
| 5687 } | |
| 5688 puts $makefile "\n# End of $filename" | |
| 5689 close $makefile | |
| 5690 | |
| 5691 } | |
| 5692 | |
| 5693 # }}} | |
| 5694 # {{{ Produce the master makefile | |
| 5695 | |
| 5696 # ---------------------------------------------------------------------------- | |
| 5697 # This routine is responsible for generating the master makefile that | |
| 5698 # exists at the top of a build tree. This makefile supports three main | |
| 5699 # targets: default, tests and clean. There is a subsidiary target | |
| 5700 # "headers" which takes care of the header files. | |
| 5701 # | |
| 5702 | |
| 5703 proc pkgconf::produce_makefile { } { | |
| 5704 | |
| 5705 report "Generating toplevel makefile." | |
| 5706 | |
| 5707 ASSERT { $pkgconf::build_tree != "" } | |
| 5708 set filename [file join $pkgconf::build_tree "makefile"] | |
| 5709 set makefile [open $filename "w"] | |
| 5710 output_banner $makefile "makefile" | |
| 5711 | |
| 5712 puts $makefile \ | |
| 5713 " | |
| 5714 include pkgconf/pkgconf.mak | |
|
4
1d7f19c9e4d1
Merge from eCos master repository on 1999-05-11-21:11:10-BST
jlarmour
parents:
2
diff
changeset
|
5715 .PHONY: default build clean tests headers" |
| 2 | 5716 |
| 5717 puts $makefile "\nbuild: $(PREFIX)/lib/extras.o" | |
| 5718 puts $makefile "\t@echo Build finished." | |
| 5719 | |
| 5720 puts $makefile "\n$(PREFIX)/lib/extras.o: $(PREFIX)/lib/libextras.a" | |
|
4
1d7f19c9e4d1
Merge from eCos master repository on 1999-05-11-21:11:10-BST
jlarmour
parents:
2
diff
changeset
|
5721 puts $makefile "\t$(CC) $(ARCHFLAGS) $(LDARCHFLAGS) -nostdlib -Wl,-r -Wl,--whole-archive $(PREFIX)/lib/libextras.a -o $(PREFIX)/lib/extras.o" |
| 2 | 5722 |
| 5723 puts $makefile "\n$(PREFIX)/lib/libextras.a: headers" | |
| 0 | 5724 foreach src_dir $pkgconf::src_dirs { |
| 5725 puts $makefile "\t\$(MAKE) -C $src_dir" | |
| 5726 } | |
| 5727 | |
| 5728 puts $makefile "\ntests: build" | |
| 5729 foreach tests_dir $pkgconf::tests_dirs { | |
| 5730 puts $makefile "\t\$(MAKE) -C $tests_dir" | |
| 5731 } | |
| 5732 puts $makefile "\t@echo Tests build finished." | |
| 5733 | |
| 2 | 5734 puts $makefile "\nmisc: build" |
| 5735 foreach misc_dir $pkgconf::misc_dirs { | |
| 5736 puts $makefile "\t\$(MAKE) -C $misc_dir" | |
| 5737 } | |
| 5738 puts $makefile "\t@echo Misc build finished." | |
| 5739 | |
| 0 | 5740 puts $makefile \ |
| 5741 "\nlibobjs := \$(wildcard \$(PREFIX)/lib/*) | |
| 5742 clean: | |
| 5743 ifneq (\$(libobjs),) | |
| 5744 \t\$(RM) \$(libobjs) | |
| 5745 endif | |
| 5746 \tmake -C pkgconf clean" | |
| 5747 foreach src_dir $pkgconf::src_dirs { | |
| 5748 puts $makefile "\t\$(MAKE) -C $src_dir clean" | |
| 5749 } | |
| 2 | 5750 foreach misc_dir $pkgconf::misc_dirs { |
| 5751 puts $makefile "\t\$(MAKE) -C $misc_dir clean" | |
| 5752 } | |
| 0 | 5753 foreach tests_dir $pkgconf::tests_dirs { |
| 5754 puts $makefile "\t\$(MAKE) -C $tests_dir clean" | |
| 5755 } | |
| 5756 foreach inc_dir $pkgconf::inc_dirs { | |
| 5757 puts $makefile "\t@\$(MAKE) -silent -C $inc_dir clean" | |
| 5758 } | |
| 5759 puts $makefile "\t@echo Clean finished." | |
| 5760 | |
| 5761 puts $makefile "\nheaders:" | |
| 5762 puts $makefile "\t@echo Checking header files." | |
| 5763 puts $makefile "\t@\$(MAKE) -silent -C pkgconf" | |
| 5764 foreach inc_dir $pkgconf::inc_dirs { | |
| 5765 puts $makefile "\t@\$(MAKE) -silent -C $inc_dir" | |
| 5766 } | |
| 5767 | |
| 5768 puts $makefile "" | |
| 5769 puts $makefile "# End of makefile" | |
| 5770 close $makefile | |
| 5771 } | |
| 5772 | |
| 5773 # }}} | |
| 5774 | |
| 5775 # {{{ Produce_build_tree | |
| 5776 | |
| 5777 proc pkgconf::produce_build_tree { } { | |
| 5778 | |
| 5779 # First, check that all the requirements have been satisfied. Normally | |
| 5780 # this will have been taken care of earlier. | |
| 5781 check_requirements | |
| 5782 | |
| 5783 # What is the install tree ? | |
| 5784 set prefix $pkgconf::config_data(prefix) | |
| 5785 if { $prefix == "" } { | |
| 5786 set prefix [file join $pkgconf::build_tree "install"] | |
| 5787 } | |
| 5788 set target $pkgconf::config_data(target) | |
| 5789 set platform $pkgconf::config_data(platform) | |
| 5790 set startup $pkgconf::config_data(startup) | |
| 5791 | |
| 5792 # Report the configuration that is being built. | |
| 5793 report "Generating build tree." | |
| 5794 report "Component repository is $pkgconf::component_repository" | |
| 5795 report "Build tree is $pkgconf::build_tree" | |
| 5796 report "Install directory is $prefix" | |
| 5797 report "Architecture $target, platform $platform, startup $startup." | |
| 5798 if { $pkgconf::config_data(use_links) != 0 } { | |
| 5799 report "Using symbolic links for the header files." | |
| 5800 } | |
| 5801 | |
| 5802 # Reset the list of all the header files that should be in the install | |
| 5803 # tree, and related variables. | |
| 5804 set pkgconf::inc_dirs "" | |
| 5805 set pkgconf::src_dirs "" | |
| 2 | 5806 set pkgconf::misc_dirs "" |
| 0 | 5807 set pkgconf::tests_dirs "" |
| 5808 set pkgconf::install_inc_dirs "pkgconf" | |
| 5809 set pkgconf::install_inc_files "" | |
| 5810 set pkgconf::pkgconf_files "makevars pkgconf.mak system.h" | |
| 5811 set pkgconf::install_test_dirs "" | |
| 5812 | |
| 5813 set status [catch { | |
| 5814 | |
| 5815 # Create the toplevel build tree directory, if necessary. | |
| 5816 if { ! [file exists $pkgconf::build_tree] } { | |
| 5817 report "Creating build tree $pkgconf::build_tree" | |
| 5818 file mkdir $pkgconf::build_tree | |
| 5819 } | |
| 5820 # Create the pkgconf subdirectory. A failure here indicates that | |
| 5821 # the build tree is not writable, and it is useful to detect this | |
| 5822 # before too much processing takes place. | |
| 5823 set dirname [file join $pkgconf::build_tree pkgconf] | |
| 5824 if { ! [file exists $dirname] } { | |
| 5825 report "Creating directory $dirname" | |
| 5826 file mkdir $dirname | |
| 5827 } | |
| 5828 | |
| 5829 # Process each package that is part of the current configuration | |
| 5830 foreach pkg [get_current_packages] { | |
| 5831 set dirname $pkgconf::package_data($pkg,dir) | |
| 5832 set dirname [file join $dirname $pkgconf::config_data($pkg,version)] | |
| 5833 process_package $pkg $dirname | |
| 5834 } | |
| 5835 | |
| 2 | 5836 # If this is a debug build (according to the --debug command line |
| 5837 # option), update the appropriate packages. | |
| 5838 if {$pkgconf::debug_arg != 0} { | |
| 5839 enable_package_debug_options | |
| 5840 } elseif {$pkgconf::nodebug_arg != 0} { | |
| 5841 disable_package_debug_options | |
| 5842 } | |
| 5843 | |
| 0 | 5844 # The install tree must exist before the misc files are generated. |
| 5845 # See get_pathname_for_make for details. | |
| 5846 produce_install_tree | |
| 5847 produce_misc_files | |
| 5848 produce_makefile | |
| 5849 | |
| 5850 report "Generating save file." | |
| 5851 write_save_file | |
| 5852 report "The Build tree is ready." | |
| 5853 | |
| 5854 } message] | |
| 5855 | |
| 5856 if { $status != 0 } { | |
| 5857 fatal_error "An unexpected error occurred while generating the build tree: $message" | |
| 5858 } | |
| 5859 } | |
| 5860 | |
| 5861 # }}} | |
| 5862 | |
| 5863 # }}} | |
| 5864 # {{{ main() | |
| 5865 | |
| 5866 # ---------------------------------------------------------------------------- | |
| 5867 # Initialise data. This routine is responsible for reading in the | |
| 5868 # packages file and the targets file, setting up the default data, | |
| 5869 # reading in the save file if any, and processing the command line | |
| 5870 # arguments if any. | |
| 5871 # | |
| 5872 | |
| 5873 proc pkgconf::initialise_data { } { | |
| 5874 | |
| 5875 # First, read the packages and targets files. These routines will | |
| 5876 # also deal with the --packages and --targets arguments, and | |
| 5877 # they will check for any invalid packages or targets that may | |
| 5878 # have been passed. The order of these two calls should not be | |
| 5879 # changed since read_targets needs to know about the available | |
| 5880 # packages for some of its validations. | |
| 5881 pkgconf::read_packages | |
| 5882 pkgconf::read_targets | |
| 5883 | |
| 5884 # If either or both of the --packages or --targets arguments | |
| 5885 # were used, do not go any further. The user was just asking | |
| 5886 # for information. Ditto for --pkgdata, which can be used by | |
| 5887 # other programs to get information about the various | |
| 5888 # packages in a format more appropriate for them. | |
| 5889 # | |
| 5890 # NOTE: the parsing code does not actually check that no | |
| 5891 # further arguments were passed, but it is unlikely that the | |
| 5892 # user would both ask for a list of packages and expect | |
| 5893 # something to happen. | |
| 5894 if { ( $pkgconf::list_packages_arg != 0 ) || | |
| 5895 ( $pkgconf::list_targets_arg != 0 ) || | |
| 5896 ( $pkgconf::list_pkgdata_arg != 0 ) } { | |
| 5897 exit 0 | |
| 5898 } | |
| 5899 | |
| 5900 # Set up default values for all options which are managed directly | |
| 5901 # by this program. | |
| 5902 pkgconf::setup_defaults | |
| 5903 | |
| 5904 # Check for a save file in the existing build tree. | |
| 5905 # If so read it in, updating the default values. | |
| 5906 pkgconf::read_save_file | |
| 5907 | |
| 5908 # Now process the command line arguments, which will again result | |
| 5909 # in updates to the default values. | |
| 5910 pkgconf::process_arguments | |
| 5911 | |
| 5912 # If the -flags argument was used, list the compiler flags currently | |
| 5913 # in use. This could not be done earlier since the compiler flags | |
| 5914 # may depend on the save file and on other command line arguments. | |
| 5915 if { $pkgconf::list_flags_arg != 0 } { | |
| 5916 foreach flag $pkgconf::known_compiler_flags { | |
| 5917 set value "" | |
| 5918 if { [info exists pkgconf::config_data(cflags,$flag)] != 0 } { | |
| 5919 set value $pkgconf::config_data(cflags,$flag) | |
| 5920 } else { | |
| 5921 set value [get_platform_cflags $pkgconf::config_data(target) $pkgconf::config_data(platform) $flag] | |
| 5922 } | |
| 5923 if { $value != "" } { | |
| 5924 puts "$flag\t\"$value\"" | |
| 5925 } | |
| 5926 } | |
| 5927 exit 0 | |
| 5928 } | |
| 5929 | |
| 5930 if { 0 } { | |
| 5931 puts "target: $pkgconf::config_data(target)" | |
| 5932 puts "platform: $pkgconf::config_data(platform)" | |
|
12
4cc3eff958ab
Merge from eCos master repository on 1999-06-04-22:24:56-BST
jlarmour
parents:
4
diff
changeset
|
5933 puts "base_platform: $pkgconf::config_data(base_platform)" |
| 0 | 5934 puts "startup: $pkgconf::config_data(startup)" |
| 5935 puts "prefix: $pkgconf::config_data(prefix)" | |
| 5936 puts "packages: $pkgconf::config_data(packages)" | |
| 5937 foreach pkg $pkgconf::config_data(packages) { | |
| 5938 puts "$pkg version $pkgconf::config_data($pkg,version)" | |
| 5939 } | |
| 5940 exit 0 | |
| 5941 } | |
| 5942 } | |
| 5943 | |
| 5944 # ---------------------------------------------------------------------------- | |
| 5945 # Main(). This code only runs if the script is being run stand-alone rather | |
| 5946 # than as part of a larger application. The controlling predicate is the | |
| 5947 # existence of the variable pkgconf_not_standalone which can be set by | |
| 5948 # the containing program if any. | |
| 5949 # | |
| 5950 | |
| 5951 if { ! [info exists pkgconf_not_standalone] } { | |
| 5952 | |
| 5953 # Do some necessary GUI initialisation such as hiding the main window | |
| 5954 # during startup. | |
| 5955 pkgconf::gui_standalone_init | |
| 5956 | |
| 5957 # Decide where warnings and fatal errors should go. | |
| 5958 pkgconf::initialise_error_handling | |
| 5959 | |
| 5960 # Parse the arguments and set the global variables appropriately. | |
| 5961 pkgconf::parse_arguments $argv0 $argv | |
| 5962 | |
| 5963 # Initialise all the data, e.g. by reading in the packages and | |
| 5964 # targets files. | |
| 5965 pkgconf::initialise_data | |
| 5966 | |
| 5967 # At this stage the code can do one of two things: run the GUI, | |
| 5968 # or build/update the build tree. | |
| 5969 # The GUI can be run if the necessary commands are available and | |
| 5970 # if the user did not pass -nw. | |
| 5971 if { $pkgconf::gui_possible && ! $pkgconf::no_windows_arg } { | |
| 5972 } else { | |
| 5973 set pkgconf::gui_mode 0 | |
| 5974 } | |
| 5975 | |
| 5976 # Reset error handling to the correct mode | |
| 5977 pkgconf::initialise_error_handling | |
| 5978 | |
| 5979 # Either enter GUI mode, or produce the build tree | |
| 5980 if { $pkgconf::gui_mode } { | |
| 5981 pkgconf::gui | |
| 5982 } else { | |
| 5983 pkgconf::produce_build_tree | |
| 5984 exit 0 | |
| 5985 } | |
| 5986 } | |
| 5987 | |
| 5988 # }}} | |
| 5989 | |
| 5990 |