1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
|
# $Id: init.tcl 11912 2011-01-17 19:52:05Z m9710797 $
# 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
# Only execute this script once. Below we source other Tcl script,
# so this makes sure we don't get in an infinte loop.
if $init_tcl_executed return
set init_tcl_executed true
# internal proc to make help function available to Tcl procs
proc help { args } {
variable help_text
variable help_proc
set command [lindex $args 0]
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]
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 } {
global env
set user_file $env(OPENMSX_USER_DATA)/$file
if [file exists $user_file] { return $user_file }
return $env(OPENMSX_SYSTEM_DATA)/$file
}
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]
foreach script [lsort -unique [concat $user_scripts $system_scripts]] {
set script [data_file scripts/$script]
if {[catch {namespace eval :: [list source $script]}]} {
puts stderr "Error while executing $script\n$errorInfo"
}
}
} ;# namespace openmsx
|
