
# This dialog got rather large and ugly so it got a file of its own
# I know it can be made shorter with smarter logic, but since it works...


proc ChmodDialog { filename mode args } {
  global glob config chmod_state chmod_orig \
      chmod_action chmod_recurse chmod_cancel \
      chmod_mode chmod_string chmod_arg chmod_user\
      chmod_group chmod_ownrecurse chmod_ownarg \
      chmod_ouorg chmod_entry

  lassign $args chmod_user chmod_group
  set chmod_ouorg [list $chmod_user $chmod_group]
  set chmod_ownrecurse 0
  set chmod_ownargSet {}
  set chmod_arg {}
  set chmod_mode [format %04o [expr {$mode & 07777}]]
  set chmod_entry $chmod_mode
  set chmod_action {set}
  set chmod_cancel 1
  set w .chmod_dialog
  toplevel $w -class Dialog
  wm title $w "Change permission flags"
  wm iconname $w "Change permission flags"
  wm resizable $w false false
  wm transient $w [winfo toplevel [winfo parent $w]]

  # To make the loops work better, for special we use read=setuid, write=setgid
  # and exec=sticky
  ChmodStateFromMode $mode chmod_orig

  frame $w.top
  grid $w.top -row 1 -sticky ew
  label $w.top.filename -text $filename -bg white
  grid $w.top.filename -row 1 -sticky nsew
  grid columnconfig $w.top all -weight 1

  frame $w.mid
  grid $w.mid -row 2 -sticky nsew
  grid anchor $w.mid center
  foreach ugos {user group other special} Ugos {User Group Other Special} {
    incr col
    set row 1
    label $w.mid.title$ugos -text $Ugos
    grid $w.mid.title$ugos -row $row -column $col
    foreach rwx {read write exec} sss {setuid setgid sticky} {
      incr row
      checkbutton $w.mid.$ugos$rwx  \
	  -text [expr {$ugos == "special" ? $sss : $rwx} ] \
	  -variable  chmod_state($ugos,$rwx) \
	  -command   "chmod_setFromState"
      grid $w.mid.$ugos$rwx -row $row -column $col
    }
  }
  frame $w.cen
  grid $w.cen -row 4 -sticky nsew
  grid anchor $w.cen center
  label $w.cen.oct -text Octal
  ttk::entry $w.cen.octent \
      -textvariable chmod_mode \
      -validate key \
      -font TkFixedFont\
      -width 4\
      -validatecommand "chmod_valoct %d %i %S %W"
  label $w.cen.rwx -text rwx
  ttk::entry $w.cen.rwxent \
      -textvariable chmod_string\
      -font TkFixedFont\
      -width 9\
      -validate key \
      -validatecommand "chmod_valrwx %d %i %S %W"
  label $w.cen.result -text {chmod arg}
  label $w.cen.resultval -textvariable chmod_arg

  grid $w.cen.oct $w.cen.rwx $w.cen.result -padx 10
  grid $w.cen.octent $w.cen.rwxent $w.cen.resultval -padx 10
  frame $w.bot
  grid $w.bot -row 5 -sticky nsew
  grid anchor $w.bot center
  label $w.bot.action -text {Chmod Action}
  set col 0
  grid $w.bot.action -column 2 -columnspan 2 -row 1 -sticky w
  foreach sad {set add del} Sad {Set Add Del} {
    incr col
    radiobutton $w.bot.$sad -text $Sad \
	-variable chmod_action -value $sad -command ChmodSet$Sad
    grid $w.bot.$sad -column $col -row 2 -sticky w
  }
  incr col
  checkbutton $w.bot.recurse  \
      -text Recurse \
      -variable chmod_recurse\
      -command chmod_argSet
  grid $w.bot.recurse -column $col -row 2 -sticky w
  frame $w.owner
  grid $w.owner -row 6 -sticky nsew
  grid anchor $w.owner center
  label $w.owner.info -text {---Chown---}
  grid $w.owner.info -column 0 -columnspan 2 -row 1
  label $w.owner.usr -text User
  label $w.owner.grp -text Group
  grid $w.owner.usr $w.owner.grp -row 2
  set width 15
  ttk::entry $w.owner.usrdat \
      -textvariable chmod_user\
      -font TkFixedFont\
      -validate focusout \
      -validatecommand chmod_ownargSet\
      -width $width

  ttk::entry $w.owner.grpdat \
      -textvariable chmod_group\
      -font TkFixedFont\
      -validate focusout \
      -validatecommand chmod_ownargSet\
      -width $width
  grid $w.owner.usrdat $w.owner.grpdat -row 3 -padx 10 -sticky ew
  checkbutton $w.owner.recurse  \
      -text Recurse \
      -variable chmod_ownrecurse\
      -command chmod_ownargSet
  label $w.owner.arg -textvariable chmod_ownarg
  grid  $w.owner.arg -sticky ew -row 4 -column 1 -padx 10 -sticky ew
  grid $w.owner.recurse -row 4 -column 0 -padx 10 -sticky w
  frame $w.end
  grid $w.end -row 10 -sticky nsew

  button $w.end.ok -text Ok -command "set chmod_cancel 0; destroy $w"
  button $w.end.cancel -text Cancel -command "set chmod_cancel 1; destroy $w"
  grid  $w.end.ok -row 3 -column 3 -sticky e -padx {50 0}
  grid  $w.end.cancel -row 3 -column 4 -sticky e

  ChmodSetSet 

  #$w.bot.set select
  centerWin $w 

  set oldGrab [grab current $w]
  frgrab $w
  focus -force $w
  set oldena $glob(enableautoupdate)
  set glob(enableautoupdate) 0
  tkwait window $w
  if {$oldGrab != ""} {
    frgrab $oldGrab
  }

   
  set glob(enableautoupdate) $oldena
  set rtn [list $chmod_arg $chmod_ownarg]
  if {$chmod_cancel} {
    set rtn {}
  }

  unset chmod_state chmod_orig chmod_action \
      chmod_recurse chmod_cancel chmod_string chmod_mode\
      chmod_user chmod_group chmod_ownrecurse chmod_ownarg \
      chmod_ouorg chmod_entry chmod_arg
#  puts "$chmod_arg"
  return $rtn
}

proc chmod_ownargSet {} {
  global chmod_user chmod_group chmod_ownrecurse \
      chmod_ownarg chmod_ouorg chmod_entry
  #puts "{$chmod_user $chmod_group} $chmod_ouorg"
  if {[list $chmod_user $chmod_group] != $chmod_ouorg || \
	  $chmod_ownrecurse != 0} {
    set re [expr {$chmod_ownrecurse != 0 ? "-R " : ""}]
    set chmod_ownarg "$re$chmod_user:$chmod_group"
  } else {
    set chmod_ownarg {}
  }
  return 1
}

proc chmod_setFromState {} {
  global chmod_mode chmod_string
  set chmod_mode [chmod_stateToMode]
  set chmod_string [GetStringFromMode 0$chmod_mode]
  chmod_argSet
}

proc chmod_setFromMode {} {
  global chmod_mode chmod_string chmod_state
  
  ChmodStateFromMode $chmod_mode chmod_state
  set chmod_string [GetStringFromMode 0$chmod_mode]
  chmod_argSet
}

proc chmod_valoct {type indx char w} {
  global chmod_mode chmod_string chmod_state
  # mode is a three digit octal number
  # here we mess with the input to make it look like over
  # write and not insert.  A delete we ignore?
  if {$type == 1 && [string match {[0-7]} $char] && [string length $char] == 1} {
    set chmod_mode [string replace $chmod_mode $indx $indx $char]
    $w icursor [expr 1 + $indx]
    chmod_setFromMode
  }
  return 0
}

proc chmod_valrwx {type indx char w} {
  global chmod_string chmod_mode
  if {$type == 1 && [string length $char] == 1} {
    if {$char != "-"} {
      switch $indx {
	0 -
	3 -
	6 {if {$char != "r"} {return 0}}
	1 -
	4 -
	7 {if {$char != "w"} {return 0}}
	2 -
	5 {if {$char != "x" && $char != "S"} {return 0}}
	8 {if {$char != "x" && $char != "T"} {return 0}}
      }
    }
    set chmod_string [string replace $chmod_string $indx $indx $char]
    $w icursor [expr 1 + $indx]
    set chmod_mode [GetModeFromString $chmod_string]
    chmod_setFromMode
  }
  return 0
}

proc chmod_stateToMode {} {
  global chmod_action chmod_state
  set chmod_arg ""
  set chmod_arg 0
  set i 0
  foreach ogus {other group user special} {
    foreach xwr {exec write read} {
      set chmod_arg [expr {$chmod_arg | $chmod_state($ogus,$xwr) << $i}]
      incr i
    }
  }
  set chmod_arg [format {%04o} $chmod_arg]
  return $chmod_arg
}

proc chmod_argSet {} {
  global chmod_action chmod_state chmod_arg \
      chmod_recurse chmod_mode chmod_entry
  if {$chmod_action == "set" } {
    set chmod_arg $chmod_mode
  } else {
    set pm [expr {$chmod_action == "add" ? "+" : "-"}]
    set user ""
    set group ""
    set other ""
    set all ""
    set arg ""
    foreach ugo {user group other} {
      foreach rwx {read write exec} srwx {r w x} {
	if {$chmod_state($ugo,$rwx)} {set $ugo "$srwx[set $ugo]"}
      }
    }
    if {$chmod_state(special,read)} {set user "s$user"}
    if {$chmod_state(special,write)} {set group "s$group"}
    if {$chmod_state(special,exec)} {set all "t$all"}

    foreach ugo {user group other} s {u g o} {
      if {[set $ugo] != ""} {
	if {$arg != ""} { set arg ",$arg" }
	set arg "$s$pm[set $ugo]$arg"
      }
    }
    if {$all != ""} {
      if {$arg != ""} { set arg ",$arg" }
      set arg "a$pm$all$arg"
    }
    set chmod_arg $arg
  }
  if {$chmod_recurse} {
    set chmod_arg "-R $chmod_arg"
  }
  if {$chmod_arg == $chmod_entry} {
    set chmod_arg {}
  }
}

proc ChmodSetAdd { } {
  global chmod_state chmod_orig
  foreach i [array names chmod_orig] {
    set chmod_state($i) 0
  }
  chmod_setFromState
}

proc ChmodSetDel { } {
  ChmodSetAdd
}

proc ChmodSetSet { } {
  global chmod_state chmod_orig chmod_mode
  foreach i [array names chmod_orig] {
    set chmod_state($i) $chmod_orig($i)
  }
  chmod_setFromState
}

proc ChmodStateFromMode {mode var} {
  global chmod_state
  upvar #0 $var chmod_loc 
  set i 0
  set mode "0$mode"
  foreach ogus {other group user special} {
    foreach xwr {exec write read} {
      set chmod_loc($ogus,$xwr) [expr {($mode >> $i) & 1}]
      incr i
    }
  }
}

proc GetStringFromMode { mode } {
  global glob
  # if { $::tcl_platform(platform) == "windows"} {
  #   return [format "0x%x" $mode]
  # }
  return [format "%s%s%s%s%s%s%s%s%s" \
	      [expr {$mode &  00400 ? "r" : "-"}] \
	      [expr {$mode &  00200 ? "w" : "-"}] \
	      [expr {$mode & 0004000 ? "S" : \
			 [expr {$mode & 00100 ? "x" : "-"}]}\
		  ] \
	      [expr {$mode & 00040 ? "r" : "-"}] \
	      [expr {$mode & 00020 ? "w" : "-"}] \
	      [expr {$mode & 0002000 ? "S" : \
			 [expr {$mode & 00010 ? "x" : "-"}]}\
		  ] \
	      [expr {$mode &  00004 ? "r" : "-"}] \
	      [expr {$mode & 00002 ? "w" : "-"}] \
	      [expr {$mode & 0001000 ? "T" : \
			 [expr {$mode & 00001 ? "x" : "-"}]}\
		  ]\
	     ]
}

# And now the invers, get mode from string (for our FTP friends)

proc GetModeFromString { st } {
  # Sting should be 9 chars.  We start from the right and use the 
  # least 9. We ignor characters that are not in the right place...

  incr result 0
  incr count 0
  foreach gr {0o1 0o10 0o100 } sp {0o1000 0o2000 0o4000} {
    foreach ur [list $gr [expr {$gr * 2}] [expr {$gr *4}] ] exp { "x" "w" "r" } {
      set ch [string index $st end-$count]
      set special [expr {$count == 0 ? "T" : "S"}]
      incr count
      if { $ch == $exp } {set result [expr {$result | $ur}]}
      if { $exp == "x" && $ch == $special} {set result [expr {$result | $sp} ] }
    }
  }
  return [format  "%05o" $result]
}
