/* Primitive operations on Lisp data types for GNU Emacs Lisp interpreter.
- Copyright (C) 1985,86,88,93,94,95,97,98,99, 2000, 2001, 03, 2004
- Free Software Foundation, Inc.
+ Copyright (C) 1985, 1986, 1988, 1993, 1994, 1995, 1997, 1998, 1999, 2000,
+ 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
This file is part of GNU Emacs.
You should have received a copy of the GNU General Public License
along with GNU Emacs; see the file COPYING. If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, USA. */
+the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
#include <config.h>
return Qnil;
}
+
+extern struct device *get_device P_ ((Lisp_Object display, int));
+
+DEFUN ("terminal-local-value", Fterminal_local_value, Sterminal_local_value, 2, 2, 0,
+ doc: /* Return the terminal-local value of SYMBOL on DEVICE.
+If SYMBOL is not a terminal-local variable, then return its normal
+value, like `symbol-value'.
+
+DEVICE may be a display device id, a frame, or nil (meaning the
+selected frame's display device). */)
+ (symbol, device)
+ Lisp_Object symbol;
+ Lisp_Object device;
+{
+ Lisp_Object result;
+ struct device *d = get_device (device, 1);
+ push_device_kboard (d);
+ result = Fsymbol_value (symbol);
+ pop_frame_kboard ();
+ return result;
+}
+
+DEFUN ("set-terminal-local-value", Fset_terminal_local_value, Sset_terminal_local_value, 3, 3, 0,
+ doc: /* Set the terminal-local binding of SYMBOL on DEVICE to VALUE.
+If VARIABLE is not a terminal-local variable, then set its normal
+binding, like `set'.
+
+DEVICE may be a display device id, a frame, or nil (meaning the
+selected frame's display device). */)
+ (symbol, device, value)
+ Lisp_Object symbol;
+ Lisp_Object device;
+ Lisp_Object value;
+{
+ Lisp_Object result;
+ struct device *d = get_device (device, 1);
+ push_device_kboard (d);
+ result = Fset (symbol, value);
+ pop_frame_kboard ();
+ return result;
+}
\f
/* Find the function at the end of a chain of symbol function indirections. */
args_out_of_range (array, idx);
if (idxval < CHAR_TABLE_ORDINARY_SLOTS)
{
+ if (! SINGLE_BYTE_CHAR_P (idxval))
+ args_out_of_range (array, idx);
/* For ASCII and 8-bit European characters, the element is
stored in the top table. */
val = XCHAR_TABLE (array)->contents[idxval];
+ if (NILP (val))
+ {
+ int default_slot
+ = (idxval < 0x80 ? CHAR_TABLE_DEFAULT_SLOT_ASCII
+ : idxval < 0xA0 ? CHAR_TABLE_DEFAULT_SLOT_8_BIT_CONTROL
+ : CHAR_TABLE_DEFAULT_SLOT_8_BIT_GRAPHIC);
+ val = XCHAR_TABLE (array)->contents[default_slot];
+ }
if (NILP (val))
val = XCHAR_TABLE (array)->defalt;
while (NILP (val)) /* Follow parents until we find some value. */
{
int code[4], i;
Lisp_Object sub_table;
+ Lisp_Object current_default;
SPLIT_CHAR (idxval, code[0], code[1], code[2]);
if (code[1] < 32) code[1] = -1;
code[3] = -1; /* anchor */
try_parent_char_table:
+ current_default = XCHAR_TABLE (array)->defalt;
sub_table = array;
for (i = 0; code[i] >= 0; i++)
{
val = XCHAR_TABLE (sub_table)->contents[code[i]];
if (SUB_CHAR_TABLE_P (val))
- sub_table = val;
+ {
+ sub_table = val;
+ if (! NILP (XCHAR_TABLE (sub_table)->defalt))
+ current_default = XCHAR_TABLE (sub_table)->defalt;
+ }
else
{
if (NILP (val))
- val = XCHAR_TABLE (sub_table)->defalt;
+ val = current_default;
if (NILP (val))
{
array = XCHAR_TABLE (array)->parent;
return val;
}
}
- /* Here, VAL is a sub char table. We try the default value
- and parent. */
- val = XCHAR_TABLE (val)->defalt;
+ /* Reaching here means IDXVAL is a generic character in
+ which each character or a group has independent value.
+ Essentially it's nonsense to get a value for such a
+ generic character, but for backward compatibility, we try
+ the default value and parent. */
+ val = current_default;
if (NILP (val))
{
array = XCHAR_TABLE (array)->parent;
if (idxval < 0)
args_out_of_range (array, idx);
if (idxval < CHAR_TABLE_ORDINARY_SLOTS)
- XCHAR_TABLE (array)->contents[idxval] = newelt;
+ {
+ if (! SINGLE_BYTE_CHAR_P (idxval))
+ args_out_of_range (array, idx);
+ XCHAR_TABLE (array)->contents[idxval] = newelt;
+ }
else
{
int code[4], i;
Lisp_Object temp;
/* VAL is a leaf. Create a sub char table with the
- default value VAL or XCHAR_TABLE (array)->defalt
- and look into it. */
+ initial value VAL and look into it. */
- temp = make_sub_char_table (NILP (val)
- ? XCHAR_TABLE (array)->defalt
- : val);
+ temp = make_sub_char_table (val);
XCHAR_TABLE (array)->contents[code[i]] = temp;
array = temp;
}
staticpro (&Qargs_out_of_range);
staticpro (&Qvoid_function);
staticpro (&Qcyclic_function_indirection);
+ staticpro (&Qcyclic_variable_indirection);
staticpro (&Qvoid_variable);
staticpro (&Qsetting_constant);
staticpro (&Qinvalid_read_syntax);
defsubr (&Slocal_variable_p);
defsubr (&Slocal_variable_if_set_p);
defsubr (&Svariable_binding_locus);
+ defsubr (&Sterminal_local_value);
+ defsubr (&Sset_terminal_local_value);
defsubr (&Saref);
defsubr (&Saset);
defsubr (&Snumber_to_string);