home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / tcl / spectcl-.000 / spectcl- / usr / local / SpecTcl-0.1a / main.tk < prev    next >
Encoding:
Text File  |  1995-11-30  |  7.2 KB  |  233 lines
  1. # SpecTcl, by S. A. Uhler
  2. # Copyright (c) 1994-1995 Sun Microsystems, Inc.
  3. #
  4. # See the file "license.txt" for information on usage and redistribution
  5. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  6. #
  7. # main program for SpecTcl UI builder (sau 12/94)
  8. # Updated ui using SpecTcl generated panel (10/95)
  9. # Same, but with new ui
  10.  
  11. # check for proper versions of TK and blt_table
  12.  
  13.  
  14. catch {blt_table}    ;# force autoloading
  15. if {[info commands blt_table] == ""} {
  16.     tk_dialog .exit "Version Error" \
  17.         "SpecTcl requires the \"blt_table\" geometry manager" \
  18.         error 0 OK
  19.     exit
  20. }
  21.  
  22. # check for SpecTcl's blt_extension
  23.  
  24. frame .1
  25. frame .1.2
  26. blt_table .1 .1.2 0,0
  27. if {[catch {blt_table row .1 location 0}]} {
  28.     tk_dialog .exit "Version Error" \
  29.         "This version of blt_table is too old, and does ot have the \
  30.          \"location\" extension" \
  31.         error 0 OK
  32.     exit 0
  33. }
  34. destroy .1
  35.  
  36. # set some configuration parameters
  37.  
  38. if {[info exists env(SPECTCL_DIR)]} {
  39.     set Base_dir $env(SPECTCL_DIR)
  40. } else {
  41.     set Base_dir [file dir $argv0]
  42. }
  43. if {[info exists env(SPECTCL_HELP)]} {
  44.     set Help_dir $env(SPECTCL_HELP)
  45. } else {
  46.     set Help_dir $Base_dir/help
  47. }
  48.  
  49. if {![info exists P]} {
  50.     source $Base_dir/preferences.tk
  51. }
  52.  
  53. wm geometry . {}
  54. wm minsize . 50 50
  55. tk appname SpecTcl
  56. wm iconbitmap . @$Base_dir/icon.xbm
  57. wm iconmask . @$Base_dir/icon.xbm
  58.  
  59. # debugging - make sure we can resource everything
  60. eval "destroy [winfo children .]"
  61. catch "unset [info globals sample_*] [info globals *#*] [info globals geom:*]"
  62. foreach i [array names Widgets] {
  63.     global $i; catch {unset $i}
  64. }
  65. foreach i {f Adjust Current Widgets Update_Scheduled Frames Undo_log} {
  66.     catch {unset $i}
  67. }
  68. proc ? {} {global errorInfo; puts $errorInfo}
  69. if {$P(debug)} {
  70.     proc debug {args} {
  71.         global debug
  72.         set debug [concat $args]
  73.     }
  74. } else {
  75.     proc debug {args} {
  76.     }
  77. }
  78.  
  79. # load in all of the procedures
  80.  
  81. source $Base_dir/trace.tcl        ;# simple variable tracing facility
  82. source $Base_dir/init.tk        ;# global variable initialization
  83. source $Base_dir/configure.tk    ;# TK generic widget configuration information
  84. source $Base_dir/forms.tk        ;# option entry management
  85. source $Base_dir/filters.tk        ;# data filters for option values
  86. source $Base_dir/extract.tk        ;# widget option extraction and validation
  87. source $Base_dir/grid.tk        ;# The grid manipulation stuff
  88. source $Base_dir/subs.tk        ;# misc stuff that will end up elsewhere
  89. source $Base_dir/button_bind.tk    ;# generic button binding stuff
  90. source $Base_dir/button.tk        ;# specific binding behavior
  91. source $Base_dir/highlight.tk    ;# handle highlighting
  92. source $Base_dir/table_subs.tk    ;# manage table info
  93. source $Base_dir/outline.tk        ;# manage widget outlines
  94. source $Base_dir/arrow.tk        ;# manage the row and column indicators "arrows"
  95. source $Base_dir/save.tk        ;# save/load project from disk
  96. source $Base_dir/help.tk        ;# preliminary help stuff
  97. source $Base_dir/anchor.tk        ;# anchor selection
  98. source $Base_dir/fill.tk        ;# fill selection
  99. source $Base_dir/just.tk        ;# justify selection
  100. source $Base_dir/colors.tk        ;# color selection placeholder
  101. source $Base_dir/relief.tk        ;# relief management
  102. source $Base_dir/font_size.tk    ;# font size selection
  103. source $Base_dir/toolbar.tk        ;# toobar management routines
  104. source $Base_dir/resize.tk        ;# row and column resize behavior
  105. source $Base_dir/undo.tk        ;# The undo system (not operational)
  106. source $Base_dir/compile.tk        ;# temporary script compiler
  107. source $Base_dir/scroll.tk        ;# auto scrollbar attachment code
  108. source $Base_dir/menu.tk        ;# code to support menu bar
  109. source $Base_dir/html_lib.tcl    ;# html help library
  110. source $Base_dir/html.tcl        ;# html help library helpers
  111. source $Base_dir/about_xbm.tcl    ;# About box bitmaps
  112. source $Base_dir/about.tk        ;# About box animation
  113.  
  114. # These are generated automatically by SpecTcl
  115.  
  116. source $Base_dir/spectcl.ui.tcl    ;# main ui
  117. source $Base_dir/open.ui.tcl    ;# "open" dialog box
  118. source $Base_dir/save.ui.tcl    ;# "save" dialog box"
  119. source $Base_dir/edit.ui.tcl    ;# "edit code" widget
  120. source $Base_dir/colors.ui.tcl    ;# color editor
  121. source $Base_dir/help.ui.tcl    ;# html help system
  122.  
  123. # This is generated automatically by the menu edittor
  124.  
  125. source $Base_dir/menubar.menu.tcl    ;# menu bar from menu editor
  126.  
  127. # read in the "rc" file, if any
  128.  
  129. catch {source $env(HOME)/.SpecTclrc}
  130.  
  131. # create the top-level interface
  132. spectcl_ui .
  133. menubar_menu .menu
  134.  
  135. # The menu editor doesn't support this directly
  136. [menubar_getmenuname .menu "Show grid"] entryconfigure "Show grid" \
  137.         -onvalue $P(grid_size)
  138. set Grid 3
  139. test_help $P(help)        ;# turn on simple field help
  140.  
  141. # build the widget scaffolding
  142.  
  143. set parent .can.f                ;# all widgets are children of this guy
  144. frame $parent -bg $P(frame_bg)    ;# window to pack widgets into
  145. .can create window  0 0 -anchor nw -window $parent
  146. frame $parent.marker            ;# stacking order marker - below all buttons
  147. set Current(frame) $parent
  148. set Current(project) $P(project)
  149. set Current(dirty) ""
  150. set_title $Current(project)
  151.  
  152. # draw the grid lines, they go in ODD numbered rows and columns
  153.  
  154. grid_create $parent $P(maxrows) $P(maxcols) $P(grid_size) $P(grid_color)
  155.  
  156. # make the row and column arrows
  157.  
  158. set Frames($parent) 1
  159. table_setup $parent
  160. current_frame $parent 
  161. arrow_create .can_row row $parent all
  162. arrow_create .can_column column $parent all
  163. arrow_activate .can $parent $P(grid_color)
  164.  
  165. # initialize the toolbar
  166.  
  167. create_toolbar .toolbar
  168. blt_table column .toolbar configure all -resize none
  169. blt_table column .toolbar configure 20 -resize both
  170.  
  171. # setup the generic and widget option forms
  172.  
  173. build_option_form .generic
  174. build_option_form .widget
  175.  
  176. # initialize the button binding dispatcher
  177.  
  178. button_setup . palette_action palette $P(button) $P(gravity)
  179. button_setup . widget widget $P(button) $P(gravity)
  180. button_setup . resize resize $P(button) $P(gravity)
  181. button_setup . sub_widget widget $P(button) $P(gravity) {[winfo parent %W] %X %Y}
  182.  
  183. # build the widget palette  and sample widgets
  184.  
  185. set _Message "Gathering configuration information"
  186. set widgets [configure_widget_data Widget_data ._check_ widget_progress]
  187. set row 0
  188. foreach widget  [lsort $widgets] {
  189.     label .palette.$widget -text $widget \
  190.         -anchor w -relief raised -bd 2 -pady 1 -padx 2 ;# -bg #FDE
  191.     bindtags .palette.$widget {palette palette_action all}
  192.     blt_table .palette .palette.$widget $row,0 -fill x
  193.  
  194.     # make a "sample" widget for configuration
  195.         
  196.     $widget .sample_$widget
  197.     catch {.sample_$widget configure -text $widget}
  198.     catch {.sample_$widget configure -label $widget}
  199.     set Next_widget($widget) 0
  200.     incr row
  201. }
  202. blt_table row .palette configure all -pady 1 -resize none
  203. blt_table column .palette configure all -padx 1
  204. blt_table row .palette configure $row -resize both
  205.  
  206. # some more data setup
  207.  
  208. configure_geometry_data Widget_data ._check_
  209. install_filters            ;# associate data filters with widget items
  210. install_renames            ;# rename some of the tk options
  211. install_advanced        ;# these are the "advanced" options
  212. ignore_items            ;# set "hidden" field names for forms
  213. scrollregion_update $parent
  214. update_table $parent Init
  215.  
  216. # special case stuff for "top level" that is automatic for other frames
  217. widget_extract .can.f
  218. set_master .can.f .can.f
  219. set f(type) frame
  220.  
  221. source $Base_dir/bind.tk            ;# global bindings
  222.  
  223. # see if project is specified on the command line
  224.  
  225. set _Message "Key \"Help\" for SpecTcl help"
  226. if {$argc > 0} {
  227.     set project [lindex $argv 0]
  228.     if {![string match *.$P(file_suffix) $project]} {
  229.         append project .$P(file_suffix)
  230.     }
  231.     load_project $project
  232. }
  233.