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

libisoburn/trunk/frontend/xorriso-tcltk

@@ -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]
+  reset_to_normal_background .drive_scan
-  .drive_scan configure -background "$normal_color"
-  update idletasks
 
   # 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"]
+      set dir_dummy [combine_dir_and_name "$adr" "_"]
-      $tr insert end "$adr" "$dir_dummy" -text "dir_dummy"
+      $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" != ""} {
+    set_window_position $w "$old_geometry"
-      wm geometry $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 help_window_is_active help_window_has_scroll help_window_geometry
-  global main_help_window_is_active
+  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 help_window_border_width help_window_geometry
-  global main_help_window_lines
+  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}
+    if {"$help_main" == 1} {
-    set window_has_scroll 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:" \
+  menubutton .perm_policy -text "Permissions: as is" -width 22 -anchor w \
-                             -command {refresh_avail}
+                          -direction above -relief ridge -indicatoron 1 \
-  bind_help .avail_button "Refresh avail:"
+                          -menu .perm_policy.menu
-  frame .avail_label_frame -relief ridge -borderwidth 2
+  set m ".perm_policy.menu"
-  label .avail_label -width 10 -text ""
+  menu $m -tearoff 0
-  bind_help .avail_label "Refresh avail:"
+  $m add radiobutton -label "as is" -value "as_is" \
-  pack .avail_label -in .avail_label_frame
+                    -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
+"The \"Refresh avail:\" button triggers command -tell_media_space. It makes
-of the free space on the medium in the output drive. For this purpose,
+a time consuming exact prediction of the free space on the medium in the
-the size of an ISO session with the pending changes is computed.
+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."
   }

libisoburn/trunk/xorriso/xorriso_timestamp.h

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