view lwlib/lwlib.c @ 73331:f21883dcffa9

Merge from upstream, upto version 5.22. After 5.0: `cperl-add-tags-recurse-noxs-fullpath': new function (for -batch mode) After 5.1: ;; Major edit. Summary of most visible changes: ;; a) Multiple <<HERE per line allowed. ;; b) Handles multiline subroutine declaration headers (with comments). ;; (The exception is `cperl-etags' - but it is not used in the rest ;; of the mode.) ;; c) Fontifies multiline my/our declarations (even with comments, ;; and with legacy `font-lock'). ;; d) Major speedup of syntaxification, both immediate and postponed ;; (3.5x to 15x [for different CPUs and versions of Emacs] on the ;; huge real-life document I tested). ;; e) New bindings, edits to imenu. ;; f) "_" is made into word-char during fontification/syntaxification; ;; some attempts to recognize non-word "_" during other operations too. ;; g) Detect bug in Emacs with `looking-at' inside `narrow' and bulk out. ;; h) autoload some more perldoc-related stuff ;; i) Some new convenience features: ISpell POD/HEREDOCs, narrow-to-HEREDOC ;; j) Attempt to incorporate XEmacs edits which reached me Fine-grained changelog: `cperl-hook-after-change': New configuration variable `cperl-vc-sccs-header': Likewise. `cperl-vc-sccs-header': Likewise. `cperl-vc-header-alist': Default via two preceding variables `cperl-invalid-face': Remove double quoting under XEmacs (still needed under 21.2) `cperl-tips': Update URLs for resources `cperl-problems': Likewise. `cperl-praise': Mention new features New C-c key bindings: for `cperl-find-bad-style', `cperl-pod-spell', `cperl-here-doc-spell', `cperl-narrow-to-here-doc', `cperl-perdoc', `cperl-perldoc-at-point' CPerl Mode menu changes: "Fix style by spaces", "Imenu on Perl Info" moved, new submenu of Tools with Ispell entries and narrowing. `cperl-after-sub-regexp': New defsubst `cperl-imenu--function-name-regexp-perl': Use `cperl-after-sub-regexp', Allows heads up to head4 Allow "package;" `defun-prompt-regexp': Use `cperl-after-sub-regexp', `paren-backwards-message': ??? Something for XEmacs??? `cperl-mode': Never auto-switch abbrev-mode off Try to allow '_' be non-word char Do not use `font-lock-unfontify-region-function' on XEmacs Reset syntax cache on mode start Support multiline facification (even on legacy `font-lock') `cperl-facemenu-add-face-function': ??? Some contributed code ??? `cperl-after-change-function': Since `font-lock' and `lazy-lock' refuse to inform us whether the fontification is due to lazy calling or due to edit to a buffer, install our own hook (controlled by `cperl-hook-after-change') `cperl-electric-pod': =cut may have been recognized as start `cperl-block-p': Moved, updated for attributes `cperl-calculate-indent': Try to allow '_' be non-word char Support subs with attributes `cperl-where-am-i': Queit (?) a warning `cperl-cached-syntax-table' New function `cperl-forward-re': Use `cperl-cached-syntax-table' `cperl-unwind-to-safe': Recognize `syntax-type' property changing in a middle of line `cperl-find-sub-attrs': New function `cperl-find-pods-heres': Allow many <<EOP per line Allow subs with attributes Major speedups (3.5x..15x on a real-life test file nph-proxy.pl) Recognize "extproc " (OS/2) case-folded and only at start /x on s///x with empty replacement was not recognized Better comments `cperl-after-block-p': Remarks on diff with `cperl-block-p' Allow subs with attributes, labels Do not confuse "else::foo" with "else" Minor optimizations... `cperl-after-expr-p': Try to allow '_' be non-word char `cperl-fill-paragraph': Try to detect a major bug in Emacs with `looking-at' inside `narrow' and bulk out if found `cperl-imenu--create-perl-index': Updates for new `cperl-imenu--function-name-regexp-perl' `cperl-outline-level': Likewise. `cperl-init-faces': Allow multiline subroutine headers and my/our declarations, and ones with comments Allow subroutine attributes `cperl-imenu-on-info': Better docstring. `cperl-etags' Rudimentary support for attributes Support for packages and "package;" `cperl-add-tags-recurse-noxs': Better (?) docstring `cperl-add-tags-recurse-noxs-fullpath': Likewise. `cperl-tags-hier-init': Misprint for `fboundp' fixed `cperl-not-bad-style-regexp': Try to allow '_' be non-word char `cperl-perldoc': Add autoload `cperl-perldoc-at-point': Likewise. `cperl-here-doc-spell': New function `cperl-pod-spell': Likewise. `cperl-map-pods-heres': Likewise. `cperl-get-here-doc-region': Likewise. `cperl-font-lock-fontify-region-function': Likewise (backward compatibility for legacy `font-lock') `cperl-font-lock-unfontify-region-function': Fix style `cperl-fontify-syntaxically': Recognize and optimize away deferred calls with no-change. Governed by `cperl-hook-after-change' `cperl-fontify-update': Recognize that syntaxification region can be larger than fontification one. XXXX we leave `cperl-postpone' property, so this is quadratic... `cperl-fontify-update-bad': Temporary placeholder until it is clear how to implement `cperl-fontify-update'. `cperl-time-fontification': New function `attrib-group': New text attribute `multiline': New value: `syntax-type' text attribute After 5.2: `cperl-emulate-lazy-lock': New function `cperl-fontify-syntaxically': Would skip large regions Add `cperl-time-fontification', `cperl-emulate-lazy-lock' to menu Some globals were declared, but uninitialized After 5.3, 5.4: `cperl-facemenu-add-face-function': Add docs, fix U<> Copyright message updated. `cperl-init-faces': Work around a bug in `font-lock'. May slow facification down a bit. Misprint for my|our|local for old `font-lock' "our" was not fontified same as "my|local" Highlight variables after "my" etc even in a middle of an expression Do not facify multiple variables after my etc unless parentheses are present After 5.5, 5.6 `cperl-fontify-syntaxically': after-change hook could reset `cperl-syntax-done-to' to a middle of line; unwind to BOL. After 5.7: `cperl-init-faces': Allow highlighting of local ($/) `cperl-problems-old-emaxen': New variable (for the purpose of DOCSTRING). `cperl-problems': Remove fixed problems. `cperl-find-pods-heres': Recognize #-comments in m##x too Recognize charclasses (unless delimiter is \). `cperl-fontify-syntaxically': Unwinding to safe was done in wrong order `cperl-regexp-scan': Update docs `cperl-beautify-regexp-piece': use information got from regexp scan After 5.8: Major user visible changes: Recognition and fontification of character classes in RExen. Variable indentation of RExen according to groups `cperl-find-pods-heres': Recognize POSIX classes in REx charclasses Fontify REx charclasses in variable-name face Fontify POSIX charclasses in "type" face Fontify unmatched "]" in function-name face Mark first-char of HERE-doc as `front-sticky' Reset `front-sticky' property when needed `cperl-calculate-indent': Indents //x -RExen accordning to parens level `cperl-to-comment-or-eol': Recognize ends of `syntax-type' constructs `cperl-backward-to-noncomment': Recognize stringy `syntax-type' constructs Support `narrow'ed buffers. `cperl-praise': Remove a reservation `cperl-make-indent': New function `cperl-indent-for-comment': Use `cperl-make-indent' `cperl-indent-line': Likewise. `cperl-lineup': Likewise. `cperl-beautify-regexp-piece': Likewise. `cperl-contract-level': Likewise. `cperl-toggle-set-debug-unwind': New function New menu entry for this `fill-paragraph-function': Use when `boundp' `cperl-calculate-indent': Take into account groups when indenting RExen `cperl-to-comment-or-eol': Recognize # which end a string `cperl-modify-syntax-type': Make only syntax-table property non-sticky `cperl-fill-paragraph': Return t: needed for `fill-paragraph-function' `cperl-fontify-syntaxically': More clear debugging message `cperl-pod2man-build-command': XEmacs portability: check `Man-filter-list' `cperl-init-faces': More complicated highlight even on XEmacs (new) Merge cosmetic changes from XEmacs After 5.9: `cperl-1+': Moved to before the first use `cperl-1-': Likewise. After 5.10: This code may lock Emacs hard!!! Use on your own risk! `cperl-font-locking': New internal variable `cperl-beginning-of-property': New function `cperl-calculate-indent': Use `cperl-beginning-of-property' instead of `previous-single-property-change' `cperl-unwind-to-safe': Likewise. `cperl-after-expr-p': Likewise. `cperl-get-here-doc-region': Likewise. `cperl-font-lock-fontify-region-function': Likewise. `cperl-to-comment-or-eol': Do not call `cperl-update-syntaxification' recursively Bound `next-single-property-change' via `point-max' `cperl-unwind-to-safe': Bound likewise `cperl-font-lock-fontify-region-function': Likewise. `cperl-find-pods-heres': Mark as recursive for `cperl-to-comment-or-eol' Initialization of `cperl-font-lock-multiline-start' could be missed if the "main" fontification did not run due to the keyword being already fontified. `cperl-pod-spell': Return t from do-one-chunk function `cperl-map-pods-heres': Stop when the worker returns nil Call `cperl-update-syntaxification' `cperl-get-here-doc-region': Call `cperl-update-syntaxification' `cperl-get-here-doc-delim': Remove unused function After 5.11: The possible lockup of Emacs (introduced in 5.10) fixed `cperl-unwind-to-safe': `cperl-beginning-of-property' won't return nil `cperl-syntaxify-for-menu': New customization variable `cperl-select-this-pod-or-here-doc': New function `cperl-get-here-doc-region': Extra argument Do not adjust pos by 1 New menu entries (Perl/Tools): Selection of current POD or HERE-DOC section (Debugging CPerl:) backtrace on fontification After 5.12: `cperl-cached-syntax-table': use `car-safe' `cperl-forward-re': Remove spurious argument SET-ST Add documentation `cperl-forward-group-in-re': New function `cperl-find-pods-heres': Find and highlight (?{}) blocks in RExen (XXXX Temporary (?) hack is to syntax-mark them as comment) After 5.13: `cperl-string-syntax-table': Make { and } not-grouping (Sometimes they ARE grouping in RExen, but matching them would only confuse in many situations when they are not) `beginning-of-buffer': Replaced two occurences with goto-char... `cperl-calculate-indent': `char-after' could be nil... `cperl-find-pods-heres': REx can start after "[" too Hightlight (??{}) in RExen too `cperl-maybe-white-and-comment-rex': New constant `cperl-white-and-comment-rex': Likewise. XXXX Not very efficient, but hard to make better while keeping 1 group After 5.13: `cperl-find-pods-heres': $foo << identifier() is not a HERE-DOC Likewise for 1 << identifier After 5.14: `cperl-find-pods-heres': Different logic for $foo .= <<EOF etc Error-less condition-case could fail `cperl-font-lock-fontify-region-function': Likewise. `cperl-init-faces': Likewise. After 5.15: `cperl-find-pods-heres': Support property REx-part2 `cperl-calculate-indent': Likewise. Don't special-case REx with non-empty 1st line `cperl-find-pods-heres': In RExen, highlight non-literal backslashes Invert highlighting of charclasses: now the envelop is highlighted Highlight many others 0-length builtins `cperl-praise': Mention indenting and highlight in RExen After 5.15: `cperl-find-pods-heres': Highlight capturing parens in REx After 5.16: `cperl-find-pods-heres': Highlight '|' for alternation Initialize `font-lock-warning-face' if not present `cperl-find-pods-heres': Use `font-lock-warning-face' instead of `font-lock-function-name-face' `cperl-look-at-leading-count': Likewise. `cperl-find-pods-heres': localize `font-lock-variable-name-face' `font-lock-keyword-face' (needed for batch processing) etc Use `font-lock-builtin-face' for builtin in REx Now `font-lock-variable-name-face' is used for interpolated variables Use "talking aliases" for faces inside REx Highlight parts of REx (except in charclasses) according to the syntax and/or semantic Syntax-mark a {}-part of (?{}) as "comment" (it was the ()-part) Better logic to distinguish what is what in REx `cperl-tips-faces': Document REx highlighting `cperl-praise': Mention REx syntax highlight etc. After 5.17: `cperl-find-sub-attrs': Would not always manage to print error message `cperl-find-pods-heres': localize `font-lock-constant-face' After 5.18: `cperl-find-pods-heres': Misprint in REx for parsing REx Very minor optimization `my-cperl-REx-modifiers-face' got quoted Recognize "print $foo <<END" as HERE-doc Put `REx-interpolated' text attribute if needed `cperl-invert-if-unless-modifiers': New function `cperl-backward-to-start-of-expr': Likewise. `cperl-forward-to-end-of-expr': Likewise. `cperl-invert-if-unless': Works in "the opposite way" too Cursor position on return is on the switch-word Indents comments better `REx-interpolated': New text attribute `cperl-next-interpolated-REx': New function `cperl-next-interpolated-REx-0': Likewise. `cperl-next-interpolated-REx-1': Likewise. "\C-c\C-x", "\C-c\C-y", "\C-c\C-v": New keybinding for these functions Perl/Regexp menu: 3 new entries for `cperl-next-interpolated-REx' `cperl-praise': Mention finded interpolated RExen After 5.19: `cperl-init-faces': Highlight %$foo, @$foo too `cperl-short-docs': Better docs for system, exec `cperl-find-pods-heres': Better detect << after print {FH} <<EOF etc. Would not find HERE-doc ended by EOF without NL `cperl-short-docs': Correct not-doubled \-escapes start block: Put some `defvar' for stuff gone from XEmacs After 5.20: initial comment: Extend copyright, fix email address `cperl-indent-comment-at-column-0': New customization variable `cperl-comment-indent': Indentation after $#a would increasy by 1 `cperl-mode': Make `defun-prompt-regexp' grok BEGIN/END etc `cperl-find-pods-heres': Mark CODE of s///e as `syntax-type' `multiline' `cperl-at-end-of-expr': Would fail if @BAR=12 follows after ";" `cperl-init-faces': If `cperl-highlight-variables-indiscriminately' highlight $ in $foo too (UNTESTED) `cperl-set-style': Docstring missed some available styles toplevel: Menubar/Perl/Indent-Styles had FSF, now K&R Change "Current" to "Memorize Current" `cperl-indent-wrt-brace': New customization variable; the default is as for pre-5.2 version `cperl-styles-entries': Keep `cperl-extra-newline-before-brace-multiline' `cperl-style-alist': Likewise. `cperl-fix-line-spacing': Support `cperl-merge-trailing-else' being nil, and `cperl-extra-newline-before-brace' etc being t `cperl-indent-exp': Plans B and C to find continuation blocks even if `cperl-extra-newline-before-brace' is t After 5.21: Improve some docstrings concerning indentation. `cperl-indent-rules-alist': New variable `cperl-sniff-for-indent': New function name (separated from `cperl-calculate-indent') `cperl-calculate-indent': Separated the sniffer and the indenter; uses `cperl-sniff-for-indent' now `cperl-comment-indent': Test for `cperl-indent-comment-at-column-0' was inverted; Support `comment-column' = 0
author Stefan Monnier <monnier@iro.umontreal.ca>
date Wed, 11 Oct 2006 06:47:35 +0000
parents 23a17af379b1
children a274050b67b1 f9a65d7ebd29
line wrap: on
line source

/* A general interface to the widgets of different toolkits.
   Copyright (C) 1992, 1993 Lucid, Inc.

This file is part of the Lucid Widget Library.

The Lucid Widget Library 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.

The Lucid Widget Library 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 GNU Emacs; see the file COPYING.  If not, write to
the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
Boston, MA 02110-1301, USA.  */

#ifdef NeXT
#undef __STRICT_BSD__ /* ick */
#endif

#ifdef HAVE_CONFIG_H
#include <config.h>
#endif

#include "../src/lisp.h"

#include <sys/types.h>
#include <stdio.h>
#include <ctype.h>
#include "lwlib-int.h"
#include "lwlib-utils.h"
#include <X11/StringDefs.h>

#if defined (USE_LUCID)
#include "lwlib-Xlw.h"
#endif
#if defined (USE_MOTIF)
#include "lwlib-Xm.h"
#else /* not USE_MOTIF */
#if defined (USE_LUCID)
#define USE_XAW
#endif /* not USE_MOTIF && USE_LUCID */
#endif
#if defined (USE_XAW)
#include <X11/Xaw/Paned.h>
#include "lwlib-Xaw.h"
#endif

#if !defined (USE_LUCID) && !defined (USE_MOTIF)
 #error  At least one of USE_LUCID or USE_MOTIF must be defined.
#endif

#ifndef max
#define max(x, y) ((x) > (y) ? (x) : (y))
#endif

/* List of all widgets managed by the library. */
static widget_info*
all_widget_info = NULL;

#ifdef USE_MOTIF
char *lwlib_toolkit_type = "motif";
#else
char *lwlib_toolkit_type = "lucid";
#endif

static widget_value *merge_widget_value P_ ((widget_value *,
					     widget_value *,
					     int, int *));
static void instantiate_widget_instance P_ ((widget_instance *));
static int my_strcasecmp P_ ((char *, char *));
static void safe_free_str P_ ((char *));
static void free_widget_value_tree P_ ((widget_value *));
static widget_value *copy_widget_value_tree P_ ((widget_value *,
						 change_type));
static widget_info *allocate_widget_info P_ ((char *, char *, LWLIB_ID,
					      widget_value *,
					      lw_callback, lw_callback,
					      lw_callback, lw_callback));
static void free_widget_info P_ ((widget_info *));
static void mark_widget_destroyed P_ ((Widget, XtPointer, XtPointer));
static widget_instance *allocate_widget_instance P_ ((widget_info *,
						      Widget, Boolean));
static void free_widget_instance P_ ((widget_instance *));
static widget_info *get_widget_info P_ ((LWLIB_ID, Boolean));
static widget_instance *get_widget_instance P_ ((Widget, Boolean));
static widget_instance *find_instance P_ ((LWLIB_ID, Widget, Boolean));
static Boolean safe_strcmp P_ ((char *, char *));
static Widget name_to_widget P_ ((widget_instance *, char *));
static void set_one_value P_ ((widget_instance *, widget_value *, Boolean));
static void update_one_widget_instance P_ ((widget_instance *, Boolean));
static void update_all_widget_values P_ ((widget_info *, Boolean));
static void initialize_widget_instance P_ ((widget_instance *));
static widget_creation_function find_in_table P_ ((char *, widget_creation_entry *));
static Boolean dialog_spec_p P_ ((char *));
static void destroy_one_instance P_ ((widget_instance *));
static void lw_pop_all_widgets P_ ((LWLIB_ID, Boolean));
static Boolean get_one_value P_ ((widget_instance *, widget_value *));
static void show_one_widget_busy P_ ((Widget, Boolean));

void
lwlib_memset (address, value, length)
     char *address;
     int value;
     size_t length;
{
  int i;

  for (i = 0; i < length; i++)
    address[i] = value;
}

void
lwlib_bcopy (from, to, length)
     char *from;
     char *to;
     int length;
{
  int i;

  for (i = 0; i < length; i++)
    to[i] = from[i];
}
/* utility functions for widget_instance and widget_info */
char *
safe_strdup (s)
     const char *s;
{
  char *result;
  if (! s) return 0;
  result = (char *) malloc (strlen (s) + 1);
  if (! result)
    return 0;
  strcpy (result, s);
  return result;
}

/* Like strcmp but ignore differences in case.  */

static int
my_strcasecmp (s1, s2)
     char *s1, *s2;
{
  while (1)
    {
      int c1 = *s1++;
      int c2 = *s2++;
      if (isupper (c1))
	c1 = tolower (c1);
      if (isupper (c2))
	c2 = tolower (c2);
      if (c1 != c2)
	return (c1 > c2 ? 1 : -1);
      if (c1 == 0)
	return 0;
    }
}

static void
safe_free_str (s)
     char *s;
{
  if (s) free (s);
}

static widget_value *widget_value_free_list = 0;
static int malloc_cpt = 0;

widget_value *
malloc_widget_value ()
{
  widget_value *wv;
  if (widget_value_free_list)
    {
      wv = widget_value_free_list;
      widget_value_free_list = wv->free_list;
      wv->free_list = 0;
    }
  else
    {
      wv = (widget_value *) malloc (sizeof (widget_value));
      malloc_cpt++;
    }
  lwlib_memset ((void*) wv, 0, sizeof (widget_value));
  return wv;
}

/* this is analogous to free().  It frees only what was allocated
   by malloc_widget_value(), and no substructures.
 */
void
free_widget_value (wv)
     widget_value *wv;
{
  if (wv->free_list)
    abort ();

  if (malloc_cpt > 25)
    {
      /* When the number of already allocated cells is too big,
	 We free it.  */
      free (wv);
      malloc_cpt--;
    }
  else
    {
      wv->free_list = widget_value_free_list;
      widget_value_free_list = wv;
    }
}

static void
free_widget_value_tree (wv)
     widget_value *wv;
{
  if (!wv)
    return;

  if (wv->name) free (wv->name);
  if (wv->value) free (wv->value);
  if (wv->key) free (wv->key);

  wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;

  if (wv->toolkit_data && wv->free_toolkit_data)
    {
      XtFree (wv->toolkit_data);
      wv->toolkit_data = (void *) 0xDEADBEEF;
    }

  if (wv->contents && (wv->contents != (widget_value*)1))
    {
      free_widget_value_tree (wv->contents);
      wv->contents = (widget_value *) 0xDEADBEEF;
    }
  if (wv->next)
    {
      free_widget_value_tree (wv->next);
      wv->next = (widget_value *) 0xDEADBEEF;
    }
  free_widget_value (wv);
}

static widget_value *
copy_widget_value_tree (val, change)
     widget_value* val;
     change_type change;
{
  widget_value* copy;

  if (!val)
    return NULL;
  if (val == (widget_value *) 1)
    return val;

  copy = malloc_widget_value ();
  copy->name = safe_strdup (val->name);
  copy->value = safe_strdup (val->value);
  copy->key = safe_strdup (val->key);
  copy->help = val->help;
  copy->enabled = val->enabled;
  copy->button_type = val->button_type;
  copy->selected = val->selected;
  copy->edited = False;
  copy->change = change;
  copy->this_one_change = change;
  copy->contents = copy_widget_value_tree (val->contents, change);
  copy->call_data = val->call_data;
  copy->next = copy_widget_value_tree (val->next, change);
  copy->toolkit_data = NULL;
  copy->free_toolkit_data = False;
  return copy;
}

static widget_info *
allocate_widget_info (type, name, id, val, pre_activate_cb,
		      selection_cb, post_activate_cb, highlight_cb)
     char* type;
     char* name;
     LWLIB_ID id;
     widget_value* val;
     lw_callback pre_activate_cb;
     lw_callback selection_cb;
     lw_callback post_activate_cb;
     lw_callback highlight_cb;
{
  widget_info* info = (widget_info*)malloc (sizeof (widget_info));
  info->type = safe_strdup (type);
  info->name = safe_strdup (name);
  info->id = id;
  info->val = copy_widget_value_tree (val, STRUCTURAL_CHANGE);
  info->busy = False;
  info->pre_activate_cb = pre_activate_cb;
  info->selection_cb = selection_cb;
  info->post_activate_cb = post_activate_cb;
  info->highlight_cb = highlight_cb;
  info->instances = NULL;

  info->next = all_widget_info;
  all_widget_info = info;

  return info;
}

static void
free_widget_info (info)
     widget_info* info;
{
  safe_free_str (info->type);
  safe_free_str (info->name);
  free_widget_value_tree (info->val);
  lwlib_memset ((void*)info, 0xDEADBEEF, sizeof (widget_info));
  free (info);
}

static void
mark_widget_destroyed (widget, closure, call_data)
     Widget widget;
     XtPointer closure;
     XtPointer call_data;
{
  widget_instance* instance = (widget_instance*)closure;

  /* be very conservative */
  if (instance->widget == widget)
    instance->widget = NULL;
}

/* The messy #ifdef PROTOTYPES here and elsewhere are prompted by a
   flood of warnings about argument promotion from proprietary ISO C
   compilers.  (etags still only makes one entry for each function.)  */
static widget_instance *
#ifdef PROTOTYPES
allocate_widget_instance (widget_info* info, Widget parent, Boolean pop_up_p)
#else
allocate_widget_instance (info, parent, pop_up_p)
     widget_info* info;
     Widget parent;
     Boolean pop_up_p;
#endif
{
  widget_instance* instance =
    (widget_instance*)malloc (sizeof (widget_instance));
  bzero (instance, sizeof *instance);
  instance->parent = parent;
  instance->pop_up_p = pop_up_p;
  instance->info = info;
  instance->next = info->instances;
  info->instances = instance;

  instantiate_widget_instance (instance);

  XtAddCallback (instance->widget, XtNdestroyCallback,
		 mark_widget_destroyed, (XtPointer)instance);
  return instance;
}

static void
free_widget_instance (instance)
     widget_instance* instance;
{
  lwlib_memset ((void*)instance, 0xDEADBEEF, sizeof (widget_instance));
  free (instance);
}

static widget_info *
#ifdef PROTOTYPES
get_widget_info (LWLIB_ID id, Boolean remove_p)
#else
get_widget_info (id, remove_p)
     LWLIB_ID id;
     Boolean remove_p;
#endif
{
  widget_info* info;
  widget_info* prev;
  for (prev = NULL, info = all_widget_info;
       info;
       prev = info, info = info->next)
    if (info->id == id)
     {
       if (remove_p)
	 {
	   if (prev)
	     prev->next = info->next;
	   else
	     all_widget_info = info->next;
	 }
      return info;
     }
  return NULL;
}

/* Internal function used by the library dependent implementation to get the
   widget_value for a given widget in an instance */
widget_info *
lw_get_widget_info (id)
     LWLIB_ID id;
{
  return get_widget_info (id, 0);
}

static widget_instance *
#ifdef PROTOTYPES
get_widget_instance (Widget widget, Boolean remove_p)
#else
get_widget_instance (widget, remove_p)
     Widget widget;
     Boolean remove_p;
#endif
{
  widget_info* info;
  widget_instance* instance;
  widget_instance* prev;
  for (info = all_widget_info; info; info = info->next)
    for (prev = NULL, instance = info->instances;
	 instance;
	 prev = instance, instance = instance->next)
      if (instance->widget == widget)
	{
	  if (remove_p)
	    {
	      if (prev)
		prev->next = instance->next;
	      else
		info->instances = instance->next;
	    }
	  return instance;
	}
  return (widget_instance *) 0;
}

/* Value is a pointer to the widget_instance corresponding to
   WIDGET, or null if WIDGET is not a lwlib widget.  */

widget_instance *
lw_get_widget_instance (widget)
     Widget widget;
{
  return get_widget_instance (widget, False);
}

static widget_instance*
#ifdef PROTOTYPES
find_instance (LWLIB_ID id, Widget parent, Boolean pop_up_p)
#else
find_instance (id, parent, pop_up_p)
     LWLIB_ID id;
     Widget parent;
     Boolean pop_up_p;
#endif
{
  widget_info* info = get_widget_info (id, False);
  widget_instance* instance;

  if (info)
    for (instance = info->instances; instance; instance = instance->next)
      if (instance->parent == parent && instance->pop_up_p == pop_up_p)
	return instance;

  return NULL;
}


/* utility function for widget_value */
static Boolean
safe_strcmp (s1, s2)
     char* s1;
     char* s2;
{
  if (!!s1 ^ !!s2) return True;
  return (s1 && s2) ? strcmp (s1, s2) : s1 ? False : !!s2;
}


#if 0
# define EXPLAIN(name, oc, nc, desc, a1, a2)				\
   printf ("Change: \"%s\"\tmax(%s=%d,%s=%d)\t%s %d %d\n",		\
	   name,							\
	   (oc == NO_CHANGE ? "none" :					\
	    (oc == INVISIBLE_CHANGE ? "invisible" :			\
	     (oc == VISIBLE_CHANGE ? "visible" :			\
	      (oc == STRUCTURAL_CHANGE ? "structural" : "???")))),	\
	   oc,								\
	   (nc == NO_CHANGE ? "none" :					\
	    (nc == INVISIBLE_CHANGE ? "invisible" :			\
	     (nc == VISIBLE_CHANGE ? "visible" :			\
	      (nc == STRUCTURAL_CHANGE ? "structural" : "???")))),	\
	   nc, desc, a1, a2)
#else
# define EXPLAIN(name, oc, nc, desc, a1, a2)
#endif


static widget_value *
merge_widget_value (val1, val2, level, change_p)
     widget_value* val1;
     widget_value* val2;
     int level;
     int *change_p;
{
  change_type change, this_one_change;
  widget_value* merged_next;
  widget_value* merged_contents;

  if (!val1)
    {
      if (val2)
	{
	  *change_p = 1;
	  return copy_widget_value_tree (val2, STRUCTURAL_CHANGE);
	}
      else
	return NULL;
    }
  if (!val2)
    {
      *change_p = 1;
      free_widget_value_tree (val1);
      return NULL;
    }

  change = NO_CHANGE;

  if (safe_strcmp (val1->name, val2->name))
    {
      EXPLAIN (val1->name, change, STRUCTURAL_CHANGE, "name change",
	       val1->name, val2->name);
      change = max (change, STRUCTURAL_CHANGE);
      safe_free_str (val1->name);
      val1->name = safe_strdup (val2->name);
    }
  if (safe_strcmp (val1->value, val2->value))
    {
      EXPLAIN (val1->name, change, VISIBLE_CHANGE, "value change",
	       val1->value, val2->value);
      change = max (change, VISIBLE_CHANGE);
      safe_free_str (val1->value);
      val1->value = safe_strdup (val2->value);
    }
  if (safe_strcmp (val1->key, val2->key))
    {
      EXPLAIN (val1->name, change, VISIBLE_CHANGE, "key change",
	       val1->key, val2->key);
      change = max (change, VISIBLE_CHANGE);
      safe_free_str (val1->key);
      val1->key = safe_strdup (val2->key);
    }
  if (! EQ (val1->help, val2->help))
    {
      EXPLAIN (val1->name, change, VISIBLE_CHANGE, "help change",
	       val1->help, val2->help);
      change = max (change, VISIBLE_CHANGE);
      val1->help = val2->help;
    }
  if (val1->enabled != val2->enabled)
    {
      EXPLAIN (val1->name, change, VISIBLE_CHANGE, "enablement change",
	       val1->enabled, val2->enabled);
      change = max (change, VISIBLE_CHANGE);
      val1->enabled = val2->enabled;
    }
  if (val1->button_type != val2->button_type)
    {
      EXPLAIN (val1->name, change, VISIBLE_CHANGE, "button type change",
	       val1->button_type, val2->button_type);
      change = max (change, VISIBLE_CHANGE);
      val1->button_type = val2->button_type;
    }
  if (val1->selected != val2->selected)
    {
      EXPLAIN (val1->name, change, VISIBLE_CHANGE, "selection change",
	       val1->selected, val2->selected);
      change = max (change, VISIBLE_CHANGE);
      val1->selected = val2->selected;
    }
  if (val1->call_data != val2->call_data)
    {
      EXPLAIN (val1->name, change, INVISIBLE_CHANGE, "call-data change",
	       val1->call_data, val2->call_data);
      change = max (change, INVISIBLE_CHANGE);
      val1->call_data = val2->call_data;
    }

  if (level > 0)
    {
      merged_contents =
	merge_widget_value (val1->contents, val2->contents, level - 1,
			    change_p);

      if (val1->contents && !merged_contents)
	{
	  /* This used to say INVISIBLE_CHANGE,
	     but it is visible and vitally important when
	     the contents of the menu bar itself are entirely deleted.

	     But maybe it doesn't matter.  This fails to fix the bug.  */
	  EXPLAIN (val1->name, change, STRUCTURAL_CHANGE, "(contents gone)",
		   0, 0);
	  change = max (change, STRUCTURAL_CHANGE);
	}
      else if (merged_contents && merged_contents->change != NO_CHANGE)
	{
	  EXPLAIN (val1->name, change, INVISIBLE_CHANGE, "(contents change)",
		   0, 0);
	  change = max (change, INVISIBLE_CHANGE);
#if 0 /* This was replaced by the August 9 1996 change in lwlib-Xm.c.  */
#ifdef USE_MOTIF
	  change = max (merged_contents->change, change);
#endif
#endif
	}

      val1->contents = merged_contents;
    }

  this_one_change = change;

  merged_next = merge_widget_value (val1->next, val2->next, level, change_p);

  if (val1->next && !merged_next)
    {
      EXPLAIN (val1->name, change, STRUCTURAL_CHANGE, "(following gone)",
	       0, 0);
      change = max (change, STRUCTURAL_CHANGE);
    }
  else if (merged_next)
    {
      if (merged_next->change)
	EXPLAIN (val1->name, change, merged_next->change, "(following change)",
		 0, 0);
      change = max (change, merged_next->change);
    }

  val1->next = merged_next;

  val1->this_one_change = this_one_change;
  val1->change = change;

  if (change > NO_CHANGE && val1->toolkit_data)
    {
      *change_p = 1;
      if (val1->free_toolkit_data)
	XtFree (val1->toolkit_data);
      val1->toolkit_data = NULL;
    }

  return val1;
}


/* modifying the widgets */
static Widget
name_to_widget (instance, name)
     widget_instance* instance;
     char* name;
{
  Widget widget = NULL;

  if (!instance->widget)
    return NULL;

  if (!strcmp (XtName (instance->widget), name))
    widget = instance->widget;
  else
    {
      int length = strlen (name) + 2;
      char* real_name = (char *) xmalloc (length);
      real_name [0] = '*';
      strcpy (real_name + 1, name);

      widget = XtNameToWidget (instance->widget, real_name);

      free (real_name);
    }
  return widget;
}

static void
#ifdef PROTOTYPES
set_one_value (widget_instance* instance, widget_value* val, Boolean deep_p)
#else
set_one_value (instance, val, deep_p)
     widget_instance* instance;
     widget_value* val;
     Boolean deep_p;
#endif
{
  Widget widget = name_to_widget (instance, val->name);

  if (widget)
    {
#if defined (USE_LUCID)
      if (lw_lucid_widget_p (instance->widget))
	xlw_update_one_widget (instance, widget, val, deep_p);
#endif
#if defined (USE_MOTIF)
      if (lw_motif_widget_p (instance->widget))
	xm_update_one_widget (instance, widget, val, deep_p);
#endif
#if defined (USE_XAW)
      if (lw_xaw_widget_p (instance->widget))
	xaw_update_one_widget (instance, widget, val, deep_p);
#endif
    }
}

static void
#ifdef PROTOTYPES
update_one_widget_instance (widget_instance* instance, Boolean deep_p)
#else
update_one_widget_instance (instance, deep_p)
     widget_instance* instance;
     Boolean deep_p;
#endif
{
  widget_value *val;

  if (!instance->widget)
    /* the widget was destroyed */
    return;

  for (val = instance->info->val; val; val = val->next)
    if (val->change != NO_CHANGE)
      set_one_value (instance, val, deep_p);
}

static void
#ifdef PROTOTYPES
update_all_widget_values (widget_info* info, Boolean deep_p)
#else
update_all_widget_values (info, deep_p)
     widget_info* info;
     Boolean deep_p;
#endif
{
  widget_instance* instance;
  widget_value* val;

  for (instance = info->instances; instance; instance = instance->next)
    update_one_widget_instance (instance, deep_p);

  for (val = info->val; val; val = val->next)
    val->change = NO_CHANGE;
}

int
#ifdef PROTOTYPES
lw_modify_all_widgets (LWLIB_ID id, widget_value* val, Boolean deep_p)
#else
lw_modify_all_widgets (id, val, deep_p)
     LWLIB_ID id;
     widget_value* val;
     Boolean deep_p;
#endif
{
  widget_info* info = get_widget_info (id, False);
  widget_value* new_val;
  widget_value* next_new_val;
  widget_value* cur;
  widget_value* prev;
  widget_value* next;
  int		found;
  int change_p = 0;

  if (!info)
    return 0;

  for (new_val = val; new_val; new_val = new_val->next)
    {
      next_new_val = new_val->next;
      new_val->next = NULL;
      found = False;
      for (prev = NULL, cur = info->val; cur; prev = cur, cur = cur->next)
	if (!strcmp (cur->name, new_val->name))
	  {
	    found = True;
	    next = cur->next;
	    cur->next = NULL;
	    cur = merge_widget_value (cur, new_val, deep_p ? 1000 : 1,
				      &change_p);
	    if (prev)
	      prev->next = cur ? cur : next;
	    else
	      info->val = cur ? cur : next;
	    if (cur)
	      cur->next = next;
	    break;
	  }
      if (!found)
	{
	  /* Could not find it, add it */
	  if (prev)
	    prev->next = copy_widget_value_tree (new_val, STRUCTURAL_CHANGE);
	  else
	    info->val = copy_widget_value_tree (new_val, STRUCTURAL_CHANGE);
	  change_p = 1;
	}
      new_val->next = next_new_val;
    }

  update_all_widget_values (info, deep_p);
  return change_p;
}


/* creating the widgets */

static void
initialize_widget_instance (instance)
     widget_instance* instance;
{
  widget_value* val;

  for (val = instance->info->val; val; val = val->next)
    val->change = STRUCTURAL_CHANGE;

  update_one_widget_instance (instance, True);

  for (val = instance->info->val; val; val = val->next)
    val->change = NO_CHANGE;
}


static widget_creation_function
find_in_table (type, table)
     char* type;
     widget_creation_entry* table;
{
  widget_creation_entry* cur;
  for (cur = table; cur->type; cur++)
    if (!my_strcasecmp (type, cur->type))
      return cur->function;
  return NULL;
}

static Boolean
dialog_spec_p (name)
     char* name;
{
  /* return True if name matches [EILPQeilpq][1-9][Bb] or
     [EILPQeilpq][1-9][Bb][Rr][1-9] */
  if (!name)
    return False;

  switch (name [0])
    {
    case 'E': case 'I': case 'L': case 'P': case 'Q':
    case 'e': case 'i': case 'l': case 'p': case 'q':
      if (name [1] >= '0' && name [1] <= '9')
	{
	  if (name [2] != 'B' && name [2] != 'b')
	    return False;
	  if (!name [3])
	    return True;
	  if ((name [3] == 'T' || name [3] == 't') && !name [4])
	    return True;
	  if ((name [3] == 'R' || name [3] == 'r')
	      && name [4] >= '0' && name [4] <= '9' && !name [5])
	    return True;
	  return False;
	}
      else
	return False;

    default:
      return False;
    }
}

static void
instantiate_widget_instance (instance)
     widget_instance* instance;
{
  widget_creation_function function = NULL;

#if defined (USE_LUCID)
  if (!function)
    function = find_in_table (instance->info->type, xlw_creation_table);
#endif
#if defined(USE_MOTIF)
  if (!function)
    function = find_in_table (instance->info->type, xm_creation_table);
#endif
#if defined (USE_XAW)
  if (!function)
    function = find_in_table (instance->info->type, xaw_creation_table);
#endif

  if (!function)
    {
      if (dialog_spec_p (instance->info->type))
	{
#if defined (USE_LUCID)
	  /* not yet */
#endif
#if defined(USE_MOTIF)
	  if (!function)
	    function = xm_create_dialog;
#endif
#if defined (USE_XAW)
	  if (!function)
	    function = xaw_create_dialog;
#endif
	}
    }

  if (!function)
    {
      printf ("No creation function for widget type %s\n",
	      instance->info->type);
      abort ();
    }

  instance->widget = (*function) (instance);

  if (!instance->widget)
    abort ();

  /*   XtRealizeWidget (instance->widget);*/
}

void
lw_register_widget (type, name, id, val, pre_activate_cb,
		    selection_cb, post_activate_cb, highlight_cb)
     char* type;
     char* name;
     LWLIB_ID id;
     widget_value* val;
     lw_callback pre_activate_cb;
     lw_callback selection_cb;
     lw_callback post_activate_cb;
     lw_callback highlight_cb;
{
  if (!get_widget_info (id, False))
    allocate_widget_info (type, name, id, val, pre_activate_cb, selection_cb,
			  post_activate_cb, highlight_cb);
}

Widget
#ifdef PROTOTYPES
lw_get_widget (LWLIB_ID id, Widget parent, Boolean pop_up_p)
#else
lw_get_widget (id, parent, pop_up_p)
     LWLIB_ID id;
     Widget parent;
     Boolean pop_up_p;
#endif
{
  widget_instance* instance;

  instance = find_instance (id, parent, pop_up_p);
  return instance ? instance->widget : NULL;
}

Widget
#ifdef PROTOTYPES
lw_make_widget (LWLIB_ID id, Widget parent, Boolean pop_up_p)
#else
lw_make_widget (id, parent, pop_up_p)
     LWLIB_ID id;
     Widget parent;
     Boolean pop_up_p;
#endif
{
  widget_instance* instance;
  widget_info* info;

  instance = find_instance (id, parent, pop_up_p);
  if (!instance)
    {
      info = get_widget_info (id, False);
      if (!info)
	return NULL;
      instance = allocate_widget_instance (info, parent, pop_up_p);
      initialize_widget_instance (instance);
    }
  if (!instance->widget)
    abort ();
  return instance->widget;
}

Widget
#ifdef PROTOTYPES
lw_create_widget (char* type, char* name, LWLIB_ID id, widget_value* val,
		  Widget parent, Boolean pop_up_p,
		  lw_callback pre_activate_cb, lw_callback selection_cb,
		  lw_callback post_activate_cb, lw_callback highlight_cb)
#else
lw_create_widget (type, name, id, val, parent, pop_up_p, pre_activate_cb,
		  selection_cb, post_activate_cb, highlight_cb)
     char* type;
     char* name;
     LWLIB_ID id;
     widget_value* val;
     Widget parent;
     Boolean pop_up_p;
     lw_callback pre_activate_cb;
     lw_callback selection_cb;
     lw_callback post_activate_cb;
     lw_callback highlight_cb;
#endif
{
  lw_register_widget (type, name, id, val, pre_activate_cb, selection_cb,
		      post_activate_cb, highlight_cb);
  return lw_make_widget (id, parent, pop_up_p);
}


/* destroying the widgets */
static void
destroy_one_instance (instance)
     widget_instance* instance;
{
  /* Remove the destroy callback on the widget; that callback will try to
     dereference the instance object (to set its widget slot to 0, since the
     widget is dead.)  Since the instance is now dead, we don't have to worry
     about the fact that its widget is dead too.

     This happens in the Phase2Destroy of the widget, so this callback would
     not have been run until arbitrarily long after the instance was freed.
   */
  if (instance->widget)
    XtRemoveCallback (instance->widget, XtNdestroyCallback,
		      mark_widget_destroyed, (XtPointer)instance);

  if (instance->widget)
    {
      /* The else are pretty tricky here, including the empty statement
	 at the end because it would be very bad to destroy a widget
	 twice. */
#if defined (USE_LUCID)
      if (lw_lucid_widget_p (instance->widget))
	xlw_destroy_instance (instance);
      else
#endif
#if defined (USE_MOTIF)
      if (lw_motif_widget_p (instance->widget))
	xm_destroy_instance (instance);
      else
#endif
#if defined (USE_XAW)
      if (lw_xaw_widget_p (instance->widget))
	xaw_destroy_instance (instance);
      else
#endif
	/* do not remove the empty statement */
	;
    }

  free_widget_instance (instance);
}

void
lw_destroy_widget (w)
     Widget w;
{
  widget_instance* instance = get_widget_instance (w, True);

  if (instance)
    {
      widget_info *info = instance->info;
      /* instance has already been removed from the list; free it */
      destroy_one_instance (instance);
      /* if there are no instances left, free the info too */
      if (!info->instances)
	lw_destroy_all_widgets (info->id);
    }
}

void
lw_destroy_all_widgets (id)
     LWLIB_ID id;
{
  widget_info* info = get_widget_info (id, True);
  widget_instance* instance;
  widget_instance* next;

  if (info)
    {
      for (instance = info->instances; instance; )
	{
	  next = instance->next;
	  destroy_one_instance (instance);
	  instance = next;
	}
      free_widget_info (info);
    }
}

void
lw_destroy_everything ()
{
  while (all_widget_info)
    lw_destroy_all_widgets (all_widget_info->id);
}

void
lw_destroy_all_pop_ups ()
{
  widget_info* info;
  widget_info* next;
  widget_instance* instance;

  for (info = all_widget_info; info; info = next)
    {
      next = info->next;
      instance = info->instances;
      if (instance && instance->pop_up_p)
	lw_destroy_all_widgets (info->id);
    }
}

#ifdef USE_MOTIF
extern Widget first_child (/* Widget */);	/* garbage */
#endif

Widget
lw_raise_all_pop_up_widgets ()
{
  widget_info* info;
  widget_instance* instance;
  Widget result = NULL;

  for (info = all_widget_info; info; info = info->next)
    for (instance = info->instances; instance; instance = instance->next)
      if (instance->pop_up_p)
	{
	  Widget widget = instance->widget;
	  if (widget)
	    {
	      if (XtIsManaged (widget)
#ifdef USE_MOTIF
		  /* What a complete load of crap!!!!
		     When a dialogShell is on the screen, it is not managed!
		   */
		  || (lw_motif_widget_p (instance->widget) &&
		      XtIsManaged (first_child (widget)))
#endif
		  )
		{
		  if (!result)
		    result = widget;
		  XMapRaised (XtDisplay (widget), XtWindow (widget));
		}
	    }
	}
  return result;
}

static void
#ifdef PROTOTYPES
lw_pop_all_widgets (LWLIB_ID id, Boolean up)
#else
lw_pop_all_widgets (id, up)
     LWLIB_ID id;
     Boolean up;
#endif
{
  widget_info* info = get_widget_info (id, False);
  widget_instance* instance;

  if (info)
    for (instance = info->instances; instance; instance = instance->next)
      if (instance->pop_up_p && instance->widget)
	{
#if defined (USE_LUCID)
	  if (lw_lucid_widget_p (instance->widget))
	    {
	      XtRealizeWidget (instance->widget);
	      xlw_pop_instance (instance, up);
	    }
#endif
#if defined (USE_MOTIF)
	  if (lw_motif_widget_p (instance->widget))
	    {
	      XtRealizeWidget (instance->widget);
	      xm_pop_instance (instance, up);
	    }
#endif
#if defined (USE_XAW)
	  if (lw_xaw_widget_p (instance->widget))
	    {
	      XtRealizeWidget (XtParent (instance->widget));
	      XtRealizeWidget (instance->widget);
	      xaw_pop_instance (instance, up);
	    }
#endif
	}
}

void
lw_pop_up_all_widgets (id)
     LWLIB_ID id;
{
  lw_pop_all_widgets (id, True);
}

void
lw_pop_down_all_widgets (id)
     LWLIB_ID id;
{
  lw_pop_all_widgets (id, False);
}

void
lw_popup_menu (widget, event)
     Widget widget;
     XEvent *event;
{
#if defined (USE_LUCID)
  if (lw_lucid_widget_p (widget))
    xlw_popup_menu (widget, event);
#endif
#if defined (USE_MOTIF)
  if (lw_motif_widget_p (widget))
    xm_popup_menu (widget, event);
#endif
#if defined (USE_XAW)
  if (lw_xaw_widget_p (widget))
    xaw_popup_menu (widget, event);
#endif
}

/* get the values back */
static Boolean
get_one_value (instance, val)
     widget_instance* instance;
     widget_value* val;
{
  Widget widget = name_to_widget (instance, val->name);

  if (widget)
    {
#if defined (USE_LUCID)
      if (lw_lucid_widget_p (instance->widget))
	xlw_update_one_value (instance, widget, val);
#endif
#if defined (USE_MOTIF)
      if (lw_motif_widget_p (instance->widget))
	xm_update_one_value (instance, widget, val);
#endif
#if defined (USE_XAW)
      if (lw_xaw_widget_p (instance->widget))
	xaw_update_one_value (instance, widget, val);
#endif
      return True;
    }
  else
    return False;
}

Boolean
lw_get_some_values (id, val_out)
     LWLIB_ID id;
     widget_value* val_out;
{
  widget_info* info = get_widget_info (id, False);
  widget_instance* instance;
  widget_value* val;
  Boolean result = False;

  if (!info)
    return False;

  instance = info->instances;
  if (!instance)
    return False;

  for (val = val_out; val; val = val->next)
    if (get_one_value (instance, val))
      result = True;

  return result;
}

widget_value*
lw_get_all_values (id)
     LWLIB_ID id;
{
  widget_info* info = get_widget_info (id, False);
  widget_value* val = info->val;
  if (lw_get_some_values (id, val))
    return val;
  else
    return NULL;
}

/* internal function used by the library dependent implementation to get the
   widget_value for a given widget in an instance */
widget_value*
lw_get_widget_value_for_widget (instance, w)
     widget_instance* instance;
     Widget w;
{
  char* name = XtName (w);
  widget_value* cur;
  for (cur = instance->info->val; cur; cur = cur->next)
    if (!strcmp (cur->name, name))
      return cur;
  return NULL;
}

/* update other instances value when one thing changed */

/* To forbid recursive calls */
static Boolean lwlib_updating;

/* This function can be used as a an XtCallback for the widgets that get
  modified to update other instances of the widgets.  Closure should be the
  widget_instance. */
void
lw_internal_update_other_instances (widget, closure, call_data)
     Widget widget;
     XtPointer closure;
     XtPointer call_data;
{
  widget_instance* instance = (widget_instance*)closure;
  char* name = XtName (widget);
  widget_info* info;
  widget_instance* cur;
  widget_value* val;

  /* Avoid possibly infinite recursion.  */
  if (lwlib_updating)
    return;

  /* protect against the widget being destroyed */
  if (XtWidgetBeingDestroyedP (widget))
    return;

  /* Return immediately if there are no other instances */
  info = instance->info;
  if (!info->instances->next)
    return;

  lwlib_updating = True;

  for (val = info->val; val && strcmp (val->name, name); val = val->next);

  if (val && get_one_value (instance, val))
    for (cur = info->instances; cur; cur = cur->next)
      if (cur != instance)
	set_one_value (cur, val, True);

  lwlib_updating = False;
}


/* get the id */

LWLIB_ID
lw_get_widget_id (w)
     Widget w;
{
  widget_instance* instance = get_widget_instance (w, False);

  return instance ? instance->info->id : 0;
}

/* set the keyboard focus */
void
lw_set_keyboard_focus (parent, w)
     Widget parent;
     Widget w;
{
#if defined (USE_MOTIF)
  xm_set_keyboard_focus (parent, w);
#else
  XtSetKeyboardFocus (parent, w);
#endif
}

/* Show busy */
static void
#ifdef PROTOTYPES
show_one_widget_busy (Widget w, Boolean flag)
#else
show_one_widget_busy (w, flag)
     Widget w;
     Boolean flag;
#endif
{
  Pixel foreground = 0;
  Pixel background = 1;
  Widget widget_to_invert = XtNameToWidget (w, "*sheet");
  if (!widget_to_invert)
    widget_to_invert = w;

  XtVaGetValues (widget_to_invert,
		 XtNforeground, &foreground,
		 XtNbackground, &background,
		 NULL);
  XtVaSetValues (widget_to_invert,
		 XtNforeground, background,
		 XtNbackground, foreground,
		 NULL);
}

void
#ifdef PROTOTYPES
lw_show_busy (Widget w, Boolean busy)
#else
lw_show_busy (w, busy)
     Widget w;
     Boolean busy;
#endif
{
  widget_instance* instance = get_widget_instance (w, False);
  widget_info* info;
  widget_instance* next;

  if (instance)
    {
      info = instance->info;
      if (info->busy != busy)
	{
	  for (next = info->instances; next; next = next->next)
	    if (next->widget)
	      show_one_widget_busy (next->widget, busy);
	  info->busy = busy;
	}
    }
}

/* This hack exists because Lucid/Athena need to execute the strange
   function below to support geometry management. */
void
#ifdef PROTOTYPES
lw_refigure_widget (Widget w, Boolean doit)
#else
lw_refigure_widget (w, doit)
     Widget w;
     Boolean doit;
#endif
{
#if defined (USE_XAW)
  XawPanedSetRefigureMode (w, doit);
#endif
#if defined (USE_MOTIF)
  if (doit)
    XtManageChild (w);
  else
    XtUnmanageChild (w);
#endif
}

/* Toolkit independent way of determining if an event window is in the
   menubar. */
Boolean
lw_window_is_in_menubar (win, menubar_widget)
     Window win;
     Widget menubar_widget;
{
  return menubar_widget
#if defined (USE_LUCID)
      && XtWindow (menubar_widget) == win;
#endif
#if defined (USE_MOTIF)
      && ((XtWindow (menubar_widget) == win)
	  || (XtWindowToWidget (XtDisplay (menubar_widget), win)
	      && (XtParent (XtWindowToWidget (XtDisplay (menubar_widget), win))
		  == menubar_widget)));
#endif
}

/* Motif hack to set the main window areas. */
void
lw_set_main_areas (parent, menubar, work_area)
     Widget parent;
     Widget menubar;
     Widget work_area;
{
#if defined (USE_MOTIF)
  xm_set_main_areas (parent, menubar, work_area);
#endif
}

/* Manage resizing for Motif.  This disables resizing when the menubar
   is about to be modified. */
void
#ifdef PROTOTYPES
lw_allow_resizing (Widget w, Boolean flag)
#else
lw_allow_resizing (w, flag)
     Widget w;
     Boolean flag;
#endif
{
#if defined (USE_MOTIF)
  xm_manage_resizing (w, flag);
#endif
}


/* Value is non-zero if LABEL is a menu separator.  If it is, *TYPE is
   set to an appropriate enumerator of type enum menu_separator.
   MOTIF_P non-zero means map separator types not supported by Motif
   to similar ones that are supported.  */

int
lw_separator_p (label, type, motif_p)
     char *label;
     enum menu_separator *type;
     int motif_p;
{
  int separator_p = 0;

  if (strlen (label) >= 3
      && bcmp (label, "--:", 3) == 0)
    {
      static struct separator_table
      {
	char *name;
	enum menu_separator type;
      }
      separator_names[] =
      {
	{"space",		      SEPARATOR_NO_LINE},
	{"noLine",		      SEPARATOR_NO_LINE},
	{"singleLine",		      SEPARATOR_SINGLE_LINE},
	{"doubleLine",		      SEPARATOR_DOUBLE_LINE},
	{"singleDashedLine",	      SEPARATOR_SINGLE_DASHED_LINE},
	{"doubleDashedLine",	      SEPARATOR_DOUBLE_DASHED_LINE},
	{"shadowEtchedIn",	      SEPARATOR_SHADOW_ETCHED_IN},
	{"shadowEtchedOut",	      SEPARATOR_SHADOW_ETCHED_OUT},
	{"shadowEtchedInDash",	      SEPARATOR_SHADOW_ETCHED_IN_DASH},
	{"shadowEtchedOutDash",	      SEPARATOR_SHADOW_ETCHED_OUT_DASH},
	{"shadowDoubleEtchedIn",      SEPARATOR_SHADOW_DOUBLE_ETCHED_IN},
	{"shadowDoubleEtchedOut",     SEPARATOR_SHADOW_DOUBLE_ETCHED_OUT},
	{"shadowDoubleEtchedInDash",  SEPARATOR_SHADOW_DOUBLE_ETCHED_IN_DASH},
	{"shadowDoubleEtchedOutDash", SEPARATOR_SHADOW_DOUBLE_ETCHED_OUT_DASH},
	{0,0}
      };

      int i;

      label += 3;
      for (i = 0; separator_names[i].name; ++i)
	if (strcmp (label, separator_names[i].name) == 0)
	  {
	    separator_p = 1;
	    *type = separator_names[i].type;

	    /* If separator type is not supported under Motif,
	       use a similar one.  */
	    if (motif_p && *type >= SEPARATOR_SHADOW_DOUBLE_ETCHED_IN)
	      *type -= 4;
	    break;
	  }
    }
  else if (strlen (label) > 3
	   && bcmp (label, "--", 2) == 0
	   && label[2] != '-')
    {
      /* Alternative, more Emacs-style names.  */
      static struct separator_table
      {
	char *name;
	enum menu_separator type;
      }
      separator_names[] =
      {
	{"space",			 SEPARATOR_NO_LINE},
	{"no-line",			 SEPARATOR_NO_LINE},
	{"single-line",			 SEPARATOR_SINGLE_LINE},
	{"double-line",			 SEPARATOR_DOUBLE_LINE},
	{"single-dashed-line",		 SEPARATOR_SINGLE_DASHED_LINE},
	{"double-dashed-line",		 SEPARATOR_DOUBLE_DASHED_LINE},
	{"shadow-etched-in",		 SEPARATOR_SHADOW_ETCHED_IN},
	{"shadow-etched-out",		 SEPARATOR_SHADOW_ETCHED_OUT},
	{"shadow-etched-in-dash",	 SEPARATOR_SHADOW_ETCHED_IN_DASH},
	{"shadow-etched-out-dash",	 SEPARATOR_SHADOW_ETCHED_OUT_DASH},
	{"shadow-double-etched-in",	 SEPARATOR_SHADOW_DOUBLE_ETCHED_IN},
	{"shadow-double-etched-out",     SEPARATOR_SHADOW_DOUBLE_ETCHED_OUT},
	{"shadow-double-etched-in-dash", SEPARATOR_SHADOW_DOUBLE_ETCHED_IN_DASH},
	{"shadow-double-etched-out-dash",SEPARATOR_SHADOW_DOUBLE_ETCHED_OUT_DASH},
	{0,0}
      };

      int i;

      label += 2;
      for (i = 0; separator_names[i].name; ++i)
	if (strcmp (label, separator_names[i].name) == 0)
	  {
	    separator_p = 1;
	    *type = separator_names[i].type;

	    /* If separator type is not supported under Motif,
	       use a similar one.  */
	    if (motif_p && *type >= SEPARATOR_SHADOW_DOUBLE_ETCHED_IN)
	      *type -= 4;
	    break;
	  }
    }
  else
    {
      /* Old-style separator, maybe.  It's a separator if it contains
	 only dashes.  */
      while (*label == '-')
	++label;
      separator_p = *label == 0;
      *type = SEPARATOR_SHADOW_ETCHED_IN;
    }

  return separator_p;
}

/* arch-tag: 3d730f36-a441-4a71-9971-48ef3b5a4d9f
   (do not change this comment) */