Changeset 749 for trunk

Timestamp:

Dec 4, 2009 5:11:22 PM (13 years ago)

Author:

toby

Message:

# on 2003/11/13 17:21:17, toby did:
remove obsolete references to tkButtonInvoke
add code to support URL lookup in OSX & clean up for UNIX
don't allow archived files on initial open
fix parse of .EXP file for >999 LS cycles

File:

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

trunk/gsascmds.tcl

@@ -227 +227 @@
 
     if {[string compare $data(-default) ""]} {
-      bind $w <Return> [list tkButtonInvoke $w.[string tolower $data(-default)]]
+      bind $w <Return> [list $w.[string tolower $data(-default)] invoke]
     }
 
@@ -858 +858 @@
 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)]} {
-                set progs [auto_execok mozilla]
-                if {[llength $progs]} {
-                    set env(BROWSER) [list $progs]
-                }
-            }
-            if {[info exists env(BROWSER)]} {
-                if {[catch {exec $env(BROWSER) -remote openURL($url)}]} {
+    if {$tcl_platform(os) == "Darwin"} {
+        # if this is an external URL or does not contain an anchor, take the 
+        # easy approach
+        if {[string range $url 0 4] == "http:" || \
+                [string first "#" $url] == -1} {
+            if {![catch {exec open $url}]} {
+                return
+            }
+        }
+        # so sorry, have to use Internet Explorer
+        set url [file nativename $url]; # replace ~/ if present
+        if {[file pathtype $url] == "relative"} {
+            set url [file join [pwd] $url]
+        }
+        exec osascript -e "tell application \"Internet Explorer\"\rGetURL \"file://$url\"\rend tell"
+    } elseif {$tcl_platform(platform) == "unix"} {
+        set browserlist {}
+        if {[info exists env(BROWSER)]} {
+            set browserlist $env(BROWSER)
+        }
+        lappend browserlist netscape mozilla 
+        foreach p $browserlist {
+            set progs [auto_execok $p]
+            if {[llength $progs]} {
+                if {[catch {exec $progs -remote openURL($url)}]} {
                     # perhaps browser doesn't understand -remote flag
                     if {[catch {exec $env(BROWSER) $url &} emsg]} {
@@ -879 +888 @@
                     }
                 }
-            } else {
-                MyMessageBox -parent . -title "No Browser" \
-                        -message "Could not find a browser. Netscape is not in path. Define environment variable BROWSER to be full path name of browser." \
-                        -icon warning
-            }
-        }
-        "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
-            # or stick it on the end
-            if {[string first %1 $appCmd] != -1} {
-                regsub %1 $appCmd $url appCmd
-            } else {
-                append appCmd " " $url
-            }
-            
-            # 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)\"
+                return
+            }
+        }
+        MyMessageBox -parent . -title "No Browser" \
+            -message "Could not find a browser. Netscape & Mozilla not found. Define environment variable BROWSER to be full path name of browser." \
+            -icon warning
+    } elseif {$tcl_platform(platform) == "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
+        # or stick it on the end
+        if {[string first %1 $appCmd] != -1} {
+            regsub %1 $appCmd $url appCmd
+        } else {
+            append appCmd " " $url
+        }
+        
+        # Double up the backslashes for eval (below)
+        regsub -all {\\} $appCmd  {\\\\} appCmd
+        
+        # Invoke the command
+        eval exec $appCmd &
+    } elseif {$tcl_platform(platform) == "macintosh"} {
+        # preOSX -- this is not used
+        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"
-            }
-        }
+        } then {
+            error "Error displaying $url in browser\n$emsg"
+        }
     }
 }
 
 proc NetHelp {file anchor localloc netloc} {
+    # use the file on-line, if it exists
     if {[file exists [file join $localloc $file]]} {
         set url "[file join $localloc $file]"
@@ -1773 +1782 @@
                 -class SmallFont] \
                 -side top -fill both -expand yes -pady 5
+    } elseif {$mode != "new"} {
+        # for initial read, don't access archived files
+        pack [frame $expgui(FileInfoBox) -bd 4 -relief groove \
+                -class SmallFont] \
+                -side top -fill both -expand yes -pady 5
+        set mode "old"
     }
     pack [button $frmC.b -text Read \
@@ -2169 +2184 @@
             close $fp
             update
-            regexp {GNLS  RUN on (.*) +Total.*run +([0-9]+) } \
+            regexp {GNLS  RUN on (.*) +Total.*run *([0-9]+) } \
                     $testline a last cycles
             pack [label $expgui(FileInfoBox).2 -justify left \