/* Definitions of symbol-value forwarding for XEmacs Lisp interpreter.
   Copyright (C) 1985, 1986, 1987, 1992, 1993 Free Software Foundation, Inc.

This file is part of XEmacs.

XEmacs is free software; you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by the
Free Software Foundation; either version 2, or (at your option) any
later version.

XEmacs is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
for more details.

You should have received a copy of the GNU General Public License
along with XEmacs; see the file COPYING.  If not, write to the Free
Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */

/* Synched up with: Not in FSF. */

/* Fsymbol_value checks whether XSYMBOL (sym)->value is one of these,
 *  and does weird magic stuff if so */

#ifndef _XEMACS_SYMEVAL_H_
#define _XEMACS_SYMEVAL_H_

struct symbol_value_magic
{
  struct lcrecord_header lcheader;
  enum
    {
      /* The following tags use the 'symbol_value_forward' structure
	 and are strictly for variables DEFVARed on the C level. */
      SYMVAL_FIXNUM_FORWARD,           /* Forward C "int" */
      SYMVAL_BOOLEAN_FORWARD,          /* Forward C boolean ("int") */
      SYMVAL_OBJECT_FORWARD,           /* Forward C Lisp_Object */
      SYMVAL_DEFAULT_BUFFER_FORWARD,   /* Forward Lisp_Object into Vbuffer_defaults */
      SYMVAL_CURRENT_BUFFER_FORWARD,   /* Forward Lisp_Object into current_buffer */
      /*SYMVAL_SOME_BUFFER_FORWARD,       Either current_buffer or buffer_defaults */
      SYMVAL_UNBOUND_MARKER,           /* Only Qunbound actually has this tag */
      SYMVAL_CONST_SPECIFIER_FORWARD,  /* Forward C Lisp_Object (a specifier
					  where you can't change the
					  actual specifier object assigned
					  to the variable) */

      /* The following tags use the 'symbol_value_buffer_local' structure */
      SYMVAL_BUFFER_LOCAL,             /* make-variable-buffer-local */
      SYMVAL_SOME_BUFFER_LOCAL,        /* make-local-variable */

      /* The following tag uses the 'symbol_value_varalias' structure */
      SYMVAL_VARALIAS		       /* defvaralias */

#if 0
      /* NYI */
      SYMVAL_CONSTANT_SYMBOL,	       /* Self-evaluating symbol */
      /* NYI */
      SYMVAL_LISP_MAGIC,	       /* Forward to lisp callbacks */
#endif
    } type;
};
#define SYMBOL_VALUE_MAGIC_P(x)				\
  (LRECORDP (x)						\
   && (XRECORD_LHEADER (x)->implementation->printer	\
       == print_symbol_value_magic))
#define XSYMBOL_VALUE_MAGIC_TYPE(v) \
	(((struct symbol_value_magic *) XPNTR (v))->type)
#define XSETSYMBOL_VALUE_MAGIC(s, p) XSETOBJ (s, Lisp_Record, p)
extern void print_symbol_value_magic (Lisp_Object, Lisp_Object, int);

/********** The various different symbol-value-magic types ***********/

/* 1. symbol-value-forward */

/* This type of symbol-value-magic is used for variables declared
   DEFVAR_LISP, DEFVAR_INT, DEFVAR_BOOL, DEFVAR_BUFFER_LOCAL,
   DEFVAR_BUFFER_DEFAULTS, DEFVAR_SPECIFIER, and for Qunbound.

   Note that some of these types of variables can be made buffer-local.
   Then, the symbol's value field contains a symbol-value-buffer-local,
   whose CURRENT-VALUE field then contains a symbol-value-forward.
 */
     
extern CONST_IF_NOT_DEBUG struct lrecord_implementation
  lrecord_symbol_value_forward[];
struct symbol_value_forward
{
  struct symbol_value_magic magic;
  /* void *forward; -- use magic.lcheader.next instead */
  /* Function controlling magic behavior of this forward variable.

     SYM is the symbol being operated on (read, set, etc.);

     VAL is either the value to set or the value to be returned.

     BUF is the buffer that the value is read in or set in.
       A value of 0 means that the current buffer and possibly
       other buffers are being set. (This value will never be
       passed for built-in buffer-local variables such as
       `truncate-lines'.) (Currently, a value of 0 is always
       passed for DEFVAR_INT, DEFVAR_LISP, and DEFVAR_BOOL
       variables; the code isn't smart enough to figure out
       what buffers besides the current buffer are being
       affected.  Because the magic function is called
       before the value is changed, it's not that easy
       to determine which buffers are getting changed.
       #### If this information is important, let me know
       and I will look into providing it.)

     FLAGS gives more information about the operation being
       performed.

     The return value indicates what the magic function actually
       did.

     Currently FLAGS and the return value are not used.  This
     function is only called when the value of a forward variable
     is about to be changed.  Note that this can occur explicitly
     through a call to `set', `setq', `set-default', or `setq-default',
     or implicitly by the current buffer being changed.

     */
     
  int (*magicfun) (Lisp_Object sym, Lisp_Object *val, struct buffer *buf,
		   int flags);
};
#define XSYMBOL_VALUE_FORWARD(v) \
	((CONST struct symbol_value_forward *) XPNTR(v))
#define symbol_value_forward_forward(m) ((void *)((m)->magic.lcheader.next))
#define symbol_value_forward_magicfun(m) ((m)->magicfun)

/* 2. symbol-value-buffer-local */

extern CONST_IF_NOT_DEBUG struct lrecord_implementation
  lrecord_symbol_value_buffer_local[];
struct symbol_value_buffer_local
{
  struct symbol_value_magic magic;
  /* Used in a symbol value cell when the symbol's value is per-buffer.
   * 
   * CURRENT-BUFFER is the last buffer for which this symbol's value was
   * made up to date.
   * 
   * CURRENT-ALIST-ELEMENT is a pointer to an element of BUFFER's
   * buffer_local_var_alist, that being the element whose car
   * is this variable.
   * Or it can be NIL if BUFFER does not have an element in its
   *  alist for this variable (that is, if BUFFER sees the default
   *  value of this variable).
   * 
   * If we want to examine or set the value and BUFFER is current,
   * we just examine or set REALVALUE.
   * If BUFFER is not current, we store the current REALVALUE value into
   * CURRENT-ALIST-ELEMENT, then find the appropriate alist element for
   * the buffer now current and set up CURRENT-ALIST-ELEMENT.
   * Then we set REALVALUE out of that element, and store into BUFFER.
   * 
   * If we are setting the variable and the current buffer does not have
   * an alist entry for this variable, an alist entry is created.
   * 
   * Note that CURRENT-VALUE (but not DEFAULT-VALUE) can be a
   * forwarding pointer.  Each time it is examined or set, 
   * forwarding must be done.
   */
  Lisp_Object default_value;
  Lisp_Object current_value;
  Lisp_Object current_buffer;
  Lisp_Object current_alist_element;
};
#define XSYMBOL_VALUE_BUFFER_LOCAL(v) \
	((struct symbol_value_buffer_local *) XPNTR(v))


/* 3. symbol-value-varalias */

extern CONST_IF_NOT_DEBUG struct lrecord_implementation
  lrecord_symbol_value_varalias[];
struct symbol_value_varalias
{
  struct symbol_value_magic magic;
  Lisp_Object aliasee;
  Lisp_Object shadowed;
};
#define XSYMBOL_VALUE_VARALIAS(v)			\
	((struct symbol_value_varalias *) XPNTR(v))
#define SYMBOL_VALUE_VARALIAS_P(v)			\
  (SYMBOL_VALUE_MAGIC_P (v) &&				\
   XSYMBOL_VALUE_MAGIC_TYPE (v) == SYMVAL_VARALIAS)
#define symbol_value_varalias_aliasee(m) ((m)->aliasee)
#define symbol_value_varalias_shadowed(m) ((m)->shadowed)

/* defsubr (Sname);
 is how we define the symbol for function `name' at start-up time. */
extern void defsubr (struct Lisp_Subr *);

extern void defsymbol (Lisp_Object *location, CONST char *name);

extern void defkeyword (Lisp_Object *location, CONST char *name);

extern void deferror (Lisp_Object *symbol, CONST char *name,
		      CONST char *message, int error_type);

/* Macros we use to define forwarded Lisp variables.
   These are used in the syms_of_FILENAME functions.  */

extern void defvar_mumble (CONST char *names,
                           CONST void *magic, int sizeof_magic);

#define DEFVAR_HEADER(lname, c_location, forward_type)			  \
  static CONST struct symbol_value_forward I_hate_C			  \
   = { { { { lrecord_symbol_value_forward }, (void *) (c_location), 69 }, \
         forward_type }, 0 };						  \
  defvar_mumble ((lname), &I_hate_C, sizeof (I_hate_C))

#define DEFVAR_MAGIC_HEADER(lname, c_location, forward_type, magicfun)	  \
  static CONST struct symbol_value_forward I_hate_C			  \
   = { { { { lrecord_symbol_value_forward }, (void *) (c_location), 69 }, \
         forward_type }, magicfun };					  \
  defvar_mumble ((lname), &I_hate_C, sizeof (I_hate_C))

#define DEFVARLISP(lname, c_location, doc)			\
 do { DEFVAR_HEADER (lname, c_location, SYMVAL_OBJECT_FORWARD);	\
      staticpro (c_location);					\
 } while (0)
#define DEFVARSPECIFIER(lname, c_location, doc)				 \
 do { DEFVAR_HEADER (lname, c_location, SYMVAL_CONST_SPECIFIER_FORWARD); \
      staticpro (c_location);						 \
 } while (0)
#define DEFVARINT(lname, c_location, doc)			\
 do { DEFVAR_HEADER (lname, c_location, SYMVAL_FIXNUM_FORWARD);	\
 } while (0)
#define DEFVARBOOL(lname, c_location, doc)			\
 do { DEFVAR_HEADER (lname, c_location, SYMVAL_BOOLEAN_FORWARD);\
 } while (0)

#define DEFVARLISP_MAGIC(lname, c_location, doc, magicfun)	\
 do { DEFVAR_MAGIC_HEADER (lname, c_location,			\
      SYMVAL_OBJECT_FORWARD, magicfun);				\
      staticpro (c_location);					\
 } while (0)
#define DEFVARINT_MAGIC(lname, c_location, doc, magicfun)	\
 do { DEFVAR_MAGIC_HEADER (lname, c_location,			\
      SYMVAL_FIXNUM_FORWARD, magicfun);				\
 } while (0)
#define DEFVARBOOL_MAGIC(lname, c_location, doc, magicfun)	\
 do { DEFVAR_MAGIC_HEADER (lname, c_location,			\
      SYMVAL_BOOLEAN_FORWARD, magicfun);			\
 } while (0)

/* These discard their DOC arg because it is snarfed by make-docfile
 *  and stored in an external file. */
#define DEFVAR_LISP(lname, c_location, doc) DEFVARLISP (lname, c_location, 0)
#define DEFVAR_SPECIFIER(lname, c_location, doc) \
  DEFVARSPECIFIER (lname, c_location, 0)
#define DEFVAR_BOOL(lname, c_location, doc) DEFVARBOOL (lname, c_location, 0)
#define DEFVAR_INT(lname, c_location, doc) DEFVARINT (lname, c_location, 0)

#define DEFVAR_LISP_MAGIC(lname, c_location, doc, magicfun) \
  DEFVARLISP_MAGIC (lname, c_location, 0, magicfun)
#define DEFVAR_BOOL_MAGIC(lname, c_location, doc, magicfun) \
  DEFVARBOOL_MAGIC (lname, c_location, 0, magicfun)
#define DEFVAR_INT_MAGIC(lname, c_location, doc, magicfun) \
  DEFVARINT_MAGIC (lname, c_location, 0, magicfun)

#endif /* _XEMACS_SYMEVAL_H_ */
