"Fossies" - the Fresh Open Source Software Archive

Member "xorriso-1.5.4/frontend/xorriso-tcltk" (30 Jan 2021, 186344 Bytes) of package /linux/misc/xorriso-1.5.4.pl02.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.2_vs_1.5.4.

    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