summaryrefslogtreecommitdiff
path: root/Master/texmf-dist/scripts/tlshell/tlshell.tcl
blob: f724dcf720c3540ed4a90c2aba195da957a6f10a (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
#!/usr/bin/env wish
package require Tk

# windows: most scripts run via [w]runscript.

# linux: tlshell.tcl MUST  be run via a symlink in a directory
# which also contains (a symlink to) kpsewhich.
# This directory will be prepended to the searchpath.
# let kpsewhich disentangle symlinks.

set tempsub "" ; # subdirectory for temporary files

# the stderr and stdout of tlmgr are each read into a list of strings
set err_log {}
set out_log {}

set prmpt "tlmgr>"
set busy 0

set ddebug 0
proc do_debug {s} {
  if {$::ddebug} {
    puts stderr $s
  }
}

proc maketemp {ext} {
  set fname ""
  foreach i {0 1 2 3 4 5 6 7 8 9} { ; # ten tries
    set fname [file join $::tempsub "[expr int(10000.0*rand())]$ext"]
    if {[file exist $fname]} {set fname ""; continue}
    # create empty file. although we just want a name,
    # we must make sure that it can be created.
    set fid [open $fname w]
    close $fid
    if {! [file exists $fname]} {error "Cannot create temporary file"}
    if {$::tcl_platform(platform) eq "unix"} {
      file attributes $fname -permissions 0600
    }
    break
  }
  if {$fname eq ""} {error "Cannot create temporary file"}
  return $fname
}

# TODO: replace messagebox with a custom toplevel with a text widget
proc err_exit {} {
  do_debug "error exit"
  read_err
  tk_messageBox -message [join $::err_log "\n"] -type ok -icon error
  exit
}

proc read_err {} {
  do_debug "read_err"
  set ::err_log {}
  set len 0
  while 1 {
    do_debug "read_err: one iteration"
    set len [chan gets $::err l]
    if {$len >= 0} {
      lappend ::err_log $l
    } else {
      return
    }
  }
}

# about [chan] gets:
# if a second parameter is supplied
# then this variable receives the result, with EOL stripped,
# and the return value is the string length, possibly 0
# EOF is indicated by a return value of -1.

proc read_line {} {
  set l "" ; # will contain the line to be read
  if {([catch {chan gets $::tlshl l} len] || [chan eof $::tlshl])} {
    do_debug "read_line: failing to read"
    catch {chan close $::tlshl}
    err_exit
  } elseif {$len >= 0} {
    do_debug "read: $l"
    if {[string first $::prmpt $l] == 0} {
      # prompt line: done with command
      read_err
      set ::busy "IDLE"
      $::pipe_cb "finish"
    } else {
      lappend ::out_log $l
      $::pipe_cb "line" "$l"
    }
  }
  update
}

proc show_err {} {
  do_debug "show_err"
  .err.tx configure -state normal
  .err.tx delete 1.0 end
  if {[llength $::err_log] > 0} {
    foreach l $::err_log {.err.tx insert end "$l\n"}
    .err.tx yview moveto 1
    .logs select .err
  }
  update
  if {$::tcl_platform(os) ne "Darwin"} {
    # os x: text widget disabled => no selection possible
    .err.tx configure -state disabled
  }
}

# cb: short for callback (for file events of tlmgr pipe ::tlshl)

proc empty_cb {mode {l ""}} {}

set pipe_cb empty_cb

## template for non-empty pipe callback:
#proc packages_cb {mode {l ""}} {
#  if {$mode eq "line"} {
#  } elseif {$mode eq "init"} {
#  } elseif {$mode eq "finish"} {
#  } else {
#    lappend ::err_log "Illegal call of whatever_cb"
#    err_exit
#  }
#}

proc log_widget_cb {mode {l ""}} {
  if {$mode eq "line"} {
    .log.tx configure -state normal
    do_debug "to log widget:"
    do_debug $l
    .log.tx insert end "$l\n"
    update
  } elseif {$mode eq "init"} {
    .log.tx configure -state normal
    .log.tx delete 1.0 end
    update
  } elseif {$mode eq "finish"} {
    .log.tx yview moveto 1
    .logs select .log
    # error log on top if it contains anything
    show_err
    if {$::tcl_platform(os) ne "Darwin"} {
      .log.tx configure -state disabled
    }
    .ent.e configure -state normal
    update
  } else {
    lappend ::err_log "Illegal call of log_widget_cb"
    err_exit
  }
} ; # log_widget_cb

# running tlmgr ############################################

proc run_cmd {cmd} {
  do_debug "run_cmd \"$cmd\""
  $::pipe_cb "init"
  chan puts $::tlshl $cmd
  chan flush $::tlshl
  do_debug "posting busy"
  set ::busy "BUSY"
  update
  do_debug "puts and flush"
}

proc run_entry {} {
  # TODO: some validation of $cmd
  do_debug "run_entry"
  set cmd [.ent.e get]
  do_debug $cmd
  .ent.e delete 0 end
  .prev.prv configure -text $cmd
  update
  .ent.e configure -state disabled
  set ::pipe_cb log_widget_cb
  run_cmd $cmd
}

proc make_widgets {} {
  set textgray "#606060"

  frame .ent
  pack [label .ent.l -text "Type command:"] -side left
  pack [button .ent.b -text Run -command run_entry] -side right
  pack [entry .ent.e -width 60] -side left -fill x
  pack .ent -fill x -side top
  bind .ent.e <Return> run_entry

  frame .prev
  pack [label .prev.lprv -justify left -text "Last command entry: "] \
      -side left
  pack [label .prev.prv -justify left] \
      -side left -fill x
  pack [label .prev.busy -justify right -textvariable ::busy] -side right
  pack .prev -side top -fill x

  frame .log
  pack [scrollbar .log.scroll -command ".log.tx yview" -bd 1] \
      -side right -fill y
  pack [text .log.tx -height 10 -width 80 -bd 2 -relief groove -wrap word \
      -yscrollcommand ".log.scroll set" -fg $textgray] \
      -expand 1 -fill both
  .log.tx yview moveto 1

  frame .err
  pack [scrollbar .err.scroll -command ".err.tx yview" -bd 1] \
      -side right -fill y
  pack [text .err.tx -height 10 -width 80 -bd 2 -relief groove -wrap word \
      -yscrollcommand ".err.scroll set" -fg $textgray] \
      -expand 1 -fill both
  .err.tx yview moveto 1

  ttk::notebook .logs
  .logs add .log -text "Output"
  .logs add .err -text "Errors"
  raise .err .logs
  raise .log .logs
  pack .logs -side top -fill both -expand 1 -padx 3 -pady 6

  pack [button .b -text Quit -command exit]
} ; # make_widgets

proc initialize {} {
  # prepend TL to process searchpath (not needed on windows)
  if {$::tcl_platform(platform) ne "windows"} {
    set texbin [file dirname [info script]]
    set savedir [pwd]
    cd $texbin
    set texbin [pwd]
    cd $savedir
    # prepend texbin to PATH, unless it is already the _first_
    # path component
    if {$::tcl_platform(platform) eq "unix"} {
      set pathsep ":"
    } else {
      set pathsep ";"
    }
    set dirs [split $::env(PATH) $pathsep]
    if {[lindex $dirs 0] ne $texbin} {
      set ::env(PATH) "$texbin$pathsep$::env(PATH)"
    }
  }
  # directory for temp files
  set attemptdirs {}
  foreach tmp {TMPDIR TEMP TMP} {
    if {[lsearch [array names ::env] $tmp] >= 0} {
      lappend attemptdirs $::env($tmp)
    }
  }
  if {$::tcl_platform(os) eq "Darwin"} {
    lappend attemptdirs "/private/tmp"
  }
  if {$::tcl_platform(platform) eq "unix"} {
    lappend attemptdirs "/tmp"
  }
  lappend attemptdirs [pwd]
  set ::tempsub ""
  foreach tmp $attemptdirs {
    if {$::tcl_platform(platform) eq "windows"} {
      regsub -all {\\} $tmp {/} tmp
    }
    if {[file isdirectory $tmp]} {
      foreach i {0 1 2 3 4 5 6 7 8 9} {
        # 10 tries to get a new name for this value of tmp
        set ::tempsub [file join $tmp "tlshl[expr int(10000.0*rand())]"]
        if {[file isdirectory $::tempsub]} {set ::tempsub ""; continue}
        if {! [catch {file mkdir $::tempsub}]} {break} ;# success
        else {set ::tempsub ""}
      }
      if {$::tempsub ne ""} {break}
    }
  }

  if {$::tempsub eq "" || [file isdirectory $::tempsub] == 0} {
    error "Cannot create directory for temporary files"
  }
  # temp file for stderr
  set ::err_file [maketemp ".err_tlshl"]

  make_widgets

  # start the TeX Live Manager shell interface
  # capture stdout into the pipe, stderr into a temp file
  set ::tlshl [open "|tlmgr --autoflush shell 2>>$::err_file" w+]
  set ::err [open $::err_file r]
  chan configure $::tlshl -buffering line -blocking 0
  chan event $::tlshl readable read_line
  set pipe_cb empty_cb
  run_cmd "set machine-readable 1"
}; # initialize

initialize