开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Windows编程 > 通讯编程 > 查看源码
menu_file.tcl
资源名称：ns-allinone-2.33.tar.gz　[点击查看]
上传用户：rrhhcc
上传日期：2015-12-11
资源大小：54129k
文件大小：9k
源码类别：

通讯编程

开发平台：

Visual C++

menu_file.tcl：源码内容
  1. #
  2. # Copyright (C) 1998 by USC/ISI
  3. # All rights reserved.                                            
  4. #                                                                
  5. # Redistribution and use in source and binary forms are permitted
  6. # provided that the above copyright notice and this paragraph are
  7. # duplicated in all such forms and that any documentation, advertising
  8. # materials, and other materials related to such distribution and use
  9. # acknowledge that the software was developed by the University of
  10. # Southern California, Information Sciences Institute.  The name of the
  11. # University may not be used to endorse or promote products derived from
  12. # this software without specific prior written permission.
  13. # 
  14. # THIS SOFTWARE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
  15. # WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
  16. # MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
  17. # 
  18. # $Header: /cvsroot/nsnam/nam-1/tcl/menu_file.tcl,v 1.5 2000/02/16 01:01:11 haoboy Exp $
  20. #
  21. # Helper functions
  22. #
  23. proc filesel {w dlg args} {
  24.     frame $w -borderwidth 0
  25.     set next ""
  26.     set ctr 0
  27.     foreach arg $args {
  28. if {[string range $arg 0 0]=="-"} {
  29.     switch [string range $arg 1 end] {
  30. "variable" {
  31.     set next variable
  32. }
  33. "command" {
  34.     set next command
  35. }
  36. "label" {
  37.     set next label
  38. }
  39.     }
  40. } else {
  41.     if {$next!=""} {
  42. set vars($next) $arg
  43.     }
  44. }
  45.     }
  46.     global $vars(variable)
  47.     set $vars(variable) [pwd]
  48.     frame $w.f0 -relief sunken -borderwidth 2
  49.     listbox $w.f0.lb -width 50 -height 10 
  50.         -yscroll "$w.f0.sb set" 
  51.         -selectforeground [resource activeForeground] 
  52.         -selectbackground [resource activeBackground] 
  53.         -highlightthickness 0
  54.     scrollbar $w.f0.sb -command "$w.f0.lb yview" 
  55.         -highlightthickness 0
  56.     pack $w.f0.lb -side left
  57.     pack $w.f0.sb -side left -fill y
  58.     pack $w.f0 -side top
  60.     # We should allow flexible labeling 
  61.     label $w.l2 -text $vars(label)
  62.     pack $w.l2 -side top -anchor w
  64.     entry $w.entry -width 50 -relief sunken
  65.     bind $w.entry <Return> 
  66. "checkfile [set $vars(variable)] "w" $w $dlg "$vars(command)""
  67.     $w.entry insert 0 [pwd]
  68.     bind $w.entry <Delete> 
  69. "[bind Entry <BackSpace>];
  70. set $vars(variable) [$w.entry get];break"
  71.     bind $w.entry <BackSpace> 
  72. "[bind Entry <BackSpace>];
  73. set $vars(variable) [$w.entry get];break"
  74.     bind $w.entry <Key> 
  75. "[bind Entry <Key>];
  76. set $vars(variable) [$w.entry get];break"
  77.     bind $w.f0.lb <1> "%W selection set [%W nearest %y];
  78. $w.entry delete 0 end;
  79. set $vars(variable) [pwd]/[%W get [%W nearest %y]]; 
  80. $w.entry insert 0 [pwd]/[%W get [%W nearest %y]]"
  81.     bind $w.f0.lb <Double-Button-1> 
  82. "checkfile [set $vars(variable)] "w" $w $dlg "$vars(command)""
  83.     pack $w.entry -side top -anchor w -fill x -expand true
  84.     
  85.     checkfile [pwd] "r" $w $dlg ""
  86.     return $w
  87. }
  89. proc checkfile {file op w dlg cmd} {
  90.     if {[file isdirectory $file]} {
  91. $w.entry delete 0 end
  92. cd $file
  93. $w.entry insert 0 [pwd]
  94. $w.f0.lb delete 0 end
  95. # insert the parent dir, because glob won't generate it
  96. $w.f0.lb insert end ..
  97. foreach i [glob *] {
  98. $w.f0.lb insert end $i
  99. }
  100.     } elseif {[file isfile $file]} {
  101.     if {$op == "r"} {
  102.     set flag [file readable $file]
  103.     } else {
  104.     set flag [file writable $file]
  105.     }
  106.     if $flag {
  107.     eval $cmd
  108.     destroy $dlg
  109.     } else {
  110.     errorpopup "Error" "File $file is not writable"
  111.     }
  112.     } else {
  113.     # Is it a wild card filter?
  114.     set dirname [file dirname $file]
  115.     set fname [file tail $file]
  116.     if {$dirname != ""} {
  117.     if [catch "cd $dirname"] {
  118.     # bail out
  119.     eval $cmd
  120.     destroy $dlg
  121.     }
  122.     }
  123.     set flist [glob -nocomplain $fname]
  124.     $w.entry delete 0 end
  125.     $w.entry insert 0 [pwd]
  126.     $w.f0.lb delete 0 end
  127.     if [llength $flist] {
  128.     $w.f0.lb insert end ..
  129.     foreach i $flist {
  130.     $w.f0.lb insert end $i
  131.     }
  132.     } else {
  133.     # not expandable, try write it
  134.     if {$op == "w"} {
  135.     eval $cmd
  136.     destroy $dlg
  137.     } else {
  138.     errorpopup "Error" "File $file is not writable"
  139.     }
  140.     }
  141.     }
  142. }
  145. Animator instproc save_layout {} {
  146.     $self instvar netModel tlw_
  147.     $self tkvar savefile
  149.     toplevel $tlw_.save
  150.     set w $tlw_.save
  152.     wm title $w "Save layout"
  153.     frame $w.f -borderwidth 1 -relief raised
  154.     pack $w.f -side top -fill both -expand true
  155.     filesel $w.f.sel $w -variable [$self tkvarname savefile] 
  156.     -command "$netModel savelayout [set [$self tkvarname savefile]]" 
  157.     -label "File to save to:"
  158.     pack $w.f.sel -side top -fill both -expand true
  159.     frame $w.f.btns -borderwidth 0
  160.     pack $w.f.btns -side top -fill x
  161.     button $w.f.btns.save -text Save 
  162.     -command "$self do_save_layout $w.f.sel $w"
  163.     pack $w.f.btns.save -side left -fill x -expand true
  164.     button $w.f.btns.cancel -text Cancel -command "destroy $w"
  165.     pack $w.f.btns.cancel -side left -fill x -expand true
  166.     set savefile [pwd]
  167. }
  169. Animator instproc do_save_layout {w dlg} {
  170. $self instvar netModel
  171. $self tkvar savefile
  172. set t $savefile
  173. puts "save to file $t"
  174. checkfile $t "w" $w $dlg "$netModel savelayout $t"
  175. }
  177. Animator instproc disablefile {w} {
  178.     $w.entry configure -state disabled 
  179.     -foreground [option get . disabledForeground Nam]
  180.     $w.l2 configure -foreground [option get . disabledForeground Nam]
  181.     $w.f0.lb configure -foreground [option get . disabledForeground Nam]
  182. }
  184. Animator instproc normalfile {w filevar} {
  185.     $self tkvar $filevar
  186.     $w.entry configure -state normal 
  187.     -foreground [option get . foreground Nam]
  188.     set $filevar [$w.entry get]
  189.     $w.l2 configure -foreground [option get . foreground Nam]
  190.     $w.f0.lb configure -foreground [option get . foreground Nam]
  191. }
  193. Animator instproc print_view { viewobject windowname } {
  194.     $self tkvar printfile printto 
  195.     $self instvar tlw_
  197.     set p print
  198.  
  199.     if {[winfo exists $tlw_.$windowname-$p]} {
  200.         puts "Quit due to duplicate print view window!"
  201.     }
  203. #    toplevel .print
  204. #    set w .print
  205. #    wm title $w "Print nam animation"
  207.     toplevel $tlw_.$windowname-$p
  208.     set w $tlw_.$windowname-$p
  209.     wm title $w "Print $windowname"    
  211.     frame $w.f -borderwidth 1 -relief raised
  212.     pack $w.f -side top -fill both -expand true
  213.     frame $w.f.f0 
  214.     pack $w.f.f0 -side top -fill x
  215.     label $w.f.f0.l -text "Print to:"
  216.     pack $w.f.f0.l -side left
  218.     $self tkvar printto
  219.     radiobutton $w.f.f0.r1 -text "Printer" -variable [$self tkvarname printto] 
  220.     -value printer -command "$self disablefile $w.f.sel;
  221.     $w.f.f1.e configure -state normal -foreground 
  222.     [option get . foreground Nam];
  223.     $w.f.f1.l configure -foreground [option get . foreground Nam];
  224.     set [$self tkvarname printfile] [$w.f.f1.e get]"
  225.     pack $w.f.f0.r1 -side left 
  226.     radiobutton $w.f.f0.r2 -text "File" -variable [$self tkvarname printto] 
  227.     -value file -command "$self normalfile $w.f.sel printfile;
  228.     $w.f.f1.e configure -state disabled -foreground 
  229.     [option get . disabledForeground Nam];
  230.     $w.f.f1.l configure -foreground 
  231.     [option get . disabledForeground Nam]"
  232.     pack $w.f.f0.r2 -side left 
  233.     frame $w.f.f1 
  234.     pack $w.f.f1 -side top -fill x
  235.     label $w.f.f1.l -text "Print command:"
  236.     pack $w.f.f1.l -side left
  237.     entry $w.f.f1.e 
  238.     pack $w.f.f1.e -side left -fill x -expand true
  239.     bind $w.f.f1.e <Key> "[bind Entry <Key>];
  240.     set [$self tkvarname printfile] [$w.f.f1.e get];break"
  241.     bind $w.f.f1.e <Return> 
  242.     "$self print_animation $viewobject $w"
  243.     set printer ""
  244.     global env
  245.     catch {set printer $env(PRINTER)}
  246.     if {$printer!=""} {
  247. $w.f.f1.e insert 0 "lpr -P$printer "
  248.     } else {
  249. $w.f.f1.e insert 0 "lpr "
  250.     }
  251.     filesel $w.f.sel $w -variable [$self tkvarname printfile] 
  252.     -command "$viewobject psview [set [$self tkvarname printfile]]" 
  253.     -label "File to save to:"
  254.     pack $w.f.sel -side top -fill both -expand true
  255.     frame $w.f.btns -borderwidth 0
  256.     pack $w.f.btns -side top -fill x
  257.     button $w.f.btns.print -text Print 
  258.     -command "$self print_animation $viewobject $w"
  259.     pack $w.f.btns.print -side left -fill x -expand true
  260.     button $w.f.btns.cancel -text Cancel -command "destroy $w"
  261.     pack $w.f.btns.cancel -side left -fill x -expand true
  263.     set printto printer
  264.     set printfile [$w.f.f1.e get]
  265.     $self disablefile $w.f.sel
  266. }
  268. Animator instproc print_animation {viewobject w} {
  269. $self tkvar printto printfile
  271. if {$printto=="file"} {
  272. checkfile $printfile "w" $w.f.sel $w 
  273. "$viewobject psview $printfile"
  274. } else {
  275. $viewobject psview /tmp/nam.ps
  276. puts [eval "exec $printfile /tmp/nam.ps"]
  277. catch {destroy $w}
  278. }
  279. }
  281. Animator instproc show_subtrees {} {
  282.     $self instvar netModel
  283.     $netModel showtrees
  284. }