Changeset 322

Timestamp:

Dec 4, 2009 5:04:07 PM (14 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:

• trunk/gsascmds.tcl (modified) (26 diffs, 3 props)

trunk/gsascmds.tcl

@@ -118 +118 @@
 }
 
-# get a value in a modal toplevel 
+# get a value in a modal dialog
 proc getstring {what "chars 40" "quit 1" "initvalue {}"} {
     global expgui expmap
@@ -124 +124 @@
     catch {destroy $w}
     toplevel $w -bg beige
+    bind $w <Key-F1> "MakeWWWHelp expguierr.html Input[lindex $what 0]"
     wm title $w "Input $what"
     set expgui(temp) {}
@@ -135 +136 @@
 
     set expgui(temp) $initvalue
-    pack [frame $w.b] -side top
+    pack [frame $w.b -bg beige] -side top -fill x -expand yes
     pack [button $w.b.2 -text Set -command "destroy $w"] -side left
     if $quit {
@@ -142 +143 @@
     }
     bind $w <Return> "destroy $w"
+    pack [button $w.b.help -text Help -bg yellow \
+            -command "MakeWWWHelp expguierr.html Input[lindex $what 0]"] \
+            -side right
 
     # force the window to stay on top
@@ -226 +230 @@
     catch {destroy $frm}
     toplevel $frm
-    wm title $frm "Command Help"
-    pack [message $frm.0 -text \
-            "Click on an entry below to see help on a GSAS command" ] \
-            -side top
-    pack [frame $frm.a -width 20 -height 15] \
-            -side top -expand yes -fill both
-    pack [message $frm.help -textvariable helpmsg -relief groove] \
-            -side left -fill both -expand yes
+    wm title $frm "Help Summary"
+    grid [label $frm.0 -text \
+            "Click on an entry below to see information on the EXPGUI/GSAS topic" ] \
+        -column 0 -columnspan 4 -row 0
+#    grid [message $frm.help -textvariable helpmsg -relief groove] \
+#          -column 0 -columnspan 4 -row 2 -sticky nsew
+    grid [text $frm.help -relief groove -bg beige -width 0\
+            -height 0 -wrap word -yscrollcommand "$frm.escroll set"] \
+           -column 0 -columnspan 3 -row 2 -sticky nsew
+    grid [scrollbar $frm.escroll -command "$frm.help yview"] \
+            -column 4 -row 2 -sticky nsew
+    grid rowconfig $frm 1 -weight 1 -minsize 50
+    grid rowconfig $frm 2 -weight 2 -pad 20 -minsize 150
+    grid columnconfig $frm 0 -weight 1
+    grid columnconfig $frm 2 -weight 1
     set lst [array names expgui_helplist]
-    listbox $frm.a.cmds -relief raised -bd 2 -yscrollcommand \
-            "$frm.a.scroll set" -height 15 -width 0
-    scrollbar $frm.a.scroll -command "$frm.a.cmds yview"
-    foreach item [lsort $lst] {
-        $frm.a.cmds insert end $item 
-    }
-    if {[$frm.a.cmds curselection] == ""} {$frm.a.cmds selection set 0}
-    button $frm.a.done -text Done -command "destroy $frm"
-    bind $frm.a.cmds <ButtonRelease-1> \
-            "+set helpmsg \$expgui_helplist(\[$frm.a.cmds get \[$frm.a.cmds curselection\]\])"
-    pack $frm.a.scroll -side left -fill y 
-    pack $frm.a.cmds -side left -expand yes -anchor w
-    pack $frm.a.done -side right -expand no
+    grid [listbox $frm.cmds -relief raised -bd 2 \
+            -yscrollcommand "$frm.scroll set" \
+            -height 8 -width 0 -exportselection 0 ] \
+            -column 0 -row 1 -sticky nse 
+    grid [scrollbar $frm.scroll -command "$frm.cmds yview"] \
+            -column 1 -row 1 -sticky nsew
+    foreach item [lsort -dictionary $lst] {
+        $frm.cmds insert end $item 
+    }
+    if {[$frm.cmds curselection] == ""} {$frm.cmds selection set 0}
+    grid [button $frm.done -text Done -command "destroy $frm"] \
+            -column 2 -row 1
+#    bind $frm.cmds <ButtonRelease-1> \
+#           "+set helpmsg \$expgui_helplist(\[$frm.cmds get \[$frm.cmds curselection\]\])"
+    bind $frm.cmds <ButtonRelease-1> \
+            "+$frm.help config -state normal; $frm.help delete 0.0 end; \
+             $frm.help insert end \$expgui_helplist(\[$frm.cmds get \[$frm.cmds curselection\]\]); \
+             $frm.help config -state disabled"
+
     # get the size of the window and expand the message boxes to match
-    update
-    set width [lindex [split [wm geometry $frm] x+] 0]
-    $frm.0 config -width $width
-    $frm.help config -width $width
-    # waitdone $frm
-}
-
-# compute the composition for each phase and display in a toplevel
+#    update
+#    $frm.help config -width [winfo width $frm.help ]
+}
+
+# compute the composition for each phase and display in a dialog
 proc composition {} {
     global expmap expgui
@@ -291 +305 @@
     catch {destroy .comp}
     toplevel .comp
+    bind .comp <Key-F1> "MakeWWWHelp expguierr.html Composition"
     wm title .comp Composition
     pack [label .comp.results -text $text \
             -font $expgui(coordfont) -justify left] -side top
-    pack [frame .comp.box]  -side top
+    pack [frame .comp.box]  -side top -expand y -fill x
     pack [button .comp.box.1 -text Close -command "destroy .comp"] -side left
+
     set lstnam [string toupper [file tail [file rootname $expgui(expfile)].LST]]
     pack [button .comp.box.2 -text "Save to $lstnam file" \
             -command "writelst [list $text] ; destroy .comp"] -side left
+    pack [button .comp.box.help -text Help -bg yellow \
+            -command "MakeWWWHelp expguierr.html Composition"] \
+            -side right
 }
 
@@ -318 +337 @@
     toplevel .export
     wm title .export "Export coordinates"
+    bind .export <Key-F1> "MakeWWWHelp expguierr.html ExportMSI"
     pack [label .export.lbl -text "Export coordinates in MSI .xtl format"\
             ] -side top -anchor center
@@ -333 +353 @@
     pack [entry .export.sg.2 -textvariable expgui(export_sg) -width 8] -side left
     pack [checkbutton .export.sg.3 -variable expgui(export_orig) -text "Origin 2"] -side left
-    pack [frame .export.but] -side top
+    pack [frame .export.but] -side top -fill x -expand yes
     if {[llength $expmap(phaselist)] > 0} {
         pack [button .export.but.1 -text Write -command writextl] -side left
@@ -339 +359 @@
     }
     pack [button .export.but.2 -text Quit -command "destroy .export"] -side left
+    pack [button .export.but.help -text Help -bg yellow \
+            -command "MakeWWWHelp expguierr.html ExportMSI"] \
+            -side right
+    # force the window to stay on top
+    putontop .export
+    afterputontop
 }
 
@@ -451 +477 @@
     toplevel $frm
     wm title $frm "Convert File"
+    bind $frm <Key-F1> "MakeWWWHelp expguierr.html ConvertUnix"
 
     pack [frame [set frm0 $frm.0] -bd 2 -relief groove] \
@@ -461 +488 @@
             -padx 3 -pady 3 -side left
     pack [label $frmB.0 -text "Enter an output file"] -side top -anchor center
-    pack [frame [set frmC $frm.3] ] -padx 3 -pady 3 -side top
+    pack [frame [set frmC $frm.3] ] -padx 3 -pady 3 -side top -fill x -expand y
 
     pack [label $frm0.1 -text "Convert to:"] -side top -anchor center
@@ -475 +502 @@
     pack [button $frmC.b -text Convert -command "valid_conv_unix"] -side left
     pack [button $frmC.q -text Quit -command "set infile(done) 1"] -side left
-
+    pack [button $frmC.help -text Help -bg yellow \
+            -command "MakeWWWHelp expguierr.html ConvertUnix"] \
+            -side right
     
     unixcnvbox $frmA infile 1 
@@ -638 +667 @@
     toplevel $frm
     wm title $frm "Convert File"
+    bind $frm <Key-F1> "MakeWWWHelp expguierr.html ConvertWin"
     pack [frame [set frmA $frm.1] -bd 2 -relief groove] -padx 3 -pady 3 -side left
-    pack [frame [set frmC $frm.3] ] -padx 3 -pady 3 -side left
+    pack [frame [set frmC $frm.3] ] -padx 3 -pady 3 \
+            -side left -fill y -expand yes
+    pack [button $frmC.help -text Help -bg yellow \
+            -command "MakeWWWHelp expguierr.html ConvertWin"] -side top
+    pack [button $frmC.q -text Quit -command "destroy $frm"] -side bottom
     pack [button $frmC.b -text Convert -command "ValidWinCnv $frm"] \
-            -side top
-    pack [button $frmC.q -text Quit -command "destroy $frm"] -side top
+            -side bottom
     pack [label $frmA.0 -text "Select a file to convert"] -side top -anchor center
     winfilebox $frm
@@ -1198 +1231 @@
 
     global makenew
-    set makenew(OldFocus) [focus]
-    catch {
-        set makenew(OldGrab) [grab current $w]
-        if {$makenew(OldGrab) != ""} {
-            set makenew(GrabStatus) [grab status $makenew(OldGrab)]
-        }
-        grab $w
-    }
+    set makenew(OldGrab) ""
+    catch {set makenew(OldFocus) [focus]}
+    catch {set makenew(OldGrab) [grab current $w]}
+    catch {grab $w}
 }
 
@@ -1212 +1241 @@
     global makenew
     catch {focus $makenew(OldFocus)}
-    if {$makenew(OldGrab) != ""} {
-        catch {
-            if {$makenew(GrabStatus) == "global"} {
-                grab -global $makenew(OldGrab)
-            } else {
-                grab $makenew(OldGrab)
-            }
-        }
-    }
-}
-
-proc ShowBigMessage {win labeltext msg "optionlist OK"} {
+    catch {
+        if {$makenew(OldGrab) != ""} {
+            grab $makenew(OldGrab)
+        }
+    }
+}
+
+proc ShowBigMessage {win labeltext msg "optionlist OK" "link {}"} {
     catch {destroy $win}
     toplevel $win
 
-    # grab focus, etc.
     pack [label $win.l1 -text $labeltext] -side top
     pack [frame $win.f1] -side top -expand yes -fill both
@@ -1261 +1285 @@
                 -command "set makenew(result) $i; destroy $win" -text $item] -side left
     }
+    if {$link != ""} {
+        pack [button $win.help -text Help -bg yellow \
+            -command "MakeWWWHelp $link"] \
+            -side right
+        bind $win <Key-F1> "MakeWWWHelp $link"
+    }
     putontop $win
     tkwait window $win
@@ -1300 +1330 @@
         {-title "" "" " "}
         {-type "" "" "ok"}
+        {-helplink "" "" ""}
     }
 
@@ -1407 +1438 @@
     frame $w.top
     pack $w.top -side top -fill both -expand 1
+    if {$data(-helplink) != ""} {
+#       frame $w.help
+#       pack $w.help -side top -fill both
+        pack [button $w.top.1 -text Help -bg yellow \
+                -command "MakeWWWHelp $data(-helplink)"] \
+                -side right -anchor ne
+        bind $w <Key-F1> "MakeWWWHelp $data(-helplink)"
+    }
     if {[string compare $tcl_platform(platform) "macintosh"]} {
         $w.bot configure -relief raised -bd 1
@@ -1517 +1556 @@
     # 8. Set a grab and claim the focus too.
 
-    set oldFocus [focus]
-    set oldGrab [grab current $w]
-    if {[string compare $oldGrab ""]} {
-        set grabStatus [grab status $oldGrab]
-    }
-    grab $w
-    if {[string compare $data(-default) ""]} {
-        focus $w.$data(-default)
-    } else {
-        focus $w
+    catch {set oldFocus [focus]}
+    catch {set oldGrab [grab current $w]}
+    catch {
+        grab $w
+        if {[string compare $data(-default) ""]} {
+            focus $w.$data(-default)
+        } else {
+            focus $w
+        }
     }
 
@@ -1538 +1576 @@
     catch {focus $oldFocus}
     destroy $w
-    if {[string compare $oldGrab ""]} {
-      if {![string compare $grabStatus "global"]} {
-            grab -global $oldGrab
-        } else {
-            grab $oldGrab
-        }
-    }
+    catch {grab $oldGrab}
     return $tkPriv(button)
 }
@@ -1555 +1587 @@
     catch {destroy $frm}
     toplevel $frm
+    bind $frm <Key-F1> "MakeWWWHelp expguierr.html DeleteHistoryRecords"
     if {[string trim $msg] == ""} {
         set msg "There are [CountHistory] history records"
@@ -1567 +1600 @@
     pack [checkbutton $frm.1.2 -text renumber -variable expgui(renumber)] -side top
     set expgui(renumber) 1
-    pack [frame $frm.2] -padx 3 -pady 3 -side left
+    pack [frame $frm.2] -padx 3 -pady 3 -side left -fill both -expand yes
+    pack [button $frm.2.help -text Help -bg yellow \
+            -command "MakeWWWHelp expguierr.html DeleteHistoryRecords"] -side top
+    pack [button $frm.2.4 -text Quit \
+            -command {destroy .history}] -side bottom
     pack [button $frm.2.3 -text OK \
             -command { 
@@ -1575 +1612 @@
             destroy .history
         }
-    }] -side top
-    pack [button $frm.2.4 -text Quit \
-            -command {destroy .history}] -side top
+    }] -side bottom
     bind $frm <Return> "$frm.2.3 invoke"
     
@@ -1689 +1724 @@
     wm geom .msg +$x+$y
     wm deiconify .msg
-    focus .msg
-    grab .msg
+    global makenew
+    set makenew(OldGrab) ""
+    #catch {set makenew(OldFocus) [focus]}
+    catch {set makenew(OldGrab) [grab current .msg]}
+    catch {grab .msg}
+    catch {focus .msg}
     update
 }
 # clear the message
 proc donewait {} {
+    global makenew
+    catch {focus $makenew(OldFocus)}
     catch {destroy .msg}
+    catch {
+        if {$makenew(OldGrab) != ""} {
+            grab $makenew(OldGrab)
+        }
+    }
 }
 
@@ -1871 +1917 @@
     pack [frame $w.c -bg beige] -side top -expand yes -fill both
     pack [frame $w.d -bg beige] -side top -expand yes -fill both
-    pack [button $w.d.2 -text Set -bg beige \
+    pack [button $w.d.2 -text Set  \
             -command "SaveChangeProfileType $w.c $histlist $phaselist; destroy $w"\
             ] -side left
-    pack [button $w.d.3 -text Quit -bg beige \
+    pack [button $w.d.3 -text Quit \
             -command "destroy $w"] -side left
+    pack [button $w.d.help -text Help -bg yellow \
+            -command "MakeWWWHelp expgui5.html ChangeType"] \
+            -side right
+    bind $w <Key-F1> "MakeWWWHelp expgui5.html ChangeType"
     bind $w <Return> "destroy $w"
 
@@ -2057 +2107 @@
     }
 }
+
+# browse a WWW page with URL. The URL may contain a #anchor
+# On UNIX assume netscape is in the path or env(BROWSER) is loaded. 
+# On Windows search the registry for a browser. Mac branch not tested.
+# This is taken from http://mini.net/cgi-bin/wikit/557.html with many thanks
+# to the contributers
+proc urlOpen {url} {
+    global env tcl_platform
+    switch $tcl_platform(platform) {
+        "unix" {
+            if {![info exists env(BROWSER)]} {
+                set progs [auto_execok netscape]
+                if {[llength $progs]} {
+                    set env(BROWSER) [list $progs]
+                }
+            }
+            if {[info exists env(BROWSER)]} {
+                if {[catch {exec $env(BROWSER) -remote openURL($url)}]} {
+                    # perhaps browser doesn't understand -remote flag
+                    if {[catch {exec $env(BROWSER) $url &} emsg]} {
+                        error "Error displaying $url in browser\n$emsg"
+                    }
+                }
+            } else {
+                tk_dialog .warn "No Browser" \
+                        "Could not find a browser. Netscape is not in path. Define environment variable BROWSER to be full path name of browser." \
+                        warn 0 OK
+            }
+        }
+        "windows" {
+            package require registry
+            # Look for the application under
+            # HKEY_CLASSES_ROOT
+            set root HKEY_CLASSES_ROOT
+
+            # Get the application key for HTML files
+            set appKey [registry get $root\\.html ""]
+
+            # Get the command for opening HTML files
+            set appCmd [registry get \
+                    $root\\$appKey\\shell\\open\\command ""]
+
+            # Substitute the HTML filename into the command for %1
+            regsub %1 $appCmd $htmlFile appCmd
+            
+            # Double up the backslashes for eval (below)
+            regsub -all {\\} $appCmd  {\\\\} appCmd
+            
+            # Invoke the command
+            eval exec $appCmd &
+        }
+        "macintosh" {
+            if {0 == [info exists env(BROWSER)]} {
+                set env(BROWSER) "Browse the Internet"
+            }
+            if {[catch {
+                AppleScript execute\
+                    "tell application \"$env(BROWSER)\"
+                         open url \"$url\"
+                     end tell
+                "} emsg]
+            } then {
+                error "Error displaying $url in browser\n$emsg"
+            }
+        }
+    }
+}
+
+proc NetHelp {file anchor localloc netloc} {
+    if {[file exists [file join $localloc $file]]} {
+        set url "file:[file join $localloc $file]"
+    } else {
+        set url "http://$netloc/$file"
+    }
+    catch {
+        pleasewait "Starting web browser..."
+        after 2000 donewait
+    }
+    if {$anchor != ""} {
+        append url # $anchor
+    }
+    urlOpen $url
+}
+
+proc MakeWWWHelp {"topic {}" "anchor {}"} {
+    global expgui
+    if {$topic == ""} {
+        foreach item $expgui(notebookpagelist) {
+            if {[lindex $item 0] == $expgui(pagenow)} {
+                NetHelp [lindex $item 5] [lindex $item 6] $expgui(docdir) ""
+                return
+            }
+        }
+        # this should not happen
+        NetHelp expgui.html "" $expgui(docdir) ""       
+    } elseif {$topic == "menu"} {
+        NetHelp expguic.html "" $expgui(docdir) ""
+    } else {
+        NetHelp $topic $anchor $expgui(docdir) ""
+    }
+}