#!/usr/bin/wish 
#
# xorriso-tcltk
# Copyright (C) 2012, Thomas Schmitt <scdbackup@gmx.net>, libburnia project.
# Provided under GNU GPL version 2 or later.
#
# This is mainly a proof of concept for xorriso serving under a frontend.
# It exercises several fundamental gestures of communication:
# - connecting via two named pipes
# - sending commands
# - receiving replies
# - inquiring the xorriso message sieve
# - using the xorriso parsing service

# Note that any other language than Tcl/Tk could be used, if it only can
# do i/o via standard input and standard output or via named pipes.
# Further it has to perform integer arithmetics and string manipulations.
# And, well, a graphical widget set would be nice.

set own_version "1.2.5"

proc print_usage {argv0} {
  puts stderr "Usage:"
  puts stderr "  $argv0 \[options\]"
  puts stderr "Options:"
  puts stderr " All options must be given with two dashes (\"--option\") in"
  puts stderr " order to distinguish them from any options of the Tcl shell."
  puts stderr " --help"
  puts stderr "     Print this text and exit."
  puts stderr " --stdio"
  puts stderr "     Establishes connection to xorriso via stdin and stdout."
  puts stderr "     E.g. when letting xorriso start this frontend program:"
  puts stderr "       xorriso -launch_frontend \$(which xorriso-tcltk) --stdio --"
  puts stderr " --named_pipes cmd_fifo reply_fifo"
  puts stderr "     Establishes connection to a xorriso process started by:"
  puts stderr "       xorriso -dialog on <cmd_fifo >reply_fifo"
  puts stderr "     which is then ready for a run of:"
  puts stderr "       xorriso-tcltk --named_pipes cmd_fifo reply_fifo"
  puts stderr "     It is important that the parent of xorriso and of this"
  puts stderr "     tcl/tk frontend opens the named pipe for commands before"
  puts stderr "     it opens the named pipe for replies. This avoids deadlock."
  puts stderr " --geometry {+|-}X{+|-}Y"
  puts stderr "     Sets the position of the main window."
  puts stderr " --click_to_focus"
  puts stderr "     Chooses that input fields and list boxes get the keyboard"
  puts stderr "     focus only when being clicked by the mouse."
  puts stderr " --auto_focus"
  puts stderr "     Chooses that the keyboard focus is where the mouse"
  puts stderr "     pointer is. (Default)"
  puts stderr " --log_file path"
  puts stderr "     Set a file address for logging of xorriso commands and"
  puts stderr "     reply messages. The log lines will be appended."
  puts stderr ""
  puts stderr "Either --stdio or --named_pipes must be given for a program run."
  puts stderr ""
}


# ------------------------------- the frontend ----------------------------
#
# Starts xorriso, connects to it, sends commands, receives replies,
# prepares replies for GUI

# Connection to xorriso
set cmd_conn ""
set reply_conn ""

# The addresses of the named pipes, if such are used (see option -named_pipe)
set cmd_pipe_adr ""
set reply_pipe_adr ""

# The command to send (resp. the command most recently sent)
set cmdline ""
# Wether to clear the cmdline after sending
set cmdline_clear true
# Command counter
set cmd_sent 0
# Current -mark synchronization text
set mark_count 0

# Results of most recent await_all_replies 
set info_list ""
set info_count 0
set emerging_info ""
set result_list ""
set result_count 0
set emerging_result ""

# Highest severities encountered in total and with most recent command
set highest_total_sev ALL
set highest_total_sev_msg ""
set highest_cmd_sev ALL
set highest_cmd_sev_msg ""
# This one registers like highest_cmd_sev with threshold ALL
set highest_seen_cmd_sev ALL

# State of last read_sieve command
set sieve_ret 0

# Mode for parsing replies with multiple words of arbitrary characters
# 0= single -msg_op parse commands
# 1= -msg_op parse_bulk (less problems with connection latency)
set bulk_parse_mode 1
# How many texts to pass with one parse_bulk command
set bulk_parse_max_chunk 200
# Parse parameters
set bulk_parse_prefix ""
set bulk_parse_separators ""
set bulk_parse_max_words ""
set bulk_parse_flag ""
# The announced number of texts to parse
set bulk_parse_num_texts ""

# Whether to complain on stderr about broken pipes.
# This may be expected when xorriso is being shut down by this frontend.
set expect_broken_pipes "0"


# Local copies of xorriso state

# Addresses of drives (or image files)
set outdev_adr ""
set indev_adr ""

# Whether the medium is blank, appendable, closed, missing
set indev_medium_status "missing"
set outdev_medium_status "missing"

# What kind of medium is presented by the drive
set indev_profile ""
set outdev_profile ""

# List of known drive addresses
set devlist ""

# Intermediate storage for messages until the GUI is up with .msglist box
set pre_msglist ""

# Whether overwriting of files in ISO and on disk is allowed
set overwrite_files 1

# If overwrite_files is 1 : Wether overwriting of ISO directories is allowed
set overwrite_dirs 0

# The file where to log commands and replies for debugging purposes
set log_file ""
set log_conn stderr

# Whether to log all commands and replies to the log_file 
set logging 0


# xorriso specific constants

# List of severities (gets later overridden by -msg_op list_sev -)
set xorriso_severity_list {
  ALL DEBUG UPDATE NOTE HINT WARNING SORRY MISHAP FAILURE FATAL ABORT NEVER
}
set scan_event_threshold HINT


# --------- Communication between frontend and xorriso ----------


# Open the connection to a pair of named pipes. Program option -named_pipes
#
proc init_frontend_named_pipes {cmd_pipe reply_pipe} {
  global cmd_conn
  global reply_conn

  set cmd_conn [open "$cmd_pipe" w]
  set reply_conn [open "$reply_pipe" r]

  # Note: disencouraged flags would be necessary for opening idle fifo
  # set reply_conn [open "$reply_pipe" {RDONLY NONBLOCK}]

}


# Send a command line to the xorriso process. Do not wait for reply.
#
proc send_async_cmd {cmd} {
  global cmd_sent cmd_conn logging log_conn

  display_busy 1

  log_puts "     =============================================================="
  log_puts "       $cmd"
  display_msg "======>  $cmd" 
  incr cmd_sent
  puts $cmd_conn "$cmd"
  flush $cmd_conn
}


# Send a command line and a -mark command to xorriso. Wait until the
# mark message confirms that all command output has been received.
#
proc send_marked_cmd {cmd} {
  global cmd_conn mark_count

  send_async_cmd "$cmd" 
  incr mark_count
  set mark_cmd "-mark $mark_count"
  log_puts "       $mark_cmd"
  puts $cmd_conn "$mark_cmd"
  flush $cmd_conn
  await_all_replies
}


# Wait for the currently pending mark message to arrive.
# Buffer all received result lines and info messages.
#
proc await_all_replies {} {
  global reply_conn mark_count result_count result_list
  global info_count info_list expect_broken_pipes
  global .busy_text 

  clear_reply_lists

  while {1} {
    set ret [gets "$reply_conn" line]
    if {"$ret" < 0} {
      if {"$expect_broken_pipes" != 1} {
        puts stderr "EOF at reply pipe"
      }
  break
    }
    log_puts "$line"
    if {[string range "$line" 0 0] == "M"} {
       if {[string range "$line" 5 end] == "$mark_count"} {

         # <<<
         # puts stderr "sync mark"

  break
       } else {
         # outdated mark message
  continue
       }
    }

    de_pkt_line "$line"
  }

  display_busy 0

  # <<< debug
  # for {set i 0} {$i < $info_count} {incr i} {
  #   set line [lindex "$info_list" $i]
  #   puts stderr "info $i : $line"
  # }
  # for {set i 0} {$i < $result_count} {incr i} {
  #   set line [lindex "$result_list" $i]
  #   puts stderr "result $i : $line"
  # }
}


# Decode -pkt_output format to complete lines and buffer them.
#
proc de_pkt_line {line} {
  global info_list
  global info_count
  global emerging_info
  global result_list
  global result_count
  global emerging_result

  # Distinguish R and I
  set ch [string range "$line" 0 0]

  set payload [string range "$line" 5 end]
  if {"$ch" == "R"} {
    set emerging_result "$emerging_result$payload"
  } else { if {"$ch" == "I"} {
    set emerging_info "$emerging_info$payload"
  } else {
    return ""
  }}

  # if line end : add to list
  if {[string range "$line" 2 2] == "1"} {
    if {"$ch" == "R"} {
      lappend result_list  "$emerging_result"
      incr result_count
      display_msg "$emerging_result"

      # <<<
      # puts stderr "result: $emerging_result"

      set emerging_result ""
    } else {
      lappend info_list "$emerging_info"
      incr info_count
      display_msg "$emerging_info"
      scan_info_for_event "$emerging_info"

      # <<<
      # puts stderr "info: $emerging_info"

      set emerging_info ""
    }
  }
}


# Search in the decoded info messages for the most severe event reports.
#
proc scan_info_for_event {line} {
  global highest_total_sev highest_total_sev_msg
  global highest_cmd_sev highest_cmd_sev_msg highest_seen_cmd_sev
  global scan_event_threshold
  global display_msg_enabled

  # check for word : CAPS : text ...
  set ret [regexp {[a-z][a-z]*[ ]*: [A-Z][A-Z]* :} "$line"]
      
  if {"$ret" != 1} {return ""}

  # retrieve severity
  set pos [string first ":" "$line"]
  set sev [string range "$line" [expr $pos+2] end]
  set pos [string first ":" "$sev"]
  set sev [string range "$sev" 0 [expr $pos-2]];

  if {[compare_sev "$sev" "$highest_seen_cmd_sev"] > 0} {
    set highest_seen_cmd_sev "$sev"
  }

  if {[compare_sev "$sev" "$scan_event_threshold"] < 0} {return ""}

  if {"$display_msg_enabled" == 0} {
    set display_msg_enabled 1
    display_msg "$line"
    set display_msg_enabled 0
  }
  if {[compare_sev "$sev" "$highest_total_sev"] >= 0} {
    set highest_total_sev "$sev"
    set highest_total_sev_msg "$line"
  }
  if {[compare_sev "$sev" "$highest_cmd_sev"] >= 0} {
    set highest_cmd_sev "$sev"
    set highest_cmd_sev_msg "$line"
  }
}


# Unpack the output format of -msg_op read_sieve into a result_list
# of strings which each hold one parsed word.
#
proc de_sieve {} {
  global result_list
  global sieve_ret
  
  set sieve_ret [lindex "$result_list" 0]
  set sieve_result_count [lindex "$result_list" 1]

  set payload ""
  set sieve_result_count 0
  for {set i 2} {$i < [llength "$result_list"]} {incr i} {
    set line ""
    set num_lines [lindex "$result_list" $i]

    # <<<
    # puts stderr "de_sieve : num_lines = $num_lines"

    for {set j 0} {$j < "$num_lines"} {incr j} {
      incr i
      set line "$line[lindex "$result_list" $i]"
      if {$j < "$num_lines" - 1} {
        set line "$line\n"
      } else {
        lappend payload "$line"
        incr sieve_result_count  
      }  
    }
  }
  set result_list "$payload"
  set result_count "$sieve_result_count"
}


# Alternative to proc await_all_replies. It waits for a line at one of the
# three channels and displays all lines which it receives before that line.
# Used before this frontend had the opportunity to set up xorriso by commands
# like -pkt_output "on".
#
proc wait_for_msg {prefix channel} {
  global reply_conn

  if {"$channel" == "M"} {
    set channel_prefix "M:0: "
  } else {
    set channel_prefix "$channel:1: "
  }

  set prefix_l [string length "$prefix"]
  while {1} {

    # >>> Have a timeout

    set ret [gets "$reply_conn" line]
    if {"$ret" < 0} {
  break
    }
    log_puts "$line"
    if {[string length "$line"] < "$prefix_l"} {
      display_msg "$line"
  continue
    }
    if {[string range "$line" 0 [expr "$prefix_l - 1"]] == "$prefix"} {
      return [string range "$line" "$prefix_l" end]
    }
    if {[string length "$line"] >= [expr "$prefix_l + 5"]} {
      if {[string range "$line" 0 4] == "$channel_prefix"} {
        if {[string range "$line" 5 [expr "$prefix_l + 4"]] == "$prefix"} {
          return [string range "$line" [expr "$prefix_l + 5"] end] 
        }
      }
    }
    display_msg "$line"
  }
}


# Reset the buffer for result lines and info messages.
#
proc clear_reply_lists {} {
  global info_list
  global info_count
  global emerging_info
  global result_list
  global result_count
  global emerging_result

  set info_list ""
  set info_count 0
  set emerging_info ""
  set result_list ""
  set result_count 0
  set emerging_result ""
}


# Reset the register of the most severe event for command sequences.
# Typically this is done before executing the commands of a procedure
# that is triggered by the user interface.
#
proc reset_highest_cmd_sev {} {
  global highest_cmd_sev highest_cmd_sev_msg highest_seen_cmd_sev

  set highest_cmd_sev ALL
  set highest_cmd_sev_msg ""
  set highest_seen_cmd_sev ALL
}


# Clear the recordings of the xorriso message sieve.
#
proc clear_sieve {} {
  set disp_en_mem [set_display_msg 0]
  send_marked_cmd "-msg_op clear_sieve -"
  set_display_msg "$disp_en_mem"
}


# Obtain a recorded item from the xorriso message sieve.
#
proc read_sieve {name} {
  set disp_en_mem [set_display_msg 0]
  send_marked_cmd "-msg_op read_sieve '$name'"
  set_display_msg "$disp_en_mem"
  de_sieve
}


# ------- Inquiring xorriso status -------


# Get more information about drive that was inquired by recent -toc_of.
#
proc obtain_drive_info {dev} {
  global result_list
  global sieve_ret
  global indev_medium_status outdev_medium_status
  global indev_profile outdev_profile

  set line ""

  if {"$dev" == "in"} {
    set indev_medium_status "missing"
    set indev_profile ""
  } else {
    set outdev_medium_status "missing"
    set outdev_profile ""
  }
  read_sieve "Media status :"
  if {"$sieve_ret" > 0} {
    set reply [lindex "$result_list" 0]
    foreach i {blank appendable closed} {
      if {[string first "$i" "$reply"] != -1} {
        set line "$i "
        if {"$dev" == "in"} {
          set indev_medium_status "$i"
        } else {
          set outdev_medium_status "$i"
        }
    break
      }
    }
  }
  read_sieve "Media current:"
  if {"$sieve_ret" > 0} {
    set profile [lindex "$result_list" 0]
    if {"$profile" == "is not recognizable"} {
      set profile "no recognizable medium"
      set line "$line$profile"
      return "$line"
    } else {
      set line "$line$profile, "
      if {"$dev" == "in"} {
        set indev_profile "$profile"
      } else {
        set outdev_profile "$profile"
      }
    }
  }
  read_sieve "Media summary:"
  if {"$sieve_ret" > 0} {
    set line "$line[lindex "$result_list" 0] sessions, "
    if {"$dev" == "in"} {
      set line "$line[lindex "$result_list" 2] used"
    } else {
      set line "$line[lindex "$result_list" 3] free"
    }
  }
  return "$line"
}


# Inquire whether changes of the ISO image are pending.
#
proc changes_are_pending {} {
  global result_count result_list

  set disp_en_mem [set_display_msg 0]
  send_marked_cmd "-changes_pending show_status"
  set_display_msg "$disp_en_mem"
  if {"$result_count" >= 1} {
    if {[lindex "$result_list" 0] == "-changes_pending no"} {
      return "0"
    }
    return "1"
  }
  return ""
}


# Inquire the file type of an address in the xorriso ISO image tree.
# This is a precondition for writing the session. Vice versa pending changes
# block a change of the input drive or the program end.
#
proc get_iso_filetype {adr} {
  global result_list result_count scan_event_threshold

  set scan_event_mem "$scan_event_threshold"
  set scan_event_threshold "SORRY"
  set disp_en_mem [set_display_msg 0]
  send_marked_cmd "-lsdl [make_text_shellsafe "$adr"] --"
  set_display_msg "$disp_en_mem"
  set scan_event_threshold "$scan_event_mem"
  if {"$result_count" <= 0} {
    return ""
  }
  return [string range [lindex "$result_list" 0] 0 0]
}


# Inquire whether an ISO image model has been created inside xorriso.
# This is a precondition for inserting files into the ISO tree model.
#
proc assert_iso_image {with_msg} {
  global highest_seen_cmd_sev scan_event_threshold

  set disp_en_mem [set_display_msg 0]
  set highest_seen_cmd_sev ""
  set set_mem "$scan_event_threshold"
  set scan_event_threshold "FATAL"
  send_marked_cmd "-lsd / --"
  set scan_event_threshold "$set_mem"
  set_display_msg "$disp_en_mem"
  if {[compare_sev "$highest_seen_cmd_sev" "FAILURE"] >= 0} {
    if {"$with_msg" == 1} {
      xorriso_tcltk_errmsg "xorriso-tcltk : SORRY : First you need to create or load an ISO image by selecting a drive or an image file"
    }
    return "0"
  }
  return "1"
}


# Obtain the list of possible event severity names, sorted in ascending order
#
proc inquire_severity_list {} {
  global xorriso_severity_list
  global result_list

  set disp_en_mem [set_display_msg 0]
  send_marked_cmd "-msg_op list_sev -"
  set_display_msg "$disp_en_mem"
  if {[lindex "$result_list" 0] != ""} {
    set xorriso_severity_list [split [lindex "$result_list" 0] " "]
  }
}


# Parse-by-xorriso handler function for proc inquire_dev
#
proc set_inquired_dev {} {
  global result_list indev_adr outdev_adr

  if {[llength "$result_list"] < 2} {return ""} 
  set what [lindex "$result_list" 0]
  if {"$what" == "-dev" || "$what" == "-indev"} {
    set indev_adr [lindex "$result_list" 1]
  }
  if {"$what" == "-dev" || "$what" == "-outdev"} {
    set outdev_adr [lindex "$result_list" 1]
  }
}


# Inquire -indev and -outdev from xorriso and install in indev_adr
# and outdev_adr. Usually called when the user messed up the text fields.
# (This could be done by -toc_of like in proc refresh_indev. But here
#  i demonstrate the use of command -status and parsing its result by
#  help of xorriso.)
#
proc inquire_dev {} {
  global result_list

  set disp_en_mem [set_display_msg 0]
  send_marked_cmd "-status -dev"
  handle_result_list set_inquired_dev "''" "''" 2 0
  set_display_msg "$disp_en_mem"
  update idletasks
  return ""
}


# Verify that the connected process runs a xorriso program that is modern
# enough. This is done before sending xorriso the setup commands.
#
proc check_xorriso_version {} {
  global sieve_ret result_list pre_msglist xorriso_version
  global reply_conn

  set min_version "1.2.5"
  set version "0.0.0 (= unknown)"

  set disp_en_mem [set_display_msg 0]

  # In order to see the pre-frontend messages of xorriso
  # set an individual -mark and use send_async_cmd

  set mark_text "xorriso-tcltk-version-check-[clock seconds]"
  send_async_cmd "-mark [make_text_shellsafe "$mark_text"]"
  set_display_msg "$disp_en_mem"
  wait_for_msg "$mark_text" "M"

  set_display_msg 0
  send_async_cmd "-version"

  set xorriso_version [wait_for_msg "xorriso version   :  " "R"]

  if {"$xorriso_version" < "$min_version"} {
    puts stderr "xorriso-tcltk: xorriso-$xorriso_version is too old."
    puts stderr "xorriso-tcltk: Need at least version $min_version"
    window_ack \
    "xorriso-$xorriso_version is too old. Need at least version $min_version" \
              "red" "embedded"
    central_exit 2
  }
  set_display_msg "$disp_en_mem"
}


# Commands which bring the connected xorriso process into the state that
# is expected by this frontend.
#
proc setup_xorriso {} {
  set cmd ""

  # Invalidate possible -mark 1
  set cmd "$cmd -mark 0" 

  # Make replies digestible for await_all_replies
  set cmd "$cmd -pkt_output on"

  # Report version early
  set cmd "$cmd -version"

  # This frontend relies heavily on the message sieve
  set cmd "$cmd -msg_op start_sieve -"

  # -reassure questions from xorriso would not be properly handled by
  # this frontend
  set cmd "$cmd -reassure off"

  set cmd "$cmd -for_backup"

  # There is a performance problem in xorriso with -hardlinks on and
  # image manipulations. So for now -hardlinks is set to off.
  set cmd "$cmd -hardlinks off"

  set cmd "$cmd -abort_on NEVER"
  set cmd "$cmd -report_about UPDATE"
  set cmd "$cmd -osirrox on"
  set cmd "$cmd -iso_rr_pattern off"
  set cmd "$cmd -disk_pattern off"

  send_marked_cmd "$cmd"

  inquire_severity_list
}


# ------ Parsing by help of xorriso ------

# Parsing by xorriso takes from the frontend the burden to understand
# and implement the quoting rules of xorriso input and output.
# Lines which are supposed to consist of several words get sent to
# xorriso command -msg_op. The result lines of this command encode
# the words unambigously in one or more text lines.
# This is supposed to be safe for even the weirdest file names.
# Only NUL characters cannot be part of names.


# If enabled: Start a bulk parser job by which xorriso shall split the output
# of e.g. -lsl into single words from which this frontend can pick information.
#
proc start_bulkparse {prefix separators max_words flag num_lines} {
  global bulk_parse_mode bulk_parse_prefix bulk_parse_separators
  global bulk_parse_max_words bulk_parse_flag bulk_parse_num_texts

  if {"$num_lines" <= 0} {return ""}

  set bulk_parse_prefix "$prefix"
  set bulk_parse_separators "$separators"
  set bulk_parse_max_words "$max_words"
  set bulk_parse_flag "$flag"
  set bulk_parse_num_texts "$num_lines"
  if {"$bulk_parse_mode" == 1} {
    set cmd "-msg_op parse_bulk \"$prefix $separators $max_words $flag $num_lines\""

    # <<<
    # puts stderr "start_bulkparse : $cmd"

    send_async_cmd "$cmd"
    # Do not wait for mark
  }
}


# Submit a new input line to the xorriso parser. If no bulk parser job was
# started then submit a single line parser command.
#
proc submit_bulkparse {text} {
  global cmd_conn reply_conn
  global result_list result_count
  global bulk_parse_mode bulk_parse_prefix bulk_parse_separators
  global bulk_parse_max_words bulk_parse_flag

  if {"$bulk_parse_mode" != 1} {
    clear_reply_lists
  }
  set disp_en_mem [set_display_msg 0]

  set num_lines [expr [count_newlines "$text"] + 1]

  if {"$bulk_parse_mode" == 0} {
    set cmd "-msg_op parse \"$bulk_parse_prefix $bulk_parse_separators $bulk_parse_max_words $bulk_parse_flag $num_lines\""

    # <<<
    # puts stderr "submit_bulkparse: cmd = $cmd"

    send_async_cmd "$cmd"
  } else {
    log_puts ">>>>>  $num_lines"
    puts $cmd_conn "$num_lines"
  }
  log_puts ">>>>>  $text"
  puts $cmd_conn "$text"
  flush $cmd_conn

  # <<<
  # puts stderr "submit_bulkparse: text sent"

  if {"$bulk_parse_mode" != 1} {

    set loop_limit 2
    while {"$result_count" < "$loop_limit"} {
      set ret [gets "$reply_conn" line]
      if {"$ret" < 0} { return ""}
      log_puts "$line"
      de_pkt_line "$line"
      if {"$result_count" == 1} {
        set parse_ret [lindex "$result_list" 0]
      }
      if {"$result_count" == 2} {
        set num_replies [lindex "$result_list" 1]
        set loop_limit [expr "$num_replies * 2 + 2"]

        # <<<
        # puts stderr "submit_bulkparse: loop_limit = $loop_limit"

      }
    }
    de_sieve

  }
  set_display_msg "$disp_en_mem"
}


# If a bulk parsing job was started, then read the expected number of
# replies into the result buffer and call handler_proc to inspect them.
# Each input line of the parser yields one reply buffer full of parsed words.
#
proc read_bulkparse {handler_proc num_texts} {
  global bulk_parse_mode 

  if {"$bulk_parse_mode" != 1} { return ""}

  set disp_en_mem [set_display_msg 0]

  # <<<
  # puts stderr "read_bulkparse : handler_proc = $handler_proc , num_texts = $num_texts"

  for {set i 0} {"$i" < "$num_texts"} {incr i} {
    clear_reply_lists
    read_parse_reply
    $handler_proc
  }

  set_display_msg "$disp_en_mem"
}


# Read and decode the xorriso parser reply for one input line.
#
proc read_parse_reply {} {
  global reply_conn
  global result_list result_count

  set loop_limit 2
  while {"$result_count" < "$loop_limit"} {
    set ret [gets "$reply_conn" line]
    if {"$ret" < 0} { return ""}
    log_puts "$line"
    de_pkt_line "$line"
    if {"$result_count" == 1} {
      set parse_ret [lindex "$result_list" 0]
    }
    if {"$result_count" == 2} {
      set num_replies [lindex "$result_list" 1]
      set loop_limit [expr "$num_replies * 2 + 2"]

      # <<<
      # puts stderr "submit_bulkparse: loop_limit = $loop_limit"

    }
  }
  de_sieve
}


# Let xorriso parse the lines in the result buffer and call handler_proc
# with the parse result of each line.
# This is used to split the result lines of -lsl into words from which
# handler proc isolist_parse_handler picks the info which it displays
# in .stbox isolist .
# Note that iall parameters must be xorriso words. E.g. empty prefix or
# separator have to be submitted as tcl string "''" rather than "".
#
proc handle_result_list {handler_proc \
                         prefix separators max_words flag } {
  global result_list
  global bulk_parse_mode bulk_parse_max_chunk

  set raw_list "$result_list"
  set raw_line_count [expr [llength "$raw_list"]]
  if {"$raw_line_count" > "$bulk_parse_max_chunk"} {
    set chunk_size "$bulk_parse_max_chunk"
  } else {
    set chunk_size "$raw_line_count"
  }
  start_bulkparse "$prefix" "$separators" "$max_words" "$flag" "$chunk_size"

  # <<<
  # puts stderr "isodir_return : chunk_size = $chunk_size"

  set submit_count 0
  set submit_in_chunk_count 0
  foreach i "$raw_list" {
    # <<<
    # puts stderr "isodir_return : submit_bulkparse $i"

    submit_bulkparse "$i"
    incr submit_count
    incr submit_in_chunk_count
    if {"$bulk_parse_mode" != 1} {
      $handler_proc
    }
    if {"$bulk_parse_mode" == 1 && "$submit_in_chunk_count" == "$chunk_size"} {

      # <<<
      # puts stderr "isodir_return : submit_in_chunk_count = $submit_in_chunk_count"

      read_bulkparse "$handler_proc" "$chunk_size"
      set todo [expr "$raw_line_count" - "$submit_count"]
      if {"$todo" <= 0} {
  break
      }
      if {"$todo" > "$bulk_parse_max_chunk"} {
        set chunk_size "$bulk_parse_max_chunk"
      } else {
        set chunk_size "$todo"
      }
      start_bulkparse "$prefix" "$separators" "$max_words" "$flag" \
                      "$chunk_size"

      # <<<
      # puts stderr "isodir_return : further chunk_size = $chunk_size"

      set submit_in_chunk_count 0
    }
  }
  display_busy 0
}


# ------------------------------- the GUI ----------------------------

# ------ State variables ------

# Whether to display messages in .msglist 
set display_msg_enabled 1

# Whether a device list is already displayed
set devices_scanned 0

# Currently displayed ISO directory
set isodir_adr ""
set isodir_is_pwd 0

# The plain names and types matching listbox .isolist
set isolist_names ""
set isolist_types ""

# The name which to select after isodir_return
set isodir_return_name ""

# The address where to move selected ISO files
set isomanip_move_target ""

# Memorized isolist selection
set memorized_isolist_selection ""

# Image file address for .burn_write_image
set burn_write_image_adr ""

# Whether to close medium after writing
set burn_write_close 0 

# Whether to force CD TAO, DVD-R Inremental, DVD+R/BD-R open ended track
set burn_write_tao 0

# Whether to engage Defect Management on formatted BD media
set burn_write_defect_mgt 0

# Answer of yes/no window
set answer_of_yesno ""

# The local filesystem address to be mapped into isodir_adr
set insert_from_adr ""

# Whether to insert with leafname of insert_from_adr underneath isodir_adr
# (else: -map $insert_from_adr $isodir_adr) 
set insert_underneath 1

# Whether to insert at or under the selected .isolist item
# rather than isodir_adr
set insert_at_selected 0

# The local filesystem address to which to extract from isodir_adr
set extract_to_adr ""

# Whether to insert with leafname of insert_from_adr underneath isodir_adr
# (else: -map $insert_from_adr $isodir_adr) 
set extract_underneath 1

# Whether to insert at or under the selected .isolist item
set extract_from_selected 0

# Whether to temporarily enforce rwx permissions for target directories on disk
set extract_auto_chmod 0

# Whether the display label .busy_text is already usable
set busy_text_exists 0

# Whether to demand a click before focus goes to entry or listbox
set click_to_focus "0"

# Whether .ack_window resp. .yesno_window is already displayed 
# (>>> Better would be to block user interaction until they are gone)
set ack_window_is_active 0
set yesno_window_is_active 0


# ------ GUI callback procedures ----


# Called when the Return key is hit in commandline.
#
proc cmdline_return {} {
  global cmdline cmdline_clear
  global .cmdline .cmdline_text .cmdline_entry
  global highest_cmd_sev
  global highest_cmd_sev_msg

  reset_highest_cmd_sev
  send_marked_cmd "$cmdline"
  set cmdline ""

  # To force display of GUI changes now and not some time later
  update idletasks
}


# Called when the input drive address shall be brought into effect with
# xorriso.
#
proc indev_return {} {
  global indev_adr
  global .indev_entry
  global .outdev_entry

  if {[assert_no_changes] == 0} {
    inquire_dev
    return "0"
  }
  reset_highest_cmd_sev
  send_marked_cmd "-indev [make_text_shellsafe $indev_adr]"
  set indev_mem_adr "$indev_adr"
  .indev_entry icursor 0
  refresh_indev
  return "1"
}


# Called when the "Eject" button for the input drive is hit.
#
proc eject_indev {} {
  if {[assert_no_changes] == 0} {return ""}
  reset_highest_cmd_sev
  send_marked_cmd "-eject indev"
  refresh_outdev
  refresh_indev
}


# Called when the output drive address shall be brought into effect with
# xorriso.
#
proc outdev_return {} {
  global outdev_adr indev_adr
  global .outdev_entry

  reset_highest_cmd_sev
  send_marked_cmd "-outdev [make_text_shellsafe $outdev_adr]"
  set outdev_mem_adr "$outdev_adr"
  .outdev_entry icursor 0
  refresh_outdev
  return "1"
}


# Called when the "Eject" button for the output drive is hit.
#
proc eject_outdev {} {
  global outdev_adr indev_adr

  if {"$outdev_adr" == "$indev_adr"} {
    if {[assert_no_changes] == 0} {return ""}
  }
  reset_highest_cmd_sev
  send_marked_cmd "-eject outdev"
  refresh_outdev
  refresh_indev
}


# Called when both drive addresses shall be brought into effect with xorriso.
#
proc dev_return {} {
  global outdev_adr indev_adr
  global .outdev_entry .indev_entry

  if {"$outdev_adr" != "$indev_adr"} {
    if {[indev_return] == 0} {return "0"}
    outdev_return
  } else {
    if {[assert_no_changes] == 0} {
      inquire_dev
      return "0"
    }
    reset_highest_cmd_sev
    send_marked_cmd "-dev [make_text_shellsafe $outdev_adr]"
    .outdev_entry icursor 0
    refresh_outdev
    .indev_entry icursor 0
    refresh_indev
  }
}


# Obtain and display the input drive status.
# Called after the input drive address may have changed.
#
proc refresh_indev {} {
  global result_list
  global indev_adr
  global sieve_ret
  global .indev_summary

  .indev_summary configure -text ""
  set indev_adr ""
  update idletasks

  set disp_en_mem [set_display_msg 0]
  clear_sieve
  send_marked_cmd "-toc_of in:short"
  read_sieve "Drive current:"
  set_display_msg "$disp_en_mem"
  if {"$sieve_ret" > 0} {
    set cmd [lindex "$result_list" 0]
    if {"$cmd" == "-indev" || "$cmd" == "-dev"} {
      set indev_adr [lindex "$result_list" 1]
    }
    set line [obtain_drive_info in]
    .indev_summary configure -text "$line"
  }
  .avail_label configure -text ""
  update idletasks
  isodir_return "refresh_indev"
}


# Obtain and display the output drive status.
# Called after the output drive address may have changed.
#
proc refresh_outdev {} {
  global result_list
  global outdev_adr
  global sieve_ret

  .outdev_summary configure -text ""
  set outdev_adr ""
  update idletasks

  set disp_en_mem [set_display_msg 0]
  clear_sieve
  send_marked_cmd "-toc_of out:short"
  read_sieve "Drive current:"
  set_display_msg "$disp_en_mem"
  if {"$sieve_ret" > 0} {
    set cmd [lindex "$result_list" 0]
    if {"$cmd" == "-outdev" || "$cmd" == "-dev"} {
      set outdev_adr [lindex "$result_list" 1]
    }
    set line [obtain_drive_info out]
    .outdev_summary configure -text "$line"
  }
  .avail_label configure -text ""
  update idletasks
}


# Scan the system for optical drives with rw permission
# Called when the "Scan for drives button" is hit.
#
proc scan_for_drives {} {
  global .drivelist
  global sieve_ret result_list devlist devices_scanned indev_adr outdev_adr

  if {[assert_no_changes] == 0} {return ""}
  if {"$indev_adr" != "" || "$outdev_adr" != ""} {
    if {[window_yesno \
             "Really give up aquired drives for scanning a new drive list ?"] \
      != 1} { return "" }
  }

  set max_idx [.drivelist index end]
  .drivelist delete 0 [expr "$max_idx-1"]
  set devlist ""

  clear_sieve
  send_marked_cmd "-devices"
  set max_idx 0
  while {1} {
    read_sieve "?  -dev"
    if {"$sieve_ret" > 0} {
      .drivelist insert end "[lindex "$result_list" 0] : [lindex "$result_list" 2] [lindex "$result_list" 3]"
      lappend devlist [lindex "$result_list" 0]
    } else {
  break
    }
  }
  while {1} {
    read_sieve "??  -dev"
    if {"$sieve_ret" > 0} {
      .drivelist insert end "[lindex "$result_list" 0] : [lindex "$result_list" 2] [lindex "$result_list" 3]"
      lappend devlist [lindex "$result_list" 0]
    } else {
  break
    }
  }
  set devices_scanned 1
  update idletasks

  # Command -devices drops all aquired drives
  refresh_indev
  refresh_outdev
}


# Refresh the display after some xorriso may have changed the status
# Called by the "Refresh state" display button and others.
#
proc refresh_state {} {
  refresh_indev
  refresh_outdev
}


# Reset the recorded Worst problem message.
# Called when the "Clear" button is hit.
#
proc clear_total_errmsg {} {
  global highest_total_sev
  global highest_total_sev_msg

  set highest_total_sev ALL
  set highest_total_sev_msg ""
  update idletasks
}


# Called when the "Pick input drive button" is hit.
#
proc pick_indev {} {
  pick_drive indev
}


# Called when the "Pick output drive button" is hit.
#
proc pick_outdev {} {
  pick_drive outdev
}


# Called when the "Pick drive for both roles" button is hit.
# or when an item in the scanned drive list is double-clicked.
#
proc pick_dev {} {
  pick_drive dev
}


# Perform the actual work of pick_dev, pick_indev, and pick_outdev
#
proc pick_drive {role} {
  global .drivelist
  global devlist
  global highest_cmd_sev_msg outdev_adr indev_adr devices_scanned

  set selected [.drivelist curselection]
  if {[llength "$selected"] != 1} {
    set must_scan ""
    if {"$devices_scanned" == 0} { set must_scan " scan and"}
    xorriso_tcltk_errmsg \
       "xorriso-tcltk : SORRY : First you must$must_scan select a single drive"
    return ""
  }
  set drive_idx [lindex "$selected" 0]

  if {"$role" == "dev"} {
    set outdev_adr [lindex "$devlist" "$drive_idx"]
    set indev_adr [lindex "$devlist" "$drive_idx"]
    dev_return
  }
  if {"$role" == "outdev"} {
    set outdev_adr [lindex "$devlist" "$drive_idx"]
    outdev_return
  }
  if {"$role" == "indev"} {
    set indev_adr [lindex "$devlist" "$drive_idx"]
    indev_return
  }
  .drivelist selection clear 0 end  
}


# Called when the "Give up drives" button is hit.
#
proc give_up_dev {} {
  global outdev_adr indev_adr

  if {[assert_no_changes] == 0} {return ""}
  set outdev_adr ""
  outdev_return
  set indev_adr ""
  indev_return
}


# Obtain and display the content of the current ISO directory.
# Called when the Return key is hit in the .isodir_entry text field
# and by many others which change variable isodir_adr or the
# content of the directory in xorriso's tree model.
#
proc isodir_return {caller} {
  global isodir_adr result_list isolist_names isolist_types isodir_return_name
  global isodir_is_pwd highest_cmd_sev highest_cmd_sev_msg
  global indev_adr outdev_adr
  global .isolist
  global bulk_parse_mode
  global bulk_parse_max_chunk

  set chunk_size 0

  set max_idx [.isolist index end]
  .isolist delete 0 [expr "$max_idx-1"]
  update idletasks
  set isolist_names ""
  set isolist_types ""

  if {"$indev_adr" == "" && "$outdev_adr" == ""} {
    if {[changes_are_pending] == "0"} {return ""}
  }
  normalize_isodir_adr

  set disp_en_mem [set_display_msg 0]
  set highest_cmd_sev_mem "$highest_cmd_sev"
  set highest_cmd_sev_msg_mem "$highest_cmd_sev_msg"
  reset_highest_cmd_sev
  send_marked_cmd "-cd [make_text_shellsafe "$isodir_adr"]"
  if {[compare_sev "$highest_cmd_sev" "WARNING"] < 0} {
    send_marked_cmd "-lsl --"
    set isodir_is_pwd 1
  } else {
    send_marked_cmd "-lsl [make_text_shellsafe "$isodir_adr"] --"
    set isodir_is_pwd 0
  }
  handle_result_list isolist_parse_handler "''" "''" 0 0
  set_display_msg "$disp_en_mem"
  set highest_cmd_sev "$highest_cmd_sev_mem"
  set highest_cmd_sev_msg "$highest_cmd_sev_msg_mem"

  if {"$isodir_return_name" != ""} {
    set idx [lsearch -exact "$isolist_names" "$isodir_return_name"]
    if {"$idx" != -1} {
      .isolist see "$idx"
      .isolist selection set "$idx"
    }
    set isodir_return_name ""
  }
  update idletasks
}


# The handler procedure that is submitted to proc handle_result_list
# and will be called for every parsed line.
# It records file names and types in separate lists and displays them
# in the .isolist box.
#
proc isolist_parse_handler {} {
  global result_list isolist_names isolist_types
  global .isolist

  if {[lindex "$result_list" 0] == "total"} {return ""}
  set name [lindex "$result_list" 8]
  set ftype [string range [lindex "$result_list" 0] 0 0]
  lappend isolist_names "$name"
  lappend isolist_types "$ftype"
  .isolist insert end "$ftype   $name"
}


# Make current the ISO directory that was selected from the .isolist box.
# Called when an item in the .isolist box is double-clicked.
#
proc pick_isodir {} {
  global isolist_names isolist_types isodir_adr isodir_return_name
  global .isolist

  set selected [.isolist curselection]
  if {[llength "$selected"] != 1} {
    xorriso_tcltk_errmsg \
       "xorriso-tcltk : SORRY : First you must select a single directory"
    return ""
  }
  set idx [lindex "$selected" 0]

  # <<<
  # puts stderr "pick_isodir: lindex \$isolist_types $idx = [lindex $isolist_types "$idx"]"

  if {[lindex "$isolist_types" "$idx"] != "d"} {
    xorriso_tcltk_errmsg \
       "xorriso-tcltk : SORRY : You may only double-click a directory"
    return ""
  }
  if {"$isodir_adr" == "/"} {
    set isodir_adr ""
  }
  set isodir_adr "$isodir_adr/[lindex $isolist_names "$idx"]"
  set isodir_return_name ""
  isodir_return "pick_isodir"
}


# Make current the parent directory of the current ISO directory.
# Called when the "Up" button is hit.
#
proc isodir_up {} {
  global isodir_adr isodir_return_name

  set isodir_return_name ""
  set idx [string last "/" "$isodir_adr"]
  set l  [string length "$isodir_adr"]
  if {"$idx" == -1} {
    set isodir_return_name "$isodir_adr"
    set isodir_adr "/"
  } else {
    if {"$idx" > 0} {
      if {"$idx" < [expr "$l" - 1]} {
        set isodir_return_name \
            [string range "$isodir_adr" [expr "$idx" + 1] end]
      }
      set isodir_adr [string range "$isodir_adr" 0 [expr "$idx" - 1]]
    } else {
      if {"$l" > 1} {
        set isodir_return_name [string range "$isodir_adr" 1 end]
      }
      set isodir_adr "/"
    }
  }
  isodir_return "isodir_up"
}


# Rename resp. move the files which are selected in the .isolist box.
# The target is defined by the .isomanip_move_target text field.
# Called when the "Rename to:" button is hit.
#
proc isomanip_mv {} {
  global .isolist
  global isomanip_move_target isolist_names isodir_is_pwd isodir_adr
  global isodir_return_name

  if {"$isomanip_move_target" == ""} {
    xorriso_tcltk_errmsg \
       "xorriso-tcltk : SORRY : First you must enter a target address"
    return ""
  }
  set selected [.isolist curselection]
  set num_selected [llength "$selected"]
  if {"$num_selected" < 1} {
    xorriso_tcltk_errmsg \
       "xorriso-tcltk : SORRY : First you must select one or more ISO files"
    return ""
  }

  set target "$isomanip_move_target"
  if {"$isodir_is_pwd" == 0 && [string range "$target" 0 0] != "/"} {
    set target [combine_dir_and_name "$isodir_adr" "$target"]
  }
  set target_ftype [get_iso_filetype "$target"]

  # If more than one selected : target must be directory
  if {"$num_selected" > 1} {
    if {"$target_ftype" != "d" && "$target_ftype" != ""} {
      xorriso_tcltk_errmsg \
         "xorriso-tcltk : SORRY : If multiple files are selected then the target must be a directory"
      return ""
    }
    if {"$target_ftype" == ""} {
      set isomanip_move_target_mem "$isomanip_move_target"
      set isomanip_move_target "$target"
      isomanip_mkdir
      set isomanip_move_target "$isomanip_move_target_mem"
    } 
  }

  enforce_overwrite_settings
  reset_highest_cmd_sev
  foreach i "$selected" {
    set name [lindex "$isolist_names" "$i"]
    if {"$isodir_is_pwd" == 0} {

      # <<<
      # puts stderr "isomanip_mv : isodir_is_pwd = $isodir_is_pwd"

      set name [combine_dir_and_name "$isodir_adr" "$name"]
    }

    # Ask for confirmation if overwriting is about to happen
    if {"$target_ftype" == "d"} {
      set eff_target [combine_dir_and_name "$target" "$name"]
      set eff_target_ftype [get_iso_filetype "$eff_target"]
      if {[handle_iso_overwriting \
            "$eff_target" "$eff_target_ftype" 0 "" ""] == "0"} {
        return ""
      }
    } else {
      if {[handle_iso_overwriting \
                    "$target" "$target_ftype" 0 "" ""] == "0"} {
        return ""
      }
    }
    send_marked_cmd "-mv [make_text_shellsafe "$name"] [make_text_shellsafe "$target"] --"
  }

  if {[llength "$selected"] == 1} {
    set isodir_return_name [path_touches_isodir "$target"]
  }
  isodir_return "isomanip_mv"
}


# Create an empty ISO directory with address given by variable
# isomanip_move_target.
# Called when the "Make directory" button is hit or by other functions.
#
proc isomanip_mkdir {} {
  global isomanip_move_target isodir_adr isodir_return_name

  if {"$isomanip_move_target" == ""} {
    xorriso_tcltk_errmsg \
       "xorriso-tcltk : SORRY : First you must enter a target address"
    return ""
  }

  if {[string range "$isomanip_move_target" 0 0] == "/"} {
    set abs_adr "$isomanip_move_target"
  } else {
    set abs_adr [combine_dir_and_name "$isodir_adr" "$isomanip_move_target"]
  }
  reset_highest_cmd_sev
  send_marked_cmd "-mkdir [make_text_shellsafe "$abs_adr"] --"

  # Refresh only if new dir in isodir_adr
  # or if a parent directory of new dir is created in isodir_adr
  set touch_name [path_touches_isodir "$abs_adr"]
  if {"$touch_name" != ""} {
    if {[llength [.isolist curselection]] != 0} {
      memorize_isolist_selection 
      set selection_memorized 1
    } else {
      set isodir_return_name "$touch_name"
      set selection_memorized 0
    }
    isodir_return "isomanip_mkdir"
    if {"$selection_memorized" != 0} {
      restore_isolist_selection 
    }
  }
}


# Remove a file or directory tree from the ISO image.
# Called when the "Delete" button is hit.
#
proc isomanip_rm_r {} {
  global .isolist
  global isomanip_move_target isolist_names isodir_is_pwd isodir_adr

  set selected [.isolist curselection]
  if {[llength "$selected"] < 1} {
    xorriso_tcltk_errmsg \
       "xorriso-tcltk : SORRY : First you must select one or more ISO files"
    return ""
  }
  if {[window_yesno "Really delete the selected files from ISO image ?"] \
      != 1} { return "" }
  reset_highest_cmd_sev
  foreach i "$selected" {
    set name [lindex "$isolist_names" "$i"]
    if {"$isodir_is_pwd" == 0} {
      set name [combine_dir_and_name "$isodir_adr" "$name"]
    }
    send_marked_cmd "-rm_r [make_text_shellsafe "$name"] --"
  }
  isodir_return "isomanip_rm_r"
}


# Perform a blanking run on the output drive.
# Called when the "Blank" button is hit.
#
proc burn_blank {} {
  global outdev_adr outdev_profile

  if {[assert_outdev blanking] <= 0} {return ""}

  set victim "medium in"
  if {[string first "stdio" "$outdev_profile"] == 0} {
    set victim "image file"
  } 
  if {[window_yesno \
            "Really blank the $victim [make_text_shellsafe "$outdev_adr"] ?"] \
      != 1} { return "" }
  reset_highest_cmd_sev
  send_marked_cmd "-blank as_needed"
  refresh_indev
  refresh_outdev
}


# Perform a formatting run on the output drive.
# Called when the "Format" button is hit.
#
proc burn_format {} {
  global outdev_adr outdev_profile

  if {[assert_outdev formatting] <= 0} {return ""}

  if {[string first "stdio" "$outdev_profile"] == 0} {
    xorriso_tcltk_errmsg \
       "xorriso-tcltk : SORRY : Image files cannot be formatted"
    return ""
  } 
  if {[window_yesno "Really format the medium in $outdev_adr ?"] \
      != 1} { return "" }

  reset_highest_cmd_sev
  send_marked_cmd "-format as_needed"
  refresh_indev
  refresh_outdev
}


# Write pending changes in the xorriso ISO model as session to the output
# drive. This will be an add-on session if the drive is output and input drive
# and if its medium is not blank.
# Else it will be a new independent ISO image.
#
proc burn_commit {} {
  global outdev_adr result_list result_count outdev_medium_status
  global burn_write_close burn_write_tao burn_write_defect_mgt
  global indev_adr outdev_adr

  if {[assert_outdev "writing ISO session"] <= 0} {return ""}
  if {"$outdev_adr" == "$indev_adr"} {
    if {"$outdev_medium_status" != "blank" && \
        "$outdev_medium_status" != "appendable"} {
      xorriso_tcltk_errmsg \
        "xorriso-tcltk : SORRY : Medium in output drive is neither blank nor appendable"
      return ""
    }
  } else {
    if {"$outdev_medium_status" != "blank"} {
      xorriso_tcltk_errmsg \
        "xorriso-tcltk : SORRY : Medium in output drive is not blank"
      return ""
    }
  }
  if {[changes_are_pending] == "0"} {
    window_ack "No changes are pending. Will not write ISO session." \
               "grey" "toplevel"
    return ""
  }
  if {"$outdev_adr" == "$indev_adr"} {
    if {[window_yesno "Really write ISO changes as session to $outdev_adr ?"] \
        != 1} { return "" }
  } else {
    if {[window_yesno "Really write new ISO filesystem to $outdev_adr ?"] \
        != 1} { return "" }
  }

  set cmd ""
  set cmd "$cmd -close"
  if {"$burn_write_close" == 1} {
    set cmd "$cmd on"
  } else {
    set cmd "$cmd off"
  }
  set cmd "$cmd -write_type"
  if {"$burn_write_tao" == 1} {
    set cmd "$cmd tao"
  } else {
    set cmd "$cmd auto"
  }
  set cmd "$cmd -stream_recording"
  if {"$burn_write_defect_mgt" == 1} {
    set cmd "$cmd off"
  } else {
    set cmd "$cmd data"
  }
  set cmd "$cmd -commit"
  reset_highest_cmd_sev
  send_marked_cmd "$cmd"
  refresh_indev
  refresh_outdev
}


# Verify the MD5 checksums of the data files in the tree underneath the
# current ISO directory.
# Called when the "Verify" in the "ISO directory:" line is hit.
#
proc isodir_verify {} {
  global isodir_adr

  reset_highest_cmd_sev
  send_marked_cmd "-check_md5_r sorry [make_text_shellsafe "$isodir_adr"] --"

  # >>> select mismatching files or directories with mismatching files

}


# Verify the MD5 checksums of the data files orch are selected or which
# sit in the trees underneath the selected items in the isolist box.
# Called when the "Verify" in the "ISO selection:" line is hit.
#
proc isomanip_verify {} {
  global .isolist
  global isomanip_move_target isolist_names isodir_is_pwd isodir_adr

  set selected [.isolist curselection]
  if {[llength "$selected"] < 1} {
    xorriso_tcltk_errmsg \
       "xorriso-tcltk : SORRY : First you must select one or more ISO files"
    return ""
  }
  reset_highest_cmd_sev
  foreach i "$selected" {
    set name [combine_dir_and_name "$isodir_adr" \
                                    [lindex "$isolist_names" "$i"]]
    send_marked_cmd "-check_md5_r sorry [make_text_shellsafe "$name"] --"
  }

  # >>> select mismatching files or directories with mismatching files

}


# Slow down the spinning of the aquired optical drives.
# Called when button "Calm drives" is hit.
#
proc calm_drives {} {
  reset_highest_cmd_sev
  send_marked_cmd "-calm_drive all"
}


# Burn a data file from disk as session to the output drive.
# Called when the "Burn image file:" button is hit.
#
proc burn_write_image {} {
  global burn_write_image_adr burn_write_close outdev_adr outdev_medium_status
  global outdev_profile burn_write_tao burn_write_defect_mgt

  if {[assert_outdev "writing an image file"] <= 0} {return ""}
  if {"$burn_write_image_adr" == ""} {
    xorriso_tcltk_errmsg \
       "xorriso-tcltk : SORRY : You have to set an image file address in the local filesystem first"
    return ""
  }

  if {"$outdev_medium_status" != "blank" && \
      "$outdev_medium_status" != "appendable"} {
    xorriso_tcltk_errmsg \
      "xorriso-tcltk : SORRY : Medium in output drive is neither blank nor appendable"
    return ""
  }
  if {[file readable "$burn_write_image_adr"] == 0 || \
      [file isfile "$burn_write_image_adr"] == 0 ||
      [file exists "$burn_write_image_adr"] == 0} {
    xorriso_tcltk_errmsg \
               "xorriso-tcltk : SORRY : Image file '$burn_write_image_adr' is not a readable data file"
    return ""
  }
  if {[window_yesno "Really write '$burn_write_image_adr' as image to $outdev_adr ?"] \
      != 1} { return "" }

  set cmd "-as cdrecord -v"
  if {[regexp "^CD" "$outdev_profile"] == 1 && \
      "$outdev_medium_status" == "appendable"} {
    set cmd "$cmd padsize=150s"
  }
  set cmd "$cmd dev=[make_text_shellsafe "$outdev_adr"]"
  set cmd "$cmd [make_text_shellsafe "$burn_write_image_adr"]"
  if {"$burn_write_tao" == 1} {
    set cmd "$cmd -tao"
  }
  if {"$burn_write_close" != 1} {
    set cmd "$cmd -multi"
  } 
  if {"$burn_write_defect_mgt" == 1} {
    set cmd "$cmd stream_recording=off"
  } else {
    set cmd "$cmd stream_recording=32s"
  }
  reset_highest_cmd_sev
  send_marked_cmd "$cmd"
  refresh_state
}


# Discard all image modifications and reload ISO image model from input drive.
# Called when the "Rollback" button is hit.
#
proc iso_rollback {} {
  if {[window_yesno \
         "Really discard all pending changes and reload from input drive  ?"] \
      != 1} { return "" }
  reset_highest_cmd_sev
  send_marked_cmd "-rollback"
  .avail_label configure -text ""
  isodir_return "iso_rollback"
} 


# Inquire an accurate prediction of free space after writing a session with
# the pending changes of the ISO image.
# Called when button "Refresh avail:" is hit.
#
proc refresh_avail {} {
  global result_list highest_cmd_sev
  global sieve_ret

  if {[assert_outdev "refreshing available space count"] <= 0} {return ""}

  set line "n.a."
  reset_highest_cmd_sev
  clear_sieve
  send_marked_cmd "-tell_media_space"
  if {[compare_sev "$highest_cmd_sev" "FAILURE"] < 0} {
    set ac ""
    read_sieve "After commit :"
    if {"$sieve_ret" > 0} {
      set ac [lindex "$result_list" 0]
      set ac [string range "$ac" 0 [expr [string length "$ac"] - 2]]
      set line "[format "%7dm" [expr "$ac / 512"]]"
    }
  }
  .avail_label configure -text "$line"
}


# Warn and prompt the user for confirmation if there is the risk to overwrite
# existing files in the ISO image model.
# Called from several procedures which change the ISO tree.
#
proc handle_iso_overwriting {target target_ftype from_is_dir
                             selected_adr selected_ftype} {
  global overwrite_dirs

  # >>> Nicer would be:
    # >>> Check if any file will get overwritten. Not only the direct target.
    # >>> Then silently allow directories to be merged

  if {"$target_ftype" != ""} {
    if {"$target_ftype" == "d"} {
      if {"$from_is_dir" == 1} {
        if {[window_yesno \
                   "'$target'\n\nReally merge with existing ISO directory ?"] \
            != 1} { return "0" }
      } else {
        if {"$overwrite_dirs" == 1} {
          if {[window_yesno \
                    "'$target'\n\nReally overwrite existing ISO directory ?"] \
              != 1} { return "0" }
        } else {
          xorriso_tcltk_errmsg "xorriso-tcltk : SORRY : You would have to enable \"Overwriting of ISO directories\""
          return "0"
        }
      }
    } else {
      if {[window_yesno "'$target'\n\nReally overwrite existing ISO file ?"] \
           != 1} { return "0" }
    }
  }
  if {"$selected_adr" != "$target" && "$selected_adr" != "" && \
      "$selected_ftype" != "d" && "$selected_ftype" != ""} {
    if {[window_yesno \
                     "'$selected_adr'\n\nReally replace existing ISO file by a directory ?"] \
        != 1} { return "0" }
  }
  return "1"
}


# Insert a file or directory tree into the ISO model tree and schedule it
# for being copied when "Write ISO session" is hit.
# Called when button "Insert from disk:" is hit.
#
proc insert_from {} {
  global insert_from_adr isodir_adr isolist_names isodir_return_name
  global insert_at_selected insert_underneath overwrite_dirs

  if {[assert_iso_image 1] == 0} {return ""}
  if {"$insert_from_adr" == ""} {
    xorriso_tcltk_errmsg \
       "xorriso-tcltk : SORRY : You have to set a source address in the local filesystem first"
    return ""
  }
  set selected_ftype ""
  set selected_adr ""
  if {"$insert_at_selected" == 1} {
    set selected [.isolist curselection]
    if {[llength "$selected"] != 1} {
      xorriso_tcltk_errmsg "xorriso-tcltk : SORRY : You must select exactly one ISO file as insertion target"
      return ""
    }
    set target "[lindex "$isolist_names" [lindex "$selected" 0]]"
    set selected_ftype [get_iso_filetype "$target"]
    set selected_adr "$target"
  } else {
    set target "$isodir_adr"
  }
  set from_is_dir [file isdirectory "$insert_from_adr"]
  set name [file tail "$insert_from_adr"]
  if {"$insert_underneath" == 1 || "$from_is_dir" == 0} {
    set target [combine_dir_and_name "$target" "$name"]
  }
  set target_ftype [get_iso_filetype "$target"]

  if {[handle_iso_overwriting "$target" "$target_ftype" "$from_is_dir" \
                              "$selected_adr" "$selected_ftype"] == "0"} {
    return ""
  }

  set preserve_selection 0
  if {"$insert_underneath" + "$insert_at_selected" == 1} {
    set isodir_return_name "$name"
  } else {
    set preserve_selection 1
  }
  reset_highest_cmd_sev
  enforce_overwrite_settings
  send_marked_cmd "-map [make_text_shellsafe "$insert_from_adr"] [make_text_shellsafe "$target"]"

  if {"$preserve_selection" == 1} {
    memorize_isolist_selection
  }
  isodir_return "insert_from"
  if {"$preserve_selection" == 1} {
    restore_isolist_selection
  }
}


# Copy a file out of the ISO image model to the local disk filesystem.
# The meta data stem from the ISO model tree. The content data are usually
# read from the input drive.
# Called when button "Extract to disk:" is hit.
#
proc extract_to {} {
  global extract_to_adr extract_from_selected extract_underneath
  global extract_auto_chmod
  global isodir_adr isolist_names

  if {[assert_iso_image 1] == 0} {return ""}
  if {"$extract_to_adr" == ""} {
    xorriso_tcltk_errmsg \
       "xorriso-tcltk : SORRY : You have to set a target address in the local filesystem first"
    return ""
  }
  set sources ""
  set selected_ftype ""
  set selected_adr ""
  if {"$extract_from_selected" == 1} {
    set selected [.isolist curselection]
    if {[llength "$selected"] < 1} {
      xorriso_tcltk_errmsg "xorriso-tcltk : SORRY : You must select at least one ISO file as extraction source"
      return ""
    }
    foreach i "$selected" {
      set path [combine_dir_and_name "$isodir_adr" \
                                     [lindex "$isolist_names" "$i"]]
      lappend sources "$path"
    }
  } else {
    set sources [list "$isodir_adr"]
  }
  reset_highest_cmd_sev
  enforce_overwrite_settings
  set disp_en_mem [set_display_msg 0]
  if {"$extract_auto_chmod" == 1} {
    send_marked_cmd "-osirrox on:sort_lba_on:auto_chmod_on"
  } else {
    send_marked_cmd "-osirrox on:sort_lba_off:auto_chmod_off"
  }
  set_display_msg "$disp_en_mem"
  foreach i "$sources" {
    if {"$extract_underneath" == 1} {
      set name [file tail "$i"]
      set target [combine_dir_and_name "$extract_to_adr" "$name"]
    } else {
      if {[llength "$sources"] != 1} {
        xorriso_tcltk_errmsg "xorriso-tcltk : SORRY : You must select exactly one ISO file as extraction source"
        return ""
      }
      set target "$extract_to_adr"
    }
    if {"$i" == ""} {
      set i "/"
    }
    send_marked_cmd "-extract [make_text_shellsafe "$i"] [make_text_shellsafe "$target"]"
  }
}


# Send the currently chosen -overwrite settings of the checkbuttons
# "Overwrite files" and "Overwrite ISO dirs".
# Called before operations which could overwrite files in ISO model
# or in local disk filesystem.
# I.e. any -overwrite command sent via the "Command:" text field will not
# be able to override the checkbuttons.
#
proc enforce_overwrite_settings {} {
  global overwrite_files overwrite_dirs

  if {"$overwrite_files" == 0} {
    set mode "off"
  } else {
    if {"$overwrite_dirs" == 0} {
      set mode "nondir"
    } else {
      set mode "on"
    }
  }
  set disp_en_mem [set_display_msg 0]
  send_marked_cmd "-overwrite $mode"
  set_display_msg "$disp_en_mem"
}


# Send xorriso an appropriate end command and wait for the pipes to break.
# Called when button "End" is hit.
#
proc end_xorriso {} {
  global expect_broken_pipes

  if {[window_yesno "Really end this program and its xorriso backend ?"] \
      != 1} { return "" }
  if {[changes_are_pending] == 1} {
    if {[window_yesno \
              "Changes of the ISO image are pending.\nReally discard them ?"] \
        != 1} { return "" }
    set expect_broken_pipes "1"
    send_marked_cmd "-rollback_end"
  } else {
    set expect_broken_pipes "1"
    send_marked_cmd "-end"
  }
  central_exit 0
}


# Check whether an output drive is aquired. Propose refusal if not.
# Called by procedures which are about to use the output drive.
#
proc assert_outdev {purpose} {
  global outdev_adr

  if {"$outdev_adr" == ""} {
    xorriso_tcltk_errmsg \
      "xorriso-tcltk : SORRY : You must choose an output drive before $purpose"
    return "0"
  }
  return "1"
}


# Check whether changes to the ISO model are pending. If so, propose refusal.
# Called by procedures which are about to discard the ISO model.
#
proc assert_no_changes {} {
  if {[changes_are_pending] == 1} {
     window_ack "ISO image changes are pending. You have to do \"Write ISO session\" or \"Rollback\"." "grey" "toplevel"
    return "0"
  }
  return "1"
}


# ------ GUI display procedures ----


# Display a message of xorriso or of this frontend in the .msglist box
#
proc display_msg {msg} {
  global .msglist
  global msglist_max_fill msglist_running pre_msglist display_msg_enabled

  if {"$display_msg_enabled" == 0} {return ""}
  if {"$msg" == "============================" || \
"$msg" == "==============================================================" || \
      "$msg" == "enter option and arguments :"} {return ""}
    
  if {"$msglist_running" == 0} {
    lappend pre_msglist "$msg"
  } else {
    if {[.msglist index end] > "$msglist_max_fill"} {
      .msglist delete 0 0
    }
    .msglist insert end "$msg"
    .msglist see [expr "[.msglist index end]-1"]
    update idletasks
  }
}


# Set whether messages submitted to proc display_message shall really show up
# This is used by callback procedures to hide auxilliary commands and lengthy
# reply messages from the user display.
#
proc set_display_msg {mode} {
  global display_msg_enabled

  set old "$display_msg_enabled"
  if {"$mode" == "0"} {
    set display_msg_enabled 0
  } else {
    set display_msg_enabled "1"
  }
  return "$old"
}


# Display a frontend error message in the .msglist box and by a pop-up window.
# >>> It would be nice to be able to wait for user confirmation.
#
proc xorriso_tcltk_errmsg {msg} {
  global highest_cmd_sev_msg

  set highest_cmd_sev_msg "$msg"
  display_msg "$msg"
  window_ack "$msg" "grey" "toplevel"
  update idletasks
}


# Memorize the current selection in the .isolist box.
#
proc memorize_isolist_selection {} {
  global memorized_isolist_selection isolist_names
  global .isolist

  set memorized_isolist_selection ""
  set selected [.isolist curselection]
  foreach i "$selected" {
    lappend memorized_isolist_selection [lindex $isolist_names "$i"]
  }
}


# Restore the memorized selection in the .isolist box as far as the
# names have survived in the meantime.
#
proc restore_isolist_selection {} {
  global memorized_isolist_selection isolist_names
  global .isolist

  .isolist selection clear 0 end
  foreach i "$memorized_isolist_selection" {
    set idx [lsearch -exact "$isolist_names" "$i"]
    if {"$idx" > -1} {
      .isolist selection set "$idx" "$idx"
    }
  }
  set memorized_isolist_selection ""
}


# Receive the answer of the yes/no window and destroy it.
#
proc destroy_yesno {w answer} {
  global yesno_window_is_active answer_of_yesno

  if {"$w" != ""} {
    destroy "$w"
  }
  set yesno_window_is_active 0
  set answer_of_yesno "$answer"
}
  

# Pop-up a window which asks for yes or no. Return 1 if answer is yes.
#
proc window_yesno {question} {
  global answer_of_yesno yesno_window_is_active

  set w {.yesno_window}
  if {"$yesno_window_is_active" == 1} {
    raise $w
    xorriso_tcltk_errmsg "xorriso-tcltk : SORRY : You still need to answer an older yes/no question"
    return "0"
  }
  set yesno_window_is_active 1
  set answer_of_yesno ""
  toplevel $w -borderwidth 20 -class Dialog
  wm title $w "xorriso-tcltk yes/no"
  # wm geometry $w -0+0
  label $w.question -text "$question"
  button $w.yes -text "yes" -command "destroy_yesno $w 1" \
                -borderwidth 10 -padx 20 -pady 20 -relief ridge
  button $w.no -text "no" -command "destroy_yesno $w 0" \
                -borderwidth 10 -padx 20 -pady 20 -relief ridge
  pack $w.yes $w.question $w.no -side left -expand 1 -fill both
  update idletasks

  tkwait variable answer_of_yesno
  return "$answer_of_yesno"
}


# Destroy the notification pop-up window.
#
proc destroy_ack {w} {
  global ack_window_is_active

  if {"$w" != ""} {
    destroy "$w"
  }
  set ack_window_is_active 0
}


# Pop-up a window which notifies of a problem and asks for a button click.
#
proc window_ack {question button_color where} {
  global answer_of_yesno ack_window_is_active

  set re_use_widgets 0
  if {"$where" == "embedded"} {
    set w ""
    set destroy_cmd ""
  } else {
    set w {.ack_window}
    if {"$ack_window_is_active" == 0} {
      toplevel $w -borderwidth 20 -class Dialog
      wm title $w "xorriso-tcltk acknowledge"
      set ack_window_is_active 1
    } else {
      set re_use_widgets 1
    }
    # wm geometry $w +0+0
    set destroy_cmd "destroy_ack $w"
  }
  if {"$re_use_widgets" == 1} {
    $w.question configure -text "$question"
    raise $w
  } else {
    label $w.question -text "$question"
    button $w.ok -text "Continue" -command "$destroy_cmd" \
                 -background "$button_color"
    pack $w.question -side top -expand 1 -fill both
    pack $w.ok -side top 
  }

  # >>> How to block any event but the "Continue" button ?

}


# Display the busy/ready state of xorriso.
# Called with 1 by sender of commands and with 0 by receivers of replies .
#  
proc display_busy {state} {
  global busy_text_exists
  global .busy_text 

  if {"$busy_text_exists" == 0} {return ""}

  if {"$state" == 0} {
    .busy_text configure -text "ready"
    .busy_text configure -background "#D0D0D0"
  } else {
    .busy_text configure -text "busy"
    .busy_text configure -background "#808080"
  }
  update idletasks
}


# ------ Building GUI components ------

# ------ GUI layout parameters ------

# The default position of the main window
set main_window_geometry ""

# How to mark the borders of the main grouping frames
set main_framerelief ridge
set main_borderwidth 4

# How to mark the borders of the second level grouping frames
set borderwidth 1

# Number of lines in msglist display
set msglist_lines 8 
set msglist_max_fill 1000
set msglist_running 0

# Number of lines in drivelist display
set drivelist_lines 2

# Number of lines in ISO directory content display
set isolist_lines 8

# Whether the message box shall export its selection to the whole X display
set export_msg_selection true

# Wether the item lists shall export their selection
set export_selection false


# -------- GUI definition procedures


# Overall definition of the GUI
#
proc init_gui {} {
  global .input .cmdline_entry .msgbox  .errmsg .dev .drivebox
  global .isobox .localfs
  global main_framerelief main_borderwidth

  # Main grouping frames
  frame .connection_block \
        -relief "$main_framerelief" -borderwidth "$main_borderwidth"
  frame .drive_block \
        -relief "$main_framerelief" -borderwidth "$main_borderwidth"
  frame .iso_block \
        -relief "$main_framerelief" -borderwidth "$main_borderwidth"

  init_input
  init_msgbox
  init_errmsg
  init_dev
  init_drivebox
  init_isobox
  init_isomanip
  init_burn
  init_localfs

  pack .input .msgbox .errmsg -in .connection_block \
       -side top -expand 1 -fill both
  pack .drivebox .dev .burn -in .drive_block \
       -side top -expand 1 -fill both
  pack .localfs .isobox .isomanip -in .iso_block \
       -side top -expand 1 -fill both

  pack .connection_block .drive_block .iso_block \
       -side top -expand 1 -fill both

  focus .cmdline_entry
}


# The xorriso headline with End button, xorriso version, busy/ready indicator,
# command line, and "Refresh state display" button.
#
proc init_input {} {
  global borderwidth busy_text_exists xorriso_version logging
  global .input .input_line1 .xorriso_version .busy .busy_text
  global .refresh_state .end_button .cmdline .log_pipes_switch

  frame .input -borderwidth $borderwidth
  frame .input_line1 -borderwidth 0
  pack .input_line1 -in .input \
                    -side top -anchor w -expand 1 -fill both

  button .end_button -text "End" -command "end_xorriso"
  if {[string length "$xorriso_version"] > 10} {
    set xorriso_version [string range "$xorriso_version" 0 9]
  }
  label .xorriso_version -text "xorriso-$xorriso_version"
  frame .busy -relief ridge -borderwidth 2
  label .busy_text -width 5 -text "busy"
  set busy_text_exists 1
  pack .busy_text -in .busy

  button .refresh_state -text "Refresh state display" \
                        -command "refresh_state"

  checkbutton .log_pipes_switch -text "Log pipes" \
                                -indicatoron 1 -selectcolor "" \
                                -relief ridge -borderwidth 2 \
                                -variable logging \
                                -onvalue 1 -offvalue 0

  init_cmdline

  pack .end_button .xorriso_version .busy -in .input_line1 -side left
  pack .cmdline \
       -in .input_line1 -side left -expand 1 -fill both
  pack .refresh_state .log_pipes_switch -in .input_line1 -side left
}


# The combination of "Command:" label and command line
#
proc init_cmdline {} {
  global cmdline borderwidth
  global .cmdline .cmdline_text .cmdline_entry

  frame .cmdline -borderwidth 0

  label .cmdline_text -width 10 -text "Command:"
  entry .cmdline_entry -width 60 -relief sunken -bd 1 \
                              -textvariable cmdline
  bind_entry_keys .cmdline_entry {cmdline_return}

  # >>> is there a chance to get a history on an entry ?

  pack .cmdline_text -in .cmdline -side left 
  pack .cmdline_entry -in .cmdline -side left -expand 1 -fill both
}


# The listbox where to display commands and reply messages unless this is
# disabled for auxiliary commands which shall not clutter the display.
#
proc init_msgbox {} {
  global borderwidth
  global msglist_lines export_msg_selection msglist_running pre_msglist
  global .msgbox .msglist .msgscroll

  frame .msgbox -borderwidth $borderwidth

  listbox .msglist -height $msglist_lines -selectmode extended \
                   -yscrollcommand ".msgscroll set" \
                   -exportselection $export_msg_selection
  bind_listbox_keys ".msglist" "$msglist_lines" 
  set msglist_running 1
  foreach i "$pre_msglist" {

    # <<<
    # puts stderr "init_msgbox : pre_msglist : $i"

    display_msg "$i"
  }
  scrollbar .msgscroll -command ".msglist yview"
  pack .msglist   -in .msgbox -side left  -expand 1 -fill both
  pack .msgscroll -in .msgbox -side right -fill y
  set pre_msglist ""
}


# Two display lines for most severe event messages. One gets reset with
# each important command. The other one stays until the user clears it.
#
proc init_errmsg {} {
  global borderwidth
  global .errmsg .total_errmsg .cmd_errmsg

  frame .errmsg -borderwidth $borderwidth

  init_total_errmsg
  init_cmd_errmsg

  pack .cmd_errmsg .total_errmsg -in .errmsg \
       -side top -anchor w -expand 1 -fill both
 
}


# The most severe message display which gets reset automatically.
#
proc init_cmd_errmsg {} {
  global borderwidth
  global .cmd_errmsg .cmd_errmsg_label .cmd_errmsg_msg

  frame .cmd_errmsg -borderwidth "$borderwidth"

  label .cmd_errmsg_label -width 14 -text "Recent problem:"
  entry .cmd_errmsg_msg -width 80 -relief raised -bd 1 \
                      -textvariable highest_cmd_sev_msg
  # (no keys, no focus)
  pack .cmd_errmsg_label -in .cmd_errmsg -side left
  pack .cmd_errmsg_msg -in .cmd_errmsg -side left -expand 1 -fill both
}


# The persistent most severe message display that is to be reset by the user.
#
proc init_total_errmsg {} {
  global borderwidth
  global .total_errmsg .total_errmsg_label .total_errmsg_msg
  global .total_errmsg_clear

  frame .total_errmsg -borderwidth "$borderwidth"

  label .total_errmsg_label -text "Worst problem:" -width 14
  button .total_errmsg_clear -text "Clear" \
                             -width 5 \
                             -command "clear_total_errmsg"
  entry .total_errmsg_msg -width 80 -relief raised -bd 1 \
                      -textvariable highest_total_sev_msg
  # (no keys, no focus)
  pack .total_errmsg_label -in .total_errmsg -side left 
  pack .total_errmsg_msg -in .total_errmsg -side left -expand 1 -fill both
  pack .total_errmsg_clear -in .total_errmsg -side left
}


# The list of drives which were found by scanning, the Scan button, and
# buttons for picking a drive from the list, for giving them up, for
# calming them down, and for reloading the ISO image from the input drive.
#
proc init_drivebox {} {
  global borderwidth drivelist_lines export_selection
  global .drivebox .drivelistbox .drivelist .drivescroll .drive_scan
  global .drive_picker .drive_scan .drive_pick_in .drive_pick_out
  global .drive_pick_both .drive_drop_both .drive_calm .iso_rollback_button


  frame .drivebox -borderwidth $borderwidth
  frame .drivelistbox -borderwidth $borderwidth
  listbox .drivelist -height $drivelist_lines -selectmode extended \
                     -yscrollcommand ".drivescroll set" \
                     -exportselection $export_selection
  bind_listbox_keys ".drivelist" "$drivelist_lines" 
  scrollbar .drivescroll -command ".drivelist yview"

  pack .drivelist   -in .drivelistbox -side left  -expand 1 -fill both
  pack .drivescroll -in .drivelistbox -side right -fill y 

  frame .drive_picker -borderwidth $borderwidth
  button .drive_scan -text "Scan for drives" \
                     -command "scan_for_drives"
  button .drive_pick_in -text "Pick input drive" \
                        -command "pick_indev"
  button .drive_pick_out -text "Pick output drive" \
                         -command "pick_outdev"
  button .drive_pick_both -text "Pick drive for both roles" \
                         -command "pick_dev"
  button .drive_drop_both -text "Give up drives" \
                         -command "give_up_dev"
  button .drive_calm -text "Calm drives" \
                         -command "calm_drives"
  button .iso_rollback_button -text "Rollback" -command {iso_rollback}

  pack .drive_scan \
       .drive_pick_in .drive_pick_out .drive_pick_both \
       .drive_drop_both .drive_calm .iso_rollback_button \
       -in .drive_picker -side left -expand 1 -fill none 
  pack .drive_picker -in .drivebox \
       -side top -expand 1 -fill none
  pack .drivelistbox -in .drivebox \
       -side top -expand 1 -fill both

  bind .drivelist <Double-Button-1> {
    pick_dev
  }
}


# The text fields for setting and display of the current input and output
# drives. With Eject button and a short text description of the medium status.
#
proc init_dev {} {
  global borderwidth
  global .dev .indev .outdev

  frame .dev -borderwidth $borderwidth

  init_indev
  init_outdev 

  pack .indev .outdev -in .dev \
                    -side top -anchor w -expand 1 -fill both
}


# Set and display the current input drive.
#
proc init_indev {} {
  global borderwidth indev_adr
  global .indev .indev_eject .indev_label .indev_entry .indev_summary

  frame .indev -borderwidth $borderwidth

  button .indev_eject -text "Eject" -command {eject_indev}
  label .indev_label -width 22 -text "Input drive or image  "
  entry .indev_entry -width 40 -relief sunken -bd 1 \
                     -textvariable indev_adr
  bind_entry_keys .indev_entry {indev_return}
  label .indev_summary -width 65 -text "" -relief ridge -borderwidth 2
  pack .indev_eject .indev_label .indev_entry .indev_summary \
       -in .indev -side left -expand 1 -fill both
}


# Set and display the current output drive.
#
proc init_outdev {} {
  global .outdev .outdev_eject .outdev_label .outdev_entry .outdev_summary
  global borderwidth outdev_adr

  frame .outdev -borderwidth $borderwidth

  button .outdev_eject -text "Eject" -command {eject_outdev}
  label .outdev_label -width 22 -text "Output drive or image" 
  entry .outdev_entry -width 40 -relief sunken -bd 1 \
                      -textvariable outdev_adr
  bind_entry_keys .outdev_entry {outdev_return}
  label .outdev_summary -width 65 -text "" -relief ridge -borderwidth 2
  pack .outdev_eject .outdev_label .outdev_entry .outdev_summary \
       -in .outdev -side left -expand 1 -fill both
}


# The button panel for blanking, formatting, and writing to the output drive.
#
proc init_burn {} {
  global borderwidth burn_write_image_adr burn_write_close burn_write_tao
  global burn_write_defect_mgt
  global .burn .burn_blank_button .burn_format_button .burn_commit_button
  global .burn_write_image .burn_write_image_entry .burn_write_close
  global .burn_write_tao .burn_write_defect_mgt

  frame .burn -borderwidth $borderwidth
 
  button .burn_blank_button -text "Blank" \
                            -command {burn_blank}
  button .burn_format_button -text "Format" \
                             -command {burn_format}
  button .burn_commit_button -text "Write ISO session" \
                             -command {burn_commit}
  button .burn_write_image -text "Burn image file:" \
                           -command {burn_write_image}
  entry .burn_write_image_entry -width 40 -relief sunken -bd 1 \
                                -textvariable burn_write_image_adr
  bind_entry_keys .burn_write_image_entry {burn_write_image}
  checkbutton .burn_write_close -text "Close" \
                                -indicatoron 1 -selectcolor "" \
                                -relief ridge -borderwidth 2 \
                                -variable burn_write_close \
                                -onvalue 1 -offvalue 0
  checkbutton .burn_write_tao -text "TAO" \
                                -indicatoron 1 -selectcolor "" \
                                -relief ridge -borderwidth 2 \
                                -variable burn_write_tao \
                                -onvalue 1 -offvalue 0
  checkbutton .burn_write_defect_mgt -text "Defect Mgt" \
                                -indicatoron 1 -selectcolor "" \
                                -relief ridge -borderwidth 2 \
                                -variable burn_write_defect_mgt \
                                -onvalue 1 -offvalue 0
  pack .burn_blank_button .burn_format_button \
       .burn_commit_button .burn_write_close .burn_write_tao \
       .burn_write_defect_mgt \
       .burn_write_image .burn_write_image_entry \
       -in .burn -side left -expand 1 -fill both
}


# Set and display the current ISO directory and its content.
#
proc init_isobox {} {
  global borderwidth isolist_lines export_selection
  global .isobox .isodir .isolist .isodir_entry .isodir_up .isodir_up2
  global .isodir_label .isodir_verify .isolistbox .isoscroll_y .isoscroll_x
  
  frame .isobox -borderwidth $borderwidth
  frame .isodir -borderwidth 0

  label .isodir_label -text "ISO directory:" \
                      -width 14
  entry .isodir_entry -width 60 -relief sunken -bd 1 \
                      -textvariable isodir_adr
  bind_entry_keys .isodir_entry {isodir_return "isodir_entry"}
  button .isodir_verify -text "Verify" -command {isodir_verify}
  button .isodir_up -text "Up" -command {isodir_up}
  button .isodir_up2 -text "Up" -command {isodir_up}
  pack .isodir_label .isodir_up \
       -in .isodir -side left
  pack .isodir_entry \
       -in .isodir -side left -expand 1 -fill both
  pack .isodir_up2 .isodir_verify \
       -in .isodir -side left

  frame .isolistbox -borderwidth 0
  listbox .isolist -height $isolist_lines -selectmode extended \
                   -yscrollcommand ".isoscroll_y set" \
                   -xscrollcommand ".isoscroll_x set" \
                   -exportselection $export_selection
  bind_listbox_keys ".isolist" "$isolist_lines" 
  scrollbar .isoscroll_y -command ".isolist yview"
  scrollbar .isoscroll_x -orient horizontal -command ".isolist xview"
  pack .isolist     -in .isolistbox -side left  -expand 1 -fill both
  bind .isolist <Double-Button-1> { pick_isodir }
  pack .isoscroll_y -in .isolistbox -side right -fill y 

  pack .isodir .isolistbox .isoscroll_x \
       -in .isobox -side top -expand 1 -fill both
}


# The ISO-internal manipulation buttons for the ISO directory or its content.
# Plus a text field where to set an ISO path as target for renaming or
# directory making.
#
proc init_isomanip {} {
  global borderwidth isomanip_move_target
  global .isomanip .isomanip_move .isomanip_prefix .isomanip_verify_button
  global .isomanip_move_target .isomanip_rm_r_button .isomanip_move_button
  global .isomanip_mkdir_button .isomanip_move_target

  frame .isomanip -borderwidth $borderwidth
  frame .isomanip_move -borderwidth 0
 
  label .isomanip_prefix -text "ISO selection:"

  button .isomanip_verify_button -width 8 -text "Verify" \
                                -command {isomanip_verify}
  button .isomanip_rm_r_button -width 8 -text "Delete" \
                                -command {isomanip_rm_r}
  button .isomanip_move_button -text "Rename to:" \
                               -command {isomanip_mv}
  button .isomanip_mkdir_button -width 8 -text "Make dir" \
                                -command {isomanip_mkdir}
  entry .isomanip_move_target -width 60 -relief sunken -bd 1 \
                             -textvariable isomanip_move_target
  # bind_entry_keys .isomanip_move_target {isomanip_mv}
  bind_entry_keys .isomanip_move_target ""
  pack .isomanip_prefix .isomanip_verify_button .isomanip_rm_r_button \
       .isomanip_move_button .isomanip_move_target .isomanip_mkdir_button \
       -in .isomanip_move -side left -expand 1 -fill both

  pack .isomanip_move \
       -in .isomanip -side top -expand 1 -fill both
}


# The means for interaction of ISO image and local filesystem.
#
proc init_localfs {} {
  global borderwidth
  global .localfs .extract_frame .localfs_aux_frame .insert_frame

  frame .localfs -borderwidth $borderwidth

  init_extract
  init_localfs_aux
  init_insert

  pack .extract_frame .localfs_aux_frame .insert_frame \
       -in .localfs -side top -expand 1 -fill both
}


# The means for extracting files from ISO image to disk
# 
proc init_extract {} {
  global borderwidth extract_to_adr extract_from_selected extract_underneath
  global .extract_button .extract_frame .extract_entry .extract_from_selected
  global .extract_underneath 

  # >>> should be some file browser instead of a button-entry pair

  frame .extract_frame -borderwidth 0
  button .extract_button -text "Extract to disk:" \
                         -width 17 \
                         -command {extract_to}
  entry .extract_entry -width 40 -relief sunken -bd 1 \
                       -textvariable "extract_to_adr"
  bind_entry_keys .extract_entry {extract_to}
  checkbutton .extract_underneath -text "Underneath" \
                                  -indicatoron 1 -selectcolor "" \
                                  -relief ridge -borderwidth 2 \
                                  -variable extract_underneath \
                                  -onvalue 1 -offvalue 0
  checkbutton .extract_from_selected -text "Selected" \
                                     -indicatoron 1 -selectcolor "" \
                                     -relief ridge -borderwidth 2 \
                                     -variable extract_from_selected \
                                     -onvalue 1 -offvalue 0
  pack .extract_button -in .extract_frame -side left
  pack .extract_entry \
       -in .extract_frame -side left -expand 1 -fill both
  pack .extract_from_selected .extract_underneath \
       -in .extract_frame -side right
}


# Some controls which apply to insertion, extraction, or both.
#
proc init_localfs_aux {} {
  global borderwidth
  global .localfs_aux_frame
  global .overwrite_files_button .overwrite_dir_button .extract_auto_chmod
  global .avail_label .avail_label_frame .avail_button

  frame .localfs_aux_frame -borderwidth 0
  checkbutton .overwrite_files_button -text "Overwrite files" \
                                      -indicatoron 1 -selectcolor "" \
                                      -relief ridge -borderwidth 2 \
                                      -variable overwrite_files \
                                      -onvalue 1 -offvalue 0
  checkbutton .overwrite_dir_button -text "Overwrite ISO dirs" \
                                      -indicatoron 1 -selectcolor "" \
                                      -relief ridge -borderwidth 2 \
                                      -variable overwrite_dirs \
                                      -onvalue 1 -offvalue 0
  checkbutton .extract_auto_chmod   -text "Enforce disk dir write access" \
                                      -indicatoron 1 -selectcolor "" \
                                      -relief ridge -borderwidth 2 \
                                      -variable extract_auto_chmod \
                                      -onvalue 1 -offvalue 0
  pack .overwrite_files_button .overwrite_dir_button .extract_auto_chmod \
       -in .localfs_aux_frame -side left

  button .avail_button -text "Refresh avail:" \
                             -command {refresh_avail}
  frame .avail_label_frame -relief ridge -borderwidth 2
  label .avail_label -width 10 -text ""
  pack .avail_label -in .avail_label_frame

  pack .avail_label_frame .avail_button -in .localfs_aux_frame -side right
}


# The means for inserting files from disk into the ISO image
# 
proc init_insert {} {
  global borderwidth insert_from_adr insert_at_selected insert_underneath
  global .insert_button .insert_from_frame .insert_entry .insert_at_selected
  global .insert_underneath .insert_frame

  # >>> should be some file browser instead of a button-entry pair

  frame .insert_frame -borderwidth 0
  frame .insert_from_frame -borderwidth 0
  button .insert_button -text "Insert from disk:" \
                        -width 17 \
                        -command {insert_from}
  entry .insert_entry -width 40 -relief sunken -bd 1 \
                      -textvariable "insert_from_adr"
  bind_entry_keys .insert_entry {insert_from}
  checkbutton .insert_underneath -text "Underneath" \
                                 -indicatoron 1 -selectcolor "" \
                                 -relief ridge -borderwidth 2 \
                                 -variable insert_underneath \
                                 -onvalue 1 -offvalue 0
  checkbutton .insert_at_selected -text "Selected" \
                                  -indicatoron 1 -selectcolor "" \
                                  -relief ridge -borderwidth 2 \
                                  -variable insert_at_selected \
                                  -onvalue 1 -offvalue 0
  pack .insert_button -in .insert_from_frame -side left
  pack .insert_entry \
       -in .insert_from_frame -side left -expand 1 -fill both
  pack .insert_at_selected .insert_underneath \
       -in .insert_from_frame -side right
  pack .insert_from_frame -in .insert_frame -side left -expand 1 -fill both
}


# Set common behavior of listboxes in respect to focus and navigation keys.
#
proc bind_listbox_keys {box height} {
  global click_to_focus

  if {"$click_to_focus" == 1} {
    bind $box <1> "focus \"$box\""
    bind $box <2> "focus \"$box\""
    bind $box <3> "focus \"$box\""
  } else {
    bind $box <Enter> "focus \"$box\""
  }

  # No underlining
  $box configure -activestyle none

  # Need to evaluate all $box and $height at bind-time. Thus "-quotes.
  bind $box <Any-KeyPress> "

    # <<<
    # puts stderr \"bind_updown_keys: K = '%K'\"

    if {\"%K\" == \"Up\"} {
      $box yview scroll \"-1\" units
    }
    if {\"%K\" == \"Down\"} {
      $box yview scroll 1 units
    }
    if {\"%K\" == \"Prior\"} {
      $box yview scroll -[expr \"$height\" - 1] units
    }
    if {\"%K\" == \"Next\"} {
      $box yview scroll [expr \"$height\" - 1] units
    }
    if {\"%K\" == \"Home\"} {
      $box yview 0
    }
    if {\"%K\" == \"End\"} {
      $box yview end
    }
    # Prevent other bindings from being performed
    break
  "
}


# Set common behavior of entries in respect to focus and Return key.
#
proc bind_entry_keys {entry return_cmd} {
  global click_to_focus

  if {"$click_to_focus" != 1} {
    bind $entry <Enter> "focus \"$entry\""
  }
  if {"$return_cmd" != ""} {
    bind $entry <Return> "$return_cmd"
  }
}


# ------- Misc helper procedures -------


# Equip a text with quotation marks so that xorriso will consider it as
# a single word.
#
proc make_text_shellsafe {text} {
  set result "'"
  set rest "$text"
  while {[string length "$rest"]} {
    set idx [string first "'" "$rest"]
    if {"$idx" == -1} {
      set result "$result$rest"
  break
    } else {
      if {"$idx" > 0} {
        set result "$result[string range "$rest" 0 [expr "$idx" - 1]]"
      }
      set result "$result'\"'\"'"
      if {"$idx" == [expr [string length "$rest"] - 1]} {
  break
      }
      set rest [string range "$rest" [expr "$idx" + 1] end]
    }
  }
  set result "$result'"
}


# Count the number of newline chracters in text.
#
proc count_newlines {text} {
  set rest "$text"
  set count 0
  while {[string length "$rest"]} {
    set idx [string first "\n" "$rest"]
    if {"$idx" == -1} {
  break
    } else {
      set count [expr "$count" + 1]
      if {"$idx" == [expr [string length "$rest"] - 1]} {
  break
      }
      set rest [string range "$rest" [expr "$idx" + 1] end]
    }
  }
}


# Append name to dir so that the result is a path to name under dir.
#
proc combine_dir_and_name {dir name} {
  set has_slash 0
  if {"$name" == ""} {
    return "$dir"
  }
  if {[string range "$name" 0 0] == "/"} {
    incr has_slash
  }
  if {[string last "/" "$dir"] == [expr [string length "$dir"] - 1] &&
      "$dir" != ""} {
    incr has_slash 1
  }
  if {"$has_slash" == 2} {
    return "$dir[string range $name" 1 end]"
  }
  if {"$has_slash" == 1} {
    return "$dir$name"
  }
  return "$dir/$name"
}


# Force the content of variable isodir_adr to be an absolute address
#
proc normalize_isodir_adr {} {
  global isodir_adr

  if {"$isodir_adr" == ""} {
    set isodir_adr "/"
  }
  if {[string range "$isodir_adr" 0 0] != "/"} {
    set isodir_adr "/$isodir_adr"
  }
}


# Inspect path whether one of its components is in isodir_adr
#
proc path_touches_isodir {path} {
  global isodir_adr

  # <<<
  # puts stderr "path_touches_isodir : '$path'" 

  normalize_isodir_adr
  set cmp_start 0
  if {"$isodir_adr" == "/"} {
    set cmp_start 1
  }
  if {[string range "$path" 0 0] != "/"} {
    if {[string first "/" "$path"] == -1} {
      return "$path"
    } else {
      return [file dirname "$path"]
    }
  }
  set l [expr {[string length "$isodir_adr"] - $cmp_start}]
  if {[string length "$path"] < [expr {$l + 2}]} {

    # <<<
    # puts stderr "path_touches_isodir : shorter than [expr {$l + 2}]" 

    return ""
  }
  if {$l > 0} { 
    if {[string range "$path" $cmp_start [expr {$l - 1}]] != \
        [string range "$isodir_adr" $cmp_start end]} {

      # <<<
      # puts stderr "path_touches_isodir : start does not match" 

      return ""
    }
  }
  if {[string range "$path" "$l" "$l"] != "/"} {

    # <<<
    # puts stderr "path_touches_isodir : start not followed by /" 

    return ""
  }
  set subpath [string range "$path" [expr {$l + 1}] end]
  set slash [string first "/" "$subpath"]
  if {"$slash" == -1} {
    return "$subpath"
  }
  if {"$slash" == 0} {

    # <<<
    # puts stderr "path_touches_isodir : subpath begins by / : '$subpath'" 

    return ""
  }
  return [string range "$subpath" 0 [expr {$slash - 1}]]
}


# Compare two severity names by help of the severity list that was obtained
# from xorriso via proc inquire_severity_list.
#
proc compare_sev {sev1 sev2} {
  global xorriso_severity_list

  set idx1 [lsearch -exact "$xorriso_severity_list" "$sev1"]
  set idx2 [lsearch -exact "$xorriso_severity_list" "$sev2"]
  if {$idx1 < $idx2} {return -1}
  if {$idx1 > $idx2} {return 1}
  return 0
}


# Write a text to the pipe log
#
proc log_puts {text} {
  global logging log_conn

  if {"$logging" == 1} {
    puts $log_conn "$text"
  }
}


# End program and return the given exit value.
#
proc central_exit {value} {
  exit $value
}

 
# -------- start living


proc setup_by_args {argv0 argv} {
  global cmd_pipe_adr reply_pipe_adr main_window_geometry click_to_focus
  global log_file log_conn logging
  global cmd_conn reply_conn
  global geometry stdout stdin

  # wish normally eats the -geometry option and puts the result into $geometry
  catch {set main_window_geometry "$geometry"}

  set connection_defined 0

  set loop_limit [llength "$argv"]
  for {set i 0} {"$i" < "$loop_limit"} {incr i} {
    set ok "0"
    set opt [lrange "$argv" "$i" "$i"]
    if {"$opt" == "--help"} {
      set ok "1"
      print_usage "$argv0"
      central_exit 0
    }
    if {"$opt" == "--stdio"} {
      set ok "1"
      set connection_defined 1
    }
    if {"$opt" == "--named_pipes"} {
      set ok "1"
      incr i
      set cmd_pipe_adr [lrange "$argv" "$i" "$i"]
      incr i
      set reply_pipe_adr [lrange "$argv" "$i" "$i"]
      if {"$cmd_pipe_adr" != "" && "$reply_pipe_adr" != "" &&
          "$cmd_pipe_adr" != "-" && "$reply_pipe_adr" != "-"} {
        init_frontend_named_pipes "$cmd_pipe_adr" "$reply_pipe_adr"
      }
      set connection_defined 1
    }
    if {"$opt" == "--geometry" || "$opt" == "-geometry"} {
      set ok "1"
      # Just in case -geometry does not get eaten by wish
      incr i
      set main_window_geometry [lrange "$argv" "$i" "$i"]
    }
    if {"$opt" == "--click_to_focus"} {
      set ok "1"
      set click_to_focus "1"
    }
    if {"$opt" == "--auto_focus"} {
      set ok "1"
      set click_to_focus "0"
    }
    if {"$opt" == "--log_file"} {
      set ok "1"
      incr i
      set log_file [lrange "$argv" "$i" "$i"]
      if {"$log_file" == "" || "$log_file" == "-"} {
        set log_conn stderr
      } else {
        set log_conn ""
        catch {set log_conn [open "$log_file" a]}
        if {"$log_conn" == ""} {
          puts stderr "$argv0 : Cannot open -log_file '$log_file' for writing"
          central_exit 2
        }
      }
      set logging "1"
    }
    if {"$ok" == 0} {
      puts stderr "$argv0 : Unknown option '$opt'"
      print_usage "$argv0"
      central_exit 1
    }
  }

  if {"$connection_defined" == 0} {
    puts stderr "$argv0 : Either --stdio or --named_pipes must be given for a program run.\n"
    print_usage "$argv0"
    central_exit 1
  }

  if {"$cmd_pipe_adr" == "" || "$reply_pipe_adr" == "" ||
      "$cmd_pipe_adr" == "-" || "$reply_pipe_adr" == "-"} {
    set cmd_conn stdout
    set reply_conn stdin
  }
  if {"$main_window_geometry" != ""} {
    wm geometry . "$main_window_geometry"
  }
}


puts stderr "xorriso-tcltk $own_version : Proof of concept for GUI frontends\n"

setup_by_args "$argv0" "$argv"
check_xorriso_version
setup_xorriso

init_gui

display_busy 0
refresh_state