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 / xfsaveSource.tcl < prev    next >
Encoding:
Text File  |  1993-11-20  |  12.9 KB  |  372 lines
  1. # Program: xf
  2. # Description: save complete pieces pf source
  3. #
  4. # $Header: xfsaveSource.tcl[2.3] Wed Mar 10 12:08:24 1993 garfield@garfield frozen $
  5.  
  6. ##########
  7. # Procedure: XFSaveSourceAppendix
  8. # Description: save the appendix. Initialisations etc.
  9. # Arguments: xfOutFile - the output descriptor
  10. #            {xfSavePlain} - save the output as plain tcl file
  11. # Returns: none
  12. # Sideeffects: none
  13. ##########
  14. proc XFSaveSourceAppendix {xfOutFile {xfSavePlain 0}} {
  15.   global autoLoadList
  16.   global moduleList
  17.   global preloadList
  18.   global xfConf
  19.   global xfStatus
  20.  
  21.   puts $xfOutFile "\n\n"
  22.   if {"[array names moduleList]" != "" &&
  23.       "[array names moduleList]" != "$xfConf(programName)"} {
  24.     puts $xfOutFile "# module load procedure"
  25.     puts $xfOutFile "proc XFLocalIncludeModule {{moduleName \"\"}} {" nonewline
  26.     puts $xfOutFile [info body XFIncludeModule] nonewline
  27.     puts $xfOutFile "}\n"
  28.   }
  29.  
  30.   if {$xfConf(createAppdefCode)} {
  31.     puts $xfOutFile "# application parsing procedure"
  32.     puts $xfOutFile "proc XFLocalParseAppDefs {xfAppDefFile} {" nonewline
  33.     puts $xfOutFile [info body XFParseAppDefs] nonewline
  34.     puts $xfOutFile "}\n"
  35.     puts $xfOutFile "# application loading procedure"
  36.     puts $xfOutFile "proc XFLocalLoadAppDefs {{xfClasses \"\"} {xfPriority \"startupFile\"} {xfAppDefFile \"\"}} {" nonewline
  37.     puts $xfOutFile [info body XFLoadAppDefs] nonewline
  38.     puts $xfOutFile "}\n"
  39.     puts $xfOutFile "# application setting procedure"
  40.     puts $xfOutFile "proc XFLocalSetAppDefs {{xfWidgetPath \".\"}} {" nonewline
  41.     puts $xfOutFile [info body XFSetAppDefs] nonewline
  42.     puts $xfOutFile "}\n"
  43.   }
  44.  
  45.   if {$xfConf(createClassBinding)} {
  46.     puts $xfOutFile "# class bindings"
  47.     foreach xfCounter $xfStatus(elementList) {
  48.       XFSaveBind $xfOutFile $xfCounter 1
  49.     }
  50.     foreach xfCounter $xfStatus(additionalList) {
  51.       XFSaveBind $xfOutFile $xfCounter 1
  52.     }
  53.     puts $xfOutFile ""
  54.   }
  55.  
  56.   if {$xfConf(createFormCode)} {
  57.     puts $xfOutFile "# form bindings"
  58.     puts $xfOutFile "proc XFLocalFormBind {xfW xfPrevW xfNextW {xfCommand \"\"}} {" nonewline
  59.     puts $xfOutFile [info body XFBindForms] nonewline
  60.     puts $xfOutFile "}\n"
  61.     puts $xfOutFile "# focus in a text/entry widget"
  62.     puts $xfOutFile "proc XFLocalFocusIn {xfW} {" nonewline
  63.     puts $xfOutFile [info body XFBindFocusIn] nonewline
  64.     puts $xfOutFile "}\n"
  65.     puts $xfOutFile "# form support procedure"
  66.     puts $xfOutFile "proc XFLocalFormConnect {xfWList {xfCommand \"\"} {xfInitial 1}} {" nonewline
  67.     puts $xfOutFile [info body XFBindFormConnect] nonewline
  68.     puts $xfOutFile "}\n"
  69.   }
  70.  
  71.   if {"[bind all]" != ""} {
  72.     puts $xfOutFile "# initialize bindings for all widgets"
  73.     puts $xfOutFile "proc InitAllBindings {} {"
  74.     XFSaveBind $xfOutFile all
  75.     puts $xfOutFile "}"
  76.   }
  77.  
  78.   if {$xfConf(createPixmapCode) &&
  79.       "[array names preloadList]" != "" &&
  80.       "[array names preloadList]" != "xfInternal"} {
  81.     XFSaveSourcePreloadPixmaps $xfOutFile $xfSavePlain
  82.   }
  83.  
  84.   XFSaveSourceStartupEndProc $xfOutFile
  85.  
  86.   if {!$xfSavePlain} {
  87.     if {"[array names moduleList]" != "" &&
  88.         "[array names moduleList]" != "$xfConf(programName)"} {
  89.       puts $xfOutFile ""
  90.     }
  91.     foreach xfCounter [lsort [array names moduleList]] {
  92.       if {"$xfCounter" == "$xfConf(programName)"} {
  93.         continue
  94.       }
  95.       if {[info exists autoLoadList($xfCounter)] &&
  96.           $autoLoadList($xfCounter)} {
  97.         puts $xfOutFile "if {\"\[info procs XFShowHelp\]\" != \"\"} {"
  98.         puts $xfOutFile "  XFLocalIncludeModule $xfCounter"
  99.         puts $xfOutFile "}"
  100.       } {
  101.         puts $xfOutFile "XFLocalIncludeModule $xfCounter"
  102.       }
  103.     }
  104.     if {"[array names moduleList]" != "" &&
  105.         "[array names moduleList]" != "$xfConf(programName)"} {
  106.       puts $xfOutFile ""
  107.     }
  108.   }
  109.  
  110.   if {$xfConf(writeTclIndex) && !$xfSavePlain} {
  111.     puts $xfOutFile "\n# prepare auto loading"
  112.     puts $xfOutFile "global auto_path"
  113.     puts $xfOutFile "global tk_library"
  114.     puts $xfOutFile "global xfLoadPath"
  115.     puts $xfOutFile "foreach xfElement \[eval list \[split \$xfLoadPath :\] \$auto_path\] {"
  116.     puts $xfOutFile "  if {\[file exists \$xfElement/tclIndex\]} {"
  117.     puts $xfOutFile "    lappend auto_path \$xfElement"
  118.     puts $xfOutFile "  }"
  119.     puts $xfOutFile "}"
  120.     puts $xfOutFile "catch \"unset auto_index\"\n"
  121.     puts $xfOutFile "catch \"unset auto_oldpath\"\n"
  122.     puts $xfOutFile "catch \"unset auto_execs\"\n"
  123.   }
  124.  
  125.   if {"[info procs StartupSrc]" != ""} {
  126.     puts $xfOutFile "\n# startup source"
  127.     puts $xfOutFile "StartupSrc"
  128.   }
  129.  
  130.   XFSaveGlobals $xfOutFile $xfSavePlain
  131.  
  132.   if {!$xfSavePlain} {
  133.     puts $xfOutFile "\n# initialize global variables"
  134.     puts $xfOutFile "InitGlobals"
  135.     if {$xfConf(createPixmapCode) &&
  136.         "[array names preloadList]" != "" &&
  137.         "[array names preloadList]" != "xfInternal"} {
  138.       puts $xfOutFile "\n# preload pixmaps"
  139.       puts $xfOutFile "PreloadPixmaps"
  140.     }
  141.   }
  142.   puts $xfOutFile "\n# display/remove toplevel windows."
  143.   puts $xfOutFile "ShowWindow."
  144.   foreach xfCounter [lsort [info globals xfShowWindow.*]] {
  145.     global $xfCounter
  146.     puts $xfOutFile "\nglobal $xfCounter"
  147.     puts $xfOutFile "set $xfCounter [set $xfCounter]"
  148.     if {[set $xfCounter]} {
  149.       puts $xfOutFile "ShowWindow.[string range $xfCounter 13 \
  150.                          [expr [string length $xfCounter]-1]]"
  151.     }
  152.   }
  153.  
  154.   puts $xfOutFile "\n# load default bindings."
  155.   puts $xfOutFile "if {\[info exists env(XF_BIND_FILE)\] &&"
  156.   puts $xfOutFile "    \"\[info procs XFShowHelp\]\" == \"\"} {"
  157.   puts $xfOutFile "  source \$env(XF_BIND_FILE)"
  158.   puts $xfOutFile "}"
  159.  
  160.   if {"[bind all]" != ""} {
  161.     puts $xfOutFile "\n# initialize bindings for all widgets."
  162.     puts $xfOutFile "InitAllBindings\n"
  163.   }
  164.  
  165.   if {$xfConf(createAppdefCode)} {
  166.     set xfApplicationClass [string toupper [string range [file rootname $xfConf(programName)] 0 0]][string range [file rootname $xfConf(programName)] 1 end]
  167.     puts $xfOutFile "\n# parse and apply application defaults."
  168.     puts $xfOutFile "XFLocalLoadAppDefs $xfApplicationClass"
  169.     puts $xfOutFile "XFLocalSetAppDefs"
  170.   }
  171.  
  172.   if {"[info procs EndSrc]" != ""} {
  173.     puts $xfOutFile "\n# end source"
  174.     puts $xfOutFile "EndSrc"
  175.   }
  176. }
  177.  
  178. ##########
  179. # Procedure: XFSaveSourceDestroyWindow
  180. # Description: save widget destroy code
  181. # Arguments: xfOutFile - the output descriptor
  182. #            xfW - the widget to destroy
  183. # Returns: none
  184. # Sideeffects: none
  185. ##########
  186. proc XFSaveSourceDestroyWindow {xfOutFile xfW} {
  187.  
  188.   puts $xfOutFile "\nproc DestroyWindow$xfW {} {# xf ignore me 7"
  189.   puts $xfOutFile "  if {\"\[info procs XFEdit\]\" != \"\"} {"
  190.   puts $xfOutFile "    if {\"\[info commands $xfW\]\" != \"\"} {"
  191.   puts $xfOutFile "      global xfShowWindow$xfW"
  192.   puts $xfOutFile "      set xfShowWindow$xfW 0"
  193.   puts $xfOutFile "      XFEditSetPath ."
  194.   puts $xfOutFile "      after 2 \"XFSaveAsProc $xfW; XFEditSetShowWindows\""
  195.   puts $xfOutFile "    }"
  196.   puts $xfOutFile "  } {"
  197.   puts $xfOutFile "    catch \"destroy $xfW\""
  198.   puts $xfOutFile "    update"
  199.   puts $xfOutFile "  }"
  200.   puts $xfOutFile "}"
  201. }
  202.  
  203. ##########
  204. # Procedure: XFSaveSourcePrefix
  205. # Description: save prefix code, module loading parse source etc.
  206. # Arguments: xfOutFile - the output descriptor
  207. #            {xfSavePlain} - save the output as plain tcl file
  208. # Returns: none
  209. # Sideeffects: none
  210. ##########
  211. proc XFSaveSourcePrefix {xfOutFile {xfSavePlain 0}} {
  212.   global xfConf
  213.   global xfLoadPath
  214.  
  215.   if {!$xfSavePlain} {
  216.     puts $xfOutFile "\n# module inclusion"
  217.     puts $xfOutFile "global env"
  218.     puts $xfOutFile "global xfLoadPath"
  219.     puts $xfOutFile "global xfLoadInfo"
  220.     puts $xfOutFile "set xfLoadInfo 0"
  221.     puts $xfOutFile "if {\[info exists env(XF_LOAD_PATH)\]} {"
  222.     puts $xfOutFile "  if {\[string first \$env(XF_LOAD_PATH) $xfLoadPath\] == -1} {"
  223.     puts $xfOutFile "    set xfLoadPath \$env(XF_LOAD_PATH):$xfLoadPath"
  224.     puts $xfOutFile "  } {"
  225.     puts $xfOutFile "    set xfLoadPath $xfLoadPath"
  226.     puts $xfOutFile "  }"
  227.     puts $xfOutFile "} {"
  228.     puts $xfOutFile "  set xfLoadPath $xfLoadPath"
  229.     puts $xfOutFile "}\n"
  230.     if {$xfConf(createParseCode)} {
  231.       puts $xfOutFile "global argc"
  232.       puts $xfOutFile "global argv"
  233.       puts $xfOutFile "global tkVersion"
  234.       puts $xfOutFile "set tmpArgv \"\""
  235.       puts $xfOutFile "for {set counter 0} {\$counter < \$argc} {incr counter 1} {"
  236.       puts $xfOutFile "  case \[string tolower \[lindex \$argv \$counter\]\] in {"
  237.       puts $xfOutFile "    {-xfloadpath} {"
  238.       puts $xfOutFile "      incr counter 1"
  239.       puts $xfOutFile "      set xfLoadPath \"\[lindex \$argv \$counter\]:\$xfLoadPath\""
  240.       puts $xfOutFile "    }"
  241.       puts $xfOutFile "    {-xfstartup} {"
  242.       puts $xfOutFile "      incr counter 1"
  243.       puts $xfOutFile "      source \[lindex \$argv \$counter\]"
  244.       puts $xfOutFile "    }"
  245.       puts $xfOutFile "    {-xfbindfile} {"
  246.       puts $xfOutFile "      incr counter 1"
  247.       puts $xfOutFile "      set env(XF_BIND_FILE) \"\[lindex \$argv \$counter\]\""
  248.       puts $xfOutFile "    }"
  249.       puts $xfOutFile "    {-xfcolorfile} {"
  250.       puts $xfOutFile "      incr counter 1"
  251.       puts $xfOutFile "      set env(XF_COLOR_FILE) \"\[lindex \$argv \$counter\]\""
  252.       puts $xfOutFile "    }"
  253.       puts $xfOutFile "    {-xfcursorfile} {"
  254.       puts $xfOutFile "      incr counter 1"
  255.       puts $xfOutFile "      set env(XF_CURSOR_FILE) \"\[lindex \$argv \$counter\]\""
  256.       puts $xfOutFile "    }"
  257.       puts $xfOutFile "    {-xffontfile} {"
  258.       puts $xfOutFile "      incr counter 1"
  259.       puts $xfOutFile "      set env(XF_FONT_FILE) \"\[lindex \$argv \$counter\]\""
  260.       puts $xfOutFile "    }"
  261.       puts $xfOutFile "    {-xfmodelmono} {"
  262.       puts $xfOutFile "      if {\$tkVersion >= 3.0} {"
  263.       puts $xfOutFile "        tk colormodel . monochrome"
  264.       puts $xfOutFile "      }"
  265.       puts $xfOutFile "    }"
  266.       puts $xfOutFile "    {-xfmodelcolor} {"
  267.       puts $xfOutFile "      if {\$tkVersion >= 3.0} {"
  268.       puts $xfOutFile "        tk colormodel . color"
  269.       puts $xfOutFile "      }"
  270.       puts $xfOutFile "    }"
  271.       puts $xfOutFile "    {-xfloading} {"
  272.       puts $xfOutFile "      set xfLoadInfo 1"
  273.       puts $xfOutFile "    }"
  274.       puts $xfOutFile "    {-xfnoloading} {"
  275.       puts $xfOutFile "      set xfLoadInfo 0"
  276.       puts $xfOutFile "    }"
  277.       puts $xfOutFile "    {default} {"
  278.       puts $xfOutFile "      lappend tmpArgv \[lindex \$argv \$counter\]"
  279.       puts $xfOutFile "    }"
  280.       puts $xfOutFile "  }"
  281.       puts $xfOutFile "}"
  282.       puts $xfOutFile "set argv \$tmpArgv"
  283.       puts $xfOutFile "set argc \[llength \$tmpArgv\]"
  284.       puts $xfOutFile "unset counter"
  285.       puts $xfOutFile "unset tmpArgv"
  286.     }
  287.   }
  288. }
  289.  
  290. ##########
  291. # Procedure: XFSaveSourcePreloadPixmaps
  292. # Description: save source for pixmap preloading
  293. # Arguments: xfOutFile - the output descriptor
  294. #            xfSavePlain - save the output as plain tcl file
  295. # Returns: none
  296. # Sideeffects: none
  297. ##########
  298. proc XFSaveSourcePreloadPixmaps {xfOutFile {xfSavePlain 0}} {
  299.   global preloadList
  300.   global xfConf
  301.  
  302.   if {"[info commands pinfo]" == ""} {
  303.     if {!$xfSavePlain} {
  304.       puts $xfOutFile "\n# predefine pixmaps"
  305.       puts $xfOutFile "proc PreloadPixmaps {} {\n"
  306.       puts $xfOutFile "}"
  307.     }
  308.   } {
  309.     if {!$xfSavePlain} {
  310.       set leftOffset "  "
  311.       puts $xfOutFile "\n# predefine pixmaps"
  312.       puts $xfOutFile "proc PreloadPixmaps {} {\n"
  313.       # make interpreter happy }
  314.     } {
  315.       set leftOffset ""
  316.       puts $xfOutFile "\n# predefine pixmaps"
  317.     }
  318.     puts $xfOutFile "${leftOffset}if {\"\[info commands pinfo\]\" != \"\"} {"
  319.     foreach xfCounter [lsort [pinfo names]] {
  320.       if {[info exists preloadList($xfCounter)] &&
  321.           "$xfCounter" != "gray25" && "$xfCounter" != "gray50"} {
  322.         if {[pinfo depth $xfCounter] == 1} {
  323.           puts $xfOutFile "${leftOffset}  pinfo define $xfCounter \{[pinfo data $xfCounter bitmap]\}"
  324.         } {
  325.           puts $xfOutFile "${leftOffset}  pinfo define $xfCounter \{[pinfo data $xfCounter xpm3]\}"
  326.         }
  327.       }
  328.     }
  329.     puts $xfOutFile "${leftOffset}}\n"
  330.     if {!$xfSavePlain} {
  331.       # make interpreter happy {
  332.       puts $xfOutFile "}"
  333.     }
  334.   }
  335. }
  336.  
  337. ##########
  338. # Procedure: XFSaveSourceStartupEndProc
  339. # Description: save startup/end source procedure
  340. # Arguments: xfOutFile - the output descriptor
  341. # Returns: none
  342. # Sideeffects: none
  343. ##########
  344. proc XFSaveSourceStartupEndProc {xfOutFile} {
  345.  
  346.   if {"[info procs StartupSrc]" != ""} {
  347.     puts $xfOutFile "\n\n# startup source"
  348.     set xfBodyList [string trimright [info body StartupSrc]]
  349.     puts $xfOutFile "proc StartupSrc {args} {"
  350.     if {[string index $xfBodyList 0] == "\n"} {
  351.       puts $xfOutFile [string range $xfBodyList 1 end]
  352.     } {
  353.       puts $xfOutFile $xfBodyList
  354.     }
  355.     puts $xfOutFile "}"
  356.   }
  357.   if {"[info procs EndSrc]" != ""} {
  358.     puts $xfOutFile "\n\n# end source"
  359.     set xfBodyList [string trimright [info body EndSrc]]
  360.     puts $xfOutFile "proc EndSrc {} {"
  361.     if {[string index $xfBodyList 0] == "\n"} {
  362.       puts $xfOutFile [string range $xfBodyList 1 end]
  363.     } {
  364.       puts $xfOutFile $xfBodyList
  365.     }
  366.     puts $xfOutFile "}"
  367.   }
  368. }
  369.  
  370. # eof
  371.  
  372.