Added a menu for global access permission policy, improved pop-up window positioning

This commit is contained in:
Thomas Schmitt 2013-01-01 13:02:40 +00:00
parent 6895b969cb
commit 448ba3d400
2 changed files with 192 additions and 53 deletions

View File

@ -773,6 +773,24 @@ proc setup_xorriso {} {
}
proc effectuate_permission_policy {} {
global permission_policy
if {"$permission_policy" == "readable"} {
send_marked_cmd \
"-find / -exec chmod a+r -- -find / -type d -exec chmod a+x --"
}
if {"$permission_policy" == "readonly"} {
send_marked_cmd \
"-find / -exec chmod a=r -- -find / -type d -exec chmod a+x --"
}
if {"$permission_policy" == "mkisofs_r"} {
send_marked_cmd \
"-find / -exec mkisofs_r"
}
}
# ------ Parsing by help of xorriso ------
# Parsing by xorriso takes from the frontend the burden to understand
@ -1026,6 +1044,12 @@ set yesno_window_is_active 0
set help_window_is_active 0
set main_help_window_is_active 0
# Positions of above windows when they were last closed
set yesno_window_geometry ""
set ack_window_geometry ""
set help_window_geometry ""
set main_help_window_geometry ""
# Whether the help window already has a scroll bar
set help_window_has_scroll 0
@ -1037,14 +1061,21 @@ set bwidget_version ""
# Whether the .browse_disk_window is already displayed
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 .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 to bring the selected browser item directly into the text field
set browse_select_is_setvar 0
# Whether to modify the ISO file permissions before writing the ISO session
# Policies: as_is , readable , readonly , mkisofs_r
set permission_policy "as_is"
# ------ GUI callback procedures ----
@ -1258,9 +1289,7 @@ proc scan_for_drives {} {
}
}
set devices_scanned 1
set normal_color [.drive_drop_both cget -background]
.drive_scan configure -background "$normal_color"
update idletasks
reset_to_normal_background .drive_scan
# Command -devices drops all aquired drives
refresh_outdev
@ -1693,9 +1722,9 @@ proc burn_format {} {
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
global indev_adr outdev_adr permission_policy
if {[assert_outdev "writing ISO session"] <= 0} {return ""}
if {[assert_outdev "writing an ISO session"] <= 0} {return ""}
if {"$outdev_adr" == "$indev_adr"} {
if {"$outdev_medium_status" != "blank" && \
"$outdev_medium_status" != "appendable"} {
@ -1723,6 +1752,8 @@ proc burn_commit {} {
!= 1} { return "" }
}
reset_highest_cmd_sev
effectuate_permission_policy
set cmd ""
set cmd "$cmd -close"
if {"$burn_write_close" == 1} {
@ -1743,7 +1774,6 @@ proc burn_commit {} {
set cmd "$cmd data"
}
set cmd "$cmd -commit"
reset_highest_cmd_sev
send_marked_cmd "$cmd"
refresh_indev
refresh_outdev
@ -2184,6 +2214,23 @@ proc assert_no_changes {} {
}
# Set the text of the "Permissions:" menubutton
# Called by the radiobuttons in the menu.
#
proc show_permission_policy {} {
global permission_policy
set text "$permission_policy"
if {"$permission_policy" == "as_is"} {
set text "as is"
}
if {"$permission_policy" == "mkisofs_r"} {
set text "mkisofs -r"
}
.perm_policy configure -text "Permissions: $text"
}
# ------ A primitive file tree browser for hard disk filesystem and ISO model
# Write a directory content list into a Tree widget
@ -2204,8 +2251,8 @@ proc browse_tree_fill_dir {tr parent children} {
set adr [combine_dir_and_name "$parent" "$name"]
$tr insert end "$parent_name" "$adr" -text "$name"
if {[string range "$i" 0 0] == "d"} {
set dir_dummy [combine_dir_and_name "$adr" "dir_dummy"]
$tr insert end "$adr" "$dir_dummy" -text "dir_dummy"
set dir_dummy [combine_dir_and_name "$adr" "_"]
$tr insert end "$adr" "$dir_dummy" -text " "
}
}
}
@ -2323,7 +2370,7 @@ proc browse_tree_down {adr_var_name tr which_fs} {
# It replaces the directory content list by a single dummy item.
#
proc browse_tree_close_dir {tr name} {
browse_tree_fill_dir $tr "$name" "{? dir_dummy}"
browse_tree_fill_dir $tr "$name" [list "? "]
}
@ -2383,9 +2430,9 @@ proc browse_tree_help {about_what button_color from_item} {
# Destroy the hard disk browser pop-up window.
#
proc destroy_browse_disk {w} {
global browse_disk_window_is_active
global browse_disk_window_is_active browse_disk_window_geometry
if {"$w" != "" && "$browse_disk_window_is_active" == 1} {
set browse_disk_window_geometry [wm geometry $w]
destroy "$w"
}
set browse_disk_window_is_active 0
@ -2422,9 +2469,10 @@ proc browse_iso_open_dir {tr name} {
# Destroy the ISO browser pop-up window.
#
proc destroy_browse_iso {w} {
global browse_iso_window_is_active
global browse_iso_window_is_active browse_iso_window_geometry
if {"$w" != "" && "$browse_iso_window_is_active" == 1} {
set browse_iso_window_geometry [wm geometry $w]
destroy "$w"
}
set browse_iso_window_is_active 0
@ -2445,10 +2493,10 @@ proc browse_tree {adr_var which_fs} {
global have_bwidget browse_disk_window_is_active browse_iso_window_is_active
global browse_disk_window_var browse_iso_window_var
global tree_window_lines tree_window_width tree_window_button_width
global browse_disk_window_geometry browse_iso_window_geometry
set button_color "grey"
set old_geometry ""
if {"$which_fs" == "isofs"} {
set w {.browse_iso_window}
set window_is_active "$browse_iso_window_is_active"
@ -2456,11 +2504,11 @@ proc browse_tree {adr_var which_fs} {
set open_dir_cmd "browse_iso_open_dir"
set destroy_cmd "destroy_browse_iso"
if {"$browse_iso_window_var" != "$adr_var" && "$window_is_active" == 1} {
set old_geometry [wm geometry $w]
destroy_browse_iso $w
set window_is_active 0
}
set browse_iso_window_var "$adr_var"
set old_geometry "$browse_iso_window_geometry"
set browse_iso_window_is_active 1
} else {
set w {.browse_disk_window}
@ -2469,20 +2517,18 @@ proc browse_tree {adr_var which_fs} {
set open_dir_cmd "browse_disk_open_dir"
set destroy_cmd "destroy_browse_disk"
if {"$browse_disk_window_var" != "$adr_var" && "$window_is_active" == 1} {
set old_geometry [wm geometry $w]
destroy_browse_disk $w
set window_is_active 0
}
set browse_disk_window_var "$adr_var"
set old_geometry "$browse_disk_window_geometry"
set browse_disk_window_is_active 1
}
set re_use_widgets 0
if {"$window_is_active" == 0} {
toplevel $w -borderwidth 10 -class Browse
toplevel $w -borderwidth 10 -class Browser
wm title $w "$title_name"
if {"$old_geometry" != ""} {
wm geometry $w "$old_geometry"
}
set_window_position $w "$old_geometry"
} else {
set re_use_widgets 1
}
@ -2637,9 +2683,10 @@ proc restore_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
global yesno_window_is_active answer_of_yesno yesno_window_geometry
if {"$w" != ""} {
set yesno_window_geometry [wm geometry $w]
destroy "$w"
}
set yesno_window_is_active 0
@ -2650,7 +2697,7 @@ proc destroy_yesno {w 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
global answer_of_yesno yesno_window_is_active yesno_window_geometry
set w {.yesno_window}
if {"$yesno_window_is_active" == 1} {
@ -2662,7 +2709,7 @@ proc window_yesno {question} {
set answer_of_yesno ""
toplevel $w -borderwidth 20 -class Dialog
wm title $w "xorriso-tcltk yes/no"
# wm geometry $w -0+0
set_window_position $w "$yesno_window_geometry"
label $w.question -text "$question"
button $w.yes -text "yes" -command "destroy_yesno $w 1" \
-borderwidth 10 -padx 20 -pady 20 -relief ridge
@ -2679,9 +2726,10 @@ proc window_yesno {question} {
# Destroy the notification pop-up window.
#
proc destroy_ack {w} {
global ack_window_is_active
global ack_window_is_active ack_window_geometry
if {"$w" != ""} {
set ack_window_geometry [wm geometry $w]
destroy "$w"
}
set ack_window_is_active 0
@ -2691,7 +2739,7 @@ proc destroy_ack {w} {
# 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
global answer_of_yesno ack_window_is_active ack_window_geometry
set re_use_widgets 0
if {"$where" == "embedded"} {
@ -2706,7 +2754,7 @@ proc window_ack {question button_color where} {
} else {
set re_use_widgets 1
}
# wm geometry $w +0+0
set_window_position $w "$ack_window_geometry"
set destroy_cmd "destroy_ack $w"
}
if {"$re_use_widgets" == 1} {
@ -2728,10 +2776,15 @@ proc window_ack {question button_color where} {
# Destroy the help pop-up window.
#
proc destroy_help {w help_main} {
global help_window_is_active help_window_has_scroll
global main_help_window_is_active
global help_window_is_active help_window_has_scroll help_window_geometry
global main_help_window_is_active main_help_window_geometry
if {"$w" != ""} {
if {"$help_main" == 1} {
set main_help_window_geometry [wm geometry $w]
} else {
set help_window_geometry [wm geometry $w]
}
destroy "$w"
}
if {"$help_main" == 1} {
@ -2752,8 +2805,9 @@ proc surround_text {text} {
#
proc window_help {about_what button_color} {
global help_window_is_active help_window_lines help_window_has_scroll
global help_window_border_width main_help_window_is_active
global main_help_window_lines
global help_window_border_width help_window_geometry
global main_help_window_is_active
global main_help_window_lines main_help_window_geometry
global .help_window .main_help_window
# The main help window is independent of the GUI element help window
@ -2762,12 +2816,14 @@ proc window_help {about_what button_color} {
set w {.main_help_window}
set window_is_active "$main_help_window_is_active"
set window_has_scroll 1
set old_geometry "$main_help_window_geometry"
set window_lines "$main_help_window_lines"
} else {
set help_main 0
set w {.help_window}
set window_is_active "$help_window_is_active"
set window_has_scroll "$help_window_has_scroll"
set old_geometry "$help_window_geometry"
set window_lines "$help_window_lines"
}
@ -2780,16 +2836,25 @@ proc window_help {about_what button_color} {
destroy_help $w "$help_main"
set window_is_active 0
}
if {"$help_main" == 0} {set help_window_has_scroll 1}
set window_has_scroll 1
if {"$help_main" == 1} {
set old_geometry "$main_help_window_geometry"
} else {
set help_window_has_scroll 1
set window_has_scroll 1
set old_geometry "$help_window_geometry"
}
}
set re_use_widgets 0
if {"$window_is_active" == 0} {
toplevel $w -borderwidth "$help_window_border_width" -class Help
wm title $w "xorriso-tcltk help text"
set_window_position $w "$old_geometry"
if {"$help_main" == 1} {
wm title $w "xorriso-tcltk main help text"
set main_help_window_is_active 1
reset_to_normal_background .help
update idletasks
} else {
wm title $w "xorriso-tcltk GUI element help text"
set help_window_is_active 1
}
} else {
@ -2801,7 +2866,6 @@ proc window_help {about_what button_color} {
$w.text insert end "$helptext"
raise $w
} else {
# wm geometry $w +0+0
set destroy_cmd "destroy_help $w $help_main"
frame $w.text_frame
@ -2861,12 +2925,44 @@ proc check_for_bwidget {} {
}
# A window to display if no file browser is available
#
proc browser_dummy {} {
window_ack \
"The file browser cannot be used because Tcl/Tk package \"BWidget\" is not loaded" "grey" "toplevel"
}
# Obtain the geometry string of a window
#
proc get_window_geometry {w} {
wm geometry $w
}
# Set the position of a window from a geometry string
#
proc set_window_position {w geometry} {
set value "$geometry"
set idx [string first "+" "$value"]
if {"$idx" == -1} {
set value [wm geometry .]
set idx [string first "+" "$value"]
}
if {"$idx" == -1} { return "" }
set pos [string range "$value" "$idx" end]
wm geometry $w "$pos"
}
# Reset button appearance from startup color to normal color
#
proc reset_to_normal_background {w} {
set normal_color [.drive_drop_both cget -background]
$w configure -background "$normal_color"
}
# ------ Building GUI components ------
# ------ GUI layout parameters ------
@ -2994,7 +3090,8 @@ proc init_input {} {
-variable logging \
-onvalue 1 -offvalue 0
bind_help .log_pipes_switch "Log pipes"
button .help -text "Help" -command {window_help "Help" "grey"}
button .help -text "Help" -command {window_help "Help" "grey"} \
-background "grey"
bind_help .help "Help"
init_cmdline
@ -3384,6 +3481,7 @@ proc init_isomanip {} {
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
global .avail_label .avail_label_frame .avail_button
frame .isomanip -borderwidth $borderwidth
frame .isomanip_move -borderwidth 0
@ -3410,12 +3508,22 @@ proc init_isomanip {} {
bind_help .isomanip_move_target "rename and mkdir target"
create_browser_button .isomanip_move_target_button \
"isomanip_move_target" "isofs" "Browse ISO (move target)"
button .avail_button -text "Refresh avail:" \
-command {refresh_avail}
bind_help .avail_button "Refresh avail:"
frame .avail_label_frame -relief ridge -borderwidth 2
label .avail_label -width 10 -text ""
bind_help .avail_label "Refresh avail:"
pack .avail_label -in .avail_label_frame
pack .isomanip_prefix .isomanip_verify_button .isomanip_rm_r_button \
.isomanip_move_button .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 \
-in .isomanip_move -side left -expand 1 -fill both
pack .avail_label_frame .avail_button -in .isomanip_move -side right
pack .isomanip_move \
-in .isomanip -side top -expand 1 -fill both
}
@ -3480,10 +3588,9 @@ proc init_extract {} {
# Some controls which apply to insertion, extraction, or both.
#
proc init_localfs_aux {} {
global borderwidth have_bwidget
global borderwidth have_bwidget permission_policy
global .localfs_aux_frame
global .overwrite_iso_files_button .overwrite_dir_button .extract_auto_chmod
global .avail_label .avail_label_frame .avail_button
frame .localfs_aux_frame -borderwidth 0
checkbutton .overwrite_iso_files_button -text "Overwrite ISO files" \
@ -3523,15 +3630,23 @@ proc init_localfs_aux {} {
pack .browse_select_is_setvar -in .localfs_aux_frame -side left
}
button .avail_button -text "Refresh avail:" \
-command {refresh_avail}
bind_help .avail_button "Refresh avail:"
frame .avail_label_frame -relief ridge -borderwidth 2
label .avail_label -width 10 -text ""
bind_help .avail_label "Refresh avail:"
pack .avail_label -in .avail_label_frame
menubutton .perm_policy -text "Permissions: as is" -width 22 -anchor w \
-direction above -relief ridge -indicatoron 1 \
-menu .perm_policy.menu
set m ".perm_policy.menu"
menu $m -tearoff 0
$m add radiobutton -label "as is" -value "as_is" \
-variable permission_policy -command show_permission_policy
$m add radiobutton -label "readable" -value "readable" \
-variable permission_policy -command show_permission_policy
$m add radiobutton -label "readonly" -value "readonly" \
-variable permission_policy -command show_permission_policy
$m add radiobutton -label "mkisofs -r" -value "mkisofs_r" \
-variable permission_policy -command show_permission_policy
show_permission_policy
pack .avail_label_frame .avail_button -in .localfs_aux_frame -side right
bind_help .perm_policy "Permissions:"
pack .perm_policy -in .localfs_aux_frame -side right
}
@ -4123,7 +4238,7 @@ which is not possible with CD-R, DVD-R, DVD+R, and BD-R.
if {"$what" == "TAO"} {
return \
"The \"TAO\" switch controls whether an incremental MMC write type shall be
enforced with write commands.
enforced with write commands. See xorriso command -write_type.
Normally xorriso will decide by medium status and job parameters which
MMC write type to choose. Some drives at the edge of failure might work
@ -4133,7 +4248,7 @@ with the one write type while already failing with the other."
return \
"The \"Defect Mgt\" switch controls whether slow and error-prone drive internal
check-reading shall be enabled when writing to formatted BD-R or BD-RE.
"
See xorriso command -stream_recording."
}
if {"$what" == "Burn image file:"} {
return \
@ -4297,7 +4412,7 @@ or only the selected items shall be copied to hard disk.
if {"$what" == "Overwrite ISO files"} {
return \
"The \"Overwrite ISO files\" switch controls whether existing files may be
overwritten in the ISO image.
overwritten in the ISO image. See xorriso command -overwrite \"nondir\".
The frontend program will only detect the most obvious name collisions,
but xorriso will reliably refuse to overwrite files if this is banned."
@ -4305,7 +4420,7 @@ but xorriso will reliably refuse to overwrite files if this is banned."
if {"$what" == "Overwrite ISO dirs"} {
return \
"The \"Overwrite ISO dirs\" switch controls whether it is allowed to replace
an ISO directory by a non-directory file.
an ISO directory by a non-directory file. See xorriso command -overwrite \"on\".
If a directory is copied to a directory, then both directory trees will
be merged. So this switch applies only to situations where non-directories
@ -4329,7 +4444,7 @@ no w-permission."
if {"$what" == "Overwrite disk files"} {
return \
"The \"Overwrite disk files\" switch controls whether existing files may be
overwritten by extraction on hard disk.
overwritten by extraction on hard disk. See xorriso command -overwrite \"on\".
This is DANGEROUS, of course, but comes in handy with restoring of backups.
@ -4348,12 +4463,36 @@ only if double clicked, of by button \"Accept\", or by button \"Edit\".
In any case, double clicked addresses get treated as if the Return key
had been hit in the text field. The same happens with the selected item
and button \"Accept\"."
}
if {"$what" == "Permissions:"} {
return \
"The \"Permissions\" menu allows to choose a global policy to adjust
the access permissions of the files in the emerging ISO session.
The default policy \"as is\" leaves the permissions as they are.
Usually they have been imported from hard disk or from a loaded ISO image.
xorriso commands -chmod , -chmod_r, and -find ... -exec chmod --
may be used to perform permission manipulations.
Policy \"readable\" adds read permission to all kinds of files and
search permission to all directories.
Policy \"readonly\" sets the permissions of all kinds files to read-only.
Directories get added search permission.
Policy \"mkisofs -r\" does what option -r of program mkisofs does:
User id and group id become 0, all r-permissions get granted, all w denied.
If there is any x-permission, then all three x get granted. s- and t-bits
get removed.
"
}
if {"$what" == "Refresh avail:"} {
return \
"The \"Refresh avail:\" button triggers a time consuming exact prediction
of the free space on the medium in the output drive. For this purpose,
the size of an ISO session with the pending changes is computed.
"The \"Refresh avail:\" button triggers command -tell_media_space. It makes
a time consuming exact prediction of the free space on the medium in the
output drive. For this purpose, the size of an ISO session with the pending
changes is computed.
With image files rather than real optical drives, the free space of
the hosting filesystem is displayed."
}

View File

@ -1 +1 @@
#define Xorriso_timestamP "2012.12.31.173306"
#define Xorriso_timestamP "2013.01.01.130149"