playtkl, testing Tk apps and playing macros

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: 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.

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
      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:

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

Macros

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:

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

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

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

Category GUI

Category Testing