##############################################################
# atomselect tracing and debugging
namespace eval ::DebugAtomSelect:: {
    variable verbose           0 ; # print a message whenever create/delete?
    variable status            0 ; # debugging on or off?
    variable started "not active"; # date when tracing started
    variable total_sel_count   0 ; # counter of total selections since active
    variable total_sel_added   0 ; # counter of selections added since active
    variable total_sel_deleted 0 ; # counter of selections deleted since active
    variable wrapped_atomsels    ; # hash of selection procs that are wrapped
    variable alias_token         ; # token required to undo alias.
    array set wrapped_atomsels {}
    namespace export debug_atomselect
}

# this is the atomselect proxy that will trace the atomselect calls.
proc ::DebugAtomSelect::atomselect_proxy {args} {
    variable verbose 
    variable total_sel_count
    variable total_sel_added
    variable wrapped_atomsels

    if {$verbose} {
        vmdcon -info "atomselect called with arguments: $args"
    }
    
    set selname {}
    if {[catch {uplevel 1 ::atomselect_real $args} selname]} {
        if {$verbose} {
            vmdcon -info "atomselect failed: $selname"
        }
        error $selname
    }
        
    incr total_sel_count
    incr total_sel_added
    rename ::$selname [join [list :: $selname _real] {}]
    set seltoken [interp alias {} ::$selname {} ::DebugAtomSelect::atomselect_wrap $selname]
    if {$verbose} {
        vmdcon -info "wrapping selection function $selname / $seltoken"
    }
    set wrapped_atomsels($selname) $seltoken

    if {$verbose} {
        debug_atomselect stats
    }
    return $selname
}

# this is the wrapper for created atomselect functions to track deletes.
proc ::DebugAtomSelect::atomselect_wrap {args} {
    variable verbose 
    variable total_sel_count
    variable total_sel_deleted
    variable wrapped_atomsels

    # remove first argument created by alias statement
    set selname [lindex $args 0]
    set args [lrange $args 1 end]

    if {$verbose} {
        vmdcon -info "$selname called with arguments: $args"
    }
    
    # the delete command nees special treatment.
    if {([llength $args] > 0) && [string match [lindex $args 0] delete]} {
        incr total_sel_count -1
        incr total_sel_deleted
        if {$verbose} {
            debug_atomselect stats
        }
        # remove alias from interpreter, 
        interp alias {} $wrapped_atomsels($selname) {}
        rename [join [list :: $selname _real] {}] ::$selname
        # remove from list as well
        array unset wrapped_atomsels $selname
        return [uplevel 1 $selname delete]
    }
    return [uplevel 1 [join [list :: $selname _real] {}] $args]
}

proc ::DebugAtomSelect::debug_atomselect {{flag help}} {
    variable verbose
    variable status
    variable started
    variable total_sel_count
    variable total_sel_added
    variable total_sel_deleted
    variable wrapped_atomsels
    variable alias_token

    switch $flag {
        on  {
            if {$status} {
                if {$verbose} {
                    vmdcon -info \
                        "atomselect debugging already active $started"
                }
                return
            }
            if {![catch {rename ::atomselect ::atomselect_real}]} {
                set alias_token [interp alias {} ::atomselect {} ::DebugAtomSelect::atomselect_proxy]
            }
            set status 1
            set started "since [clock format [clock seconds]]"
        }
        
        off {
            if {!$status} {
                if {$verbose} {
                    vmdcon -info \
                        "atomselect debugging already inactive."
                }
                return
            }
            set status 0

            # remove alias and undo renaming
            interp alias {} $alias_token {}
            rename ::atomselect_real ::atomselect
            if {$verbose} {
                vmdcon -info "atomselect tracing now inactive"
            }
            debug_atomselect stats
            # unwrap the remaining atom selections.
            foreach {selname seltoken} [array get wrapped_atomsels] {
                vmdcon -info "unwrapping $selname  $seltoken"
                # remove alias from interpreter, 
                interp alias {} $seltoken {}
                rename [join [list :: $selname _real] {}] ::$selname
            }
            # clean up
            array unset wrapped_atomsels
            set total_sel_count   0
            set total_sel_added   0
            set total_sel_deleted 0
            set started "not active"
        }
        stats {
            vmdcon -info "atomselect statistics $started"
            vmdcon -info "total selections   : $total_sel_count"
            vmdcon -info "added selections   : $total_sel_added"
            vmdcon -info "deleted selections : $total_sel_deleted"
            return
        }
        silent  {
            if {$verbose} {
                vmdcon -info "silencing verbose atomselect tracing"
            }
            set verbose 0
            return
        }
        verbose {
            set verbose 1
            vmdcon -info "verbose atomselect tracing enabled"
            return
        }
        default {
            vmdcon -info "Atom selection tracing tool. Usage:\n"
            vmdcon -info "debug_atomselect <flag>\n"
            vmdcon -info "Available flags:"
            vmdcon -info "  on      : enable tracing of atom selections"
            vmdcon -info "  off     : disable tracing of atom selections"
            vmdcon -info "  verbose : verbosely report atomselect operations"
            vmdcon -info "  silent  : don't report atomselect operations"
            vmdcon -info "  stats   : print statistics (active/added/deleted)"
            vmdcon -info "  help    : print this message\n"
            vmdcon -info "Note: only atomselections created while tracing was enabled can be monitored."
        }
    }
}

# import main command
namespace import ::DebugAtomSelect::debug_atomselect