Windows: new menu for managing 64-bit binaries

git-svn-id: svn://tug.org/texlive/trunk@60747 c570f23f-e606-0410-a88d-b1316a301751

2 files changed, 397 insertions, 15 deletions

diff --git a/Master/texmf-dist/scripts/tlshell/help-w64.txt b/Master/texmf-dist/scripts/tlshell/help-w64.txt
new file mode 100644
index 00000000000..73cb791f39b
--- /dev/null
+++ b/Master/texmf-dist/scripts/tlshell/help-w64.txt
@@ -0,0 +1,44 @@
+!!! 64-BIT BINARIES ARE UNOFFICAL !!!
+
+If you did not press the ABOUT menu item, you probably did not
+previously add 64-bit binaries with this graphical interface.
+
+The 64-bit binaries that you can add with this interface are an
+UNOFFICAL addition to TeX Live.
+
+They are created by Akira Kakuto, who also maintains most 32-bit
+binaries for TeX Live.
+
+Installing these 64-bit binaries will NOT change your searchpath to
+include them. Instead, a new command-prompt shortcut, titled 'TeX
+Live 64-bit' will be created which prefers the 64-bit binaries over
+the 32-bit ones. You can also configure your editor to prefer
+64-bit, but that is up to you.
+
+Shortcut creation may fail on Windows 7.
+
+WARNING
+
+If the 64-bit binaries are not in step with the 32-bit ones, you
+might run into problems with format files. When an update involves a
+TeX compiler ([la]tex, pdf[la]tex, lua[la]tex, xe[la]tex) or
+metafont/metapost, it is best to also rerun this 64-bit installer.
+THIS IS YOUR OWN RESPONSIBILITY!
+
+Normal 32-bit operation should not be affected, but this also
+depends on your editor configuration.
+
+
+RE-SYNCING
+
+Another consideration is the actual set of 64-bit binaries which are
+installed. When installing or updating them, 64-bit binaries which
+do not have a corresponding 32-bit binary are automatically
+removed. Therefore, if you add or remove packages, you should also
+do a re-sync, or an update, which includes a re-sync.
+
+
+GHOSTSCRIPT
+
+You may need to also install a 64-bit ghostscript. An installer can
+be downloaded from https://mirror.ctan.org/systems/win32/TLW64/
diff --git a/Master/texmf-dist/scripts/tlshell/tlshell.tcl b/Master/texmf-dist/scripts/tlshell/tlshell.tcl
index 87a95c81bf2..e84a6d2af7e 100755
--- a/Master/texmf-dist/scripts/tlshell/tlshell.tcl
+++ b/Master/texmf-dist/scripts/tlshell/tlshell.tcl
@@ -29,6 +29,7 @@ if {$::tcl_platform(platform) ne "windows"} {
 }
 
 set ::instroot [exec kpsewhich -var-value=TEXMFROOT]
+set ::year 0 ; # to be set when connecting to tlmgr
 
 # try to read a configuration variable (gui-lang, tkfontscale)
 # from tlmgr config ($TEXMF[SYS]CONFIG/tlmgr/config
@@ -354,6 +355,11 @@ proc selective_dis_enable {} {
       .mn.opt entryconfigure $::inx_platforms -state normal
     }
   }
+
+  # 64-bit windows
+  if {$::tcl_platform(platform) eq "windows" && $::wprocessor eq "AMD64"} {
+    dis_enable_w64
+  }
 }; # selective_dis_enable
 
 proc total_dis_enable {y_n} {
@@ -1192,9 +1198,12 @@ proc show_repos {} {
   if {! $::have_remote} {
     $w.load configure -text " ([__ "Not loaded"])"
   }
+  # the $::repos array already contains the configured repositories.
+  # 'repository status' adds verification info and actual selected mirror.
   set repodict [dict create]
   if $::have_remote {
     run_cmd_waiting "repository status"
+    # a number code for verification status
     set re {^(\S+) (\S+)/tlpkg/texlive.tlpdb (-?\d+) (.*)$}
     foreach l $::out_log {
       if [regexp $re $l dum nm rp n d] {
@@ -1209,6 +1218,12 @@ proc show_repos {} {
         dict set repodict $nm "veridescr" $d
       }
     }
+    # the selected mirror is needed in the win64 code, so is a global.
+    if {$::repos(main) eq $::any_mirror} {
+      set ::actual_main [dict get $repodict "main" "url"]
+    } else {
+      set ::actual_main $::repos(main)
+    }
   }
   set rw 0
   foreach nm [array names ::repos] {
@@ -1216,10 +1231,8 @@ proc show_repos {} {
     pgrid [ttk::label $w.u$nm -text $::repos($nm) -justify left] \
         -sticky nw -row $rw -column 0
     if {$::repos($nm) eq $::any_mirror && $::have_remote} {
-      set s $::repos($nm)
-      append s "\n[__ "Actual repository"]:\n"
-      append s [dict get $repodict $nm "url"]
-      $w.u$nm configure -text $s
+      $w.u$nm configure -text \
+        "$::any_mirror\n[__ "Actual repository"]:\n$::actual_main"
     }
     if {[array size ::repos] > 1 && $nm ne $::repos($nm)} {
       pgrid [ttk::label $w.n$nm -text "($nm)"] \
@@ -1865,7 +1878,7 @@ proc restore_backups_dialog {} {
 
 } ; # if $::do_restore
 
-##### Main window and supporting procs and callbacks ##################
+##### Supporting procs and callbacks ##################
 
 ##### package-related #####
 
@@ -2236,6 +2249,7 @@ proc zoom {n} {
 }
 
 ##### running external commands #####
+# for when a simple 'set var [exec command]' won't do
 
 # For capturing an external command, we need a separate output channel,
 # but we reuse ::out_log.
@@ -2252,10 +2266,10 @@ proc read_capture {} {
   }
 }; # read_capture
 
-proc run_external {cmd mess} {
+proc run_external {cmd {mess ""}} {
   set ::out_log {}
   set ::err_log {}
-  lappend ::out_log $mess
+  if {$mess ne ""} {lappend ::out_log $mess}
   unset -nocomplain ::done_waiting
   # treat cmd as a list, possibly of one element
   # using a list enables a direct invocation, bypassing a shell
@@ -2289,7 +2303,7 @@ proc tlmgr_help {} {
   long_message [exec tlmgr --help] ok
 }
 
-## arbitrary commands: no way to know what data have to be updated
+## no arbitrary commands: no way to know what data have to be updated
 #proc custom_command {} {
 #  create_dlg .tlcust .
 #  wm title .tlcust [__ "Custom command"]
@@ -2319,6 +2333,306 @@ Please configure a valid repository" $::repos(main)]
   }
 }
 
+##### w64 binaries ####################################################
+
+# Although w64 binaries can be added if windows is only an
+# additional platform, the extra w64 command-prompt can only be
+# added from within windows. The situation is a bit difficult to
+# explain to begin with, so it seems better to offer the option only
+# for a native windows install.
+
+# I would have liked to avoid pointless downloads,
+# but comparing dates is fraught with problems:
+# - remote file info is reported differently by different protocols
+# - the date of a local file may be installation time
+# - spurious differences due to local time and daylight saving time
+# we CAN timestamp zipfiles to their latest member
+# with 'unzip -T', but this can only be done AFTER downloading.
+# See also tcl commands 'file mtime', and 'clock scan'
+
+# $::wprocessor will later decide whether a w64 menu will be created.
+if {$::tcl_platform(platform) eq "windows"} {
+  set ::wprocessor $::env(PROCESSOR_ARCHITECTURE)
+  # in case of 32-bit programs on 64-bit system:
+  if [info exists ::env(PROCESSOR_ARCHITEW6432)] {
+    set ::wprocessor $::env(PROCESSOR_ARCHITEW6432)
+  }
+}
+
+proc w64_about {} {
+  # read and display file with warning message
+  set fn [exec kpsewhich -format texmfscripts help-w64.txt]
+  if {$fn eq "" || [catch {open $fn} wf]} {
+    tk_messageBox -message "Failed to open help-w64.txt"
+    return 0
+  }
+  set s ""
+  while {! [catch {chan gets $wf} line] && ! [chan eof $wf]} {
+    set s [string cat $s "\n" $line]
+  }
+  chan close $wf
+  long_message [string range $s 1 end] "okcancel"
+}
+
+set ::w64_zipdir "${::instroot}/bin/win64/zip"
+set ::w64_zipname "tl-win64"
+
+proc create_w64_shortcut {} {
+  # delegate the creation of a start menu shortcut to powershell.
+  # consider failure non-fatal
+  set shortcutfile \
+     [file join \
+          [expr {$::multiuser ? $::env(programdata) : $::env(appdata)}] \
+          "microsoft\\windows\\start menu\\programs" \
+          "TeX Live $::year" \
+          "TeX Live $::year 64-bit.lnk"]
+  set shortcut_bsl [string map {\/ \\} $shortcutfile]
+
+  set inst_bsl [string map {\/ \\} $::instroot]
+  set path_add "${inst_bsl}\\bin\\win64;${inst_bsl}\\bin\\win32;"
+  # below, escape '%' for the sake of tcl, probably unnecessary here
+  # i believe '%' has no special significance  for powershell.
+  set shargs "/k path ${path_add}\%PATH\% && title TeX Live 64-bit"
+  set cmd [string cat \
+      "\$ws = new-object -comobject wscript.shell;" \
+      "\$s = \$ws.createshortcut('$shortcut_bsl');" \
+      "\$s.targetpath = 'cmd';" \
+      "\$s.arguments = '$shargs';" \
+      "\$s.workingdirectory = '\%userprofile\%';" \
+               "\$s.save()"]
+  # powershell will silently overwrite an existing shortcut
+  set res [catch {exec cmd /c powershell.exe -NoLogo -NonInteractive \
+                      -NoProfile -command $cmd}]
+  if {$res || ![file exists $shortcutfile]} {
+    return 0
+  }
+  return 1
+}
+
+proc remove_w64 {} {
+  total_dis_enable 0
+  update idletasks
+  # remove shortcut
+  set shortcutfile \
+     [file join \
+          [expr {$::multiuser ? $::env(programdata) : $::env(appdata)}] \
+          "microsoft\\windows\\start menu\\programs" \
+          "TeX Live $::year" \
+          "TeX Live $::year 64-bit.lnk"]
+  file delete -force $shortcutfile
+  cd $::instroot
+  set w64dir [file join $::instroot "bin" "win64"]
+  total_dis_enable 1
+  update idletasks
+  catch {file delete -force $w64dir}
+  if {[file exists $shortcutfile] || [file exists $w64dir]} {
+    tk_messageBox -message "$w64dir not completely removed"
+    dis_enable_w64
+    return 0
+  } else {
+    tk_messageBox -message "$w64dir completely removed"
+    dis_enable_w64
+    return 1
+  }
+}
+
+proc make_64_dirs {} {
+  if [catch {file mkdir "$::instroot/bin/win64/zip"}] {
+    tk_messageBox -message "Cannot create required directory"
+    return 0
+  }
+  return 1
+}
+
+# local or remote source: these are separate submenu entries
+
+proc get_remote_w64 {} {
+
+  set curl "$::instroot/tlpkg/installer/curl/curl.exe"
+  set url ""
+  if {[string first {://} $::repos(main)]<0} {
+    # local repository, we assume w64 not included
+    set url ""
+  } elseif $::have_remote {
+    set url $::actual_main
+  } else {
+    set url $::repos(main)
+    if {$url eq $::any_mirror} {
+      set url ""
+    }
+  }
+  # we are currently in $::w64_zipdir
+  if [file exists ${::w64_zipname}.zip] {
+    # here and elsewhere, we do not consider a rename failure fatal
+    catch {file rename -force ${::w64_zipname}.zip ${::w64_zipname}_old.zip}
+  }
+  set notfound 1
+  set ntries 1
+  while {$notfound && $ntries<6} {
+    if {$url eq ""} {
+      # ask curl for a specific mirror
+      if [catch {exec $curl -Ls -o nul -w %{url_effective} $::any_mirror} url] {
+        tk_messageBox -message "Cannot get any mirror"
+        return 0
+      }
+    }
+    set c [string last "/texlive" $url]
+    if {$c<0} {
+      lappend ::err_log "Mirror $url no good at try $ntries"
+      continue
+    }
+    set url [string range $url 0 $c] ; # the new value includes a final '/'
+    set url "${url}win32/TLW64/${::w64_zipname}.zip"
+    # download options:
+    # -s: silent; -f: silent fail; -o: target name; -R: preserve time
+    incr ntries
+    set notfound [catch {
+      exec -keepnewline -ignorestderr $curl -s -f -o ${::w64_zipname}.zip -R $url
+    }]
+    if {!$notfound} {
+      lappend ::err_log "Success after $ntries tries"
+      return 1
+    } else {
+      set url ""
+    }
+  }
+  tk_messageBox -message \
+   "No success after $ntries tries.\nFailed to download ${::w64_zipname}.zip"
+  return 0
+}
+
+proc get_local_w64 {} {
+  # we are currently in $::w64_zipdir
+  # invoke file browser
+  set zipfile [tk_getOpenFile \
+                   -filetypes {{"Zip files" {.zip .ZIP}}} \
+                   -initialfile "${::w64_zipname}.zip" \
+                   -title "Zipfile with 64-bit binaries"]
+  if {$zipfile eq ""} {
+    return 0
+  } else {
+    if {[file normalize $zipfile] ne "${::w64_zipdir}/${::w64_zipname}.zip"} {
+      # nothing to be done if zipfile is at its intended location
+      if [file exists "${::w64_zipname}.zip"] {
+        file rename -force "${::w64_zipname}.zip" "${::w64_zipname}_old.zip"
+        # ignore failure; below, we shall just try to overwrite
+      }
+      if [catch {file copy -force $zipfile ${::w64_zipname}.zip}] {
+        tk_messageBox -message \
+            "Cannot copy $zipfile to ${::w64_zipdir}/${::w64_zipname}.zip"
+        return 0
+      }
+    }
+  }
+  return 1
+}
+
+proc dis_enable_w64 {} {
+  if [file exists [file join $::instroot "bin" "win64"]] {
+    .mn.w64 entryconfigure $::inx_remove64 -state normal
+  } else {
+    .mn.w64 entryconfigure $::inx_remove64 -state disabled
+  }
+  if [file exists [file join $::w64_zipdir "${::w64_zipname}.zip"]] {
+    .mn.w64 entryconfigure $::inx_sync64 -state normal
+  } else {
+    .mn.w64 entryconfigure $::inx_sync64 -state disabled
+  }
+}
+
+proc sync_w64_w32 {} {
+  # disable interface, but only if invoked directly
+  set caller [lindex [info level 1] 0]
+  if {$caller ne "add_or_update_w64"} {
+    total_dis_enable 0
+    update idletasks
+  }
+  # try to clear out bin/win64
+  foreach f [glob -nocomplain -directory $::instroot/bin/win64 *] {
+    if {![file isdirectory $f]} {
+      catch {file delete $f}
+    }
+  }
+  cd $::instroot; # actually already done by invoker
+  if [catch {
+    exec unzip -d $::instroot -qo ${::w64_zipdir}/${::w64_zipname}.zip} r] {
+    tk_messageBox -message "$r:\nDid not succeed in extracting all win64 files"
+    return 0
+  }
+  cd $::instroot/bin/win64
+  # all 64-bit executable files should have corresponding 32-bit files
+  set sync_mess {}
+  foreach f [glob -nocomplain *] {
+    # exempt .dll files
+    if {[string tolower [string range $f end-3 end]] ne ".dll"} {
+      if {! [file exists ../win32/$f] && ![file isdirectory $f]} {
+        if [catch {file delete $f}] {
+          lappend sync_mess $f
+        }
+      }
+    }
+  }
+  cd $::instroot
+  if {$caller ne "add_or_update_w64"} {
+    total_dis_enable 1
+    update idletasks
+  }
+  return $sync_mess
+}
+
+proc add_or_update_w64 {lr} {
+  if {! [file exists ${::w64_zipname}.zip]} {
+    # 'about' message if no prior w64
+    w64_about
+  }
+  set ok 1
+  # below, fatal errors in invoked procs produce error message boxes
+  # so nothing remains but abandoning the effort.
+  if {! [make_64_dirs]} {set ok 0}
+
+  if {$ok && [catch {cd $::w64_zipdir}]} {
+    tk_messageBox -message "Cannot access $::w64_zipdir"
+    set ok 0
+  }
+  if {! $ok} {return 0}
+
+  # operations below may take time: disable interface
+  total_dis_enable 0
+  update idletasks
+  if {$lr eq "remote"} {
+    if {! [get_remote_w64]} {
+      set ok 0
+    }
+  } else {
+    if {! [get_local_w64]} {
+      set ok 0
+    }
+  }
+  if $ok {
+    # unpack new zip selectively
+    set mess [sync_w64_w32] ; # a list of filenames
+    if {[llength $mess]>0} {
+      set mess [linsert $mess 0 \
+        "The following files should have been deleted from bin/w64 but were not:"]
+    }
+    # now w64 shortcut for cmd.exe using powershell invocation
+    if [create_w64_shortcut] {
+      lappend mess "64-bit TeXLive shortcut created"
+    } else {
+      lappend mess "Failed to create 64-bit TeXLive shortcut"
+    }
+    lappend mess "Downloaded and installed 64-bit binaries."
+      lappend mess "Done"
+    any_message [join $mess "\n"] ok
+  }
+
+  total_dis_enable 1
+  update idletasks
+  return 1
+}
+
+##### main window #####################################################
+
 proc populate_main {} {
 
   wm withdraw .
@@ -2353,10 +2667,6 @@ proc populate_main {} {
     }
   }
 
-  # inx: keeping count to record submenu indices where needed,
-  # i.e. when an entry needs to be referenced.
-  # not all submenus need this.
-
   .mn add cascade -label [__ "File"] -menu .mn.file -underline 0
   menu .mn.file
   .mn.file add command -label [__ "Load repository"] \
@@ -2365,8 +2675,6 @@ proc populate_main {} {
 
   .mn add cascade -label [__ "Actions"] -menu .mn.act -underline 0
   menu .mn.act
-  set inx -1
-  incr inx
   .mn.act add command -label [__ "Regenerate filename database"] -command \
       {run_external "mktexlsr" [__ "Regenerating filename database..."]}
   .mn.act add command -label [__ "Regenerate formats"] -command \
@@ -2377,15 +2685,16 @@ proc populate_main {} {
 
   .mn add cascade -label [__ "Options"] -menu .mn.opt -underline 0
 
+  # need to keep track of indices of this submenu
   menu .mn.opt
   set inx -1
   incr inx
   .mn.opt add command -label "[__ "Repositories"] ..." \
       -command repository_dialog
-
   incr inx
   .mn.opt add cascade -label [__ "Paper ..."] -menu .mn.opt.paper
   incr inx
+
   menu .mn.opt.paper
   foreach p {A4 Letter} {
     .mn.opt.paper add command -label $p -command \
@@ -2401,6 +2710,28 @@ proc populate_main {} {
     .mn.opt add command -label "[__ "Platforms"] ..." -command platforms_select
   }
 
+  if {$::tcl_platform(platform) eq "windows" && $::wprocessor eq "AMD64"} {
+    .mn add cascade -label "64-bit Windows" -menu .mn.w64
+    menu .mn.w64
+    set inx -1
+    incr inx
+    .mn.w64 add command -label [__ "About"] -command w64_about
+    incr inx
+    .mn.w64 add command -label [__ "Add/replace 64-bit binaries"] \
+        -command "add_or_update_w64 remote"
+    incr inx
+    .mn.w64 add command -label [__ "Add/replace from local file"] \
+        -command "add_or_update_w64 local"
+    incr inx
+    set ::inx_sync64 $inx
+    .mn.w64 add command -label [__ "Resynchronize with 32-bit"] \
+        -command sync_w64_w32
+    incr inx
+    set ::inx_remove64 $inx
+    .mn.w64 add command -label [__ "Remove 64-bit binaries"] \
+        -command remove_w64
+  }
+
   if {[llength $::langs] > 1} {
     .mn add cascade -label [__ "GUI language"] \
         -menu .mn.lang
@@ -2766,6 +3097,13 @@ proc initialize {} {
       if [regexp {^\s*multiuser\s+([01])\s*$} $l d ::multiuser] break
     }
   }
+  run_cmd_waiting "version"
+  foreach l $::out_log {
+    if {[string range $l 0 8] eq "tlversion"} {
+      set ::year [string range $l end-3 end]
+      break
+    }
+  }
   get_packages_info_local
   collect_filtered
   get_repos_from_tlmgr