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 / src / xftextBox.tcl < prev    next >
Encoding:
Text File  |  1993-11-20  |  11.0 KB  |  309 lines
  1. # XFNoParsing
  2. # Program: template
  3. # Description: text box
  4. #
  5. # $Header: xftextBox.tcl[2.3] Wed Mar 10 12:08:26 1993 garfield@garfield frozen $
  6.  
  7. global xfTextBox
  8. set xfTextBox(activeBackground) ""
  9. set xfTextBox(activeForeground) ""
  10. set xfTextBox(background) ""
  11. set xfTextBox(font) ""
  12. set xfTextBox(foreground) ""
  13. set xfTextBox(scrollActiveForeground) ""
  14. set xfTextBox(scrollBackground) ""
  15. set xfTextBox(scrollForeground) ""
  16. set xfTextBox(state) disabled
  17. set xfTextBox(toplevelName) .xfTextBox
  18. set xfTextBox(button) 0
  19. set xfTextBox(contents) ""
  20.  
  21. proc XFTextBox {{xfTextBoxMessage {Text message}} {xfTextBoxCommand ""} {xfTextBoxGeometry 350x150} {xfTextBoxTitle "Text box"} args} {# xf ignore me 5
  22. ##########
  23. # Procedure: XFTextBox
  24. # Description: show text box
  25. # Arguments: {xfTextBoxMessage} - the text to display
  26. #            {xfTextBoxCommand} - the command to call after ok
  27. #            {xfTextBoxGeometry} - the geometry for the window
  28. #            {xfTextBoxTitle} - the title for the window
  29. #            {args} - labels of buttons
  30. # Returns: The number of the selected button, or nothing
  31. # Sideeffects: none
  32. # Notes: there exist also functions called:
  33. #          XFTextBoxFile - to open and read a file automatically
  34. #          XFTextBoxFd - to read from an already opened filedescriptor
  35. ##########
  36. #
  37. # global xfTextBox(activeBackground) - active background color
  38. # global xfTextBox(activeForeground) - active foreground color
  39. # global xfTextBox(background) - background color
  40. # global xfTextBox(font) - text font
  41. # global xfTextBox(foreground) - foreground color
  42. # global xfTextBox(scrollActiveForeground) - scrollbar active background color
  43. # global xfTextBox(scrollBackground) - scrollbar background color
  44. # global xfTextBox(scrollForeground) - scrollbar foreground color
  45. # global xfTextBox(scrollSide) - side where scrollbar is located
  46.  
  47.   global xfTextBox
  48.  
  49.   # show text box
  50.   if {[llength $args] > 0} {
  51.     eval XFTextBoxInternal "\{$xfTextBoxMessage\}" "\{$xfTextBoxCommand\}" "\{$xfTextBoxGeometry\}" "\{$xfTextBoxTitle\}" $args
  52.   } {
  53.     XFTextBoxInternal $xfTextBoxMessage $xfTextBoxCommand $xfTextBoxGeometry $xfTextBoxTitle
  54.   }
  55.  
  56.   if {[llength $args] > 0} {
  57.     # wait for the box to be destroyed
  58.     update idletask
  59.     grab $xfTextBox(toplevelName)
  60.     tkwait window $xfTextBox(toplevelName)
  61.  
  62.     return $xfTextBox(button)
  63.   }
  64. }
  65.  
  66. proc XFTextBoxFd {{xfTextBoxInFile ""} {xfTextBoxCommand ""} {xfTextBoxGeometry 350x150} {xfTextBoxTitle "Text box"} args} {# xf ignore me 5
  67. ##########
  68. # Procedure: XFTextBoxFd
  69. # Description: show text box containing a filedescriptor
  70. # Arguments: {xfTextBoxInFile} - a filedescriptor to read. The descriptor
  71. #                              is closed after reading
  72. #            {xfTextBoxCommand} - the command to call after ok
  73. #            {xfTextBoxGeometry} - the geometry for the window
  74. #            {xfTextBoxTitle} - the title for the window
  75. #            {args} - labels of buttons
  76. # Returns: The number of the selected button, ot nothing
  77. # Sideeffects: none
  78. # Notes: there exist also functions called:
  79. #          XFTextBox - to display a passed string
  80. #          XFTextBoxFile - to open and read a file automatically
  81. ##########
  82. #
  83. # global xfTextBox(activeBackground) - active background color
  84. # global xfTextBox(activeForeground) - active foreground color
  85. # global xfTextBox(background) - background color
  86. # global xfTextBox(font) - text font
  87. # global xfTextBox(foreground) - foreground color
  88. # global xfTextBox(scrollActiveForeground) - scrollbar active background color
  89. # global xfTextBox(scrollBackground) - scrollbar background color
  90. # global xfTextBox(scrollForeground) - scrollbar foreground color
  91. # global xfTextBox(scrollSide) - side where scrollbar is located
  92.  
  93.   global xfTextBox
  94.  
  95.   # check file existance
  96.   if {"$xfTextBoxInFile" == ""} {
  97.     puts stderr "No filedescriptor specified"
  98.     return
  99.   }
  100.  
  101.   set xfTextBoxMessage [read $xfTextBoxInFile]
  102.   close $xfTextBoxInFile
  103.  
  104.   # show text box
  105.   if {[llength $args] > 0} {
  106.     eval XFTextBoxInternal "\{$xfTextBoxMessage\}" "\{$xfTextBoxCommand\}" "\{$xfTextBoxGeometry\}" "\{$xfTextBoxTitle\}" $args
  107.   } {
  108.     XFTextBoxInternal $xfTextBoxMessage $xfTextBoxCommand $xfTextBoxGeometry $xfTextBoxTitle
  109.   }
  110.  
  111.   if {[llength $args] > 0} {
  112.     # wait for the box to be destroyed
  113.     update idletask
  114.     grab $xfTextBox(toplevelName)
  115.     tkwait window $xfTextBox(toplevelName)
  116.  
  117.     return $xfTextBox(button)
  118.   }
  119. }
  120.  
  121. proc XFTextBoxFile {{xfTextBoxFile ""} {xfTextBoxCommand ""} {xfTextBoxGeometry 350x150} {xfTextBoxTitle "Text box"} args} {# xf ignore me 5
  122. ##########
  123. # Procedure: XFTextBoxFile
  124. # Description: show text box containing a file
  125. # Arguments: {xfTextBoxFile} - filename to read
  126. #            {xfTextBoxCommand} - the command to call after ok
  127. #            {xfTextBoxGeometry} - the geometry for the window
  128. #            {xfTextBoxTitle} - the title for the window
  129. #            {args} - labels of buttons
  130. # Returns: The number of the selected button, ot nothing
  131. # Sideeffects: none
  132. # Notes: there exist also functions called:
  133. #          XFTextBox - to display a passed string
  134. #          XFTextBoxFd - to read from an already opened filedescriptor
  135. ##########
  136. #
  137. # global xfTextBox(activeBackground) - active background color
  138. # global xfTextBox(activeForeground) - active foreground color
  139. # global xfTextBox(background) - background color
  140. # global xfTextBox(font) - text font
  141. # global xfTextBox(foreground) - foreground color
  142. # global xfTextBox(scrollActiveForeground) - scrollbar active background color
  143. # global xfTextBox(scrollBackground) - scrollbar background color
  144. # global xfTextBox(scrollForeground) - scrollbar foreground color
  145. # global xfTextBox(scrollSide) - side where scrollbar is located
  146.  
  147.   global xfTextBox
  148.  
  149.   # check file existance
  150.   if {"$xfTextBoxFile" == ""} {
  151.     puts stderr "No filename specified"
  152.     return
  153.   }
  154.  
  155.   if {[catch "open $xfTextBoxFile r" xfTextBoxInFile]} {
  156.     puts stderr "$xfTextBoxInFile"
  157.     return
  158.   }
  159.  
  160.   set xfTextBoxMessage [read $xfTextBoxInFile]
  161.   close $xfTextBoxInFile
  162.  
  163.   # show text box
  164.   if {[llength $args] > 0} {
  165.     eval XFTextBoxInternal "\{$xfTextBoxMessage\}" "\{$xfTextBoxCommand\}" "\{$xfTextBoxGeometry\}" "\{$xfTextBoxTitle\}" $args
  166.   } {
  167.     XFTextBoxInternal $xfTextBoxMessage $xfTextBoxCommand $xfTextBoxGeometry $xfTextBoxTitle
  168.   }
  169.  
  170.   if {[llength $args] > 0} {
  171.     # wait for the box to be destroyed
  172.     update idletask
  173.     grab $xfTextBox(toplevelName)
  174.     tkwait window $xfTextBox(toplevelName)
  175.  
  176.     return $xfTextBox(button)
  177.   }
  178. }
  179.  
  180. ##########
  181. # Procedure: XFTextBoxInternal
  182. # Description: show text box internal
  183. # Arguments: xfTextBoxMessage - the text to display
  184. #            xfTextBoxCommand - the command to call after ok
  185. #            xfTextBoxGeometry - the geometry for the window
  186. #            xfTextBoxTitle - the title for the window
  187. #            args - labels of buttons
  188. # Returns: none
  189. # Sideeffects: none
  190. ##########
  191. proc XFTextBoxInternal {xfTextBoxMessage xfTextBoxCommand xfTextBoxGeometry xfTextBoxTitle args} {# xf ignore me 6
  192.   global xfTextBox
  193.  
  194.   set tmpButtonOpt ""
  195.   set tmpFrameOpt ""
  196.   set tmpMessageOpt ""
  197.   set tmpScrollOpt ""
  198.   if {"$xfTextBox(activeBackground)" != ""} {
  199.     append tmpButtonOpt "-activebackground \"$xfTextBox(activeBackground)\" "
  200.   }
  201.   if {"$xfTextBox(activeForeground)" != ""} {
  202.     append tmpButtonOpt "-activeforeground \"$xfTextBox(activeForeground)\" "
  203.   }
  204.   if {"$xfTextBox(background)" != ""} {
  205.     append tmpButtonOpt "-background \"$xfTextBox(background)\" "
  206.     append tmpFrameOpt "-background \"$xfTextBox(background)\" "
  207.     append tmpMessageOpt "-background \"$xfTextBox(background)\" "
  208.   }
  209.   if {"$xfTextBox(font)" != ""} {
  210.     append tmpButtonOpt "-font \"$xfTextBox(font)\" "
  211.     append tmpMessageOpt "-font \"$xfTextBox(font)\" "
  212.   }
  213.   if {"$xfTextBox(foreground)" != ""} {
  214.     append tmpButtonOpt "-foreground \"$xfTextBox(foreground)\" "
  215.     append tmpMessageOpt "-foreground \"$xfTextBox(foreground)\" "
  216.   }
  217.   if {"$xfTextBox(scrollActiveForeground)" != ""} {
  218.     append tmpScrollOpt "-activeforeground \"$xfTextBox(scrollActiveForeground)\" "
  219.   }
  220.   if {"$xfTextBox(scrollBackground)" != ""} {
  221.     append tmpScrollOpt "-background \"$xfTextBox(scrollBackground)\" "
  222.   }
  223.   if {"$xfTextBox(scrollForeground)" != ""} {
  224.     append tmpScrollOpt "-foreground \"$xfTextBox(scrollForeground)\" "
  225.   }
  226.  
  227.   XFTmpltToplevel "$xfTextBox(toplevelName)" "$xfTextBoxGeometry" "$xfTextBoxTitle"
  228.  
  229.   frame $xfTextBox(toplevelName).frame0 \
  230.     -borderwidth 0 \
  231.     -relief raised
  232.   catch "$xfTextBox(toplevelName).frame0 config $tmpFrameOpt"
  233.  
  234.   text $xfTextBox(toplevelName).frame0.text1 \
  235.     -relief raised \
  236.     -wrap none \
  237.     -borderwidth 2 \
  238.     -yscrollcommand "$xfTextBox(toplevelName).frame0.vscroll set"
  239.   catch "$xfTextBox(toplevelName).frame0.text1 config $tmpMessageOpt"
  240.  
  241.   scrollbar $xfTextBox(toplevelName).frame0.vscroll \
  242.     -relief raised \
  243.     -command "$xfTextBox(toplevelName).frame0.text1 yview"
  244.   catch "$xfTextBox(toplevelName).frame0.vscroll config $tmpScrollOpt"
  245.  
  246.   frame $xfTextBox(toplevelName).frame1 \
  247.     -borderwidth 0 \
  248.     -relief raised
  249.   catch "$xfTextBox(toplevelName).frame1 config $tmpFrameOpt"
  250.  
  251.   set xfTextBoxCounter 0
  252.   set buttonNum [llength $args]
  253.  
  254.   if {$buttonNum > 0} {
  255.     while {$xfTextBoxCounter < $buttonNum} {
  256.       button $xfTextBox(toplevelName).frame1.button$xfTextBoxCounter \
  257.         -text "[lindex $args $xfTextBoxCounter]" \
  258.         -command "
  259.           global xfTextBox
  260.           set xfTextBox(button) $xfTextBoxCounter
  261.           set xfTextBox(contents) \[$xfTextBox(toplevelName).frame0.text1 get 1.0 end\]
  262.           if {\"\[info commands XFDestroy\]\" != \"\"} {
  263.             catch {XFDestroy $xfTextBox(toplevelName)}
  264.           } {
  265.             catch {destroy $xfTextBox(toplevelName)}
  266.           }"
  267.       catch "$xfTextBox(toplevelName).frame1.button$xfTextBoxCounter config $tmpButtonOpt"
  268.  
  269.       pack append $xfTextBox(toplevelName).frame1 \
  270.                   $xfTextBox(toplevelName).frame1.button$xfTextBoxCounter {left fillx expand}
  271.  
  272.       incr xfTextBoxCounter
  273.     }
  274.   } {
  275.     button $xfTextBox(toplevelName).frame1.button0 \
  276.       -text "OK" \
  277.       -command "
  278.         global xfTextBox
  279.         set xfTextBox(button) 0
  280.         set xfTextBox(contents) \[$xfTextBox(toplevelName).frame0.text1 get 1.0 end\]
  281.         if {\"\[info commands XFDestroy\]\" != \"\"} {
  282.           catch {XFDestroy $xfTextBox(toplevelName)}
  283.         } {
  284.           catch {destroy $xfTextBox(toplevelName)}
  285.         }
  286.         $xfTextBoxCommand"
  287.     catch "$xfTextBox(toplevelName).frame1.button0 config $tmpButtonOpt"
  288.  
  289.     pack append $xfTextBox(toplevelName).frame1 \
  290.                 $xfTextBox(toplevelName).frame1.button0 {left fillx expand}
  291.   }
  292.  
  293.   $xfTextBox(toplevelName).frame0.text1 insert end "$xfTextBoxMessage"
  294.  
  295.   $xfTextBox(toplevelName).frame0.text1 config \
  296.     -state $xfTextBox(state)
  297.  
  298.   # packing
  299.   pack append $xfTextBox(toplevelName).frame0 \
  300.               $xfTextBox(toplevelName).frame0.vscroll "$xfTextBox(scrollSide) filly" \
  301.               $xfTextBox(toplevelName).frame0.text1 {left fill expand}
  302.   pack append $xfTextBox(toplevelName) \
  303.               $xfTextBox(toplevelName).frame1 {bottom fill} \
  304.               $xfTextBox(toplevelName).frame0 {top fill expand}
  305. }
  306.  
  307. # eof
  308.  
  309.