# TkPasMan 2.x core

# Dump password file to stdout. Useful for conversion etc.
proc Dump {} {

  global conf PW
  
  # Only dump site name, username and password.
  # Format with conf(dump-formatstring)
  
  foreach name [lsort [array names PW]] {
    puts stdout [format $conf(dump-formatstring) \
      $name [lindex $PW($name) 0] [lindex $PW($name) 1]]
  }
}


# This one is called once, when the user changes the PW array.
# When called with argument 0 the PW array is marked unchanged.
# A trace will be set, to monitor the first change after that.
proc PWChanged {yn args} {

  global PW state

  set state(changed) $yn
  trace [string map {
    0 variable
    1 vdelete
  } $yn] PW wu {PWChanged 1}
}


# Write the password file (encrypted) to disk.
# When using encryption, ssl(passwd) must contain a valid password.
# If save fails, or is interrupted or canceled, returns 1, otherwise
# this function returns 0.
proc Save {} {

  global ssl conf state PW
  
  # Append algorithm name to filename if encryption must be performed.
  if {$state(use-encryption)} {
    set outf $conf(file).$ssl(enc)
  } else {
    set outf $conf(file)
  }

  # Now backup the old file, if it exists. The new file will then be
  # written to the old one, so if a user for safety's sake hard links another
  # filename to it, the links will stay intact.
  while 1 {
    set backupf "${outf}-tmp[expr {int (rand() * 4194304)}]"
    if {! [file exists $backupf]} break
  }
  if {[file readable $outf]} {
    if {[catch {file copy $outf $backupf}]} {
      SaveErrorMsg "Creating backup failed.\
        Perhaps your filesystem is full, or [file dirname $outf]/\
        is not writable."
      return 1
    }
  }
  
  set f [open $outf w 0600]

  if {$state(use-encryption)} {
    close $f
    set cmd [list |$ssl(cmd) $ssl(enc)]
    eval lappend cmd $ssl(salt)
    lappend cmd -e -pass stdin > $outf
    set f [open $cmd w]
    puts $f $ssl(passwd)
  }
  foreach el [array names PW] {
    if {[catch {puts $f [array get PW $el]}]} {
      catch {close $f}
      if {[file exists $backupf] && [catch {file copy $backupf $outf}]} {
        SaveErrorMsg "Writing to the password file failed.\
          Restoring the backup failed as well! This should not happen.\
          I have left the backup in '$backupf'"
          return 1
      } else {
        file delete -force $backupf
        SaveErrorMsg "Writing to the password file failed.\
          Perhaps your filesystem is full.\
          I have restored the old file."
        return 1
      }
    }
  }
  if {[catch {close $f}]} {
    if {[catch {file copy $backupf $outf}]} {
      SaveErrorMsg "Closing the password file failed.\
        Restoring the backup failed as well! This should not happen.\
        I have left the backup in '$backupf'"
        return 1
    } else {
      file delete -force $backupf
      SaveErrorMsg "Closing the password file failed.\
        Perhaps your filesystem is full.\
        I have restored the old file."
      return 1
    }
  }
  PWChanged 0
  file delete -force $backupf
  return 0
}


proc SaveErrorMsg msg {
  tk_messageBox -type ok -icon error -title "TkPasMan: Save Error" -parent . \
    -message "Could not save password file:\n\n$msg.\n\nPlease retry."
}


# Open an (encrypted) password file
# Returns 0 on succes, 1 on fail.
# if state(readonly) is already 1, the file will be opened readonly.
proc Open {} {

  global ssl conf state PW

  # If there exists an encrypted file, force state(use-encryption) to 1
  # else force it to 0.
  set state(use-encryption) 0
  set file $conf(file)
  if {[array exists ssl] && [file readable $file.$ssl(enc)]} {
    set state(use-encryption) 1
    set file $file.$ssl(enc)
  } elseif {! [file readable $file]} {
    # there is no file. Create one now.
    array set PW {}
    set f [open $file w 0600]
    close $f
  }
  # Lock the file if it is writable.
  if {! $state(readonly) && [file writable $file] && ! [Locked $file] } {
    if {[Lock $file]} {
      set state(readonly) 1
      tk_messageBox -type ok -icon warning -parent . -title "TkPasMan: Warning" \
        -message "Locking the password file failed. Session made read-only."
    } else {
      set state(readonly) 0
    }
  } else {
    set state(readonly) 1
  }
  # Now, if the file is encrypted, ask for a password.
  if {$state(use-encryption)} {
    set cmd [list |$ssl(cmd) $ssl(enc) -d -in [homify $file] -pass stdin]
    eval lappend cmd $ssl(salt)
    # Ask for the password
    if {$state(X)} {
      set passwd [InputPassword "TkPasMan: Enter Password" \
          "Please enter the master password for ${file}:" {}]
    } else {
      # We use stderr, so the user can pipe stdout to something useful.
      puts -nonewline stderr "Please enter the master password for ${file}: "
      flush stderr
      # A kludge to get the password without echo.
      set passwd [exec sh -c {read -s line ; echo $line}]
      puts stderr ""
    }      
    if {[string equal $passwd {}]} {
      Unlock $file
      return 1
    }
    set f [open $cmd r+]
    puts $f $passwd
    flush $f
    if {[catch {array set PW [read $f]}] + [catch {close $f}]} {
      array unset PW *
      Unlock $file
      if {$state(X)} {
        OpenErrorMsg "Error reading encrypted file! You probably supplied a\
          wrong password."
      } else {
        puts stderr "tkpasman: error: Error reading encrypted file!\nYou\
          probably supplied a wrong password."
      }
      return 1
    }
    # (the file has been read correctly)
    # Save the password.
    set ssl(passwd) $passwd
  } else {
    set f [open $file r]
    if {[catch {array set PW [read $f]}] + [catch {close $f}]} {
      array unset PW *
      Unlock $file
      if {$state(X)} {
        OpenErrorMsg "Error reading password file!"
      } else {
        puts stderr "tkpasman: error: Error reading password file!"
      }
      return 1
    }
  }
  # When we are here, the file has been read correctly.
  # Now we might see if the password file is of the old <=2.1 format.
  # Then we convert to the new format.
  # Old:		New:
  # 1 (uname)		1 0 0 0
  # 2 (pw)		0 1 0 0
  # 3 (both)		1 1 0 0
  # 4 (w newl.)		1 1 0 1
  set old 0
  foreach el [array names PW] {
    if {[llength $PW($el)] == 3} {
      # Old format!
      set old 1
      set PW($el) [eval lreplace {$PW($el)} end end [string map {
        0	{0 0 0 0}
        1	{1 0 0 0}
        2	{0 1 0 0}
        3	{1 1 0 0}
        4	{1 1 0 1}
        } [lindex $PW($el) end]]]
    }
  }
  if {$old} {
    if {$state(X)} {
      tk_messageBox -type ok -icon warning -title "TkPasMan: Warning" -parent .\
        -message "Warning: The file format of the password file has\
          changed since TkPasMan 2.2. I have imported the file, but when\
          you save the password file, old versions of TkPasMan might not\
          read it correctly."
    } else {
      puts stderr "tkpasman: warning: password file in old format"
    }
  }  
  PWChanged 0
  return 0
}


proc OpenErrorMsg msg {
  tk_messageBox -type ok -icon error -parent . -title "TkPasMan: Open Error" \
    -message "Could not open password file:\n\n$msg\n\nPlease retry."
}


# Lock file. Returns 0 on success, 1 on fail.
proc Lock file {
  expr {[catch {set f [open $file.lock w 0600]}] +
        [catch {puts $f [format %10d [pid]]}]    +
        [catch {close $f}]}
}


# Unlock file if this session is not readonly (i.e. if this session
# created the lock). Returns 0 on success, 1 on fail.
proc Unlock file {

  global state
  
  if {! $state(readonly)} {
    return [catch {file delete $file.lock}]
  } else {
    return 0
  }
}


# Returns 1 if locked.
proc Locked file {
  file exists $file.lock
}


# Closes the password file. Interacts with the user if changed.
# Returns 1 if the user cancels the close dialog, or if save fails!
proc Close {} {

  global state conf ssl

  set retval 0
  if {$state(changed)} {
    if {! $conf(confirm-save-on-quit)} {
      set retval [Save]
    } else {
      switch -- [tk_messageBox \
          -parent . -icon question -title Save? \
          -message {The file has changed. Do you want to save?} \
          -type yesnocancel -default yes] {
        yes {
          set retval [Save]
        }
        no {}
        cancel {
          set retval 1
        }
      }
    }
  }
  if {! $retval} {
    if {! $state(readonly)} {
      if {$state(use-encryption)} {
        Unlock $conf(file).$ssl(enc)
        # Forget the password.
        set ssl(passwd) {}
      } else {
        Unlock $conf(file)
      }
    }
  } else {
    Hint "Password file NOT saved"
  }
  return $retval
}


# Exit tkpasman, if the user didn't cancel the close dialog.
proc Quit {} {

  global conf

  if {![Close]} {
    if {$conf(onquit-save-options)} SaveConfig
    exit
  }
}


# Makes it possible to set a master password.
# The user must save the file afterwards, to confirm the new password.
# When user cancels or something goes wrong, returns 1, otherwise 0.
proc SetPassword {} {

  global ssl state
  
  # You never know...
  if {! [array exists ssl]} return
  
  set passwd [Input2Passwords "New Password" \
    "Please enter new password:" {}]
  
  # If cancelled, hop it.
  if {[string equal $passwd {}]} {
    tk_messageBox -type ok -icon warning -parent . -title Warning \
      -message "Setting of password cancelled!"
    return 1
  }
  
  switch [tk_messageBox -type okcancel -default ok -icon question \
    -parent . -title "Caution!" -message \
      "You MUST save your password file right now, in order\
      to keep the new password persistent.\n\nChoose OK to save the file\
      now.\n\nIf you choose Cancel, the new password will NOT be set."] {
    ok {
      set ssl(passwd) $passwd
      set state(use-encryption) 1
      PWChanged 1
      return [Save]
    }
    default {
      tk_messageBox -type ok -icon warning -parent . -title Warning \
        -message "Setting of password cancelled!"
      return 1
    }
  }
}

# Just asks and verify the password (not for opening the file)
# returns 1 on fail, 0 on success.
proc AskPassword message {

  global ssl
  
  # You never know...
  if {! [array exists ssl]} {return 0}

  if {[string compare $ssl(passwd) {}]} {
    set passwd [InputPassword \
      "TkPasMan: Enter Password" $message {}]
    if {[string compare $passwd $ssl(passwd)]} {
      if {[string compare $passwd {}]} {
        tk_messageBox -type ok -icon error -parent . -title Error \
          -message "Wrong password. Please retry."
      }
      return 1
    }
  }
  return 0
}


# Change Master Password
# This proc assumes encryption is currently active.
#
# This proc may not be called if session is readonly.
proc ChangePassword {} {
  
  global ssl state

  # You never know...
  if {! [array exists ssl] || ! $state(use-encryption)} {return 0}

  if {[AskPassword \
      "Before you are allowed to change the master\
       password, you have to enter the old password:"]} {
    return 1
  }
  return [SetPassword]
}


# EnableEncryption
# This proc is called when the user wants to switch from/to encryption.
# When state(use-encryption) = 1, user _wants_to_ switch on (i.e. it _is_ not
# yet switched on, so then we have to put it back to zero.
#
# This proc may not be called if session is readonly.
proc EnableEncryption {} {

  global state ssl conf
  
  if {$state(use-encryption)} {
    # User wants to switch on encryption
    switch [tk_messageBox -type okcancel -icon question -parent .\
        -title "Enable Encryption" -message \
        "To enable encryption, you will now be asked to enter a\
        password.\n\nChoose OK to continue." -default ok] {
      cancel {
        set state(use-encryption) 0
        Hint "Enabling Encryption cancelled"
      }
      ok {
        if {[SetPassword]} {
          set state(use-encryption) 0
          file delete -force $conf(file).$ssl(enc)
          tk_messageBox -type ok -icon warning -parent . -title Warning \
            -message "Enabling Encryption failed! File is NOT encrypted."
        } else {
          Lock $conf(file).$ssl(enc)
          Unlock $conf(file)
          file delete $conf(file)
          Hint "Encryption is now enabled"
        }
      }
    }
  } else {
    # User wants to switch _off_ encryption
    switch [tk_messageBox -type okcancel -icon question -parent .\
        -title "Disable Encryption" -message \
        "To disable encryption, you must first enter the master\
        password.\n\nChoose OK to continue." -default ok] {
      cancel {
        set state(use-encryption) 1
        Hint "Disabling Encryption cancelled"
      }
      ok {
        if {[AskPassword "Please enter the master password:"]} {
          set state(use-encryption) 1
          Hint "Disabling Encryption failed"
        } else {
          if {[Save]} {
            set state(use-encryption) 1
            file delete -force $conf(file)
            tk_messageBox -type ok -icon error -parent . -title Error \
              -message "Disabling Encryption failed! Encryption remains active."
          } else {
            Lock $conf(file)
            Unlock $conf(file).$ssl(enc)
            file delete $conf(file).$ssl(enc)
            Hint "Encryption is now disabled"
          }
        }
      }
    }
  }
}


# Write the contents of the global conf array to disk.
proc SaveConfig {} {

  global conf ConfigFile Version

  set conf(geometry) "[winfo width .]x[winfo height .]"

  set f [open $ConfigFile w 0600]
  puts $f "# TkPasMan-$Version"
  foreach el [lsort [array names conf]] {
    puts $f [array get conf $el]
  }
  close $f
}


# A short hand for the status message.
proc Hint args {

  eval statusMessage .status $args

}


# this one should move to cooltk, when that becomes a separate, multilanguage
# user app-framework...;-)
proc Input {title message value} {

  toplevel [set w .inputwindow] -class Input -bd 8 -relief flat
  wm title $w $title
  wm iconname $w "[wm title .]: $title"
  wm transient $w .
  wm protocol $w WM_DELETE_WINDOW "$w.can invoke"

  pack [message $w.l -text $message]
  pack [entry $w.e -textvar $w] -pady 8 -fill x -expand 1
  pack [button $w.ok -text Ok -command "destroy $w" -default active] -side left
  pack [button $w.can -text Cancel -command "set $w {}; destroy $w"] -side right

  focus $w.e
  bind $w.e <Return> "$w.ok invoke"
  bind $w.e <Escape> "$w.can invoke"

  set ::$w $value
  center $w widget .
  grab $w
  tkwait window $w
  set ::$w
}

# Same, for passwords
proc InputPassword {title message value} {

  toplevel [set w .inputwindow] -class Input -bd 8 -relief flat
  wm title $w $title
  wm iconname $w "[wm title .]: $title"
  wm transient $w .
  wm protocol $w WM_DELETE_WINDOW "$w.can invoke"

  pack [message $w.l -text $message]
  pack [entry $w.e -textvar $w -show *] -pady 8 -fill x -expand 1
  pack [button $w.ok -text Ok -command "destroy $w" -default active] -side left
  pack [button $w.can -text Cancel -command "set $w {}; destroy $w"] -side right

  focus $w.e
  bind $w.e <Return> "$w.ok invoke"
  bind $w.e <Escape> "$w.can invoke"

  set ::$w $value
  center $w widget .
  grab $w
  tkwait window $w
  set ::$w
}

proc Input2Passwords {title message value} {

  toplevel [set w .inputwindow] -class Input -bd 8 -relief flat
  wm title $w $title
  wm iconname $w "[wm title .]: $title"
  wm transient $w .
  wm protocol $w WM_DELETE_WINDOW "$w.can invoke"

  pack [message $w.l1 -text $message]
  pack [entry $w.e1 -textvar $w.1 -show *] -pady 8 -fill x -expand 1
  pack [message $w.l2 -text "Re-enter password:"]
  pack [entry $w.e2 -textvar $w.2 -show *] -pady 8 -fill x -expand 1
  pack [button $w.ok -text Ok -default active] -side left
  pack [button $w.can -text Cancel -command "set $w {}; destroy $w"] -side right

  $w.ok configure -command \
    "if {\[string equal \${$w.1} \${$w.2}\]} {
      set {$w} \${$w.1}
      destroy $w
    } else {
      set {$w.1} {}
      set {$w.2} {}
      tk_messageBox -type ok -parent {$w} -icon error -title Error \
        -message {Ambiguous passwords! Please enter again.}
      focus $w.e1
    }"
  focus $w.e1
  bind $w.e1 <Return> "focus $w.e2"
  bind $w.e2 <Return> "$w.ok invoke"
  bind $w <Escape> "$w.can invoke"

  set ::$w.1 $value
  set ::$w.2 $value
  center $w widget .
  grab $w
  tkwait window $w
  set ::$w
}


proc Help {} {

  global Help

  set w .help
  if {![seeToplevel $w]} {
    toplevel $w -class Help
    wm title $w "TkPasMan Help"
    wm iconname $w "TkPasMan Help"
    pack [button $w.b -text Close -command "wm withdraw $w" -default active] -side bottom
    pack [scrollText $w.t -wrap none] -padx 4 -pady 4 -fill both -expand 1
    set t $w.t.t
    bind $w <Key-Escape> "wm withdraw $w"
    bind $w <Key-Up>     "$t yview scroll -1 units"
    bind $w <Key-Down>   "$t yview scroll  1 units"
    bind $w <Key-Prior>  "$t yview scroll -1 pages"
    bind $w <Key-Next>   "$t yview scroll  1 pages"
    bind $w <Key-Home>   "$t see 1.0"
    bind $w <Key-End>    "$t see end"
    bind $w <Key-Return> "$t yview scroll  1 units"
    $t insert end $Help
    $t config -state disabled
    $t see 1.0
  }
}


proc About {} {

  global Version

  set w .about
  if {![seeToplevel $w]} {
    toplevel $w -class About
    wm title $w "About TkPasMan"
    wm iconname $w "About TkPasMan"
    pack [button $w.b -text Close -command "wm withdraw $w" -default active] -side bottom
    pack [text $w.t -width 50 -height 13 -wrap word] -fill both -expand 1 -padx 8 -pady 8
    bind $w <Key-Escape> "wm withdraw $w"
    $w.t tag configure title -spacing1 3m -spacing3 5m
    $w.t tag configure p -spacing3 3m
    $w.t tag configure url -spacing3 3m
    skinConfigureDefaultTextTags $w.t title p url
    $w.t insert end \
      "TkPasMan version $Version\n"			title	\
      "TkPasMan was written by Wilbert Berendsen <"	p	\
      wbsoft@xs4all.nl					url	\
      "> in Tcl/Tk. This program is Free Software,\
      distributed under the GNU General Public\
      License.\nA copy of the license is included\
      in the distribution.\nHomepage of TkPasMan: see "	p	\
      http://www.xs4all.nl/~wbsoft/linux		url	\
      .\n 						p
    $w.t configure -state disabled
    center $w widget
  }
}


# SaveHint
#
proc SaveHint {} {

  if {[Save]} {
    Hint "Password file NOT saved"
  } else {
    Hint "Password file saved"
  }
}


# CreateMainGUI
#
# Creates the main gui and menus. Only called once.
#
proc CreateMainGUI {} {

  global state conf

  wm protocol . WM_DELETE_WINDOW Quit

  # menu structure
  set m [menu .menu -tearoff no]

  set s [menu $m.file]
  $m add cascade -menu $s -label &File
  $s add command -label &Save -command SaveHint -accel Ctrl+S
  $s add command -label &Quit -command Quit -accel Ctrl+Q
  
  set s [menu $m.edit]
  $m add cascade -menu $s -label &Edit
  $s add command -label {&Add site} -command Add -accel Ctrl+A
  $s add command -label {&Edit description} -command Edit -accel Ctrl+E
  $s add command -label {&Remove site} -command Remove -accel Ctrl+D

  set s [menu $m.opts]
  $m add cascade -menu $s -label &Options
  $s add check -label {&Read only} -var conf(readonly) -command ShowLocked
  $s add check -label {Confirm S&ave on Quit} -var conf(confirm-save-on-quit)
  $s add check -label {&Confirm Remove site} -var conf(confirm-remove-site)
  global ssl ; if {[array exists ssl]} {
    set k [menu $s.ssl]
    $s add cascade -label Encr&yption -menu $k
    $k add check -label {Use Encr&yption (using openssl)} -var state(use-encryption) -command EnableEncryption
    $k add command -label {Change &Master Password} -command ChangePassword
  }
  $s add sep
  $s add check -label {Show &Passwords} -var conf(show-passwd) -command ShowPassWords
  $s add check -label {Show &Menubar} -var conf(show-menu) -command ShowMenuBar -accel Ctrl+M
  $s add check -label {Show &Statusbar} -var conf(show-status) -command ShowStatusBar
  $s add check -label {Remember &Window size} -var conf(save-windowsize)
  if {[llength [skinList]]} {
    set k [menu $s.skin]
    $s add cascade -label S&kin -menu $k
    $k add radio -label None -var conf(skin) -value none -command {skinSet none}
    $k add sep
    foreach skin [skinList] {
      $k add radio -label $skin -var conf(skin) -value $skin -command [list skinSet $skin]
    }
  }
  $s add sep
  $s add check -label {Save &Options on Quit} -var conf(onquit-save-options)
  $s add command -label {Save Options &Now} -command SaveConfig

  set s [menu $m.help]
  $m add cascade -menu $s -label &Help
  $s add command -label &Help -command Help -accel F1
  $s add command -label &About... -command About

  menuSetLabelAccel $m .

  # (scrolled) list box
  pack [scrollListbox .l -listvar state(listVar) -exportsel 0 -selectm browse] \
       -side left -fill both -expand 1

  # right fields.
  pack [label .lu -text Username:] [entry .u -textvar Entry(username)] \
       [label .lp -text Password:] [entry .p -textvar Entry(password)] \
       [label .ls -text Selection:] \
       [checkbutton .1 -var Entry(sel-user) -text {Username}] \
       [checkbutton .2 -var Entry(sel-pass) -text {Password}] \
       [checkbutton .3 -var Entry(sel-pas2) -text {Repeat Password}] \
       [checkbutton .4 -var Entry(sel-newl) -text {Append Newlines}] \
       -fill x

  # status bar, not now packed, but later.
  statusBar .status -button {quit Quit Quit}
  
  # bindings
  bind . <3> {tk_popup .menu %X %Y}
  bind .l.l <3> {ListboxSelect [%W index @%x,%y]}
  bind .l.l <<ListboxSelect>> {ListboxSelectCallback}

  # default message
  Hint -persistent "Press F1 for Help"
  
  # remind my birthday ;-)
  if {[set age [wilbertsBirthDay]]} { 
    Hint [format "Today it's Wilbert's birthday! (He's now %d)" $age]
  }

  # keep window title up-to-date
  trace variable state(changed) w UpdateWindowTitle

  # update everything in the display
  ShowMenuBar 0
  ShowStatusBar
  ShowPassWords

  UpdateGlobalState
  UpdateWindowTitle
  UpdateListbox
  UpdateSelection
  
  selection handle -type UTF8_STRING . SelectionHandler
  selection handle -type STRING . SelectionHandler
}


# show array names in listbox
proc UpdateListbox {} {

  global PW state
  set state(listVar) [lsort -dict [array names PW]]

}


# manipulate screen selection without touching X selection
proc ListboxSelect index {
  .l.l selection clear 0 end
  .l.l selection set $index
  .l.l see $index
  .l.l activate $index
  UpdateSelection
}


# is called from <<ListboxSelect>> event.
proc ListboxSelectCallback {} {

  global conf state Entry

  UpdateSelection
  if {[string compare $state(selected) {}] && $state(enable-selection)} {
    if {$Entry(sel-newl)} {
      set newline \n
      set p { (with newline)}
    } else {
      set newline {}
      set p {}
    }
    set state(currentSelection) {}
    foreach {selvar var selmsg pastemsg} {
      sel-user username
        "Username selected"
        "Username pasted"
      sel-pass password
        "Password selected"
        "Password pasted"
      sel-pas2 password
        "Password still selected"
        "Password pasted"
    } {
      if {$Entry($selvar)} {
        lappend state(currentSelection) \
          [list $Entry($var)$newline $selmsg $pastemsg$p]
      }
    }
    # Really selected something?
    if {[llength $state(currentSelection)]} {
      # set up a timer for warning when selection is requested too fast.
      # set conf(selection-delay) to the time value in ms that must pass
      # before the first selection request will be performed without warning.
      set state(selectionTimer)\
        [after $conf(selection-delay) {catch {unset state(selectionTimer)}}]
      # Be verbose...
      set ind [lindex $state(currentSelection) 0]
      Hint -persistent "[lindex $ind 1]"
      selection own -command SelectionLose .
    }
  }
}


proc SelectionLose {} {

  Hint -persistent ""
  Hint "Selection lost"
  
}


proc SelectionHandler {from count} {

  global conf state

  # return empty strings while user is in dialog.
  if {[info exists state(inWarning)]} {return {}}

  if {$from == 0} {
    # when an app requests the selection almost immediately, it is possibly
    # not the user, but some app like Downloader or Klipper. The user is
    # warned.
    if {[info exists state(selectionTimer)]} {
      set state(inWarning) 1
      catch { after cancel $state(selectionTimer)
              unset state(selectionTimer) }
      switch [tk_messageBox -icon warning -title Warning\
          -type yesno -default no -parent .\
          -message "Warning! An application has requested the selection\
           too fast, within $conf(selection-delay) ms. Is pasting allowed?"] {
        no {
          unset state(inWarning)
          selection clear
          return {}
        }
        yes {
          unset state(inWarning)
          if {[string compare . [selection own]]} {
            Hint "Selection lost anyway"
            return {}
          }
        }
      }
    }
    if {[llength $state(currentSelection)]} {
      set ind [lindex $state(currentSelection) 0]
      set state(currentSelection) [lrange $state(currentSelection) 1 end]
      if {[llength $state(currentSelection)]} {
        Hint -persistent [lindex [lindex $state(currentSelection) 0] 1]
      } else {
        Hint -persistent ""
        selection clear
      }
      set state(selectionString) [lindex $ind 0]
      Hint [lindex $ind 2]
    }
  }
  return [string range $state(selectionString) $from [expr {$from + $count - 1}]]
}



# updates entries and disable/enable state.
proc UpdateSelection {} {

  global PW state conf Entry
  
  set s [.l.l curselection]
  if {[llength $s]} {
    trace vdelete Entry w TraceEntry
    set state(selected) [lindex $state(listVar) $s]
    foreach {
      Entry(username)
      Entry(password)
      Entry(sel-user)
      Entry(sel-pass)
      Entry(sel-pas2)
      Entry(sel-newl)
    } $PW($state(selected)) break
    trace variable Entry w TraceEntry
    set State normal
  } else {
    trace vdelete Entry w TraceEntry
    set state(selected) {}
    foreach {
      Entry(username)
      Entry(password)
      Entry(sel-user)
      Entry(sel-pass)
      Entry(sel-pas2)
      Entry(sel-newl)
    } [list {} {} 0 0 0 0] break
    set State disabled
  }

  if {$conf(readonly) || $state(readonly)} {
    set State disabled
    set AddState disabled
  } else {
    set AddState normal
  }

  foreach w {.u .p .1 .2 .3 .4} {
    $w config -state $State
  }
  set e .menu.edit
  set E [string equal tearoff [$e type 0]]
  $e entryconfig $E -state $AddState
  $e entryconfig [incr E] -state $State
  $e entryconfig [incr E] -state $State

  global ssl
  if {[array exists ssl]} {
    set e .menu.opts.ssl
    set E [string equal tearoff [$e type 0]]
    $e entryconfig $E -state $AddState
    $e entryconfig [incr E] -state $AddState
  }
}


proc UpdateGlobalState {} {

  global state
  
  set f .menu.file
  set F [string equal tearoff [$f type 0]]
  $f entryconfig $F -state [expr {$state(readonly) ? "disabled" : "normal"}]
}


# Trace changes in Entry
proc TraceEntry args {

  global PW state Entry
  set PW($state(selected)) [list \
  $Entry(username) \
  $Entry(password) \
  $Entry(sel-user) \
  $Entry(sel-pass) \
  $Entry(sel-pas2) \
  $Entry(sel-newl) \
  ]
}


proc UpdateWindowTitle args {

  global state conf Version

  set State {}
  if {$state(readonly)}   { lappend State readonly } else {
    if {$state(changed)}  { lappend State changed  }
    if {$conf(readonly)}  { lappend State locked   }
  }

  set title "TkPasMan-$Version"
  if {[llength $State]} { append title " ([join $State {, }])" }

  wm title . $title
  wm iconname . $title
}


proc ShowMenuBar {{hint 1}} {

  global conf

  if {$conf(show-menu)} {
    . config -menu .menu
  } else {
    . config -menu {}
    if {$hint} {
      Hint "Use right hand mouse button to popup menu"
    }
  }
}


proc ShowStatusBar {} {

  global conf

  if {$conf(show-status)} {
    pack .status -side bottom -fill x -before .l
  } else {
    pack forget .status
  }
}


proc ShowPassWords {} {

  global conf

  if {$conf(show-passwd)} {
    .p configure -show {}
  } else {
    .p configure -show *
  }
}


proc ShowLocked {{hint 1}} {

  global conf state
  
  UpdateWindowTitle
  UpdateSelection
  if {$hint} {
    if {$state(readonly)} {
      Hint "File not writable at all"
    } elseif {$conf(readonly)} {
      Hint "File write protected"
    } else {
      Hint "File is writable"
    }
  }
}


proc Remove {} {

  global PW conf state

  if {$conf(confirm-remove-site) ? [string equal yes \
      [tk_messageBox -title Alert! \
      -message {Do you really want to remove this site?} \
      -type yesnocancel -default cancel -icon warning -parent .]] : 1} {
    if {[string equal . [selection own]]} { selection clear }
    unset PW($state(selected))
    .l.l selection clear 0 end
    UpdateListbox
    UpdateSelection
    Hint "Site removed"
  } else {
    Hint "Remove cancelled"
  }
}


proc Add {} {

  global PW state
  
  set Site [Input {Add site} "Please enter hostname or description:" {}]
  if {[string compare $Site {}]} {
    if {[lsearch -exact $state(listVar) $Site] == -1} {
      set PW($Site) [list {} {} 1 1 0 0]
      UpdateListbox
    }
    ListboxSelect [lsearch -exact $state(listVar) $Site]
  }
}


proc Edit {} {

  global PW state
  
  set Site [Input {Edit description} \
    "Please enter new hostname\nor description:" $state(selected)]
  if {![string equal $Site $state(selected)] && ![string equal $Site {}]} {
    if {[lsearch -exact $state(listVar) $Site] == -1} {
      set PW($Site) $PW($state(selected))
      unset PW($state(selected))
      UpdateListbox
      ListboxSelect [lsearch -exact $state(listVar) $Site]
    } else {
      if {[string equal [
          tk_messageBox -title Alert! -message {Description already exists!} \
          -type retrycancel -default retry -parent .] retry]} {
        after idle Edit
      }
    }
  }
}


# Main... here starts the run-once-at-startup-and-forget-stuff...
namespace import cooltk::*

# There might be some dialogs first.
if {$state(X)} {
  wm withdraw .
}

# Parse command line
if {[llength $argv]} {
  foreach arg $argv {
    switch -exact -- $arg {
      --dump {
        set state(do-dump) 1
        set state(readonly) 1
      }
      
      --disable-selection {
        set state(enable-selection) 0
      }

      --readonly {
        set state(readonly) 1
      }
      
      --version {
        puts stdout "TkPasMan version $Version"
        exit 0
      }

      --help {
        # Fetch usage info from built-in README.
        regexp -lineanchor {(^[\t ]*?--help:.*?\n)\n\n} $Help {} usage
        puts stdout \
"This is TkPasMan version $Version, written by Wilbert Berendsen
<wbsoft@xs4all.nl>. This is Free Software, distributed under the GNU General
Public License. It comes with absolutely NO WARRANTY.\n
Usage: tkpasman \[options\]\n\n$usage"
        exit 0
      }
      
      --fullhelp {
        puts stdout $Help
        exit 0
      }
                             
      default {
        puts stderr "tkpasman: error: Unknown command line option: \"$arg\""
        exit 1
      }
    }
  }
}


# Load user configfile (if exists) in the conf array
if {[file readable $ConfigFile]} {
  set f [open $ConfigFile r]
  # Get the line telling the version.
  gets $f line
  if {[string compare -nocase $line "# TkPasMan-2.1"] < 1} {
    # An old configfile was found.
    set state(old-config) 1
    eval [read $f]
    catch {unset conf(onquit-save)}
    catch {unset conf(allow-two-pastes)}
    set conf(onquit-save-options) 0
  } else {
    array set conf [read $f]
  }
  close $f
}


# Handle skin and other X options, only when in X.
if {$state(X)} {

  # User wants to save window geometry?
  if {$conf(save-windowsize)} {
    wm geometry . $conf(geometry)
  }

  # Try to find best default skin
  if {[string equal $conf(skin) {}]} {
    set conf(skin) [expr {[regexp color [winfo visual .]] ? "Default" : "none"}]
  }

  # Set skin reset command (typically insert some defaults in rec. db)
  set s {
    option clear
    option add *Label.anchor			w
    option add *Radiobutton.anchor		w
    option add *Checkbutton.anchor		w
    option add *StatusBar*takeFocus		0
    option add *StatusBar.Button.padY		0
    option add *Scrollbar.takeFocus		0
    option add *ScrollListbox.Listbox.width	30
    option add *Scrollbar.width			12
    option add *Input.Entry.width			30
    option add *Input.Message.font	{Times 18}
    option add *Input.Message.aspect		400
    option add *About*AllJustify	center
    option add *About*AllFont	{helvetica 12}		widgetDefault
    option add *About*titleFont	{helvetica 18 bold}	widgetDefault
    option add *About*urlUnderline	1		widgetDefault
  }
  if {[regexp color [winfo visual .]]} {
    append s {
      option add *About*urlForeground blue	widgetDefault
    }
  }
  skinSetResetCommand $s ; unset s
  skinSet $conf(skin)
}

# Warn the user if an old config file was found.
if {$state(old-config)} {
  if {$state(X)} {
    tk_messageBox -type ok -icon warning -title Warning -parent . \
      -message "Warning: an old configuration file for\
       [string range $line 2 end] was found.\n\nI have imported your\
       options, but when you save your config, you will not be able\
       to use it with an old version of TkPasMan."
  } else {
    puts stderr "tkpasman: warning: old configfile found, importing"
  }
}

# Just doing a dump?
if {$state(do-dump)} {
  if {[Open]} {
    puts stderr "tkpasman: error: could not open password file -- exit for now"
    exit 1
  }
  Dump
  exit
}

# Now, if the user is running without X, exit with a warning.
if {! $state(X)} {
  puts stderr "tkpasman: To get the user interface, you must run tkpasman from within X!\nType `tkpasman --help' for info."
  exit 1
}  

# Open, if the user is running in X.
if {[Open]} {
  puts stderr "tkpasman: error: could not open password file -- exit for now"
  exit 1
}
CreateMainGUI
wm deiconify .