diff --git a/frontend/xorriso-tcltk b/frontend/xorriso-tcltk index 9417fd93..9c280895 100755 --- a/frontend/xorriso-tcltk +++ b/frontend/xorriso-tcltk @@ -60,9 +60,14 @@ proc print_usage {argv0} { puts stderr " --auto_focus" puts stderr " Chooses that the keyboard focus is where the mouse" puts stderr " pointer is." - puts stderr " --log_file path" + puts stderr " --pipe_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 " reply messages and enable this logging." + puts stderr " The log lines will be appended. Path \"-\" means stderr." + puts stderr " --script_log_file path" + puts stderr " Set a file address for logging of major xorriso commands" + puts stderr " and immediately enable this logging." + puts stderr " The log lines will be appended. Path \"-\" means stderr." puts stderr "" puts stderr "If neither --stdio nor --named_pipes is given, then this script" puts stderr "will try to locate itself in the filesystem and start a xorriso" @@ -168,15 +173,24 @@ set overwrite_iso_dirs 0 set overwrite_disk_files 0 # The file where to log commands and replies for debugging purposes -set log_file "" -set log_conn stderr +set debug_log_file "" +set debug_log_conn stderr -# Whether to log all commands and replies to the log_file -set logging 0 +# Whether to log all commands and replies to the debug_log_file +set debug_logging 0 # The result of the most recent isofs_ls run set isofs_ls_result "" +# The communication channel where to log files (if it is not the empty text) +set cmd_log_conn "" + +# The address under which cmd_log_conn was opened +set cmd_log_target "" + +# Whether to log essential commands: 0=off , 1=no extract , 2=with extract +set cmd_logging_mode 0 + # xorriso specific constants @@ -208,12 +222,13 @@ proc init_frontend_named_pipes {cmd_pipe reply_pipe} { # 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 + global cmd_sent cmd_conn debug_logging debug_log_conn display_busy 1 - log_puts " ==============================================================" - log_puts " $cmd" + debug_log_puts \ + " ==============================================================" + debug_log_puts " $cmd" display_msg "======> $cmd" incr cmd_sent puts $cmd_conn $cmd @@ -230,13 +245,21 @@ proc send_marked_cmd {cmd} { send_async_cmd $cmd incr mark_count set mark_cmd "-mark $mark_count" - log_puts " $mark_cmd" + debug_log_puts " $mark_cmd" puts $cmd_conn $mark_cmd flush $cmd_conn await_all_replies } +# Send a command and make it a candidate for the log script +# +proc send_loggable_cmd {cmd} { + log_command $cmd + send_marked_cmd $cmd +} + + # Wait for the currently pending mark message to arrive. # Buffer all received result lines and info messages. # @@ -255,7 +278,7 @@ proc await_all_replies {} { } break } - log_puts $line + debug_log_puts $line if {[string range $line 0 0] == "M"} { if {[string range $line 5 end] == $mark_count} { break @@ -407,7 +430,7 @@ proc wait_for_msg {prefix channel} { if {$ret < 0} { break } - log_puts $line + debug_log_puts $line if {[string length $line] < $prefix_l} { display_msg $line continue @@ -759,39 +782,48 @@ proc setup_xorriso {} { # 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 -return_with ABORT 32" set cmd "$cmd -report_about UPDATE" set cmd "$cmd -osirrox on" set cmd "$cmd -iso_rr_pattern off" set cmd "$cmd -disk_pattern off" - set cmd "$cmd -follow mount:limit=100" send_marked_cmd $cmd + send_marked_cmd [xorriso_loggable_init_cmds] + inquire_severity_list } +# Commands which should also be at the start of a log script +# +proc xorriso_loggable_init_cmds {} { + set 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 -follow mount:limit=100" + return $cmd +} + + proc effectuate_permission_policy {} { global permission_policy if {$permission_policy == "readable"} { - send_marked_cmd \ + send_loggable_cmd \ "-find / -exec chmod a+r -- -find / -type d -exec chmod a+x --" } if {$permission_policy == "readonly"} { - send_marked_cmd \ + send_loggable_cmd \ "-find / -exec chmod a=r -- -find / -type d -exec chmod a+x --" } if {$permission_policy == "mkisofs_r"} { - send_marked_cmd \ + send_loggable_cmd \ "-find / -exec mkisofs_r" } } @@ -850,10 +882,10 @@ proc submit_bulkparse {text} { set cmd "-msg_op parse \"$bulk_parse_prefix $bulk_parse_separators $bulk_parse_max_words $bulk_parse_flag $num_lines\"" send_async_cmd $cmd } else { - log_puts ">>>>> $num_lines" + debug_log_puts ">>>>> $num_lines" puts $cmd_conn $num_lines } - log_puts ">>>>> $text" + debug_log_puts ">>>>> $text" puts $cmd_conn $text flush $cmd_conn @@ -862,7 +894,7 @@ proc submit_bulkparse {text} { while {$result_count < $loop_limit} { set ret [gets $reply_conn line] if {$ret < 0} { return ""} - log_puts $line + debug_log_puts $line de_pkt_line $line if {$result_count == 1} { set parse_ret [lindex $result_list 0] @@ -907,7 +939,7 @@ proc read_parse_reply {} { while {$result_count < $loop_limit} { set ret [gets $reply_conn line] if {$ret < 0} { return ""} - log_puts $line + debug_log_puts $line de_pkt_line $line if {$result_count == 1} { set parse_ret [lindex $result_list 0] @@ -1072,12 +1104,16 @@ set browse_disk_window_is_active 0 set browse_disk_window_var "" # Position of window when it was last closed set browse_disk_window_geometry "" +# Whether the window is grabbed +set browse_disk_window_is_grabbed 0 # Whether the .browse_iso_window is already displayed set browse_iso_window_is_active 0 set browse_iso_window_var "" # Position of window when it was last closed set browse_iso_window_geometry "" +# Whether the window is grabbed +set browse_iso_window_is_grabbed 0 # Whether to bring the selected browser item directly into the text field set browse_select_is_setvar 0 @@ -1100,7 +1136,7 @@ proc cmdline_return {} { reset_highest_cmd_sev set_display_msg 1 - send_marked_cmd $cmdline + send_loggable_cmd $cmdline set cmdline "" # To force display of GUI changes now and not some time later @@ -1121,7 +1157,7 @@ proc indev_return {} { return "0" } reset_highest_cmd_sev - send_marked_cmd "-indev [make_text_shellsafe $indev_adr]" + send_loggable_cmd "-indev [make_text_shellsafe $indev_adr]" set indev_mem_adr $indev_adr .indev_entry icursor 0 refresh_indev @@ -1134,7 +1170,7 @@ proc indev_return {} { proc eject_indev {} { if {[assert_no_changes] == 0} {return ""} reset_highest_cmd_sev - send_marked_cmd "-eject indev" + send_loggable_cmd "-eject indev" refresh_outdev refresh_indev } @@ -1148,7 +1184,7 @@ proc outdev_return {} { global .outdev_entry reset_highest_cmd_sev - send_marked_cmd "-outdev [make_text_shellsafe $outdev_adr]" + send_loggable_cmd "-outdev [make_text_shellsafe $outdev_adr]" set outdev_mem_adr $outdev_adr .outdev_entry icursor 0 refresh_outdev @@ -1165,7 +1201,7 @@ proc eject_outdev {} { if {[assert_no_changes] == 0} {return ""} } reset_highest_cmd_sev - send_marked_cmd "-eject outdev" + send_loggable_cmd "-eject outdev" refresh_outdev refresh_indev } @@ -1186,7 +1222,7 @@ proc dev_return {} { return "0" } reset_highest_cmd_sev - send_marked_cmd "-dev [make_text_shellsafe $outdev_adr]" + send_loggable_cmd "-dev [make_text_shellsafe $outdev_adr]" .outdev_entry icursor 0 refresh_outdev .indev_entry icursor 0 @@ -1277,7 +1313,7 @@ proc scan_for_drives {} { reset_highest_cmd_sev clear_sieve - send_marked_cmd "-devices" + send_loggable_cmd "-devices" set max_idx 0 while {1} { read_sieve "? -dev" @@ -1432,7 +1468,7 @@ proc isodir_return {caller} { 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]" + send_loggable_cmd "-cd [make_text_shellsafe $isodir_adr]" if {[compare_sev $highest_cmd_sev "WARNING"] < 0} { send_marked_cmd "-lsl --" set isodir_is_pwd 1 @@ -1602,7 +1638,7 @@ proc isomanip_mv {} { if {$multi_source == 0} { return "" } continue } - send_marked_cmd "-mv [make_text_shellsafe $name] [make_text_shellsafe $target] --" + send_loggable_cmd "-mv [make_text_shellsafe $name] [make_text_shellsafe $target] --" } if {[llength $selected] == 1} { @@ -1632,7 +1668,7 @@ proc isomanip_mkdir {} { 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] --" + send_loggable_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 @@ -1675,7 +1711,7 @@ proc isomanip_rm_r {} { if {$isodir_is_pwd == 0} { set name [combine_dir_and_name $isodir_adr $name] } - send_marked_cmd "-rm_r [make_text_shellsafe $name] --" + send_loggable_cmd "-rm_r [make_text_shellsafe $name] --" } browse_iso_refresh isodir_return "isomanip_rm_r" @@ -1698,7 +1734,7 @@ proc burn_blank {} { "Really blank the $victim [make_text_shellsafe $outdev_adr] ?"] \ != 1} { return "" } reset_highest_cmd_sev - send_marked_cmd "-blank as_needed" + send_loggable_cmd "-blank as_needed" refresh_indev refresh_outdev } @@ -1721,7 +1757,7 @@ proc burn_format {} { != 1} { return "" } reset_highest_cmd_sev - send_marked_cmd "-format as_needed" + send_loggable_cmd "-format as_needed" refresh_indev refresh_outdev } @@ -1767,8 +1803,7 @@ proc burn_commit {} { reset_highest_cmd_sev effectuate_permission_policy - set cmd "" - set cmd "$cmd -close" + set cmd "-close" if {$burn_write_close == 1} { set cmd "$cmd on" } else { @@ -1787,7 +1822,7 @@ proc burn_commit {} { set cmd "$cmd data" } set cmd "$cmd -commit" - send_marked_cmd $cmd + send_loggable_cmd $cmd refresh_indev refresh_outdev } @@ -1801,7 +1836,7 @@ proc isodir_verify {} { global isodir_adr reset_highest_cmd_sev - send_marked_cmd "-check_md5_r sorry [make_text_shellsafe $isodir_adr] --" + send_loggable_cmd "-check_md5_r sorry [make_text_shellsafe $isodir_adr] --" # >>> select mismatching files or directories with mismatching files @@ -1826,7 +1861,7 @@ proc isomanip_verify {} { 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] --" + send_loggable_cmd "-check_md5_r sorry [make_text_shellsafe $name] --" } # >>> select mismatching files or directories with mismatching files @@ -1839,7 +1874,7 @@ proc isomanip_verify {} { # proc calm_drives {} { reset_highest_cmd_sev - send_marked_cmd "-calm_drive all" + send_loggable_cmd "-calm_drive all" } @@ -1898,7 +1933,7 @@ proc burn_write_image {} { set cmd "$cmd stream_recording=32s" } reset_highest_cmd_sev - send_marked_cmd $cmd + send_loggable_cmd $cmd refresh_state } @@ -1911,7 +1946,7 @@ proc iso_rollback {} { "Really discard all pending changes and reload from input drive ?"] \ != 1} { return "" } reset_highest_cmd_sev - send_marked_cmd "-rollback" + send_loggable_cmd "-rollback" .avail_label configure -text "" isodir_return "iso_rollback" } @@ -2072,7 +2107,7 @@ proc insert_from {} { } reset_highest_cmd_sev enforce_overwrite_settings "isofs" - send_marked_cmd "-map [make_text_shellsafe $insert_from_adr] [make_text_shellsafe $target]" + send_loggable_cmd "-map [make_text_shellsafe $insert_from_adr] [make_text_shellsafe $target]" if {$preserve_selection == 1} { memorize_isolist_selection @@ -2124,9 +2159,9 @@ proc extract_to {} { enforce_overwrite_settings "localfs" set disp_en_mem [set_display_msg 0] if {$extract_auto_chmod == 1} { - send_marked_cmd "-osirrox on:sort_lba_on:auto_chmod_on" + send_loggable_cmd "-osirrox on:sort_lba_on:auto_chmod_on" } else { - send_marked_cmd "-osirrox on:sort_lba_off:auto_chmod_off" + send_loggable_cmd "-osirrox on:sort_lba_off:auto_chmod_off" } set_display_msg $disp_en_mem set multi_source 0 @@ -2153,7 +2188,7 @@ proc extract_to {} { "" ""] == 0} { continue } - send_marked_cmd \ + send_loggable_cmd \ "-extract [make_text_shellsafe $i] [make_text_shellsafe $target]" } browse_tree_populate "localfs" @@ -2188,7 +2223,7 @@ proc enforce_overwrite_settings {which_fs} { } } set disp_en_mem [set_display_msg 0] - send_marked_cmd "-overwrite $mode" + send_loggable_cmd "-overwrite $mode" set_display_msg $disp_en_mem } @@ -2206,10 +2241,10 @@ proc end_xorriso {} { "Changes of the ISO image are pending.\nReally discard them ?"] \ != 1} { return "" } set expect_broken_pipes "1" - send_marked_cmd "-rollback_end" + send_loggable_cmd "-rollback_end" } else { set expect_broken_pipes "1" - send_marked_cmd "-end" + send_loggable_cmd "-end" } central_exit 0 } @@ -2259,6 +2294,149 @@ proc show_permission_policy {} { } +# Start command logging +# Called by setup_by_args and by the "Script/Log" menu. +# (target == "." and mode == -1 preserve the current state.) +# +proc start_command_logging {target mode} { + global cmd_log_conn cmd_logging_mode msglist_running cmd_log_target + global .script_log.menu + + set is_stderr 0 + if {$cmd_log_target == "" || $cmd_log_target == "-" || \ + $cmd_log_conn == "stderr"} {set is_stderr 1} + set errmsg "" + if {$target != "." && $cmd_log_conn != "" && $target != $cmd_log_target && \ + $is_stderr == 0} { + catch "close $cmd_log_conn" + set cmd_log_conn "" + } + set ret 0 + if {$cmd_log_conn == "" || $is_stderr == 1} { + if {$target == "-" || $target == "" || $target == "."} { + set cmd_log_conn stderr + } else { + set ret [catch {set cmd_log_conn [open $target a]} errmsg] + } + if {$target != "."} { + set cmd_log_target $target + } + } + if {$ret == 0 && $mode >= 0} { + set cmd_logging_mode $mode + } + if {$ret == 1} { + set msg "xorriso-tcltk : SORRY : Failed to open command log script [make_text_shellsafe $target] :\n$errmsg" + if {$msglist_running == 1} { + xorriso_tcltk_errmsg $msg + } else { + puts stderr $msg + } + return 0 + } + if {$mode > 0} { + puts $cmd_log_conn "# xorriso-tcltk command log script" + puts $cmd_log_conn [xorriso_loggable_init_cmds] + } + return 1 +} + + +# Start communications pipe logging +# Called by setup_by_args and by the "Script/Log" menu. +# (target == "." and mode == -1 preserve the current state.) +# +proc start_debug_logging {target mode} { + global debug_log_conn debug_log_file debug_logging msglist_running + global .script_log.menu + + set is_stderr 0 + if {$debug_log_file == "" || $debug_log_file == "-" || \ + $debug_log_conn == "stderr"} {set is_stderr 1} + set errmsg "" + if {$target != "." && $debug_log_conn != "" && \ + $target != $debug_log_file && $is_stderr == 0} { + catch "close $debug_log_conn" + set debug_log_conn "" + } + set ret 0 + if {$debug_log_conn == "" || $is_stderr == 1} { + if {$target == "-" || $target == "" || $target == "."} { + set debug_log_conn stderr + } else { + set ret [catch {set debug_log_conn [open $target a]} errmsg] + } + if {$target != "."} { + set debug_log_file $target + } + } + if {$ret == 0 && $mode >= 0} { + set debug_logging $mode + } + if {$ret == 1} { + set msg "xorriso-tcltk : SORRY : Failed to open pipe log [make_text_shellsafe $target] :\n$errmsg" + if {$msglist_running == 1} { + xorriso_tcltk_errmsg $msg + } else { + puts stderr $msg + } + return 0 + } + return 1 +} + + +# Set the target address of command logging. +# Called by the "Script/Log" menu. +# +proc set_log_script_address {} { + browse_tree cmd_log_target "localfs" + set w .browse_disk_window + tkwait window $w + effectuate_command_logging 0 +} + + +# Bring into effect the settings for command script logging. +# Called by the "Accept" button or the Return key of the +# "Set log script address" file browser. +# +proc effectuate_command_logging {close_window} { + global cmd_log_target cmd_logging_mode browse_disk_window_is_active + + if {$close_window == 1 && $browse_disk_window_is_active == 1} { + destroy_browse_disk .browse_disk_window + } + start_command_logging $cmd_log_target $cmd_logging_mode +} + + +# Set the target address of communication pipe logging. +# Called by the "Script/Log" menu. +# +proc set_debug_log_address {} { + browse_tree debug_log_file "localfs" + set w .browse_disk_window + tkwait window $w + effectuate_debug_logging 0 +} + + +# Bring into effect the settings for communication pipe logging. +# Called by the "Accept" button or the Return key of the +# "Set pipe log address" file browser. +# +proc effectuate_debug_logging {close_window} { + global debug_log_file debug_logging browse_disk_window_is_active + + if {$close_window == 1 && $browse_disk_window_is_active == 1} { + destroy_browse_disk .browse_disk_window + } + start_debug_logging $debug_log_file $debug_logging +} + + + # ------ A primitive file tree browser for hard disk filesystem and ISO model # Write a directory content list into a Tree widget @@ -2300,7 +2478,8 @@ proc browse_tree_select {adr_var_name tr selected} { # proc browse_tree_accept {adr_var_name do_return tr selected} { global extract_to_adr insert_from_adr burn_write_image_adr isodir_adr - global isomanip_move_target indev_adr outdev_adr + global isomanip_move_target indev_adr outdev_adr cmd_log_target + global debug_log_file if {[llength $selected] == 0} { set value "" @@ -2325,7 +2504,7 @@ proc browse_tree_accept {adr_var_name do_return tr selected} { } if {$adr_var_name == "isomanip_move_target"} { set isomanip_move_target $value - # No do_return because the field is shared between buttons + if {$do_return == 1} {isomanip_mv} } if {$adr_var_name == "indev_adr"} { set indev_adr $value @@ -2335,6 +2514,48 @@ proc browse_tree_accept {adr_var_name do_return tr selected} { set outdev_adr $value if {$do_return == 1} {outdev_return} } + if {$adr_var_name == "cmd_log_target"} { + set cmd_log_target $value + if {$do_return == 1} {effectuate_command_logging 1} + } + if {$adr_var_name == "debug_log_file"} { + set debug_log_file $value + if {$do_return == 1} {effectuate_debug_logging 1} + } +} + + +# Translate a browser tree variable in a human readable topic text +# +proc browse_tree_topic {adr_var_name} { + if {$adr_var_name == "burn_write_image_adr"} { + return "Burn image file:" + } + if {$adr_var_name == "extract_to_adr"} { + return "Extract to disk:" + } + if {$adr_var_name == "insert_from_adr"} { + return "Insert from disk:" + } + if {$adr_var_name == "isodir_adr"} { + return "ISO directory:" + } + if {$adr_var_name == "isomanip_move_target"} { + return "Move to:" + } + if {$adr_var_name == "indev_adr"} { + return "Input drive/image" + } + if {$adr_var_name == "outdev_adr"} { + return "Output drive/image" + } + if {$adr_var_name == "cmd_log_target"} { + return "Set log script address" + } + if {$adr_var_name == "debug_log_file"} { + return "Set pipe log address" + } + return $adr_var_name } @@ -2351,6 +2572,19 @@ proc browse_tree_accept_sel {adr_var_name do_return tr} { } +# Hit the Return key on the text entry of the browser +# +proc browse_tree_accept_entry {adr_var_name do_return tr} { + global extract_to_adr insert_from_adr burn_write_image_adr isodir_adr + global isomanip_move_target indev_adr outdev_adr cmd_log_target + global debug_log_file + + eval set text $$adr_var_name + set selected [list $text] + browse_tree_accept $adr_var_name $do_return $tr $selected +} + + # Move up one directory level of the file browser selection # proc browse_tree_up {adr_var_name tr which_fs} { @@ -2459,7 +2693,13 @@ proc browse_tree_help {about_what button_color from_item} { # proc destroy_browse_disk {w} { global browse_disk_window_is_active browse_disk_window_geometry + global browse_disk_window_is_grabbed + if {$w != "" && $browse_disk_window_is_active == 1} { + if {$browse_disk_window_is_grabbed == 1} { + grab release $w + } + set browse_disk_window_is_grabbed 0 set browse_disk_window_geometry [wm geometry $w] destroy $w } @@ -2498,9 +2738,14 @@ proc browse_iso_open_dir {tr name} { # proc destroy_browse_iso {w} { global browse_iso_window_is_active browse_iso_window_geometry + global browse_iso_window_is_grabbed if {$w != "" && $browse_iso_window_is_active == 1} { set browse_iso_window_geometry [wm geometry $w] + if {$browse_iso_window_is_grabbed == 1} { + grab release $w + } + set browse_iso_window_is_grabbed 0 destroy $w } set browse_iso_window_is_active 0 @@ -2569,46 +2814,66 @@ proc browse_tree {adr_var which_fs} { set re_use_widgets 1 } if {$re_use_widgets == 0} { - # BWidget Tree - frame $w.tree_frame - frame $w.tree_frame_x - Tree $w.tree -width $tree_window_width -height $tree_window_lines \ - -opencmd "$open_dir_cmd $w.tree" \ - -closecmd "browse_tree_close_dir $w.tree" \ - -selectcommand "browse_tree_select $adr_var" \ - -selectfill 1 \ - -yscrollcommand "browse_tree_yscrollcommand $w" \ - -xscrollcommand "$w.treescroll_x set" - # ??? why doesn't work ? - # $w.tree bindText "browse_tree_accept $adr_var 1 $w.tree" + if {$have_bwidget == 1} { + # BWidget Tree + frame $w.tree_frame + frame $w.tree_frame_x + Tree $w.tree -width $tree_window_width -height $tree_window_lines \ + -opencmd "$open_dir_cmd $w.tree" \ + -closecmd "browse_tree_close_dir $w.tree" \ + -selectcommand "browse_tree_select $adr_var" \ + -selectfill 1 \ + -yscrollcommand "browse_tree_yscrollcommand $w" \ + -xscrollcommand "$w.treescroll_x set" - # At least double-click does work - $w.tree bindText "browse_tree_accept $adr_var 1 $w.tree" + # ??? why doesn't work ? + # $w.tree bindText "browse_tree_accept $adr_var 1 $w.tree" - $w.tree bindText {browse_tree_help "Browse tree" grey} + # At least double-click does work + $w.tree bindText "browse_tree_accept $adr_var 1 $w.tree" - scrollbar $w.treescroll_y_l -command "$w.tree yview" - scrollbar $w.treescroll_y_r -command "$w.tree yview" - scrollbar $w.treescroll_x -orient horizontal -command "$w.tree xview " - pack $w.tree -in $w.tree_frame_x -side top -expand 1 -fill both - pack $w.treescroll_x -in $w.tree_frame_x -side top -fill x - pack $w.treescroll_y_l $w.tree_frame_x $w.treescroll_y_r \ - -in $w.tree_frame -side left -expand 1 -fill both + $w.tree bindText {browse_tree_help "Browse tree" grey} - frame $w.button_line - button $w.accept -text "Accept" -width $tree_window_button_width \ - -command "browse_tree_accept_sel $adr_var 1 $w.tree" - bind_help $w.accept "Accept (browse tree)" - button $w.to_field -text "Edit" -width $tree_window_button_width \ - -command "browse_tree_accept_sel $adr_var 0 $w.tree" - bind_help $w.to_field "Edit (browse tree)" - button $w.up -text "Up" -width $tree_window_button_width \ - -command "browse_tree_up $adr_var $w.tree $which_fs" - bind_help $w.up "Up (browse tree)" - button $w.down -text "Down" -width $tree_window_button_width \ - -command "browse_tree_down $adr_var $w.tree $which_fs" - bind_help $w.down "Down (browse tree)" + scrollbar $w.treescroll_y_l -command "$w.tree yview" + scrollbar $w.treescroll_y_r -command "$w.tree yview" + scrollbar $w.treescroll_x -orient horizontal -command "$w.tree xview " + pack $w.tree -in $w.tree_frame_x -side top -expand 1 -fill both + pack $w.treescroll_x -in $w.tree_frame_x -side top -fill x + pack $w.treescroll_y_l $w.tree_frame_x $w.treescroll_y_r \ + -in $w.tree_frame -side left -expand 1 -fill both + + frame $w.button_line + button $w.accept -text "Accept" -width $tree_window_button_width \ + -command "browse_tree_accept_sel $adr_var 1 $w.tree" + bind_help $w.accept "Accept (browse tree)" + button $w.to_field -text "Edit" -width $tree_window_button_width \ + -command "browse_tree_accept_sel $adr_var 0 $w.tree" + bind_help $w.to_field "Edit (browse tree)" + button $w.up -text "Up" -width $tree_window_button_width \ + -command "browse_tree_up $adr_var $w.tree $which_fs" + bind_help $w.up "Up (browse tree)" + button $w.down -text "Down" -width $tree_window_button_width \ + -command "browse_tree_down $adr_var $w.tree $which_fs" + bind_help $w.down "Down (browse tree)" + button $w.help -text "Help" -width $tree_window_button_width \ + -command {window_help "Browse tree" grey} + bind_help $w.help "Browse tree" + button $w.close -text "Close" -width $tree_window_button_width \ + -command "$destroy_cmd $w" \ + -background $button_color + bind_help $w.close "Close (browse tree)" + pack $w.up $w.down $w.accept $w.to_field $w.help $w.close \ + -in $w.button_line -side left -expand 0 + + pack $w.tree_frame -side top -anchor w + } else { + frame $w.button_line + button $w.accept -text "Accept" -width $tree_window_button_width \ + -command "browse_tree_accept_entry $adr_var 1 $w.tree" + bind_help $w.accept "Accept (browse tree)" + pack $w.accept -in $w.button_line -side left -expand 0 + } button $w.help -text "Help" -width $tree_window_button_width \ -command {window_help "Browse tree" grey} bind_help $w.help "Browse tree" @@ -2616,15 +2881,28 @@ proc browse_tree {adr_var which_fs} { -command "$destroy_cmd $w" \ -background $button_color bind_help $w.close "Close (browse tree)" - pack $w.up $w.down $w.accept $w.to_field $w.help $w.close \ + pack $w.help $w.close \ -in $w.button_line -side left -expand 0 - pack $w.tree_frame $w.button_line -side top -anchor w - focus $w.tree - } else { - raise $w + pack $w.button_line -side top -anchor w + + frame $w.text_frame + label $w.topic -text "[browse_tree_topic $adr_var]" + bind_help $w.topic "Browse tree" + entry $w.text_entry -relief sunken -bd 1 -width 40 \ + -textvariable $adr_var + bind_entry_keys $w.text_entry \ + "browse_tree_accept_entry $adr_var 1 $w.tree" + bind_help $w.text_entry "Browse tree" + pack $w.topic -in $w.text_frame -side left + pack $w.text_entry -in $w.text_frame -side left -expand 1 -fill both + pack $w.text_frame -side top -expand 1 -fill both + } + raise $w + if {$have_bwidget == 1} { + browse_tree_populate $which_fs + focus $w.tree } - browse_tree_populate $which_fs } @@ -2844,7 +3122,9 @@ proc destroy_ack {w had_focus} { if {$w != ""} { set ack_window_geometry [wm geometry $w] grab release $w - focus $had_focus + if {$had_focus != "-"} { + focus $had_focus + } destroy $w update idletasks } @@ -2859,6 +3139,7 @@ proc window_ack {question button_color where} { global continue_from_ack set had_focus [focus] + if {$had_focus == ""} {set had_focus "-"} set re_use_widgets 0 if {$where == "embedded"} { set w "" @@ -3226,7 +3507,8 @@ proc init_gui {} { # command line, and "Refresh disp" button. # proc init_input {} { - global borderwidth busy_text_exists xorriso_version logging + global borderwidth busy_text_exists xorriso_version debug_logging + global cmd_logging_mode cmd_log_target global .input .input_line1 .xorriso_version .busy .busy_text global .refresh_state .end_button .cmdline .log_pipes_switch @@ -3253,12 +3535,25 @@ proc init_input {} { -command "refresh_state" bind_help .refresh_state "Refresh disp" - checkbutton .log_pipes_switch -text "Log pipes" \ - -indicatoron 1 -selectcolor "" \ - -relief ridge -borderwidth 2 \ - -variable logging \ - -onvalue 1 -offvalue 0 - bind_help .log_pipes_switch "Log pipes" + menubutton .script_log -text "Script/Log" -anchor w \ + -direction below -relief ridge -indicatoron 1 \ + -menu .script_log.menu + bind_help .script_log "Script/Log" + set m ".script_log.menu" + menu $m + $m add checkbutton -label "Log command script" \ + -indicatoron 1 -selectcolor "" \ + -variable cmd_logging_mode \ + -onvalue 1 -offvalue 0 + $m add command -label "Set log script address" \ + -command "set_log_script_address" + $m add checkbutton -label "Log pipes" \ + -indicatoron 1 -selectcolor "" \ + -variable debug_logging \ + -onvalue 1 -offvalue 0 + $m add command -label "Set pipe log address" \ + -command "set_debug_log_address" + button .help -text "Help" -command {window_help "Help" "grey"} \ -background "grey" bind_help .help "Help" @@ -3268,7 +3563,7 @@ proc init_input {} { 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 .help -in .input_line1 -side left + pack .refresh_state .script_log .help -in .input_line1 -side left } @@ -3670,16 +3965,17 @@ proc init_isomanip {} { button .isomanip_mkdir_button -text "Make dir" \ -command {isomanip_mkdir} bind_help .isomanip_mkdir_button "Make dir" - entry .isomanip_move_target -width 58 -relief sunken -bd 1 \ + 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 "" + bind_entry_keys .isomanip_move_target {isomanip_mv} bind_help .isomanip_move_target "rename and mkdir target" create_browser_button .isomanip_move_target_button \ "isomanip_move_target" "isofs" "Browse ISO (move target)" pack .isomanip_prefix .isomanip_verify_button .isomanip_rm_r_button \ - .isomanip_move_button .isomanip_move_target \ + .isomanip_move_button \ + -in .isomanip_move -side left + pack .isomanip_move_target \ -in .isomanip_move -side left -expand 1 -fill both pack .isomanip_move_target_button -in .isomanip_move -side left pack .isomanip_mkdir_button \ @@ -3939,7 +4235,9 @@ proc bind_help {to_what help_name} { proc create_browser_button {button_name var_name which_fs help_name} { global have_bwidget - if {$have_bwidget == 1} { +# >>> Remove dummy + + if {1 || $have_bwidget == 1} { button $button_name -text "/" -command "browse_tree $var_name $which_fs" bind_help $button_name $help_name } else { @@ -4190,13 +4488,29 @@ and the frontend is still waiting for its reply messages." "The \"Command:\" field can be used to send commands to xorriso. See the manual page of xorriso for its concepts and commands." } - if {$what == "Log pipes"} { + if {$what == "Script/Log"} { return \ -"The \"Log pipes\" switch controls whether all xorriso commands and replies -shall be logged to standard error resp. to the file that has been given -with program argument --log_file. +"The \"Script/Log\" menu controls logging of xorriso commands and replies. -Caution: This log is verbous." +The \"Log command script\" switch controls whether the essential xorriso +commands of the GUI session shall be written to the end of a script file +on hard disk. Not written will be the commands by which the GUI inspects +the xorriso state, but only those which set up that state and those which +get sent via the \"Command:\" field. + +The item \"Set log script address\" pops up a file tree browser window +which asks for the target of appending to script. Address \"-\" means +standard error. Else it must not yet exist or be a writable data file. + +The \"Log pipes\" switch controls whether all xorriso commands and replies +shall be logged to standard error resp. to the file that has been given +with program argument --pipe_log_file. +Caution: This log is verbous. + +The item \"Set pipe log address\" pops up a file tree browser window +which asks for the target of pipe logging . Address \"-\" means +standard error. Else it must not yet exist or be a writable data file. +" } if {$what == "message box"} { return \ @@ -4760,7 +5074,7 @@ above the \"Selection:\" line. If the respective \"Selected\" switches are enabled, then the ISO selection is source of file extraction and target of file insertion. -In any case it is the old nome of the \"Move to:\" button, the victim +In any case it is the old name of the \"Move to:\" button, the victim of the \"Delete\" button, and the subject of the \"Verify\" button." } if {$what == "Verify (selection)"} { @@ -4806,7 +5120,9 @@ Useful to create a target directory before moving the selection." return \ "The text field between the \"Move to:\" button and the \"Make dir\" button serves both buttons by providing the target address for renaming -resp. directory creation." +resp. directory creation. + +If you hit the Return key in this field, it will trigger \"Mode to:\"." } if {$what == "yes to all"} { return \ @@ -4859,38 +5175,79 @@ to really perform this action. # Tell the general help text of the file browser. # proc tell_file_browser_help {with_separator} { - set sep "" + global have_bwidget + + set text "" if {$with_separator == 1} { - set sep \ + set text \ "-------------------------------------------------------------------------\n\n" } - return \ -"${sep}The file tree browser presents to you a directory tree and -lets you bring into effect one of the file addresses in that tree. + if {$have_bwidget == 1} { -Click on the \"+\" resp. \"-\" nodes to open resp. close directories. + set text \ +"${text}The file tree browser presents to you a directory tree and +lets you bring into effect one of the file addresses in that tree.\n" + + } else { + + set text \ +"${text}Normally the file tree browser would present to you a directory tree +and let you bring into effect one of the file addresses in that tree. + +But the tree view cannot be displayed because Tcl/Tk package \"BWidget\" +is not loaded. + +-------------------------------------------------------------------------\n" + + } + + set text "${text} +The bottom line of the browser window tells the associated text field +in the GUI. E.g. \"ISO directory:\". +Left of this label is a copy of that associated text field. You may edit +its content and bring it into effect by hitting the Return key.\n" + + if {$have_bwidget == 1} { + + set text "${text} +In the tree display click on the \"+\" resp. \"-\" nodes to open resp. +close directories. Double click on an item to bring it into effect with the associated -text field. I.e. double clicking also hits the Return key in that field. +text field. I.e. double clicking also hits the Return key in that field.\n" -The \"Accept\" button does the same with the selected item. + } -The \"To field\" button brings the selected item into the text field + set text "${text} +The \"Accept\" button does the same with the selected item.\n" + + if {$have_bwidget == 1} { + + set text "${text} +The \"Edit\" button brings the selected item into the text field without hitting the Return key. So you may edit the name before hitting Return yourself. The \"Up\" button brings you to the parent directory of the selected item. -The \"Down\" button works like clicking the \"+\" node of the selected item. +The \"Down\" button works like clicking the \"+\" node of the selected item.\n" + } + + set text "${text} The \"Help\" button displays this help text window. -The \"Close\" button closes the browser window. +The \"Close\" button closes the browser window.\n" + if {$have_bwidget == 1} { + + set text "${text} If the \"File browser text field\" switch is enabled then a single click or a cursor movement by the arrow keys brings the selected item into -the associated text field, but does not hit the Return key. -" +the associated text field, but does not hit the Return key." + + } + return $text } @@ -5052,11 +5409,11 @@ proc compare_sev {sev1 sev2} { # Write a text to the pipe log # -proc log_puts {text} { - global logging log_conn +proc debug_log_puts {text} { + global debug_logging debug_log_conn - if {$logging == 1} { - puts $log_conn $text + if {$debug_logging == 1} { + puts $debug_log_conn $text } } @@ -5164,14 +5521,33 @@ proc localfs_ls {dir} { } +# Log a command (if enabled) +# +proc log_command {cmd} { + global cmd_log_conn cmd_logging_mode + + if {$cmd_logging_mode < 1} {return ""} + if {$cmd_log_conn == ""} { + effectuate_command_logging 0 + } + set prefix "" + if {$cmd_logging_mode == 1} { + if {[string first "-osirrox" $cmd] != -1 || \ + [string first "-extract" $cmd] != -1} { + set prefix "# " + } + } + puts $cmd_log_conn $prefix$cmd + flush $cmd_log_conn +} + + # -------- 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 have_bwidget - global cmd_conn reply_conn - global geometry stdout stdin + global have_bwidget cmd_conn reply_conn geometry stdout stdin # wish normally eats the -geometry option and puts the result into $geometry catch {set main_window_geometry $geometry} @@ -5221,21 +5597,27 @@ proc setup_by_args {argv0 argv} { set ok "1" set click_to_focus "0" } - if {$opt == "--log_file"} { + if {$opt == "--pipe_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 name [lrange $argv $i $i] + set ret [start_debug_logging $name 1] + if {$ret <= 0} { + puts stderr \ + "$argv0 : Cannot open --pipe_log_file '$debug_log_file' for writing" + central_exit 2 + } + } + if {$opt == "--script_log_file"} { + set ok "1" + incr i + set name [lrange $argv $i $i] + set ret [start_command_logging $name 1] + if {$ret <= 0} { + puts stderr \ + "$argv0 : Cannot open --script_log_file '$name' for writing" + central_exit 2 } - set logging "1" } if {$opt == "--no_bwidget"} { set ok "1" diff --git a/xorriso/xorriso_timestamp.h b/xorriso/xorriso_timestamp.h index ef20ad18..a4c70bd6 100644 --- a/xorriso/xorriso_timestamp.h +++ b/xorriso/xorriso_timestamp.h @@ -1 +1 @@ -#define Xorriso_timestamP "2013.01.04.094503" +#define Xorriso_timestamP "2013.01.04.140336"