# evaluate in internal openmsx namespace

namespace eval openmsx {

variable init_tcl_executed false

variable tabcompletion_proc_sensitive

variable tabcompletion_proc_insensitive

variable help_text

variable help_proc

variable lazy [dict create]

# Only execute this script once. Below we source other Tcl script,

# so this makes sure we don't get in an infinite loop.

if {$init_tcl_executed} return

set init_tcl_executed true

# Debug pints (disabled by default).

proc dbg {msg} {

	#puts stderr $msg

}

# Helpers to handle on-demand (lazy) loading of Tcl scripts

# Register 'script' to be loaded on-demand when one of the proc names in

# 'procs' is about to be executed. See also 'lazy.tcl'.

proc register_lazy {script procs} {

	variable lazy

	dict set lazy $script $procs

}

# Lookup the script associated with the given proc name. If found that script

# is executed (and the script+proc-names are removed from the list of

# yet-to-be-executed lazy scripts).

proc lazy_handler {name} {

	variable lazy

	# Registered names can be fully qualified (e.g. 'cheat_finder::start'),

	# so match on both the qualified name and the bare proc name.

	set full [string trimleft $name :]

	set tail [namespace tail $name]

	dict for {script procs} $lazy {

		if {($full ni $procs) && ($tail ni $procs)} continue

		dict unset lazy $script

		dbg "start executing script $script (via lazy_handler)"

		if {[catch {namespace eval :: [list source [data_file scripts/$script]]}]} {

			puts stderr "Error while (lazily) loading Tcl script: $script\n$::errorInfo"

			error $::errorInfo

		}

		dbg "done executing script $script"

		return true

	}

	return false

}

# Execute all not yet executed lazy-scripts. ATM this is (only) required for

# the 'about' command which has to search through the help text of all the

# scripts.

proc lazy_execute_all {} {

	variable lazy

	# cannot simply iterate because the 'source' command below might

	# trigger a load of a script later in the collection

	while {[dict size $lazy] != 0} {

		set script [lindex [dict keys $lazy] 0]

		dict unset lazy $script

		dbg "start executing script $script (via lazy_execute_all)"

		if {[catch {namespace eval :: [list source [data_file scripts/$script]]}]} {

			puts stderr "Error while (lazily) loading Tcl script: $script\n$::errorInfo"

			error $::errorInfo

		}

		dbg "done executing script $script"

	}

}

# Return a list of all command names. This includes:

#   builtin Tcl commands,

#   procs defined in Tcl scripts,

#   procs from not yet loaded lazy-scripts (see register_lazy).

# This helper proc is used for tab-completion in the openMSX console.

proc all_command_names {} {

	variable lazy

	set result [info commands]

	foreach procs [dict values $lazy] {

		lappend result {*}$procs

	}

	# only one level deep, good enough for machineN::*

	foreach ns [namespace children ::] {

		lappend result {*}[info commands ${ns}::*]

	}

	return $result

}

# Returns a list of Tcl commands that provide extra help (text or proc).

# Note: there may also be commands implemented in c++ which provide help.

proc all_command_names_with_help {} {

	lazy_execute_all

	set result [array names ::openmsx::help_text]

	lappend result {*}[array names ::openmsx::help_proc]

	return $result

}

# Is the given name a name of a proc, possibly a name defined in a not-yet

# loaded script. This helper proc is used for syntax-highlighting in the

# openMSX console.

proc is_command_name {name} {

	if {[info commands ::$name] ne ""} {return 1}

	expr {[lsearch -exact [all_command_names] [namespace tail $name]] != -1}

}

# Override the builtin Tcl proc 'unknown'. This is called when the Tcl

# interpreter is about to execute an undefined command.

proc ::unknown {args} {

	#puts stderr "unknown: $args"

	set name [lindex $args 0]

	if {[openmsx::lazy_handler $name]} {

		return [uplevel 1 $args]

	}

	return -code error "invalid command name \"$name\""

}

# internal proc to make help function available to Tcl procs

proc help {args} {

	variable help_text

	variable help_proc

	set command [lindex $args 0]

	lazy_handler $command

	if {[info exists help_proc($command)]} {

		return [namespace eval :: $help_proc($command) $args]

	} elseif {[info exists help_text($command)]} {

		return $help_text($command)

	} elseif {[info commands $command] ne ""} {

		error "No help for command: $command"

	} else {

		error "Unknown command: $command"

	}

}

proc set_help_text {command help} {

	variable help_text

	set help_text($command) $help

}

set_help_text set_help_text \

{Associate a help-text with a Tcl proc. This is normally only used in Tcl scripts.}

proc set_help_proc {command procname} {

	variable help_proc

	set help_proc($command) $procname

}

set_help_text set_help_proc \

{Associate a help-proc with a Tcl proc. This is normally only used in Tcl scripts.}

# internal proc to make tabcompletion available to Tcl procs

proc tabcompletion {args} {

	variable tabcompletion_proc_sensitive

	variable tabcompletion_proc_insensitive

	set command [lindex $args 0]

	lazy_handler $command

	set result ""

	if {[info exists tabcompletion_proc_sensitive($command)]} {

		set result [namespace eval :: $tabcompletion_proc_sensitive($command) $args]

		lappend result true

	} elseif {[info exists tabcompletion_proc_insensitive($command)]} {

		set result [namespace eval :: $tabcompletion_proc_insensitive($command) $args]

		lappend result false

	}

	return $result

}

proc set_tabcompletion_proc {command proc {case_sensitive true}} {

	variable tabcompletion_proc_sensitive

	variable tabcompletion_proc_insensitive

	if {$case_sensitive} {

		set tabcompletion_proc_sensitive($command) $proc

	} else {

		set tabcompletion_proc_insensitive($command) $proc

	}

}

set_help_text set_tabcompletion_proc \

{Provide a way to do tab-completion for a certain Tcl proc. For details look at the numerous examples in the share/scripts directory. This is normally only used in Tcl scripts.}

set_help_text data_file \

"Resolve data file. First try user directory, if the file doesn't exist

there try the system directory."

proc data_file { file } {

	set user_file $::env(OPENMSX_USER_DATA)/$file

	if {[file exists $user_file]} { return $user_file }

	return $::env(OPENMSX_SYSTEM_DATA)/$file

}

namespace export register_lazy

namespace export set_help_text

namespace export set_help_proc

namespace export set_tabcompletion_proc

namespace export data_file

} ;# namespace openmsx

namespace import openmsx::*

namespace eval openmsx {

# Source all .tcl files in user and system scripts directory. Prefer

# the version in the user directory in case a script exists in both

set user_scripts [glob -dir $::env(OPENMSX_USER_DATA)/scripts -tails -nocomplain *.tcl]

set system_scripts [glob -dir $::env(OPENMSX_SYSTEM_DATA)/scripts -tails -nocomplain *.tcl]

set profile_list [list]

foreach script [lsort -unique [concat $user_scripts $system_scripts]] {

	# Skip scripts that start with a '_' character. (By convention) those

	# are loaded on-demand (see 'lazy.tcl').

	if {[string index $script 0] eq "_"} continue

	set script [data_file scripts/$script]

	set t1 [openmsx_info realtime]

	dbg "start executing script $script (via startup sequence)"

	if {[catch {namespace eval :: [list source $script]}]} {

		puts stderr "Error while executing $script\n$errorInfo"

	}

	dbg "done executing script $script"

	set t2 [openmsx_info realtime]

	lappend profile_list [list [expr {int(1000000 * ($t2 - $t1))}] $script]

}

if 0 {

	foreach e [lsort -integer -index 0 $profile_list] { puts stderr $e }

}

} ;# namespace openmsx