Subversion Repositories or1k

# 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

}