@zzz0350/ozon-listing-workbench 0.5.0 → 1.0.0

package/versions/0.5.0/_internal/_tk_data/safetk.tcl

@@ -1,262 +0,0 @@
-# safetk.tcl --
-#
-# Support procs to use Tk in safe interpreters.
-#
-# Copyright (c) 1997 Sun Microsystems, Inc.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-
-# see safetk.n for documentation
-
-#
-#
-# Note: It is now ok to let untrusted code being executed
-#       between the creation of the interp and the actual loading
-#       of Tk in that interp because the C side Tk_Init will
-#       now look up the parent interp and ask its safe::TkInit
-#       for the actual parameters to use for it's initialization (if allowed),
-#       not relying on the child state.
-#
-
-# We use opt (optional arguments parsing)
-package require opt 0.4.1;
-
-namespace eval ::safe {
-
-    # counter for safe toplevels
-    variable tkSafeId 0
-}
-
-#
-# tkInterpInit : prepare the child interpreter for tk loading
-#                most of the real job is done by loadTk
-# returns the child name (tkInterpInit does)
-#
-proc ::safe::tkInterpInit {child argv} {
-    global env tk_library
-
-    # We have to make sure that the tk_library variable is normalized.
-    set tk_library [file normalize $tk_library]
-
-    # Clear Tk's access for that interp (path).
-    allowTk $child $argv
-
-    # Ensure tk_library and subdirs (eg, ttk) are on the access path
-    ::interp eval $child [list set tk_library [::safe::interpAddToAccessPath $child $tk_library]]
-    foreach subdir [::safe::AddSubDirs [list $tk_library]] {
-	::safe::interpAddToAccessPath $child $subdir
-    }
-    return $child
-}
-
-
-# tkInterpLoadTk:
-# Do additional configuration as needed (calling tkInterpInit)
-# and actually load Tk into the child.
-#
-# Either contained in the specified windowId (-use) or
-# creating a decorated toplevel for it.
-
-# empty definition for auto_mkIndex
-proc ::safe::loadTk {} {}
-
-::tcl::OptProc ::safe::loadTk {
-    {child -interp "name of the child interpreter"}
-    {-use  -windowId {} "window Id to use (new toplevel otherwise)"}
-    {-display -displayName {} "display name to use (current one otherwise)"}
-} {
-    set displayGiven [::tcl::OptProcArgGiven "-display"]
-    if {!$displayGiven} {
-	# Try to get the current display from "."
-	# (which might not exist if the parent is tk-less)
-	if {[catch {set display [winfo screen .]}]} {
-	    if {[info exists ::env(DISPLAY)]} {
-		set display $::env(DISPLAY)
-	    } else {
-		Log $child "no winfo screen . nor env(DISPLAY)" WARNING
-		set display ":0.0"
-	    }
-	}
-    }
-
-    # Get state for access to the cleanupHook.
-    namespace upvar ::safe S$child state
-
-    if {![::tcl::OptProcArgGiven "-use"]} {
-	# create a decorated toplevel
-	lassign [tkTopLevel $child $display] w use
-
-	# set our delete hook (child arg is added by interpDelete)
-	# to clean up both window related code and tkInit(child)
-	set state(cleanupHook) [list tkDelete {} $w]
-    } else {
-	# set our delete hook (child arg is added by interpDelete)
-	# to clean up tkInit(child)
-	set state(cleanupHook) [list disallowTk]
-
-	# Let's be nice and also accept tk window names instead of ids
-	if {[string match ".*" $use]} {
-	    set windowName $use
-	    set use [winfo id $windowName]
-	    set nDisplay [winfo screen $windowName]
-	} else {
-	    # Check for a better -display value
-	    # (works only for multi screens on single host, but not
-	    #  cross hosts, for that a tk window name would be better
-	    #  but embeding is also usefull for non tk names)
-	    if {![catch {winfo pathname $use} name]} {
-		set nDisplay [winfo screen $name]
-	    } else {
-		# Can't have a better one
-		set nDisplay $display
-	    }
-	}
-	if {$nDisplay ne $display} {
-	    if {$displayGiven} {
-		return -code error -errorcode {TK DISPLAY SAFE} \
-		    "conflicting -display $display and -use $use -> $nDisplay"
-	    } else {
-		set display $nDisplay
-	    }
-	}
-    }
-
-    # Prepares the child for tk with those parameters
-    tkInterpInit $child [list "-use" $use "-display" $display]
-
-    load {} Tk $child
-
-    return $child
-}
-
-proc ::safe::TkInit {interpPath} {
-    variable tkInit
-    if {[info exists tkInit($interpPath)]} {
-	set value $tkInit($interpPath)
-	Log $interpPath "TkInit called, returning \"$value\"" NOTICE
-	return $value
-    } else {
-	Log $interpPath "TkInit called for interp with clearance:\
-		preventing Tk init" ERROR
-	return -code error -errorcode {TK SAFE PERMISSION} "not allowed"
-    }
-}
-
-# safe::allowTk --
-#
-#	Set tkInit(interpPath) to allow Tk to be initialized in
-#	safe::TkInit.
-#
-# Arguments:
-#	interpPath	child interpreter handle
-#	argv		arguments passed to safe::TkInterpInit
-#
-# Results:
-#	none.
-
-proc ::safe::allowTk {interpPath argv} {
-    variable tkInit
-    set tkInit($interpPath) $argv
-    return
-}
-
-
-# safe::disallowTk --
-#
-#	Unset tkInit(interpPath) to disallow Tk from getting initialized
-#	in safe::TkInit.
-#
-# Arguments:
-#	interpPath	child interpreter handle
-#
-# Results:
-#	none.
-
-proc ::safe::disallowTk {interpPath} {
-    variable tkInit
-    # This can already be deleted by the DeleteHook of the interp
-    if {[info exists tkInit($interpPath)]} {
-	unset tkInit($interpPath)
-    }
-    return
-}
-
-
-# safe::tkDelete --
-#
-#	Clean up the window associated with the interp being deleted.
-#
-# Arguments:
-#	interpPath	child interpreter handle
-#
-# Results:
-#	none.
-
-proc ::safe::tkDelete {W window child} {
-
-    # we are going to be called for each widget... skip untill it's
-    # top level
-
-    Log $child "Called tkDelete $W $window" NOTICE
-    if {[::interp exists $child]} {
-	if {[catch {::safe::interpDelete $child} msg]} {
-	    Log $child "Deletion error : $msg"
-	}
-    }
-    if {[winfo exists $window]} {
-	Log $child "Destroy toplevel $window" NOTICE
-	destroy $window
-    }
-
-    # clean up tkInit(child)
-    disallowTk $child
-    return
-}
-
-proc ::safe::tkTopLevel {child display} {
-    variable tkSafeId
-    incr tkSafeId
-    set w ".safe$tkSafeId"
-    if {[catch {toplevel $w -screen $display -class SafeTk} msg]} {
-	return -code error -errorcode {TK TOPLEVEL SAFE} \
-	    "Unable to create toplevel for \"$child\" ($msg)"
-    }
-    Log $child "New toplevel $w" NOTICE
-
-    set msg "Untrusted Tcl applet ($child)"
-    wm title $w $msg
-
-    # Control frame (we must create a style for it)
-    ttk::style layout TWarningFrame {WarningFrame.border -sticky nswe}
-    ttk::style configure TWarningFrame -background red
-
-    set wc $w.fc
-    ttk::frame $wc -relief ridge -borderwidth 4 -style TWarningFrame
-
-    # We will destroy the interp when the window is destroyed
-    bindtags $wc [concat Safe$wc [bindtags $wc]]
-    bind Safe$wc <Destroy> [list ::safe::tkDelete %W $w $child]
-
-    ttk::label $wc.l -text $msg -anchor w
-
-    # We want the button to be the last visible item
-    # (so be packed first) and at the right and not resizing horizontally
-
-    # frame the button so it does not expand horizontally
-    # but still have the default background instead of red one from the parent
-    ttk::frame  $wc.fb -borderwidth 0
-    ttk::button $wc.fb.b -text "Delete" \
-	    -command [list ::safe::tkDelete $w $w $child]
-    pack $wc.fb.b -side right -fill both
-    pack $wc.fb -side right -fill both -expand 1
-    pack $wc.l -side left -fill both -expand 1 -ipady 2
-    pack $wc -side bottom -fill x
-
-    # Container frame
-    frame $w.c -container 1
-    pack $w.c -fill both -expand 1
-
-    # return both the toplevel window name and the id to use for embedding
-    list $w [winfo id $w.c]
-}

package/versions/0.5.0/_internal/_tk_data/scale.tcl

@@ -1,307 +0,0 @@
-# scale.tcl --
-#
-# This file defines the default bindings for Tk scale widgets and provides
-# procedures that help in implementing the bindings.
-#
-# Copyright (c) 1994 The Regents of the University of California.
-# Copyright (c) 1994-1995 Sun Microsystems, Inc.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-
-#-------------------------------------------------------------------------
-# The code below creates the default class bindings for entries.
-#-------------------------------------------------------------------------
-
-# Standard Motif bindings:
-
-bind Scale <Enter> {
-    if {$tk_strictMotif} {
-	set tk::Priv(activeBg) [%W cget -activebackground]
-	%W configure -activebackground [%W cget -background]
-    }
-    tk::ScaleActivate %W %x %y
-}
-bind Scale <Motion> {
-    tk::ScaleActivate %W %x %y
-}
-bind Scale <Leave> {
-    if {$tk_strictMotif} {
-	%W configure -activebackground $tk::Priv(activeBg)
-    }
-    if {[%W cget -state] eq "active"} {
-	%W configure -state normal
-    }
-}
-bind Scale <1> {
-    tk::ScaleButtonDown %W %x %y
-}
-bind Scale <B1-Motion> {
-    tk::ScaleDrag %W %x %y
-}
-bind Scale <B1-Leave> { }
-bind Scale <B1-Enter> { }
-bind Scale <ButtonRelease-1> {
-    tk::CancelRepeat
-    tk::ScaleEndDrag %W
-    tk::ScaleActivate %W %x %y
-}
-bind Scale <2> {
-    tk::ScaleButton2Down %W %x %y
-}
-bind Scale <B2-Motion> {
-    tk::ScaleDrag %W %x %y
-}
-bind Scale <B2-Leave> { }
-bind Scale <B2-Enter> { }
-bind Scale <ButtonRelease-2> {
-    tk::CancelRepeat
-    tk::ScaleEndDrag %W
-    tk::ScaleActivate %W %x %y
-}
-if {[tk windowingsystem] eq "win32"} {
-    # On Windows do the same with button 3, as that is the right mouse button
-    bind Scale <3>		[bind Scale <2>]
-    bind Scale <B3-Motion>	[bind Scale <B2-Motion>]
-    bind Scale <B3-Leave>	[bind Scale <B2-Leave>]
-    bind Scale <B3-Enter>	[bind Scale <B2-Enter>]
-    bind Scale <ButtonRelease-3> [bind Scale <ButtonRelease-2>]
-}
-bind Scale <Control-1> {
-    tk::ScaleControlPress %W %x %y
-}
-bind Scale <<PrevLine>> {
-    tk::ScaleIncrement %W up little noRepeat
-}
-bind Scale <<NextLine>> {
-    tk::ScaleIncrement %W down little noRepeat
-}
-bind Scale <<PrevChar>> {
-    tk::ScaleIncrement %W up little noRepeat
-}
-bind Scale <<NextChar>> {
-    tk::ScaleIncrement %W down little noRepeat
-}
-bind Scale <<PrevPara>> {
-    tk::ScaleIncrement %W up big noRepeat
-}
-bind Scale <<NextPara>> {
-    tk::ScaleIncrement %W down big noRepeat
-}
-bind Scale <<PrevWord>> {
-    tk::ScaleIncrement %W up big noRepeat
-}
-bind Scale <<NextWord>> {
-    tk::ScaleIncrement %W down big noRepeat
-}
-bind Scale <<LineStart>> {
-    %W set [%W cget -from]
-}
-bind Scale <<LineEnd>> {
-    %W set [%W cget -to]
-}
-
-# ::tk::ScaleActivate --
-# This procedure is invoked to check a given x-y position in the
-# scale and activate the slider if the x-y position falls within
-# the slider.
-#
-# Arguments:
-# w -		The scale widget.
-# x, y -	Mouse coordinates.
-
-proc ::tk::ScaleActivate {w x y} {
-    if {[$w cget -state] eq "disabled"} {
-	return
-    }
-    if {[$w identify $x $y] eq "slider"} {
-	set state active
-    } else {
-	set state normal
-    }
-    if {[$w cget -state] ne $state} {
-	$w configure -state $state
-    }
-}
-
-# ::tk::ScaleButtonDown --
-# This procedure is invoked when a button is pressed in a scale.  It
-# takes different actions depending on where the button was pressed.
-#
-# Arguments:
-# w -		The scale widget.
-# x, y -	Mouse coordinates of button press.
-
-proc ::tk::ScaleButtonDown {w x y} {
-    variable ::tk::Priv
-    set Priv(dragging) 0
-    set el [$w identify $x $y]
-
-    # save the relief
-    set Priv($w,relief) [$w cget -sliderrelief]
-
-    if {$el eq "trough1"} {
-	ScaleIncrement $w up little initial
-    } elseif {$el eq "trough2"} {
-	ScaleIncrement $w down little initial
-    } elseif {$el eq "slider"} {
-	set Priv(dragging) 1
-	set Priv(initValue) [$w get]
-	set coords [$w coords]
-	set Priv(deltaX) [expr {$x - [lindex $coords 0]}]
-	set Priv(deltaY) [expr {$y - [lindex $coords 1]}]
-        switch -exact -- $Priv($w,relief) {
-            "raised" { $w configure -sliderrelief sunken }
-            "ridge"  { $w configure -sliderrelief groove }
-        }
-    }
-}
-
-# ::tk::ScaleDrag --
-# This procedure is called when the mouse is dragged with
-# mouse button 1 down.  If the drag started inside the slider
-# (i.e. the scale is active) then the scale's value is adjusted
-# to reflect the mouse's position.
-#
-# Arguments:
-# w -		The scale widget.
-# x, y -	Mouse coordinates.
-
-proc ::tk::ScaleDrag {w x y} {
-    variable ::tk::Priv
-    if {!$Priv(dragging)} {
-	return
-    }
-    $w set [$w get [expr {$x-$Priv(deltaX)}] [expr {$y-$Priv(deltaY)}]]
-}
-
-# ::tk::ScaleEndDrag --
-# This procedure is called to end an interactive drag of the
-# slider.  It just marks the drag as over.
-#
-# Arguments:
-# w -		The scale widget.
-
-proc ::tk::ScaleEndDrag {w} {
-    variable ::tk::Priv
-    set Priv(dragging) 0
-    if {[info exists Priv($w,relief)]} {
-        $w configure -sliderrelief $Priv($w,relief)
-        unset Priv($w,relief)
-    }
-}
-
-# ::tk::ScaleIncrement --
-# This procedure is invoked to increment the value of a scale and
-# to set up auto-repeating of the action if that is desired.  The
-# way the value is incremented depends on the "dir" and "big"
-# arguments.
-#
-# Arguments:
-# w -		The scale widget.
-# dir -		"up" means move value towards -from, "down" means
-#		move towards -to.
-# big -		Size of increments: "big" or "little".
-# repeat -	Whether and how to auto-repeat the action:  "noRepeat"
-#		means don't auto-repeat, "initial" means this is the
-#		first action in an auto-repeat sequence, and "again"
-#		means this is the second repetition or later.
-
-proc ::tk::ScaleIncrement {w dir big repeat} {
-    variable ::tk::Priv
-
-    if {![winfo exists $w]} return
-
-    # give the cancel callback a chance to be serviced if the execution time of
-    # the -command script lasts longer than -repeatdelay
-    set clockms [clock milliseconds]
-    if {$repeat eq "again" &&
-            [expr {$clockms - $Priv(clockms)}] > [expr {[$w cget -repeatinterval] * 1.1}]} {
-        set Priv(clockms) $clockms
-	set Priv(afterId) [after [$w cget -repeatinterval] \
-		[list tk::ScaleIncrement $w $dir $big again]]
-	return
-    }
-
-    if {$big eq "big"} {
-	set inc [$w cget -bigincrement]
-	if {$inc == 0} {
-	    set inc [expr {abs([$w cget -to] - [$w cget -from])/10.0}]
-	}
-	if {$inc < [$w cget -resolution]} {
-	    set inc [$w cget -resolution]
-	}
-    } else {
-	set inc [$w cget -resolution]
-    }
-    if {([$w cget -from] > [$w cget -to]) ^ ($dir eq "up")} {
-        if {$inc > 0} {
-            set inc [expr {-$inc}]
-        }
-    } else {
-        if {$inc < 0} {
-            set inc [expr {-$inc}]
-        }
-    }
-    # this will run the -command script (if any) during the redrawing
-    # of the scale at idle time
-    $w set [expr {[$w get] + $inc}]
-
-    if {$repeat eq "again"} {
-        set Priv(clockms) $clockms
-	set Priv(afterId) [after [$w cget -repeatinterval] \
-		[list tk::ScaleIncrement $w $dir $big again]]
-    } elseif {$repeat eq "initial"} {
-	set delay [$w cget -repeatdelay]
-	if {$delay > 0} {
-	    set Priv(clockms) $clockms
-	    set Priv(afterId) [after $delay \
-		    [list tk::ScaleIncrement $w $dir $big again]]
-	}
-    }
-}
-
-# ::tk::ScaleControlPress --
-# This procedure handles button presses that are made with the Control
-# key down.  Depending on the mouse position, it adjusts the scale
-# value to one end of the range or the other.
-#
-# Arguments:
-# w -		The scale widget.
-# x, y -	Mouse coordinates where the button was pressed.
-
-proc ::tk::ScaleControlPress {w x y} {
-    set el [$w identify $x $y]
-    if {$el eq "trough1"} {
-	$w set [$w cget -from]
-    } elseif {$el eq "trough2"} {
-	$w set [$w cget -to]
-    }
-}
-
-# ::tk::ScaleButton2Down
-# This procedure is invoked when button 2 is pressed over a scale.
-# It sets the value to correspond to the mouse position and starts
-# a slider drag.
-#
-# Arguments:
-# w -		The scrollbar widget.
-# x, y -	Mouse coordinates within the widget.
-
-proc ::tk::ScaleButton2Down {w x y} {
-    variable ::tk::Priv
-
-    if {[$w cget -state] eq "disabled"} {
-	return
-    }
-
-    $w configure -state active
-    $w set [$w get $x $y]
-    set Priv(dragging) 1
-    set Priv(initValue) [$w get]
-    set Priv($w,relief) [$w cget -sliderrelief]
-    set coords "$x $y"
-    set Priv(deltaX) 0
-    set Priv(deltaY) 0
-}