Tcl Source Code

Check-in [0899c7c6c0]
Login

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: 0899c7c6c0b487d2909786c21a629ce5bf44c960
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
Unified Diff Ignore Whitespace Patch
Changes to library/init.tcl.
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.26 1999/02/11 03:04:46 stanton 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.





|







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
597

598
599
600

601
602
603
604
605
606
607
	}
    }
    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)







|
>



>







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
678
679
680
681
682
683
684
685
686
687
688
    append msg "    $dirs\n\n"
    append msg "$errors\n\n"
    append msg "This probably means that $basename wasn't installed properly.\n"
    error $msg
}


# 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_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







<
<
<
<







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
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
		$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







<


|




















>






|







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



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
	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




	lappend initCommands [list \$parser eval $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.






    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]












	    $parser invokehidden proc $name {args} [list _%@eval $alias \$args]
	    $parser alias $alias $fakeName
	} else {
	    $parser alias $name $fakeName
	}
	return
    }








>












>







>
>
>
|



>











|
|
|






>


>
>
>
>
>















<




|




>
>
>
>
>
>
>
>
>
>
>
>
|







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
    }