Version 2 of playtkl, testing Tk apps and playing macros

The playtkl is Tcl/Tk package that is used:

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: recording and playing. At recording, mouse / keyboard actions occurred 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. Other GUI Tcl libraries aren't supported.

Testing Tk

With GUI applications, tcltest and doctest couldn't help you a lot.

To test a GUI application "properly", you might act this way:

You record the key / mouse pressings in the application, supposedly at its "good" behavior. Thus, you get a testing scenario of "good" behavior.
After a while, some changes are made to the application.
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.
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 package is rather good for this way of testing.

Of course, as usually with Tcl/Tk, there are alternative ways, see e.g.

How's that

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
      after 4000 "playtkl::record $playtklfname F11"  ;# 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:

recording with playtkl::record
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 in a working mode of Tk application, when the 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.
#
# Run with the command:
#
#  tclsh ~/PG/github/apave_tests/tests/test2_pave.tcl lightbrown 4 10 12 "small icons"
#
# playtkl:   Recording: 11:20:26
# playtkl:         End: 11:26:40
#
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 start / end of recording.

At need, any lines can be commented out, e.g. last ones that close the application as shown above.

Macros

The usage of playtkl to record / play macros is nearly the same as above described.

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.

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 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
playtkl doesn't catch events related to window managers like clicking a window's title buttons

With movable widgets like scrollbars, scales, rulers etc., there may be problems when the widgets are moved too fast at recording - then, at playing them, the mouse pointer can lag a bit, so that the replayed picture would be distorted. Though a bit annoying, this artifact isn't critical in most cases.

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.

Code

###########################################################
# 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.0

# _________________________ playtkl ________________________ #

namespace eval playtkl {
  variable fields {-time %t -keysym %K -button %b -x %x -y %y -state %s -data %d}
  variable dd; array set dd {timing 1 endkey "" pausekey ""}
}
#_______________________

proc playtkl::inform {msg} {
  # Puts out a short 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)} {
    set msg [string range "          $msg" end-10 end]
    set msg "playtkl: $msg: [clock format [clock seconds] -format %T]"
    puts $msg
    bell
  }
  return $msg
}
#_______________________

proc playtkl::Data {w data} {
  # Extracts event's data of wildcard
  #   w - the wildcard
  #   data - full list of %w=data

  set i [lsearch -glob $data $w*]
  set d [lindex $data $i]
  return [string range $d [string first = $d]+1 end]
}
#_______________________

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 {$ev eq {KeyRelease} && $dd(prevev) ne {KeyPress} && $key in {Tab Return}} {
        set t %t=[expr {[Data %t $args]-1}]
        lappend dd(fcont) KeyPress\ $win\ $args\ $t
      }
      lappend dd(fcont) $ev\ $win\ $args
      set dd(prevev) $ev
    }
  }
}
#_______________________

proc playtkl::Playing {} {
  # Plays a current record.

  variable fields
  variable dd
  set llen [llength $dd(fcont)]
  if {[incr dd(idx)]>=$llen} {
    end
    return
  }
  if {$dd(pause)} {
    after 300 ::playtkl::Playing
    return
  }
  set line [lindex $dd(fcont) $dd(idx)]
  if {[regexp {^\s*#+} $line#]} { ;# skip empty or commented
    after idle ::playtkl::Playing
    return
  }
  lassign $line ev win
  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
      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]} {
    after idle [list event generate $win <Motion> -warp 1 -x $X -y $Y]
  } else {
    after idle [list event generate $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]} {
    set aft idle
  } else {
    set aft [expr {max(0,$time1-$time)}]
  }
  after $aft ::playtkl::Playing
}
#_______________________

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::record {fname {endkey ""}} {
  # Starts the recording.
  #   fname - name of file to store the recording
  #   endkey - key to stop the recording

  variable fields
  variable dd
  set dd(isrec) yes
  if {$dd(endkey) eq {}} {
    foreach {o w} $fields {append opts " {%$w=$w}"}
    foreach ev {KeyPress KeyRelease ButtonPress ButtonRelease Motion} {
      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]
}

# ________________________ Play-back _________________________ #

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 ""} {ismacro yes}} {
  # Replays a read/written recording, fastly at replaying a macro.
  #   fname - name of file to store the recording
  #   ismacro - yes for fast replaying a macro

  variable dd
  set dd(idx) -1
  set dd(isrec) no
  set dd(pause) no
  if {$fname ne {}} {
    set ch [open $fname]
    set dd(fcont) [split [string trim [read $ch]] \n]
    close $ch
  }
  if {$ismacro} {
    set fcont [list]
    set time 0
    foreach line $dd(fcont) {
      if {![regexp {^\s*#+} $line#]} { ;# skip empty or commented
        set ln [lrange $line 0 1]
        append ln " %t=[incr time 2] " [lrange $line 3 end]
        lappend fcont $ln
      }
    }
    set dd(fcont) $fcont
  }
  Playing
  inform Playing
}

# ________________________ Game over _________________________ #

proc playtkl::end {} {
  # Closes the recording/playing.

  variable dd
  set msgend [inform End]
  if {$dd(isrec)} {
    set dd(fcont) [lsort -index 2 -dictionary $dd(fcont)] ;# sort by time
    set dd(fcont) [linsert $dd(fcont) 0 "# $dd(msgbeg)" "# $msgend" #]
    set ch [open $dd(fname) w]
    foreach line $dd(fcont) {puts $ch $line}
    close $ch
  }
  set dd(isrec) 0
  set dd(endkey) -
}
#_______________________

proc playtkl::isend {} {
  # Checks if no recording is performed.

  variable dd
  return [expr {$dd(endkey) in {- ""}}]
}

# _______________________ EOF _______________________ #

Category GUI

Category Testing