#######################################
# Provide a vmdcon tcl command for versions that don't have it 
# compiled in. This will allow to convert plugins transparently.
if { ! [string equal [info commands vmdcon] vmdcon]} then {
    uplevel \#0 {
        set vmd_console_status 2; # textmode is default
        global vmd_console_status
        proc vmdcon {args} {
            global vmd_console_status

            set newline 1
            set argc [llength $args]
            set idx 0
            set prefix {}
            
            if {$argc == 0} { puts ""; return }

            if {[string equal [lindex $args $idx] {-nonewline}]} then {
                set newline 0
                incr idx
                # nothing to do...
                if {$argc == $idx} { return }
            }
            switch -exact -- [lindex $args $idx] {

              -info        {incr idx; set prefix {Info) }}
              -warn        {incr idx; set prefix {Warning) }}
              -err         {incr idx; set prefix {ERROR) }}

              -dmesg       -
              -loglevel    -
              -register    -
              -unregister  { return }
              -textmode    { set vmd_console_status 2; return }
              -widgetmode  { set vmd_console_status 1; return }
              -status      { return [lindex {none widget text} $vmd_console_status] }
              
              -help {
                puts {usage: vmdcon ?-nonewline? ?options? [arguments]
       print data to the VMD console or change console behavior

Output options:
  with no options 'vmdcon' copies all arguments to the current console
  -info      -- prepend output with 'Info) '
  -warn      -- prepend output with 'Warning) '
  -err       -- prepend output with 'ERROR) '
  -nonewline -- don't append a newline to the output

Console mode options:
  -register <widget_path> ?<mark>?  -- register a tk text widget as console
    optionally provide a mark as reference for insertions. otherwise 'end' is used
  -unregister                       -- unregister the currently registered console widget
  -textmode                         -- switch to text mode console (using stdio)
  -widgetmode                       -- switch to tk (registered) text widget as console
  -loglevel ?all|info|warn|err?     -- get or set console log level (output to console only at that level or higher)

General options:
  -status   -- report current console status (text|widget|none)
  -dmesg    -- (re)print recent console messages
  -help     -- print this help message
                }
              }
            }
            set string [join [concat $prefix [lrange $args $idx end]]]
            if {$newline} then {
              puts $string
            } else {
              puts -nonewline $string
            }
        }
    }
}

##############################################################
# 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"
    }

    # the list command needs special treatment.
    if {([llength $args] > 0) && [string match [lindex $args 0] list]} {
        return [::__atomselect_real list]
    }
    
    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]
                foreach selname [::__atomselect_real list] {
                    incr total_sel_count
                    rename ::$selname [join [list ::__ $selname _real] {}]
                    set seltoken [interp alias {} ::$selname {} ::DebugAtomSelect::__atomselect_wrap $selname]
                    if {$verbose} {
                        vmdcon -info "wrapping existing selection function $selname / $seltoken"
                    }
                    set wrapped_atomsels($selname) $seltoken
                }
            }
            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     : [llength [atomselect list]]"
            vmdcon -info "monitored 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