"Fossies" - the Fresh Open Source Software Archive 
Member "libisoburn-1.5.4/frontend/xorriso-tcltk" (30 Jan 2021, 186344 Bytes) of package /linux/misc/libisoburn-1.5.4.tar.gz:
As a special service "Fossies" has tried to format the requested text file into HTML format (style:
standard) with prefixed line numbers.
Alternatively you can here
view or
download the uninterpreted source code file.
See also the last
Fossies "Diffs" side-by-side code changes report for "xorriso-tcltk":
1.5.0_vs_1.5.2.
1 #!/usr/bin/wish
2 #
3 # xorriso-tcltk
4 # Copyright (C) 2012 - 2021
5 # Thomas Schmitt <scdbackup@gmx.net>, libburnia project.
6 # Provided under BSD license: Use, modify, and distribute as you like.
7 #
8 # This is mainly a proof of concept for xorriso serving under a frontend.
9 # It exercises several fundamental gestures of communication:
10 # - connecting via two named pipes
11 # - sending commands
12 # - receiving replies
13 # - inquiring the xorriso message sieve
14 # - using the xorriso parsing service
15 #
16 # It also may serve as educational frontend to xorriso which tells by
17 # its message window how to operate xorriso by commands and what it will
18 # reply.
19
20 # Note that any other language than Tcl/Tk could be used, if it only can
21 # do i/o via standard input and standard output or via named pipes.
22 # Further it has to perform integer arithmetics and string manipulations.
23 # And, well, a graphical widget set would be nice.
24
25
26 set own_version "1.5.4"
27
28 # Minimum version of xorriso to be used as backend process.
29 # Older versions of xorriso do not offer commands -msg_op and -launch_frontend
30 set min_xorriso_version "1.2.6"
31
32
33 proc print_usage {argv0} {
34 puts stderr "Usage:"
35 puts stderr " $argv0 \[options\]"
36 puts stderr "Options:"
37 puts stderr " All options must be given with two dashes (\"--option\") in"
38 puts stderr " order to distinguish them from any options of the Tcl shell."
39 puts stderr " --help"
40 puts stderr " Print this text and exit."
41 puts stderr " --stdio"
42 puts stderr " Establish connection to xorriso via stdin and stdout."
43 puts stderr " E.g. when letting xorriso start this frontend program:"
44 puts stderr " xorriso -launch_frontend \$(which xorriso-tcltk) --stdio --"
45 puts stderr " --named_pipes cmd_fifo reply_fifo"
46 puts stderr " Establish connection to a xorriso process started by:"
47 puts stderr " xorriso -dialog on <cmd_fifo >reply_fifo"
48 puts stderr " which is then ready for a run of:"
49 puts stderr " xorriso-tcltk --named_pipes cmd_fifo reply_fifo"
50 puts stderr " It is important that the parent of xorriso and of this"
51 puts stderr " tcl/tk frontend opens the named pipe for commands before"
52 puts stderr " it opens the named pipe for replies. This avoids deadlock."
53 puts stderr " --silent_start"
54 puts stderr " Do not issue the start message xorriso-tcltk-version."
55 puts stderr " This works only if --silent_start is the first argument."
56 puts stderr " --no_extract"
57 puts stderr " Do not allow extraction of files from ISO filesystem to"
58 puts stderr " hard disk. This is not revokable during the program run."
59 puts stderr " --no_bwidget"
60 puts stderr " Do not try to load the Tcl/Tk package BWidget which is"
61 puts stderr " a prerequisite for the \"/\" file browser buttons."
62 puts stderr " --geometry {+|-}X{+|-}Y"
63 puts stderr " Sets the position of the main window."
64 puts stderr " --click_to_focus"
65 puts stderr " Chooses that input fields and list boxes get the keyboard"
66 puts stderr " focus only when being clicked by the mouse. (Default)"
67 puts stderr " --auto_focus"
68 puts stderr " Chooses that the keyboard focus is where the mouse"
69 puts stderr " pointer is."
70 puts stderr " --pipe_log_file path"
71 puts stderr " Set a file address for logging of xorriso commands and"
72 puts stderr " reply messages and enable this logging."
73 puts stderr " The log lines will be appended. Path \"-\" means stderr."
74 puts stderr " --script_log_file path"
75 puts stderr " Set a file address for logging of essential xorriso"
76 puts stderr " commands and enable this logging."
77 puts stderr " The log lines will be appended. Path \"-\" means stderr."
78 puts stderr " --script_log_all_commands"
79 puts stderr " With logging of commands log non-essential commands too."
80 puts stderr " --use_command_move"
81 puts stderr " Use xorriso command -move for the \"Move to:\" button"
82 puts stderr " if xorriso version is >= 1.2.8"
83 puts stderr " --use_command_mv"
84 puts stderr " Use xorriso command -mv for the \"Move to:\" button."
85 puts stderr ""
86 puts stderr "If neither --stdio nor --named_pipes is given, then this script"
87 puts stderr "will try to locate itself in the filesystem and start a xorriso"
88 puts stderr "run that launches it again."
89 puts stderr ""
90 puts stderr "In the running GUI, click with the rightmost mouse button on"
91 puts stderr "any GUI element to get its particular help text."
92 puts stderr ""
93 }
94
95
96 # ------------------------------- the frontend ----------------------------
97 #
98 # Connects to a xorriso process, sends commands, receives replies,
99 # prepares replies for GUI
100
101 # Connection to xorriso
102 set cmd_conn ""
103 set reply_conn ""
104
105 # The addresses of the named pipes, if such are used (see option -named_pipe)
106 set cmd_pipe_adr ""
107 set reply_pipe_adr ""
108
109 # The command to send (or the command most recently sent)
110 set cmdline ""
111 # Whether to clear the cmdline after sending
112 set cmdline_clear true
113 # Command counter
114 set cmd_sent 0
115 # Current -mark synchronization text
116 set mark_count 0
117
118 # Results of most recent await_all_replies
119 set info_list ""
120 set info_count 0
121 set emerging_info ""
122 set result_list ""
123 set result_count 0
124 set emerging_result ""
125
126 # Highest severities encountered in total and with most recent command
127 set highest_total_sev ALL
128 set highest_total_sev_msg ""
129 set highest_cmd_sev ALL
130 set highest_cmd_sev_msg ""
131 # This one registers like highest_cmd_sev with threshold ALL
132 set highest_seen_cmd_sev ALL
133
134 # State of last read_sieve command
135 set sieve_ret 0
136
137 # How many texts to pass with one parse_bulk command
138 set bulk_parse_max_chunk 200
139 # Parse parameters
140 set bulk_parse_prefix ""
141 set bulk_parse_separators ""
142 set bulk_parse_max_words ""
143 set bulk_parse_flag ""
144 # The announced number of texts to parse
145 set bulk_parse_num_texts ""
146
147 # Whether to complain on stderr about broken pipes.
148 # This may be expected when xorriso is being shut down by this frontend.
149 set expect_broken_pipes "0"
150
151 # Whether to use command -move rather than -mv. Possible since xorriso-1.2.8.
152 set use_command_move 1
153
154 # Whether to enable -hardlinks mode "on". Too slow before xorriso-1.3.0.
155 set use_command_hardlinks_on 1
156
157
158 # Local copies of xorriso state
159
160 # Addresses of drives (or image files) as shown by their text fields in the GUI
161 set outdev_adr ""
162 set indev_adr ""
163
164 # Addresses of drives (or image files) as set in xorriso (after inquire_dev)
165 set eff_outdev_adr ""
166 set eff_indev_adr ""
167
168 # Whether the medium is blank, appendable, closed, missing
169 set indev_medium_status "missing"
170 set outdev_medium_status "missing"
171
172 # What kind of medium is presented by the drive
173 set indev_profile ""
174 set outdev_profile ""
175
176 # List of known drive addresses
177 set devlist ""
178
179 # Intermediate storage for messages until the GUI is up with .msglist box
180 set pre_msglist ""
181
182 # Whether overwriting of files in the ISO model is allowed
183 set overwrite_iso_files 1
184
185 # If overwrite_iso_files is 1: Whether overwriting of ISO directories is allowed
186 set overwrite_iso_dirs 0
187
188 # Whether overwriting of files on disk is allowed
189 set overwrite_disk_files 0
190
191 # The file where to log commands and replies for debugging purposes
192 set debug_log_file ""
193 set debug_log_conn stderr
194
195 # Whether to log all commands and replies to the debug_log_file
196 set debug_logging 0
197
198 # The result of the most recent isofs_ls run
199 set isofs_ls_result ""
200
201 # The result of the most recent localfs_ls run
202 set localfs_ls_result ""
203
204 # The communication channel where to log files (if it is not the empty text)
205 set cmd_log_conn ""
206
207 # The address under which cmd_log_conn was opened
208 set cmd_log_target ""
209
210 # Whether to log essential commands: 0=off , 1=no extract , 2=with extract
211 set cmd_logging_mode 0
212
213 # Whether to log all commands if cmd_logging_mode is 1: 0=off , 1=on
214 set cmd_logging_all 0
215
216 # The last logged -cd path. Used to prevent redundant logging of -cd.
217 set recent_cd_path ""
218
219 # The file address and the channel for xorriso command script execution
220 set execute_script_adr ""
221 set execute_script_conn ""
222
223 # Whether extraction to disk shall be allowed in scripts
224 set script_with_osirrox 0
225
226 # Whether extraction to disk is allowed
227 set osirrox_allowed 1
228
229
230 # xorriso specific constants
231
232 # List of severities (gets later overridden by -msg_op list_sev -)
233 set xorriso_severity_list {
234 ALL DEBUG UPDATE NOTE HINT WARNING SORRY MISHAP FAILURE FATAL ABORT NEVER
235 }
236 set scan_event_threshold HINT
237
238
239 # --------- Communication between frontend and xorriso ----------
240
241
242 # Open the connection to a pair of named pipes. Program option -named_pipes
243 #
244 proc init_frontend_named_pipes {cmd_pipe reply_pipe} {
245 global cmd_conn
246 global reply_conn
247
248 set cmd_conn [open $cmd_pipe w]
249 set reply_conn [open $reply_pipe r]
250
251 # Note: dissuaded flags would be necessary for opening idle fifo
252 # set reply_conn [open $reply_pipe {RDONLY NONBLOCK}]
253
254 }
255
256
257 # Send a command line to the xorriso process. Do not wait for reply.
258 #
259 proc send_async_cmd {cmd} {
260 global cmd_sent cmd_conn debug_logging debug_log_conn
261
262 display_busy 1
263 log_command $cmd 0
264
265 debug_log_puts \
266 " =============================================================="
267 debug_log_puts " $cmd"
268 display_msg "======> $cmd"
269 incr cmd_sent
270 puts $cmd_conn $cmd
271 flush $cmd_conn
272 }
273
274
275 # Send a command line and a -mark command to xorriso. Wait until the
276 # mark message confirms that all command output has been received.
277 #
278 proc send_marked_cmd {cmd} {
279 global cmd_conn mark_count
280
281 send_async_cmd $cmd
282 incr mark_count
283 set mark_cmd "-mark $mark_count"
284 debug_log_puts " $mark_cmd"
285 puts $cmd_conn $mark_cmd
286 flush $cmd_conn
287 await_all_replies
288 }
289
290
291 # Send a command and make it a candidate for the log script
292 #
293 proc send_loggable_cmd {cmd} {
294 log_command $cmd 1
295 send_marked_cmd $cmd
296 }
297
298
299 # Send a command that shall not be displayed in the message log
300 #
301 proc send_silent_cmd {cmd} {
302 set disp_en_mem [set_display_msg 0]
303 send_marked_cmd $cmd
304 set_display_msg $disp_en_mem
305 }
306
307
308 # Wait for the currently pending mark message to arrive.
309 # Buffer all received result lines and info messages.
310 #
311 proc await_all_replies {} {
312 global reply_conn mark_count result_count result_list
313 global info_count info_list expect_broken_pipes
314 global .busy_text
315
316 clear_reply_lists
317
318 while {1} {
319 set ret [gets $reply_conn line]
320 if {$ret < 0} {
321 if {$expect_broken_pipes != 1} {
322 puts stderr "EOF at reply pipe"
323 }
324 break
325 }
326 debug_log_puts $line
327 if {[string range $line 0 0] == "M"} {
328 if {[string range $line 5 end] == $mark_count} {
329 break
330 } else {
331 # outdated mark message
332 continue
333 }
334 }
335
336 de_pkt_line $line
337 }
338
339 display_busy 0
340 }
341
342
343 # Decode -pkt_output format to complete lines and buffer them.
344 #
345 proc de_pkt_line {line} {
346 global info_list
347 global info_count
348 global emerging_info
349 global result_list
350 global result_count
351 global emerging_result
352
353 # Distinguish R and I
354 set ch [string range $line 0 0]
355
356 set payload [string range $line 5 end]
357 if {$ch == "R"} {
358 set emerging_result "$emerging_result$payload"
359 } else { if {$ch == "I"} {
360 set emerging_info "$emerging_info$payload"
361 } else {
362 return ""
363 }}
364
365 # if line end : add to list
366 if {[string range $line 2 2] == "1"} {
367 if {$ch == "R"} {
368 lappend result_list $emerging_result
369 incr result_count
370 display_msg $emerging_result
371 set emerging_result ""
372 } else {
373 lappend info_list $emerging_info
374 incr info_count
375 display_msg $emerging_info
376 scan_info_for_event $emerging_info
377 set emerging_info ""
378 }
379 }
380 }
381
382
383 # Search in the decoded info messages for the most severe event reports.
384 #
385 proc scan_info_for_event {line} {
386 global highest_total_sev highest_total_sev_msg
387 global highest_cmd_sev highest_cmd_sev_msg highest_seen_cmd_sev
388 global scan_event_threshold
389 global display_msg_enabled
390
391 # check for word : CAPS : text ...
392 set ret [regexp {[a-z][a-z]*[ ]*: [A-Z][A-Z]* :} $line]
393
394 if {$ret != 1} {return ""}
395
396 # retrieve severity
397 set pos [string first ":" $line]
398 set sev [string range $line [expr $pos+2] end]
399 set pos [string first ":" $sev]
400 set sev [string range $sev 0 [expr $pos-2]];
401
402 if {[compare_sev $sev $highest_seen_cmd_sev] > 0} {
403 set highest_seen_cmd_sev $sev
404 }
405
406 if {[compare_sev $sev $scan_event_threshold] < 0} {return ""}
407
408 if {$display_msg_enabled == 0} {
409 set display_msg_enabled 1
410 display_msg $line
411 set display_msg_enabled 0
412 }
413 if {[compare_sev $sev $highest_total_sev] >= 0} {
414 set highest_total_sev $sev
415 set highest_total_sev_msg [escape_newline $line 0]
416 }
417 if {[compare_sev $sev $highest_cmd_sev] >= 0} {
418 set highest_cmd_sev $sev
419 set highest_cmd_sev_msg [escape_newline $line 0]
420 }
421 }
422
423
424 # Unpack the output format of -msg_op read_sieve into a result_list
425 # of strings which each hold one parsed word.
426 #
427 proc de_sieve {} {
428 global result_list
429 global sieve_ret
430
431 set sieve_ret [lindex $result_list 0]
432 set sieve_result_count [lindex $result_list 1]
433
434 set payload ""
435 set sieve_result_count 0
436 for {set i 2} {$i < [llength $result_list]} {incr i} {
437 set line ""
438 set num_lines [lindex $result_list $i]
439 for {set j 0} {$j < $num_lines} {incr j} {
440 incr i
441 set line "$line[lindex $result_list $i]"
442 if {$j < $num_lines - 1} {
443 set line "$line\n"
444 } else {
445 lappend payload $line
446 incr sieve_result_count
447 }
448 }
449 }
450 set result_list $payload
451 set result_count $sieve_result_count
452 }
453
454
455 # Alternative to proc await_all_replies. It waits for a line at one of the
456 # three channels and displays all lines which it receives before that line.
457 # Used before this frontend had the opportunity to set up xorriso by commands
458 # like -pkt_output "on".
459 #
460 proc wait_for_msg {prefix channel} {
461 global reply_conn
462
463 if {$channel == "M"} {
464 set channel_prefix "M:0: "
465 } else {
466 set channel_prefix "$channel:1: "
467 }
468
469 set prefix_l [string length $prefix]
470 while {1} {
471
472 # >>> Have a timeout
473
474 set ret [gets $reply_conn line]
475 if {$ret < 0} {
476 break
477 }
478 debug_log_puts $line
479 if {[string length $line] < $prefix_l} {
480 display_msg $line
481 continue
482 }
483 if {[string range $line 0 [expr $prefix_l-1]] == $prefix} {
484 return [string range $line $prefix_l end]
485 }
486 if {[string length $line] >= [expr $prefix_l+5]} {
487 if {[string range $line 0 4] == $channel_prefix} {
488 if {[string range $line 5 [expr $prefix_l+4]] == $prefix} {
489 return [string range $line [expr $prefix_l+5] end]
490 }
491 }
492 }
493 display_msg $line
494 }
495 }
496
497
498 # Reset the buffer for result lines and info messages.
499 #
500 proc clear_reply_lists {} {
501 global info_list
502 global info_count
503 global emerging_info
504 global result_list
505 global result_count
506 global emerging_result
507
508 set info_list ""
509 set info_count 0
510 set emerging_info ""
511 set result_list ""
512 set result_count 0
513 set emerging_result ""
514 }
515
516
517 # Reset the register of the most severe event for command sequences.
518 # Typically this is done before executing the commands of a procedure
519 # that is triggered by the user interface.
520 #
521 proc reset_highest_cmd_sev {} {
522 global highest_cmd_sev highest_cmd_sev_msg highest_seen_cmd_sev
523
524 set highest_cmd_sev ALL
525 set highest_cmd_sev_msg ""
526 set highest_seen_cmd_sev ALL
527 }
528
529
530 # Clear the recordings of the xorriso message sieve.
531 #
532 proc clear_sieve {} {
533 send_silent_cmd "-msg_op clear_sieve -"
534 }
535
536
537 # Obtain a recorded item from the xorriso message sieve.
538 #
539 proc read_sieve {name} {
540 send_silent_cmd "-msg_op read_sieve '$name'"
541 de_sieve
542 }
543
544
545 # ------- Inquiring xorriso status -------
546
547
548 # Get more information about drive that was inquired by recent -toc_of.
549 #
550 proc obtain_drive_info {dev} {
551 global result_list
552 global sieve_ret
553 global indev_medium_status outdev_medium_status
554 global indev_profile outdev_profile
555
556 set line ""
557
558 if {$dev == "in"} {
559 set indev_medium_status "missing"
560 set indev_profile ""
561 } else {
562 set outdev_medium_status "missing"
563 set outdev_profile ""
564 }
565 read_sieve "Media status :"
566 if {$sieve_ret > 0} {
567 set reply [lindex $result_list 0]
568 foreach i {blank appendable closed} {
569 if {[string first $i $reply] != -1} {
570 set line "$i "
571 if {$dev == "in"} {
572 set indev_medium_status $i
573 } else {
574 set outdev_medium_status $i
575 }
576 break
577 }
578 }
579 }
580 read_sieve "Media current:"
581 if {$sieve_ret > 0} {
582 set profile [lindex $result_list 0]
583 if {$profile == "is not recognizable"} {
584 set profile "no recognizable medium"
585 set line "$line$profile"
586 return $line
587 } else {
588 set line "$line$profile, "
589 if {$dev == "in"} {
590 set indev_profile $profile
591 } else {
592 set outdev_profile $profile
593 }
594 }
595 }
596 read_sieve "Media summary:"
597 if {$sieve_ret > 0} {
598 set line "$line[lindex $result_list 0] sessions, "
599 if {$dev == "in"} {
600 set line "$line[lindex $result_list 2] used"
601 } else {
602 set line "$line[lindex $result_list 3] free"
603 }
604 }
605 return $line
606 }
607
608
609 # Inquire whether changes of the ISO image are pending.
610 # This is a precondition for writing the session. Vice versa pending changes
611 # block a change of the input drive or the program end.
612 #
613 proc changes_are_pending {} {
614 global result_count result_list
615
616 send_silent_cmd "-changes_pending show_status"
617 if {$result_count >= 1} {
618 if {[lindex $result_list 0] == "-changes_pending no"} {
619 return "0"
620 }
621 return "1"
622 }
623 return ""
624 }
625
626
627 # Inquire whether an ISO image model has been created inside xorriso.
628 # This is a precondition for inserting files into the ISO tree model.
629 #
630 proc assert_iso_image {with_msg} {
631 global highest_seen_cmd_sev scan_event_threshold
632
633 set highest_seen_cmd_sev ""
634 set set_mem $scan_event_threshold
635 set scan_event_threshold "FATAL"
636 send_silent_cmd "-lsd / --"
637 set scan_event_threshold $set_mem
638 if {[compare_sev $highest_seen_cmd_sev "FAILURE"] >= 0} {
639 if {$with_msg == 1} {
640 xorriso_tcltk_errmsg "xorriso-tcltk : SORRY : First you need to create or load an ISO image by selecting a drive or an image file"
641 }
642 return "0"
643 }
644 return "1"
645 }
646
647
648 # Obtain the list of possible event severity names, sorted in ascending order
649 #
650 proc inquire_severity_list {} {
651 global xorriso_severity_list
652 global result_list
653
654 set disp_en_mem [set_display_msg 0]
655 send_marked_cmd "-msg_op list_sev -"
656 set_display_msg $disp_en_mem
657 if {[lindex $result_list 0] != ""} {
658 set xorriso_severity_list [split [lindex $result_list 0] " "]
659 }
660 }
661
662
663 # Parse-by-xorriso handler function for proc inquire_dev
664 #
665 proc set_inquired_dev {} {
666 global result_list eff_indev_adr eff_outdev_adr
667
668 if {[llength $result_list] < 2} {return ""}
669 set what [lindex $result_list 0]
670 if {$what == "-dev" || $what == "-indev"} {
671 set eff_indev_adr [lindex $result_list 1]
672 }
673 if {$what == "-dev" || $what == "-outdev"} {
674 set eff_outdev_adr [lindex $result_list 1]
675 }
676 }
677
678
679 # Inquire -indev and -outdev from xorriso and install in eff_indev_adr
680 # and eff_outdev_adr.
681 # (This could be done by -toc_of like in proc refresh_indev. But here
682 # i demonstrate the use of command -status and parsing its result by
683 # help of xorriso.)
684 #
685 proc inquire_dev {} {
686 set disp_en_mem [set_display_msg 0]
687 send_marked_cmd "-status -dev"
688 handle_result_list set_inquired_dev "''" "''" 2 0
689 set_display_msg $disp_en_mem
690 update idletasks
691 return ""
692 }
693
694
695 # Inquire -indev and -outdev from xorriso and install in indev_adr
696 # and outdev_adr.
697 #
698 proc update_dev_var {} {
699 global result_list eff_indev_adr eff_outdev_adr indev_adr outdev_adr
700
701 inquire_dev
702 set indev_adr $eff_indev_adr
703 set outdev_adr $eff_outdev_adr
704 }
705
706
707 # Parse-by-xorriso handler function for proc isofs_ls
708 #
709 proc isofs_ls_handler {} {
710 global result_list isofs_ls_result
711
712 if {[lindex $result_list 0] == "total"} {return ""}
713 lappend isofs_ls_result \
714 "[string range [lindex $result_list 0] 0 0] [lindex $result_list 8]"
715 }
716
717
718 # Produce a list of all files in a directory of the ISO model
719 #
720 proc isofs_ls {dir} {
721 global isofs_ls_result
722
723 set isofs_ls_result ""
724 set disp_en_mem [set_display_msg 0]
725 send_marked_cmd "-lsl [make_text_shellsafe $dir]"
726 handle_result_list isofs_ls_handler "''" "''" 0 0
727 set_display_msg $disp_en_mem
728 return $isofs_ls_result
729 }
730
731
732 # Tells the file type of an absolute path in the ISO model.
733 # Indicator characters like with ls -l. Empty text means non existing file.
734 #
735 proc isofs_filetype {path} {
736 global result_list result_count scan_event_threshold
737
738 set scan_event_mem $scan_event_threshold
739 set scan_event_threshold "SORRY"
740 send_silent_cmd "-lsdl [make_text_shellsafe $path]"
741 set scan_event_threshold $scan_event_mem
742 if {$result_count < 1} {return ""}
743 return [string range [lindex $result_list 0] 0 0]
744 }
745
746
747 # Inspection of hard disk is done via xorriso.
748 # The xorriso commands have the advantage to be always available and to
749 # need no unescaping. On the other hand, shell and tcl lstat would be
750 # faster with large directories.
751
752 # Parse-by-xorriso handler function for proc localfs_ls
753 #
754 proc localfs_ls_handler {} {
755 global result_list localfs_ls_result
756
757 if {[lindex $result_list 0] == "total"} {return ""}
758 lappend localfs_ls_result \
759 "[string range [lindex $result_list 0] 0 0] [lindex $result_list 8]"
760 }
761
762
763 # Return the list of files of a hard disk filesystem directory
764 #
765 proc localfs_ls {dir} {
766 global localfs_ls_result
767
768 set localfs_ls_result ""
769 if {[localfs_filetype $dir] != "d"} {return ""}
770
771 set disp_en_mem [set_display_msg 0]
772 send_marked_cmd "-lslx [make_text_shellsafe $dir]"
773 handle_result_list localfs_ls_handler "''" "''" 0 0
774 set_display_msg $disp_en_mem
775 return $localfs_ls_result
776 }
777
778
779 # Tells the file type of an absolute path in the ISO model.
780 # Indicator characters like with ls -l. Empty text means non existing file.
781 #
782 proc localfs_filetype {path} {
783 global result_list result_count scan_event_threshold
784
785 set scan_event_mem $scan_event_threshold
786 set scan_event_threshold "SORRY"
787 send_silent_cmd "-lsdlx [make_text_shellsafe $path]"
788 set scan_event_threshold $scan_event_mem
789 if {[llength $result_list] < 1} {return ""}
790 return [string range [lindex $result_list 0] 0 0]
791 }
792
793
794 # Verify that the connected process runs a xorriso program that is modern
795 # enough. This is done before sending xorriso the setup commands.
796 #
797 proc check_xorriso_version {} {
798 global sieve_ret result_list pre_msglist xorriso_version min_xorriso_version
799 global use_command_move use_command_hardlinks_on
800 global reply_conn
801
802 set version "0.0.0 (= unknown)"
803
804 set disp_en_mem [set_display_msg 0]
805
806 # In order to see the pre-frontend messages of xorriso
807 # set an individual -mark and use send_async_cmd
808
809 set mark_text "xorriso-tcltk-version-check-[clock seconds]"
810 send_async_cmd "-mark [make_text_shellsafe $mark_text]"
811 set_display_msg $disp_en_mem
812 wait_for_msg $mark_text "M"
813
814 set_display_msg 0
815 send_async_cmd "-version"
816
817 set xorriso_version [wait_for_msg "xorriso version : " "R"]
818
819 if {$xorriso_version < $min_xorriso_version} {
820 puts stderr "xorriso-tcltk: xorriso-$xorriso_version is too old."
821 puts stderr "xorriso-tcltk: Need at least version $min_xorriso_version"
822 window_ack \
823 "xorriso-$xorriso_version is too old. Need at least version $min_xorriso_version" \
824 "red" "embedded"
825 central_exit 2
826 }
827 if {$xorriso_version < "1.2.8"} {
828 set use_command_move 0
829 }
830 if {$xorriso_version < "1.3.0"} {
831 set use_command_hardlinks_on 0
832 }
833 set_display_msg $disp_en_mem
834 }
835
836
837 # Commands which bring the connected xorriso process into the state that
838 # is expected by this frontend.
839 #
840 proc setup_xorriso {} {
841 global osirrox_allowed
842
843 set cmd ""
844
845 # Invalidate possible -mark 1
846 set cmd "$cmd -mark 0"
847
848 # Make replies digestible for await_all_replies
849 set cmd "$cmd -pkt_output on"
850
851 # Report version early
852 set cmd "$cmd -version"
853
854 # This frontend relies heavily on the message sieve
855 set cmd "$cmd -msg_op start_sieve -"
856
857 # -reassure questions from xorriso would not be properly handled by
858 # this frontend
859 set cmd "$cmd -reassure off"
860
861 set cmd "$cmd -abort_on NEVER"
862 set cmd "$cmd -return_with ABORT 32"
863 set cmd "$cmd -report_about UPDATE"
864 set cmd "$cmd -iso_rr_pattern off"
865 set cmd "$cmd -disk_pattern off"
866
867 if {$osirrox_allowed == 0} {
868 set cmd "$cmd -osirrox banned"
869 }
870
871 set cmd "$cmd [xorriso_loggable_init_cmds]"
872
873 send_marked_cmd $cmd
874 inquire_severity_list
875 }
876
877
878 # Commands which should also be at the start of a log script
879 #
880 proc xorriso_loggable_init_cmds {} {
881 global use_command_hardlinks_on
882
883 set cmd "-for_backup"
884
885 # Before xorriso-1.3.0 there is a performance problem with -hardlinks "on"
886 # and image manipulations before xorriso-1.3.0.
887 if {$use_command_hardlinks_on == 0} {
888 set cmd "$cmd -hardlinks off"
889 } else {
890 set cmd "$cmd -hardlinks on"
891 }
892
893 set cmd "$cmd -backslash_codes on"
894 set cmd "$cmd -follow mount:limit=100"
895 return $cmd
896 }
897
898
899 proc effectuate_permission_policy {} {
900 global permission_policy
901
902 if {$permission_policy == "readable"} {
903 send_loggable_cmd \
904 "-find / -exec chmod a+r -- -find / -type d -exec chmod a+x --"
905 }
906 if {$permission_policy == "readonly"} {
907 send_loggable_cmd \
908 "-find / -exec chmod a=r -- -find / -type d -exec chmod a+x --"
909 }
910 if {$permission_policy == "mkisofs_r"} {
911 send_loggable_cmd \
912 "-find / -exec mkisofs_r"
913 }
914 }
915
916
917 # ------ Parsing by help of xorriso ------
918
919 # Parsing by xorriso takes from the frontend the burden to understand
920 # and implement the quoting rules of xorriso input and output.
921 # Lines which are supposed to consist of several words get sent to
922 # xorriso command -msg_op. The result lines of this command encode
923 # the words unambiguously in one or more text lines.
924 # This is supposed to be safe for even the weirdest file names.
925 # Only NUL characters cannot be part of names.
926
927
928 # Start a bulk parser job by which xorriso shall split the output of e.g. -lsl
929 # into single words from which this frontend can pick information.
930 #
931 proc start_bulkparse {prefix separators max_words flag num_lines} {
932 global bulk_parse_prefix bulk_parse_separators
933 global bulk_parse_max_words bulk_parse_flag bulk_parse_num_texts
934
935 if {$num_lines <= 0} {return ""}
936
937 set bulk_parse_prefix $prefix
938 set bulk_parse_separators $separators
939 set bulk_parse_max_words $max_words
940 set bulk_parse_flag $flag
941 set bulk_parse_num_texts $num_lines
942 set cmd "-msg_op parse_bulk \"$prefix $separators $max_words $flag $num_lines\""
943 send_async_cmd $cmd
944 # Do not wait for mark
945 }
946
947
948 # Submit a new input line to the xorriso bulk parser job.
949 #
950 proc submit_bulkparse {text} {
951 global cmd_conn reply_conn
952 global result_list result_count
953 global bulk_parse_prefix bulk_parse_separators
954 global bulk_parse_max_words bulk_parse_flag
955
956 set disp_en_mem [set_display_msg 0]
957
958 set num_lines [expr [count_newlines $text] + 1]
959
960 debug_log_puts ">>>>> $num_lines"
961 puts $cmd_conn $num_lines
962 debug_log_puts ">>>>> $text"
963 puts $cmd_conn $text
964 flush $cmd_conn
965 set_display_msg $disp_en_mem
966 }
967
968
969 # Read the expected number of bulk parsing replies into the result buffer
970 # and call handler_proc to inspect them.
971 # Each input line of the parser yields one reply buffer full of parsed words.
972 #
973 proc read_bulkparse {handler_proc num_texts} {
974 set disp_en_mem [set_display_msg 0]
975 for {set i 0} {$i < $num_texts} {incr i} {
976 clear_reply_lists
977 read_parse_reply
978 $handler_proc
979 }
980 set_display_msg $disp_en_mem
981 }
982
983
984 # Read and decode the xorriso parser reply for one input line.
985 #
986 proc read_parse_reply {} {
987 global reply_conn
988 global result_list result_count
989
990 set sieve_result_count 0
991 set payload ""
992 set num_lines 0
993 set acc ""
994 set loop_limit 2
995 while {$result_count < $loop_limit} {
996 set ret [gets $reply_conn line]
997 if {$ret < 0} { return ""}
998 debug_log_puts $line
999 de_pkt_line $line
1000 set line [lindex $result_list [expr $result_count-1]]
1001 if {$result_count == 1} {
1002 set parse_ret $line
1003 } else { if {$result_count == 2} {
1004 set num_replies $line
1005 # The minimum number of lines
1006 set loop_limit [expr "$num_replies * 2 + 2"]
1007 } else {
1008 if {$num_lines <= 0} {
1009 set num_lines $line
1010 if {$num_lines > 1} {
1011 # Need to read extra lines
1012 incr loop_limit [expr $num_lines-1]
1013 }
1014 set acc ""
1015 } else {
1016 incr num_lines -1
1017 if {$acc != ""} {
1018 set acc "$acc\n$line"
1019 } else {
1020 set acc $line
1021 }
1022 if {$num_lines <= 0} {
1023 lappend payload $acc
1024 incr sieve_result_count
1025 }
1026 }
1027 }}
1028 }
1029 set result_list $payload
1030 set result_count $sieve_result_count
1031 }
1032
1033
1034 # Let xorriso parse the lines in the result buffer and call handler_proc
1035 # with the parse result of each line.
1036 # This is used to split the result lines of -lsl into words from which
1037 # handler proc isolist_parse_handler picks the info which it displays
1038 # in .stbox isolist .
1039 # Note that all parameters must be xorriso words. E.g. empty prefix or
1040 # separator have to be submitted as tcl string "''" rather than "".
1041 #
1042 proc handle_result_list {handler_proc \
1043 prefix separators max_words flag } {
1044 global result_list
1045 global bulk_parse_max_chunk
1046
1047 set raw_list $result_list
1048 set raw_line_count [expr [llength $raw_list]]
1049 if {$raw_line_count > $bulk_parse_max_chunk} {
1050 set chunk_size $bulk_parse_max_chunk
1051 } else {
1052 set chunk_size $raw_line_count
1053 }
1054 start_bulkparse $prefix $separators $max_words $flag $chunk_size
1055 set submit_count 0
1056 set submit_in_chunk_count 0
1057 foreach i $raw_list {
1058 submit_bulkparse $i
1059 incr submit_count
1060 incr submit_in_chunk_count
1061 if {$submit_in_chunk_count == $chunk_size} {
1062 read_bulkparse $handler_proc $chunk_size
1063 set todo [expr "$raw_line_count - $submit_count"]
1064 if {$todo <= 0} {
1065 break
1066 }
1067 if {$todo > $bulk_parse_max_chunk} {
1068 set chunk_size $bulk_parse_max_chunk
1069 } else {
1070 set chunk_size $todo
1071 }
1072 start_bulkparse $prefix $separators $max_words $flag \
1073 $chunk_size
1074 set submit_in_chunk_count 0
1075 }
1076 }
1077 display_busy 0
1078 }
1079
1080
1081 # ------------------------------- the GUI ----------------------------
1082
1083 # ------ State variables ------
1084
1085 # Whether to display messages in .msglist
1086 set display_msg_enabled 1
1087
1088 # Whether a device list is already displayed
1089 set devices_scanned 0
1090
1091 # Currently displayed ISO directory
1092 set isodir_adr ""
1093 set isodir_is_pwd 0
1094
1095 # The plain names and types matching listbox .isolist
1096 set isolist_names ""
1097 set isolist_types ""
1098
1099 # The name which to select after isodir_return
1100 set isodir_return_name ""
1101
1102 # The address where to move selected ISO files
1103 set isomanip_move_target ""
1104
1105 # Memorized isolist selection
1106 set memorized_isolist_selection ""
1107
1108 # Image file address for .burn_write_image
1109 set burn_write_image_adr ""
1110
1111 # Whether to close medium after writing
1112 set burn_write_close 0
1113
1114 # Whether to force CD TAO, DVD-R Inremental, DVD+R/BD-R open ended track
1115 set burn_write_tao 0
1116
1117 # Whether to engage Defect Management on formatted BD media
1118 set burn_write_defect_mgt 0
1119
1120 # Answer of yes/no window
1121 set answer_of_yesno ""
1122
1123 # Semi-persistent answers of yes/no window
1124 set yesno_to_all 0
1125
1126 # The hard disk filesystem address to be mapped into isodir_adr
1127 set insert_from_adr ""
1128
1129 # Whether to insert with leafname of insert_from_adr underneath isodir_adr
1130 # (else: -map $insert_from_adr $isodir_adr)
1131 set insert_underneath 1
1132
1133 # Whether to insert at or under the selected .isolist item
1134 # rather than isodir_adr
1135 set insert_at_selected 0
1136
1137 # The hard disk filesystem address to which to extract from isodir_adr
1138 set extract_to_adr ""
1139
1140 # Whether to insert with leafname of insert_from_adr underneath isodir_adr
1141 # (else: -map $insert_from_adr $isodir_adr)
1142 set extract_underneath 1
1143
1144 # Whether to insert at or under the selected .isolist item
1145 set extract_from_selected 1
1146
1147 # Whether to temporarily enforce rwx permissions for target directories on disk
1148 set extract_auto_chmod 0
1149
1150 # Whether the display label .busy_text is already usable
1151 set busy_text_exists 0
1152
1153 # Whether to demand a click before focus goes to entry or listbox
1154 set click_to_focus 1
1155
1156 # Whether .ack_window , .yesno_window , .help_window, .main_help_window
1157 # are already displayed.
1158 set ack_window_is_active 0
1159 set yesno_window_is_active 0
1160 set help_window_is_active 0
1161 set main_help_window_is_active 0
1162
1163 # Positions of above windows when they were last closed
1164 set yesno_window_geometry ""
1165 set ack_window_geometry ""
1166 set help_window_geometry ""
1167 set main_help_window_geometry ""
1168
1169 # Whether the help window already has a scroll bar
1170 set help_window_has_scroll 0
1171
1172 # Whether there is the BWidget package available: 0=unknown, 1=yes, -1=banned
1173 #
1174 set have_bwidget 0
1175 set bwidget_version ""
1176
1177 # Whether the .browse_disk_window is already displayed
1178 set browse_disk_window_is_active 0
1179 set browse_disk_window_var ""
1180 # Position of window when it was last closed
1181 set browse_disk_window_geometry ""
1182 # Whether the window is grabbed
1183 set browse_disk_window_is_grabbed 0
1184
1185 # Whether the .browse_iso_window is already displayed
1186 set browse_iso_window_is_active 0
1187 set browse_iso_window_var ""
1188 # Position of window when it was last closed
1189 set browse_iso_window_geometry ""
1190 # Whether the window is grabbed
1191 set browse_iso_window_is_grabbed 0
1192
1193 # Whether to modify the ISO file permissions before writing the ISO session
1194 # Policies: as_is , readable , readonly , mkisofs_r
1195 set permission_policy "as_is"
1196
1197
1198 # ------ GUI callback procedures ----
1199
1200
1201 # Called when the Return key is hit in commandline.
1202 #
1203 proc cmdline_return {} {
1204 global cmdline cmdline_clear
1205 global .cmdline .cmdline_text .cmdline_entry
1206 global highest_cmd_sev
1207 global highest_cmd_sev_msg
1208
1209 reset_highest_cmd_sev
1210 set_display_msg 1
1211 send_loggable_cmd $cmdline
1212 set cmdline ""
1213
1214 # To force display of GUI changes now and not some time later
1215 update idletasks
1216 }
1217
1218
1219 # Called when the input drive address shall be brought into effect with
1220 # xorriso.
1221 #
1222 proc indev_return {} {
1223 global indev_adr
1224 global .indev_entry
1225 global .outdev_entry
1226
1227 if {[assert_no_changes] == 0} {
1228 update_dev_var
1229 return "0"
1230 }
1231 reset_highest_cmd_sev
1232 send_loggable_cmd "-indev [make_text_shellsafe $indev_adr]"
1233 set indev_mem_adr $indev_adr
1234 .indev_entry icursor 0
1235 refresh_indev
1236 return "1"
1237 }
1238
1239
1240 # Called when the "Eject" button for the input drive is hit.
1241 #
1242 proc eject_indev {} {
1243 if {[assert_no_changes] == 0} {return ""}
1244 reset_highest_cmd_sev
1245 send_loggable_cmd "-eject indev"
1246 refresh_outdev
1247 refresh_indev
1248 }
1249
1250
1251 # Called when the output drive address shall be brought into effect with
1252 # xorriso.
1253 #
1254 proc outdev_return {} {
1255 global outdev_adr indev_adr
1256 global .outdev_entry
1257
1258 reset_highest_cmd_sev
1259 send_loggable_cmd "-outdev [make_text_shellsafe $outdev_adr]"
1260 set outdev_mem_adr $outdev_adr
1261 .outdev_entry icursor 0
1262 refresh_outdev
1263 return "1"
1264 }
1265
1266
1267 # Called when the "Eject" button for the output drive is hit.
1268 #
1269 proc eject_outdev {} {
1270 global outdev_adr indev_adr
1271
1272 if {$outdev_adr == $indev_adr} {
1273 if {[assert_no_changes] == 0} {return ""}
1274 }
1275 reset_highest_cmd_sev
1276 send_loggable_cmd "-eject outdev"
1277 refresh_outdev
1278 refresh_indev
1279 }
1280
1281
1282 # Called when both drive addresses shall be brought into effect with xorriso.
1283 #
1284 proc dev_return {} {
1285 global outdev_adr indev_adr
1286 global .outdev_entry .indev_entry
1287
1288 if {$outdev_adr != $indev_adr} {
1289 if {[indev_return] == 0} {return "0"}
1290 outdev_return
1291 } else {
1292 if {[assert_no_changes] == 0} {
1293 update_dev_var
1294 return "0"
1295 }
1296 reset_highest_cmd_sev
1297 send_loggable_cmd "-dev [make_text_shellsafe $outdev_adr]"
1298 .outdev_entry icursor 0
1299 refresh_outdev
1300 .indev_entry icursor 0
1301 refresh_indev
1302 }
1303 }
1304
1305
1306 # Obtain and display the input drive status.
1307 # Called after the input drive address may have changed.
1308 #
1309 proc refresh_indev {} {
1310 global result_list
1311 global indev_adr
1312 global sieve_ret
1313 global .indev_summary
1314
1315 .indev_summary configure -text ""
1316 set indev_adr ""
1317 update idletasks
1318
1319 set disp_en_mem [set_display_msg 0]
1320 clear_sieve
1321 send_marked_cmd "-toc_of in:short"
1322 read_sieve "Drive current:"
1323 set_display_msg $disp_en_mem
1324 if {$sieve_ret > 0} {
1325 set cmd [lindex $result_list 0]
1326 if {$cmd == "-indev" || $cmd == "-dev"} {
1327 set indev_adr [lindex $result_list 1]
1328 }
1329 set line [obtain_drive_info in]
1330 .indev_summary configure -text $line
1331 }
1332 .avail_label configure -text ""
1333 update idletasks
1334 isodir_return "refresh_indev"
1335 }
1336
1337
1338 # Obtain and display the output drive status.
1339 # Called after the output drive address may have changed.
1340 #
1341 proc refresh_outdev {} {
1342 global result_list
1343 global outdev_adr
1344 global sieve_ret
1345
1346 .outdev_summary configure -text ""
1347 set outdev_adr ""
1348 update idletasks
1349
1350 set disp_en_mem [set_display_msg 0]
1351 clear_sieve
1352 send_marked_cmd "-toc_of out:short"
1353 read_sieve "Drive current:"
1354 set_display_msg $disp_en_mem
1355 if {$sieve_ret > 0} {
1356 set cmd [lindex $result_list 0]
1357 if {$cmd == "-outdev" || $cmd == "-dev"} {
1358 set outdev_adr [lindex $result_list 1]
1359 }
1360 set line [obtain_drive_info out]
1361 .outdev_summary configure -text $line
1362 }
1363 .avail_label configure -text ""
1364 update idletasks
1365 }
1366
1367
1368 # Scan the system for optical drives with rw permission
1369 # Called when the "Scan for drives button" is hit.
1370 #
1371 proc scan_for_drives {} {
1372 global .drivelist .drive_drop_both .drive_scan
1373 global sieve_ret result_list devlist devices_scanned indev_adr outdev_adr
1374
1375 if {[assert_no_changes] == 0} {return ""}
1376 if {$indev_adr != "" || $outdev_adr != ""} {
1377 if {[window_yesno \
1378 "Really give up acquired drives for scanning a new drive list ?"] \
1379 != 1} { return "" }
1380 }
1381
1382 set max_idx [.drivelist index end]
1383 .drivelist delete 0 [expr $max_idx-1]
1384 set devlist ""
1385
1386 reset_highest_cmd_sev
1387 clear_sieve
1388 send_loggable_cmd "-devices"
1389 set max_idx 0
1390 while {1} {
1391 read_sieve "? -dev"
1392 if {$sieve_ret > 0} {
1393 .drivelist insert end "[lindex $result_list 0] : [lindex $result_list 2] [lindex $result_list 3]"
1394 lappend devlist [lindex $result_list 0]
1395 } else {
1396 break
1397 }
1398 }
1399 while {1} {
1400 read_sieve "?? -dev"
1401 if {$sieve_ret > 0} {
1402 .drivelist insert end "[lindex $result_list 0] : [lindex $result_list 2] [lindex $result_list 3]"
1403 lappend devlist [lindex $result_list 0]
1404 } else {
1405 break
1406 }
1407 }
1408 set devices_scanned 1
1409 reset_to_normal_background .drive_scan
1410
1411 # Command -devices drops all acquired drives
1412 refresh_outdev
1413 refresh_indev
1414 }
1415
1416
1417 # Refresh the display after some xorriso may have changed the status
1418 # Called by the "Refresh disp" button and others.
1419 #
1420 proc refresh_state {} {
1421 refresh_indev
1422 refresh_outdev
1423 }
1424
1425
1426 # Reset the recorded Worst problem message.
1427 # Called when the "Clear" button is hit.
1428 #
1429 proc clear_total_errmsg {} {
1430 global highest_total_sev
1431 global highest_total_sev_msg
1432
1433 set highest_total_sev ALL
1434 set highest_total_sev_msg ""
1435 update idletasks
1436 }
1437
1438
1439 # Called when the "Pick input drive button" is hit.
1440 #
1441 proc pick_indev {} {
1442 pick_drive indev
1443 }
1444
1445
1446 # Called when the "Pick output drive button" is hit.
1447 #
1448 proc pick_outdev {} {
1449 pick_drive outdev
1450 }
1451
1452
1453 # Called when the "Pick drive for both roles" button is hit.
1454 # or when an item in the scanned drive list is double-clicked.
1455 #
1456 proc pick_dev {} {
1457 pick_drive dev
1458 }
1459
1460
1461 # Perform the actual work of pick_dev, pick_indev, and pick_outdev
1462 #
1463 proc pick_drive {role} {
1464 global .drivelist
1465 global devlist
1466 global highest_cmd_sev_msg outdev_adr indev_adr devices_scanned
1467
1468 set selected [.drivelist curselection]
1469 if {[llength $selected] != 1} {
1470 set must_scan ""
1471 if {$devices_scanned == 0} { set must_scan " scan and"}
1472 xorriso_tcltk_errmsg \
1473 "xorriso-tcltk : SORRY : First you must$must_scan select a single drive"
1474 return ""
1475 }
1476 set drive_idx [lindex $selected 0]
1477
1478 if {$role == "dev"} {
1479 set outdev_adr [lindex $devlist $drive_idx]
1480 set indev_adr [lindex $devlist $drive_idx]
1481 dev_return
1482 }
1483 if {$role == "outdev"} {
1484 set outdev_adr [lindex $devlist $drive_idx]
1485 outdev_return
1486 }
1487 if {$role == "indev"} {
1488 set indev_adr [lindex $devlist $drive_idx]
1489 indev_return
1490 }
1491 .drivelist selection clear 0 end
1492 }
1493
1494
1495 # Called when the "Give up drives" button is hit.
1496 #
1497 proc give_up_dev {} {
1498 global outdev_adr indev_adr
1499
1500 if {[assert_no_changes] == 0} {return ""}
1501 set outdev_adr ""
1502 outdev_return
1503 set indev_adr ""
1504 indev_return
1505 }
1506
1507
1508 # Obtain and display the content of the current ISO directory.
1509 # Called when the Return key is hit in the .isodir_entry text field
1510 # and by many others which change variable isodir_adr or the
1511 # content of the directory in xorriso's tree model.
1512 #
1513 proc isodir_return {caller} {
1514 global isodir_adr result_list isolist_names isolist_types isodir_return_name
1515 global isodir_is_pwd highest_cmd_sev highest_cmd_sev_msg
1516 global indev_adr outdev_adr eff_indev_adr
1517 global .isolist
1518 global bulk_parse_max_chunk
1519
1520 set chunk_size 0
1521
1522 set max_idx [.isolist index end]
1523 .isolist delete 0 [expr "$max_idx-1"]
1524 update idletasks
1525 set isolist_names ""
1526 set isolist_types ""
1527
1528 inquire_dev
1529 if {$eff_indev_adr == "" && [changes_are_pending] == "0"} {return ""}
1530
1531 normalize_isodir_adr
1532 set file_type [isofs_filetype $isodir_adr]
1533 if {$file_type != "d" && $file_type != ""} {
1534 .isolist insert end "@@@ exists but is not a directory @@@"
1535 set isodir_is_pwd 0
1536 return ""
1537 }
1538 set disp_en_mem [set_display_msg 0]
1539 set highest_cmd_sev_mem $highest_cmd_sev
1540 set highest_cmd_sev_msg_mem $highest_cmd_sev_msg
1541 reset_highest_cmd_sev
1542 send_loggable_cmd "-cd [make_text_shellsafe $isodir_adr]"
1543 if {[compare_sev $highest_cmd_sev "WARNING"] < 0} {
1544 send_marked_cmd "-lsl --"
1545 set isodir_is_pwd 1
1546 } else {
1547 send_marked_cmd "-lsl [make_text_shellsafe $isodir_adr] --"
1548 set isodir_is_pwd 0
1549 }
1550 handle_result_list isolist_parse_handler "''" "''" 0 0
1551 set_display_msg $disp_en_mem
1552 set highest_cmd_sev $highest_cmd_sev_mem
1553 set highest_cmd_sev_msg $highest_cmd_sev_msg_mem
1554
1555 if {$isodir_return_name != ""} {
1556 set idx [lsearch -exact $isolist_names $isodir_return_name]
1557 if {$idx != -1} {
1558 .isolist see $idx
1559 .isolist selection set $idx
1560 }
1561 set isodir_return_name ""
1562 }
1563 update idletasks
1564 }
1565
1566
1567 # The handler procedure that is submitted to proc handle_result_list
1568 # and will be called for every parsed line.
1569 # It records file names and types in separate lists and displays them
1570 # in the .isolist box.
1571 #
1572 proc isolist_parse_handler {} {
1573 global result_list isolist_names isolist_types
1574 global .isolist
1575
1576 if {[lindex $result_list 0] == "total"} {return ""}
1577 set name [lindex $result_list 8]
1578 set ftype [string range [lindex $result_list 0] 0 0]
1579 lappend isolist_names $name
1580 lappend isolist_types $ftype
1581 .isolist insert end "$ftype $name"
1582 }
1583
1584
1585 # Make current the ISO directory that was selected from the .isolist box.
1586 # Called when an item in the .isolist box is double-clicked.
1587 #
1588 proc pick_isodir {} {
1589 global isolist_names isolist_types isodir_adr isodir_return_name
1590 global .isolist
1591
1592 set selected [.isolist curselection]
1593 if {[llength $selected] != 1} {
1594 xorriso_tcltk_errmsg \
1595 "xorriso-tcltk : SORRY : First you must select a single directory"
1596 return ""
1597 }
1598 set idx [lindex $selected 0]
1599 if {[lindex $isolist_types $idx] != "d"} { return "" }
1600 if {$isodir_adr == "/"} {
1601 set isodir_adr ""
1602 }
1603 set isodir_adr "$isodir_adr/[lindex $isolist_names $idx]"
1604 set isodir_return_name ""
1605 isodir_return "pick_isodir"
1606 }
1607
1608
1609 # Make current the parent directory of the current ISO directory.
1610 # Called when the "Up" button is hit.
1611 #
1612 proc isodir_up {} {
1613 global isodir_adr isodir_return_name
1614
1615 set isodir_return_name ""
1616 set idx [string last "/" $isodir_adr]
1617 set l [string length $isodir_adr]
1618 if {$idx == -1} {
1619 set isodir_return_name $isodir_adr
1620 set isodir_adr "/"
1621 } else {
1622 if {$idx > 0} {
1623 if {$idx < [expr $l - 1]} {
1624 set isodir_return_name \
1625 [string range $isodir_adr [expr $idx+1] end]
1626 }
1627 set isodir_adr [string range $isodir_adr 0 [expr $idx - 1]]
1628 } else {
1629 if {$l > 1} {
1630 set isodir_return_name [string range $isodir_adr 1 end]
1631 }
1632 set isodir_adr "/"
1633 }
1634 }
1635 isodir_return "isodir_up"
1636 }
1637
1638
1639 # Rename or move the files which are selected in the .isolist box.
1640 # The target is defined by the .isomanip_move_target text field.
1641 # Called when the "Move to:" button is hit.
1642 #
1643 proc isomanip_mv {} {
1644 global .isolist
1645 global isomanip_move_target isolist_names isodir_is_pwd isodir_adr
1646 global isodir_return_name use_command_move
1647
1648 if {$isomanip_move_target == ""} {
1649 xorriso_tcltk_errmsg \
1650 "xorriso-tcltk : SORRY : First you must enter a target address"
1651 return ""
1652 }
1653 set selected [.isolist curselection]
1654 set num_selected [llength $selected]
1655 if {$num_selected < 1} {
1656 xorriso_tcltk_errmsg \
1657 "xorriso-tcltk : SORRY : First you must select one or more ISO files"
1658 return ""
1659 }
1660
1661 set target $isomanip_move_target
1662 if {$isodir_is_pwd == 0 && [string range $target 0 0] != "/"} {
1663 set target [combine_dir_and_name $isodir_adr $target]
1664 }
1665 set target_ftype [isofs_filetype $target]
1666
1667 # If more than one selected : target must be directory
1668 if {$num_selected > 1} {
1669 if {$target_ftype != "d" && $target_ftype != ""} {
1670 xorriso_tcltk_errmsg \
1671 "xorriso-tcltk : SORRY : If multiple files are selected then the target must be a directory"
1672 return ""
1673 }
1674 if {$target_ftype == ""} {
1675 set isomanip_move_target_mem $isomanip_move_target
1676 set isomanip_move_target $target
1677 isomanip_mkdir
1678 set isomanip_move_target $isomanip_move_target_mem
1679 }
1680 }
1681
1682 enforce_overwrite_settings "isofs"
1683 reset_highest_cmd_sev
1684 reset_yesno_to_all
1685 set multi_source 0
1686 if {[llength $selected] != 1} {set multi_source 1}
1687 foreach i $selected {
1688 set name [lindex $isolist_names $i]
1689 if {$isodir_is_pwd == 0} {
1690 set name [combine_dir_and_name $isodir_adr $name]
1691 }
1692 set name_ftype [isofs_filetype $name]
1693
1694 # Ask for confirmation if overwriting is about to happen
1695 if {$target_ftype == "d" && $use_command_move == 0} {
1696 set eff_target [combine_dir_and_name $target $name]
1697 set eff_target_ftype [isofs_filetype $eff_target]
1698 } else {
1699 set eff_target $target
1700 set eff_target_ftype $target_ftype
1701 }
1702 if {[handle_overwriting "isofs" $eff_target $eff_target_ftype \
1703 "isofs" $name $name_ftype $multi_source \
1704 "" "" "replace"] == "0"} {
1705 if {$multi_source == 0} { return "" }
1706 continue
1707 }
1708 if {$use_command_move == 0} {
1709 send_loggable_cmd \
1710 "-mv [make_text_shellsafe $name] [make_text_shellsafe $target] --"
1711 } else {
1712 send_loggable_cmd \
1713 "-move [make_text_shellsafe $name] [make_text_shellsafe $target] --"
1714 }
1715 }
1716
1717 if {[llength $selected] == 1} {
1718 set isodir_return_name [path_touches_isodir $target]
1719 }
1720 browse_iso_refresh
1721 isodir_return "isomanip_mv"
1722 }
1723
1724
1725 # Create an empty ISO directory with address given by variable
1726 # isomanip_move_target.
1727 # Called when the "Make dir" button is hit or by other functions.
1728 #
1729 proc isomanip_mkdir {} {
1730 global isomanip_move_target isodir_adr isodir_return_name
1731
1732 if {$isomanip_move_target == ""} {
1733 xorriso_tcltk_errmsg \
1734 "xorriso-tcltk : SORRY : First you must enter a target address"
1735 return ""
1736 }
1737
1738 if {[string range $isomanip_move_target 0 0] == "/"} {
1739 set abs_adr $isomanip_move_target
1740 } else {
1741 set abs_adr [combine_dir_and_name $isodir_adr $isomanip_move_target]
1742 }
1743 reset_highest_cmd_sev
1744 send_loggable_cmd "-mkdir [make_text_shellsafe $abs_adr] --"
1745
1746 # Refresh only if new dir in isodir_adr
1747 # or if a parent directory of new dir is created in isodir_adr
1748 set touch_name [path_touches_isodir $abs_adr]
1749 if {$touch_name != ""} {
1750 if {[llength [.isolist curselection]] != 0} {
1751 memorize_isolist_selection
1752 set selection_memorized 1
1753 } else {
1754 set isodir_return_name $touch_name
1755 set selection_memorized 0
1756 }
1757 isodir_return "isomanip_mkdir"
1758 if {$selection_memorized != 0} {
1759 restore_isolist_selection
1760 }
1761 }
1762 browse_iso_refresh
1763 }
1764
1765
1766 # Remove a file or directory tree from the ISO image.
1767 # Called when the "Delete" button is hit.
1768 #
1769 proc isomanip_rm_r {} {
1770 global .isolist
1771 global isomanip_move_target isolist_names isodir_is_pwd isodir_adr
1772
1773 set selected [.isolist curselection]
1774 if {[llength $selected] < 1} {
1775 xorriso_tcltk_errmsg \
1776 "xorriso-tcltk : SORRY : First you must select one or more ISO files"
1777 return ""
1778 }
1779 if {[window_yesno "Really delete the selected files from ISO image ?"] \
1780 != 1} { return "" }
1781 reset_highest_cmd_sev
1782 foreach i $selected {
1783 set name [lindex $isolist_names $i]
1784 if {$isodir_is_pwd == 0} {
1785 set name [combine_dir_and_name $isodir_adr $name]
1786 }
1787 send_loggable_cmd "-rm_r [make_text_shellsafe $name] --"
1788 }
1789 browse_iso_refresh
1790 isodir_return "isomanip_rm_r"
1791 }
1792
1793
1794 # Perform a blanking run on the output drive.
1795 # Called when the "Blank" button is hit.
1796 #
1797 proc burn_blank {} {
1798 global outdev_profile eff_outdev_adr eff_indev_adr
1799
1800 refresh_outdev
1801 if {[assert_outdev blanking] <= 0} {return ""}
1802
1803 if {$eff_outdev_adr == $eff_indev_adr} {
1804 if {[assert_no_changes] <= 0} {return ""}
1805 }
1806 set victim "medium in"
1807 if {[string first "stdio" $outdev_profile] == 0} {
1808 set victim "image file"
1809 }
1810 if {[window_yesno \
1811 "Really blank the $victim [make_text_shellsafe $eff_outdev_adr] ?"] \
1812 != 1} { return "" }
1813 reset_highest_cmd_sev
1814 send_loggable_cmd "-blank as_needed"
1815 refresh_indev
1816 refresh_outdev
1817 }
1818
1819
1820 # Perform a formatting run on the output drive.
1821 # Called when the "Format" button is hit.
1822 #
1823 proc burn_format {} {
1824 global outdev_profile eff_outdev_adr eff_indev_adr
1825
1826 refresh_outdev
1827 if {[assert_outdev formatting] <= 0} {return ""}
1828 if {$eff_outdev_adr == $eff_indev_adr} {
1829 if {[assert_no_changes] <= 0} {return ""}
1830 }
1831
1832 if {[string first "stdio" $outdev_profile] == 0} {
1833 xorriso_tcltk_errmsg \
1834 "xorriso-tcltk : SORRY : Image files cannot be formatted"
1835 return ""
1836 }
1837 if {[window_yesno "Really format the medium in $eff_outdev_adr ?"] \
1838 != 1} { return "" }
1839
1840 reset_highest_cmd_sev
1841 send_loggable_cmd "-format as_needed"
1842 refresh_indev
1843 refresh_outdev
1844 }
1845
1846
1847 # Write pending changes in the xorriso ISO model as session to the output
1848 # drive. This will be an add-on session if the drive is output and input drive
1849 # and if its medium is not blank.
1850 # Else it will be a new independent ISO image.
1851 #
1852 proc burn_commit {} {
1853 global outdev_adr result_list result_count outdev_medium_status
1854 global burn_write_close burn_write_tao burn_write_defect_mgt
1855 global indev_adr outdev_adr permission_policy
1856
1857 if {[assert_outdev "writing an ISO session"] <= 0} {return ""}
1858 if {$outdev_adr == $indev_adr} {
1859 if {$outdev_medium_status != "blank" && \
1860 $outdev_medium_status != "appendable"} {
1861 xorriso_tcltk_errmsg \
1862 "xorriso-tcltk : SORRY : Medium in output drive is neither blank nor appendable"
1863 return ""
1864 }
1865 } else {
1866 if {$outdev_medium_status != "blank"} {
1867 xorriso_tcltk_errmsg \
1868 "xorriso-tcltk : SORRY : Medium in output drive is not blank"
1869 return ""
1870 }
1871 }
1872 if {[changes_are_pending] == "0"} {
1873 window_ack "No changes are pending. Will not write ISO session." \
1874 "grey" "toplevel"
1875 return ""
1876 }
1877 if {$outdev_adr == $indev_adr} {
1878 if {[window_yesno "Really write ISO changes as session to $outdev_adr ?"] \
1879 != 1} { return "" }
1880 } else {
1881 if {[window_yesno "Really write a new ISO filesystem to $outdev_adr ?"] \
1882 != 1} { return "" }
1883 }
1884
1885 reset_highest_cmd_sev
1886 effectuate_permission_policy
1887 set cmd "-close"
1888 if {$burn_write_close == 1} {
1889 set cmd "$cmd on"
1890 } else {
1891 set cmd "$cmd off"
1892 }
1893 set cmd "$cmd -write_type"
1894 if {$burn_write_tao == 1} {
1895 set cmd "$cmd tao"
1896 } else {
1897 set cmd "$cmd auto"
1898 }
1899 set cmd "$cmd -stream_recording"
1900 if {$burn_write_defect_mgt == 1} {
1901 set cmd "$cmd off"
1902 } else {
1903 set cmd "$cmd data"
1904 }
1905 set cmd "$cmd -commit"
1906 send_loggable_cmd $cmd
1907 refresh_indev
1908 refresh_outdev
1909 }
1910
1911
1912 # Verify the MD5 checksums of the data files in the tree underneath the
1913 # current ISO directory.
1914 # Called when the "Verify" in the "ISO directory:" line is hit.
1915 #
1916 proc isodir_verify {} {
1917 global isodir_adr
1918
1919 reset_highest_cmd_sev
1920 send_loggable_cmd "-check_md5_r sorry [make_text_shellsafe $isodir_adr] --"
1921
1922 # >>> select mismatching files or directories with mismatching files
1923
1924 }
1925
1926
1927 # Verify the MD5 checksums of the data files orch are selected or which
1928 # sit in the trees underneath the selected items in the isolist box.
1929 # Called when the "Verify" in the "Selection:" line is hit.
1930 #
1931 proc isomanip_verify {} {
1932 global .isolist
1933 global isomanip_move_target isolist_names isodir_is_pwd isodir_adr
1934
1935 set selected [.isolist curselection]
1936 if {[llength $selected] < 1} {
1937 xorriso_tcltk_errmsg \
1938 "xorriso-tcltk : SORRY : First you must select one or more ISO files"
1939 return ""
1940 }
1941 reset_highest_cmd_sev
1942 foreach i $selected {
1943 set name [combine_dir_and_name $isodir_adr \
1944 [lindex $isolist_names $i]]
1945 send_loggable_cmd "-check_md5_r sorry [make_text_shellsafe $name] --"
1946 }
1947
1948 # >>> select mismatching files or directories with mismatching files
1949
1950 }
1951
1952
1953 # Slow down the spinning of the acquired optical drives.
1954 # Called when button "Calm drives" is hit.
1955 #
1956 proc calm_drives {} {
1957 reset_highest_cmd_sev
1958 send_loggable_cmd "-calm_drive all"
1959 }
1960
1961
1962 # Burn a data file from disk as session to the output drive.
1963 # Called when the "Burn image file:" button is hit.
1964 #
1965 proc burn_write_image {} {
1966 global burn_write_image_adr burn_write_close outdev_adr outdev_medium_status
1967 global outdev_profile burn_write_tao burn_write_defect_mgt indev_adr
1968
1969 update_dev_var
1970 if {$indev_adr != ""} {
1971 xorriso_tcltk_errmsg \
1972 "xorriso-tcltk : SORRY : You may not have an input drive open when writing an image file"
1973 return ""
1974 }
1975
1976 if {[assert_outdev "writing an image file"] <= 0} {return ""}
1977 if {$burn_write_image_adr == ""} {
1978 xorriso_tcltk_errmsg \
1979 "xorriso-tcltk : SORRY : You have to set an image file address in the hard disk filesystem first"
1980 return ""
1981 }
1982
1983 if {$outdev_medium_status != "blank"} {
1984 xorriso_tcltk_errmsg \
1985 "xorriso-tcltk : SORRY : You must have a blank medium in the output drive for burning an image data file"
1986 return ""
1987 }
1988 if {[file readable $burn_write_image_adr] == 0 || \
1989 [file isfile $burn_write_image_adr] == 0 ||
1990 [file exists $burn_write_image_adr] == 0} {
1991 xorriso_tcltk_errmsg \
1992 "xorriso-tcltk : SORRY : Image file '$burn_write_image_adr' is not a readable data file"
1993 return ""
1994 }
1995 if {[window_yesno "Really write '$burn_write_image_adr' as image to $outdev_adr ?"] \
1996 != 1} { return "" }
1997
1998 set cmd "-as cdrecord -v"
1999 if {[regexp "^CD" $outdev_profile] == 1 && \
2000 ( $outdev_medium_status == "appendable" || $burn_write_tao == 1 )} {
2001 set cmd "$cmd padsize=150s"
2002 }
2003 set cmd "$cmd dev=[make_text_shellsafe $outdev_adr]"
2004 set cmd "$cmd [make_text_shellsafe $burn_write_image_adr]"
2005 if {$burn_write_tao == 1} {
2006 set cmd "$cmd -tao"
2007 }
2008 if {$burn_write_close != 1} {
2009 set cmd "$cmd -multi"
2010 }
2011 if {$burn_write_defect_mgt == 1} {
2012 set cmd "$cmd stream_recording=off"
2013 } else {
2014 set cmd "$cmd stream_recording=32s"
2015 }
2016 reset_highest_cmd_sev
2017 send_loggable_cmd $cmd
2018 refresh_state
2019 }
2020
2021
2022 # Discard all image modifications and reload ISO image model from input drive.
2023 # Called when the "Rollback" button is hit.
2024 #
2025 proc iso_rollback {} {
2026 if {[window_yesno \
2027 "Really discard all pending changes and reload from input drive ?"] \
2028 != 1} { return "" }
2029 reset_highest_cmd_sev
2030 send_loggable_cmd "-rollback"
2031 .avail_label configure -text ""
2032 isodir_return "iso_rollback"
2033 }
2034
2035
2036 # Inquire an accurate prediction of free space after writing a session with
2037 # the pending changes of the ISO image.
2038 # Called when button "Refresh avail:" is hit.
2039 #
2040 proc refresh_avail {} {
2041 global result_list highest_cmd_sev
2042 global sieve_ret
2043
2044 if {[assert_outdev "refreshing available space prediction"] <= 0} {return ""}
2045
2046 set line "n.a."
2047 reset_highest_cmd_sev
2048 clear_sieve
2049 send_loggable_cmd "-tell_media_space"
2050 if {[compare_sev $highest_cmd_sev "FAILURE"] < 0} {
2051 set ac ""
2052 read_sieve "After commit :"
2053 if {$sieve_ret > 0} {
2054 set ac [lindex $result_list 0]
2055 set ac [string range $ac 0 [expr [string length $ac] - 2]]
2056 set line "[format "%7dm" [expr "$ac / 512"]]"
2057 }
2058 }
2059 .avail_label configure -text $line
2060 }
2061
2062
2063 # Warn and prompt the user for confirmation if there is the risk to overwrite
2064 # existing files on hard disk or in the ISO image model.
2065 # Called from several procedures which cause side effects on directory trees.
2066 #
2067 proc handle_overwriting {target_fs target target_ftype
2068 source_fs source source_ftype multi_source
2069 selected_adr selected_ftype dir_action} {
2070 global overwrite_iso_files overwrite_iso_dirs overwrite_disk_files
2071
2072 if {$target_fs == "localfs"} {
2073 set to_fs "hard disk"
2074 set overwrite_fs "disk"
2075 set overwrite_dirs 0
2076 set overwrite_files $overwrite_disk_files
2077 } else {
2078 set to_fs "ISO"
2079 set overwrite_fs "ISO"
2080 set overwrite_dirs $overwrite_iso_dirs
2081 set overwrite_files $overwrite_iso_files
2082 }
2083 if {$source_fs == "localfs"} {
2084 set from_fs "hard disk"
2085 } else {
2086 set from_fs "ISO"
2087 }
2088 if {$multi_source == 1} {
2089 set what_window window_yesno_ever
2090 } else {
2091 set what_window window_yesno
2092 }
2093
2094 # >>> Nicer would be:
2095 # >>> Check if any file will get overwritten. Not only the direct target.
2096 # >>> Then silently allow directories to be merged
2097
2098 if {$target_ftype != ""} {
2099 if {$target_ftype == "d"} {
2100 if {$source_ftype == "d"} {
2101 if {$dir_action == "replace"} {
2102 if {$overwrite_iso_dirs != 1} {
2103 xorriso_tcltk_errmsg "xorriso-tcltk : SORRY : You would have to enable \"Overwrite $overwrite_fs dirs\" for\n[make_text_shellsafe $target]"
2104 return "0"
2105 }
2106 if {[$what_window \
2107 "Really replace existing $to_fs directory\n\n[make_text_shellsafe $target]\n\nby $from_fs directory\n[make_text_shellsafe $source]\n?"] \
2108 != 1} { return "0" }
2109 return "1"
2110 }
2111 if {[$what_window \
2112 "Really merge existing $to_fs directory\n\n[make_text_shellsafe $target]\n\nwith $from_fs directory\n[make_text_shellsafe $source]\n?"] \
2113 != 1} { return "0" }
2114 } else {
2115 if {$target_fs != "isofs"} {
2116 xorriso_tcltk_errmsg "xorriso-tcltk : SORRY : Will not replace directory on hard disk by file of other type\n[make_text_shellsafe $target]"
2117 return "0"
2118 }
2119 if {$overwrite_dirs == 1} {
2120 if {[$what_window \
2121 "Really overwrite $to_fs directory\n\n[make_text_shellsafe $target]\n\nby $from_fs file\n[make_text_shellsafe $source]\n?"] \
2122 != 1} { return "0" }
2123 } else {
2124 xorriso_tcltk_errmsg "xorriso-tcltk : SORRY : You would have to enable \"Overwrite $overwrite_fs dirs\" for\n[make_text_shellsafe $target]"
2125 return "0"
2126 }
2127 }
2128 } else {
2129 if {$overwrite_files == 1} {
2130 if {[$what_window \
2131 "Really overwrite $to_fs file\n\n[make_text_shellsafe $target]\n\nby $from_fs file\n[make_text_shellsafe $source]\n?"] != 1} {
2132 return "0"
2133 }
2134 } else {
2135 xorriso_tcltk_errmsg "xorriso-tcltk : SORRY : You would have to enable \"Overwrite $overwrite_fs files\" for\n[make_text_shellsafe $target]"
2136 return "0"
2137 }
2138 }
2139 }
2140 if {$selected_adr != $target && $selected_adr != "" && \
2141 $selected_ftype != "d" && $selected_ftype != ""} {
2142 if {[$what_window \
2143 "Really replace existing $to_fs file\n\n[make_text_shellsafe $target]\n\nby $from_fs directory\n[make_text_shellsafe $source]\n?"] != 1} {
2144 return "0"
2145 }
2146 }
2147 return "1"
2148 }
2149
2150
2151 # Insert a file or directory tree into the ISO model tree and schedule it
2152 # for being copied when "Write ISO session" is hit.
2153 # Called when button "Insert from disk:" is hit.
2154 #
2155 proc insert_from {} {
2156 global insert_from_adr isodir_adr isolist_names isodir_return_name
2157 global insert_at_selected insert_underneath
2158
2159 if {[assert_iso_image 1] == 0} {return ""}
2160 if {$insert_from_adr == ""} {
2161 xorriso_tcltk_errmsg \
2162 "xorriso-tcltk : SORRY : You have to set a source address in the hard disk filesystem first"
2163 return ""
2164 }
2165 set selected_ftype ""
2166 set selected_adr ""
2167 if {$insert_at_selected == 1} {
2168 set selected [.isolist curselection]
2169 if {[llength $selected] != 1} {
2170 xorriso_tcltk_errmsg "xorriso-tcltk : SORRY : You must select exactly one ISO file as insertion target"
2171 return ""
2172 }
2173 set target "[lindex $isolist_names [lindex $selected 0]]"
2174 set selected_ftype [isofs_filetype $target]
2175 set selected_adr $target
2176 } else {
2177 set target $isodir_adr
2178 }
2179 set source_ftype [localfs_filetype $insert_from_adr]
2180 set name [file tail $insert_from_adr]
2181 if {$insert_underneath == 1 || $source_ftype == "d"} {
2182 set target [combine_dir_and_name $target $name]
2183 }
2184 set target_ftype [isofs_filetype $target]
2185
2186 reset_yesno_to_all
2187 if {[handle_overwriting "isofs" $target $target_ftype \
2188 "localfs" $insert_from_adr $source_ftype 0 \
2189 $selected_adr $selected_ftype "merge"] == "0"} {
2190 return ""
2191 }
2192
2193 set preserve_selection 0
2194 if {$insert_underneath + $insert_at_selected == 1} {
2195 set isodir_return_name $name
2196 } else {
2197 set preserve_selection 1
2198 }
2199 reset_highest_cmd_sev
2200 enforce_overwrite_settings "isofs"
2201 send_loggable_cmd "-map [make_text_shellsafe $insert_from_adr] [make_text_shellsafe $target]"
2202
2203 if {$preserve_selection == 1} {
2204 memorize_isolist_selection
2205 }
2206 isodir_return "insert_from"
2207 if {$preserve_selection == 1} {
2208 restore_isolist_selection
2209 }
2210 browse_iso_refresh
2211 }
2212
2213
2214 # Copy a file out of the ISO image model to the hard disk filesystem.
2215 # The meta data stem from the ISO model tree. The content data are usually
2216 # read from the input drive.
2217 # Called when button "Extract to disk:" is hit.
2218 #
2219 proc extract_to {} {
2220 global extract_to_adr extract_from_selected extract_underneath
2221 global extract_auto_chmod osirrox_allowed
2222 global isodir_adr isolist_names
2223
2224 if {$osirrox_allowed != 1} {
2225 xorriso_tcltk_errmsg \
2226 "xorriso-tcltk : SORRY : Extraction from ISO to hard disk is already irrevocably banned."
2227 return ""
2228 }
2229
2230 if {[assert_iso_image 1] == 0} {return ""}
2231 if {$extract_to_adr == ""} {
2232 xorriso_tcltk_errmsg \
2233 "xorriso-tcltk : SORRY : You have to set a target address in the hard disk filesystem first"
2234 return ""
2235 }
2236 set sources ""
2237 set selected_ftype ""
2238 set selected_adr ""
2239 if {$extract_from_selected == 1} {
2240 set selected [.isolist curselection]
2241 if {[llength $selected] < 1} {
2242 xorriso_tcltk_errmsg "xorriso-tcltk : SORRY : You must select at least one ISO file as extraction source"
2243 return ""
2244 }
2245 foreach i $selected {
2246 set path [combine_dir_and_name $isodir_adr \
2247 [lindex $isolist_names $i]]
2248 lappend sources $path
2249 }
2250 } else {
2251 set sources [list $isodir_adr]
2252 }
2253
2254 reset_highest_cmd_sev
2255 reset_yesno_to_all
2256 enforce_overwrite_settings "localfs"
2257 set disp_en_mem [set_display_msg 0]
2258 if {$extract_auto_chmod == 1} {
2259 send_loggable_cmd "-osirrox on:sort_lba_on:auto_chmod_on"
2260 } else {
2261 send_loggable_cmd "-osirrox on:sort_lba_off:auto_chmod_off"
2262 }
2263 set_display_msg $disp_en_mem
2264 set multi_source 0
2265 if {[llength $sources] != 1} {set multi_source 1}
2266 foreach i $sources {
2267 if {$extract_underneath == 1} {
2268 set name [file tail $i]
2269 set target [combine_dir_and_name $extract_to_adr $name]
2270 } else {
2271 if {[llength $sources] != 1} {
2272 xorriso_tcltk_errmsg "xorriso-tcltk : SORRY : You must select exactly one ISO file as extraction source"
2273 return ""
2274 }
2275 set target $extract_to_adr
2276 }
2277 if {$i == ""} {
2278 set i "/"
2279 }
2280 set target_ftype [localfs_filetype $target]
2281 set from_is_dir 0
2282 set source_ftype [isofs_filetype $i]
2283 if {[handle_overwriting "localfs" $target $target_ftype \
2284 "isofs" $i $source_ftype $multi_source \
2285 "" "" "merge"] == 0} {
2286 continue
2287 }
2288 send_loggable_cmd \
2289 "-extract [make_text_shellsafe $i] [make_text_shellsafe $target]"
2290 }
2291 browse_tree_populate "localfs"
2292 }
2293
2294
2295 # Send the currently chosen -overwrite settings of the checkbuttons
2296 # "Overwrite ISO files", "Overwrite ISO dirs", "Overwrite hard disk files".
2297 # Called before operations which could overwrite files in ISO model
2298 # or in the hard disk filesystem.
2299 # I.e. any -overwrite command sent via the "Command:" text field will not
2300 # be able to override the checkbuttons.
2301 #
2302 proc enforce_overwrite_settings {which_fs} {
2303 global overwrite_iso_files overwrite_iso_dirs overwrite_disk_files
2304
2305 if {$which_fs == "isofs"} {
2306 if {$overwrite_iso_files == 0} {
2307 set mode "off"
2308 } else {
2309 if {$overwrite_iso_dirs == 0} {
2310 set mode "nondir"
2311 } else {
2312 set mode "on"
2313 }
2314 }
2315 } else {
2316 if {$overwrite_disk_files == 1} {
2317 set mode "on"
2318 } else {
2319 set mode "off"
2320 }
2321 }
2322 set disp_en_mem [set_display_msg 0]
2323 send_loggable_cmd "-overwrite $mode"
2324 set_display_msg $disp_en_mem
2325 }
2326
2327
2328 # Send xorriso an appropriate end command and wait for the pipes to break.
2329 # Called when button "End" is hit.
2330 #
2331 proc end_xorriso {} {
2332 global expect_broken_pipes
2333
2334 if {[window_yesno "Really end this program and its xorriso backend ?"] \
2335 != 1} { return "" }
2336 if {[changes_are_pending] == 1} {
2337 if {[window_yesno \
2338 "Changes of the ISO image are pending.\nReally discard them ?"] \
2339 != 1} { return "" }
2340 set expect_broken_pipes "1"
2341 send_loggable_cmd "-rollback_end"
2342 } else {
2343 set expect_broken_pipes "1"
2344 send_loggable_cmd "-end"
2345 }
2346 central_exit 0
2347 }
2348
2349
2350 # Check whether an output drive is acquired. Propose refusal if not.
2351 # Called by procedures which are about to use the output drive.
2352 #
2353 proc assert_outdev {purpose} {
2354 global eff_outdev_adr
2355
2356 inquire_dev
2357 if {$eff_outdev_adr == ""} {
2358 xorriso_tcltk_errmsg \
2359 "xorriso-tcltk : SORRY : You must choose an output drive before $purpose"
2360 return "0"
2361 }
2362 return "1"
2363 }
2364
2365
2366 # Check whether changes to the ISO model are pending. If so, propose refusal.
2367 # Called by procedures which are about to discard the ISO model.
2368 #
2369 proc assert_no_changes {} {
2370 if {[changes_are_pending] == 1} {
2371 window_ack "ISO image changes are pending. You have to do \"Write ISO session\" or \"Rollback\"." "grey" "toplevel"
2372 return "0"
2373 }
2374 return "1"
2375 }
2376
2377
2378 # Set the text of the "Permissions:" menubutton
2379 # Called by the radiobuttons in the menu.
2380 #
2381 proc show_permission_policy {} {
2382 global permission_policy
2383
2384 set text $permission_policy
2385 if {$permission_policy == "as_is"} {
2386 set text "as is"
2387 }
2388 if {$permission_policy == "mkisofs_r"} {
2389 set text "mkisofs -r"
2390 }
2391 .perm_policy configure -text "Permissions: $text"
2392 }
2393
2394
2395 # Set the target address of command logging.
2396 # Called by the "Script/Log" menu.
2397 #
2398 proc set_log_script_address {} {
2399 browse_tree cmd_log_target "localfs"
2400 set w .browse_disk_window
2401 tkwait window $w
2402 effectuate_command_logging 0
2403 }
2404
2405
2406 # Bring into effect the settings for command script logging.
2407 # Called by the "Accept" button or the Return key of the
2408 # "Set log script address" file browser.
2409 #
2410 proc effectuate_command_logging {close_window} {
2411 global cmd_log_target cmd_logging_mode browse_disk_window_is_active
2412
2413 if {$close_window == 1 && $browse_disk_window_is_active == 1} {
2414 destroy_browse_disk .browse_disk_window
2415 }
2416 if {$close_window == 1 || $cmd_logging_mode > 0} {
2417 start_command_logging $cmd_log_target $cmd_logging_mode
2418 }
2419 }
2420
2421
2422 # Set the target address of communication pipe logging.
2423 # Called by the "Script/Log" menu.
2424 #
2425 proc set_debug_log_address {} {
2426 browse_tree debug_log_file "localfs"
2427 set w .browse_disk_window
2428 tkwait window $w
2429 effectuate_debug_logging 0
2430 }
2431
2432
2433 # Bring into effect the settings for communication pipe logging.
2434 # Called by the "Accept" button or the Return key of the
2435 # "Set pipe log address" file browser.
2436 #
2437 proc effectuate_debug_logging {close_window} {
2438 global debug_log_file debug_logging browse_disk_window_is_active
2439
2440 if {$close_window == 1 && $browse_disk_window_is_active == 1} {
2441 destroy_browse_disk .browse_disk_window
2442 }
2443 if {$close_window == 1 || $debug_logging > 0} {
2444 start_debug_logging $debug_log_file $debug_logging
2445 }
2446 }
2447
2448
2449 # Trigger execution of a script of xorriso commands.
2450 # Called by the "Script/Log" menu.
2451 #
2452 proc start_script_execution {} {
2453 browse_tree execute_script_adr "localfs"
2454 # actual script start is done by browse_tree_accept -> execute_script
2455 }
2456
2457
2458 # Permanently ban any extraction from ISO to hard disk
2459 #
2460 proc osirrox_banned {} {
2461 global osirrox_allowed
2462
2463 reset_yesno_to_all
2464 if {[window_yesno \
2465 "Really irrevocably ban any extraction from ISO to hard disk ?"] \
2466 != 1} { return "" }
2467
2468 send_loggable_cmd "-osirrox banned"
2469 set osirrox_allowed 0
2470
2471 set m ".script_log.menu"
2472 $m entryconfigure "Allow extract to disk" -state "disabled"
2473 $m entryconfigure "Permanently ban extraction" -state "disabled"
2474
2475 .extract_button configure -state "disabled"
2476
2477 }
2478
2479
2480 # ------ A primitive file tree browser for hard disk filesystem and ISO model
2481
2482 # Write a directory content list into a Tree widget
2483 #
2484 proc browse_tree_fill_dir {tr parent children} {
2485
2486 if {$parent == "/"} {
2487 set parent_name root
2488 set parent_dir /
2489 } else {
2490 set parent_name [escape_to_tree $parent]
2491 set parent_dir $parent_name
2492 }
2493 if {[$tr exists $parent_name] == 0} {return ""}
2494
2495 $tr delete [$tr nodes $parent_name]
2496
2497 foreach i $children {
2498 set name [string range $i 2 end]
2499 set escpd [escape_to_tree $name]
2500 set adr [combine_dir_and_name $parent_dir $escpd]
2501 $tr insert end $parent_name $adr -text $name
2502 if {[string range $i 0 0] == "d"} {
2503 set dir_dummy [combine_dir_and_name $adr "_"]
2504 $tr insert end $adr $dir_dummy -text " "
2505 }
2506 }
2507 }
2508
2509
2510 # The command to be executed when the user double-clicks a node.
2511 #
2512 proc browse_tree_accept {adr_var_name do_return tr value} {
2513 global have_bwidget
2514 global extract_to_adr insert_from_adr burn_write_image_adr isodir_adr
2515 global isomanip_move_target indev_adr outdev_adr cmd_log_target
2516 global debug_log_file execute_script_adr
2517
2518 # Caution: Before using $tr, check for $have_bwidget
2519
2520 if {$adr_var_name == "burn_write_image_adr"} {
2521 set burn_write_image_adr $value
2522 if {$do_return == 1} {burn_write_image}
2523 }
2524 if {$adr_var_name == "extract_to_adr"} {
2525 set extract_to_adr $value
2526 if {$do_return == 1} {extract_to}
2527 }
2528 if {$adr_var_name == "insert_from_adr"} {
2529 set insert_from_adr $value
2530 if {$do_return == 1} {insert_from}
2531 }
2532 if {$adr_var_name == "isodir_adr"} {
2533 set isodir_adr $value
2534 if {$do_return == 1} {isodir_return "browse_tree_accept"}
2535 }
2536 if {$adr_var_name == "isomanip_move_target"} {
2537 set isomanip_move_target $value
2538 if {$do_return == 1} {isomanip_mv}
2539 }
2540 if {$adr_var_name == "indev_adr"} {
2541 set indev_adr $value
2542 if {$do_return == 1} {indev_return}
2543 }
2544 if {$adr_var_name == "outdev_adr"} {
2545 set outdev_adr $value
2546 if {$do_return == 1} {outdev_return}
2547 }
2548 if {$adr_var_name == "cmd_log_target"} {
2549 set cmd_log_target $value
2550 if {$do_return == 1} {effectuate_command_logging 1}
2551 }
2552 if {$adr_var_name == "debug_log_file"} {
2553 set debug_log_file $value
2554 if {$do_return == 1} {effectuate_debug_logging 1}
2555 }
2556 if {$adr_var_name == "execute_script_adr"} {
2557 set execute_script_adr $value
2558 if {$do_return == 1} {execute_script 1}
2559 }
2560 }
2561
2562
2563 # Translate a browser tree variable in a human readable topic text
2564 #
2565 proc browse_tree_topic {adr_var_name} {
2566 if {$adr_var_name == "burn_write_image_adr"} {
2567 return "Burn image file:"
2568 }
2569 if {$adr_var_name == "extract_to_adr"} {
2570 return "Extract to disk:"
2571 }
2572 if {$adr_var_name == "insert_from_adr"} {
2573 return "Insert from disk:"
2574 }
2575 if {$adr_var_name == "isodir_adr"} {
2576 return "ISO directory:"
2577 }
2578 if {$adr_var_name == "isomanip_move_target"} {
2579 return "Move to:"
2580 }
2581 if {$adr_var_name == "indev_adr"} {
2582 return "Input drive/image"
2583 }
2584 if {$adr_var_name == "outdev_adr"} {
2585 return "Output drive/image"
2586 }
2587 if {$adr_var_name == "cmd_log_target"} {
2588 return "Set log script address"
2589 }
2590 if {$adr_var_name == "debug_log_file"} {
2591 return "Set pipe log address"
2592 }
2593 if {$adr_var_name == "execute_script_adr"} {
2594 return "Execute command script"
2595 }
2596 return $adr_var_name
2597 }
2598
2599
2600 # Unescape &|^! from Bwidget tree browser
2601 #
2602 proc unescape_from_tree {text} {
2603 return [string map [list "\{\{\}" "\{" "\{+\}" "&" "\{I\}" "|" \
2604 "\{A\}" "^" "\{.\}" "!"] \
2605 $text]
2606
2607 # <<< alternative encoding
2608 # set escpd [string map [list "\\\\" "\\" "\\+" "&" "\\I" "|" \
2609 # "\\A" "^" "\\." "!"] \
2610 }
2611
2612
2613 # Escape &|^! which are special to BWidget Tree
2614 #
2615 proc escape_to_tree {text} {
2616 return [string map [list "\{" "\{\{\}" "&" "\{+\}" "|" "\{I\}" \
2617 "^" "\{A\}" "!" "\{.\}"] \
2618 $text]
2619 }
2620
2621
2622
2623 # Accept the single selected item of the tree browser
2624 # Called by the \"Accept\" button in the browser window.
2625 #
2626 proc browse_tree_accept_sel {adr_var_name do_return tr} {
2627 set selected [$tr selection get]
2628
2629 if {[llength $selected] != 1} {
2630 xorriso_tcltk_errmsg "xorriso-tcltk : SORRY : You must select a single tree item before clicking the \"Accept\" button."
2631 return ""
2632 }
2633 browse_tree_accept $adr_var_name $do_return $tr \
2634 [unescape_from_tree [lindex $selected 0]]
2635 }
2636
2637
2638 # Hit the Return key on the text entry of the browser
2639 #
2640 proc browse_tree_accept_entry {adr_var_name do_return tr} {
2641 global extract_to_adr insert_from_adr burn_write_image_adr isodir_adr
2642 global isomanip_move_target indev_adr outdev_adr cmd_log_target
2643 global debug_log_file execute_script_adr
2644
2645 eval set text $$adr_var_name
2646 browse_tree_accept $adr_var_name $do_return $tr $text
2647 }
2648
2649
2650 # Submit a Tree-escaped path to browse_tree_accept.
2651 # Called by Double-click in browser.
2652 #
2653 proc browse_tree_accept_escd {adr_var_name do_return tr escd_path} {
2654 browse_tree_accept $adr_var_name $do_return $tr \
2655 [unescape_from_tree $escd_path]
2656 }
2657
2658
2659 # Move up one directory level of the file browser selection
2660 #
2661 proc browse_tree_up {adr_var_name tr which_fs} {
2662 global extract_to_adr insert_from_adr burn_write_image_adr isodir_adr
2663 global isomanip_move_target indev_adr outdev_adr
2664
2665 set selected [$tr selection get]
2666 if {[llength $selected] != 1} {
2667 xorriso_tcltk_errmsg "xorriso-tcltk : SORRY : You must select a single tree item before clicking the \"Up\" button."
2668 return ""
2669 }
2670 set old_adr [lindex $selected 0]
2671 set adr [file dirname $old_adr]
2672 catch {
2673 $tr see $adr
2674 if {[$tr nodes $old_adr 0] != ""} {
2675 $tr closetree $old_adr
2676 }
2677 }
2678 if {$adr != "/" && $adr != ""} {
2679 $tr selection clear
2680 $tr selection set $adr
2681 }
2682 }
2683
2684
2685 # Move down one directory level of the file browser selection
2686 #
2687 proc browse_tree_down {adr_var_name tr which_fs} {
2688 global extract_to_adr insert_from_adr burn_write_image_adr isodir_adr
2689 global isomanip_move_target indev_adr outdev_adr
2690
2691 set selected [$tr selection get]
2692 if {[llength $selected] != 1} {
2693 xorriso_tcltk_errmsg "xorriso-tcltk : SORRY : You must select a single tree item before clicking the \"Down\" button."
2694 return ""
2695 }
2696 set adr [lindex $selected 0]
2697 if {$which_fs == "isofs"} {
2698 browse_iso_open_dir $tr $adr
2699 } else {
2700 browse_disk_open_dir $tr $adr
2701 }
2702 catch {
2703 $tr opentree $adr 0
2704 $tr see $adr
2705 }
2706 }
2707
2708
2709 # The command to be executed when the user closes a directory node.
2710 # It replaces the directory content list by a single dummy item.
2711 #
2712 proc browse_tree_close_dir {tr name} {
2713 browse_tree_fill_dir $tr $name [list "? "]
2714 }
2715
2716
2717 # Delete the old content of the browse window and display the freshly
2718 # obtained current state down to the current address in the field variable.
2719 #
2720 proc browse_tree_populate {which_fs} {
2721 global have_bwidget
2722 global browse_disk_window_var browse_iso_window_var
2723 global browse_iso_window_is_active browse_disk_window_is_active
2724 global extract_to_adr insert_from_adr burn_write_image_adr isodir_adr
2725 global isomanip_move_target indev_adr outdev_adr cmd_log_target
2726 global debug_log_file execute_script_adr
2727
2728 if {$have_bwidget != 1} {return ""}
2729
2730 if {$which_fs == "isofs"} {
2731 if {$browse_iso_window_is_active == 0} {return ""}
2732 set w {.browse_iso_window}
2733 set open_dir_cmd "browse_iso_open_dir"
2734 set adr_var $browse_iso_window_var
2735 } else {
2736 if {$browse_disk_window_is_active == 0} {return ""}
2737 set w {.browse_disk_window}
2738 set open_dir_cmd "browse_disk_open_dir"
2739 set adr_var $browse_disk_window_var
2740 }
2741
2742 # Variable indirection
2743 eval set adr $$adr_var
2744
2745 # Install root level
2746 $open_dir_cmd $w.tree "/"
2747
2748 # Set $adr as current address
2749 set comps [split $adr "/"]
2750 # Install the stack of directories above current address
2751 set path "/"
2752 foreach i $comps {
2753 if {$i == ""} {
2754 continue
2755 }
2756 set path [combine_dir_and_name $path [escape_to_tree $i]]
2757 $open_dir_cmd $w.tree $path
2758 catch {
2759 $w.tree opentree $path 0
2760 $w.tree see $path
2761 }
2762 }
2763 }
2764
2765
2766 # The procedure to be run by mouse button 3 in the file browser.
2767 # It has to strip off the surplus parameter added by the Tree widget.
2768 #
2769 proc browse_tree_help {about_what button_color from_item} {
2770 window_help $about_what $button_color
2771 }
2772
2773
2774 # Destroy the hard disk browser pop-up window.
2775 #
2776 proc destroy_browse_disk {w} {
2777 global browse_disk_window_is_active browse_disk_window_geometry
2778 global browse_disk_window_is_grabbed
2779
2780 if {$w != "" && $browse_disk_window_is_active == 1} {
2781 if {$browse_disk_window_is_grabbed == 1} {
2782 grab release $w
2783 }
2784 set browse_disk_window_is_grabbed 0
2785 set browse_disk_window_geometry [wm geometry $w]
2786 destroy $w
2787 }
2788 set browse_disk_window_is_active 0
2789 }
2790
2791
2792 # The command to be executed when the user opens a directory node in
2793 # the hard disk filesystem.
2794 #
2795 proc browse_disk_open_dir {tr name} {
2796 set escpd [unescape_from_tree $name]
2797 if {[localfs_filetype $escpd] != "d"} {return ""}
2798 set lslist [localfs_ls $escpd]
2799 browse_tree_fill_dir $tr $escpd $lslist
2800 }
2801
2802
2803 # Refresh the content of a possibly displayed tree browser for hard disk
2804 #
2805 proc browse_disk_refresh {} {
2806 browse_tree_populate "localfs"
2807 }
2808
2809
2810 # The command to be executed when the user opens a directory node in
2811 # the ISO model.
2812 #
2813 proc browse_iso_open_dir {tr name} {
2814 set escpd [unescape_from_tree $name]
2815 if {[isofs_filetype $escpd] != "d"} {return ""}
2816 set lslist [isofs_ls $escpd]
2817 browse_tree_fill_dir $tr $escpd $lslist
2818 }
2819
2820
2821 # Destroy the ISO browser pop-up window.
2822 #
2823 proc destroy_browse_iso {w} {
2824 global browse_iso_window_is_active browse_iso_window_geometry
2825 global browse_iso_window_is_grabbed
2826
2827 if {$w != "" && $browse_iso_window_is_active == 1} {
2828 set browse_iso_window_geometry [wm geometry $w]
2829 if {$browse_iso_window_is_grabbed == 1} {
2830 grab release $w
2831 }
2832 set browse_iso_window_is_grabbed 0
2833 destroy $w
2834 }
2835 set browse_iso_window_is_active 0
2836 }
2837
2838
2839 # Refresh the content of a possibly displayed tree browser for ISO model
2840 #
2841 proc browse_iso_refresh {} {
2842 browse_tree_populate "isofs"
2843 }
2844
2845
2846 # Multiplexer for updating both vertical scrollbars
2847 #
2848 proc browse_tree_yscrollcommand {w arg1 arg2} {
2849 $w.treescroll_y_l set $arg1 $arg2
2850 $w.treescroll_y_r set $arg1 $arg2
2851 }
2852
2853
2854 # Open a file browser window for hard disk filesystem or ISO model
2855 #
2856 proc browse_tree {adr_var which_fs} {
2857 upvar $adr_var adr
2858 global have_bwidget browse_disk_window_is_active browse_iso_window_is_active
2859 global browse_disk_window_var browse_iso_window_var
2860 global tree_window_lines tree_window_width tree_window_button_width
2861 global browse_disk_window_geometry browse_iso_window_geometry
2862
2863 set button_color "grey"
2864
2865 if {$which_fs == "isofs"} {
2866 set w {.browse_iso_window}
2867 set window_is_active $browse_iso_window_is_active
2868 set title_name "xorriso-tcltk ISO model browser"
2869 set open_dir_cmd "browse_iso_open_dir"
2870 set destroy_cmd "destroy_browse_iso"
2871 if {$browse_iso_window_var != $adr_var && $window_is_active == 1} {
2872 destroy_browse_iso $w
2873 set window_is_active 0
2874 }
2875 set browse_iso_window_var $adr_var
2876 set old_geometry $browse_iso_window_geometry
2877 set browse_iso_window_is_active 1
2878 } else {
2879 set w {.browse_disk_window}
2880 set window_is_active $browse_disk_window_is_active
2881 set title_name "xorriso-tcltk hard disk filesystem browser"
2882 set open_dir_cmd "browse_disk_open_dir"
2883 set destroy_cmd "destroy_browse_disk"
2884 if {$browse_disk_window_var != $adr_var && $window_is_active == 1} {
2885 destroy_browse_disk $w
2886 set window_is_active 0
2887 }
2888 set browse_disk_window_var $adr_var
2889 set old_geometry $browse_disk_window_geometry
2890 set browse_disk_window_is_active 1
2891 }
2892 set re_use_widgets 0
2893 if {$window_is_active == 0} {
2894 toplevel $w -borderwidth 10 -class Browser
2895 wm title $w $title_name
2896 set_window_position $w $old_geometry
2897 } else {
2898 set re_use_widgets 1
2899 }
2900 if {$re_use_widgets == 0} {
2901
2902 if {$have_bwidget == 1} {
2903 # BWidget Tree
2904 frame $w.tree_frame
2905 frame $w.tree_frame_x
2906 Tree $w.tree -width $tree_window_width -height $tree_window_lines \
2907 -opencmd "$open_dir_cmd $w.tree" \
2908 -closecmd "browse_tree_close_dir $w.tree" \
2909 -selectfill 1 \
2910 -yscrollcommand "browse_tree_yscrollcommand $w" \
2911 -xscrollcommand "$w.treescroll_x set"
2912
2913 # ??? why doesn't <Return> work ?
2914 # $w.tree bindText <Return> \
2915 # "browse_tree_accept_bindtext $adr_var 1 $w.tree"
2916
2917 # At least double-click does work
2918 $w.tree bindText <Double-Button-1> \
2919 "browse_tree_accept_escd $adr_var 1 $w.tree"
2920
2921 $w.tree bindText <Button-3> {browse_tree_help "Browse tree" grey}
2922
2923 scrollbar $w.treescroll_y_l -command "$w.tree yview"
2924 scrollbar $w.treescroll_y_r -command "$w.tree yview"
2925 scrollbar $w.treescroll_x -orient horizontal -command "$w.tree xview "
2926 pack $w.tree -in $w.tree_frame_x -side top -expand 1 -fill both
2927 pack $w.treescroll_x -in $w.tree_frame_x -side top -expand 1 -fill x
2928 pack $w.treescroll_y_l -in $w.tree_frame -side left -expand 1 -fill y
2929 pack $w.tree_frame_x -in $w.tree_frame -side left -expand 1 -fill both
2930 pack $w.treescroll_y_r -in $w.tree_frame -side left -expand 1 -fill y
2931
2932 frame $w.button_line
2933 button $w.accept -text "Accept" -width $tree_window_button_width \
2934 -command "browse_tree_accept_sel $adr_var 1 $w.tree"
2935 bind_help $w.accept "Accept (browse tree)"
2936 button $w.to_field -text "Edit" -width $tree_window_button_width \
2937 -command "browse_tree_accept_sel $adr_var 0 $w.tree"
2938 bind_help $w.to_field "Edit (browse tree)"
2939 button $w.up -text "Up" -width $tree_window_button_width \
2940 -command "browse_tree_up $adr_var $w.tree $which_fs"
2941 bind_help $w.up "Up (browse tree)"
2942 button $w.down -text "Down" -width $tree_window_button_width \
2943 -command "browse_tree_down $adr_var $w.tree $which_fs"
2944 bind_help $w.down "Down (browse tree)"
2945 pack $w.up $w.down $w.accept $w.to_field \
2946 -in $w.button_line -side left -expand 0
2947
2948 pack $w.tree_frame -side top -anchor w -expand 1 -fill both
2949 } else {
2950 frame $w.button_line
2951 button $w.accept -text "Accept" -width $tree_window_button_width \
2952 -command "browse_tree_accept_entry $adr_var 1 $w.tree"
2953 bind_help $w.accept "Accept (browse tree)"
2954 pack $w.accept -in $w.button_line -side left -expand 0
2955 }
2956 button $w.help -text "Help" -width $tree_window_button_width \
2957 -command {window_help "Browse tree" grey}
2958 bind_help $w.help "Browse tree"
2959 button $w.close -text "Close" -width $tree_window_button_width \
2960 -command "$destroy_cmd $w" \
2961 -background $button_color
2962 bind_help $w.close "Close (browse tree)"
2963 pack $w.help $w.close \
2964 -in $w.button_line -side left -expand 0
2965
2966 pack $w.button_line -side top -anchor center
2967
2968 frame $w.text_frame
2969 label $w.topic -text "[browse_tree_topic $adr_var]"
2970 bind_help $w.topic "Browse tree"
2971 entry $w.text_entry -relief sunken -bd 1 -width 40 \
2972 -textvariable $adr_var
2973 bind_entry_keys $w.text_entry \
2974 "browse_tree_accept_entry $adr_var 1 $w.tree"
2975 bind_help $w.text_entry "Browse tree"
2976 pack $w.topic -in $w.text_frame -side left
2977 pack $w.text_entry -in $w.text_frame -side left -expand 1 -fill both
2978 pack $w.text_frame -side top -expand 1 -fill both
2979 }
2980 raise $w
2981 if {$have_bwidget == 1} {
2982 browse_tree_populate $which_fs
2983 focus $w.tree
2984 }
2985 update idletasks
2986 }
2987
2988
2989 # ------ GUI display procedures ----
2990
2991
2992 # Display a message of xorriso or of this frontend in the .msglist box
2993 #
2994 proc display_msg {msg} {
2995 global .msglist
2996 global msglist_max_fill msglist_running pre_msglist display_msg_enabled
2997
2998 if {$display_msg_enabled == 0} {return ""}
2999 if {$msg == "============================" || \
3000 $msg == "==============================================================" || \
3001 $msg == "enter option and arguments :"} {return ""}
3002
3003 if {$msglist_running == 0} {
3004 lappend pre_msglist $msg
3005 } else {
3006 if {[.msglist index end] > $msglist_max_fill} {
3007 .msglist delete 0 0
3008 }
3009 .msglist insert end [escape_newline $msg 0]
3010 .msglist see [expr "[.msglist index end]-1"]
3011 update idletasks
3012 }
3013 }
3014
3015
3016 # Set whether messages submitted to proc display_message shall really show up
3017 # This is used by callback procedures to hide auxiliary commands and lengthy
3018 # reply messages from the user display.
3019 #
3020 proc set_display_msg {mode} {
3021 global display_msg_enabled
3022
3023 set old $display_msg_enabled
3024 if {$mode == "0"} {
3025 set display_msg_enabled 0
3026 } else {
3027 set display_msg_enabled "1"
3028 }
3029 return $old
3030 }
3031
3032
3033 # Display a frontend error message in the .msglist box and by a pop-up window.
3034 #
3035 proc xorriso_tcltk_errmsg {msg} {
3036 global highest_cmd_sev_msg
3037
3038 set highest_cmd_sev_msg [escape_newline $msg 0]
3039 display_msg $msg
3040 window_ack $msg "grey" "toplevel"
3041 update idletasks
3042 }
3043
3044
3045 # Memorize the current selection in the .isolist box.
3046 #
3047 proc memorize_isolist_selection {} {
3048 global memorized_isolist_selection isolist_names
3049 global .isolist
3050
3051 set memorized_isolist_selection ""
3052 set selected [.isolist curselection]
3053 foreach i $selected {
3054 lappend memorized_isolist_selection [lindex $isolist_names $i]
3055 }
3056 }
3057
3058
3059 # Restore the memorized selection in the .isolist box as far as the
3060 # names have survived in the meantime.
3061 #
3062 proc restore_isolist_selection {} {
3063 global memorized_isolist_selection isolist_names
3064 global .isolist
3065
3066 .isolist selection clear 0 end
3067 foreach i $memorized_isolist_selection {
3068 set idx [lsearch -exact $isolist_names $i]
3069 if {$idx > -1} {
3070 .isolist selection set $idx $idx
3071 }
3072 }
3073 set memorized_isolist_selection ""
3074 }
3075
3076
3077 # Receive the answer of the yes/no window and destroy it.
3078 #
3079 proc destroy_yesno {w answer} {
3080 global yesno_window_is_active answer_of_yesno yesno_window_geometry
3081 global yesno_to_all
3082
3083 if {$w != ""} {
3084 set yesno_window_geometry [wm geometry $w]
3085 grab release $w
3086 destroy $w
3087 update idletasks
3088 }
3089 set yesno_window_is_active 0
3090 set answer_of_yesno $answer
3091 if {$answer == 2} {
3092 set yesno_to_all 1
3093 set answer_of_yesno 1
3094 }
3095 if {$answer == -1} {
3096 set yesno_to_all -1
3097 set answer_of_yesno 0
3098 }
3099 }
3100
3101
3102 # Pop-up a window which asks for yes or no. Return 1 if answer is yes.
3103 #
3104 proc window_yesno {question} {
3105 global answer_of_yesno yesno_window_is_active yesno_window_geometry
3106
3107 set w {.yesno_window}
3108 if {$yesno_window_is_active == 1} {
3109 set yesno_window_is_active [window_exists $w]
3110 }
3111 if {$yesno_window_is_active == 1} {
3112 raise $w
3113 xorriso_tcltk_errmsg "xorriso-tcltk : SORRY : You still need to answer an older yes/no question"
3114 return "0"
3115 }
3116 set yesno_window_is_active 1
3117 set answer_of_yesno ""
3118 toplevel $w -borderwidth 20 -class Dialog
3119 wm title $w "xorriso-tcltk yes/no"
3120 set_window_position $w $yesno_window_geometry
3121 label $w.question -text $question
3122 button $w.yes -text "yes" -command "destroy_yesno $w 1" \
3123 -borderwidth 4 -padx 20 -pady 20
3124 bind_help $w.yes "yes/no"
3125 button $w.no -text "no" -command "destroy_yesno $w 0" \
3126 -borderwidth 4 -padx 20 -pady 20
3127 bind_help $w.no "yes/no"
3128 pack $w.yes $w.question $w.no -side left
3129 update idletasks
3130
3131 grab set $w
3132 tkwait variable answer_of_yesno
3133 return $answer_of_yesno
3134 }
3135
3136
3137 # Pop-up a window which asks for yes, yes-to-all, no, or no-to-all.
3138 # Return 1 if answer is yes.
3139 #
3140 proc window_yesno_ever {question} {
3141 global answer_of_yesno yesno_window_is_active yesno_window_geometry
3142 global yesno_to_all
3143
3144 set w {.yesno_window}
3145 if {$yesno_window_is_active == 1} {
3146 set yesno_window_is_active [window_exists $w]
3147 }
3148 if {$yesno_window_is_active == 1} {
3149 raise $w
3150 xorriso_tcltk_errmsg "xorriso-tcltk : SORRY : You still need to answer an older yes/no question"
3151 return "0"
3152 }
3153 if {$yesno_to_all == 1} {
3154 return "1"
3155 }
3156 if {$yesno_to_all == -1} {
3157 return "0"
3158 }
3159 set yesno_window_is_active 1
3160 set answer_of_yesno ""
3161 toplevel $w -borderwidth 20 -class Dialog
3162 wm title $w "xorriso-tcltk yes/no"
3163 set_window_position $w $yesno_window_geometry
3164
3165 frame $w.yes_frame
3166 frame $w.no_frame
3167 label $w.question -text $question
3168 button $w.yes -text "yes" -command "destroy_yesno $w 1" \
3169 -borderwidth 4 -padx 20 -pady 20 -relief raised
3170 button $w.no -text "no" -command "destroy_yesno $w 0" \
3171 -borderwidth 4 -padx 20 -pady 20 -relief raised
3172 button $w.yes_to_all -text "yes to all" -command "destroy_yesno $w 2"
3173 bind_help $w.yes_to_all "yes to all"
3174 button $w.no_to_all -text "no to all" -command "destroy_yesno $w -1"
3175 bind_help $w.no_to_all "no to all"
3176 pack $w.yes $w.yes_to_all -in $w.yes_frame -side top -expand 1 -fill both
3177 pack $w.no $w.no_to_all -in $w.no_frame -side top -expand 1 -fill both
3178 pack $w.yes_frame $w.question $w.no_frame \
3179 -in $w -side left -expand 1 -fill both
3180
3181 raise $w
3182 update idletasks
3183
3184 grab set $w
3185 tkwait variable answer_of_yesno
3186 return $answer_of_yesno
3187 }
3188
3189
3190 proc reset_yesno_to_all {} {
3191 global yesno_to_all
3192
3193 set yesno_to_all 0
3194 }
3195
3196
3197 # Destroy the notification pop-up window.
3198 #
3199 proc destroy_ack {w had_focus} {
3200 global ack_window_is_active ack_window_geometry
3201
3202 if {$w != ""} {
3203 set ack_window_geometry [wm geometry $w]
3204 grab release $w
3205 if {$had_focus != "-"} {
3206 focus $had_focus
3207 }
3208 destroy $w
3209 update idletasks
3210 }
3211 set ack_window_is_active 0
3212 }
3213
3214
3215 # Pop-up a window which notifies of a problem and asks for a button click.
3216 #
3217 proc window_ack {question button_color where} {
3218 global answer_of_yesno ack_window_is_active ack_window_geometry
3219 global continue_from_ack
3220
3221 set had_focus [focus]
3222 if {$had_focus == ""} {set had_focus "-"}
3223 set re_use_widgets 0
3224 if {$where == "embedded"} {
3225 set w ""
3226 set destroy_cmd ""
3227 } else {
3228 set w {.ack_window}
3229 if {$ack_window_is_active == 1} {
3230 set ack_window_is_active [window_exists $w]
3231 }
3232 if {$ack_window_is_active == 0} {
3233 toplevel $w -borderwidth 20 -class Dialog
3234 wm title $w "xorriso-tcltk acknowledge"
3235 set ack_window_is_active 1
3236 } else {
3237 set re_use_widgets 1
3238 }
3239 set_window_position $w $ack_window_geometry
3240 set destroy_cmd "destroy_ack $w $had_focus"
3241 }
3242 if {$re_use_widgets == 1} {
3243 $w.question configure -text $question
3244 } else {
3245 label $w.question -text $question
3246 button $w.ok -text "Continue" -command $destroy_cmd \
3247 -background $button_color
3248 bind $w.ok <Return> $destroy_cmd
3249 bind_help $w.ok "Continue"
3250 pack $w.question -side top -expand 1 -fill both
3251 pack $w.ok -side top
3252 }
3253
3254 raise $w
3255 update idletasks
3256 focus $w.ok
3257 grab set $w
3258 tkwait variable ack_window_is_active
3259 }
3260
3261
3262 # Destroy the help pop-up window.
3263 #
3264 proc destroy_help {w help_main} {
3265 global help_window_is_active help_window_has_scroll help_window_geometry
3266 global main_help_window_is_active main_help_window_geometry
3267
3268 if {$w != ""} {
3269 if {$help_main == 1} {
3270 set main_help_window_geometry [wm geometry $w]
3271 } else {
3272 set help_window_geometry [wm geometry $w]
3273 }
3274 destroy $w
3275 }
3276 if {$help_main == 1} {
3277 set main_help_window_is_active 0
3278 } else {
3279 set help_window_is_active 0
3280 set help_window_has_scroll 0
3281 }
3282 }
3283
3284
3285 proc surround_text {text} {
3286 return "\n\n [string map {\n "\n "} $text]\n"
3287 }
3288
3289
3290 # Pop-up a window which shows a help text and a Close button.
3291 #
3292 proc window_help {about_what button_color} {
3293 global help_window_is_active help_window_lines help_window_has_scroll
3294 global help_window_border_width help_window_geometry
3295 global main_help_window_is_active
3296 global main_help_window_lines main_help_window_geometry
3297 global .help_window .main_help_window
3298
3299 # The main help window is independent of the GUI element help window
3300 if {$about_what == "Help"} {
3301 set help_main 1
3302 set w {.main_help_window}
3303 set window_is_active $main_help_window_is_active
3304 set window_has_scroll 1
3305 set old_geometry $main_help_window_geometry
3306 set window_lines $main_help_window_lines
3307 } else {
3308 set help_main 0
3309 set w {.help_window}
3310 set window_is_active $help_window_is_active
3311 set window_has_scroll $help_window_has_scroll
3312 set old_geometry $help_window_geometry
3313 set window_lines $help_window_lines
3314 }
3315 if {$window_is_active == 1} {
3316 set window_is_active [window_exists $w]
3317 }
3318
3319 # Giving the help text some distance from the border decorations
3320 set line_width 82
3321 set helptext "\n\n [string map {\n "\n "} [tell_helptext $about_what]]\n"
3322
3323 if {[count_newlines $helptext] >= $window_lines} {
3324 if {$window_is_active == 1 && $window_has_scroll == 0} {
3325 destroy_help $w $help_main
3326 set window_is_active 0
3327 }
3328 if {$help_main == 1} {
3329 set old_geometry $main_help_window_geometry
3330 } else {
3331 set help_window_has_scroll 1
3332 set window_has_scroll 1
3333 set old_geometry $help_window_geometry
3334 }
3335 }
3336 # Dealing with initiating windows that are grabbed
3337 set grabbed [grab current]
3338 if {$grabbed == ""} {set grabbed "-"}
3339 if {$grabbed != "-" && $window_is_active == 1} {
3340 destroy_help $w $help_main
3341 set window_is_active 0
3342 }
3343 if {$grabbed != "-"} {
3344 # Set old_geometry to position underneath grabbed window
3345 set value [wm geometry $grabbed]
3346 set idx [string first "+" $value]
3347 set height_idx [string first "x" $value]
3348 if {$idx != -1 && $height_idx != -1 && $idx > $height_idx} {
3349 set width [string range $value 0 [expr $height_idx-1]]
3350 set height [string range $value [expr $height_idx+1] [expr $idx-1]]
3351 set x [string range $value [expr $idx+1] end]
3352 set idx [string first "+" $x]
3353 if {$idx != -1} {
3354 set y [string range $x [expr $idx+1] end]
3355 set x [string range $x 0 [expr $idx-1]]
3356 set y [expr $y+$height]
3357 set old_geometry "${width}x${height}+${x}+${y}"
3358 }
3359 }
3360 }
3361
3362 set re_use_widgets 0
3363 if {$window_is_active == 0} {
3364 toplevel $w -borderwidth $help_window_border_width -class Help
3365 set_window_position $w $old_geometry
3366 if {$help_main == 1} {
3367 wm title $w "xorriso-tcltk main help text"
3368 set main_help_window_is_active 1
3369 reset_to_normal_background .help
3370 update idletasks
3371 } else {
3372 wm title $w "xorriso-tcltk GUI element help text"
3373 set help_window_is_active 1
3374 }
3375 } else {
3376 set re_use_widgets 1
3377 }
3378
3379 if {$re_use_widgets == 1} {
3380 $w.text configure -state normal
3381 $w.text delete 1.0 end
3382 $w.text insert end $helptext
3383 raise $w
3384 } else {
3385 set destroy_cmd "destroy_help $w $help_main"
3386
3387 frame $w.text_frame
3388 text $w.text -width $line_width -height $window_lines \
3389 -relief flat -borderwidth 0
3390 $w.text insert end $helptext
3391 pack $w.text -in $w.text_frame -side left -expand 1 -fill both
3392 if {$window_has_scroll == 1} {
3393 scrollbar $w.scroll_y -command "$w.text yview"
3394 $w.text configure -yscrollcommand "$w.scroll_y set"
3395 bind_listbox_keys $w.text $window_lines "text"
3396 pack $w.scroll_y -in $w.text_frame -side left -fill y
3397 }
3398
3399 button $w.close -text "Close" -command $destroy_cmd \
3400 -background $button_color
3401 pack $w.text_frame -side top -expand 1 -fill both
3402 frame $w.middle_spacer -height 6
3403 frame $w.bottom_spacer -height 6
3404 pack $w.middle_spacer $w.close $w.bottom_spacer -side top
3405 }
3406 $w.text configure -state disabled
3407 }
3408
3409
3410 # Display the busy/ready state of xorriso.
3411 # Called with 1 by sender of commands and with 0 by receivers of replies .
3412 #
3413 proc display_busy {state} {
3414 global busy_text_exists
3415 global .busy_text
3416
3417 if {$busy_text_exists == 0} {return ""}
3418
3419 if {$state == 0} {
3420 .busy_text configure -text "ready"
3421 .busy_text configure -background "#D0D0D0"
3422 } else {
3423 .busy_text configure -text "busy"
3424 .busy_text configure -background "#808080"
3425 }
3426 update idletasks
3427 }
3428
3429
3430 # Tries to make use of the BWidget package for getting its Tree widget
3431 #
3432 proc check_for_bwidget {} {
3433 global have_bwidget bwidget_version
3434
3435 if {$have_bwidget == 0} {
3436 catch {
3437 set bwidget_version [package require BWidget]
3438 set have_bwidget 1
3439 }
3440 }
3441 }
3442
3443
3444 # A window to display if no file browser is available
3445 #
3446 proc browser_dummy {} {
3447 window_ack \
3448 "The file browser cannot be used because Tcl/Tk package \"BWidget\" is not loaded" "grey" "toplevel"
3449 }
3450
3451
3452 # Obtain the geometry string of a window
3453 #
3454 proc get_window_geometry {w} {
3455 wm geometry $w
3456 }
3457
3458
3459 # Set the position of a window from a geometry string
3460 #
3461 proc set_window_position {w geometry} {
3462 set value $geometry
3463 set idx [string first "+" $value]
3464 if {$idx == -1} {
3465 set value [wm geometry .]
3466 set idx [string first "+" $value]
3467 }
3468 if {$idx == -1} { return "" }
3469 set pos [string range $value $idx end]
3470 wm geometry $w $pos
3471 }
3472
3473
3474 # Reset button appearance from startup color to normal color
3475 #
3476 proc reset_to_normal_background {w} {
3477 set normal_color [.drive_drop_both cget -background]
3478 $w configure -background $normal_color
3479 }
3480
3481
3482 # Checks whether a window is really there
3483 #
3484 proc window_exists {w} {
3485 set window_exists 0
3486 catch {
3487 $w cget -background
3488 set window_exists 1
3489 }
3490 return $window_exists
3491 }
3492
3493
3494 # ------ Building GUI components ------
3495
3496 # ------ GUI layout parameters ------
3497
3498 # The default position of the main window
3499 set main_window_geometry ""
3500
3501 # How to mark the borders of the main grouping frames
3502 set main_framerelief ridge
3503 set main_borderwidth 4
3504
3505 # How to mark the borders of the second level grouping frames
3506 set borderwidth 1
3507
3508 # Number of lines in msglist display
3509 set msglist_lines 8
3510 set msglist_max_fill 1000
3511 set msglist_running 0
3512
3513 # Number of lines in drivelist display
3514 set drivelist_lines 2
3515
3516 # Number of lines in ISO directory content display
3517 set isolist_lines 8
3518
3519 # Whether the message box shall export its selection to the whole X display
3520 set export_msg_selection true
3521
3522 # Whether the item lists shall export their selection
3523 set export_selection false
3524
3525 # The number of lines in the display of the help texts
3526 set main_help_window_lines 24
3527 set help_window_lines 16
3528
3529 # The distance of the help text from the help window border
3530 set help_window_border_width 0
3531
3532 # The number of items to display in a tree browser window
3533 set tree_window_lines 12
3534 # The number of visible characters in a tree browser line
3535 set tree_window_width 50
3536 # The width in characters of the six buttons under the tree browser
3537 set tree_window_button_width 6
3538
3539
3540 # -------- GUI definition procedures
3541
3542
3543 # Overall definition of the GUI
3544 #
3545 proc init_gui {} {
3546 global .input .cmdline_entry .msgbox .errmsg .dev .drivebox
3547 global .isobox .localfs
3548 global main_framerelief main_borderwidth click_to_focus
3549
3550 check_for_bwidget
3551
3552 # Main grouping frames
3553 frame .connection_block \
3554 -relief $main_framerelief -borderwidth $main_borderwidth
3555 frame .drive_block \
3556 -relief $main_framerelief -borderwidth $main_borderwidth
3557 frame .iso_block \
3558 -relief $main_framerelief -borderwidth $main_borderwidth
3559
3560 init_input
3561 init_msgbox
3562 init_errmsg
3563 init_dev
3564 init_drivebox
3565 init_isobox
3566 init_isomanip
3567 init_burn
3568 init_localfs
3569
3570 pack .input .msgbox .errmsg -in .connection_block \
3571 -side top -expand 1 -fill both
3572 pack .drivebox .dev .burn -in .drive_block \
3573 -side top -expand 1 -fill both
3574 pack .localfs .isobox .isomanip -in .iso_block \
3575 -side top -expand 1 -fill both
3576
3577 pack .connection_block .drive_block .iso_block \
3578 -side top -expand 1 -fill both
3579
3580 if {$click_to_focus == 1} {
3581 focus .msglist
3582 }
3583 }
3584
3585
3586 # The xorriso headline with End button, xorriso version, busy/ready indicator,
3587 # command line, and "Refresh disp" button.
3588 #
3589 proc init_input {} {
3590 global borderwidth busy_text_exists xorriso_version debug_logging
3591 global cmd_logging_mode cmd_log_target osirrox_allowed cmd_logging_all
3592 global .input .input_line1 .xorriso_version .busy .busy_text
3593 global .refresh_state .end_button .cmdline .log_pipes_switch
3594
3595 set extract_state "normal"
3596 if {$osirrox_allowed == 0} {set extract_state "disabled"}
3597
3598 frame .input -borderwidth $borderwidth
3599 frame .input_line1 -borderwidth 0
3600 pack .input_line1 -in .input \
3601 -side top -anchor w -expand 1 -fill both
3602
3603 button .end_button -text "End" -command "end_xorriso"
3604 bind_help .end_button "End"
3605
3606 if {[string length $xorriso_version] > 10} {
3607 set xorriso_version [string range $xorriso_version 0 9]
3608 }
3609 label .xorriso_version -text "xorriso-$xorriso_version"
3610 bind_help .xorriso_version "version"
3611 frame .busy -relief ridge -borderwidth 2
3612 label .busy_text -width 5 -text "busy"
3613 bind_help .busy_text "ready/busy"
3614 set busy_text_exists 1
3615 pack .busy_text -in .busy
3616
3617 button .refresh_state -text "Refresh disp" \
3618 -command "refresh_state"
3619 bind_help .refresh_state "Refresh disp"
3620
3621 menubutton .script_log -text "Script/Log" -anchor w \
3622 -direction below -relief ridge -indicatoron 1 \
3623 -menu .script_log.menu
3624 bind_help .script_log "Script/Log"
3625 set m ".script_log.menu"
3626 menu $m
3627 $m add checkbutton -label "Log command script" \
3628 -indicatoron 1 -selectcolor "" \
3629 -command "effectuate_command_logging 0" \
3630 -variable cmd_logging_mode \
3631 -onvalue 1 -offvalue 0
3632 $m add checkbutton -label "Log non-essential commands" \
3633 -indicatoron 1 -selectcolor "" \
3634 -variable cmd_logging_all \
3635 -onvalue 1 -offvalue 0
3636 $m add command -label "Set log script address" \
3637 -command "set_log_script_address"
3638 $m add separator
3639 $m add checkbutton -label "Log pipes" \
3640 -indicatoron 1 -selectcolor "" \
3641 -variable debug_logging \
3642 -onvalue 1 -offvalue 0
3643 $m add command -label "Set pipe log address" \
3644 -command "set_debug_log_address"
3645 $m add separator
3646 $m add separator
3647 $m add command -label "Execute command script" \
3648 -command "start_script_execution"
3649 $m add checkbutton -label "Allow extract to disk" \
3650 -state $extract_state \
3651 -indicatoron 1 -selectcolor "" \
3652 -variable script_with_osirrox \
3653 -onvalue 1 -offvalue 0
3654 $m add separator
3655 $m add command -label "Permanently ban extraction" \
3656 -state $extract_state \
3657 -command "osirrox_banned"
3658
3659 button .help -text "Help" -command {window_help "Help" "grey"} \
3660 -background "grey"
3661 bind_help .help "Help"
3662
3663 init_cmdline
3664
3665 pack .end_button .xorriso_version .busy -in .input_line1 -side left
3666 pack .cmdline \
3667 -in .input_line1 -side left -expand 1 -fill both
3668 pack .refresh_state .script_log .help -in .input_line1 -side left
3669 }
3670
3671
3672 # The combination of "Command:" label and command line
3673 #
3674 proc init_cmdline {} {
3675 global cmdline borderwidth
3676 global .cmdline .cmdline_text .cmdline_entry
3677
3678 frame .cmdline -borderwidth 0
3679
3680 label .cmdline_text -width 10 -text "Command:"
3681 bind_help .cmdline_text "Command:"
3682 entry .cmdline_entry -width 56 -relief sunken -bd 1 \
3683 -textvariable cmdline
3684 bind_entry_keys .cmdline_entry {cmdline_return}
3685 bind_help .cmdline_entry "Command:"
3686
3687 # >>> is there a chance to get a history on an entry ?
3688
3689 pack .cmdline_text -in .cmdline -side left
3690 pack .cmdline_entry -in .cmdline -side left -expand 1 -fill both
3691 }
3692
3693
3694 # The listbox where to display commands and reply messages unless this is
3695 # disabled for auxiliary commands which shall not clutter the display.
3696 #
3697 proc init_msgbox {} {
3698 global borderwidth
3699 global msglist_lines export_msg_selection msglist_running pre_msglist
3700 global .msgbox .msglist .msgscroll
3701
3702 frame .msgbox -borderwidth $borderwidth
3703
3704 listbox .msglist -height $msglist_lines -selectmode extended \
3705 -yscrollcommand ".msgscroll set" \
3706 -exportselection $export_msg_selection
3707 bind_listbox_keys ".msglist" $msglist_lines "listbox"
3708 bind_help .msglist "message box"
3709 set msglist_running 1
3710 foreach i $pre_msglist {
3711 display_msg [escape_newline $i 0]
3712 }
3713 scrollbar .msgscroll -command ".msglist yview"
3714 pack .msglist -in .msgbox -side left -expand 1 -fill both
3715 pack .msgscroll -in .msgbox -side right -fill y
3716 set pre_msglist ""
3717 }
3718
3719
3720 # Two display lines for most severe event messages. One gets reset with
3721 # each important command. The other one stays until the user clears it.
3722 #
3723 proc init_errmsg {} {
3724 global borderwidth
3725 global .errmsg .total_errmsg .cmd_errmsg
3726
3727 frame .errmsg -borderwidth $borderwidth
3728
3729 init_total_errmsg
3730 init_cmd_errmsg
3731
3732 pack .cmd_errmsg .total_errmsg -in .errmsg \
3733 -side top -anchor w -expand 1 -fill both
3734
3735 }
3736
3737
3738 # The most severe message display which gets reset automatically.
3739 #
3740 proc init_cmd_errmsg {} {
3741 global borderwidth
3742 global .cmd_errmsg .cmd_errmsg_label .cmd_errmsg_msg
3743
3744 frame .cmd_errmsg -borderwidth $borderwidth
3745
3746 label .cmd_errmsg_label -width 14 -text "Recent problem:" -anchor w
3747 bind_help .cmd_errmsg_label "Recent problem:"
3748 label .cmd_errmsg_msg -width 80 -relief ridge -bd 2 \
3749 -anchor w \
3750 -textvariable highest_cmd_sev_msg
3751 # (no keys, no focus)
3752 bind_help .cmd_errmsg_msg "Recent problem:"
3753 pack .cmd_errmsg_label -in .cmd_errmsg -side left
3754 pack .cmd_errmsg_msg -in .cmd_errmsg -side left -expand 1 -fill both
3755 }
3756
3757
3758 # The persistent most severe message display that is to be reset by the user.
3759 #
3760 proc init_total_errmsg {} {
3761 global borderwidth
3762 global .total_errmsg .total_errmsg_label .total_errmsg_msg
3763 global .total_errmsg_clear
3764
3765 frame .total_errmsg -borderwidth $borderwidth
3766
3767 label .total_errmsg_label -text "Worst problem:" -width 14 -anchor w
3768 bind_help .total_errmsg_label "Worst problem:"
3769 button .total_errmsg_clear -text "Clear" \
3770 -width 5 \
3771 -command "clear_total_errmsg"
3772 bind_help .total_errmsg_clear "Clear"
3773 label .total_errmsg_msg -width 80 -relief ridge -bd 2 \
3774 -anchor w \
3775 -textvariable highest_total_sev_msg
3776 # (no keys, no focus)
3777 bind_help .total_errmsg_msg "Worst problem:"
3778 pack .total_errmsg_label -in .total_errmsg -side left
3779 pack .total_errmsg_msg -in .total_errmsg -side left -expand 1 -fill both
3780 pack .total_errmsg_clear -in .total_errmsg -side left
3781 }
3782
3783
3784 # The list of drives which were found by scanning, the Scan button, and
3785 # buttons for picking a drive from the list, for giving them up, for
3786 # calming them down, and for reloading the ISO image from the input drive.
3787 #
3788 proc init_drivebox {} {
3789 global borderwidth drivelist_lines export_selection
3790 global .drivebox .drivelistbox .drivelist .drivescroll .drive_scan
3791 global .drive_picker .drive_scan .drive_pick_in .drive_pick_out
3792 global .drive_pick_both .drive_drop_both .drive_calm .iso_rollback_button
3793
3794
3795 frame .drivebox -borderwidth $borderwidth
3796 frame .drivelistbox -borderwidth $borderwidth
3797 listbox .drivelist -height $drivelist_lines -selectmode extended \
3798 -yscrollcommand ".drivescroll set" \
3799 -exportselection $export_selection
3800 bind_listbox_keys ".drivelist" $drivelist_lines "listbox"
3801 bind_help .drivelist "drivelist"
3802 scrollbar .drivescroll -command ".drivelist yview"
3803
3804 pack .drivelist -in .drivelistbox -side left -expand 1 -fill both
3805 pack .drivescroll -in .drivelistbox -side right -fill y
3806
3807 frame .drive_picker -borderwidth $borderwidth
3808 frame .drive_picker_line_1 -borderwidth 0
3809 frame .drive_picker_line_2 -borderwidth 0
3810 frame .drive_aux_buttons_line_1 -borderwidth 0
3811 frame .drive_aux_buttons_line_2 -borderwidth 0
3812 frame .drive_aux_buttons -borderwidth 0
3813
3814 button .drive_scan -text "Scan for drives" \
3815 -background "grey" \
3816 -command "scan_for_drives"
3817 bind_help .drive_scan "Scan for drives"
3818 button .drive_pick_in -text "Pick input drive" \
3819 -command "pick_indev"
3820 bind_help .drive_pick_in "Pick input drive"
3821 button .drive_pick_out -text "Pick output drive" \
3822 -command "pick_outdev"
3823 bind_help .drive_pick_out "Pick output drive"
3824 button .drive_pick_both -text "Pick drive for both roles" \
3825 -command "pick_dev"
3826 bind_help .drive_pick_both "Pick drive for both roles"
3827 button .drive_drop_both -text "Give up drives" \
3828 -command "give_up_dev"
3829 bind_help .drive_drop_both "Give up drives"
3830 button .drive_calm -text "Calm drives" \
3831 -command "calm_drives"
3832 bind_help .drive_calm "Calm drives"
3833 button .iso_rollback_button -text "Rollback" -width 9 \
3834 -command {iso_rollback}
3835 bind_help .iso_rollback_button "Rollback"
3836
3837 # One button block left, one right
3838 pack .drive_pick_in .drive_pick_out \
3839 -in .drive_picker_line_1 -side left -expand 1 -fill none
3840 pack .drive_pick_both \
3841 -in .drive_picker_line_2 -side left -expand 1 -fill x
3842 pack .drive_picker_line_1 .drive_picker_line_2 \
3843 -in .drive_picker -side top -expand 1 -fill x -anchor w
3844 pack .drive_scan .drive_calm \
3845 -in .drive_aux_buttons_line_1 -side left -expand 1 -fill none
3846 pack .drive_drop_both .iso_rollback_button \
3847 -in .drive_aux_buttons_line_2 -side left -expand 1 -fill x
3848 pack .drive_aux_buttons_line_1 .drive_aux_buttons_line_2 \
3849 -in .drive_aux_buttons -side top -expand 1 -fill x -anchor w
3850 pack .drive_picker -in .drivebox -side left -expand 0 -fill none
3851 pack .drivelistbox -in .drivebox -side left -expand 1 -fill both
3852 pack .drive_aux_buttons -in .drivebox -side left -expand 0 -fill none
3853
3854 bind .drivelist <Double-Button-1> {
3855 pick_dev
3856 }
3857 }
3858
3859
3860 # The text fields for setting and display of the current input and output
3861 # drives. With Eject button and a short text description of the medium status.
3862 #
3863 proc init_dev {} {
3864 global borderwidth
3865 global .dev .indev .outdev
3866
3867 frame .dev -borderwidth $borderwidth
3868
3869 init_indev
3870 init_outdev
3871
3872 pack .indev .outdev -in .dev \
3873 -side top -anchor w -expand 1 -fill both
3874 }
3875
3876
3877 # Set and display the current input drive.
3878 #
3879 proc init_indev {} {
3880 global borderwidth indev_adr
3881 global .indev .indev_eject .indev_label .indev_entry .indev_summary
3882
3883 frame .indev -borderwidth $borderwidth
3884
3885 button .indev_eject -text "Eject" -command {eject_indev}
3886 bind_help .indev_eject "Eject (indev)"
3887
3888 button .indev_label -width 16 -text "Input drive/image " \
3889 -command {indev_return}
3890
3891 bind_help .indev_label "Input drive/image"
3892 entry .indev_entry -width 34 -relief sunken -bd 1 \
3893 -textvariable indev_adr
3894
3895 bind_entry_keys .indev_entry {indev_return}
3896 bind_help .indev_entry "Input drive/image"
3897 label .indev_summary -width 60 -text "" -relief ridge -borderwidth 2
3898 bind_help .indev_summary "input drive info"
3899 create_browser_button .indev_browse_button \
3900 "indev_adr" "localfs" "Browse disk (indev)"
3901
3902 pack .indev_eject .indev_label .indev_entry \
3903 -in .indev -side left -expand 1 -fill both
3904 pack .indev_browse_button -in .indev -side left
3905 pack .indev_summary \
3906 -in .indev -side left -expand 1 -fill both
3907 }
3908
3909
3910 # Set and display the current output drive.
3911 #
3912 proc init_outdev {} {
3913 global .outdev .outdev_eject .outdev_label .outdev_entry .outdev_summary
3914 global borderwidth outdev_adr
3915
3916 frame .outdev -borderwidth $borderwidth
3917
3918 button .outdev_eject -text "Eject" -command {eject_outdev}
3919 bind_help .outdev_eject "Eject (outdev)"
3920
3921 button .outdev_label -width 16 -text "Output drive/image" \
3922 -command {outdev_return}
3923
3924 bind_help .outdev_label "Output drive/image"
3925 entry .outdev_entry -width 34 -relief sunken -bd 1 \
3926 -textvariable outdev_adr
3927 bind_entry_keys .outdev_entry {outdev_return}
3928 bind_help .outdev_entry "Output drive/image"
3929 create_browser_button .outdev_browse_button \
3930 "outdev_adr" "localfs" "Browse disk (outdev)"
3931 label .outdev_summary -width 60 -text "" -relief ridge -borderwidth 2
3932 bind_help .outdev_summary "output drive info"
3933 pack .outdev_eject .outdev_label .outdev_entry \
3934 -in .outdev -side left -expand 1 -fill both
3935 pack .outdev_browse_button -in .outdev -side left
3936 pack .outdev_summary \
3937 -in .outdev -side left -expand 1 -fill both
3938 }
3939
3940
3941 # The button panel for blanking, formatting, and writing to the output drive.
3942 #
3943 proc init_burn {} {
3944 global borderwidth burn_write_image_adr burn_write_close burn_write_tao
3945 global burn_write_defect_mgt
3946 global .burn .burn_blank_button .burn_format_button .burn_commit_button
3947 global .burn_write_image .burn_write_image_entry .burn_write_close
3948 global .burn_write_tao .burn_write_defect_mgt
3949
3950 frame .burn -borderwidth $borderwidth
3951
3952 button .burn_blank_button -text "Blank" \
3953 -command {burn_blank}
3954 bind_help .burn_blank_button "Blank"
3955 button .burn_format_button -text "Format" \
3956 -command {burn_format}
3957 bind_help .burn_format_button "Format"
3958 button .burn_commit_button -text "Write ISO session" \
3959 -command {burn_commit}
3960 bind_help .burn_commit_button "Write ISO session"
3961 button .burn_write_image -text "Burn image file:" \
3962 -command {burn_write_image}
3963 bind_help .burn_write_image "Burn image file:"
3964 entry .burn_write_image_entry -width 40 -relief sunken -bd 1 \
3965 -textvariable burn_write_image_adr
3966 bind_entry_keys .burn_write_image_entry {burn_write_image}
3967 bind_help .burn_write_image_entry "Burn image file:"
3968 create_browser_button .burn_image_browse_button \
3969 "burn_write_image_adr" "localfs" "Browse disk (burn image)"
3970 checkbutton .burn_write_close -text "Close" \
3971 -indicatoron 1 -selectcolor "" \
3972 -relief ridge -borderwidth 2 \
3973 -variable burn_write_close \
3974 -onvalue 1 -offvalue 0
3975 bind_help .burn_write_close "Close"
3976 checkbutton .burn_write_tao -text "TAO" \
3977 -indicatoron 1 -selectcolor "" \
3978 -relief ridge -borderwidth 2 \
3979 -variable burn_write_tao \
3980 -onvalue 1 -offvalue 0
3981 bind_help .burn_write_tao "TAO"
3982 checkbutton .burn_write_defect_mgt -text "Defect Mgt" \
3983 -indicatoron 1 -selectcolor "" \
3984 -relief ridge -borderwidth 2 \
3985 -variable burn_write_defect_mgt \
3986 -onvalue 1 -offvalue 0
3987 bind_help .burn_write_defect_mgt "Defect Mgt"
3988 pack .burn_blank_button .burn_format_button \
3989 .burn_commit_button .burn_write_close .burn_write_tao \
3990 .burn_write_defect_mgt \
3991 .burn_write_image .burn_write_image_entry \
3992 -in .burn -side left -expand 1 -fill both
3993 pack .burn_image_browse_button -in .burn -side left
3994 }
3995
3996
3997 # Set and display the current ISO directory and its content.
3998 #
3999 proc init_isobox {} {
4000 global borderwidth isolist_lines export_selection
4001 global .isobox .isodir .isolist .isodir_entry .isodir_up .isodir_up2
4002 global .isodir_label .isodir_verify .isolistbox .isoscroll_y .isoscroll_x
4003
4004 frame .isobox -borderwidth $borderwidth
4005 frame .isodir -borderwidth 0
4006
4007 label .isodir_label -text "ISO directory:" \
4008 -width 14
4009 bind_help .isodir_label "ISO directory:"
4010 entry .isodir_entry -width 60 -relief sunken -bd 1 \
4011 -textvariable isodir_adr
4012 bind_entry_keys .isodir_entry {isodir_return "isodir_entry"}
4013 bind_help .isodir_entry "ISO directory:"
4014 create_browser_button .isodir_browse_button \
4015 "isodir_adr" "isofs" "Browse ISO (isodir)"
4016 button .isodir_verify -text "Verify" -command {isodir_verify}
4017 bind_help .isodir_verify "Verify"
4018 button .isodir_up -text "Up" -command {isodir_up}
4019 bind_help .isodir_up "Up"
4020 button .isodir_up2 -text "Up" -command {isodir_up}
4021 bind_help .isodir_up2 "Up"
4022 pack .isodir_label .isodir_up \
4023 -in .isodir -side left
4024 pack .isodir_entry \
4025 -in .isodir -side left -expand 1 -fill both
4026 pack .isodir_browse_button .isodir_up2 .isodir_verify \
4027 -in .isodir -side left
4028
4029 frame .isolistbox -borderwidth 0
4030 listbox .isolist -height $isolist_lines -selectmode extended \
4031 -yscrollcommand ".isoscroll_y set" \
4032 -xscrollcommand ".isoscroll_x set" \
4033 -exportselection $export_selection
4034 bind_listbox_keys ".isolist" $isolist_lines "listbox"
4035 bind_help .isolist "isolist"
4036 scrollbar .isoscroll_y -command ".isolist yview"
4037 scrollbar .isoscroll_x -orient horizontal -command ".isolist xview"
4038 pack .isolist -in .isolistbox -side left -expand 1 -fill both
4039 bind .isolist <Double-Button-1> { pick_isodir }
4040 pack .isoscroll_y -in .isolistbox -side right -fill y
4041
4042 pack .isodir .isolistbox .isoscroll_x \
4043 -in .isobox -side top -expand 1 -fill both
4044 }
4045
4046
4047 # The ISO-internal manipulation buttons for the ISO directory or its content.
4048 # Plus a text field where to set an ISO path as target for renaming or
4049 # directory making.
4050 #
4051 proc init_isomanip {} {
4052 global borderwidth isomanip_move_target
4053 global .isomanip .isomanip_move .isomanip_prefix .isomanip_verify_button
4054 global .isomanip_move_target .isomanip_rm_r_button .isomanip_move_button
4055 global .isomanip_mkdir_button .isomanip_move_target
4056 global .avail_label .avail_label_frame .avail_button
4057
4058 frame .isomanip -borderwidth $borderwidth
4059 frame .isomanip_move -borderwidth 0
4060
4061 label .isomanip_prefix -text "Selection:"
4062 bind_help .isomanip_prefix "Selection:"
4063
4064 button .isomanip_verify_button -text "Verify" \
4065 -command {isomanip_verify}
4066 bind_help .isomanip_verify_button "Verify (selection)"
4067 button .isomanip_rm_r_button -text "Delete" \
4068 -command {isomanip_rm_r}
4069 bind_help .isomanip_rm_r_button "Delete"
4070 button .isomanip_move_button -text "Move to:" \
4071 -command {isomanip_mv}
4072 bind_help .isomanip_move_button "Move to:"
4073 button .isomanip_mkdir_button -text "Make dir" \
4074 -command {isomanip_mkdir}
4075 bind_help .isomanip_mkdir_button "Make dir"
4076 entry .isomanip_move_target -width 60 -relief sunken -bd 1 \
4077 -textvariable isomanip_move_target
4078 bind_entry_keys .isomanip_move_target {isomanip_mv}
4079 bind_help .isomanip_move_target "rename and mkdir target"
4080 create_browser_button .isomanip_move_target_button \
4081 "isomanip_move_target" "isofs" "Browse ISO (move target)"
4082
4083 pack .isomanip_prefix .isomanip_verify_button .isomanip_rm_r_button \
4084 .isomanip_move_button \
4085 -in .isomanip_move -side left
4086 pack .isomanip_move_target \
4087 -in .isomanip_move -side left -expand 1 -fill both
4088 pack .isomanip_move_target_button -in .isomanip_move -side left
4089 pack .isomanip_mkdir_button \
4090 -in .isomanip_move -side left -expand 1 -fill both
4091 pack .isomanip_move \
4092 -in .isomanip -side top -expand 1 -fill both
4093 }
4094
4095
4096 # The means for interaction of ISO image and hard disk filesystem.
4097 #
4098 proc init_localfs {} {
4099 global borderwidth
4100 global .localfs .extract_frame .aux_control_frame .insert_frame
4101
4102 frame .localfs -borderwidth $borderwidth
4103
4104 init_extract
4105 init_aux_control
4106 init_insert
4107
4108 pack .extract_frame .aux_control_frame .insert_frame \
4109 -in .localfs -side top -expand 1 -fill both
4110 }
4111
4112
4113 # The means for extracting files from ISO image to disk
4114 #
4115 proc init_extract {} {
4116 global borderwidth extract_to_adr extract_from_selected extract_underneath
4117 global osirrox_allowed
4118 global .extract_button .extract_frame .extract_entry .extract_from_selected
4119 global .extract_underneath
4120
4121 set extract_state "normal"
4122 if {$osirrox_allowed == 0} {set extract_state "disabled"}
4123
4124 frame .extract_frame -borderwidth 0
4125 button .extract_button -text "Extract to disk:" \
4126 -state $extract_state \
4127 -width 17 \
4128 -command {extract_to}
4129 bind_help .extract_button "Extract to disk:"
4130 entry .extract_entry -width 40 -relief sunken -bd 1 \
4131 -textvariable "extract_to_adr"
4132 bind_entry_keys .extract_entry {extract_to}
4133 bind_help .extract_entry "Extract to disk:"
4134 create_browser_button .extract_browse_button \
4135 "extract_to_adr" "localfs" "Browse disk (extract)"
4136 checkbutton .extract_underneath -text "Underneath" \
4137 -indicatoron 1 -selectcolor "" \
4138 -relief ridge -borderwidth 2 \
4139 -variable extract_underneath \
4140 -onvalue 1 -offvalue 0
4141 bind_help .extract_underneath "Underneath (extract)"
4142 checkbutton .extract_from_selected -text "Selected" \
4143 -indicatoron 1 -selectcolor "" \
4144 -relief ridge -borderwidth 2 \
4145 -variable extract_from_selected \
4146 -onvalue 1 -offvalue 0
4147 bind_help .extract_from_selected "Selected (extract)"
4148 pack .extract_button -in .extract_frame -side left
4149 pack .extract_entry \
4150 -in .extract_frame -side left -expand 1 -fill both
4151 pack .extract_from_selected .extract_underneath \
4152 -in .extract_frame -side right
4153 pack .extract_browse_button -in .extract_frame -side right
4154 }
4155
4156
4157 # Some controls which apply to insertion, extraction, or both.
4158 #
4159 proc init_aux_control {} {
4160 global borderwidth have_bwidget permission_policy
4161 global .aux_control_frame
4162 global .overwrite_iso_files_button .overwrite_dir_button .extract_auto_chmod
4163
4164 frame .aux_control_frame -borderwidth 0
4165
4166 menubutton .overwriting -text "Overwriting:" -width 16 -anchor w \
4167 -direction above -relief ridge -indicatoron 1 \
4168 -menu .overwriting.menu
4169 bind_help .overwriting "Overwriting:"
4170 set_overwriting_label
4171 set m ".overwriting.menu"
4172 menu $m
4173 $m add checkbutton -label "Overwrite ISO files" \
4174 -indicatoron 1 -selectcolor "" \
4175 -command set_overwriting_label \
4176 -variable overwrite_iso_files \
4177 -onvalue 1 -offvalue 0
4178 $m add checkbutton -label "Overwrite ISO dirs" \
4179 -indicatoron 1 -selectcolor "" \
4180 -command set_overwriting_label \
4181 -variable overwrite_iso_dirs \
4182 -onvalue 1 -offvalue 0
4183 $m add checkbutton -label "Overwrite hard disk files" \
4184 -indicatoron 1 -selectcolor "" \
4185 -command set_overwriting_label \
4186 -variable overwrite_disk_files \
4187 -onvalue 1 -offvalue 0
4188 $m add checkbutton -label "Enforce disk dir write access" \
4189 -indicatoron 1 -selectcolor "" \
4190 -command set_overwriting_label \
4191 -variable extract_auto_chmod \
4192 -onvalue 1 -offvalue 0
4193
4194 pack .overwriting -in .aux_control_frame -side left
4195
4196 menubutton .perm_policy -text "Permissions: as is" -width 22 -anchor w \
4197 -direction above -relief ridge -indicatoron 1 \
4198 -menu .perm_policy.menu
4199 set m ".perm_policy.menu"
4200 menu $m -tearoff 0
4201 $m add radiobutton -label "as is" -value "as_is" \
4202 -variable permission_policy -command show_permission_policy
4203 $m add radiobutton -label "readable" -value "readable" \
4204 -variable permission_policy -command show_permission_policy
4205 $m add radiobutton -label "readonly" -value "readonly" \
4206 -variable permission_policy -command show_permission_policy
4207 $m add radiobutton -label "mkisofs -r" -value "mkisofs_r" \
4208 -variable permission_policy -command show_permission_policy
4209 show_permission_policy
4210 bind_help .perm_policy "Permissions:"
4211
4212 button .avail_button -text "Refresh avail:" \
4213 -command {refresh_avail}
4214 bind_help .avail_button "Refresh avail:"
4215 frame .avail_label_frame -relief ridge -borderwidth 2
4216 label .avail_label -width 12 -text ""
4217 bind_help .avail_label "Refresh avail:"
4218 pack .avail_label -in .avail_label_frame
4219
4220 pack .avail_label_frame .avail_button .perm_policy \
4221 -in .aux_control_frame -side right
4222 }
4223
4224
4225 # The means for inserting files from disk into the ISO image
4226 #
4227 proc init_insert {} {
4228 global borderwidth insert_from_adr insert_at_selected insert_underneath
4229 global .insert_button .insert_from_frame .insert_entry .insert_at_selected
4230 global .insert_underneath .insert_frame
4231
4232 frame .insert_frame -borderwidth 0
4233 frame .insert_from_frame -borderwidth 0
4234 button .insert_button -text "Insert from disk:" \
4235 -width 17 \
4236 -command {insert_from}
4237 bind_help .insert_button "Insert from disk:"
4238 entry .insert_entry -width 40 -relief sunken -bd 1 \
4239 -textvariable "insert_from_adr"
4240 bind_entry_keys .insert_entry {insert_from}
4241 bind_help .insert_entry "Insert from disk:"
4242 create_browser_button .insert_browse_button \
4243 "insert_from_adr" "localfs" "Browse disk (insert)"
4244 checkbutton .insert_underneath -text "Underneath" \
4245 -indicatoron 1 -selectcolor "" \
4246 -relief ridge -borderwidth 2 \
4247 -variable insert_underneath \
4248 -onvalue 1 -offvalue 0
4249 bind_help .insert_underneath "Underneath (insert)"
4250 checkbutton .insert_at_selected -text "Selected" \
4251 -indicatoron 1 -selectcolor "" \
4252 -relief ridge -borderwidth 2 \
4253 -variable insert_at_selected \
4254 -onvalue 1 -offvalue 0
4255 bind_help .insert_at_selected "Selected (insert)"
4256 pack .insert_button -in .insert_from_frame -side left
4257 pack .insert_entry \
4258 -in .insert_from_frame -side left -expand 1 -fill both
4259 pack .insert_browse_button -in .insert_from_frame -side left
4260 pack .insert_at_selected .insert_underneath \
4261 -in .insert_from_frame -side right
4262 pack .insert_from_frame -in .insert_frame -side left -expand 1 -fill both
4263 }
4264
4265
4266 # Set common behavior of listboxes in respect to focus and navigation keys.
4267 #
4268 proc bind_listbox_keys {box height what_widget} {
4269 global click_to_focus
4270
4271 if {$click_to_focus == 1} {
4272 bind $box <1> "focus \"$box\""
4273 bind $box <2> "focus \"$box\""
4274 bind $box <3> "focus \"$box\""
4275 } else {
4276 bind $box <Enter> "focus \"$box\""
4277 }
4278
4279 # No underlining
4280 if {$what_widget == "listbox"} {
4281 $box configure -activestyle "none"
4282 }
4283
4284 # Need to evaluate all $box and $height at bind-time. Thus "-quotes.
4285 bind $box <Any-KeyPress> "
4286 if {\"%K\" == \"Up\"} {
4287 $box yview scroll \"-1\" units
4288 }
4289 if {\"%K\" == \"Down\"} {
4290 $box yview scroll 1 units
4291 }
4292 if {\"%K\" == \"Prior\"} {
4293 $box yview scroll -[expr \"$height\" - 1] units
4294 # $box yview scroll -1 pages
4295 }
4296 if {\"%K\" == \"Next\"} {
4297 $box yview scroll [expr \"$height\" - 1] units
4298 # $box yview scroll 1 pages
4299 }
4300 if {\"%K\" == \"Home\"} {
4301 $box yview 0
4302 }
4303 if {\"%K\" == \"End\"} {
4304 $box yview end
4305 }
4306
4307 # >>> Do i need this ?
4308 # >>> For now: yes. It prevents double scrolling by PgUp PgDown
4309 # Prevent other bindings from being performed
4310 break
4311 "
4312 }
4313
4314
4315 # Set common behavior of entries in respect to focus and Return key.
4316 #
4317 proc bind_entry_keys {entry return_cmd} {
4318 global click_to_focus
4319
4320 if {$click_to_focus != 1} {
4321 bind $entry <Enter> "focus \"$entry\""
4322 }
4323 if {$return_cmd != ""} {
4324 bind $entry <Return> $return_cmd
4325 }
4326 }
4327
4328
4329 # Bind a help text to a widget.
4330 #
4331 proc bind_help {to_what help_name} {
4332 bind $to_what <Button-3> "window_help \"$help_name\" grey"
4333 }
4334
4335
4336 # Create a "/" button and wire it with variable, filesystem type,and help text.
4337 #
4338 proc create_browser_button {button_name var_name which_fs help_name} {
4339 global have_bwidget
4340
4341 button $button_name -text "/" -command "browse_tree $var_name $which_fs"
4342 bind_help $button_name $help_name
4343 }
4344
4345
4346 proc set_overwriting_label {} {
4347 global overwrite_iso_files overwrite_iso_dirs overwrite_disk_files
4348 global extract_auto_chmod
4349 global .overwriting
4350
4351 # Determine text suffix for menubutton from overwrite variables
4352 set oif "-"
4353 if {$overwrite_iso_files == 1} {set oif "f"}
4354 set oid "-"
4355 if {$overwrite_iso_dirs == 1} {set oid "d"}
4356 set ohf "-"
4357 if {$overwrite_disk_files == 1} {set ohf "h"}
4358 set fdw "-"
4359 if {$extract_auto_chmod == 1} {set fdw "w"}
4360 set otext "Overwriting: ${oif}${oid}${ohf}${fdw}"
4361 .overwriting configure -text $otext
4362 }
4363
4364
4365 # The central storage for help texts.
4366 #
4367 proc tell_helptext {what} {
4368 global own_version argv0 bwidget_version use_command_move
4369
4370 if {$what == "Help"} {
4371 return \
4372 "For getting particular help texts:
4373
4374 Click the rightmost mouse button on any button, list box, or text field.
4375
4376 For a help text about startup options of this frontend, execute in a shell:
4377
4378 $argv0 --help
4379
4380 For background info about xorriso and its commands, execute in a shell:
4381
4382 man xorriso
4383
4384 -----------------------------------------------------------------------------
4385
4386 The GUI window is separated into three main areas:
4387
4388 - The area for connection to xorriso
4389 - shows xorriso messages,
4390 - offers some general activities,
4391 - displays the \"ready/busy\" state of the connection,
4392 - and allows to toggle xorriso commands into the \"Command:\" field.
4393
4394 - The area for management of drives and ISO image data files
4395 - allows to scan for optical drives,
4396 - to acquire them and load their ISO directory tree,
4397 - to acquire ISO image files from hard disk as pseudo drives like DVD+RW,
4398 - to blank CD-RW, DVD-RW DVD+RW, BD-RE and format DVD-RW, BD-R,
4399 - to trigger writing of ISO sessions (which get defined in the third area),
4400 - and to burn image data files from hard disk to optical media.
4401
4402 - The area for inspection, manipulation, and exploitation of the ISO model
4403 - allows to insert directories and files from hard disk into the ISO model,
4404 - to delete and rename file objects in the ISO model,
4405 - to verify data files of loaded ISO directory trees by MD5,
4406 - to extract directories and files from ISO filesystem to hard disk.
4407
4408 -----------------------------------------------------------------------------
4409 Some Use Cases
4410 -----------------------------------------------------------------------------
4411
4412 - Burn a directory as only content onto a CD, DVD or BD
4413 - Write a directory as only content to an ISO image data file on hard disk
4414 - Burn an image data file from hard disk onto CD, DVD or BD
4415 - Add more data to an appendable medium or to an ISO image data file
4416 - Extract a directory tree from an ISO filesystem to hard disk
4417
4418 -----------------------------------------------------------------------------
4419
4420 Burn a directory as only content onto a CD, DVD or BD
4421
4422 - Click the \"Scan for drives\" button in the middle area.
4423 - Select a drive and click the \"Pick output drive\" button.
4424 - If the information field in the \"Output drive/image\" line begins by
4425 \"appendable\" or \"closed\" and if the medium is CD-RW, DVD-RW, DVD+RW, or
4426 BD-RE then click the \"Blank\" button to erase the old data.
4427 (Blanking of \"DVD-RW sequential recording\" will last very long.)
4428 - Go to the \"Insert from disk:\" line in the lower area.
4429 Either toggle in the address of the hard disk directory,
4430 or click on the \"/\" button to the right of the text field to get
4431 a file browser.
4432 - Hit the Return key in the text field or double click on a name in the
4433 browser to schedule the disk directory for writing to the medium.
4434 You may of course insert several directories or files that way.
4435 - Close the browser and click the \"Write ISO session\" button in the
4436 middle area. Confirm in the \"yes/no\" window that pops up.
4437 Burning will begin (or refuse on unsuitable medium status).
4438 - When the \"busy\" field displays \"ready\" again, you may click \"Eject\".
4439 Desktop drives should then put out the tray with the medium.
4440
4441 -----------------------------------------------------------------------------
4442
4443 Write a directory as only content to an ISO image data file on hard disk
4444
4445 - Go to the text field beside the \"Output drive/image\" button and toggle
4446 the address of the image file. Click the button or hit the Return key
4447 when the address is complete.
4448 Or click on the \"/\" button to the right of the field to get a file browser.
4449 - You may click on a name in the browser and bring it into the text field
4450 by button \"Edit\".
4451 - When the intended file address is composed, hit the Return key in the
4452 text field or click the \"Output drive/image\" button.
4453 - If the information field in the \"Output drive/image\" line begins by
4454 \"appendable\" or \"closed\" then you addressed an existing data file.
4455 Warning: Applying the \"Blank\" button to it would damage its content !
4456 You probably do not want this in this special use case.
4457 - Go to the \"Insert from disk:\" line in the lower area.
4458 Continue like in the above description for CD, DVD, and BD media.
4459
4460 -----------------------------------------------------------------------------
4461
4462 Burn an image data file from hard disk onto CD, DVD or BD
4463
4464 - Click the \"Scan for drives\" button in the middle area.
4465 - Select a drive and click the \"Pick output drive\" button.
4466 - If the information field in the \"Output drive/image\" line begins by
4467 \"appendable\" or \"closed\" and if the medium is CD-RW, DVD-RW, DVD+RW, or
4468 BD-RE then click the \"Blank\" button to erase the old data.
4469 (Blanking of \"DVD-RW sequential recording\" will last very long.)
4470 - Go to the text field beside the \"Burn image file:\" button and toggle
4471 the address of the image file. Or click on the \"/\" button to the right
4472 of the field to get a file browser.
4473 - Hit the Return key in the text field or double click on a name in the
4474 browser to initiate the burn run.
4475 Confirm in the \"yes/no\" window that pops up.
4476 - When the \"busy\" field displays \"ready\" again, you may click \"Eject\".
4477 Desktop drives should then put out the tray with the medium.
4478
4479 -----------------------------------------------------------------------------
4480
4481 Add more data to an appendable medium or to an ISO image data file
4482
4483 - Like above, \"Scan for drives\" but click button \"Pick drive for both roles\"
4484 in order to load the directory tree of the existing ISO filesystem.
4485 For an ISO image data file, bring its name into the input fields of both
4486 lines \"Input drive/image\" and \"Output drive/image\" and activate it
4487 by clicking both buttons or hitting the Return key in both fields.
4488 You should now see in both info fields texts which begin by \"appendable\".
4489 - Go to the \"Insert from disk:\" line in the lower area.
4490 Use the means described in the first use case to add more directories or
4491 data files.
4492 - If you are interested in \"Delete\" or \"Move to:\" buttons in the
4493 bottom line of the GUI: Click them by the rightmost mouse button to see
4494 their help texts.
4495 - When all intended changes are done: Click \"Write ISO session\" and
4496 confirm in the \"yes/no\" window.
4497
4498 -----------------------------------------------------------------------------
4499
4500 Extract a directory tree from an ISO filesystem to hard disk
4501
4502 - Like above, \"Scan for drives\" but click button \"Pick input drive\"
4503 in order to load the directory tree of the existing ISO filesystem.
4504 For an ISO image data file, bring its name into the input field of the
4505 line \"Input drive/image\". You should now see in its info field a text
4506 which begins by \"appendable\" or \"closed\".
4507 - Go to the \"ISO directory:\" line and list box in the lower area and
4508 select the directory or file you want to copy to hard disk.
4509 - To get to see the desired file items, either toggle the address of their
4510 parent directory into the text field and hit Return, or double click items
4511 to open them as directories, or click the \"/\" button to get a file browser.
4512 Select the item in the list box of the main window by a single click.
4513 - Go to the \"Extract to disk:\" line and choose the target address on disk.
4514 Either toggle in the address of the hard disk directory, or click on the
4515 \"/\" button to the right of the text field to get a file browser.
4516 - Hit the Return key in the text field or double click on a name in the
4517 browser to initiate the extraction run.
4518 If a \"yes/no\" window pops up, consider well whether you are up to
4519 shooting your own foot right now.
4520 Enable the \"Overwrite hard disk files\" switch only if you are really
4521 sure that the files from ISO are better than the ones on hard disk.
4522
4523 -----------------------------------------------------------------------------
4524
4525 xorriso-tcltk is mainly a proof of concept for a frontend that operates
4526 xorriso in dialog mode.
4527
4528 It demonstrates some of xorriso's multi-session features with ISO 9660
4529 filesystems on optical media (CD, DVD, BD) or in disk files.
4530
4531 Dependencies:
4532 xorriso, Tcl language, Tk GUI toolkit, optionally Tcl/Tk package BWidget
4533
4534 Copyright (C) 2012 - 2016
4535 Thomas Schmitt <scdbackup@gmx.net>, libburnia-project.org
4536 Provided under BSD license: Use, modify, and distribute as you like."
4537 }
4538 if {$what == "End"} {
4539 return \
4540 "The \"End\" button leads to the end of frontend and xorriso process."
4541 }
4542 if {$what == "version"} {
4543 return \
4544 "The field between \"End\" button and ready/busy field displays the
4545 version of the serving xorriso program.
4546
4547 xorriso is a program which copies file objects from POSIX compliant
4548 filesystems into Rock Ridge enhanced ISO 9660 filesystems and allows
4549 session-wise manipulation of such filesystems. It can load the management
4550 information of existing ISO images and it writes the session results to
4551 optical media or to filesystem objects.
4552 Vice versa xorriso is able to restore file objects from ISO 9660 filesystems.
4553
4554 xorriso-tcltk-$own_version is mainly a proof of concept for a frontend
4555 that operates xorriso in dialog mode.
4556
4557 It exercises several fundamental gestures of communication:
4558 - connecting via two pipes
4559 - sending commands
4560 - receiving replies
4561 - inquiring the xorriso message sieve
4562 - using the xorriso parsing service
4563
4564 Note that any other language than Tcl/Tk could be used, if it only can
4565 do i/o via standard input and standard output or via named pipes.
4566 Further it has to perform integer arithmetics and string manipulations.
4567 And, well, a graphical widget set would be nice."
4568 }
4569 if {$what == "Refresh disp"} {
4570 return \
4571 "The \"Refresh disp\" button causes several text fields and list
4572 boxes to update their display after manually transmitted commands may
4573 have changed the state of drives or ISO model."
4574 }
4575 if {$what == "ready/busy"} {
4576 return \
4577 "The ready/busy field indicates whether a xorriso command is being executed
4578 and the frontend is still waiting for its reply messages."
4579 }
4580 if {$what == "Command:"} {
4581 return \
4582 "The \"Command:\" field can be used to send commands to xorriso.
4583 See the manual page of xorriso for its concepts and commands.
4584
4585 Normally the other GUI elements will emit xorriso commands for you.
4586 This input field is presented only to make accessible those features
4587 of xorriso which are not covered by the GUI. Use the \"Refresh disp\"
4588 button to update the display after you have manually transmitted commands."
4589 }
4590 if {$what == "Script/Log"} {
4591 return \
4592 "The \"Script/Log\" menu controls logging of xorriso commands and replies.
4593
4594 The \"Log command script\" switch controls whether the essential xorriso
4595 commands of the GUI session shall be written to the end of a script file
4596 on hard disk. Not written will be the commands by which the GUI inspects
4597 the xorriso state, but only those which set up that state and those which
4598 get sent via the \"Command:\" field.
4599 Commands -osirrox and -extract will be logged only as comments.
4600
4601 The \"Log non-essential commands\" switch controls whether all commands
4602 shall be logged if \"Log command script\" is enabled. Commands
4603 -msg_op \"parse\" and -msg_op \"parse_bulk\" will be logged only as comments.
4604
4605 The item \"Set log script address\" pops up a file tree browser window
4606 which asks for the target of appending to script. Address \"-\" means
4607 standard error. Else it must not yet exist or be a writable data file.
4608
4609 The \"Log pipes\" switch controls whether all xorriso commands and replies
4610 shall be logged to standard error or to the file that has been given
4611 with program argument --pipe_log_file.
4612 Caution: This log is verbose.
4613
4614 The item \"Set pipe log address\" pops up a file tree browser window
4615 which asks for the target of pipe logging . Address \"-\" means
4616 standard error. Else it must not yet exist or be a writable data file.
4617
4618 The item \"Execute command script\" executes the commands in a script
4619 file that should stem from \"Log command script\".
4620 At least it must begin by this line:
4621 # xorriso-tcltk command log script
4622 Be aware that xorriso will slavishly execute those commands. Better check
4623 in advance whether the content of the script file is what you expect.
4624 See man xorriso for the meaning of the commands.
4625
4626 The \"Allow extract to disk\" switch controls whether commands like -extract
4627 are allowed in command scripts. If disabled, then command -osirrox is used
4628 to temporarily block those commands (unless the script unblocks itself, which
4629 would be nasty behavior).
4630
4631 The item \"Permanently ban extraction\" disables -extract irrevocably for
4632 scripts and GUI alike."
4633 }
4634 if {$what == "message box"} {
4635 return \
4636 "The message box displays commands sent to xorriso and messages received
4637 from xorriso.
4638
4639 Many commands which are emitted by the GUI will hide themselves and their
4640 replies from this display. All event messages with severity WARNING or
4641 higher will show up, nevertheless."
4642 }
4643 if {$what == "Recent problem:"} {
4644 return \
4645 "The \"Recent problem:\" field shows the most severe event message that occurred
4646 during the execution of the most recent command. It also displays the most
4647 recent problem message from the frontend program itself.
4648
4649 Several commands emitted by the GUI will not clear this display. But any
4650 manually transmitted command and the major GUI gestures will do.
4651 "
4652 }
4653 if {$what == "Worst problem:"} {
4654 return \
4655 "The \"Worst problem:\" field shows the most severe event message that occurred
4656 since last time the \"Clear\" button was hit. It will not clear automatically."
4657 }
4658 if {$what == "Clear"} {
4659 return \
4660 "The \"Clear\" button removes the message from the \"Worst problem:\" field."
4661 }
4662 if {$what == "Scan for drives"} {
4663 return \
4664 "The \"Scan for drives\" button executes command -devices and puts the list
4665 of found optical drives into the box beside the button.
4666
4667 Scanning should be done before any ISO image manipulations because xorriso
4668 has to give up its acquired drives in order to perform the scan run.
4669
4670 To become visible and to be usable, the drives have to offer rw-permission
4671 to the user of this program. If drives do not show up, then consider to
4672 become superuser and to execute
4673 xorriso -devices
4674 Then apply
4675 chmod a+rw
4676 to the listed device files. (Consider to use finer means of permission
4677 granting for a permanent solution.)"
4678 }
4679 if {$what == "Pick input drive"} {
4680 return \
4681 "The \"Pick input drive\" button executes command -indev and obtains some
4682 information about the medium status. This info is displayed in the
4683 \"Input drive/image\" line.
4684 Further it causes the display of the ISO image model to be updated.
4685
4686 The medium in the input drive must be blank or contain a valid ISO 9660
4687 filesystem.
4688 Choosing an input drive causes a root directory to be created in the ISO
4689 model of xorriso. If there is a valid ISO filesystem in the input drive
4690 then its directory tree gets loaded underneath that model root directory.
4691
4692 The input drive may also be a data file on hard disk if that file contains
4693 an ISO 9660 filesystem image. See the \"Input drive/image\" button."
4694 }
4695 if {$what == "Pick output drive"} {
4696 return \
4697 "The \"Pick output drive\" button executes command -outdev and obtains some
4698 information about the medium status. This info is displayed in the
4699 \"Output drive/image\" line.
4700
4701 The output drive may be empty or loaded with a medium, that may be blank,
4702 appendable or closed.
4703 It is usable for writing only if there is a medium inserted which is either
4704 blank or appendable. Button \"Blank\" can bring appendable or closed media
4705 into blank state.
4706
4707 The output drive may also be a data file on hard disk. See field
4708 \"Output drive/image\"."
4709 It is considered appendable if it contains an ISO 9660 filesystem image.
4710 It is considered blank if it is empty or marked as blank by button \"Blank\".
4711 It is considered closed if it contains other data."
4712 }
4713 if {$what == "Pick drive for both roles"} {
4714 return \
4715 "The \"Pick drive for both roles\" button executes command -dev and obtains some
4716 information about the medium status. This info is displayed in the
4717 \"Input drive/image\" line and in the \"Output drive/image\" line.
4718 Further it causes the display of the ISO image model to be updated.
4719
4720 The medium in the drive must be blank or contain a valid ISO 9660 filesystem.
4721 Else the drive will only be acquired as output drive.
4722
4723 This drive configuration is the most usual one with xorriso. It loads
4724 an eventual ISO image, allows to manipulate it by insertion, deletion,
4725 and renaming. When this is done, the changes get written to the drive
4726 via button \"Write ISO session\".
4727
4728 The drive may also be a data file on hard disk. See the fields beside
4729 the \"Input drive/image\" and \"Output drive/image\" buttons.
4730 A file is considered appendable if it contains an ISO 9660 filesystem image.
4731 It is considered blank if it is empty or marked as blank by button \"Blank\".
4732 It is considered closed if it contains other data."
4733 }
4734 if {$what == "Give up drives"} {
4735 return \
4736 "The \"Give up drives\" button executes commands -indev \"\" -outdev \"\"
4737 and clears both \"... drive/image\" lines, as well as the ISO model."
4738 }
4739 if {$what == "Calm drives"} {
4740 return \
4741 "The \"Calm drives\" button executes command -calm_drives which tells the
4742 acquired optical drives to stop spinning until the next drive activity
4743 gets triggered."
4744 }
4745 if {$what == "Rollback"} {
4746 return \
4747 "The \"Rollback\" button executes command -rollback which drops all pending
4748 changes of the ISO model and reloads it from the input drive, if one is
4749 acquired."
4750 }
4751 if {$what == "drivelist"} {
4752 return \
4753 "The box beside the \"Scan for drives\" button shows the optical drives
4754 which were found by the most recent scan run.
4755
4756 A double-click on a drive item has the same effect as button
4757 \"Pick drive for both roles\".
4758 "
4759 }
4760 if {$what == "Input drive/image"} {
4761 return \
4762 "The field beside the \"Input drive/image\" button displays the address of
4763 the input drive. You may edit this field.
4764 Clicking the button or pressing the Return key causes the execution of
4765 command -indev with the field content as drive address.
4766
4767 Use this to load the model from an ISO image data file on hard disk.
4768 It is of course permissible that input image and output image are the
4769 same file.
4770 "
4771 }
4772 if {$what == "input drive info"} {
4773 return \
4774 "The text beside the \"Input drive/image\" field displays the medium
4775 status of the input drive. It tells about the writability, the medium type,
4776 the number of ISO sessions, and the amount of readable data."
4777 }
4778 if {$what == "Eject (indev)"} {
4779 return \
4780 "The \"Eject\" button beside the \"Input drive/image\" button executes
4781 command -eject \"in\"."
4782 }
4783 if {$what == "Output drive/image"} {
4784 return \
4785 "The field beside the \"Output drive/image\" button displays the address
4786 of the output drive. You may edit this field.
4787 Clicking the button or pressing the Return key causes the execution
4788 of command -outdev with the field content as drive address.
4789
4790 Use this to direct writing to an ISO image data file on hard disk.
4791 It is of course permissible that input image and output image are the
4792 same file.
4793 "
4794 }
4795 if {$what == "output drive info"} {
4796 return \
4797 "The text beside the \"Output drive/image\" field displays the medium
4798 status of the output drive. It tells about the writability, the medium type,
4799 the number of ISO sessions, and the amount of free space."
4800 }
4801 if {$what == "Eject (outdev)"} {
4802 return \
4803 "The \"Eject\" button beside the \"Output drive/image\" button executes
4804 command -eject \"out\"."
4805 }
4806 if {$what == "Blank"} {
4807 return \
4808 "The \"Blank\" button executes command -blank \"as_needed\" on the output drive
4809 in order to make a re-usable medium or an ISO image data file writable from
4810 scratch.
4811
4812 Genuine blanking applies only to CD-RW and DVD-RW.
4813 But xorriso emulates ISO 9660 multi-session on DVD+RW, DVD-RAM,
4814 formatted DVD-RW, BD-RE, as well as in ISO image data files on hard disk.
4815 On those media and pseudo media, blanking will be performed by a small
4816 write operation which invalidates their existing ISO filesystem.
4817
4818 One-time writable media CD-R, DVD-R, DVD+R, and BD-R cannot be blanked."
4819 }
4820 if {$what == "Format"} {
4821 return \
4822 "The \"Format\" button executes -format \"as_needed\".
4823
4824 This only applies to real optical drives and is of interest only with DVD-RW
4825 or BD-R media, which both can be used formatted and unformatted. Other media
4826 types which mandatorily need formatting will be formatted by the write
4827 commands.
4828
4829 Formatted DVD-RW media have the advantage of being overwritable and thus
4830 being quickly blankable while maintaining the capability for multi-session.
4831
4832 Formatted BD-R can perform Defect Management, which is of questionable value."
4833 }
4834 if {$what == "Write ISO session"} {
4835 return \
4836 "The \"Write ISO session\" executes command -commit, which writes a session
4837 with all pending changes to the output drive.
4838
4839 The output drive must be either blank or it must be the same as the input
4840 drive.
4841
4842 Writing the session is the last step in the course of creating a new ISO
4843 filesystem or an add-on session that expands or changes the ISO filesystem
4844 on the medium of the output drive.
4845 So first choose a drive, then insert files from hard disk or do other
4846 manipulations, and then click \"Write ISO session\" to let xorriso
4847 write the data to medium or ISO image file.
4848 "
4849 }
4850 if {$what == "Close"} {
4851 return \
4852 "The \"Close\" switch controls whether command -close \"on\" is emitted with
4853 \"Write ISO session\" or whether -as cdrecord option -multi is omitted with
4854 \"Burn image file:\".
4855
4856 Closed optical media cannot be written any more unless they get blanked,
4857 which is not possible with CD-R, DVD-R, DVD+R, and BD-R.
4858 "
4859 }
4860 if {$what == "TAO"} {
4861 return \
4862 "The \"TAO\" switch controls whether an incremental MMC write type shall be
4863 enforced with write commands. See xorriso command -write_type.
4864
4865 Normally xorriso will decide by medium status and job parameters which
4866 MMC write type to choose. Some drives at the edge of failure might work
4867 with the one write type while already failing with the other."
4868 }
4869 if {$what == "Defect Mgt"} {
4870 return \
4871 "The \"Defect Mgt\" switch controls whether slow and error-prone drive internal
4872 check-reading shall be enabled when writing to formatted BD-R or BD-RE.
4873 See xorriso command -stream_recording."
4874 }
4875 if {$what == "Burn image file:"} {
4876 return \
4877 "The \"Burn image file:\" button executes command -as \"cdrecord\" to
4878 burn a data file from hard disk onto the output drive.
4879 The address of the disk file is taken from the neighboring text field.
4880
4881 If you do not plan to append further data to the medium, then consider
4882 to enable the \"Close\" switch.
4883
4884 No input drive may be acquired. (Delete all characters from the field
4885 \"Input drive/image\" and hit Return to give up the input drive.)
4886
4887 The medium in the drive must be blank.
4888 (It is well possible to burn image files to appendable media. But the
4889 image needs to be prepared for the address offset. Who can do that can
4890 as well use one of the command line tools for burning the result. E.g.
4891 xorriso -as cdrecord -v dev=/dev/sr0 -multi stream_recording=32s image.iso
4892 )"
4893 }
4894 if {$what == "Extract to disk:"} {
4895 return \
4896 "The \"Extract to disk:\" button executes command -extract with the whole
4897 tree of the current ISO directory or with the selected items of the box
4898 underneath \"ISO directory:\".
4899
4900 This copies the selected files or directory trees from the input drive
4901 to the address on hard disk which is given by the text field right of
4902 the button."
4903 }
4904 if {$what == "Browse tree"} {
4905 return "[tell_file_browser_help 0]"
4906 }
4907 if {$what == "Close (browse tree)"} {
4908 return \
4909 "The \"Close\" button in the file browser closes the browser window without
4910 performing other actions."
4911 }
4912 if {$what == "Up (browse tree)"} {
4913 return \
4914 "The \"Up\" button in the file browser brings you to the parent directory
4915 of the currently selected file tree item.
4916
4917 The parent directory will be opened and become the selected item.
4918 All opened directory trees underneath the parent will be closed."
4919 }
4920 if {$what == "Down (browse tree)"} {
4921 return \
4922 "The \"Down\" button in the file browser opens the directory underneath
4923 the currently selected file tree item.
4924
4925 It has the same effect as clicking the \"+\" node of the selected item."
4926 }
4927 if {$what == "Accept (browse tree)"} {
4928 return \
4929 "The \"Accept\" button in the file browser brings the single selected item
4930 from the file browser tree into effect with the associated text field.
4931 I.e. it hits the Return key of the field.
4932
4933 It works as if the item had been double clicked."
4934 }
4935 if {$what == "Edit (browse tree)"} {
4936 return \
4937 "The \"Edit\" button in the file browser brings the single selected item
4938 from the file browser tree into the associated text field.
4939
4940 It does not hit the Return key of the field, but gives you the opportunity
4941 to edit the file address."
4942 }
4943 if {$what == "Browse disk (extract)"} {
4944 return \
4945 "The \"/\" button in the \"Extract to disk:\" line pops up a file tree
4946 browser to select a target address in the hard disk filesystem.
4947
4948 [tell_file_browser_help 1]"
4949 }
4950 if {$what == "Browse disk (burn image)"} {
4951 return \
4952 "The \"/\" button beside the \"Burn image file\" field pops up a file
4953 tree browser to select a source address in the hard disk filesystem.
4954
4955 [tell_file_browser_help 1]"
4956 }
4957 if {$what == "Browse disk (insert)"} {
4958 return \
4959 "The \"/\" button beside the \"Insert from disk\" field pops up a file
4960 tree browser to select a source address in the hard disk filesystem.
4961
4962 [tell_file_browser_help 1]"
4963 }
4964 if {$what == "Browse disk (indev)"} {
4965 return \
4966 "The \"/\" button in the \"Input drive/image\" line pops up a file tree
4967 browser to select a source address in the hard disk filesystem.
4968
4969 [tell_file_browser_help 1]"
4970 }
4971 if {$what == "Browse disk (outdev)"} {
4972 return \
4973 "The \"/\" button in the \"Output drive/image\" line pops up a file tree
4974 browser to select a source address in the hard disk filesystem.
4975
4976 [tell_file_browser_help 1]"
4977 }
4978 if {$what == "Browse ISO (isodir)"} {
4979 return \
4980 "The \"/\" button in the \"ISO directory\" line pops up a file tree
4981 browser to select the current directory in the ISO filesystem model.
4982
4983 [tell_file_browser_help 1]"
4984 }
4985 if {$what == "Browse ISO (move target)"} {
4986 return \
4987 "The \"/\" button in the \"Selection:\" line pops up a file tree
4988 browser to select the current directory in the ISO filesystem model.
4989
4990 [tell_file_browser_help 1]"
4991 }
4992 if {$what == "Browse disk (dummy)"} {
4993 return \
4994 "Normally this button would start a file browser to select a file or
4995 directory on hard disk.
4996
4997 But the browser cannot be displayed because Tcl/Tk package \"BWidget\"
4998 is not loaded."
4999 }
5000 if {$what == "Browse ISO (dummy)"} {
5001 return \
5002 "Normally this button would start a file browser to select a file or
5003 directory in the ISO model.
5004
5005 But the browser cannot be displayed because Tcl/Tk package \"BWidget\"
5006 is not loaded."
5007 }
5008 if {$what == "Underneath (extract)"} {
5009 return \
5010 "The \"Underneath\" switch controls the effective hard disk target address
5011 of an item if the address in the \"Extract to disk:\" field points to a
5012 directory.
5013
5014 If \"Underneath\" is enabled, then the file object from the ISO filesystem
5015 will be copied to its name underneath the hard disk directory.
5016 If \"Underneath\" is disabled then an ISO directory tree item will be merged
5017 with the disk directory tree at the given address.
5018
5019 Example:
5020 Selected are \"/iso_dir\" and \"/iso_file\".
5021 Address for hard disk is \"/tmp/from_iso\". Switch \"Selected\" is enabled.
5022 \"Underneath\" enabled causes commands:
5023 -extract /iso_dir /tmp/from_iso/iso_dir
5024 -extract /iso_file /tmp/from_iso/iso_file
5025 \"Underneath\" disabled:
5026 -extract /iso_dir /tmp/from_iso
5027 -extract /iso_file /tmp/from_iso
5028 The last command will fail because /tmp/from_iso already exists as directory."
5029 }
5030 if {$what == "Selected (extract)"} {
5031 return \
5032 "The \"Selected\" switch controls whether the whole current ISO directory,
5033 or only the selected items shall be copied to hard disk.
5034 "
5035 }
5036 if {$what == "Overwriting:"} {
5037 return \
5038 "The \"Overwriting\" menu bundles several switches which control whether
5039 existing files or directories may be overwritten.
5040
5041 The frontend program will only detect the most obvious name collisions,
5042 but xorriso will reliably refuse to overwrite files if this is banned.
5043
5044 ----------------------------------------------------------------------------
5045
5046 The \"Overwrite ISO files\" switch controls whether existing files may be
5047 overwritten in the ISO image. See xorriso command -overwrite \"nondir\".
5048
5049 ----------------------------------------------------------------------------
5050
5051 The \"Overwrite ISO dirs\" switch controls whether it is allowed to replace
5052 an ISO directory by a another file. See xorriso command -overwrite \"on\".
5053
5054 ----------------------------------------------------------------------------
5055
5056 The \"Overwrite hard disk files\" switch controls whether existing files may be
5057 overwritten by extraction to hard disk. See xorriso command -overwrite \"on\".
5058
5059 This is DANGEROUS, of course, but comes in handy with restoring of backups.
5060
5061 ----------------------------------------------------------------------------
5062
5063 The \"Enforce disk dir write access\" switch enables the -osirrox options
5064 \"auto_chmod_on\" and \"sort_lba_on\" which influence file extraction.
5065
5066 \"auto_chmod_on\" allows xorriso to give itself temporariy w-permission to
5067 all disk directories which are owned by the xorriso user.
5068
5069 This is DANGEROUS, of course, but comes in handy with restoring of backups.
5070
5071 Option \"sort_lba_on\" reduces head-moves of optical drives and thus can
5072 speed up extraction substantially. It is bound to \"auto_chmod_on\" because
5073 else it might get into trouble when restoring ISO directories which offer
5074 no w-permission."
5075 }
5076 if {$what == "Permissions:"} {
5077 return \
5078 "The \"Permissions\" menu allows to choose a global policy to adjust
5079 the access permissions of the files when an ISO session gets written.
5080
5081 The default policy \"as is\" leaves the permissions as they are.
5082 Usually they have been imported from hard disk or from a loaded ISO image.
5083 xorriso commands -chmod , -chmod_r, and -find ... -exec chmod --
5084 may be used to perform permission manipulations.
5085
5086 Policy \"readable\" adds read permission to all kinds of files and
5087 search permission to all directories.
5088
5089 Policy \"readonly\" sets the permissions of all kinds of files to read-only.
5090 Directories get added search permission.
5091
5092 Policy \"mkisofs -r\" does what option -r of program mkisofs does:
5093 User id and group id become 0, all r-permissions get granted, all w denied.
5094 If there is any x-permission, then all three x get granted. s- and t-bits
5095 get removed.
5096 "
5097 }
5098 if {$what == "Refresh avail:"} {
5099 return \
5100 "The \"Refresh avail:\" button triggers command -tell_media_space. It makes
5101 a time consuming exact prediction of the free space on the medium in the
5102 output drive. For this purpose, the size of an ISO session with the pending
5103 changes is computed.
5104
5105 With image files rather than real optical drives, the free space of
5106 the hosting filesystem is displayed."
5107 }
5108 if {$what == "Insert from disk:"} {
5109 return \
5110 "The \"Insert from disk:\" button executes command -map with the disk file
5111 address that is given by the text field right to the button.
5112
5113 This inserts files or directory trees into the ISO image model and
5114 schedules them for being copied with the next \"Write ISO session\" run.
5115
5116 The switches \"Underneath\" and \"Selected\" control what ISO address
5117 the inserted files shall have. You may use buttons \"Delete\" and
5118 \"Move to:\" for further adjustments.
5119 "
5120 }
5121 if {$what == "Underneath (insert)"} {
5122 return \
5123 "The \"Underneath\" switch controls the effective ISO target address
5124 if the address in the \"Insert from disk:\" field points to a hard disk
5125 directory.
5126
5127 If \"Underneath\" is enabled, a directory from disk will not be unpacked
5128 to its single files but be put underneath the target address by its own
5129 leaf name."
5130
5131 If \"Underneath\" is disabled then the directory itself will not show up in
5132 the ISO image but only its files and sub directories will do."
5133 }
5134 if {$what == "Selected (insert)"} {
5135 return \
5136 "If the switch \"Selected\" is enabled, then the given disk file or tree will
5137 be inserted at or underneath the only selected item in the box underneath
5138 \"ISO directory:\"."
5139 }
5140 if {$what == "ISO directory:"} {
5141 return \
5142 "The current ISO directory shall be used to navigate in the ISO image model
5143 of xorriso. By default it is the target of file insertions and the source
5144 of file extractions.
5145
5146 The text field in the \"ISO directory:\" line displays the current ISO
5147 directory and can be used to toggle its path directly.
5148 Hitting the Return key causes the current directory to change and the
5149 display in the box underneath to be refreshed.
5150
5151 It is possible to choose the ISO directory by double-clicking an item
5152 in the box underneath the \"ISO directory:\" line.
5153 "
5154 }
5155 if {$what == "Up"} {
5156 return \
5157 "The \"Up\" buttons move the current ISO directory one directory level up."
5158 }
5159 if {$what == "Verify"} {
5160 return \
5161 "The \"Verify\" button executes -md5_check_r \"SORRY\" with the current ISO
5162 directory.
5163
5164 This reads the content of all data files which are underneath the current ISO
5165 directory and which have MD5 checksums in the ISO image.
5166 ISO images bear MD5 checksums for each data file if they were produced
5167 by xorriso with -md5 \"on\" or -for_backup. This frontend enables
5168 this feature on startup."
5169 }
5170 if {$what == "isolist"} {
5171 return \
5172 "The list box underneath the \"ISO directory:\" line displays the files in
5173 the current ISO directory. One or more item can be selected and play a
5174 role with extraction or insertion of files.
5175
5176 Most of the buttons underneath the box operate on the selected items
5177 unconditionally."
5178 }
5179 if {$what == "Selection:"} {
5180 return \
5181 "The ISO selection consists of the items which are selected in the list box
5182 above the \"Selection:\" line.
5183
5184 If the respective \"Selected\" switches are enabled, then the ISO selection
5185 is source of file extraction and target of file insertion.
5186
5187 In any case it is the old name of the \"Move to:\" button, the victim
5188 of the \"Delete\" button, and the subject of the \"Verify\" button."
5189 }
5190 if {$what == "Verify (selection)"} {
5191 return \
5192 "The \"Verify\" button in the \"Selection:\" line executes command
5193 -md5_check_r \"SORRY\" with each of the selected items.
5194
5195 This reads the content of all data files which are selected or underneath
5196 selected directories and which have MD5 checksums in the ISO image.
5197 ISO images bear MD5 checksums for each data file if they were produced
5198 by xorriso with -md5 \"on\" or -for_backup. This frontend enables
5199 this feature on startup."
5200 }
5201 if {$what == "Delete"} {
5202 return \
5203 "The \"Delete\" button executes command -rm_r with each of the selected items.
5204
5205 This removes the affected files and directory trees from the ISO model.
5206 They will not show up in the directory tree of the next session that
5207 is written via \"Write ISO session\". Nevertheless they will stay present
5208 in earlier sessions beginning from the session where they were inserted."
5209 }
5210 if {$what == "Move to:"} {
5211 if {$use_command_move == 0} {
5212 return \
5213 "The \"Move to:\" button uses command -mv to move each of the selected
5214 items to the address that is given by the text field right to the button.
5215
5216 If this address points to an existing ISO directory, then the items will
5217 be moved underneath that directory and keep their leaf names.
5218 Else there may be only one selected item which will be renamed to the
5219 given address."
5220 } else {
5221 return \
5222 "The \"Move to:\" button uses command -move to rename each of the selected
5223 items to the address that is given by the text field right to the button."
5224 }
5225 }
5226 if {$what == "Make dir"} {
5227 return \
5228 "The \"Make dir\" button executes command -mkdir with the address in the
5229 text field to its left (the same as used by \"Move to:\").
5230
5231 Useful to create a target directory before moving the selection."
5232 }
5233 if {$what == "rename and mkdir target"} {
5234 return \
5235 "The text field between the \"Move to:\" button and the \"Make dir\" button
5236 serves both buttons by providing the target address for renaming
5237 or directory creation, respectively.
5238
5239 If you hit the Return key in this field, it will trigger \"Mode to:\"."
5240 }
5241 if {$what == "yes to all"} {
5242 return \
5243 "The \"yes to all\" button appears in the yes/no window if a GUI action is
5244 about to overwrite a file object and more such overwrite situations are
5245 to be expected.
5246
5247 If the button is clicked, then all further yes/no questions of that GUI
5248 action will be answered automatically with yes.
5249
5250 [about_help_for_yesno]"
5251 }
5252 if {$what == "no to all"} {
5253 return \
5254 "The \"no to all\" button appears in the yes/no window if a GUI action is
5255 about to overwrite a file object and more such overwrite situations are
5256 to be expected.
5257
5258 If the button is clicked, then all further yes/no questions of that GUI
5259 action will be answered automatically with no.
5260
5261 [about_help_for_yesno]"
5262 }
5263 if {$what == "Continue"} {
5264 return \
5265 "The \"Continue\" button appears in the notification windows which tell
5266 about a failed or rejected GUI action.
5267
5268 ---------------------------------------------------------------------------
5269
5270 It is impossible to trigger any further GUI action while the notification
5271 window is displayed. You either have to click the \"Continue\" button
5272 or hit the Return key.
5273
5274 You cannot even close this help window before you did that."
5275 }
5276 if {$what == "yes/no"} {
5277 return \
5278 "The \"yes\" and \"no\" buttons appear in the confirmation window which tells
5279 about a potentially dangerous GUI action and demands a user decision whether
5280 to really perform this action.
5281
5282 [about_help_for_yesno]"
5283 }
5284
5285 return "--- No help text found for topic '$what'"
5286 }
5287
5288
5289 # Tell the general help text of the file browser.
5290 #
5291 proc tell_file_browser_help {with_separator} {
5292 global have_bwidget
5293
5294 set text ""
5295 if {$with_separator == 1} {
5296 set text \
5297 "-------------------------------------------------------------------------\n\n"
5298 }
5299 if {$have_bwidget == 1} {
5300
5301 set text \
5302 "${text}The file tree browser presents to you a directory tree and
5303 lets you bring into effect one of the file addresses in that tree.\n"
5304
5305 } else {
5306
5307 set text \
5308 "${text}Normally the file tree browser would present to you a directory tree
5309 and let you bring into effect one of the file addresses in that tree.
5310
5311 But the tree view cannot be displayed because Tcl/Tk package \"BWidget\"
5312 is not loaded.
5313
5314 -------------------------------------------------------------------------\n"
5315
5316 }
5317
5318 set text "${text}
5319 The bottom line of the browser window tells the associated text field
5320 in the GUI. E.g. \"ISO directory:\".
5321 Left of this label is a copy of that associated text field. You may edit
5322 its content and bring it into effect by hitting the Return key.\n"
5323
5324 if {$have_bwidget == 1} {
5325
5326 set text "${text}
5327 In the tree display click on the \"+\" or \"-\" nodes to open or
5328 close directories, respectively.
5329
5330 Double click on an item to bring it into effect with the associated
5331 text field. I.e. double clicking also hits the Return key in that field.\n"
5332
5333 }
5334
5335 set text "${text}
5336 The \"Accept\" button does the same with the selected item.\n"
5337
5338 if {$have_bwidget == 1} {
5339
5340 set text "${text}
5341 The \"Edit\" button brings the selected item into the text field
5342 without hitting the Return key. So you may edit the name before hitting
5343 Return yourself.
5344
5345 The \"Up\" button brings you to the parent directory of the selected item.
5346
5347 The \"Down\" button works like clicking the \"+\" node of the selected item.\n"
5348
5349 }
5350
5351 set text "${text}
5352 The \"Help\" button displays this help text window.
5353
5354 The \"Close\" button closes the browser window.\n"
5355 }
5356
5357
5358 # Tell about pecliarity of help window triggered by yes/no window
5359 proc about_help_for_yesno {} {
5360 return \
5361 "---------------------------------------------------------------------------
5362
5363 It is impossible to trigger any further GUI action while the confirmation
5364 window is displayed. You have to click one of the buttons in that window.
5365
5366 You cannot even close this help window before you clicked one of the buttons."
5367 }
5368
5369
5370 # ------- Misc helper procedures -------
5371
5372
5373 # Equip a text with quotation marks so that xorriso will consider it as
5374 # a single word.
5375 #
5376 proc make_text_shellsafe {text} {
5377 set result "'"
5378 set rest $text
5379 while {[string length $rest]} {
5380 set idx [string first "'" $rest]
5381 if {$idx == -1} {
5382 set result "$result$rest"
5383 break
5384 } else {
5385 if {$idx > 0} {
5386 set result "$result[string range $rest 0 [expr $idx - 1]]"
5387 }
5388 set result "$result'\"'\"'"
5389 if {$idx == [expr [string length $rest] - 1]} {
5390 break
5391 }
5392 set rest [string range $rest [expr $idx + 1] end]
5393 }
5394 }
5395 set result "$result'"
5396 }
5397
5398
5399 # Count the number of newline characters in text.
5400 #
5401 proc count_newlines {text} {
5402 set rest $text
5403 set count 0
5404 while {[string length $rest]} {
5405 set idx [string first "\n" $rest]
5406 if {$idx == -1} {
5407 break
5408 } else {
5409 set count [expr $count + 1]
5410 if {$idx == [expr [string length $rest] - 1]} {
5411 break
5412 }
5413 set rest [string range $rest [expr $idx + 1] end]
5414 }
5415 }
5416 return $count
5417 }
5418
5419
5420 # Append name to dir so that the result is a path to name under dir.
5421 #
5422 proc combine_dir_and_name {dir name} {
5423 set has_slash 0
5424 if {$name == ""} {
5425 return $dir
5426 }
5427 if {[string range $name 0 0] == "/"} {
5428 incr has_slash
5429 }
5430 if {[string last "/" $dir] == [expr [string length $dir] - 1] &&
5431 $dir != ""} {
5432 incr has_slash 1
5433 }
5434 if {$has_slash == 2} {
5435 return "$dir[string range $name" 1 end]"
5436 }
5437 if {$has_slash == 1} {
5438 return "$dir$name"
5439 }
5440 return "$dir/$name"
5441 }
5442
5443
5444 # Force the content of variable isodir_adr to be an absolute address
5445 #
5446 proc normalize_isodir_adr {} {
5447 global isodir_adr
5448
5449 if {$isodir_adr == ""} {
5450 set isodir_adr "/"
5451 }
5452 if {[string range $isodir_adr 0 0] != "/"} {
5453 set isodir_adr "/$isodir_adr"
5454 }
5455 }
5456
5457
5458 # Inspect path whether one of its components is in isodir_adr
5459 #
5460 proc path_touches_isodir {path} {
5461 global isodir_adr
5462
5463 normalize_isodir_adr
5464 set cmp_start 0
5465 if {$isodir_adr == "/"} {
5466 set cmp_start 1
5467 }
5468 if {[string range $path 0 0] != "/"} {
5469 if {[string first "/" $path] == -1} {
5470 return $path
5471 } else {
5472 return [file dirname $path]
5473 }
5474 }
5475 set l [expr {[string length $isodir_adr] - $cmp_start}]
5476 if {[string length $path] < [expr {$l + 2}]} {
5477 return ""
5478 }
5479 if {$l > 0} {
5480 if {[string range $path $cmp_start [expr {$l - 1}]] != \
5481 [string range $isodir_adr $cmp_start end]} {
5482 return ""
5483 }
5484 }
5485 if {[string range $path $l $l] != "/"} {
5486 return ""
5487 }
5488 set subpath [string range $path [expr {$l + 1}] end]
5489 set slash [string first "/" $subpath]
5490 if {$slash == -1} {
5491 return $subpath
5492 }
5493 if {$slash == 0} {
5494 return ""
5495 }
5496 return [string range $subpath 0 [expr {$slash - 1}]]
5497 }
5498
5499
5500 # Compare two severity names by help of the severity list that was obtained
5501 # from xorriso via proc inquire_severity_list.
5502 #
5503 proc compare_sev {sev1 sev2} {
5504 global xorriso_severity_list
5505
5506 set idx1 [lsearch -exact $xorriso_severity_list $sev1]
5507 set idx2 [lsearch -exact $xorriso_severity_list $sev2]
5508 if {$idx1 < $idx2} {return -1}
5509 if {$idx1 > $idx2} {return 1}
5510 return 0
5511 }
5512
5513
5514 # Write a text to the pipe log
5515 #
5516 proc debug_log_puts {text} {
5517 global debug_logging debug_log_conn
5518
5519 if {$debug_logging == 1} {
5520 puts $debug_log_conn $text
5521 flush $debug_log_conn
5522 }
5523 }
5524
5525
5526 # End program and return the given exit value.
5527 #
5528 proc central_exit {value} {
5529 exit $value
5530 }
5531
5532
5533 # Start a xorriso process which will in return launch another frontend
5534 # process. This is necessary until i learned how to create a pair of pipes
5535 # and to fork in Tcl.
5536 #
5537 proc start_xorriso {} {
5538 global argv0 argv
5539
5540 set self ""
5541 if {[string first "/" $argv0] != -1} {
5542 set self $argv0
5543 }
5544 if {$self == ""} {
5545 set self "/usr/bin/xorriso-tcltk"
5546 if {[file executable $self] == 0} {set self ""}
5547 }
5548 if {$self == ""} {
5549 set self "/usr/local/bin/xorriso-tcltk"
5550 if {[file executable $self] == 0} {set self ""}
5551 }
5552 if {$self == ""} {
5553 catch {
5554 set conn [open "|which xorriso-tcltk" r]
5555 set self [gets $conn]
5556 close $conn
5557 }
5558 }
5559 if {$self == ""} {
5560 catch {
5561 set conn [open "|sh -c \"type -p xorriso-tcltk\"" r]
5562 set self [gets $conn]
5563 close $conn
5564 }
5565 }
5566 if {$self == ""} {
5567 puts stderr "$argv0 :\n Cannot locate address of script xorriso-tcltk in filesystem.\n"
5568 puts stderr "You will have to use --stdio or --named_pipes."
5569 puts stderr "See $argv0 --help\n"
5570 central_exit 1
5571 }
5572
5573 # eval is used to split $argv into single words
5574 eval exec xorriso -launch_frontend "\"$self\"" --silent_start --stdio $argv -- 2>@stderr
5575
5576 central_exit 0
5577 }
5578
5579
5580 # Print a startup message to stderr if not the first argument is --silent_start
5581 #
5582 proc yell_xorriso_tcltk {} {
5583 global argv own_version
5584
5585 if {[llength $argv] > 0} {
5586 if {[lindex $argv 0] == "--silent_start"} {return ""}
5587 }
5588 puts stderr "xorriso-tcltk $own_version : Proof of concept for GUI frontends of xorriso\n"
5589 }
5590
5591
5592 # Log a command (if enabled)
5593 #
5594 proc log_command {cmd essential} {
5595 global cmd_log_conn cmd_logging_mode cmd_logging_all recent_cd_path
5596
5597 if {$cmd_logging_mode < 1} {return ""}
5598 if {$essential <= 0} {
5599 if {$cmd_logging_all <= 0} {return ""}
5600 } else {
5601 # Leave logging to non-essential call which will come soon after
5602 if {$cmd_logging_all > 0} {return ""}
5603 }
5604
5605 if {[string first "-cd " $cmd] == 0} {
5606 set path [string range $cmd 4 end]
5607 if {$path == $recent_cd_path && $cmd_logging_all <= 0} {return ""}
5608 set recent_cd_path $path
5609 }
5610
5611 if {$cmd_log_conn == ""} {
5612 effectuate_command_logging 0
5613 if {$cmd_logging_mode < 1} {return ""}
5614 }
5615 set prefix ""
5616 if {$cmd_logging_mode == 1} {
5617 if {[string first "-osirrox" $cmd] != -1 || \
5618 [string first "-extract" $cmd] != -1} {
5619 set prefix "# "
5620 }
5621 }
5622 if {[string first "-msg_op parse" $cmd] != -1} {
5623 set prefix "# "
5624 }
5625 puts $cmd_log_conn $prefix$cmd
5626 flush $cmd_log_conn
5627 }
5628
5629
5630 # Start command logging
5631 # Called by setup_by_args and by the "Script/Log" menu.
5632 # (target == "." and mode == -1 preserve the current state.)
5633 #
5634 proc start_command_logging {target mode} {
5635 global cmd_log_conn cmd_logging_mode msglist_running cmd_log_target
5636
5637 set is_stderr 0
5638 if {$cmd_log_target == "" || $cmd_log_target == "-" || \
5639 $cmd_log_conn == "stderr"} {set is_stderr 1}
5640 set errmsg ""
5641 if {$target != "." && $cmd_log_conn != "" && $target != $cmd_log_target && \
5642 $is_stderr == 0} {
5643 catch "close $cmd_log_conn"
5644 set cmd_log_conn ""
5645 }
5646 set ret 0
5647 if {$cmd_log_conn == "" || $is_stderr == 1} {
5648 if {$target == "-" || $target == "" || $target == "."} {
5649 set cmd_log_conn stderr
5650 } else {
5651 set ret [catch {set cmd_log_conn [open $target a]} errmsg]
5652 }
5653 if {$target != "."} {
5654 set cmd_log_target $target
5655 }
5656 }
5657 if {$ret == 0 && $mode >= 0} {
5658 set cmd_logging_mode $mode
5659 }
5660 if {$ret == 1} {
5661 set msg "xorriso-tcltk : SORRY : Failed to open command log script [make_text_shellsafe $target] :\n$errmsg"
5662 if {$msglist_running == 1} {
5663 xorriso_tcltk_errmsg $msg
5664 } else {
5665 puts stderr $msg
5666 }
5667 set cmd_logging_mode 0
5668 return 0
5669 }
5670 if {$mode > 0} {
5671 puts $cmd_log_conn "# xorriso-tcltk command log script"
5672 puts $cmd_log_conn [xorriso_loggable_init_cmds]
5673 flush $cmd_log_conn
5674 }
5675 return 1
5676 }
5677
5678
5679 # Start communications pipe logging
5680 # Called by setup_by_args and by the "Script/Log" menu.
5681 # (target == "." and mode == -1 preserve the current state.)
5682 #
5683 proc start_debug_logging {target mode} {
5684 global debug_log_conn debug_log_file debug_logging msglist_running
5685
5686 set is_stderr 0
5687 if {$debug_log_file == "" || $debug_log_file == "-" || \
5688 $debug_log_conn == "stderr"} {set is_stderr 1}
5689 set errmsg ""
5690 if {$target != "." && $debug_log_conn != "" && \
5691 $target != $debug_log_file && $is_stderr == 0} {
5692 catch "close $debug_log_conn"
5693 set debug_log_conn ""
5694 }
5695 set ret 0
5696 if {$debug_log_conn == "" || $is_stderr == 1} {
5697 if {$target == "-" || $target == "" || $target == "."} {
5698 set debug_log_conn stderr
5699 } else {
5700 set ret [catch {set debug_log_conn [open $target a]} errmsg]
5701 }
5702 if {$target != "."} {
5703 set debug_log_file $target
5704 }
5705 }
5706 if {$ret == 0 && $mode >= 0} {
5707 set debug_logging $mode
5708 }
5709 if {$ret == 1} {
5710 set msg "xorriso-tcltk : SORRY : Failed to open pipe log [make_text_shellsafe $target] :\n$errmsg"
5711 if {$msglist_running == 1} {
5712 xorriso_tcltk_errmsg $msg
5713 } else {
5714 puts stderr $msg
5715 }
5716 return 0
5717 }
5718 return 1
5719 }
5720
5721
5722 proc execute_script {close_window} {
5723 global execute_script_conn execute_script_adr browse_disk_window_is_active
5724 global osirrox_allowed script_with_osirrox cmd_logging_mode cmd_log_target
5725 global highest_cmd_sev
5726
5727 if {$close_window == 1 && $browse_disk_window_is_active == 1} {
5728 destroy_browse_disk .browse_disk_window
5729 }
5730
5731 set n1 [file normalize $execute_script_adr]
5732 set n2 [file normalize $cmd_log_target]
5733 if {$n1 == $n2 && $cmd_logging_mode > 0} {
5734 xorriso_tcltk_errmsg "xorriso-tcltk : SORRY : You first have to disable command script logging before using the log script"
5735 return ""
5736 }
5737
5738 set errmsg ""
5739 set ret [catch {set execute_script_conn [open $execute_script_adr r]} errmsg]
5740 if {$ret != 0} {
5741 xorriso_tcltk_errmsg "xorriso-tcltk : SORRY : Failed to open command script [make_text_shellsafe $execute_script_adr] :\n$errmsg"
5742 return ""
5743 }
5744 set line ""
5745 set ret [gets $execute_script_conn line]
5746 if {$ret < 0 || $line != "# xorriso-tcltk command log script"} {
5747 xorriso_tcltk_errmsg "xorriso-tcltk : SORRY : Given file does not look like a xorriso command log script"
5748 close $execute_script_conn
5749 return ""
5750 }
5751
5752 # >>> ??? Show script
5753
5754 if {[window_yesno "Really perform the xorriso commands in file\n\n[make_text_shellsafe $execute_script_adr]\n\n?"] != 1} {
5755 close $execute_script_conn
5756 return ""
5757 }
5758 if {$script_with_osirrox != 1} {
5759 send_silent_cmd "-osirrox blocked"
5760 }
5761 while {1} {
5762 set ret [gets $execute_script_conn line]
5763 if {$ret < 0} {
5764 break
5765 }
5766 if {$line == "" || [string first "#" $line] == 0} {
5767 continue
5768 }
5769 reset_highest_cmd_sev
5770 send_loggable_cmd $line
5771 if {[compare_sev $highest_cmd_sev "FAILURE"] >= 0} {
5772 xorriso_tcltk_errmsg "xorriso-tcltk : SORRY : Encountered problem event of severity '$highest_cmd_sev'.\nScript execution aborted."
5773 break
5774 }
5775 }
5776 close $execute_script_conn
5777 if {$script_with_osirrox != 1} {
5778 send_silent_cmd "-osirrox unblock"
5779 }
5780 }
5781
5782
5783 # Convert newline into \n
5784 #
5785 proc escape_newline {text backslash_too} {
5786 if {$backslash_too == 0} {
5787 return [string map [list "\n" "\\n"] $text]
5788 }
5789 return [string map [list "\n" "\\n" "\\" "\\\\"] $text]
5790 }
5791
5792
5793 # -------- start living
5794
5795
5796 proc setup_by_args {argv0 argv} {
5797 global cmd_pipe_adr reply_pipe_adr main_window_geometry click_to_focus
5798 global have_bwidget cmd_conn reply_conn geometry stdout stdin
5799 global osirrox_allowed cmd_logging_all use_command_move
5800
5801 # wish normally eats the -geometry option and puts the result into $geometry
5802 catch {set main_window_geometry $geometry}
5803
5804 set connection_defined 0
5805 set pipe_logging 0
5806 set script_logging 0
5807
5808 set loop_limit [llength $argv]
5809 for {set i 0} {$i < $loop_limit} {incr i} {
5810 set ok "0"
5811 set opt [lrange $argv $i $i]
5812 if {$opt == "--help"} {
5813 set ok "1"
5814 print_usage $argv0
5815 central_exit 0
5816 }
5817 if {$opt == "--silent_start"} {
5818 set ok "1"
5819 }
5820 if {$opt == "--stdio"} {
5821 set ok "1"
5822 set connection_defined 1
5823 }
5824 if {$opt == "--named_pipes"} {
5825 set ok "1"
5826 incr i
5827 set cmd_pipe_adr [lrange $argv $i $i]
5828 incr i
5829 set reply_pipe_adr [lrange $argv $i $i]
5830 if {$cmd_pipe_adr != "" && $reply_pipe_adr != "" &&
5831 $cmd_pipe_adr != "-" && $reply_pipe_adr != "-"} {
5832 init_frontend_named_pipes $cmd_pipe_adr $reply_pipe_adr
5833 }
5834 set connection_defined 1
5835 }
5836 if {$opt == "--geometry" || $opt == "-geometry"} {
5837 set ok "1"
5838 # Just in case -geometry does not get eaten by wish
5839 incr i
5840 set main_window_geometry [lrange $argv $i $i]
5841 set give_geometry [lrange $argv $i $i]
5842 }
5843 if {$opt == "--click_to_focus"} {
5844 set ok "1"
5845 set click_to_focus "1"
5846 }
5847 if {$opt == "--auto_focus"} {
5848 set ok "1"
5849 set click_to_focus "0"
5850 }
5851 if {$opt == "--pipe_log_file"} {
5852 set ok "1"
5853 incr i
5854 set pipe_log_name [lrange $argv $i $i]
5855 # postpone actual log start until start_xorriso has been passed
5856 set pipe_logging 1
5857 }
5858 if {$opt == "--script_log_file"} {
5859 set ok "1"
5860 incr i
5861 set script_log_name [lrange $argv $i $i]
5862 # postpone actual log start until start_xorriso has been passed
5863 set script_logging 1
5864 }
5865 if {$opt == "--script_log_all_commands"} {
5866 set ok "1"
5867 set cmd_logging_all 1
5868 }
5869 if {$opt == "--no_extract"} {
5870 set ok "1"
5871 set osirrox_allowed 0
5872 }
5873 if {$opt == "--no_bwidget"} {
5874 set ok "1"
5875 set have_bwidget "-1"
5876 }
5877 if {$opt == "--use_command_move"} {
5878 set ok "1"
5879 set use_command_move 1
5880 }
5881 if {$opt == "--use_command_mv"} {
5882 set ok "1"
5883 set use_command_move 0
5884 }
5885 if {$ok == 0} {
5886 puts stderr "$argv0 : Unknown option '$opt'"
5887 print_usage $argv0
5888 central_exit 1
5889 }
5890 }
5891
5892 if {$connection_defined == 0} {
5893 start_xorriso
5894 }
5895
5896 if {$cmd_pipe_adr == "" || $reply_pipe_adr == "" ||
5897 $cmd_pipe_adr == "-" || $reply_pipe_adr == "-"} {
5898 set cmd_conn stdout
5899 set reply_conn stdin
5900 }
5901 if {$pipe_logging == 1} {
5902 set ret [start_debug_logging $pipe_log_name 1]
5903 if {$ret <= 0} {
5904 puts stderr \
5905 "$argv0 : Cannot open --pipe_log_file '$pipe_log_name' for writing"
5906 central_exit 2
5907 }
5908 }
5909 if {$script_logging == 1} {
5910 set ret [start_command_logging $script_log_name 1]
5911 if {$ret <= 0} {
5912 puts stderr \
5913 "$argv0 : Cannot open --script_log_file '$script_log_name' for writing"
5914 central_exit 2
5915 }
5916 }
5917
5918 if {$main_window_geometry != ""} {
5919 wm geometry . $main_window_geometry
5920 }
5921 }
5922
5923 yell_xorriso_tcltk
5924
5925 setup_by_args $argv0 $argv
5926 check_xorriso_version
5927 setup_xorriso
5928
5929 init_gui
5930
5931 display_busy 0
5932 refresh_state
5933