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

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

** 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/download/demo-playtkl-1.0/demo-playtkl-1.0.1.mp4%|%Demo of testing (dark theme)]
   * [https://github.com/aplsimple/playtkl/releases/download/demo-playtkl-1.0/demo-playtkl-1.0.mp4%|%Demo of testing (light theme)]
   * [https://github.com/aplsimple/playtkl/releases/download/demo-playtkl-1.0/demo-macro-playtkl-1.0.1.mp4%|%Demo of macros]

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

# _________________________ 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::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::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 {
      set t [Data %t $args]
      if {[string is integer -strict $t] && $t>0} {
        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
      } else {
        inform yes
        inform "BUG? (time received 0): $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 200 ::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 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]} {
    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::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]"
    puts $msg
  } else {
    set msg {}
  }
  return $msg
}
#_______________________

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 {![info exists dd(msgbeg)]} {
    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]
}

# ________________________ Playback _________________________ #

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}} {
  # 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)

  variable dd
  if {$fname ne {}} {
    set ch [open $fname]
    set dd(fcont) [split [string trim [read $ch]] \n]
    close $ch
  }
  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]
    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
  }
  inform Playing
  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
    if {$msgend ne {}} {
      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
  }
  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 no recording is performed.

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

# _______________________ EOF _______________________ #

======

<<categories>> GUI | Testing