Changeset 322


Ignore:
Timestamp:
Dec 4, 2009 5:04:07 PM (11 years ago)
Author:
toby
Message:

# on 2000/10/12 21:36:23, toby did:
Add www help support
improve formatting of help box
at catch statements to focus and grab calls
save grab in pleasewait and restore in donewait
Add link arg in ShowBigMessage? & -helplink to MyMessageBox?

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/gsascmds.tcl

    • Property rcs:date changed from 2000/07/28 20:28:25 to 2000/10/12 21:36:23
    • Property rcs:lines changed from +1 -1 to +231 -80
    • Property rcs:rev changed from 1.23 to 1.24
    r249 r322  
    118118}
    119119
    120 # get a value in a modal toplevel
     120# get a value in a modal dialog
    121121proc getstring {what "chars 40" "quit 1" "initvalue {}"} {
    122122    global expgui expmap
     
    124124    catch {destroy $w}
    125125    toplevel $w -bg beige
     126    bind $w <Key-F1> "MakeWWWHelp expguierr.html Input[lindex $what 0]"
    126127    wm title $w "Input $what"
    127128    set expgui(temp) {}
     
    135136
    136137    set expgui(temp) $initvalue
    137     pack [frame $w.b] -side top
     138    pack [frame $w.b -bg beige] -side top -fill x -expand yes
    138139    pack [button $w.b.2 -text Set -command "destroy $w"] -side left
    139140    if $quit {
     
    142143    }
    143144    bind $w <Return> "destroy $w"
     145    pack [button $w.b.help -text Help -bg yellow \
     146            -command "MakeWWWHelp expguierr.html Input[lindex $what 0]"] \
     147            -side right
    144148
    145149    # force the window to stay on top
     
    226230    catch {destroy $frm}
    227231    toplevel $frm
    228     wm title $frm "Command Help"
    229     pack [message $frm.0 -text \
    230             "Click on an entry below to see help on a GSAS command" ] \
    231             -side top
    232     pack [frame $frm.a -width 20 -height 15] \
    233             -side top -expand yes -fill both
    234     pack [message $frm.help -textvariable helpmsg -relief groove] \
    235             -side left -fill both -expand yes
     232    wm title $frm "Help Summary"
     233    grid [label $frm.0 -text \
     234            "Click on an entry below to see information on the EXPGUI/GSAS topic" ] \
     235        -column 0 -columnspan 4 -row 0
     236#    grid [message $frm.help -textvariable helpmsg -relief groove] \
     237#          -column 0 -columnspan 4 -row 2 -sticky nsew
     238    grid [text $frm.help -relief groove -bg beige -width 0\
     239            -height 0 -wrap word -yscrollcommand "$frm.escroll set"] \
     240           -column 0 -columnspan 3 -row 2 -sticky nsew
     241    grid [scrollbar $frm.escroll -command "$frm.help yview"] \
     242            -column 4 -row 2 -sticky nsew
     243    grid rowconfig $frm 1 -weight 1 -minsize 50
     244    grid rowconfig $frm 2 -weight 2 -pad 20 -minsize 150
     245    grid columnconfig $frm 0 -weight 1
     246    grid columnconfig $frm 2 -weight 1
    236247    set lst [array names expgui_helplist]
    237     listbox $frm.a.cmds -relief raised -bd 2 -yscrollcommand \
    238             "$frm.a.scroll set" -height 15 -width 0
    239     scrollbar $frm.a.scroll -command "$frm.a.cmds yview"
    240     foreach item [lsort $lst] {
    241         $frm.a.cmds insert end $item
    242     }
    243     if {[$frm.a.cmds curselection] == ""} {$frm.a.cmds selection set 0}
    244     button $frm.a.done -text Done -command "destroy $frm"
    245     bind $frm.a.cmds <ButtonRelease-1> \
    246             "+set helpmsg \$expgui_helplist(\[$frm.a.cmds get \[$frm.a.cmds curselection\]\])"
    247     pack $frm.a.scroll -side left -fill y
    248     pack $frm.a.cmds -side left -expand yes -anchor w
    249     pack $frm.a.done -side right -expand no
     248    grid [listbox $frm.cmds -relief raised -bd 2 \
     249            -yscrollcommand "$frm.scroll set" \
     250            -height 8 -width 0 -exportselection 0 ] \
     251            -column 0 -row 1 -sticky nse
     252    grid [scrollbar $frm.scroll -command "$frm.cmds yview"] \
     253            -column 1 -row 1 -sticky nsew
     254    foreach item [lsort -dictionary $lst] {
     255        $frm.cmds insert end $item
     256    }
     257    if {[$frm.cmds curselection] == ""} {$frm.cmds selection set 0}
     258    grid [button $frm.done -text Done -command "destroy $frm"] \
     259            -column 2 -row 1
     260#    bind $frm.cmds <ButtonRelease-1> \
     261#           "+set helpmsg \$expgui_helplist(\[$frm.cmds get \[$frm.cmds curselection\]\])"
     262    bind $frm.cmds <ButtonRelease-1> \
     263            "+$frm.help config -state normal; $frm.help delete 0.0 end; \
     264             $frm.help insert end \$expgui_helplist(\[$frm.cmds get \[$frm.cmds curselection\]\]); \
     265             $frm.help config -state disabled"
     266
    250267    # get the size of the window and expand the message boxes to match
    251     update
    252     set width [lindex [split [wm geometry $frm] x+] 0]
    253     $frm.0 config -width $width
    254     $frm.help config -width $width
    255     # waitdone $frm
    256 }
    257 
    258 # compute the composition for each phase and display in a toplevel
     268#    update
     269#    $frm.help config -width [winfo width $frm.help ]
     270}
     271
     272# compute the composition for each phase and display in a dialog
    259273proc composition {} {
    260274    global expmap expgui
     
    291305    catch {destroy .comp}
    292306    toplevel .comp
     307    bind .comp <Key-F1> "MakeWWWHelp expguierr.html Composition"
    293308    wm title .comp Composition
    294309    pack [label .comp.results -text $text \
    295310            -font $expgui(coordfont) -justify left] -side top
    296     pack [frame .comp.box]  -side top
     311    pack [frame .comp.box]  -side top -expand y -fill x
    297312    pack [button .comp.box.1 -text Close -command "destroy .comp"] -side left
     313
    298314    set lstnam [string toupper [file tail [file rootname $expgui(expfile)].LST]]
    299315    pack [button .comp.box.2 -text "Save to $lstnam file" \
    300316            -command "writelst [list $text] ; destroy .comp"] -side left
     317    pack [button .comp.box.help -text Help -bg yellow \
     318            -command "MakeWWWHelp expguierr.html Composition"] \
     319            -side right
    301320}
    302321
     
    318337    toplevel .export
    319338    wm title .export "Export coordinates"
     339    bind .export <Key-F1> "MakeWWWHelp expguierr.html ExportMSI"
    320340    pack [label .export.lbl -text "Export coordinates in MSI .xtl format"\
    321341            ] -side top -anchor center
     
    333353    pack [entry .export.sg.2 -textvariable expgui(export_sg) -width 8] -side left
    334354    pack [checkbutton .export.sg.3 -variable expgui(export_orig) -text "Origin 2"] -side left
    335     pack [frame .export.but] -side top
     355    pack [frame .export.but] -side top -fill x -expand yes
    336356    if {[llength $expmap(phaselist)] > 0} {
    337357        pack [button .export.but.1 -text Write -command writextl] -side left
     
    339359    }
    340360    pack [button .export.but.2 -text Quit -command "destroy .export"] -side left
     361    pack [button .export.but.help -text Help -bg yellow \
     362            -command "MakeWWWHelp expguierr.html ExportMSI"] \
     363            -side right
     364    # force the window to stay on top
     365    putontop .export
     366    afterputontop
    341367}
    342368
     
    451477    toplevel $frm
    452478    wm title $frm "Convert File"
     479    bind $frm <Key-F1> "MakeWWWHelp expguierr.html ConvertUnix"
    453480
    454481    pack [frame [set frm0 $frm.0] -bd 2 -relief groove] \
     
    461488            -padx 3 -pady 3 -side left
    462489    pack [label $frmB.0 -text "Enter an output file"] -side top -anchor center
    463     pack [frame [set frmC $frm.3] ] -padx 3 -pady 3 -side top
     490    pack [frame [set frmC $frm.3] ] -padx 3 -pady 3 -side top -fill x -expand y
    464491
    465492    pack [label $frm0.1 -text "Convert to:"] -side top -anchor center
     
    475502    pack [button $frmC.b -text Convert -command "valid_conv_unix"] -side left
    476503    pack [button $frmC.q -text Quit -command "set infile(done) 1"] -side left
    477 
     504    pack [button $frmC.help -text Help -bg yellow \
     505            -command "MakeWWWHelp expguierr.html ConvertUnix"] \
     506            -side right
    478507   
    479508    unixcnvbox $frmA infile 1
     
    638667    toplevel $frm
    639668    wm title $frm "Convert File"
     669    bind $frm <Key-F1> "MakeWWWHelp expguierr.html ConvertWin"
    640670    pack [frame [set frmA $frm.1] -bd 2 -relief groove] -padx 3 -pady 3 -side left
    641     pack [frame [set frmC $frm.3] ] -padx 3 -pady 3 -side left
     671    pack [frame [set frmC $frm.3] ] -padx 3 -pady 3 \
     672            -side left -fill y -expand yes
     673    pack [button $frmC.help -text Help -bg yellow \
     674            -command "MakeWWWHelp expguierr.html ConvertWin"] -side top
     675    pack [button $frmC.q -text Quit -command "destroy $frm"] -side bottom
    642676    pack [button $frmC.b -text Convert -command "ValidWinCnv $frm"] \
    643             -side top
    644     pack [button $frmC.q -text Quit -command "destroy $frm"] -side top
     677            -side bottom
    645678    pack [label $frmA.0 -text "Select a file to convert"] -side top -anchor center
    646679    winfilebox $frm
     
    11981231
    11991232    global makenew
    1200     set makenew(OldFocus) [focus]
    1201     catch {
    1202         set makenew(OldGrab) [grab current $w]
    1203         if {$makenew(OldGrab) != ""} {
    1204             set makenew(GrabStatus) [grab status $makenew(OldGrab)]
    1205         }
    1206         grab $w
    1207     }
     1233    set makenew(OldGrab) ""
     1234    catch {set makenew(OldFocus) [focus]}
     1235    catch {set makenew(OldGrab) [grab current $w]}
     1236    catch {grab $w}
    12081237}
    12091238
     
    12121241    global makenew
    12131242    catch {focus $makenew(OldFocus)}
    1214     if {$makenew(OldGrab) != ""} {
    1215         catch {
    1216             if {$makenew(GrabStatus) == "global"} {
    1217                 grab -global $makenew(OldGrab)
    1218             } else {
    1219                 grab $makenew(OldGrab)
    1220             }
    1221         }
    1222     }
    1223 }
    1224 
    1225 proc ShowBigMessage {win labeltext msg "optionlist OK"} {
     1243    catch {
     1244        if {$makenew(OldGrab) != ""} {
     1245            grab $makenew(OldGrab)
     1246        }
     1247    }
     1248}
     1249
     1250proc ShowBigMessage {win labeltext msg "optionlist OK" "link {}"} {
    12261251    catch {destroy $win}
    12271252    toplevel $win
    12281253
    1229     # grab focus, etc.
    12301254    pack [label $win.l1 -text $labeltext] -side top
    12311255    pack [frame $win.f1] -side top -expand yes -fill both
     
    12611285                -command "set makenew(result) $i; destroy $win" -text $item] -side left
    12621286    }
     1287    if {$link != ""} {
     1288        pack [button $win.help -text Help -bg yellow \
     1289            -command "MakeWWWHelp $link"] \
     1290            -side right
     1291        bind $win <Key-F1> "MakeWWWHelp $link"
     1292    }
    12631293    putontop $win
    12641294    tkwait window $win
     
    13001330        {-title "" "" " "}
    13011331        {-type "" "" "ok"}
     1332        {-helplink "" "" ""}
    13021333    }
    13031334
     
    14071438    frame $w.top
    14081439    pack $w.top -side top -fill both -expand 1
     1440    if {$data(-helplink) != ""} {
     1441#       frame $w.help
     1442#       pack $w.help -side top -fill both
     1443        pack [button $w.top.1 -text Help -bg yellow \
     1444                -command "MakeWWWHelp $data(-helplink)"] \
     1445                -side right -anchor ne
     1446        bind $w <Key-F1> "MakeWWWHelp $data(-helplink)"
     1447    }
    14091448    if {[string compare $tcl_platform(platform) "macintosh"]} {
    14101449        $w.bot configure -relief raised -bd 1
     
    15171556    # 8. Set a grab and claim the focus too.
    15181557
    1519     set oldFocus [focus]
    1520     set oldGrab [grab current $w]
    1521     if {[string compare $oldGrab ""]} {
    1522         set grabStatus [grab status $oldGrab]
    1523     }
    1524     grab $w
    1525     if {[string compare $data(-default) ""]} {
    1526         focus $w.$data(-default)
    1527     } else {
    1528         focus $w
     1558    catch {set oldFocus [focus]}
     1559    catch {set oldGrab [grab current $w]}
     1560    catch {
     1561        grab $w
     1562        if {[string compare $data(-default) ""]} {
     1563            focus $w.$data(-default)
     1564        } else {
     1565            focus $w
     1566        }
    15291567    }
    15301568
     
    15381576    catch {focus $oldFocus}
    15391577    destroy $w
    1540     if {[string compare $oldGrab ""]} {
    1541       if {![string compare $grabStatus "global"]} {
    1542             grab -global $oldGrab
    1543         } else {
    1544             grab $oldGrab
    1545         }
    1546     }
     1578    catch {grab $oldGrab}
    15471579    return $tkPriv(button)
    15481580}
     
    15551587    catch {destroy $frm}
    15561588    toplevel $frm
     1589    bind $frm <Key-F1> "MakeWWWHelp expguierr.html DeleteHistoryRecords"
    15571590    if {[string trim $msg] == ""} {
    15581591        set msg "There are [CountHistory] history records"
     
    15671600    pack [checkbutton $frm.1.2 -text renumber -variable expgui(renumber)] -side top
    15681601    set expgui(renumber) 1
    1569     pack [frame $frm.2] -padx 3 -pady 3 -side left
     1602    pack [frame $frm.2] -padx 3 -pady 3 -side left -fill both -expand yes
     1603    pack [button $frm.2.help -text Help -bg yellow \
     1604            -command "MakeWWWHelp expguierr.html DeleteHistoryRecords"] -side top
     1605    pack [button $frm.2.4 -text Quit \
     1606            -command {destroy .history}] -side bottom
    15701607    pack [button $frm.2.3 -text OK \
    15711608            -command {
     
    15751612            destroy .history
    15761613        }
    1577     }] -side top
    1578     pack [button $frm.2.4 -text Quit \
    1579             -command {destroy .history}] -side top
     1614    }] -side bottom
    15801615    bind $frm <Return> "$frm.2.3 invoke"
    15811616   
     
    16891724    wm geom .msg +$x+$y
    16901725    wm deiconify .msg
    1691     focus .msg
    1692     grab .msg
     1726    global makenew
     1727    set makenew(OldGrab) ""
     1728    #catch {set makenew(OldFocus) [focus]}
     1729    catch {set makenew(OldGrab) [grab current .msg]}
     1730    catch {grab .msg}
     1731    catch {focus .msg}
    16931732    update
    16941733}
    16951734# clear the message
    16961735proc donewait {} {
     1736    global makenew
     1737    catch {focus $makenew(OldFocus)}
    16971738    catch {destroy .msg}
     1739    catch {
     1740        if {$makenew(OldGrab) != ""} {
     1741            grab $makenew(OldGrab)
     1742        }
     1743    }
    16981744}
    16991745
     
    18711917    pack [frame $w.c -bg beige] -side top -expand yes -fill both
    18721918    pack [frame $w.d -bg beige] -side top -expand yes -fill both
    1873     pack [button $w.d.2 -text Set -bg beige \
     1919    pack [button $w.d.2 -text Set \
    18741920            -command "SaveChangeProfileType $w.c $histlist $phaselist; destroy $w"\
    18751921            ] -side left
    1876     pack [button $w.d.3 -text Quit -bg beige \
     1922    pack [button $w.d.3 -text Quit \
    18771923            -command "destroy $w"] -side left
     1924    pack [button $w.d.help -text Help -bg yellow \
     1925            -command "MakeWWWHelp expgui5.html ChangeType"] \
     1926            -side right
     1927    bind $w <Key-F1> "MakeWWWHelp expgui5.html ChangeType"
    18781928    bind $w <Return> "destroy $w"
    18791929
     
    20572107    }
    20582108}
     2109
     2110# browse a WWW page with URL. The URL may contain a #anchor
     2111# On UNIX assume netscape is in the path or env(BROWSER) is loaded.
     2112# On Windows search the registry for a browser. Mac branch not tested.
     2113# This is taken from http://mini.net/cgi-bin/wikit/557.html with many thanks
     2114# to the contributers
     2115proc urlOpen {url} {
     2116    global env tcl_platform
     2117    switch $tcl_platform(platform) {
     2118        "unix" {
     2119            if {![info exists env(BROWSER)]} {
     2120                set progs [auto_execok netscape]
     2121                if {[llength $progs]} {
     2122                    set env(BROWSER) [list $progs]
     2123                }
     2124            }
     2125            if {[info exists env(BROWSER)]} {
     2126                if {[catch {exec $env(BROWSER) -remote openURL($url)}]} {
     2127                    # perhaps browser doesn't understand -remote flag
     2128                    if {[catch {exec $env(BROWSER) $url &} emsg]} {
     2129                        error "Error displaying $url in browser\n$emsg"
     2130                    }
     2131                }
     2132            } else {
     2133                tk_dialog .warn "No Browser" \
     2134                        "Could not find a browser. Netscape is not in path. Define environment variable BROWSER to be full path name of browser." \
     2135                        warn 0 OK
     2136            }
     2137        }
     2138        "windows" {
     2139            package require registry
     2140            # Look for the application under
     2141            # HKEY_CLASSES_ROOT
     2142            set root HKEY_CLASSES_ROOT
     2143
     2144            # Get the application key for HTML files
     2145            set appKey [registry get $root\\.html ""]
     2146
     2147            # Get the command for opening HTML files
     2148            set appCmd [registry get \
     2149                    $root\\$appKey\\shell\\open\\command ""]
     2150
     2151            # Substitute the HTML filename into the command for %1
     2152            regsub %1 $appCmd $htmlFile appCmd
     2153           
     2154            # Double up the backslashes for eval (below)
     2155            regsub -all {\\} $appCmd  {\\\\} appCmd
     2156           
     2157            # Invoke the command
     2158            eval exec $appCmd &
     2159        }
     2160        "macintosh" {
     2161            if {0 == [info exists env(BROWSER)]} {
     2162                set env(BROWSER) "Browse the Internet"
     2163            }
     2164            if {[catch {
     2165                AppleScript execute\
     2166                    "tell application \"$env(BROWSER)\"
     2167                         open url \"$url\"
     2168                     end tell
     2169                "} emsg]
     2170            } then {
     2171                error "Error displaying $url in browser\n$emsg"
     2172            }
     2173        }
     2174    }
     2175}
     2176
     2177proc NetHelp {file anchor localloc netloc} {
     2178    if {[file exists [file join $localloc $file]]} {
     2179        set url "file:[file join $localloc $file]"
     2180    } else {
     2181        set url "http://$netloc/$file"
     2182    }
     2183    catch {
     2184        pleasewait "Starting web browser..."
     2185        after 2000 donewait
     2186    }
     2187    if {$anchor != ""} {
     2188        append url # $anchor
     2189    }
     2190    urlOpen $url
     2191}
     2192
     2193proc MakeWWWHelp {"topic {}" "anchor {}"} {
     2194    global expgui
     2195    if {$topic == ""} {
     2196        foreach item $expgui(notebookpagelist) {
     2197            if {[lindex $item 0] == $expgui(pagenow)} {
     2198                NetHelp [lindex $item 5] [lindex $item 6] $expgui(docdir) ""
     2199                return
     2200            }
     2201        }
     2202        # this should not happen
     2203        NetHelp expgui.html "" $expgui(docdir) ""       
     2204    } elseif {$topic == "menu"} {
     2205        NetHelp expguic.html "" $expgui(docdir) ""
     2206    } else {
     2207        NetHelp $topic $anchor $expgui(docdir) ""
     2208    }
     2209}
Note: See TracChangeset for help on using the changeset viewer.