It is Tcl/Tk package:
So, there are two working modes of playtkl: recording and playing. At recording, mouse / keyboard actions in a Tk application are saved to a file. At playing, the saved actions are read from the file and played back as if the actions were performed by a human.
The playtkl is used only with Tk applications. Alternative GUI toolkits (non-Tk) aren't supported.
With GUI applications, tcltest and doctest couldn't help you a lot.
To test a GUI application "properly", you might act this way:
The playtkl package is rather good for this way of testing.
Of course, as usually with Tcl/Tk, there are alternative ways, see e.g.
To enable playtkl, a Tk application should source playtkl.tcl and then run the recording or the playing part of it, for example this way:
if 0 { source playtkl.tcl set playtklfname ./playtkl.log playtkl::inform no if 0 { # 1. recording set details "mypackage v$::mypackageVersion" after 4000 "playtkl::record $playtklfname F11 {$details}" ;# or just: playtkl::record $playtklfname } else { # 2. playing after 4000 "playtkl::play $playtklfname F12" ;# or just: playtkl::play $playtklfname } } ... if {[info commands playtkl::end] ne {}} playtkl::end exit
Above, after the sourcing, a Tk application does the following:
In the above example, the recording and playing are run after 4 seconds of waiting for supposed initialization done. It depends on an application.
Also note that F11 is passed as 2nd (omitable) argument to playtkl::record which means a key to stop the recording. This key is mostly good for a macro recording.
The stop key is also useful for testing Tk applications. If a scenario was stopped with a key, then the final state of the application after its playback should be the same as it was after the recording. It's only the final states that can be interesting: if they didn't coincide, the test failed.
In the above example, F12 is passed as 2nd (omitable) argument to playtkl::play which means a key to pause / resume the playing.
The example shows a use of playtkl in a working mode of Tk application, when the playtkl stuff is disabled with "if 0 ..." command (or with commenting out).
The file of records can contain empty lines and comments like this:
# # It's a playtkl test for apave package. # # /home/apl/PG/github/apave_tests/tests/test2_pave.tcl lightbrown 4 9 12 small icons # apave v4.3.8 # # Tcl v9.0 : /home/apl/UTILS/wish9.0 # byteOrder = littleEndian # engine = Tcl # machine = x86_64 # os = Linux # osVersion = 5.10.0-10-amd64 # pathSeparator = : # platform = unix # pointerSize = 8 # user = apl # wordSize = 8 # # playtkl: Recording: 09:16:43 Feb 03, 2024 # playtkl: End: 09:16:46 Feb 03, 2024 # Motion .win.#win#menu %t=13150304 %K=?? %b=?? %x=399 %y=1 %s=16 %d=?? Motion .win.#win#menu %t=13150312 %K=?? %b=?? %x=397 %y=6 %s=16 %d=?? ... #ButtonPress .win.#win#menu.#win#menu#file %t=13455419 %K=?? %b=1 %x=46 %y=152 %s=16 %d=?? #ButtonRelease .win.#win#menu.#win#menu#file %t=13455611 %K=?? %b=1 %x=46 %y=152 %s=272 %d=??
It begins with comments about the platform info, the start / end of recording (all added by playtkl itself) and possibly a user's comments (on a specific package to test, here apave).
At need, any lines can be commented out, e.g. last ones that close the application as shown above.
The recording and playing macros is a side effect of the playtkl's main usage. However small, this effect is rather effective sometimes.
The recording and playing macros are performed inside and for a Tcl/Tk application, so that no need for "if 0 ..." to disable playtkl.
A stop key should be passed to playtkl::record. And vice versa, the key to pause / resume macros isn't of much importance.
To check if the recording is still active, playtkl::isend is used.
For example:
proc NS::checkrecording {{first yes}} { if {[playtkl::isend]} { bell ;# or something like "resumeWorkFlow", or nothing at all } else { if {$first} pauseWorkFlow after 300 {NS::checkrecording no} } } ... playtkl::inform no playtkl::record $playtklfname F11 NS::checkrecording ... playtkl::replay $playtklfname ... playtkl::replay ... playtkl::replay
To replay a macro, playtkl::replay is used. A recorded file's name can be passed to playtkl::replay. When playtkl::replay has no arguments, it doesn't read a file of records, it just replays what was read and played before. Other facilities of playtkl::replay can be seen in Reference , e.g. using a callback for "text edit separator" to undo / redo at one blow.
At recording a macro, it would be good to abide by the rules:
1. Only the keyboard should be used, because though it isn't forbidden the mouse moves are no good.
2. Preferable are usual typewriter keys like these:
Though not recommended, the mouse actions can be recorded/played too. The playtkl can optionally ignore the mouse at recording.
In alited, a lite editor, playtkl's macro facility is implemented in its full capacity as seen in this demo .
The initial state of a tested Tk application should be absolutely the same at recording and at playing a testing scenario. If the application uses configuration files, these files should be supplied to it in the same state at recording and at playing. It refers mostly to a geometry of Tk application as a whole and to its internal widgets which depend on a ttk theme. But an application's behavior can interfere with the playing too. Probably, OS environments should be identical, e.g. the less the loaded programs the better (esp. notifiers & schedulers).
The following two facts should be counted (i.e. appropriate uses should be avoided):
However, if played okay once, a recorded scenario would be played okay in all future runs as well. It isn't hard to reach.
All in all, playtkl allows testing the main functions of Tk apps and enhancing their facilities with macros.
########################################################### # Name: playtkl.tcl # Author: Alex Plotnikov ([email protected]) # Date: Mar 01, 2023 # Brief: Handles playing macro & testing Tk apps. # License: MIT. ########################################################### package provide playtkl 1.4.1 # _________________________ playtkl ________________________ # namespace eval playtkl { variable fields {-time %t -keysym %K -button %b -x %x -y %y -state %s -data %d -delta %D} variable dd; array set dd {timing 1 endkey "" pausekey ""} } #_______________________ proc playtkl::Data {wc data} { # Extracts event's data of wildcard # wc - the wildcard # data - full list of %w=data set i [lsearch -glob $data $wc=*] set d [lindex $data $i] return [string range $d [string first = $d]+1 end] } #_______________________ proc playtkl::Mapping {win} { # Maps a recorded window to a played one. # win - the recorded window's path # At recording, some widgets may be dynamic, with their pathes not equal to current ones # => map them. variable dd foreach {w1 w2} $dd(mappings) { if {[string match $w1 $win]} {return $w2} } return $win } #_______________________ proc playtkl::Recording {win ev args} { # Saves data of an event occured on a window. # win - window's path # ev - event # args - data variable dd if {![isend]} { set key [Data %K $args] if {$key eq $dd(endkey)} { end } else { if {!$dd(mouse) && $ev in {ButtonPress ButtonRelease Motion MouseWheel}} return set t [Data %t $args] if {[string is integer -strict $t] && $t>0} { set t %t=[expr {[Data %t $args]-1}] set ifound -1 if {$key in {Tab Return}} { if {$ev eq {KeyRelease} && $dd(prevev) ne {KeyPress}} { lappend dd(fcont) "KeyPress $win $args $t" } } elseif {$ev eq {KeyRelease} && ([string length $key]==1 || \ $key in {Left Right Up Down Home End Next Prior \ F1 F2 F3 F4 F5 F6 F7 F8 F9 F10 F11 F12})} { # KeyRelease of "Ctrl/Alt/Shift + char/navigating/function key" sets the problem: # the previous KeyPress can be not registered by Tk (only Control's etc.) # => no response from KeyPress bindings set ifound [FindPrevEvent $key KeyPress $ev $win {*}$args] if {$ifound<0} { lappend dd(fcont) "KeyPress $win $args $t %B=??" ;# %B stands for DEBUG } } if {$ifound<0} { lappend dd(fcont) "$ev $win $args" } } else { inform yes inform "BUG? (time received 0): $ev $win $args" } set dd(prevev) $ev } } } #_______________________ proc playtkl::FindPrevEvent {key ev ev2 win args} { # Searches events "ev" and "ev2" in dd(fcont) list. # key - current key # ev - the main event to search # ev2 - the event tied to the main event # win - current widget's path # args - parameters of current event variable dd set ifound -1 for {set i [llength $dd(fcont)]} {$i} {incr i -1} { set item [lindex $dd(fcont) $i] lassign $item e w set k [Data %K $item] if {$e in "$ev $ev2" && $w eq $win && $k eq $key} { if {$e eq $ev} {set ifound $i} break } } return $ifound } #_______________________ proc playtkl::Playing {} { # Plays a current record. variable fields variable dd if {$dd(pause)} { after 200 ::playtkl::Playing return } set llen [llength $dd(fcont)] if {[incr dd(idx)]>=$llen} { catch { if {$dd(ismacro)} { focus [winfo toplevel $dd(wfocus)] focus $dd(wfocus) } } end return } set line [lindex $dd(fcont) $dd(idx)] if {[regexp {^\s*#+} $line#]} { ;# skip empty or commented puts $line after idle ::playtkl::Playing return } if {[string match {stop *} $line]} { bell set scom [string range $line 5 end] set slin "Line#[expr {$dd(idx)+1}]: $scom =" if {[catch {set line "$slin [expr $scom]"}]} { catch {set line "$slin [eval $scom]"} } puts -nonewline stdout "$line : " chan flush stdout gets stdin _ puts {} after idle ::playtkl::Playing return } lassign $line ev win set win [Mapping $win] if {$dd(timing) eq {YES}} {inform "$dd(idx): $line"} ;# to debug set data [lrange $line 2 end] # mouse buttons: pressed on one window, released on other not existing yet if {![winfo exists $win]} { for {set i $dd(idx)} {$i<$llen && $win ne $dd(win)} {incr i} { set l1 [lindex $dd(fcont) $i] lassign $l1 e1 w1 set w1 [Mapping $w1] if {$e1 in {ButtonPress ButtonRelease} && [winfo exists $w1]} { set dd(fcont) [lreplace $dd(fcont) $i $i] set t [Data %t $dd(data)] set dd(fcont) [linsert $dd(fcont) $dd(idx) "$l1 %t=[incr t]"] incr dd(idx) -1 break } } after idle ::playtkl::Playing return } set opts {} set time 0 foreach wdt $data { set wc [string range $wdt 0 1] set dt [string range $wdt 3 end] ;# e.g. %x=657 if {$dt ne {??}} { if {$wc eq {%t}} { set time $dt continue } if {$wc eq {%x}} {set X $dt} if {$wc eq {%y}} {set Y $dt} set i [lsearch -exact $fields $wc] append opts { } [lindex $fields $i-1 0] { } $dt } } set dd(win) $win set dd(data) $data if {$ev eq {Motion} && [info exists X] && [info exists Y]} { GenerateEvent $win Motion -warp 1 -x $X -y $Y -state [dict get $opts -state] } else { GenerateEvent $win $ev {*}$opts } set line [lindex $dd(fcont) $dd(idx)+1] set time1 [Data %t [lrange $line 2 end]] if {!$time || ![string is integer -strict $time1] || $dd(ismacro)} { set aft idle } else { set aft [expr {max(0,$time1-$time)}] } after $aft ::playtkl::Playing } #_______________________ proc playtkl::GenerateEvent {win ev args} { # Generates an event for a widget. # win - widget's path # ev - event variable dd if {[winfo exists $win]} { if {$dd(ismacro)} { event generate $win <$ev> {*}$args } else { after idle [list after 0 event generate $win <$ev> {*}$args] } } } #_______________________ proc playtkl::PausePlaying {pausekey key} { # Pauses / resumes the playing. # pausekey - key to pause/resume # key - pressed key variable dd if {$pausekey eq $key} { if {[set dd(pause) [expr {!$dd(pause)}]]} {inform Paused} {inform Resumed} } } # ________________________ Record _________________________ # proc playtkl::inform {msg} { # Puts out a message and the current time. # msg - the message or yes/no to switch the puts on/off variable dd if {[string is boolean $msg]} { set dd(timing) $msg } elseif {$dd(timing)} { if {[string length $msg]<11} { bell set msg [string range " $msg" end-10 end] } set msg "playtkl: $msg: [clock format [clock seconds] -format {%T %b %d, %Y}]" puts $msg } else { set msg {} } return $msg } #_______________________ proc playtkl::record {fname {endkey ""} {mouse yes} {details ""}} { # Starts the recording. # fname - name of file to store the recording # endkey - key to stop the recording # mouse - "no" to disable mouse events # details - additional info on the recording variable fields variable dd set dd(isrec) yes set dd(mouse) $mouse set dd(details) [string map [list \n "\n# "] $details] if {![info exists dd(msgbeg)]} { foreach {o w} $fields {append opts " {%$w=$w}"} foreach ev {KeyPress KeyRelease ButtonPress ButtonRelease Motion MouseWheel} { bind all <$ev> "+ ::playtkl::Recording %W $ev $opts" } } set dd(fname) $fname set dd(endkey) $endkey set dd(idx) -1 lassign {} dd(prevev) dd(fcont) dd(win) set dd(msgbeg) [inform Recording] } # ________________________ Playback _________________________ # proc playtkl::readcontents {fname} { # Reads (updates) a log file's contents. Useful at changing the file manually. # fname - file name variable dd catch { set ch [open $fname] set dd(fcont) [split [string trim [read $ch]] \n] close $ch } } #_______________________ proc playtkl::play {fname {pausekey ""}} { # Starts the playback. # fname - name of file to store the recording # pausekey - key to pause/resume the playing variable dd if {$pausekey ne {} && $pausekey ne $dd(pausekey)} { bind all <KeyPress> [list + ::playtkl::PausePlaying $pausekey %K] set dd(pausekey) $pausekey } replay $fname {} {} no } #_______________________ proc playtkl::replay {{fname ""} {cbreplay ""} {mappings {}} {ismacro yes} {wfocus ""}} { # Replays a read/written recording, fastly at replaying a macro. # fname - name of file to store the recording # cbreplay - callback after replaying (e.g with "text edit separator") # mappings - mappings of some widgets' pathes to currently used ones # ismacro - yes for fast replaying a macro (used by playtkl) # wfocus - currently focused widget variable dd if {$wfocus eq {}} {set wfocus [focus]} set dd(wfocus) $wfocus set dd(ismacro) $ismacro if {$fname ne {}} {readcontents $fname} set line [lindex $dd(fcont) 0] lassign $line dd(prevev) dd(win) set dd(data) [lrange $line 2 end] set dd(idx) -1 set dd(isrec) no set dd(pause) no set dd(cbreplay) $cbreplay set dd(mappings) $mappings if {$ismacro} { set fcont [list] foreach line $dd(fcont) { if {![regexp {^\s*#+} $line#]} { ;# skip empty or commented set ln [lrange $line 0 1] append ln " %t=0 " [lrange $line 3 end] lappend fcont $ln } } set dd(fcont) $fcont } inform Playing Playing } # ________________________ Game over _________________________ # proc playtkl::end {{macrodetails ""}} { # Closes the recording/playing. # macrodetails - comments to macro to be recorded variable dd set msgend [inform End] if {$dd(isrec)} { set dd(fcont) [lsort -index 2 -dictionary $dd(fcont)] ;# sort by time if {$msgend ne {}} { set details {} catch {append details "# $::argv0 $::argv"} append details "\n# $dd(details)" set tp "# Tcl v[info tclversion] : [info nameofexecutable]" foreach a [lsort [array names ::tcl_platform]] { append tp "\n# $a = " $::tcl_platform($a) } set dd(fcont) [linsert $dd(fcont) 0 $details # $tp # "# $dd(msgbeg)" "# $msgend" #] } if {$macrodetails ne {}} { set macrodetails #[string trim $macrodetails #\n] set dd(fcont) [linsert $dd(fcont) 0 [string map [list \n \n#] $macrodetails]] } set ch [open $dd(fname) w] foreach line $dd(fcont) {puts $ch $line} close $ch } if {[info exists dd(cbreplay)] && $dd(cbreplay) ne {}} { {*}$dd(cbreplay) } unset -nocomplain dd(cbreplay) set dd(isrec) 0 set dd(endkey) - } #_______________________ proc playtkl::isend {} { # Checks if the recording is done. variable dd expr {!$dd(isrec)} } # _______________________ EOF _______________________ #