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 / additionals / XFForm < prev    next >
Encoding:
Text File  |  1993-11-20  |  6.2 KB  |  212 lines
  1. # Program: xf
  2. # Description: handle xfform widgets
  3. #
  4. # $Header: XFForm[2.3] Wed Mar 10 11:57:36 1993 garfield@garfield frozen $
  5.  
  6. global xfDefaultConf
  7. set xfDefaultConf(xfform) 2
  8.  
  9. ##########
  10. # Procedure: XFAdd.XFForm
  11. # Description: add a XFform
  12. # Arguments: xfW - the widget
  13. #            xfName - a optional name
  14. #            xfType - add or config
  15. # Returns: none
  16. # Sideeffects: none
  17. ##########
  18. proc XFAdd.XFForm {xfW xfName xfType} {
  19.   global xfStatus
  20.  
  21.   XFEditSetStatus "Inserting XFForm..."
  22.   set xfName [XFMiscGetUniqueName $xfName form]
  23.   if {"$xfStatus(path)" == "."} {
  24.     if {"$xfType" == "add"} {
  25.       frame .$xfName -class XFForm \
  26.         -borderwidth 2 \
  27.         -relief raised
  28.     } {
  29.       frame .$xfName -class XFForm
  30.     }
  31.  
  32.     XFMiscPositionWidget .$xfName \
  33.       {top fill expand} {-x 0 -y 0 -relwidth 1 -relheight 1}
  34.     XFMiscBindWidgetTree .$xfName
  35.   } {
  36.     if {"$xfType" == "add"} {
  37.       frame $xfStatus(path).$xfName -class XFForm \
  38.         -borderwidth 2 \
  39.         -relief raised
  40.     } {
  41.       frame $xfStatus(path).$xfName -class XFForm
  42.     }
  43.  
  44.     XFMiscPositionWidget $xfStatus(path).$xfName \
  45.       {top fill expand} {-x 0 -y 0 -relwidth 1 -relheight 1}
  46.     XFMiscBindWidgetTree $xfStatus(path).$xfName
  47.   }
  48.  
  49.   incr xfStatus(elementCounter)
  50.   XFEditSetPath $xfStatus(path)
  51.   XFEditSetStatus "Inserting XFForm...done"
  52. }
  53.  
  54. ##########
  55. # Procedure: XFAddTmp.XFForm
  56. # Description: add a tmp xfform
  57. # Arguments: none
  58. # Returns: none
  59. # Sideeffects: none
  60. ##########
  61. proc XFAddTmp.XFForm {} {
  62.  
  63.   catch "destroy .xfEdit.tmplt"
  64.   if {[catch "frame .xfEdit.tmplt -class XFForm"]} {
  65.     XFProcConfConfigure undefined "" "" XFForm add
  66.   } {
  67.     XFProcConfConfigure .xfEdit.tmplt "" "" XFForm add
  68.   }
  69. }
  70.  
  71. ##########
  72. # Procedure: XFConfig.XFForm4
  73. # Description: configure a XFform
  74. # Arguments: xfW - the widget
  75. #            xfType - config type (add config)
  76. #            xfClass - the class we configure
  77. #            xfLeader - the leading window
  78. # Returns: none
  79. # Sideeffects: none
  80. ##########
  81. proc XFConfig.XFForm4 {xfW xfType xfClass {xfLeader ""}} {
  82.   global xfStatus
  83.  
  84.   if {"$xfType" == "add"} {
  85.     set xfName form$xfStatus(elementCounter)
  86.   } {
  87.     set xfName [XFMiscPathName $xfW]
  88.   }
  89.   XFEditSetStatus "Calling parameter setting for XFForm..."
  90.  
  91.   # build widget structure
  92.   XFTmpltToplevel .xf${xfClass}Config4 400x380 \
  93.     "XFForm parameters:[XFMiscPathTail $xfW]" $xfLeader
  94.  
  95.   XFElementInit $xfW .xf${xfClass}Config4 $xfType $xfClass \
  96.     XFXFFormSetXFForm4 parameters $xfName 4
  97.   XFElementColor $xfW .xf${xfClass}Config4 $xfType $xfClass bg \
  98.     background Background "Background" XFXFFormSetXFForm4
  99.   XFElementScale $xfW .xf${xfClass}Config4 $xfType $xfClass borderwidth \
  100.     borderWidth BorderWidth "Border width" "pixels" 40 XFXFFormSetXFForm4
  101.   XFElementCursor $xfW .xf${xfClass}Config4 $xfType $xfClass \
  102.     XFXFFormSetXFForm4
  103.   XFElementGeometry $xfW .xf${xfClass}Config4 $xfType $xfClass \
  104.     XFXFFormSetXFForm4
  105.   XFElementRelief $xfW .xf${xfClass}Config4 $xfType $xfClass \
  106.     XFXFFormSetXFForm4
  107.   XFElementSize $xfW .xf${xfClass}Config4 $xfType $xfClass XFXFFormSetXFForm4
  108.  
  109.   if {"$xfType" == "add"} {
  110.     .xf${xfClass}Config4.params1.params2.borderwidth.borderwidth set 2
  111.   }
  112.  
  113.   # save current parameter
  114.   XFElementSave $xfW $xfClass {background borderwidth cursor geometry relief}
  115.  
  116.   # packing
  117.   pack append .xf${xfClass}Config4.params1 \
  118.               .xf${xfClass}Config4.params1.params2 {left fill expand}
  119.   pack append .xf${xfClass}Config4 \
  120.               .xf${xfClass}Config4.pathname {top fill frame center} \
  121.               .xf${xfClass}Config4.leave {bottom fill} \
  122.               .xf${xfClass}Config4.additional {bottom fill} \
  123.               .xf${xfClass}Config4.params1 {top fill expand}
  124.  
  125.   XFBindFormConnect .xf${xfClass}Config4.params1.params2 \
  126.     "XFXFFormSetXFForm4 $xfW 0 $xfClass"
  127.  
  128.   XFEditSetStatus "Calling parameter setting for XFForm...done"
  129. }
  130.  
  131. ##########
  132. # Procedure: XFSaveSpecial.XFForm
  133. # Description: save XFform
  134. # Arguments: xfW - the widget
  135. # Returns: none
  136. # Sideeffects: none
  137. ##########
  138. proc XFSaveSpecial.XFForm {xfW} {
  139.  
  140.   return "  if {\"\[info procs XFLocalFormConnect\]\" != \"\"} {\n    XFLocalFormConnect $xfW\n  }\n"
  141. }
  142.  
  143. ##########
  144. # Procedure: XFSaveWidget.XFForm
  145. # Description: save xfform widget
  146. # Arguments: xfOutFile - the output file
  147. #            xfW - the widget
  148. # Returns: none
  149. # Sideeffects: none
  150. ##########
  151. proc XFSaveWidget.XFForm {xfOutFile xfW} {
  152.   global xfConf
  153.  
  154.   set xfTmpString ""
  155.   set xfType [string tolower [winfo class $xfW]]
  156.  
  157.   # what are we doing here ?
  158.   puts $xfOutFile "\n  # build widget $xfW"
  159.  
  160.   # write widget type and path name
  161.   puts $xfOutFile "  frame $xfW -class XFForm " nonewline
  162.   XFSaveWidgetResource $xfOutFile $xfW
  163.   puts $xfOutFile ""
  164. }
  165.  
  166. ##########
  167. # Procedure: XFXFFormSetXFForm4
  168. # Description: set XFform parameters
  169. # Arguments: xfW - the widget
  170. #            xfType - the type of setting (1 = set always, 0 = set
  171. #                     only if permanent apply is on)
  172. #            xfClass - the class we configure
  173. #            xfParam1 - ignored parameter
  174. # Returns: none
  175. # Sideeffects: none
  176. ##########
  177. proc XFXFFormSetXFForm4 {xfW xfType xfClass {xfParam1 ""}} {
  178.   global xfConf
  179.   global xfMisc
  180.  
  181.   if {$xfType == 0 && !$xfConf(applyParameters)} {
  182.     return
  183.   }
  184.   if {"[info commands $xfW]" == ""} {
  185.     return
  186.   }
  187.   XFMiscSetSymbolicName $xfW \
  188.     [.xf${xfClass}Config4.params1.params2.symname.symname get]
  189.  
  190.   XFMiscSetResource $xfW background \
  191.     [.xf${xfClass}Config4.params1.params2.bg.bg get]
  192.   XFMiscSetResource $xfW borderwidth \
  193.     [.xf${xfClass}Config4.params1.params2.borderwidth.borderwidth get]
  194.   XFMiscSetResource $xfW cursor \
  195.     "[.xf${xfClass}Config4.params1.params2.cursor.cursor get]"
  196.   if {[.xf${xfClass}Config4.params1.params2.geo.geo1.geo1 get] > 0 &&
  197.       [.xf${xfClass}Config4.params1.params2.geo.geo2.geo2 get] > 0} {
  198.     XFMiscSetResource $xfW geometry \
  199.       "[.xf${xfClass}Config4.params1.params2.geo.geo1.geo1 get]x[.xf${xfClass}Config4.params1.params2.geo.geo2.geo2 get]"
  200.   } {
  201.     XFMiscSetResource $xfW geometry {}
  202.     XFMiscSetResource $xfW height \
  203.       [.xf${xfClass}Config4.params1.params2.size.size2.size2 get]
  204.     XFMiscSetResource $xfW width \
  205.       [.xf${xfClass}Config4.params1.params2.size.size1.size1 get]
  206.   }
  207.   XFMiscSetResource $xfW relief $xfMisc(relief)
  208. }
  209.  
  210. # eof
  211.  
  212.