blob: c3727718a902d29ddefe681211d73c42161d8cac (
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
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
|
#!/usr/bin/env wish
package require Tk
# This version:
# - example of reading database
# - restart
# - update commands removed or disabled; can get in the way
# 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 {}
# pkgs: dict of package dicts
set pkgs {}
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 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"
# update
} else {
lappend ::out_log $l
$::pipe_cb "line" "$l"
}
}
}
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
}
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"
} elseif {$mode eq "init"} {
.log.tx configure -state normal
.log.tx delete 1.0 end
} 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
} else {
lappend ::err_log "Illegal call of log_widget_cb"
err_exit
}
} ; # log_widget_cb
proc packages_cb {mode {l ""}} {
if {$mode eq "line"} {
# .pkglist configure -state normal
set re {^([ i]) ([^: ]+): (.*)$}
if {[regexp $re $l m is_inst pname pdescr]} {
do_debug "Match: $l"
# for now, we assume that there are no duplicates
if {$is_inst eq " "} {set is_inst false} else {set is_inst true}
dict set ::pkgs $pname {$pdescr $is_inst}
.pkglist insert {} end -id $pname -values \
[list [expr {$is_inst ? {X} : {}}] $pname $pdescr]
} else {
do_debug "No match: $l"
}
} elseif {$mode eq "init"} {
foreach k [dict keys $::pkgs] {dict unset ::pkgs $k}
} elseif {$mode eq "finish"} {
# fill_package_listbox
} else {
lappend ::err_log "Illegal call of packages_cb"
err_exit
}
} ; # log_widget_cb
# running tlmgr ############################################
proc run_cmd {cmd} {
do_debug "run_cmd \"$cmd\""
set ::out_log {}
set ::err_log {}
$::pipe_cb "init"
# update
chan puts $::tlshl $cmd
chan flush $::tlshl
do_debug "posting busy"
set ::busy "BUSY"
do_debug "puts and flush"
}
proc start_tlmgr {} {
# start the TeX Live Manager shell interface
# capture stdout into the pipe, stderr into a temp file
set ::tlshl [open "|tlmgr --machine-readable 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
}
proc restart_tlmgr {} {
set ::pipe_cb empty_cb
run_cmd "quit"
chan close $::tlshl
start_tlmgr
}
proc run_entry {} {
# TODO: some validation of $cmd
do_debug "run_entry"
set cmd [.ent.e get]
if {$cmd eq ""} return
do_debug $cmd
.ent.e delete 0 end
.ent.prv configure -text $cmd
.ent.e configure -state disabled
set ::pipe_cb log_widget_cb
run_cmd $cmd
}
proc view_collections {} {
set cmd "info collections"
set ::pipe_cb packages_cb
run_cmd $cmd
}
proc make_widgets {} {
set textgray "#606060"
# width of '0', as a rough estimate of character width
set cw [font measure TkTextFont "0"]
frame .buttons -background "#d0d0d0"
grid [label .more -justify left -text "Buttons (more to come)" \
-background "#d0d0d0"] \
-in .buttons -column 0 -columnspan 2 -row 0 -sticky w
grid [button .collections -text "Show collections" \
-command view_collections] \
-in .buttons -column 0 -row 1 -sticky w
pack .buttons -side top -fill x -expand 1
# command entry
frame .ent
grid [label .ent.l -text "Type command:"] -row 0 -column 0
grid [button .ent.b -text Run -command run_entry] \
-row 0 -column 2 -sticky w
grid [entry .ent.e -width 70] -row 0 -column 1 -sticky ew
bind .ent.e <Return> run_entry
grid [label .ent.lprv -justify left -text "Last command entry: "] \
-row 1 -column 0
grid [label .ent.prv -justify left] -row 1 -column 1
grid [label .ent.busy -justify right -textvariable ::busy] \
-row 1 -column 2
pack .ent -fill x -side top -expand 1
# packages list
frame .fpkg
ttk::treeview .pkglist -columns {ins Name Description} \
-show headings -height 8 \
-xscrollcommand {.pkhsb set} -yscrollcommand {.pkvsb set}
foreach col {ins Name Description} {
.pkglist heading $col -text $col -anchor w
}
.pkglist column ins -width [expr $cw * 5]
.pkglist column Name -width [expr $cw * 25]
.pkglist column Description -width [expr $cw * 50]
ttk::scrollbar .pkhsb -orient horizontal -command {.pkglist xview}
ttk::scrollbar .pkvsb -orient vertical -command {.pkglist yview}
grid .pkglist -in .fpkg -row 0 -column 0 -sticky news
grid .pkvsb -in .fpkg -row 0 -column 1 -sticky ns
grid .pkhsb -in .fpkg -row 1 -column 0 -sticky ew
pack .fpkg -side top -fill x -expand 1
# log displays
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 x -expand 1 -padx 3 -pady 6
# finally...
frame .endbuttons
pack [button .q -text Quit -command exit] \
-in .endbuttons -side right
pack [button .r -text Restart -command restart_tlmgr] \
-in .endbuttons -side right
pack .endbuttons -side bottom -fill x -expand 1
} ; # 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_tlmgr
}; # initialize
initialize
|