Tcl Source Code

Check-in [293b4045fe]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Fixing quoting bugs in auto_mkindex slavehook: BUGID 1657
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | core-8-1-branch-old
Files: files | file ages | folders
SHA1: 293b4045fe37e8adc334a241e05aed28dd27f919
User & Date: welch 1999-03-31 19:54:15
Context
1999-03-31
19:54
Tests for quoting bugs in auto_mkindex slavehook: BUGID 1657 check-in: f33978ea19 user: welch tags: core-8-1-branch-old
19:54
Fixing quoting bugs in auto_mkindex slavehook: BUGID 1657 check-in: 293b4045fe user: welch tags: core-8-1-branch-old
1999-03-30
23:56
* unix/Makefile.in: Removed trailing backslash that broke the "depend" target.

* unix/tclUnixInit.c... check-in: bffc3e18c7 user: stanton tags: core-8-1-branch-old

Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Changes to library/auto.tcl.

     1      1   # auto.tcl --
     2      2   #
     3      3   # utility procs formerly in init.tcl dealing with auto execution
     4      4   # of commands and can be auto loaded themselves.
     5      5   #
     6         -# RCS: @(#) $Id: auto.tcl,v 1.1.2.7 1999/02/11 03:15:40 stanton Exp $
            6  +# RCS: @(#) $Id: auto.tcl,v 1.1.2.8 1999/03/31 19:54:15 welch Exp $
     7      7   #
     8      8   # Copyright (c) 1991-1993 The Regents of the University of California.
     9      9   # Copyright (c) 1994-1998 Sun Microsystems, Inc.
    10     10   #
    11     11   # See the file "license.terms" for information on usage and redistribution
    12     12   # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
    13     13   #
    14     14   
    15     15   # auto_reset --
           16  +#
    16     17   # Destroy all cached information for auto-loading and auto-execution,
    17     18   # so that the information gets recomputed the next time it's needed.
    18     19   # Also delete any procedures that are listed in the auto-load index
    19     20   # except those defined in this file.
    20     21   #
    21     22   # Arguments: 
    22     23   # None.
................................................................................
    32     33   	}
    33     34       }
    34     35       catch {unset auto_execs}
    35     36       catch {unset auto_index}
    36     37       catch {unset auto_oldpath}
    37     38   }
    38     39   
    39         -
    40         -# tcl_findLibrary
           40  +# tcl_findLibrary --
           41  +#
    41     42   #	This is a utility for extensions that searches for a library directory
    42     43   #	using a canonical searching algorithm. A side effect is to source
    43     44   #	the initialization script and set a global library variable.
           45  +#
    44     46   # Arguments:
    45     47   # 	basename	Prefix of the directory name, (e.g., "tk")
    46     48   #	version		Version number of the package, (e.g., "8.0")
    47     49   #	patch		Patchlevel of the package, (e.g., "8.0.3")
    48     50   #	initScript	Initialization script to source (e.g., tk.tcl)
    49     51   #	enVarName	environment variable to honor (e.g., TK_LIBRARY)
    50     52   #	varName		Global variable to set when done (e.g., tk_library)
................................................................................
   264    266   	    $parser hide proc
   265    267   	    $parser hide namespace
   266    268   	    $parser hide eval
   267    269   	    $parser hide puts
   268    270   	    $parser invokehidden namespace delete ::
   269    271   	    $parser invokehidden proc unknown {args} {}
   270    272   
   271         -	    #
   272    273   	    # We'll need access to the "namespace" command within the
   273    274   	    # interp.  Put it back, but move it out of the way.
   274         -	    #
          275  +
   275    276   	    $parser expose namespace
   276    277   	    $parser invokehidden rename namespace _%@namespace
   277    278   	    $parser expose eval
   278    279   	    $parser invokehidden rename eval _%@eval
   279    280   
   280    281   	    # Install all the registered psuedo-command implementations
   281    282   
................................................................................
   288    289   	variable parser
   289    290   	interp delete $parser
   290    291   	unset parser
   291    292       }
   292    293   }
   293    294   
   294    295   # auto_mkindex_parser::mkindex --
          296  +#
   295    297   # Used by the "auto_mkindex" command to create a "tclIndex" file for
   296    298   # the given Tcl source file.  Executes the commands in the file, and
   297    299   # handles things like the "proc" command by adding an entry for the
   298    300   # index file.  Returns a string that represents the index file.
   299    301   #
   300    302   # Arguments: 
   301         -# file -		Name of Tcl source file to be indexed.
          303  +#	file	Name of Tcl source file to be indexed.
   302    304   
   303    305   proc auto_mkindex_parser::mkindex {file} {
   304    306       variable parser
   305    307       variable index
   306    308       variable scriptFile
   307    309       variable contextStack
   308    310       variable imports
................................................................................
   329    331       foreach name $imports {
   330    332           catch {$parser eval [list _%@namespace forget $name]}
   331    333       }
   332    334       return $index
   333    335   }
   334    336   
   335    337   # auto_mkindex_parser::hook command
          338  +#
   336    339   # Registers a Tcl command to evaluate when initializing the
   337    340   # slave interpreter used by the mkindex parser.
   338    341   # The command is evaluated in the master interpreter, and can
   339    342   # use the variable auto_mkindex_parser::parser to get to the slave
   340    343   
   341    344   proc auto_mkindex_parser::hook {cmd} {
   342    345       variable initCommands
   343    346   
   344    347       lappend initCommands $cmd
   345    348   }
   346    349   
   347    350   # auto_mkindex_parser::slavehook command
          351  +#
   348    352   # Registers a Tcl command to evaluate when initializing the
   349    353   # slave interpreter used by the mkindex parser.
   350    354   # The command is evaluated in the slave interpreter.
   351    355   
   352    356   proc auto_mkindex_parser::slavehook {cmd} {
   353    357       variable initCommands
   354    358   
   355         -    lappend initCommands [list \$parser eval $cmd]
          359  +    # The $parser variable is defined to be the name of the
          360  +    # slave interpreter when this command is used later.
          361  +
          362  +    lappend initCommands "\$parser eval [list $cmd]"
   356    363   }
   357    364   
   358    365   # auto_mkindex_parser::command --
          366  +#
   359    367   # Registers a new command with the "auto_mkindex_parser" interpreter
   360    368   # that parses Tcl files.  These commands are fake versions of things
   361    369   # like the "proc" command.  When you execute them, they simply write
   362    370   # out an entry to a "tclIndex" file for auto-loading.
   363    371   #
   364    372   # This procedure allows extensions to register their own commands
   365    373   # with the auto_mkindex facility.  For example, a package like
   366    374   # [incr Tcl] might register a "class" command so that class definitions
   367    375   # could be added to a "tclIndex" file for auto-loading.
   368    376   #
   369    377   # Arguments:
   370         -# name -		Name of command recognized in Tcl files.
   371         -# arglist -		Argument list for command.
   372         -# body -		Implementation of command to handle indexing.
          378  +#	name 	Name of command recognized in Tcl files.
          379  +#	arglist	Argument list for command.
          380  +#	body 	Implementation of command to handle indexing.
   373    381   
   374    382   proc auto_mkindex_parser::command {name arglist body} {
   375    383       hook [list auto_mkindex_parser::commandInit $name $arglist $body]
   376    384   }
   377    385   
   378    386   # auto_mkindex_parser::commandInit --
          387  +#
   379    388   # This does the actual work set up by auto_mkindex_parser::command
   380    389   # This is called when the interpreter used by the parser is created.
          390  +#
          391  +# Arguments:
          392  +#	name 	Name of command recognized in Tcl files.
          393  +#	arglist	Argument list for command.
          394  +#	body 	Implementation of command to handle indexing.
   381    395   
   382    396   proc auto_mkindex_parser::commandInit {name arglist body} {
   383    397       variable parser
   384    398   
   385    399       set ns [namespace qualifiers $name]
   386    400       set tail [namespace tail $name]
   387    401       if {$ns == ""} {
................................................................................
   389    403       } else {
   390    404           set fakeName "_%@fake_$name"
   391    405           regsub -all {::} $fakeName "_" fakeName
   392    406           set fakeName "[namespace current]::$fakeName"
   393    407       }
   394    408       proc $fakeName $arglist $body
   395    409   
   396         -    #
   397    410       # YUK!  Tcl won't let us alias fully qualified command names,
   398    411       # so we can't handle names like "::itcl::class".  Instead,
   399    412       # we have to build procs with the fully qualified names, and
   400    413       # have the procs point to the aliases.
   401         -    #
          414  +
   402    415       if {[regexp {::} $name]} {
   403    416           set exportCmd [list _%@namespace export [namespace tail $name]]
   404    417           $parser eval [list _%@namespace eval $ns $exportCmd]
          418  + 
          419  +	# The following proc definition does not work if you
          420  +	# want to tolerate space or something else diabolical
          421  +	# in the procedure name, (i.e., space in $alias)
          422  +	# The following does not work:
          423  +	#   "_%@eval {$alias} \$args"
          424  +	# because $alias gets concat'ed to $args.
          425  +	# The following does not work because $cmd is somehow undefined
          426  +	#   "set cmd {$alias} \; _%@eval {\$cmd} \$args"
          427  +	# A gold star to someone that can make test
          428  +	# autoMkindex-3.3 work properly
          429  +
   405    430           set alias [namespace tail $fakeName]
   406         -        $parser invokehidden proc $name {args} [list _%@eval $alias \$args]
          431  +        $parser invokehidden proc $name {args} "_%@eval {$alias} \$args"
   407    432           $parser alias $alias $fakeName
   408    433       } else {
   409    434           $parser alias $name $fakeName
   410    435       }
   411    436       return
   412    437   }
   413    438