home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / tcl / xf2.3-p / xf2 / xf2.3 / demos / XFSymName.tcl < prev   
Encoding:
Text File  |  1993-11-20  |  10.5 KB  |  428 lines
  1. #!/home/stone/garfield/bin/X386/epwish -f
  2. # Program: XFSymName
  3. #
  4.  
  5. # module inclusion
  6. global env
  7. global xfLoadPath
  8. if {[info exists env(XF_LOAD_PATH)]} {
  9.   if {[string first $env(XF_LOAD_PATH) /usr/local/lib/] == -1} {
  10.     set xfLoadPath $env(XF_LOAD_PATH):/usr/local/lib/
  11.   } {
  12.     set xfLoadPath /usr/local/lib/
  13.   }
  14. } {
  15.   set xfLoadPath /usr/local/lib/
  16. }
  17.  
  18.  
  19.  
  20. # procedure to show window .
  21. proc ShowWindow. {args} {# xf ignore me 7
  22.  
  23.   # Window manager configurations
  24.   global tkVersion
  25.   wm positionfrom . user
  26.   wm sizefrom . program
  27.   wm maxsize . 1152 900
  28.   wm title . {Symbolic Names}
  29.  
  30.  
  31.   # build widget .button0
  32.   button .button0 \
  33.     -padx {2} \
  34.     -text {aaa bbb}
  35.  
  36.   # build widget .button1
  37.   button .button1 \
  38.     -command {
  39. puts stdout "SymName is: root            realName is: [SymbolicName {root}]"
  40. puts stdout "SymName is: aaa bbb         realName is: [SymbolicName {aaa bbb}]"
  41. puts stdout "SymName is: oooo            realName is: [SymbolicName {oooo}]"
  42. puts stdout "SymName is: ooo pppp iiii   realName is: [SymbolicName {ooo pppp iiii}]"
  43. } \
  44.     -padx {2} \
  45.     -text {Symnames are...}
  46.  
  47.   # build widget .checkbutton2
  48.   checkbutton .checkbutton2 \
  49.     -command {
  50. } \
  51.     -padx {2} \
  52.     -text {ooo pppp iiii} \
  53.     -variable {checkbutton2}
  54.  
  55.   # build widget .label1
  56.   label .label1 \
  57.     -relief {raised} \
  58.     -text {oooo}
  59.  
  60.   # pack widget .
  61.   pack append . \
  62.     .button0 {top frame center} \
  63.     .label1 {top frame center} \
  64.     .checkbutton2 {top frame center} \
  65.     .button1 {top frame center} 
  66.  
  67.   if {"[info procs XFEdit]" != ""} {
  68.     XFEditSetShowWindows
  69.     XFMiscBindWidgetTree .xfEdit
  70.   }
  71. }
  72.  
  73.  
  74. # User defined procedures
  75.  
  76.  
  77. # Procedure: EntryBS
  78. proc EntryBS { xfW} {
  79.  
  80.   set xfX [expr {[$xfW index cursor]-1}]
  81.   if {$xfX != -1} {
  82.     $xfW delete $xfX
  83.   }
  84.   EntryV2C $xfW
  85. }
  86.  
  87.  
  88. # Procedure: EntryV2C
  89. proc EntryV2C { xfW} {
  90.  
  91.   set xfLeftExtent [$xfW index @0]
  92.   set xfRightExtent [$xfW index @[winfo width $xfW]]
  93.   set xfCursorPos [$xfW index cursor]
  94.   set xfEntryLen [expr "$xfRightExtent-$xfLeftExtent"]
  95.  
  96.   if {$xfCursorPos > $xfLeftExtent} {
  97.     if {$xfCursorPos > $xfRightExtent} {
  98.       #handle cursor too far to the right
  99.       $xfW view [expr "$xfCursorPos-$xfEntryLen+1"]
  100.     }
  101.   } { 
  102.     #handle cursor too far to the left
  103.     $xfW view [expr "$xfCursorPos-1"]
  104.   }
  105. }
  106.  
  107.  
  108. # Internal procedures
  109.  
  110.  
  111. # Procedure: Alias
  112. proc Alias { args} {
  113. # xf ignore me 7
  114. ##########
  115. # Procedure: Alias
  116. # Description: establish an alias for a procedure
  117. # Arguments: args - no argument means that a list of all aliases
  118. #                   is returned. Otherwise the first parameter is
  119. #                   the alias name, and the second parameter is
  120. #                   the procedure that is aliased.
  121. # Returns: nothing, the command that is bound to the alias or a
  122. #          list of all aliases - command pairs. 
  123. # Sideeffects: internalAliasList is updated, and the alias
  124. #              proc is inserted
  125. ##########
  126.   global internalAliasList
  127.  
  128.   if {[llength $args] == 0} {
  129.     return $internalAliasList
  130.   } {
  131.     if {[llength $args] == 1} {
  132.       set xfTmpIndex [lsearch $internalAliasList "[lindex $args 0] *"]
  133.       if {$xfTmpIndex != -1} {
  134.         return [lindex [lindex $internalAliasList $xfTmpIndex] 1]
  135.       }
  136.     } {
  137.       if {[llength $args] == 2} {
  138.         eval "proc [lindex $args 0] {args} {#xf ignore me 2
  139. return \[eval \"[lindex $args 1] \$args\"\]}"
  140.         set xfTmpIndex [lsearch $internalAliasList "[lindex $args 0] *"]
  141.         if {$xfTmpIndex != -1} {
  142.           set internalAliasList [lreplace $internalAliasList $xfTmpIndex $xfTmpIndex "[lindex $args 0] [lindex $args 1]"]
  143.         } {
  144.           lappend internalAliasList "[lindex $args 0] [lindex $args 1]"
  145.         }
  146.       } {
  147.         error "Alias: wrong number or args: $args"
  148.       }
  149.     }
  150.   }
  151. }
  152.  
  153.  
  154. # Procedure: GetSelection
  155. if {"[info procs GetSelection]" == ""} {
  156. proc GetSelection {} {
  157. # xf ignore me 7
  158. ##########
  159. # Procedure: GetSelection
  160. # Description: get current selection
  161. # Arguments: none
  162. # Returns: none
  163. # Sideeffects: none
  164. ##########
  165.  
  166.   # the save way
  167.   set xfSelection ""
  168.   catch "selection get" xfSelection
  169.   if {"$xfSelection" == "selection doesn't exist or form \"STRING\" not defined"} {
  170.     return ""
  171.   } {
  172.     return $xfSelection
  173.   }
  174. }
  175. }
  176.  
  177.  
  178. # Procedure: MenuPopupAdd
  179. if {"[info procs MenuPopupAdd]" == ""} {
  180. proc MenuPopupAdd { xfW xfButton xfMenu {xfModifier ""} {xfCanvasTag ""}} {
  181. # xf ignore me 7
  182. # the popup menu handling is from (I already gave up with popup handling :-):
  183. #
  184. # Copyright 1991,1992 by James Noble.
  185. # Everyone is granted permission to copy, modify and redistribute.
  186. # This notice must be preserved on all copies or derivates.
  187. #
  188. ##########
  189. # Procedure: MenuPopupAdd
  190. # Description: attach a popup menu to widget
  191. # Arguments: xfW - the widget
  192. #            xfButton - the button we use
  193. #            xfMenu - the menu to attach
  194. #            {xfModifier} - a optional modifier
  195. #            {xfCanvasTag} - a canvas tagOrId
  196. # Returns: none
  197. # Sideeffects: none
  198. ##########
  199.  
  200.   if {"$xfModifier" != ""} {
  201.     set xfPressModifier "$xfModifier-"
  202.     set xfMoveModifier "$xfModifier-"
  203.     set xfReleaseModifier "Any-"
  204.   } {
  205.     set xfPressModifier ""
  206.     set xfMoveModifier ""
  207.     set xfReleaseModifier ""
  208.   }
  209.  
  210.   if {"$xfCanvasTag" == ""} {
  211.     if {[catch "bind $xfW \"<${xfPressModifier}ButtonPress-$xfButton>\"                   \"$xfMenu post %X %Y\"" xfResult]} {
  212.       if {"[info commands XFProcError]" != ""} {
  213.         XFProcError "$xfResult"
  214.       } {
  215.         puts stdout "$xfResult"
  216.       }
  217.       return
  218.     }
  219.     if {[catch "bind $xfW \"<${xfMoveModifier}B$xfButton-Motion>\"                   \"MenuPopupHandle $xfMenu %W %X %Y\"" xfResult]} {
  220.       if {"[info commands XFProcError]" != ""} {
  221.         XFProcError "$xfResult"
  222.       } {
  223.         puts stdout "$xfResult"
  224.       }
  225.       return
  226.     }
  227.     # we need these to counteract the effects of passive grabs :-(
  228.     if {[catch "bind $xfW \"<${xfReleaseModifier}ButtonRelease-$xfButton>\"                   \"$xfMenu invoke active; $xfMenu unpost\"" xfResult]} {
  229.       if {"[info commands XFProcError]" != ""} {
  230.         XFProcError "$xfResult"
  231.       } {
  232.         puts stdout "$xfResult"
  233.       }
  234.       return
  235.     }
  236.   } {
  237.     if {[catch "$xfW bind $xfCanvasTag \"<${xfPressModifier}ButtonPress-$xfButton>\"                   \"$xfMenu post %X %Y\"" xfResult]} {
  238.       if {"[info commands XFProcError]" != ""} {
  239.         XFProcError "$xfResult"
  240.       } {
  241.         puts stdout "$xfResult"
  242.       }
  243.       return
  244.     }
  245.     if {[catch "$xfW bind $xfCanvasTag \"<${xfMoveModifier}B$xfButton-Motion>\"                   \"MenuPopupHandle $xfMenu %W %X %Y\"" xfResult]} {
  246.       if {"[info commands XFProcError]" != ""} {
  247.         XFProcError "$xfResult"
  248.       } {
  249.         puts stdout "$xfResult"
  250.       }
  251.       return
  252.     }
  253.     # we need these to counteract the effects of passive grabs :-(
  254.     if {[catch "$xfW bind $xfCanvasTag \"<${xfReleaseModifier}ButtonRelease-$xfButton>\"                   \"$xfMenu invoke active; $xfMenu unpost\"" xfResult]} {
  255.       if {"[info commands XFProcError]" != ""} {
  256.         XFProcError "$xfResult"
  257.       } {
  258.         puts stdout "$xfResult"
  259.       }
  260.       return
  261.     }
  262.   }
  263. }
  264. }
  265.  
  266.  
  267. # Procedure: MenuPopupHandle
  268. if {"[info procs MenuPopupHandle]" == ""} {
  269. proc MenuPopupHandle { xfMenu xfW xfX xfY} {
  270. # xf ignore me 7
  271. ##########
  272. # Procedure: MenuPopupHandle
  273. # Description: handle the popup menus
  274. # Arguments: xfMenu - the menu to attach
  275. #            xfW - the widget
  276. #            xfX - the root x coordinate
  277. #            xfY - the root x coordinate
  278. # Returns: none
  279. # Sideeffects: none
  280. ##########
  281.  
  282.   if {"[info commands $xfMenu]" != "" && [winfo ismapped $xfMenu]} {
  283.     set xfPopMinX [winfo rootx $xfMenu]
  284.     set xfPopMaxX [expr $xfPopMinX+[winfo width $xfMenu]]
  285.     if {($xfX >= $xfPopMinX) &&  ($xfX <= $xfPopMaxX)} {
  286.       $xfMenu activate @[expr $xfY-[winfo rooty $xfMenu]]
  287.     } {
  288.       $xfMenu activate none
  289.     }
  290.   }
  291. }
  292. }
  293.  
  294.  
  295. # Procedure: NoFunction
  296. if {"[info procs NoFunction]" == ""} {
  297. proc NoFunction { args} {
  298. # xf ignore me 7
  299. ##########
  300. # Procedure: NoFunction
  301. # Description: do nothing (especially with scales and scrollbars)
  302. # Arguments: args - a number of ignored parameters
  303. # Returns: none
  304. # Sideeffects: none
  305. ##########
  306. }
  307. }
  308.  
  309.  
  310. # Procedure: SN
  311. if {"[info procs SN]" == ""} {
  312. proc SN { {xfName ""}} {
  313. # xf ignore me 7
  314. ##########
  315. # Procedure: SN
  316. # Description: map a symbolic name to the widget path
  317. # Arguments: xfName
  318. # Returns: the symbolic name
  319. # Sideeffects: none
  320. ##########
  321.  
  322.   SymbolicName $xfName
  323. }
  324. }
  325.  
  326.  
  327. # Procedure: SymbolicName
  328. if {"[info procs SymbolicName]" == ""} {
  329. proc SymbolicName { {xfName ""}} {
  330. # xf ignore me 7
  331. ##########
  332. # Procedure: SymbolicName
  333. # Description: map a symbolic name to the widget path
  334. # Arguments: xfName
  335. # Returns: the symbolic name
  336. # Sideeffects: none
  337. ##########
  338.  
  339.   global symbolicName
  340.  
  341.   if {"$xfName" != ""} {
  342.     set xfArrayName ""
  343.     append xfArrayName symbolicName ( $xfName )
  344.     if {![catch "set \"$xfArrayName\"" xfValue]} {
  345.       return $xfValue
  346.     } {
  347.       if {"[info commands XFProcError]" != ""} {
  348.         XFProcError "Unknown symbolic name:\n$xfName"
  349.       } {
  350.         puts stderr "XF error: unknown symbolic name:\n$xfName"
  351.       }
  352.     }
  353.   }
  354.   return ""
  355. }
  356. }
  357.  
  358.  
  359. # Procedure: Unalias
  360. proc Unalias { aliasName} {
  361. # xf ignore me 7
  362. ##########
  363. # Procedure: Unalias
  364. # Description: remove an alias for a procedure
  365. # Arguments: aliasName - the alias name to remove
  366. # Returns: none
  367. # Sideeffects: internalAliasList is updated, and the alias
  368. #              proc is removed
  369. ##########
  370.   global internalAliasList
  371.  
  372.   set xfIndex [lsearch $internalAliasList "$aliasName *"]
  373.   if {$xfIndex != -1} {
  374.     rename $aliasName ""
  375.     set internalAliasList [lreplace $internalAliasList $xfIndex $xfIndex]
  376.   }
  377. }
  378.  
  379.  
  380.  
  381.  
  382. # initialize global variables
  383. proc InitGlobals {} {
  384.   global {checkbutton2}
  385.   set {checkbutton2} {0}
  386.   global {tmplt}
  387.   set {tmplt} {0}
  388.  
  389.   # please don't modify the following
  390.   # variables. They are needed by xf.
  391.   global {autoLoadList}
  392.   set {autoLoadList(XFSymName.tcl)} {0}
  393.   set {autoLoadList(main.tcl)} {0}
  394.   global {internalAliasList}
  395.   set {internalAliasList} {}
  396.   global {moduleList}
  397.   set {moduleList(XFSymName.tcl)} {}
  398.   global {preloadList}
  399.   set {preloadList(xfInternal)} {}
  400.   global {symbolicName}
  401.   set {symbolicName(aaa bbb)} {.button0}
  402.   set {symbolicName(ooo pppp iiii)} {.checkbutton2}
  403.   set {symbolicName(oooo)} {.label1}
  404.   set {symbolicName(root)} {.}
  405.   global {xfWmSetPosition}
  406.   set {xfWmSetPosition} {}
  407.   global {xfWmSetSize}
  408.   set {xfWmSetSize} {}
  409.   global {xfAppDefToplevels}
  410.   set {xfAppDefToplevels} {}
  411. }
  412.  
  413. # initialize global variables
  414. InitGlobals
  415.  
  416. # display/remove toplevel windows.
  417. ShowWindow.
  418.  
  419. # load default bindings.
  420. if {[info exists env(XF_BIND_FILE)] &&
  421.     "[info procs XFShowHelp]" == ""} {
  422.   source $env(XF_BIND_FILE)
  423. }
  424.  
  425. # eof
  426. #
  427.  
  428.