Tcl 9 portability, file home

Author: andreas-kupries

examples/httpd/httpd.tcl

@@ -7,6 +7,7 @@ set DEMOROOT [file join $DIR htdocs]
 set tcllibroot  [file normalize [file join $DIR .. ..]]
 set auto_path [linsert $auto_path 0 [file normalize [file join $tcllibroot modules]]]
 package require httpd 4.1
+package require file::home	;# tcllib file home forward compatibility
 ###
 # This script creates two toplevel domains:
 # * Hosting the tcllib embedded documentation as static content
@@ -84,7 +85,7 @@ clay::define httpd::content.fossil_node_scgi {
     set prefix [my clay get prefix]
     set module [lindex [split $uri /] 2]
     if {[package vsatisfies [package present Tcl] 9]} {
-      file mkdir [file tildeexpand ~/tmp]
+	file mkdir [file join [file home] tmp]
     } else {
       file mkdir ~/tmp
     }
@@ -102,11 +103,7 @@ clay::define httpd::content.fossil_node_scgi {
         tailcall my error 400 {Not Found}
       }
       set mport [my <server> port_listening]
-      if {[package vsatisfies [package present Tcl] 9]} {
-        set cmd [list [::fossil] server $dbfile --port $port --localhost --scgi 2>[file home]/tmp/$module.err >[file home]/tmp/$module.log]
-      } else {
-        set cmd [list [::fossil] server $dbfile --port $port --localhost --scgi 2>~/tmp/$module.err >~/tmp/$module.log]
-      }
+      set cmd [list [::fossil] server $dbfile --port $port --localhost --scgi 2>[file home]/tmp/$module.err >[file home]/tmp/$module.log]
       dict set ::fossil_process($module) port $port
       dict set ::fossil_process($module) handle $handle
       dict set ::fossil_process($module) cmd $cmd

examples/mime/mbot/impersonal.tcl

@@ -7,6 +7,7 @@
 #
 
 package require Tcl 8.5 9
+package require file::home	;# tcllib file home forward compatibility
 global options
 
 
@@ -162,11 +163,7 @@ if {[catch {
         if {[catch { id convert user $userName }]} {
             cleanup "userName doesn't exist: $userName"
         }
-        if {[package vsatisfies [package present Tcl] 9]} {
-            set thisDir [file home $userName]
-        } else {
-            set thisDir ~$userName
-        }
+	set thisDir [file home $userName]
         if {([catch { file isdirectory $thisDir } result]) \
                 || (!$result)} {
             cleanup "userName doesn't have a home directory: $userName"

examples/mime/mbot/personal.tcl

@@ -9,6 +9,7 @@
 #
 
 package require Tcl 8.5 9
+package require file::home	;# tcllib file home forward compatibility
 
 global options
 
@@ -466,11 +467,7 @@ if {[catch {
         if {[catch { id convert user $userName }]} {
             cleanup "userName doesn't exist: $userName"
         }
-        if {[package vsatisfies [package present Tcl] 9]} {
-            set thisDir [file home $userName]
-        } else {
-            set thisDir ~$userName
-        }
+	set thisDir [file home $userName]
         if {([catch { file isdirectory $thisDir } result]) \
                 || (!$result)} {
             cleanup "userName doesn't have a home directory: $userName"

support/devel/sak/util/registry.tcl

@@ -3,7 +3,8 @@
 ##
 # ###
 
-getpackage pregistry registry/registry.tcl
+getpackage pregistry  registry/registry.tcl
+getpackage file::home try/fhome.tcl	;# file home forward compatibility
 
 namespace eval ::sak::registry {}
 
@@ -39,12 +40,7 @@ proc ::sak::registry::Refresh {} {
 
 namespace eval ::sak::registry {
     variable _here    [file dirname [info script]]
-
-    if {[package vsatisfies [package present Tcl] 9]} {
-        variable statedir [file join [file home] .Tcllib]
-    } else {
-        variable statedir [file join ~ .Tcllib]
-    }
+    variable statedir [file join [file home] .Tcllib]
     variable state    [file join $statedir Registry]
     variable _local   {}
 }