It is [Tcl/Tk] package: * to make a testing scenario for a [Tk] application * to run a testing scenario for a [Tk] application * to record a macro containing mouse / keyboard actions * to play a macro So, there are two working modes of [playtkl, testing Tk apps and playing macros%|%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, testing Tk apps and playing macros%|%playtkl] is used only with [Tk] applications. [Alternative GUI toolkits] (non-Tk) aren't supported. ** Testing Tk ** With GUI applications, [tcltest] and [doctest for Tcl%|%doctest] couldn't help you a lot. To test a GUI application "properly", you might act this way: 1. You ''record'' the key / mouse pressings in the application, supposedly at its "good" behavior. Thus, you get a testing scenario of "good" behavior. 2. After a while, some changes are made to the application. 3. You ''play back'' the testing scenario in the application, viewing this spectacle and noticing all discrepancies against the "good" behavior. Or just comparing the final state of the played to the recorded. 4. You repeat steps 2 and 3 to keep the application consistent with the testing scenario. At need 1st step can be repeated too, if some cool features are introduced into the application. Old scenarios may be saved and rerun as well. The [playtkl, testing Tk apps and playing macros%|%playtkl] package is rather good for this way of testing. Of course, as usually with [Tcl/Tk], there are alternative ways, see e.g. * [A little GUI tester] * [Law of Demos, tests and transpops] ** How's that ** To enable [playtkl, testing Tk apps and playing macros%|%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: * sets a file name as "./playtkl.log" * disables info messages on begin / end (by default, they are shown in stdout) * depending on a current mode, runs: 1. recording with `playtkl::record` 2. playing with `playtkl::play` * before exit, `playtkl::end` is a must if no key was pressed to stop the recording 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, testing Tk apps and playing macros%|%playtkl] in a working mode of [Tk] application, when the [playtkl, testing Tk apps and playing macros%|%playtkl] stuff is disabled with "if 0 ..." command (or with commenting out). ** Records ** 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, testing Tk apps and playing macros%|%playtkl] itself) and possibly a user's comments (on a specific package to test, here [Pave, sort of geometry manager%|%apave]). At need, any lines can be commented out, e.g. last ones that close the application as shown above. ** Macros ** The recording and playing macros is a side effect of the [playtkl, testing Tk apps and playing macros%|%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, testing Tk apps and playing macros%|%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 [https://aplsimple.github.io/en/tcl/playtkl/playtkl.html%|%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: * characters * arrows, Home, End, PgUp, PgDown * Ctrl+C, Ctrl+V, Ctrl+X, Ctrl+Arrow, Ctrl+K * Shift+Home, Shift+End, Shift+Arrow * Delete, BackSpace Though not recommended, the mouse actions can be recorded/played too. The [playtkl, testing Tk apps and playing macros%|%playtkl] can optionally ignore the mouse at recording. In [alited, a lite editor], [playtkl, testing Tk apps and playing macros%|%playtkl]'s macro facility is implemented in its full capacity as seen in [https://github.com/aplsimple/playtkl/releases/tag/demo-playtkl-1.3%|%this demo]. ** Issues ** 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): * [playtkl, testing Tk apps and playing macros%|%playtkl] cannot catch those events that occur outside of [Tk], e.g. MS Windows' file and color choosers don't provide any [Tk] bindings and as such aren't seen by [playtkl, testing Tk apps and playing macros%|%playtkl] * [playtkl, testing Tk apps and playing macros%|%playtkl] doesn't catch events related to window managers like clicking a window's title buttons 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, testing Tk apps and playing macros%|%playtkl] allows testing the main functions of [Tk] apps and enhancing their facilities with macros. ** Links ** * [https://aplsimple.github.io/en/tcl/playtkl/playtkl.html%|%Reference] * [https://chiselapp.com/user/aplsimple/repository/playtkl/download%|%Source #1] * [https://github.com/aplsimple/playtkl%|%Source #2] * [https://github.com/aplsimple/playtkl/releases/tag/demo-playtkl-1.3%|%Demos] ** Code ** ====== ########################################################### # Name: playtkl.tcl # Author: Alex Plotnikov (aplsimple@gmail.com) # 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 [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 _______________________ # ====== <> GUI | Testing