neingeist
/
arduinisten
Archived
1
0
Fork 0
You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
This repo is archived. You can view files and clone it, but cannot push or open issues/pull-requests.

199 lines
5.4 KiB
Tcl

# prefs.tcl - Preference handling.
# Copyright (C) 1997 Cygnus Solutions.
# Written by Tom Tromey <tromey@cygnus.com>.
# KNOWN BUGS:
# * When we move to the next tcl/itcl, rewrite to use namespaces and
# possibly ensembles.
# Global state.
defarray PREFS_state {
inhibit-event 0
initialized 0
}
# This is called when a trace on some option fires. It makes sure the
# relevant handlers get run.
proc PREFS_run_handlers {name1 name2 op} {
upvar $name1 state
set option [lindex $name2 0]
global PREFS_state
# Notify everybody else unless we've inhibited event generation.
if {! $PREFS_state(inhibit-event) && $PREFS_state(ide_running)} then {
ide_property set preference/$option $state([list $option value]) global
}
# Run local handlers.
run_hooks PREFS_state([list $option handler]) $option \
$state([list $option value])
}
# This is run when we see a property event. It updates our internal
# state.
proc PREFS_handle_property_event {exists property value} {
global PREFS_state
# If it isn't a preference property, ignore it.
if {! [string match preference/* $property]} then {
return
}
# [string length preference/] == 11.
set name [string range $property 11 end]
if {$exists} then {
incr PREFS_state(inhibit-event)
set PREFS_state([list $name value]) $value
incr PREFS_state(inhibit-event) -1
} elseif {$PREFS_state(ide_running)} then {
# It doesn't make sense to remove a property that mirrors some
# preference. So disallow by immediately redefining. Use
# initialize and not set because several clients are likely to run
# this at once.
ide_property initialize preference/$name \
$PREFS_state([list $name value]) global
}
}
# pref define NAME DEFAULT
# Define a new option
# NAME is the option name
# DEFAULT is the default value of the option
proc PREFS_cmd_define {name default} {
global PREFS_state
# If the option has already been defined, do nothing.
if {[info exists PREFS_state([list $name value])]} then {
return
}
if {$PREFS_state(ide_running)} then {
# We only store the value in the database.
ide_property initialize preference/$name $default global
set default [ide_property get preference/$name]
}
# We set our internal state no matter what. It is harmless if our
# definition causes a property-set event.
set PREFS_state([list $name value]) $default
set PREFS_state([list $name handler]) {}
# Set up a variable trace so that the handlers can be run.
trace variable PREFS_state([list $name value]) w PREFS_run_handlers
}
# pref get NAME
# Return value of option NAME
proc PREFS_cmd_get {name} {
global PREFS_state
return $PREFS_state([list $name value])
}
# pref getd NAME
# Return value of option NAME
# or define it if necessary and return ""
proc PREFS_cmd_getd {name} {
global PREFS_state
PREFS_cmd_define $name ""
return [pref get $name]
}
# pref varname NAME
# Return name of global variable that represents option NAME
# This is suitable for (eg) a -variable option on a radiobutton
proc PREFS_cmd_varname {name} {
return PREFS_state([list $name value])
}
# pref set NAME VALUE
# Set the option NAME to VALUE
proc PREFS_cmd_set {name value} {
global PREFS_state
# For debugging purposes, make sure the preference has already been
# defined.
if {! [info exists PREFS_state([list $name value])]} then {
error "attempt to set undefined preference $name"
}
set PREFS_state([list $name value]) $value
}
# pref setd NAME VALUE
# Set the option NAME to VALUE
# or define NAME and set the default to VALUE
proc PREFS_cmd_setd {name value} {
global PREFS_state
if {[info exists PREFS_state([list $name value])]} then {
set PREFS_state([list $name value]) $value
} else {
PREFS_cmd_define $name $value
}
}
# pref add_hook NAME HOOK
# Add a command to the hook that is run when the preference name NAME
# changes. The command is run with the name of the changed option and
# the new value as arguments.
proc PREFS_cmd_add_hook {name hook} {
add_hook PREFS_state([list $name handler]) $hook
}
# pref remove_hook NAME HOOK
# Remove a command from the per-preference hook.
proc PREFS_cmd_remove_hook {name hook} {
remove_hook PREFS_state([list $name handler]) $hook
}
# pref init ?IDE_RUNNING?
# Initialize the preference module. IDE_RUNNING is an optional
# boolean argument. If 0, then the preference module will assume that
# it is not connected to the IDE backplane. The default is based on
# the global variable IDE_ENABLED.
proc PREFS_cmd_init {{ide_running "unset"}} {
global PREFS_state IDE_ENABLED
if {! $PREFS_state(initialized)} then {
if {$ide_running == "unset"} then {
if {[info exists IDE_ENABLED]} then {
set ide_running $IDE_ENABLED
} else {
set ide_running 0
}
}
set PREFS_state(initialized) 1
set PREFS_state(ide_running) $ide_running
if {$ide_running} then {
property add_hook "" PREFS_handle_property_event
}
}
}
# pref list
# Return a list of the names of all preferences defined by this
# application.
proc PREFS_cmd_list {} {
global PREFS_state
set list {}
foreach item [array names PREFS_state] {
if {[lindex $item 1] == "value"} then {
lappend list [lindex $item 0]
}
}
return $list
}
# The primary interface to all preference subcommands.
proc pref {dispatch args} {
if {[info commands PREFS_cmd_$dispatch] == ""} then {
error "unrecognized key \"$dispatch\""
}
eval PREFS_cmd_$dispatch $args
}