Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | Fixed quoting bugs in auto_mkindex_parser, BUGID 1657 |
---|---|
Downloads: | Tarball | ZIP archive |
Timelines: | family | ancestors | descendants | both | trunk |
Files: | files | file ages | folders |
SHA1: |
0899c7c6c0b487d2909786c21a629ce5 |
User & Date: | welch 1999-03-31 18:58:14.000 |
Context
1999-03-31
| ||
18:58 | Added tests for auto_mkindex_parser quoting problems, BUGID 1657 check-in: 51ffe4e6ae user: welch tags: trunk | |
18:58 | Fixed quoting bugs in auto_mkindex_parser, BUGID 1657 check-in: 0899c7c6c0 user: welch tags: trunk | |
1999-03-25
| ||
22:47 | Fixed typo in LD_SEARCH_FLAGS definition for Linux. check-in: 2d44226fa5 user: welch tags: trunk | |
Changes
Changes to library/init.tcl.
1 2 3 4 5 | # init.tcl -- # # Default system startup file for Tcl-based applications. Defines # "unknown" procedure and auto-load facilities. # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 | # init.tcl -- # # Default system startup file for Tcl-based applications. Defines # "unknown" procedure and auto-load facilities. # # RCS: @(#) $Id: init.tcl,v 1.27 1999/03/31 18:58:14 welch Exp $ # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. |
︙ | ︙ | |||
368 369 370 371 372 373 374 375 376 377 378 379 380 381 | } } } return 1 } # auto_qualify -- # compute a fully qualified names list for use in the auto_index array. # For historical reasons, commands in the global namespace do not have leading # :: in the index key. The list has two elements when the command name is # relative (no leading ::) and the namespace is not the global one. Otherwise # only one name is returned (and searched in the auto_index). # # Arguments - | > | 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 | } } } return 1 } # auto_qualify -- # # compute a fully qualified names list for use in the auto_index array. # For historical reasons, commands in the global namespace do not have leading # :: in the index key. The list has two elements when the command name is # relative (no leading ::) and the namespace is not the global one. Otherwise # only one name is returned (and searched in the auto_index). # # Arguments - |
︙ | ︙ | |||
427 428 429 430 431 432 433 434 435 436 437 438 439 440 | # ( foo::bar , ::sub ) -> ::sub::foo::bar ::foo::bar return [list ${namespace}::$cmd ::$cmd] } } } # auto_import -- # invoked during "namespace import" to make see if the imported commands # reside in an autoloaded library. If so, the commands are loaded so # that they will be available for the import links. If not, then this # procedure does nothing. # # Arguments - # pattern The pattern of commands being imported (like "foo::*") | > | 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 | # ( foo::bar , ::sub ) -> ::sub::foo::bar ::foo::bar return [list ${namespace}::$cmd ::$cmd] } } } # auto_import -- # # invoked during "namespace import" to make see if the imported commands # reside in an autoloaded library. If so, the commands are loaded so # that they will be available for the import links. If not, then this # procedure does nothing. # # Arguments - # pattern The pattern of commands being imported (like "foo::*") |
︙ | ︙ | |||
566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 | return $auto_execs($name) } } return "" } } # auto_reset -- # Destroy all cached information for auto-loading and auto-execution, # so that the information gets recomputed the next time it's needed. # Also delete any procedures that are listed in the auto-load index # except those defined in this file. # # Arguments: # None. | > > > > > | 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 | return $auto_execs($name) } } return "" } } # OPTIONAL SUPPORT PROCEDURES # In Tcl 8.1 all the code below here has been moved to other files to # reduce the size of init.tcl # auto_reset -- # # Destroy all cached information for auto-loading and auto-execution, # so that the information gets recomputed the next time it's needed. # Also delete any procedures that are listed in the auto-load index # except those defined in this file. # # Arguments: # None. |
︙ | ︙ | |||
590 591 592 593 594 595 596 | } } catch {unset auto_execs} catch {unset auto_index} catch {unset auto_oldpath} } | | > > | 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 | } } catch {unset auto_execs} catch {unset auto_index} catch {unset auto_oldpath} } # tcl_findLibrary -- # # This is a utility for extensions that searches for a library directory # using a canonical searching algorithm. A side effect is to source # the initialization script and set a global library variable. # # Arguments: # basename Prefix of the directory name, (e.g., "tk") # version Version number of the package, (e.g., "8.0") # patch Patchlevel of the package, (e.g., "8.0.3") # initScript Initialization script to source (e.g., tk.tcl) # enVarName environment variable to honor (e.g., TK_LIBRARY) # varName Global variable to set when done (e.g., tk_library) |
︙ | ︙ | |||
671 672 673 674 675 676 677 | append msg " $dirs\n\n" append msg "$errors\n\n" append msg "This probably means that $basename wasn't installed properly.\n" error $msg } | < < < < | 680 681 682 683 684 685 686 687 688 689 690 691 692 693 | append msg " $dirs\n\n" append msg "$errors\n\n" append msg "This probably means that $basename wasn't installed properly.\n" error $msg } # ---------------------------------------------------------------------- # auto_mkindex # ---------------------------------------------------------------------- # The following procedures are used to generate the tclIndex file # from Tcl source files. They use a special safe interpreter to # parse Tcl source files, writing out index entries as "proc" # commands are encountered. This implementation won't work in a |
︙ | ︙ | |||
820 821 822 823 824 825 826 | $parser hide proc $parser hide namespace $parser hide eval $parser hide puts $parser invokehidden namespace delete :: $parser invokehidden proc unknown {args} {} | < | > | | 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 | $parser hide proc $parser hide namespace $parser hide eval $parser hide puts $parser invokehidden namespace delete :: $parser invokehidden proc unknown {args} {} # We'll need access to the "namespace" command within the # interp. Put it back, but move it out of the way. $parser expose namespace $parser invokehidden rename namespace _%@namespace $parser expose eval $parser invokehidden rename eval _%@eval # Install all the registered psuedo-command implementations foreach cmd $initCommands { eval $cmd } } } proc cleanup {} { variable parser interp delete $parser unset parser } } # auto_mkindex_parser::mkindex -- # # Used by the "auto_mkindex" command to create a "tclIndex" file for # the given Tcl source file. Executes the commands in the file, and # handles things like the "proc" command by adding an entry for the # index file. Returns a string that represents the index file. # # Arguments: # file Name of Tcl source file to be indexed. proc auto_mkindex_parser::mkindex {file} { variable parser variable index variable scriptFile variable contextStack variable imports |
︙ | ︙ | |||
885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 | foreach name $imports { catch {$parser eval [list _%@namespace forget $name]} } return $index } # auto_mkindex_parser::hook command # Registers a Tcl command to evaluate when initializing the # slave interpreter used by the mkindex parser. # The command is evaluated in the master interpreter, and can # use the variable auto_mkindex_parser::parser to get to the slave proc auto_mkindex_parser::hook {cmd} { variable initCommands lappend initCommands $cmd } # auto_mkindex_parser::slavehook command # Registers a Tcl command to evaluate when initializing the # slave interpreter used by the mkindex parser. # The command is evaluated in the slave interpreter. proc auto_mkindex_parser::slavehook {cmd} { variable initCommands | > > > > > | > | | | > > > > > > < | > > > > > > > > > > > > | | 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 | foreach name $imports { catch {$parser eval [list _%@namespace forget $name]} } return $index } # auto_mkindex_parser::hook command # # Registers a Tcl command to evaluate when initializing the # slave interpreter used by the mkindex parser. # The command is evaluated in the master interpreter, and can # use the variable auto_mkindex_parser::parser to get to the slave proc auto_mkindex_parser::hook {cmd} { variable initCommands lappend initCommands $cmd } # auto_mkindex_parser::slavehook command # # Registers a Tcl command to evaluate when initializing the # slave interpreter used by the mkindex parser. # The command is evaluated in the slave interpreter. proc auto_mkindex_parser::slavehook {cmd} { variable initCommands # The $parser variable is defined to be the name of the # slave interpreter when this command is used later. lappend initCommands "\$parser eval [list $cmd]" } # auto_mkindex_parser::command -- # # Registers a new command with the "auto_mkindex_parser" interpreter # that parses Tcl files. These commands are fake versions of things # like the "proc" command. When you execute them, they simply write # out an entry to a "tclIndex" file for auto-loading. # # This procedure allows extensions to register their own commands # with the auto_mkindex facility. For example, a package like # [incr Tcl] might register a "class" command so that class definitions # could be added to a "tclIndex" file for auto-loading. # # Arguments: # name Name of command recognized in Tcl files. # arglist Argument list for command. # body Implementation of command to handle indexing. proc auto_mkindex_parser::command {name arglist body} { hook [list auto_mkindex_parser::commandInit $name $arglist $body] } # auto_mkindex_parser::commandInit -- # # This does the actual work set up by auto_mkindex_parser::command # This is called when the interpreter used by the parser is created. # # Arguments: # name Name of command recognized in Tcl files. # arglist Argument list for command. # body Implementation of command to handle indexing. proc auto_mkindex_parser::commandInit {name arglist body} { variable parser set ns [namespace qualifiers $name] set tail [namespace tail $name] if {$ns == ""} { set fakeName "[namespace current]::_%@fake_$tail" } else { set fakeName "_%@fake_$name" regsub -all {::} $fakeName "_" fakeName set fakeName "[namespace current]::$fakeName" } proc $fakeName $arglist $body # YUK! Tcl won't let us alias fully qualified command names, # so we can't handle names like "::itcl::class". Instead, # we have to build procs with the fully qualified names, and # have the procs point to the aliases. if {[regexp {::} $name]} { set exportCmd [list _%@namespace export [namespace tail $name]] $parser eval [list _%@namespace eval $ns $exportCmd] set alias [namespace tail $fakeName] # The following proc definition does not work if you # want to tolerate space or something else diabolical # in the procedure name, (i.e., space in $alias) # The following does not work: # "_%@eval {$alias} \$args" # because $alias gets concat'ed to $args. # The following does not work because $cmd is somehow undefined # "set cmd {$alias} \; _%@eval {\$cmd} \$args" # A gold star to someone that can make test # autoMkindex-3.3 work properly $parser invokehidden proc $name {args} "_%@eval {$alias} \$args" $parser alias $alias $fakeName } else { $parser alias $name $fakeName } return } |
︙ | ︙ |