API tools faq
paste
Advertisement
gregwa

searcher Page GUI file

gregwa
Mar 3rd, 2012
841
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
TCL 16.06 KB | None | 0 0
raw download clone embed print report
  1. #!/bin/sh
  2. # the next line restarts using wish\
  3. exec wish "$0" "$@"
  4.  
  5. if {![info exists vTcl(sourcing)]} {
  6.  
  7.     # Provoke name search
  8.     catch {package require bogus-package-name}
  9.     set packageNames [package names]
  10.  
  11.     package require Tk
  12.     switch $tcl_platform(platform) {
  13.     windows {
  14.             option add *Button.padY 0
  15.     }
  16.     default {
  17.             option add *Scrollbar.width 10
  18.             option add *Scrollbar.highlightThickness 0
  19.             option add *Scrollbar.elementBorderWidth 2
  20.             option add *Scrollbar.borderWidth 2
  21.     }
  22.     }
  23.    
  24. }
  25.  
  26. #############################################################################
  27. # Visual Tcl v1.60 Project
  28. #
  29.  
  30.  
  31. #################################
  32. # VTCL LIBRARY PROCEDURES
  33. #
  34.  
  35. if {![info exists vTcl(sourcing)]} {
  36. #############################################################################
  37. ## Library Procedure:  Window
  38.  
  39. proc ::Window {args} {
  40.     ## This procedure may be used free of restrictions.
  41.     ##    Exception added by Christian Gavin on 08/08/02.
  42.     ## Other packages and widget toolkits have different licensing requirements.
  43.     ##    Please read their license agreements for details.
  44.  
  45.     global vTcl
  46.     foreach {cmd name newname} [lrange $args 0 2] {}
  47.     set rest    [lrange $args 3 end]
  48.     if {$name == "" || $cmd == ""} { return }
  49.     if {$newname == ""} { set newname $name }
  50.     if {$name == "."} { wm withdraw $name; return }
  51.     set exists [winfo exists $newname]
  52.     switch $cmd {
  53.         show {
  54.             if {$exists} {
  55.                 wm deiconify $newname
  56.             } elseif {[info procs vTclWindow$name] != ""} {
  57.                 eval "vTclWindow$name $newname $rest"
  58.             }
  59.             if {[winfo exists $newname] && [wm state $newname] == "normal"} {
  60.                 vTcl:FireEvent $newname <<Show>>
  61.             }
  62.         }
  63.         hide    {
  64.             if {$exists} {
  65.                 wm withdraw $newname
  66.                 vTcl:FireEvent $newname <<Hide>>
  67.                 return}
  68.         }
  69.         iconify { if $exists {wm iconify $newname; return} }
  70.         destroy { if $exists {destroy $newname; return} }
  71.     }
  72. }
  73. #############################################################################
  74. ## Library Procedure:  vTcl:DefineAlias
  75.  
  76. proc ::vTcl:DefineAlias {target alias widgetProc top_or_alias cmdalias} {
  77.     ## This procedure may be used free of restrictions.
  78.     ##    Exception added by Christian Gavin on 08/08/02.
  79.     ## Other packages and widget toolkits have different licensing requirements.
  80.     ##    Please read their license agreements for details.
  81.  
  82.     global widget
  83.     set widget($alias) $target
  84.     set widget(rev,$target) $alias
  85.     if {$cmdalias} {
  86.         interp alias {} $alias {} $widgetProc $target
  87.     }
  88.     if {$top_or_alias != ""} {
  89.         set widget($top_or_alias,$alias) $target
  90.         if {$cmdalias} {
  91.             interp alias {} $top_or_alias.$alias {} $widgetProc $target
  92.         }
  93.     }
  94. }
  95. #############################################################################
  96. ## Library Procedure:  vTcl:DoCmdOption
  97.  
  98. proc ::vTcl:DoCmdOption {target cmd} {
  99.     ## This procedure may be used free of restrictions.
  100.     ##    Exception added by Christian Gavin on 08/08/02.
  101.     ## Other packages and widget toolkits have different licensing requirements.
  102.     ##    Please read their license agreements for details.
  103.  
  104.     ## menus are considered toplevel windows
  105.     set parent $target
  106.     while {[winfo class $parent] == "Menu"} {
  107.         set parent [winfo parent $parent]
  108.     }
  109.  
  110.     regsub -all {\%widget} $cmd $target cmd
  111.     regsub -all {\%top} $cmd [winfo toplevel $parent] cmd
  112.  
  113.     uplevel #0 [list eval $cmd]
  114. }
  115. #############################################################################
  116. ## Library Procedure:  vTcl:FireEvent
  117.  
  118. proc ::vTcl:FireEvent {target event {params {}}} {
  119.     ## This procedure may be used free of restrictions.
  120.     ##    Exception added by Christian Gavin on 08/08/02.
  121.     ## Other packages and widget toolkits have different licensing requirements.
  122.     ##    Please read their license agreements for details.
  123.  
  124.     ## The window may have disappeared
  125.     if {![winfo exists $target]} return
  126.     ## Process each binding tag, looking for the event
  127.     foreach bindtag [bindtags $target] {
  128.         set tag_events [bind $bindtag]
  129.         set stop_processing 0
  130.         foreach tag_event $tag_events {
  131.             if {$tag_event == $event} {
  132.                 set bind_code [bind $bindtag $tag_event]
  133.                 foreach rep "\{%W $target\} $params" {
  134.                     regsub -all [lindex $rep 0] $bind_code [lindex $rep 1] bind_code
  135.                 }
  136.                 set result [catch {uplevel #0 $bind_code} errortext]
  137.                 if {$result == 3} {
  138.                     ## break exception, stop processing
  139.                     set stop_processing 1
  140.                 } elseif {$result != 0} {
  141.                     bgerror $errortext
  142.                 }
  143.                 break
  144.             }
  145.         }
  146.         if {$stop_processing} {break}
  147.     }
  148. }
  149. #############################################################################
  150. ## Library Procedure:  vTcl:Toplevel:WidgetProc
  151.  
  152. proc ::vTcl:Toplevel:WidgetProc {w args} {
  153.     ## This procedure may be used free of restrictions.
  154.     ##    Exception added by Christian Gavin on 08/08/02.
  155.     ## Other packages and widget toolkits have different licensing requirements.
  156.     ##    Please read their license agreements for details.
  157.  
  158.     if {[llength $args] == 0} {
  159.         ## If no arguments, returns the path the alias points to
  160.         return $w
  161.     }
  162.     set command [lindex $args 0]
  163.     set args [lrange $args 1 end]
  164.     switch -- [string tolower $command] {
  165.         "setvar" {
  166.             foreach {varname value} $args {}
  167.             if {$value == ""} {
  168.                 return [set ::${w}::${varname}]
  169.             } else {
  170.                 return [set ::${w}::${varname} $value]
  171.             }
  172.         }
  173.         "hide" - "show" {
  174.             Window [string tolower $command] $w
  175.         }
  176.         "showmodal" {
  177.             ## modal dialog ends when window is destroyed
  178.             Window show $w; raise $w
  179.             grab $w; tkwait window $w; grab release $w
  180.         }
  181.         "startmodal" {
  182.             ## ends when endmodal called
  183.             Window show $w; raise $w
  184.             set ::${w}::_modal 1
  185.             grab $w; tkwait variable ::${w}::_modal; grab release $w
  186.         }
  187.         "endmodal" {
  188.             ## ends modal dialog started with startmodal, argument is var name
  189.             set ::${w}::_modal 0
  190.             Window hide $w
  191.         }
  192.         default {
  193.             uplevel $w $command $args
  194.         }
  195.     }
  196. }
  197. #############################################################################
  198. ## Library Procedure:  vTcl:WidgetProc
  199.  
  200. proc ::vTcl:WidgetProc {w args} {
  201.     ## This procedure may be used free of restrictions.
  202.     ##    Exception added by Christian Gavin on 08/08/02.
  203.     ## Other packages and widget toolkits have different licensing requirements.
  204.     ##    Please read their license agreements for details.
  205.  
  206.     if {[llength $args] == 0} {
  207.         ## If no arguments, returns the path the alias points to
  208.         return $w
  209.     }
  210.  
  211.     set command [lindex $args 0]
  212.     set args [lrange $args 1 end]
  213.     uplevel $w $command $args
  214. }
  215. #############################################################################
  216. ## Library Procedure:  vTcl:toplevel
  217.  
  218. proc ::vTcl:toplevel {args} {
  219.     ## This procedure may be used free of restrictions.
  220.     ##    Exception added by Christian Gavin on 08/08/02.
  221.     ## Other packages and widget toolkits have different licensing requirements.
  222.     ##    Please read their license agreements for details.
  223.     uplevel #0 eval toplevel $args
  224.     set target [lindex $args 0]
  225.     namespace eval ::$target {set _modal 0}
  226. }
  227. }
  228.  
  229.  
  230. if {[info exists vTcl(sourcing)]} {
  231.  
  232. proc vTcl:project:info {} {
  233.     set base .top32
  234.     namespace eval ::widgets::$base {
  235.         set set,origin 1
  236.         set set,size 1
  237.         set runvisible 1
  238.     }
  239.     set site_3_0 $base.fra33
  240.     set site_3_0 $base.fra35
  241.     set site_3_0 $base.fra45
  242.     set site_4_0 $site_3_0.scr46
  243.  
  244.     #Updating ttreeview attributes
  245.     .top32.fra45.scr46.01 configure\
  246.         -columns  Col1\
  247.         -height  4\
  248.         -xscrollcommand  ".top32.fra45.scr46.02 set"\
  249.         -yscrollcommand  ".top32.fra45.scr46.03 set"\
  250.         -takefocus  ttk::takefocus
  251.  
  252.     #heading options.
  253.     .top32.fra45.scr46.01 heading Col1 \
  254.              -text Col1 \
  255.              -anchor center
  256.     #heading options.
  257.     .top32.fra45.scr46.01 heading #0 \
  258.              -text Tree \
  259.              -anchor center
  260. #    column options.
  261.     .top32.fra45.scr46.01 column Col1 \
  262.              -width 267 \
  263.              -minwidth 20 \
  264.              -stretch 1 \
  265.              -anchor w
  266. #    column options.
  267.     .top32.fra45.scr46.01 column #0 \
  268.              -width 266 \
  269.              -minwidth 20 \
  270.              -stretch 1 \
  271.              -anchor w
  272.     namespace eval ::widgets_bindings {
  273.         set tagslist _TopLevel
  274.     }
  275.     namespace eval ::vTcl::modules::main {
  276.         set procs {
  277.             py:btnExitClick()
  278.             py:btnGoClick()
  279.             py:btnSearchPathClick()
  280.         }
  281.         set compounds {
  282.         }
  283.         set projectType single
  284.     }
  285. }
  286. }
  287.  
  288. #################################
  289. # USER DEFINED PROCEDURES
  290. #
  291. #############################################################################
  292. ## Procedure:  py:btnExitClick()
  293.  
  294. proc ::py:btnExitClick() {p1} {
  295. def btnExitClick(p1) :
  296.     sys.exit()
  297. }
  298. #############################################################################
  299. ## Procedure:  py:btnGoClick()
  300.  
  301. proc ::py:btnGoClick() {p1} {
  302. def btnGoClick(p1) :
  303.     pass
  304. }
  305. #############################################################################
  306. ## Procedure:  py:btnSearchPathClick()
  307.  
  308. proc ::py:btnSearchPathClick() {p1} {
  309. def btnSearchPathClick(p1) :
  310.     pass
  311. }
  312.  
  313. #################################
  314. # VTCL GENERATED GUI PROCEDURES
  315. #
  316.  
  317. proc vTclWindow. {base} {
  318.     if {$base == ""} {
  319.         set base .
  320.     }
  321.     ###################
  322.     # CREATING WIDGETS
  323.     ###################
  324.     wm focusmodel $top passive
  325.     wm geometry $top 1x1+0+0; update
  326.     wm maxsize $top 1665 1020
  327.     wm minsize $top 1 1
  328.     wm overrideredirect $top 0
  329.     wm resizable $top 1 1
  330.     wm withdraw $top
  331.     wm title $top "page.tcl"
  332.     bindtags $top "$top Page.tcl all"
  333.     vTcl:FireEvent $top <<Create>>
  334.     wm protocol $top WM_DELETE_WINDOW "vTcl:FireEvent $top <<DeleteWindow>>"
  335.  
  336.     ###################
  337.     # SETTING GEOMETRY
  338.     ###################
  339.  
  340.     vTcl:FireEvent $base <<Ready>>
  341. }
  342.  
  343. proc vTclWindow.top32 {base} {
  344.     if {$base == ""} {
  345.         set base .top32
  346.     }
  347.     if {[winfo exists $base]} {
  348.         wm deiconify $base; return
  349.     }
  350.     set top $base
  351.     ###################
  352.     # CREATING WIDGETS
  353.     ###################
  354.     vTcl:toplevel $top -class Toplevel
  355.     wm focusmodel $top passive
  356.     wm geometry $top 600x525+511+216; update
  357.     wm maxsize $top 1665 1020
  358.     wm minsize $top 1 1
  359.     wm overrideredirect $top 0
  360.     wm resizable $top 1 1
  361.     wm deiconify $top
  362.     wm title $top "Searcher"
  363.     vTcl:DefineAlias "$top" "Searcher" vTcl:Toplevel:WidgetProc "" 1
  364.     bindtags $top "$top Toplevel all _TopLevel"
  365.     vTcl:FireEvent $top <<Create>>
  366.     wm protocol $top WM_DELETE_WINDOW "vTcl:FireEvent $top <<DeleteWindow>>"
  367.  
  368.     frame $top.fra33 \
  369.         -borderwidth 2 -relief groove -height 75 -highlightcolor black \
  370.         -width 125
  371.     vTcl:DefineAlias "$top.fra33" "Frame1" vTcl:WidgetProc "Searcher" 1
  372.     set site_3_0 $top.fra33
  373.     button $site_3_0.but34 \
  374.         -text Exit
  375.     vTcl:DefineAlias "$site_3_0.but34" "btnExit" vTcl:WidgetProc "Searcher" 1
  376.     bind $site_3_0.but34 <Button-1> {
  377.         btnExitClick
  378.     }
  379.     place $site_3_0.but34 \
  380.         -in $site_3_0 -x 510 -y 20 -anchor nw -bordermode ignore
  381.     frame $top.fra35 \
  382.         -borderwidth 2 -relief groove -height 75 -highlightcolor black \
  383.         -width 125
  384.     vTcl:DefineAlias "$top.fra35" "Frame2" vTcl:WidgetProc "Searcher" 1
  385.     set site_3_0 $top.fra35
  386.     label $site_3_0.lab36 \
  387.         -text Path:
  388.     vTcl:DefineAlias "$site_3_0.lab36" "Label1" vTcl:WidgetProc "Searcher" 1
  389.     entry $site_3_0.ent37 \
  390.         -background white -insertbackground black -textvariable FilePath
  391.     vTcl:DefineAlias "$site_3_0.ent37" "txtPath" vTcl:WidgetProc "Searcher" 1
  392.     button $site_3_0.but38 \
  393.         -text ...
  394.     vTcl:DefineAlias "$site_3_0.but38" "btnSearchPath" vTcl:WidgetProc "Searcher" 1
  395.     bind $site_3_0.but38 <Button-1> {
  396.         btnSearchPathClick
  397.     }
  398.     checkbutton $site_3_0.che39 \
  399.         -text .avi -variable VchkAVI
  400.     vTcl:DefineAlias "$site_3_0.che39" "chkAVI" vTcl:WidgetProc "Searcher" 1
  401.     checkbutton $site_3_0.che40 \
  402.         -text .mkv -variable VchkMKV
  403.     vTcl:DefineAlias "$site_3_0.che40" "chkMKV" vTcl:WidgetProc "Searcher" 1
  404.     checkbutton $site_3_0.che41 \
  405.         -text .mv4 -variable VchkMV4
  406.     vTcl:DefineAlias "$site_3_0.che41" "chkMV4" vTcl:WidgetProc "Searcher" 1
  407.     checkbutton $site_3_0.che42 \
  408.         -text .mp3 -variable VchkMP3
  409.     vTcl:DefineAlias "$site_3_0.che42" "chkMP3" vTcl:WidgetProc "Searcher" 1
  410.     checkbutton $site_3_0.che43 \
  411.         -text .ogg -variable VchkOGG
  412.     vTcl:DefineAlias "$site_3_0.che43" "chkOGG" vTcl:WidgetProc "Searcher" 1
  413.     button $site_3_0.but44 \
  414.         -text GO!
  415.     vTcl:DefineAlias "$site_3_0.but44" "btnGO" vTcl:WidgetProc "Searcher" 1
  416.     bind $site_3_0.but44 <Button-1> {
  417.         btnGoClick
  418.     }
  419.     place $site_3_0.lab36 \
  420.         -in $site_3_0 -x 10 -y 10 -anchor nw -bordermode ignore
  421.     place $site_3_0.ent37 \
  422.         -in $site_3_0 -x 10 -y 30 -width 226 -height 21 -anchor nw \
  423.         -bordermode ignore
  424.     place $site_3_0.but38 \
  425.         -in $site_3_0 -x 240 -y 30 -anchor nw -bordermode ignore
  426.     place $site_3_0.che39 \
  427.         -in $site_3_0 -x 50 -y 80 -anchor nw -bordermode ignore
  428.     place $site_3_0.che40 \
  429.         -in $site_3_0 -x 50 -y 100 -anchor nw -bordermode ignore
  430.     place $site_3_0.che41 \
  431.         -in $site_3_0 -x 50 -y 120 -anchor nw -bordermode ignore
  432.     place $site_3_0.che42 \
  433.         -in $site_3_0 -x 190 -y 100 -anchor nw -bordermode ignore
  434.     place $site_3_0.che43 \
  435.         -in $site_3_0 -x 190 -y 120 -anchor nw -bordermode ignore
  436.     place $site_3_0.but44 \
  437.         -in $site_3_0 -x 130 -y 150 -anchor nw -bordermode ignore
  438.     frame $top.fra45 \
  439.         -borderwidth 2 -relief groove -height 75 -highlightcolor black \
  440.         -width 125
  441.     vTcl:DefineAlias "$top.fra45" "Frame3" vTcl:WidgetProc "Searcher" 1
  442.     set site_3_0 $top.fra45
  443.     vTcl::widgets::ttk::scrolledtreeview::CreateCmd $site_3_0.scr46 \
  444.         -width 125 -height 75
  445.     vTcl:DefineAlias "$site_3_0.scr46" "Scrolledtreeview1" vTcl:WidgetProc "Searcher" 1
  446.     place $site_3_0.scr46 \
  447.         -in $site_3_0 -x 10 -y 10 -width 550 -height 254 -anchor nw \
  448.         -bordermode ignore
  449.     grid columnconf $site_3_0.scr46 0 -weight 1
  450.     grid rowconf $site_3_0.scr46 0 -weight 1
  451.     ###################
  452.     # SETTING GEOMETRY
  453.     ###################
  454.     place $top.fra33 \
  455.         -in $top -x 0 -y 0 -width 595 -height 55 -anchor nw \
  456.         -bordermode ignore
  457.     place $top.fra35 \
  458.         -in $top -x 0 -y 60 -width 325 -height 185 -anchor nw \
  459.         -bordermode ignore
  460.     place $top.fra45 \
  461.         -in $top -x 0 -y 250 -width 565 -height 265 -anchor nw \
  462.         -bordermode ignore
  463.  
  464.     vTcl:FireEvent $base <<Ready>>
  465. }
  466.  
  467. #############################################################################
  468. ## Binding tag:  _TopLevel
  469.  
  470. bind "_TopLevel" <<Create>> {
  471.     if {![info exists _topcount]} {set _topcount 0}; incr _topcount
  472. }
  473. bind "_TopLevel" <<DeleteWindow>> {
  474.     if {[set ::%W::_modal]} {
  475.                 vTcl:Toplevel:WidgetProc %W endmodal
  476.             } else {
  477.                 destroy %W; if {$_topcount == 0} {exit}
  478.             }
  479. }
  480. bind "_TopLevel" <Destroy> {
  481.     if {[winfo toplevel %W] == "%W"} {incr _topcount -1}
  482. }
  483.  
  484. Window show .
  485. Window show .top32
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!