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 / xfinfoProcs.tcl < prev    next >
Encoding:
Text File  |  1993-11-20  |  17.3 KB  |  530 lines
  1. # Program: xf
  2. # Description: info routine for procedures
  3. #
  4. # $Header: xfinfoProcs.tcl[2.5] Wed Mar 10 12:06:18 1993 garfield@garfield frozen $
  5.  
  6. ##########
  7. # Procedure: XFInfoProcedures
  8. # Description: show the selected information
  9. # Arguments: xfTarget - put current selection to this entry
  10. #            xfSelectProc - procedure name to select initially
  11. # Returns: none
  12. # Sideeffects: none
  13. ##########
  14. proc XFInfoProcedures {xfTarget {xfSelectProc ""}} {
  15.   global xfBind
  16.   global xfConf
  17.   global xfStatus
  18.  
  19.   XFEditSetStatus "Calling procedure list..."
  20.  
  21.   # building widget structure
  22.   XFTmpltToplevel .xfInfoProc 400x500 {XF procedures}
  23.  
  24.   XFTmpltFrame .xfInfoProc.frame1 0
  25.  
  26.   button .xfInfoProc.frame1.load \
  27.     -text {Load} \
  28.     -command {XFVersionLoad procs .xfInfoProc}
  29.  
  30.   button .xfInfoProc.frame1.save \
  31.     -text {Save} \
  32.     -command {
  33.       set xfCurrentName ""
  34.       if {"[.xfInfoProc.current.current get]" != ""} {
  35.         set xfCurrentName [.xfInfoProc.current.current get]
  36.       } {
  37.         if {"[.xfInfoProc.procs.procs curselect]" != ""} {
  38.           set xfCurrentName \
  39.             [.xfInfoProc.procs.procs get [.xfInfoProc.procs.procs curselect]]
  40.         }
  41.       }
  42.       if {"$xfCurrentName" != ""} {
  43.         if {"[info procs $xfCurrentName]" != ""} {
  44.           if {![XFMiscCorrectLevel procshow [info body $xfCurrentName]]} {
  45.             XFProcError "Invisible procedures cannot be saved"
  46.             return
  47.           }
  48.         }
  49.         XFVersionSave $xfCurrentName .xfInfoProc
  50.       }}
  51.  
  52.   button .xfInfoProc.frame1.add \
  53.     -text {Insert} \
  54.     -command {
  55.       set xfCurrentName ""
  56.       if {"[.xfInfoProc.current.current get]" != ""} {
  57.         set xfCurrentName [.xfInfoProc.current.current get]
  58.       }
  59.       if {"$xfCurrentName" != ""} {
  60.         if {"[info procs $xfCurrentName]" != ""} {
  61.           if {![XFMiscCorrectLevel procshow [info body $xfCurrentName]]} {
  62.             XFProcError "Invisible procedures with that name exitst"
  63.             return
  64.           }
  65.         }
  66.         XFInfoProceduresSet $xfCurrentName
  67.       }}
  68.  
  69.   button .xfInfoProc.frame1.edit \
  70.     -text {Edit} \
  71.     -command {
  72.       set xfCurrentName ""
  73.       if {"[.xfInfoProc.current.current get]" != ""} {
  74.         set xfCurrentName [.xfInfoProc.current.current get]
  75.       } {
  76.         if {"[.xfInfoProc.procs.procs curselect]" != ""} {
  77.           set xfCurrentName \
  78.             [.xfInfoProc.procs.procs get [.xfInfoProc.procs.procs curselect]]
  79.         }
  80.       }
  81.       if {"$xfCurrentName" != ""} {
  82.         if {"[info procs $xfCurrentName]" != ""} {
  83.           if {![XFMiscCorrectLevel procshow [info body $xfCurrentName]]} {
  84.             XFProcError "Invisible procedures cannot be edited"
  85.             return
  86.           }
  87.         }
  88.         XFInfoProceduresSet $xfCurrentName
  89.       }}
  90.  
  91.   button .xfInfoProc.frame1.rename \
  92.     -text {Rename} \
  93.     -command {
  94.       set xfCurrentName ""
  95.       if {"[.xfInfoProc.current.current get]" != ""} {
  96.         set xfCurrentName [.xfInfoProc.current.current get]
  97.       } {
  98.         if {"[.xfInfoProc.procs.procs curselect]" != ""} {
  99.           set xfCurrentName \
  100.             [.xfInfoProc.procs.procs get [.xfInfoProc.procs.procs curselect]]
  101.         }
  102.       }
  103.       set xfNewName [XFProcInputBoxOne "New procedure name:" 300x100 "XF new procedure name"]
  104.       if {"$xfCurrentName" != "" && "$xfNewName" != "" &&
  105.           "$xfCurrentName" != "$xfNewName"} {
  106.         if {"[info procs $xfCurrentName]" != ""} {
  107.           if {![XFMiscCorrectLevel procshow [info body $xfCurrentName]]} {
  108.             XFProcError "Invisible procedures cannot be renamed"
  109.             return
  110.           }
  111.         }
  112.         if {"[info procs $xfNewName]" != ""} {
  113.           if {![XFMiscCorrectLevel procshow [info body $xfNewName]]} {
  114.             XFProcError "Invisible procedures with that name exists"
  115.             return
  116.           }
  117.         }
  118.         catch "rename $xfCurrentName $xfNewName"
  119.         .xfInfoProc.current.current delete 0 end
  120.         catch "XFMiscSetText .xfInfoProc.frame4.args.args \"\""
  121.         catch "XFMiscSetText .xfInfoProc.frame4.text.text \"\""
  122.         XFMiscSetInfo procs .xfInfoProc.procs.procs 1
  123.       }}
  124.  
  125.   button .xfInfoProc.frame1.remove \
  126.     -text {Remove} \
  127.     -command {
  128.       set xfCurrentName ""
  129.       if {"[.xfInfoProc.current.current get]" != ""} {
  130.         set xfCurrentName [.xfInfoProc.current.current get]
  131.       } {
  132.         if {"[.xfInfoProc.procs.procs curselect]" != ""} {
  133.           set xfCurrentName \
  134.             [.xfInfoProc.procs.procs get [.xfInfoProc.procs.procs curselect]]
  135.         }
  136.       }
  137.       if {"$xfCurrentName" != ""} {
  138.         if {"[info procs $xfCurrentName]" != ""} {
  139.           if {![XFMiscCorrectLevel procshow [info body $xfCurrentName]]} {
  140.             XFProcError "Invisible procedures cannot be removed"
  141.             return
  142.           }
  143.         }
  144.         catch "rename $xfCurrentName {}"
  145.         XFMiscSetText .xfInfoProc.current.current ""
  146.         catch "XFMiscSetText .xfInfoProc.frame4.args.args \"\""
  147.         catch "XFMiscSetText .xfInfoProc.frame4.text.text \"\""
  148.         XFMiscSetInfo procs .xfInfoProc.procs.procs 1
  149.       }}
  150.  
  151.   button .xfInfoProc.frame1.hide \
  152.     -text {Hide} \
  153.     -command {
  154.       set xfCurrentName ""
  155.       if {"[.xfInfoProc.current.current get]" != ""} {
  156.         set xfCurrentName [.xfInfoProc.current.current get]
  157.       } {
  158.         if {"[.xfInfoProc.procs.procs curselect]" != ""} {
  159.           set xfCurrentName \
  160.             [.xfInfoProc.procs.procs get [.xfInfoProc.procs.procs curselect]]
  161.         }
  162.       }
  163.       if {"$xfCurrentName" != ""} {
  164.         XFMiscHandleHiding procs .xfInfoProc.procs.procs $xfCurrentName
  165.       }}
  166.  
  167.   button .xfInfoProc.frame1.clear \
  168.     -text {Clear} \
  169.     -command {
  170.       .xfInfoProc.current.current delete 0 end
  171.       catch "XFMiscSetText .xfInfoProc.frame4.args.args \"\""
  172.       catch "XFMiscSetText .xfInfoProc.frame4.text.text \"\""}
  173.  
  174.   button .xfInfoProc.frame1.help \
  175.     -text {Help} \
  176.     -command {
  177.       set xfCurrentName ""
  178.       if {"[.xfInfoProc.current.current get]" != ""} {
  179.         set xfCurrentName [.xfInfoProc.current.current get]
  180.       } {
  181.         if {"[.xfInfoProc.procs.procs curselect]" != ""} {
  182.           set xfCurrentName \
  183.             [.xfInfoProc.procs.procs get [.xfInfoProc.procs.procs curselect]]
  184.         }
  185.       }
  186.       XFProcHelpHelp * commands $xfCurrentName}
  187.  
  188.   XFTmpltFrame .xfInfoProc.frame2 0
  189.  
  190.   radiobutton .xfInfoProc.frame2.include \
  191.     -text {Include} \
  192.     -command {
  193.       global xfStatus
  194.       set xfStatus(includeExclude) 1
  195.       set xfStatus(includeExcludeString) \
  196.         [.xfInfoProc.pattern.pattern get]
  197.       XFMiscSetInfo procs .xfInfoProc.procs.procs 1}
  198.  
  199.   radiobutton .xfInfoProc.frame2.exclude \
  200.     -text {Exclude} \
  201.     -command {
  202.       global xfStatus
  203.       set xfStatus(includeExclude) 0
  204.       set xfStatus(includeExcludeString) \
  205.         [.xfInfoProc.pattern.pattern get]
  206.       XFMiscSetInfo procs .xfInfoProc.procs.procs 1}
  207.  
  208.   if {$xfStatus(includeExclude)} {
  209.     .xfInfoProc.frame2.include select
  210.   } {
  211.     .xfInfoProc.frame2.exclude select
  212.   }
  213.  
  214.   XFTmpltFrame .xfInfoProc.frame3 0
  215.  
  216.   button .xfInfoProc.frame3.ok \
  217.     -text {OK} \
  218.     -command "
  219.       XFInfoProceduresTest \"$xfTarget\""
  220.  
  221.   checkbutton .xfInfoProc.frame3.hiddens \
  222.     -command {
  223.       global xfStatus
  224.       if {$xfStatus(hiddenProcs)} {
  225.         .xfInfoProc.frame1.hide config -text "Unhide"
  226.         .xfInfoProc.frame1.load config -state disabled
  227.         .xfInfoProc.frame1.save config -state disabled
  228.         .xfInfoProc.frame1.add config -state disabled
  229.         .xfInfoProc.frame1.edit config -state disabled
  230.         .xfInfoProc.frame1.rename config -state disabled
  231.         .xfInfoProc.frame1.remove config -state disabled
  232.         .xfInfoProc.frame1.clear config -state disabled
  233.         .xfInfoProc.frame1.help config -state disabled
  234.         XFMiscSetInfo hiddenprocs .xfInfoProc.procs.procs 1
  235.       } {
  236.         .xfInfoProc.frame1.hide config -text "Hide"
  237.         .xfInfoProc.frame1.load config -state normal
  238.         .xfInfoProc.frame1.save config -state normal
  239.         .xfInfoProc.frame1.add config -state normal
  240.         .xfInfoProc.frame1.edit config -state normal
  241.         .xfInfoProc.frame1.rename config -state normal
  242.         .xfInfoProc.frame1.remove config -state normal
  243.         .xfInfoProc.frame1.clear config -state normal
  244.         .xfInfoProc.frame1.help config -state normal
  245.         XFMiscSetInfo procs .xfInfoProc.procs.procs 1
  246.       }
  247.       .xfInfoProc.procs.procs select from 0
  248.       .xfInfoProc.procs.procs select to 0
  249.       XFMiscSetText .xfInfoProc.current.current ""
  250.       if {"[info commands .xfInfoProc.frame4.args.args]" != ""} {
  251.         XFMiscSetText .xfInfoProc.frame4.args.args ""
  252.         XFMiscSetText .xfInfoProc.frame4.text.text ""
  253.       }} \
  254.     -text {Show hidden} \
  255.     -variable xfStatus(hiddenProcs) \
  256.     -onvalue 1 \
  257.     -offvalue 0
  258.  
  259.   button .xfInfoProc.frame3.rescan \
  260.     -text {Rescan} \
  261.     -command "XFMiscSetInfo procs .xfInfoProc.procs.procs 1"
  262.  
  263.   checkbutton .xfInfoProc.frame3.rescanperm \
  264.     -text {Rescan permanently} \
  265.     -variable xfStatus(rescanInfo) \
  266.     -onvalue 1 \
  267.     -offvalue 0
  268.  
  269.   XFTmpltListbox .xfInfoProc procs
  270.  
  271.   XFTmpltLabledEntry .xfInfoProc current {Name:} {}
  272.  
  273.   if {"$xfConf(externalEditor)" == ""} {
  274.     XFTmpltFrame .xfInfoProc.frame4 0
  275.  
  276.     XFTmpltTextLong .xfInfoProc.frame4 text 0 "" 0
  277.     XFMiscSetTextHeight .xfInfoProc.frame4.text.text 10
  278.  
  279.     XFTmpltLabledEntry .xfInfoProc.frame4 args {Parameters:} {}
  280.  
  281.     pack append .xfInfoProc.frame4 \
  282.                 .xfInfoProc.frame4.args {top frame center fill} \
  283.                 .xfInfoProc.frame4.text {top frame center fill expand}
  284.   }
  285.  
  286.   XFTmpltLabledEntry .xfInfoProc pattern {Pattern:} \
  287.     $xfStatus(includeExcludeString)
  288.  
  289.   if {"$xfSelectProc" != ""} {
  290.     if {"[info procs $xfSelectProc]" == ""} {
  291.       catch "proc $xfSelectProc {} {}"
  292.     }
  293.   }
  294.  
  295.   XFMiscSetInfo procs .xfInfoProc.procs.procs 1
  296.  
  297.   if {"$xfSelectProc" == ""} {
  298.     catch ".xfInfoProc.procs.procs get 0" xfSelectProc
  299.   } {
  300.     set xfCounter 0
  301.     set xfLast [.xfInfoProc.procs.procs size]
  302.     if {"$xfLast" == "none"} {
  303.       set xfLast -1
  304.     }
  305.     while {$xfCounter < $xfLast} {
  306.       if {"$xfSelectProc" == "[.xfInfoProc.procs.procs get $xfCounter]"} {
  307.         .xfInfoProc.procs.procs select from $xfCounter
  308.         .xfInfoProc.procs.procs select to $xfCounter
  309.         break
  310.       }
  311.       incr xfCounter
  312.     }
  313.   }
  314.  
  315.   XFMiscSetText .xfInfoProc.current.current $xfSelectProc
  316.  
  317.   # bindings
  318.   if {"$xfTarget" != ""} {
  319.     bind .xfInfoProc.procs.procs $xfBind(select1) "
  320.       if {\[%W size\] > 0} {
  321.         XFBindSelectOneIntoEntry %W %y .xfInfoProc.current.current
  322.         XFMiscInsertTextIntoWidget \"$xfTargetP\" \
  323.           \[.xfInfoProc.current.current get\]
  324.         destroy .xfInfoProc
  325.       }"
  326.   }
  327.  
  328.   if {"$xfConf(externalEditor)" == ""} {
  329.     # set text fields
  330.     set xfArguments ""
  331.     set xfBodyList ""
  332.     if {"$xfSelectProc" != "" && "[info proc $xfSelectProc]" != ""} {
  333.       set xfBodyList [string trimright [info body $xfSelectProc]]
  334.       set xfArgList [info args $xfSelectProc]
  335.       foreach xfCounter $xfArgList {
  336.         if {[info default $xfSelectProc $xfCounter xfDefault]} {
  337.           append xfArguments " \{$xfCounter \"$xfDefault\"\}"
  338.         } {
  339.           append xfArguments " $xfCounter"
  340.         }
  341.       }
  342.     }
  343.     XFMiscSetText .xfInfoProc.frame4.args.args $xfArguments
  344.     if {[string index $xfBodyList 0] == "\n"} {
  345.       XFMiscSetText .xfInfoProc.frame4.text.text \
  346.         [string range $xfBodyList 1 end]
  347.     } {
  348.       XFMiscSetText .xfInfoProc.frame4.text.text $xfBodyList
  349.     }
  350.   }
  351.  
  352.   bind .xfInfoProc.pattern.pattern <Return> {
  353.     global xfStatus
  354.     set xfStatus(includeExcludeString) \
  355.       [.xfInfoProc.pattern.pattern get]
  356.     XFMiscSetInfo procs .xfInfoProc.procs.procs 1}
  357.  
  358.   bind .xfInfoProc.procs.procs <ButtonPress-1> {
  359.     XFInfoProceduresSelect %W %y}
  360.   bind .xfInfoProc.procs.procs <Button1-Motion> {
  361.     XFInfoProceduresSelect %W %y}
  362.   bind .xfInfoProc.procs.procs <Shift-Button1-Motion> {
  363.     XFInfoProceduresSelect %W %y}
  364.   bind .xfInfoProc.procs.procs <Shift-ButtonPress-1> {
  365.     XFInfoProceduresSelect %W %y}
  366.  
  367.   # packing
  368.   pack append .xfInfoProc.frame1 \
  369.               .xfInfoProc.frame1.load {left fill expand} \
  370.               .xfInfoProc.frame1.save {left fill expand} \
  371.               .xfInfoProc.frame1.add {left fill expand} \
  372.               .xfInfoProc.frame1.edit {left fill expand} \
  373.               .xfInfoProc.frame1.rename {left fill expand} \
  374.               .xfInfoProc.frame1.remove {left fill expand} \
  375.               .xfInfoProc.frame1.hide {left fill expand} \
  376.               .xfInfoProc.frame1.clear {left fill expand} \
  377.               .xfInfoProc.frame1.help {left fill expand}
  378.   pack append .xfInfoProc.frame2 \
  379.               .xfInfoProc.frame2.include {left fill expand} \
  380.               .xfInfoProc.frame2.exclude {left fill expand}
  381.   pack append .xfInfoProc.frame3 \
  382.               .xfInfoProc.frame3.ok {left fill expand} \
  383.               .xfInfoProc.frame3.hiddens {left fill expand} \
  384.               .xfInfoProc.frame3.rescan {left fill expand} \
  385.               .xfInfoProc.frame3.rescanperm {left fill expand}
  386.   if {"$xfConf(externalEditor)" == ""} {
  387.     pack append .xfInfoProc \
  388.                 .xfInfoProc.frame3 {bottom fill} \
  389.                 .xfInfoProc.frame2 {bottom fill} \
  390.                 .xfInfoProc.pattern {bottom fill} \
  391.                 .xfInfoProc.frame1 {bottom fill} \
  392.                 .xfInfoProc.frame4 {bottom fill expand} \
  393.                 .xfInfoProc.current {bottom fill} \
  394.                 .xfInfoProc.procs {top expand fill}
  395.  
  396.     XFBindFormConnect {.xfInfoProc.current .xfInfoProc.frame4.args .xfInfoProc.frame4.text}
  397.   } {
  398.     pack append .xfInfoProc \
  399.                 .xfInfoProc.frame3 {bottom fill} \
  400.                 .xfInfoProc.frame2 {bottom fill} \
  401.                 .xfInfoProc.pattern {bottom fill} \
  402.                 .xfInfoProc.frame1 {bottom fill} \
  403.                 .xfInfoProc.current {bottom fill} \
  404.                 .xfInfoProc.procs {top expand fill}
  405.  
  406.     XFBindFormConnect {.xfInfoProc.current}
  407.   }
  408.   XFEditSetStatus "Calling procedure list...done"
  409. }
  410.  
  411. ##########
  412. # Procedure: XFInfoProceduresSelect
  413. # Description: select a procedure
  414. # Arguments: xfProcName - the procedure name
  415. # Returns: none
  416. # Sideeffects: none
  417. ##########
  418. proc XFInfoProceduresSelect {xfW xfY} {
  419.   global xfConf
  420.   global xfStatus
  421.  
  422.   if {[$xfW size] > 0} {
  423.     XFBindSelectOneIntoEntry $xfW $xfY .xfInfoProc.current.current
  424.     set xfStatus(procIndex) [$xfW curselect]
  425.     set xfStatus(procName) [.xfInfoProc.current.current get]
  426.     if {"$xfConf(externalEditor)" == ""} {
  427.       # set text fields
  428.       set xfSelectProc $xfStatus(procName)
  429.       set xfArguments ""
  430.       set xfBodyList ""
  431.       if {"$xfSelectProc" != "" && "[info proc $xfSelectProc]" != ""} {
  432.         set xfBodyList [string trimright [info body $xfSelectProc]]
  433.         set xfArgList [info args $xfSelectProc]
  434.         foreach xfCounter $xfArgList {
  435.           if {[info default $xfSelectProc $xfCounter xfDefault]} {
  436.             append xfArguments " \{$xfCounter \"$xfDefault\"\}"
  437.           } {
  438.             append xfArguments " $xfCounter"
  439.           }
  440.         }
  441.       }
  442.       XFMiscSetText .xfInfoProc.frame4.args.args $xfArguments
  443.       if {[string index $xfBodyList 0] == "\n"} {
  444.         XFMiscSetText .xfInfoProc.frame4.text.text \
  445.           [string range $xfBodyList 1 end]
  446.       } {
  447.         XFMiscSetText .xfInfoProc.frame4.text.text $xfBodyList
  448.       }
  449.     }
  450.   }
  451. }
  452.  
  453. ##########
  454. # Procedure: XFInfoProceduresSet
  455. # Description: insert the current procedure
  456. # Arguments: xfProcName - the procedure name
  457. # Returns: none
  458. # Sideeffects: none
  459. ##########
  460. proc XFInfoProceduresSet {xfProcName} {
  461.   global xfConf
  462.  
  463.   if {"$xfConf(externalEditor)" == ""} {
  464.     set xfArgs [.xfInfoProc.frame4.args.args get]
  465.     set xfBody [XFMiscGetText .xfInfoProc.frame4.text.text]
  466.     if {"$xfProcName" != ""} {
  467.       if {[catch "proc $xfProcName {$xfArgs} {\n$xfBody}" xfResult]} {
  468.         XFProcError "$xfResult"
  469.       } {
  470.         XFMiscSetInfo procs .xfInfoProc.procs.procs 0
  471.       }
  472.     } {
  473.       XFMiscSetInfo procs .xfInfoProc.procs.procs 0
  474.     }
  475.   } {
  476.     # call external editor
  477.     XFMiscCallExternalEditor procs $xfProcName
  478.   }
  479. }
  480.  
  481. ##########
  482. # Procedure: XFInfoProceduresTest
  483. # Description: test the current procedure
  484. # Arguments: xfTarget - put current selection to this entry
  485. # Returns: none
  486. # Sideeffects: none
  487. ##########
  488. proc XFInfoProceduresTest {xfTarget} {
  489.  
  490.   set xfProcName [.xfInfoProc.current.current get]
  491.  
  492.   if {"$xfProcName" != "" &&
  493.       "[info commands .xfInfoProc.frame4.args.args]" != "" &&
  494.       "[info commands .xfInfoProc.frame4.text.text]" != ""} {
  495.     set xfArgs [string trim [.xfInfoProc.frame4.args.args get]]
  496.     set xfBody [string trim [XFMiscGetText .xfInfoProc.frame4.text.text]]
  497.     set xfArgList [info args $xfProcName]
  498.     set xfCurArgs ""
  499.     foreach xfCounter $xfArgList {
  500.       if {[info default $xfProcName $xfCounter xfDefault]} {
  501.         append xfCurArgs " \{$xfCounter \"$xfDefault\"\}"
  502.       } {
  503.         append xfCurArgs " $xfCounter"
  504.       }
  505.     }
  506.     if {"[info procs $xfProcName]" != ""} {
  507.       if {"[string trim $xfCurArgs]" != "$xfArgs" ||
  508.           "[string trim [info body $xfProcName]]" != "$xfBody"} {
  509.         if {[XFProcYesNo "Modify the currently edited procedure ?"]} {
  510.           XFInfoProceduresSet $xfProcName
  511.         }
  512.       }
  513.     } { 
  514.       if {"$xfBody" != ""} {
  515.         if {[XFProcYesNo "Insert the currently edited procedure ?"]} {
  516.           XFInfoProceduresSet $xfProcName
  517.         }
  518.       }
  519.     }
  520.   }
  521.  
  522.   if {"$xfTarget" != ""} {
  523.     XFMiscInsertTextIntoWidget $xfTarget [.xfInfoProc.current.current get]
  524.   }
  525.   destroy .xfInfoProc
  526. }
  527.  
  528. # eof
  529.  
  530.