The following code allows a password to be generated according to 
a set of simple rules (length, minimum number of characters from a number
of sets).  It presents a GUI which a user can then use to "train" on the
new password to aid in remembering it by getting it "into ones fingers". 

It is fairly simplistic.  Any suggested improvements would be gratefully 
received.  Edit any suggested improvements straight inline. --[MNO]

----

 #!/bin/sh
 # Emacs: please open this file in -*-Tcl-*- mode
 # the next but one line restarts with wish...
 # DO NOT REMOVE THIS BACKSLASH -> \
         exec wish "$0" ${1+"$@"}
 #
 # Author: Mark Oakden http://wiki.tcl.tk/MNO
 # Version: 1.0
 #
 # password generator and drilling program:
 # generate a password according to the rules array and allow the user to
 # test themselves on said password,  displaying statistics on how often
 # they get it right
 #
 # no sanity checks on the supplied rules are done.
 #
 # datasets for password generation:-
 # separate lowercase and UPPERCASE letters so we can demand minimum
 # number of each separately.
 set data(letters) "abcdefghijklmnopqrstuvwxyz"
 set data(LETTERS) "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
 set data(numbers) "0123456789"
 set data(punctuation) "!\"£$%^&*()_+-={};':@#~<>,.?/\\|"
 
 # a simpler set might be, for example:-
 #
 # set data(letters) "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
 # set data(numbers) "0123456789"
 # set data(punctuation) "!\"£$%^&*()_+-={};':@#~<>,.?/\\|"
 
 # the rules determine characteristics of the randomly generated passwords
 # presently available are:-
 # rules(len) password length
 # rules(<dataset_name>,min) minimum number of characters from <dataset_name>
 # entry on the data array
 
 # example rules:-
 # password 7 chars long, with at least one U/C char, one l/c char,
 # one number and one punctuation.
 set rules(len) 7
 set rules(letters,min) 1
 set rules(LETTERS,min) 1
 set rules(numbers,min) 1
 set rules(punctuation,min) 1
 
 # example rules appropriate to the commented "simpler" datasets above:-
 #
 # set rules(len) 7
 # set rules(numbers,min) 1
 # set rules(punctuation,min) 1
 
 proc initStats {} {
     global stats
     set stats(tries) 0
     set stats(correct) 0
     updateStatsDisplay
 }
 
 # picks a (pseudo)random char from str
 proc oneCharFrom { str } {
     set len [string length $str]
     set indx [expr int(rand()*$len)]
     return [string index $str $indx]
 }
 
 # for a string of length n,  swap random pairs of chars n times
 # and return the result
 proc shuffle { str } {
     set len [string length $str]
     for { set i 1 } { $i <= $len } { incr i 1 } {
 	set indx1 [expr int(rand()*$len)]
 	set indx2 [expr int(rand()*$len)]
 	set str [swapStringChars $str $indx1 $indx2]
     }
     return $str
 }
 
 # given a string, and integers i and j, swap the ith and jth chars of str
 # return the result
 proc swapStringChars { str i j } {
     if { $i == $j } {
 	return $str
     }
     if { $i > $j } {
 	set t $j
 	set j $i
 	set i $t
     }
     set pre [string range $str 0 [expr $i - 1]]
     set chari [string index $str $i]
     set mid [string range $str [expr $i + 1] [expr $j - 1]]
     set charj [string index $str $j]
     set end [string range $str [expr $j + 1] end]
 
     set ret ${pre}${charj}${mid}${chari}${end}
     return $ret
 }
 
 # generate a password
 proc genPw {} {
     global data rules
     # Algorithm
     # 1. foreach dataset with a min parameter, choose exactly min 
     #    random chars from it
     # 2. concatenate results of above into password
     # 3. concatenate all datasets into large dataset
     # 4. choose desired_length-password_length chars from large
     # 5. concatenate (4) and (2)
     # 6. shuffle (5)
 
     set password {}
     foreach indx [array names rules *,min] {
 	set ds_name [lindex [split $indx ,] 0]
 	set num $rules($indx)
 	for {set i 1} {$i <= $num} {incr i 1} {
 	    append password [oneCharFrom $data($ds_name)]
 	}
     }
 
     set all_data {}
     foreach set [array names data] {
 	append all_data $data($set)
     }
 
     set rem_len [expr $rules(len) - [string length $password]]
     for {set i 1} {$i <= $rem_len} {incr i 1} {
 	append password [oneCharFrom $all_data]
     }
 
     return [shuffle $password]
 }
 #
 # routines for the GUI
 #
 # get a new password, update stats and GUI
 proc newPass {} {
     global password displaypass pwattempt pwishidden
     set password [genPw]
     set pwattempt {}
     set pwishidden 0
     set displaypass $password
     .pw configure -text $password
     initStats
     update idletasks
     return
 }
 
 # toggle whether the password is displayed or not
 proc hideOrShowPass {} {
     global password displaypass pwishidden
     set hidden [starString $password]
     if { $pwishidden } {
 	set displaypass $password
     } else {
 	set displaypass $hidden
     }
     # toggle the hidden state
     set pwishidden [expr 1 - $pwishidden]
     update idletasks
 }
 
 # return a string same length as argument str filled with "*"
 proc starString { str } {
     set ret {}
     foreach char [split $str {}] {
   	append ret "*"
     }
     return $ret
 }
 # the following works in 8.3 and above, but not in 8.0 or the plugin...
 #proc starString { str } {
 #    return [string repeat "*" [string length $str]]
 #}
 
 # check a password typed by user, update stats and GUI
 proc testPass {} {
     global pwattempt password feedback stats
     incr stats(tries)
     # would like to use [string equal] in the following but doesn't work
     # in 8.0 or the plugin
     if {[string compare $password $pwattempt] == 0} {
 	set feedback "Correct"
 	.feedback configure -background green
 	incr stats(correct)
     } else {
 	set feedback "Wrong"
 	.feedback configure -background red
     }
     set pwattempt {}
     updateStatsDisplay
     update idletasks
     return
 }
 
 # update the string used to display stats in GUI
 proc updateStatsDisplay {} {
     global stats formattedStats
     set formattedStats "$stats(correct)/$stats(tries) "
     if { $stats(tries) != 0 } {
 	set perc [expr 100*double($stats(correct))/double($stats(tries))]
     } else {
 	set perc 0
     }
     append formattedStats [format "(%.1f%%)" $perc]
     return
 }
 #
 # set up the GUI
 #
 initStats
 set password [genPw]
 set displaypass $password
 set pwishidden 0
 set formattedStats {0/0 (0%)}
 set feedback {}
 button .newpw -text {New} -command newPass
 label .pw -font {Courier} -textvariable displaypass
 button .hide -text "Show/Hide" -command hideOrShowPass
 entry .try -font {Courier} -show "*" -width $rules(len) -textvariable pwattempt
 label .feedback -textvariable feedback
 label .stats -text "Stats:"
 label .statval -textvariable formattedStats
 button .statreset -text "Reset Stats" -command initStats
 grid .newpw .pw .hide -sticky ew
 grid .try - .feedback -sticky ew
 grid .stats .statval .statreset -sticky ew
 grid columnconfigure . 1 -weight 1
 focus .try
 bind .try <Return> testPass

----

[RLH] - I ran it through [Nagelfar]:

 Line  65: W Expr without braces
 Line  74: W Expr without braces
 Line  75: W Expr without braces
 Line  92: W Expr without braces
 Line  94: W Expr without braces
 Line  94: W Expr without braces
 Line  96: W Expr without braces
 Line 128: W Expr without braces
 Line 161: W Expr without braces
 Line 203: W Expr without braces

----
[[
[Category Application]
]]