static void
push_menu_pane (Lisp_Object name, Lisp_Object prefix_vec)
{
if (menu_items_used + MENU_ITEMS_PANE_LENGTH > menu_items_allocated)
grow_menu_items ();
if (menu_items_submenu_depth == 0)
menu_items_n_panes++;
XVECTOR (menu_items)->contents[menu_items_used++] = Qt;
XVECTOR (menu_items)->contents[menu_items_used++] = name;
XVECTOR (menu_items)->contents[menu_items_used++] = prefix_vec;
}
/* Compile a regexp and signal a Lisp error if anything goes wrong. */
void
compile_pattern (Lisp_Object pattern, struct re_pattern_buffer *bufp, char *translate, int backward)
{
char *val;
Lisp_Object dummy;
if (EQ (pattern, last_regexp)
&& translate == bufp->translate /* 92.4.10 by K.Handa */
/* 93.7.13 by K.Handa */
&& NILP (current_buffer->mc_flag) == !bufp->mc_flag
&& (!bufp->syntax_version
|| bufp->syntax_version == syntax_table_version)
&& (!bufp->category_version
|| bufp->category_version == category_table_version))
return;
if (CONSP (pattern)) /* pre-compiled regexp */
{
Lisp_Object compiled;
val = 0;
pattern = XCONS (pattern)->car;
if (CONSP (pattern)
&& (compiled = backward ? XCONS(pattern)->cdr : XCONS(pattern)->car)
&& XTYPE (compiled) == Lisp_Vector
&& XVECTOR (compiled)->size == 4) {
/* set_pattern will set bufp->allocated to NULL */
set_pattern (compiled, bufp, translate);
return;
}
val = "Invalied pre-compiled regexp";
goto invalid_regexp;
}
CHECK_STRING (pattern, 0);
last_regexp = Qnil;
bufp->translate = translate;
bufp->syntax_version = bufp->category_version = 0; /* 93.7.13 by K.Handa */
/* 92.7.10 by T.Enami
'bufp->allocated == 0' means bufp->buffer points to pre-compiled pattern
in a lisp string, which should not be 'realloc'ed. */
if (bufp->allocated == 0) bufp->buffer = 0;
val = re_compile_pattern (XSTRING (pattern)->data,
XSTRING (pattern)->size,
bufp);
if (val)
{
invalid_regexp:
dummy = build_string (val);
while (1)
Fsignal (Qinvalid_regexp, Fcons (dummy, Qnil));
}
last_regexp = pattern;
return;
}
static void
push_left_right_boundary (void)
{
if (menu_items_used + 1 > menu_items_allocated)
grow_menu_items ();
XVECTOR (menu_items)->contents[menu_items_used++] = Qquote;
}
/* As above, but return the menu selection instead of storing in kb buffer.
If keymaps==1, return full prefixes to selection. */
Lisp_Object
find_and_return_menu_selection (FRAME_PTR f, int keymaps, void *client_data)
{
Lisp_Object prefix, entry;
int i;
Lisp_Object *subprefix_stack;
int submenu_depth = 0;
prefix = entry = Qnil;
i = 0;
subprefix_stack =
(Lisp_Object *)alloca(menu_items_used * sizeof (Lisp_Object));
while (i < menu_items_used)
{
if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
{
subprefix_stack[submenu_depth++] = prefix;
prefix = entry;
i++;
}
else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
{
prefix = subprefix_stack[--submenu_depth];
i++;
}
else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
{
prefix
= XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
i += MENU_ITEMS_PANE_LENGTH;
}
/* Ignore a nil in the item list.
It's meaningful only for dialog boxes. */
else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
i += 1;
else
{
entry
= XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
if ((EMACS_INT)client_data == (EMACS_INT)(&XVECTOR (menu_items)->contents[i]))
{
if (keymaps != 0)
{
int j;
entry = Fcons (entry, Qnil);
if (!NILP (prefix))
entry = Fcons (prefix, entry);
for (j = submenu_depth - 1; j >= 0; j--)
if (!NILP (subprefix_stack[j]))
entry = Fcons (subprefix_stack[j], entry);
}
return entry;
}
i += MENU_ITEMS_ITEM_LENGTH;
}
}
return Qnil;
}
static void
push_submenu_end (void)
{
if (menu_items_used + 1 > menu_items_allocated)
grow_menu_items ();
XVECTOR (menu_items)->contents[menu_items_used++] = Qlambda;
menu_items_submenu_depth--;
}
static void
push_submenu_start (void)
{
if (menu_items_used + 1 > menu_items_allocated)
grow_menu_items ();
XVECTOR (menu_items)->contents[menu_items_used++] = Qnil;
menu_items_submenu_depth++;
}
void
set_frame_menubar (struct frame *f, bool first_time, bool deep_p)
{
HMENU menubar_widget = f->output_data.w32->menubar_widget;
Lisp_Object items;
widget_value *wv, *first_wv, *prev_wv = 0;
int i, last_i;
int *submenu_start, *submenu_end;
int *submenu_top_level_items, *submenu_n_panes;
/* We must not change the menubar when actually in use. */
if (f->output_data.w32->menubar_active)
return;
XSETFRAME (Vmenu_updating_frame, f);
if (! menubar_widget)
deep_p = true;
if (deep_p)
{
/* Make a widget-value tree representing the entire menu trees. */
struct buffer *prev = current_buffer;
Lisp_Object buffer;
ptrdiff_t specpdl_count = SPECPDL_INDEX ();
int previous_menu_items_used = f->menu_bar_items_used;
Lisp_Object *previous_items
= (Lisp_Object *) alloca (previous_menu_items_used
* word_size);
/* If we are making a new widget, its contents are empty,
do always reinitialize them. */
if (! menubar_widget)
previous_menu_items_used = 0;
buffer = XWINDOW (FRAME_SELECTED_WINDOW (f))->contents;
specbind (Qinhibit_quit, Qt);
/* Don't let the debugger step into this code
because it is not reentrant. */
specbind (Qdebug_on_next_call, Qnil);
record_unwind_save_match_data ();
if (NILP (Voverriding_local_map_menu_flag))
{
specbind (Qoverriding_terminal_local_map, Qnil);
specbind (Qoverriding_local_map, Qnil);
}
set_buffer_internal_1 (XBUFFER (buffer));
/* Run the hooks. */
safe_run_hooks (Qactivate_menubar_hook);
safe_run_hooks (Qmenu_bar_update_hook);
fset_menu_bar_items (f, menu_bar_items (FRAME_MENU_BAR_ITEMS (f)));
items = FRAME_MENU_BAR_ITEMS (f);
/* Save the frame's previous menu bar contents data. */
if (previous_menu_items_used)
memcpy (previous_items, XVECTOR (f->menu_bar_vector)->contents,
previous_menu_items_used * word_size);
/* Fill in menu_items with the current menu bar contents.
This can evaluate Lisp code. */
save_menu_items ();
menu_items = f->menu_bar_vector;
menu_items_allocated = VECTORP (menu_items) ? ASIZE (menu_items) : 0;
submenu_start = (int *) alloca (ASIZE (items) * sizeof (int));
submenu_end = (int *) alloca (ASIZE (items) * sizeof (int));
submenu_n_panes = (int *) alloca (ASIZE (items) * sizeof (int));
submenu_top_level_items = (int *) alloca (ASIZE (items) * sizeof (int));
init_menu_items ();
for (i = 0; i < ASIZE (items); i += 4)
{
Lisp_Object key, string, maps;
last_i = i;
key = AREF (items, i);
string = AREF (items, i + 1);
maps = AREF (items, i + 2);
if (NILP (string))
break;
submenu_start[i] = menu_items_used;
menu_items_n_panes = 0;
submenu_top_level_items[i]
= parse_single_submenu (key, string, maps);
submenu_n_panes[i] = menu_items_n_panes;
submenu_end[i] = menu_items_used;
}
finish_menu_items ();
/* Convert menu_items into widget_value trees
to display the menu. This cannot evaluate Lisp code. */
wv = make_widget_value ("menubar", NULL, true, Qnil);
wv->button_type = BUTTON_TYPE_NONE;
first_wv = wv;
for (i = 0; i < last_i; i += 4)
{
menu_items_n_panes = submenu_n_panes[i];
wv = digest_single_submenu (submenu_start[i], submenu_end[i],
submenu_top_level_items[i]);
if (prev_wv)
prev_wv->next = wv;
else
first_wv->contents = wv;
/* Don't set wv->name here; GC during the loop might relocate it. */
wv->enabled = true;
wv->button_type = BUTTON_TYPE_NONE;
prev_wv = wv;
}
set_buffer_internal_1 (prev);
/* If there has been no change in the Lisp-level contents
of the menu bar, skip redisplaying it. Just exit. */
for (i = 0; i < previous_menu_items_used; i++)
if (menu_items_used == i
|| (!EQ (previous_items[i], AREF (menu_items, i))))
break;
if (i == menu_items_used && i == previous_menu_items_used && i != 0)
{
free_menubar_widget_value_tree (first_wv);
discard_menu_items ();
unbind_to (specpdl_count, Qnil);
return;
}
fset_menu_bar_vector (f, menu_items);
f->menu_bar_items_used = menu_items_used;
/* This undoes save_menu_items. */
unbind_to (specpdl_count, Qnil);
/* Now GC cannot happen during the lifetime of the widget_value,
so it's safe to store data from a Lisp_String, as long as
local copies are made when the actual menu is created.
Windows takes care of this for normal string items, but
not for owner-drawn items or additional item-info. */
wv = first_wv->contents;
for (i = 0; i < ASIZE (items); i += 4)
{
Lisp_Object string;
string = AREF (items, i + 1);
if (NILP (string))
break;
wv->name = SSDATA (string);
update_submenu_strings (wv->contents);
wv = wv->next;
}
}
else
{
/* Make a widget-value tree containing
just the top level menu bar strings. */
wv = make_widget_value ("menubar", NULL, true, Qnil);
wv->button_type = BUTTON_TYPE_NONE;
first_wv = wv;
items = FRAME_MENU_BAR_ITEMS (f);
for (i = 0; i < ASIZE (items); i += 4)
{
Lisp_Object string;
string = AREF (items, i + 1);
if (NILP (string))
break;
wv = make_widget_value (SSDATA (string), NULL, true, Qnil);
wv->button_type = BUTTON_TYPE_NONE;
/* This prevents lwlib from assuming this
menu item is really supposed to be empty. */
/* The EMACS_INT cast avoids a warning.
This value just has to be different from small integers. */
wv->call_data = (void *) (EMACS_INT) (-1);
if (prev_wv)
prev_wv->next = wv;
else
first_wv->contents = wv;
prev_wv = wv;
}
/* Forget what we thought we knew about what is in the
detailed contents of the menu bar menus.
Changing the top level always destroys the contents. */
f->menu_bar_items_used = 0;
}
/* Create or update the menu bar widget. */
block_input ();
if (menubar_widget)
{
/* Empty current menubar, rather than creating a fresh one. */
while (DeleteMenu (menubar_widget, 0, MF_BYPOSITION))
;
}
else
{
menubar_widget = CreateMenu ();
}
fill_in_menu (menubar_widget, first_wv->contents);
free_menubar_widget_value_tree (first_wv);
{
HMENU old_widget = f->output_data.w32->menubar_widget;
f->output_data.w32->menubar_widget = menubar_widget;
SetMenu (FRAME_W32_WINDOW (f), f->output_data.w32->menubar_widget);
/* Causes flicker when menu bar is updated
DrawMenuBar (FRAME_W32_WINDOW (f)); */
/* Force the window size to be recomputed so that the frame's text
area remains the same, if menubar has just been created. */
if (old_widget == NULL)
{
windows_or_buffers_changed = 23;
adjust_frame_size (f, -1, -1, 2, false, Qmenu_bar_lines);
}
}
unblock_input ();
}
void
find_and_call_menu_selection (FRAME_PTR f, int menu_bar_items_used, Lisp_Object vector, void *client_data)
{
Lisp_Object prefix, entry;
Lisp_Object *subprefix_stack;
int submenu_depth = 0;
int i;
entry = Qnil;
subprefix_stack = (Lisp_Object *) alloca (menu_bar_items_used * sizeof (Lisp_Object));
prefix = Qnil;
i = 0;
while (i < menu_bar_items_used)
{
if (EQ (XVECTOR (vector)->contents[i], Qnil))
{
subprefix_stack[submenu_depth++] = prefix;
prefix = entry;
i++;
}
else if (EQ (XVECTOR (vector)->contents[i], Qlambda))
{
prefix = subprefix_stack[--submenu_depth];
i++;
}
else if (EQ (XVECTOR (vector)->contents[i], Qt))
{
prefix = XVECTOR (vector)->contents[i + MENU_ITEMS_PANE_PREFIX];
i += MENU_ITEMS_PANE_LENGTH;
}
else
{
entry = XVECTOR (vector)->contents[i + MENU_ITEMS_ITEM_VALUE];
/* The EMACS_INT cast avoids a warning. There's no problem
as long as pointers have enough bits to hold small integers. */
if ((int) (EMACS_INT) client_data == i)
{
int j;
struct input_event buf;
Lisp_Object frame;
EVENT_INIT (buf);
XSETFRAME (frame, f);
buf.kind = MENU_BAR_EVENT;
buf.frame_or_window = frame;
buf.arg = frame;
kbd_buffer_store_event (&buf);
for (j = 0; j < submenu_depth; j++)
if (!NILP (subprefix_stack[j]))
{
buf.kind = MENU_BAR_EVENT;
buf.frame_or_window = frame;
buf.arg = subprefix_stack[j];
kbd_buffer_store_event (&buf);
}
if (!NILP (prefix))
{
buf.kind = MENU_BAR_EVENT;
buf.frame_or_window = frame;
buf.arg = prefix;
kbd_buffer_store_event (&buf);
}
buf.kind = MENU_BAR_EVENT;
buf.frame_or_window = frame;
buf.arg = entry;
kbd_buffer_store_event (&buf);
return;
}
i += MENU_ITEMS_ITEM_LENGTH;
}
}
}
widget_value *
digest_single_submenu (int start, int end, int top_level_items)
{
widget_value *wv, *prev_wv, *save_wv, *first_wv;
int i;
int submenu_depth = 0;
widget_value **submenu_stack;
int panes_seen = 0;
submenu_stack
= (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
wv = xmalloc_widget_value ();
wv->name = "menu";
wv->value = 0;
wv->enabled = 1;
wv->button_type = BUTTON_TYPE_NONE;
wv->help = Qnil;
first_wv = wv;
save_wv = 0;
prev_wv = 0;
/* Loop over all panes and items made by the preceding call
to parse_single_submenu and construct a tree of widget_value objects.
Ignore the panes and items used by previous calls to
digest_single_submenu, even though those are also in menu_items. */
i = start;
while (i < end)
{
if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
{
submenu_stack[submenu_depth++] = save_wv;
save_wv = prev_wv;
prev_wv = 0;
i++;
}
else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
{
prev_wv = save_wv;
save_wv = submenu_stack[--submenu_depth];
i++;
}
else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
&& submenu_depth != 0)
i += MENU_ITEMS_PANE_LENGTH;
/* Ignore a nil in the item list.
It's meaningful only for dialog boxes. */
else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
i += 1;
else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
{
/* Create a new pane. */
Lisp_Object pane_name, prefix;
const char *pane_string;
panes_seen++;
pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
#ifdef HAVE_NTGUI
if (STRINGP (pane_name))
{
if (unicode_append_menu)
/* Encode as UTF-8 for now. */
pane_name = ENCODE_UTF_8 (pane_name);
else if (STRING_MULTIBYTE (pane_name))
pane_name = ENCODE_SYSTEM (pane_name);
ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
}
#elif defined (USE_LUCID) && defined (HAVE_XFT)
if (STRINGP (pane_name))
{
pane_name = ENCODE_UTF_8 (pane_name);
ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
}
#elif !defined (HAVE_MULTILINGUAL_MENU)
if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
{
pane_name = ENCODE_MENU_STRING (pane_name);
ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
}
#endif
pane_string = (NILP (pane_name)
? "" : (char *) SDATA (pane_name));
/* If there is just one top-level pane, put all its items directly
under the top-level menu. */
if (menu_items_n_panes == 1)
pane_string = "";
/* If the pane has a meaningful name,
make the pane a top-level menu item
with its items as a submenu beneath it. */
if (strcmp (pane_string, ""))
{
wv = xmalloc_widget_value ();
if (save_wv)
save_wv->next = wv;
else
first_wv->contents = wv;
wv->lname = pane_name;
/* Set value to 1 so update_submenu_strings can handle '@' */
wv->value = (char *)1;
wv->enabled = 1;
wv->button_type = BUTTON_TYPE_NONE;
wv->help = Qnil;
save_wv = wv;
}
else
save_wv = first_wv;
prev_wv = 0;
i += MENU_ITEMS_PANE_LENGTH;
}
else
{
/* Create a new item within current pane. */
Lisp_Object item_name, enable, descrip, def, type, selected;
Lisp_Object help;
/* All items should be contained in panes. */
if (panes_seen == 0)
abort ();
item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
#ifdef HAVE_NTGUI
if (STRINGP (item_name))
{
if (unicode_append_menu)
item_name = ENCODE_UTF_8 (item_name);
else if (STRING_MULTIBYTE (item_name))
item_name = ENCODE_SYSTEM (item_name);
ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
}
if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
{
descrip = ENCODE_SYSTEM (descrip);
ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
}
#elif USE_LUCID
if (STRINGP (item_name))
{
item_name = ENCODE_UTF_8 (item_name);
ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
}
if (STRINGP (descrip))
{
descrip = ENCODE_UTF_8 (descrip);
ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
}
#elif !defined (HAVE_MULTILINGUAL_MENU)
if (STRING_MULTIBYTE (item_name))
{
item_name = ENCODE_MENU_STRING (item_name);
ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
}
if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
{
descrip = ENCODE_MENU_STRING (descrip);
ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
}
#endif
wv = xmalloc_widget_value ();
if (prev_wv)
prev_wv->next = wv;
else
save_wv->contents = wv;
wv->lname = item_name;
if (!NILP (descrip))
wv->lkey = descrip;
wv->value = 0;
/* The EMACS_INT cast avoids a warning. There's no problem
as long as pointers have enough bits to hold small integers. */
wv->call_data = (!NILP (def) ? (void *) (EMACS_INT) i : 0);
wv->enabled = !NILP (enable);
if (NILP (type))
wv->button_type = BUTTON_TYPE_NONE;
else if (EQ (type, QCradio))
wv->button_type = BUTTON_TYPE_RADIO;
else if (EQ (type, QCtoggle))
wv->button_type = BUTTON_TYPE_TOGGLE;
else
abort ();
wv->selected = !NILP (selected);
if (! STRINGP (help))
help = Qnil;
wv->help = help;
prev_wv = wv;
i += MENU_ITEMS_ITEM_LENGTH;
}
}
/* If we have just one "menu item"
that was originally a button, return it by itself. */
if (top_level_items && first_wv->contents && first_wv->contents->next == 0)
{
wv = first_wv->contents;
free_widget_value (first_wv);
return wv;
}
return first_wv;
}
static void
single_menu_item (Lisp_Object key, Lisp_Object item, Lisp_Object dummy, void *skp_v)
{
Lisp_Object map, item_string, enabled;
struct gcpro gcpro1, gcpro2;
int res;
struct skp *skp = skp_v;
/* Parse the menu item and leave the result in item_properties. */
GCPRO2 (key, item);
res = parse_menu_item (item, 0);
UNGCPRO;
if (!res)
return; /* Not a menu item. */
map = XVECTOR (item_properties)->contents[ITEM_PROPERTY_MAP];
enabled = XVECTOR (item_properties)->contents[ITEM_PROPERTY_ENABLE];
item_string = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
if (!NILP (map) && SREF (item_string, 0) == '@')
{
if (!NILP (enabled))
/* An enabled separate pane. Remember this to handle it later. */
skp->pending_maps = Fcons (Fcons (map, Fcons (item_string, key)),
skp->pending_maps);
return;
}
#if defined(HAVE_X_WINDOWS) || defined(MSDOS)
#ifndef HAVE_BOXES
/* Simulate radio buttons and toggle boxes by putting a prefix in
front of them. */
{
Lisp_Object prefix = Qnil;
Lisp_Object type = XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE];
if (!NILP (type))
{
Lisp_Object selected
= XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED];
if (skp->notbuttons)
/* The first button. Line up previous items in this menu. */
{
int index = skp->notbuttons; /* Index for first item this menu. */
int submenu = 0;
Lisp_Object tem;
while (index < menu_items_used)
{
tem
= XVECTOR (menu_items)->contents[index + MENU_ITEMS_ITEM_NAME];
if (NILP (tem))
{
index++;
submenu++; /* Skip sub menu. */
}
else if (EQ (tem, Qlambda))
{
index++;
submenu--; /* End sub menu. */
}
else if (EQ (tem, Qt))
index += 3; /* Skip new pane marker. */
else if (EQ (tem, Qquote))
index++; /* Skip a left, right divider. */
else
{
if (!submenu && SREF (tem, 0) != '\0'
&& SREF (tem, 0) != '-')
XVECTOR (menu_items)->contents[index + MENU_ITEMS_ITEM_NAME]
= concat2 (build_string (" "), tem);
index += MENU_ITEMS_ITEM_LENGTH;
}
}
skp->notbuttons = 0;
}
/* Calculate prefix, if any, for this item. */
if (EQ (type, QCtoggle))
prefix = build_string (NILP (selected) ? "[ ] " : "[X] ");
else if (EQ (type, QCradio))
prefix = build_string (NILP (selected) ? "( ) " : "(*) ");
}
/* Not a button. If we have earlier buttons, then we need a prefix. */
else if (!skp->notbuttons && SREF (item_string, 0) != '\0'
&& SREF (item_string, 0) != '-')
prefix = build_string (" ");
if (!NILP (prefix))
item_string = concat2 (prefix, item_string);
}
#endif /* not HAVE_BOXES */
#if ! defined (USE_X_TOOLKIT) && ! defined (USE_GTK)
if (!NILP (map))
/* Indicate visually that this is a submenu. */
item_string = concat2 (item_string, build_string (" >"));
#endif
#endif /* HAVE_X_WINDOWS || MSDOS */
push_menu_item (item_string, enabled, key,
XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF],
XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ],
XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE],
XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED],
XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP]);
#if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI)
/* Display a submenu using the toolkit. */
if (! (NILP (map) || NILP (enabled)))
{
push_submenu_start ();
single_keymap_panes (map, Qnil, key, skp->maxdepth - 1);
push_submenu_end ();
}
#endif
}
/* pattern is a list of strings:
compiled_code, fastmap, syntax_fastmap, category_fastmap */
void
set_pattern (Lisp_Object pattern, struct re_pattern_buffer *bufp, char *translate)
{
Lisp_Object temp;
if (bufp->allocated != 0) {
/*
Coming here means that this buffer was used to hold
an old-style pattern. Because new-style pattern is not
self-destructive, we only have to set pointer.
Instead, to avoid it being freed later,
bufp->allocated should be set to 0.
*/
free (bufp->buffer);
bufp->allocated = 0;
}
temp = XVECTOR (pattern)->contents[0];
bufp->buffer = (char *)XSTRING (temp)->data;
bufp->used = XSTRING (temp)->size;
bufp->translate = translate;
/* 93.7.13 by K.Handa -- set fastmap */
bufp->mc_flag = !NILP (current_buffer->mc_flag);
{
Lisp_Object fmap, syntax_fmap, category_fmap;
char *fastmap = bufp->fastmap;
int i;
unsigned char ch;
bufp->fastmap_accurate = 1;
fmap = XVECTOR (pattern)->contents[1];
if (NILP (fmap) && NILP (syntax_fmap) && NILP (category_fmap)) {
bufp->can_be_null = 1;
} else {
bufp->can_be_null = 0;
bzero (fastmap, 256);
if (XTYPE (fmap) == Lisp_String) /* 93.7.19 by K.Handa */
bcopy (XSTRING (fmap)->data, fastmap, XSTRING (fmap)->size);
syntax_fmap = XVECTOR (pattern)->contents[2];
if (XTYPE (syntax_fmap) == Lisp_String) {
for (ch = 0; ch < 0x80; ch++)
if (!fastmap[ch]
&& XSTRING (syntax_fmap)->data[syntax_code_spec[(char) SYNTAX (ch)]])
fastmap[ch] = 1;
bufp->syntax_version = syntax_table_version;
} else
bufp->syntax_version = 0;
category_fmap = XVECTOR (pattern)->contents[3];
if (XTYPE (category_fmap) == Lisp_String) {
char str[96], *p;
int not_category_spec = 0;
for (i = 32; i < 128; i++)
if (XSTRING (category_fmap)->data[i] == 2) {
not_category_spec = 1;
break;
}
for (ch = 0; ch < 0x80; ch++) {
if (!fastmap[ch]) {
pack_mnemonic_string
(char_category (ch, current_buffer->category_table), str);
if (not_category_spec) {
for (p = str; *p; p++)
if (XSTRING (category_fmap)->data[*p] != 2) {
fastmap[ch] = 1;
break;
}
} else {
for (p = str; *p; p++)
if (XSTRING (category_fmap)->data[*p] == 1) {
fastmap[ch] = 1;
break;
}
}
}
}
bufp->category_version = category_table_version;
} else
bufp->category_version = 0;
if (bufp->mc_flag
&& (XTYPE (syntax_fmap) == Lisp_String
|| XTYPE (category_fmap) == Lisp_String)) {
for (ch = 0x80; ch < 0xA0; ch++)
fastmap[ch] = 1;
}
}
}
/* 92.7.10 by T.Enami
Force 're-compile-pattern' when compile_pattern is called next time. */
last_regexp = Qnil;
}
double CompareFits(const char * i_lpszFileSource, const ES::Spectrum &i_cTarget, XDATASET & i_cOpacity_Map_A, XDATASET & i_cOpacity_Map_B, unsigned int i_uiIon, const double &i_dMin_WL, const double &i_dMax_WL, bool i_bChi2, double &o_dDay, double & o_dPS_Vel, double &o_dPS_Temp, double & o_dPS_Ion_Temp, double &o_dPS_Log_Tau, double & o_dHVF_Ion_Temp, double &o_dHVF_Log_Tau, ES::Spectrum &o_cOutput)
{
// use the following define to set the numberr of dimensions to test - value should be # dim + 1 (e.g. 3-d = 4 points)
#define NUM_PARAMETERS 7
unsigned int uiParameters = NUM_PARAMETERS;
ES::Spectrum cOutput = ES::Spectrum::create_from_range_and_size( i_cTarget.wl(0), i_cTarget.wl(i_cTarget.size() - 1), i_cTarget.size());
double dFit_Min = DBL_MAX;
double *lpdFit;
// define tetrahedron spanning the search space
XVECTOR *lpcTest_Points;
XVECTOR cBounds[2] = {XVECTOR(NUM_PARAMETERS),XVECTOR(NUM_PARAMETERS)};
XVECTOR cThreshold(NUM_PARAMETERS);
XVECTOR cCentroid(NUM_PARAMETERS);
XVECTOR cTestOuter(NUM_PARAMETERS);
XVECTOR cTestInner(NUM_PARAMETERS);
XVECTOR cTest(NUM_PARAMETERS);
XVECTOR cDelta(NUM_PARAMETERS);
XVECTOR cConvergence_Fault(NUM_PARAMETERS);
double dTest_Fit = 0.0;
unsigned int uiNum_Vertices;
cBounds[0].Set(0,0.0); // time
cBounds[0].Set(1,5.0); // PS velocity (kkm/s)
cBounds[0].Set(2,5.0); // PS temp (kK)
cBounds[0].Set(3,1.0); // PS ion temp (kK)
cBounds[0].Set(4,-10.0); // PS ion log opacity scaling
cBounds[0].Set(5,1.0); // HVF ion temp (kK)
cBounds[0].Set(6,-10.0); // HVF ion log opacity scaling
cBounds[1].Set(0,i_cOpacity_Map_A.GetNumColumns() - 2); // time
cBounds[1].Set(1,40.0); // PS velocity (kkm/s)
cBounds[1].Set(2,30.0); // PS temp (kK)
cBounds[1].Set(3,30.0); // PS ion temp (kK)
cBounds[1].Set(4,10.0); // PS ion log opacity scaling
cBounds[1].Set(5,30.0); // HVF ion temp (kK)
cBounds[1].Set(6,-8.0); // HVF ion log opacity scaling
cThreshold.Set(0,1.0);
cThreshold.Set(1,0.5);
cThreshold.Set(2,0.25);
cThreshold.Set(3,0.5);
cThreshold.Set(4,0.1);
cThreshold.Set(5,0.5);
cThreshold.Set(6,0.1);
cThreshold.Set(7,0.5);
if (i_cOpacity_Map_B.GetNumElements() == 0)
uiParameters = 6; // don't look for HVF component separately
uiNum_Vertices = 1 << uiParameters;
lpcTest_Points = new XVECTOR[uiNum_Vertices];
lpdFit = new double[uiNum_Vertices];
for (unsigned int uiI = 0; uiI < uiNum_Vertices; uiI++)
lpcTest_Points[uiI].Set_Size(NUM_PARAMETERS);
double dFit_Sum = 0.0;
if (!ReadPointsCache(i_lpszFileSource,lpcTest_Points,uiNum_Vertices,uiParameters,lpdFit))
{
// create a cuboid that spans the search space
for (unsigned int uiI = 0; uiI < uiNum_Vertices; uiI++)
{
lpcTest_Points[uiI] = cBounds[0];
for (unsigned int uiJ = 0; uiJ < uiParameters; uiJ++)
{
if (uiI & (1 << uiJ))
lpcTest_Points[uiI].Set(uiJ,cBounds[1].Get(uiJ));
}
}
for (unsigned int uiI = 0; uiI < uiNum_Vertices; uiI++)
{
cCentroid += lpcTest_Points[uiI];
dFit_Sum ++;
}
cCentroid /= dFit_Sum;
// printf("Centroid\n");
// cCentroid.Print();
// Make sure the centroid produces a valid spectrum - if not, randomly generate a point within the search space to act as the centroid for the time being...
// This centroid is going to be used to adjust edges of the cuboid to have a valid fit
double dCentroid_Fit = 0.0;
do
{
fprintf(stdout,".");
fflush(stdout);
if (isnan(dCentroid_Fit) || isinf(dCentroid_Fit)) // need a different point - try random point within the grid
{
cDelta = cBounds[1] - cBounds[0];
for (unsigned int uiI = 0; uiI < NUM_PARAMETERS; uiI++)
{
cCentroid.Set(uiI,cBounds[0].Get(uiI) + xrand_d() * cDelta.Get(uiI));
}
}
Generate_Synow_Spectra(i_cTarget,i_cOpacity_Map_A,i_cOpacity_Map_B,i_uiIon,cCentroid,cOutput);
dCentroid_Fit = Fit(i_cTarget, cOutput, i_dMin_WL, i_dMax_WL, i_bChi2);
}
while (isnan(dCentroid_Fit) || isinf(dCentroid_Fit));
for (unsigned int uiI = 0; uiI < uiNum_Vertices; uiI++)
{
fprintf(stdout,"-");
fflush(stdout);
Generate_Synow_Spectra(i_cTarget,i_cOpacity_Map_A,i_cOpacity_Map_B,i_uiIon,lpcTest_Points[uiI],cOutput);
lpdFit[uiI] = Fit(i_cTarget, cOutput, i_dMin_WL, i_dMax_WL, i_bChi2);
cTestOuter = lpcTest_Points[uiI];
cTest = lpcTest_Points[uiI];
while(isnan(lpdFit[uiI]) || isinf(lpdFit[uiI]))
{
fprintf(stdout,"_");
fflush(stdout);
XVECTOR cDelta = cTestOuter - cCentroid;
cDelta *= 0.5;
cTest = cCentroid + cDelta;
// cTest.Print();
Generate_Synow_Spectra(i_cTarget,i_cOpacity_Map_A,i_cOpacity_Map_B,i_uiIon,cTest,cOutput);
lpdFit[uiI] = Fit(i_cTarget, cOutput, i_dMin_WL, i_dMax_WL, i_bChi2);
cTestOuter = cTest;
}
lpcTest_Points[uiI] = cTest;
}
SavePointsCache(i_lpszFileSource,lpcTest_Points,uiNum_Vertices,uiParameters,lpdFit);
}
unsigned int uiFit_Max_Point = uiNum_Vertices;
unsigned int uiFit_Min_Point = uiNum_Vertices;
while (!Convergence(lpcTest_Points, uiNum_Vertices , cThreshold, &cConvergence_Fault))
{
fprintf(stdout,"+");
fflush(stdout);
// fprintf(stdout,"F: %.1f %.1f %.1f %.1f %.1f %.1f %.1f\n",cConvergence_Fault.Get(0),cConvergence_Fault.Get(1),cConvergence_Fault.Get(2),cConvergence_Fault.Get(3),cConvergence_Fault.Get(4),cConvergence_Fault.Get(5),cConvergence_Fault.Get(6));
// Find point with worst fit
double dFit_Max = 0.0;
double dFit_Near_Max = 0.0;
double dFit_Min = DBL_MAX;
double dFit_Variance = 0.0;
double dFit_Mean = 0.0;
bool bClose_Fit = true;
uiFit_Max_Point = uiNum_Vertices;
uiFit_Min_Point = uiNum_Vertices;
for (unsigned int uiI = 0; uiI < uiNum_Vertices; uiI++)
{
// printf("%i : %.2e\n",uiI,lpdFit[uiI]);
dFit_Variance += lpdFit[uiI] * lpdFit[uiI];
dFit_Mean += lpdFit[uiI];
if (lpdFit[uiI] > dFit_Max)
{
dFit_Max = lpdFit[uiI];
uiFit_Max_Point = uiI;
}
if (lpdFit[uiI] < dFit_Min)
{
dFit_Min = lpdFit[uiI];
uiFit_Min_Point = uiI;
}
}
if (dFit_Min <= 0.5)
{
for (unsigned int uiI = 0; uiI < uiNum_Vertices; uiI++)
{
lpdFit[uiI] = lpdFit[uiFit_Min_Point];
lpcTest_Points[uiI] = lpcTest_Points[uiFit_Min_Point];
}
}
else
{
dFit_Variance /= uiNum_Vertices;
dFit_Mean /= uiNum_Vertices;
double dFit_Std_Dev = dFit_Variance - dFit_Mean * dFit_Mean;
// for (unsigned int uiI = 0; uiI < uiNum_Vertices && bClose_Fit; uiI++)
// {
// bClose_Fit = (fabs(lpdFit[uiI] - dFit_Mean) < (2.0 * dFit_Std_Dev));
// }
// bClose_Fit |= (dFit_Std_Dev < 10.0);
bClose_Fit &= (dFit_Std_Dev < 10.0);
if (dFit_Near_Max == 0.0)
{
for (unsigned int uiI = 0; uiI < uiNum_Vertices; uiI++)
{
if (lpdFit[uiI] > dFit_Near_Max && uiI != uiFit_Max_Point)
dFit_Near_Max = lpdFit[uiI];
}
}
// fprintf(stdout,"%i",uiFit_Max_Point);
// fprintf(stdout,"F: %.8e %.8e %.8e %.8e %.8e %.8e %.8e\n",dFit[0],dFit[1],dFit[2],dFit[3],dFit[4],dFit[5],dFit[6],dFit[7]);
// if (uiFit_Max_Point < uiNum_Vertices)
{
// Compute weighted centroid of remaining parameters
for (unsigned int uiI = 0; uiI < cCentroid.Get_Size(); uiI++)
cCentroid.Set(uiI,0.0);
dFit_Sum = 0.0;
for (unsigned int uiI = 0; uiI < uiNum_Vertices; uiI++)
{
if (uiI != uiFit_Max_Point)
{
XVECTOR cTemp = lpcTest_Points[uiI];
// lpcTest_Points[uiI].Print(NULL);
// cTemp.Print(NULL);
if (lpdFit[uiI] > 1.0)
cTemp *= lpdFit[uiI];
cCentroid += cTemp;
// cCentroid.Print(NULL);
if (lpdFit[uiI] > 1.0)
dFit_Sum += lpdFit[uiI];
else
dFit_Sum += 1.0;
}
}
cCentroid /= dFit_Sum;
// printf("Centroid\n");
// for (unsigned int uiI = 0; uiI < uiParameters; uiI++)
// {
// printf("%.1f\n",cCentroid.Get(uiI));
// }
cTestOuter = lpcTest_Points[uiFit_Max_Point];
cTestInner = cCentroid;
// printf("\n");
// cCentroid.Print();
Generate_Synow_Spectra(i_cTarget,i_cOpacity_Map_A,i_cOpacity_Map_B,i_uiIon,cCentroid,cOutput);
dTest_Fit = Fit(i_cTarget, cOutput, i_dMin_WL, i_dMax_WL, i_bChi2);
if (bClose_Fit && !isnan(dTest_Fit) && !isinf(dTest_Fit))
{
for (unsigned int uiI = 0; uiI < uiNum_Vertices; uiI++)
{
// fprintf(stdout,"-%.0f\t%.2e\t%.0f\t%.0f\t%c\t%.1f\n",dTest_Fit,dFit_Min,dFit_Max,dFit_Near_Max,bClose_Fit ? 't' : 'f',dFit_Std_Dev);
fprintf(stdout,"-");
fflush(stdout);
cDelta = cCentroid - lpcTest_Points[uiI];
cDelta *= 0.5;
lpcTest_Points[uiI] += cDelta;
Generate_Synow_Spectra(i_cTarget,i_cOpacity_Map_A,i_cOpacity_Map_B,i_uiIon,lpcTest_Points[uiI],cOutput);
lpdFit[uiI] = Fit(i_cTarget, cOutput, i_dMin_WL, i_dMax_WL, i_bChi2);
}
}
else if (dTest_Fit > dFit_Near_Max)
{
cTestOuter = cCentroid;
cTestInner = lpcTest_Points[uiFit_Min_Point];
cTest = cTestInner;
while (isnan(dTest_Fit) || isinf(dTest_Fit) || dTest_Fit > dFit_Near_Max)
{
//cCentroid.Print();
// fprintf(stdout,"@%.0f\t%.2e\t%.0f\t%.0f\t%c\t%.1f\n",dTest_Fit,dFit_Min,dFit_Max,dFit_Near_Max,bClose_Fit ? 't' : 'f',dFit_Std_Dev);
fprintf(stdout,"@");
fflush(stdout);
cDelta = cTestOuter - cTestInner;
cDelta *= 0.5;
cTest = cTestInner + cDelta;
// cTest.Print();
Generate_Synow_Spectra(i_cTarget,i_cOpacity_Map_A,i_cOpacity_Map_B,i_uiIon,cTest,cOutput);
dTest_Fit = Fit(i_cTarget, cOutput, i_dMin_WL, i_dMax_WL, i_bChi2);
cTestOuter = cTest;
/* lpcTest_Points[uiFit_Max_Point] = cCentroid;
lpdFit[uiFit_Max_Point] = dTest_Fit;
for (unsigned int uiI = 0; uiI < cCentroid.Get_Size(); uiI++)
cCentroid.Set(uiI,0.0);
dFit_Sum = 0.0;
for (unsigned int uiI = 0; uiI < uiNum_Vertices; uiI++)
{
XVECTOR cTemp = lpcTest_Points[uiI];
if (lpdFit[uiI] > 1.0)
cTemp *= lpdFit[uiI];
cCentroid += cTemp;
if (lpdFit[uiI] > 1.0)
dFit_Sum += lpdFit[uiI];
else
dFit_Sum == 1.0;
}
cCentroid /= dFit_Sum;
Generate_Synow_Spectra(i_cTarget,i_cOpacity_Map_A,i_cOpacity_Map_B,i_uiIon,cCentroid,cOutput);
dTest_Fit = Fit(i_cTarget, cOutput, i_dMin_WL, i_dMax_WL, i_bChi2);
*/
}
lpcTest_Points[uiFit_Max_Point] = cTest;
lpdFit[uiFit_Max_Point] = dTest_Fit;
}
else
{
cTest = lpcTest_Points[uiFit_Max_Point];
double dTest_Fit = 0.0;
while(isnan(dTest_Fit) || isinf(dTest_Fit) || (!bClose_Fit && dTest_Fit < dFit_Min))
{
// fprintf(stdout,"*%.0f\t%.2e\t%.0f\t%.0f\t%c\t%.1f\n",dTest_Fit,dFit_Min,dFit_Max,dFit_Near_Max,bClose_Fit ? 't' : 'f',dFit_Std_Dev);
fprintf(stdout,"*");
fflush(stdout);
cDelta = cTestOuter - cTestInner;
cDelta *= 0.5;
cTest = cTestInner + cDelta;
// cTest.Print();
Generate_Synow_Spectra(i_cTarget,i_cOpacity_Map_A,i_cOpacity_Map_B,i_uiIon,cTest,cOutput);
dTest_Fit = Fit(i_cTarget, cOutput, i_dMin_WL, i_dMax_WL, i_bChi2);
cTestInner = cTest;
}
cTestOuter = cTest;
cTestInner = cCentroid;
while(isnan(dTest_Fit) || isinf(dTest_Fit) || dTest_Fit == 0.0 || dTest_Fit > dFit_Near_Max)
{
// fprintf(stdout,"%%%.0f\t%.2e\t%.0f\t%.0f\t%c\t%.1f\n",dTest_Fit,dFit_Min,dFit_Max,dFit_Near_Max,bClose_Fit ? 't' : 'f',dFit_Std_Dev);
fprintf(stdout,"%%");
fflush(stdout);
cDelta = cTestOuter - cTestInner;
cDelta *= 0.5;
cTest = cTestInner + cDelta;
// cTest.Print();
Generate_Synow_Spectra(i_cTarget,i_cOpacity_Map_A,i_cOpacity_Map_B,i_uiIon,cTest,cOutput);
dTest_Fit = Fit(i_cTarget, cOutput, i_dMin_WL, i_dMax_WL, i_bChi2);
cTestOuter = cTest;
}
lpcTest_Points[uiFit_Max_Point] = cTest;
lpdFit[uiFit_Max_Point] = dTest_Fit;
}
}
}
SavePointsCache(i_lpszFileSource,lpcTest_Points,uiNum_Vertices,uiParameters,lpdFit);
}
// printf("Convergence\n");
// for (unsigned int uiI = 0; uiI < uiParameters; uiI++)
// {
// printf("%.1f\n",cConvergence_Fault.Get(uiI));
// }
for (unsigned int uiI = 0; uiI < cCentroid.Get_Size(); uiI++)
cCentroid.Set(uiI,0.0);
for (unsigned int uiI = 0; uiI < uiNum_Vertices; uiI++)
{
cCentroid += lpcTest_Points[uiI];
}
cCentroid /= (double)(uiNum_Vertices);
int iT_ref = (int )(cCentroid.Get(0) + 0.5);
if (iT_ref < 0)
iT_ref = 0;
if (iT_ref > (i_cOpacity_Map_A.GetNumColumns() - 2))
iT_ref = i_cOpacity_Map_A.GetNumColumns() - 2;
iT_ref++;
o_dDay = i_cOpacity_Map_A.GetElement(iT_ref,0);
// printf("%i %.2f\n",iT_ref,o_dDay);
o_dPS_Vel = cCentroid.Get(1);
o_dPS_Temp = cCentroid.Get(2);
o_dPS_Ion_Temp = cCentroid.Get(3);
o_dPS_Log_Tau = cCentroid.Get(4);
o_dHVF_Ion_Temp = cCentroid.Get(5);
o_dHVF_Log_Tau = cCentroid.Get(6);
fprintf(stdout,"X");
fflush(stdout);
Generate_Synow_Spectra(i_cTarget,i_cOpacity_Map_A,i_cOpacity_Map_B,i_uiIon,cCentroid,cOutput);
o_cOutput = cOutput; // not completely sure why this has to be done instead of passing o_cOutput as a parameter to Generate_Synow_Spectra, but if I do the latter it returns with flux set to zero...
// system("rm spectrafit.cache");
return Fit(i_cTarget, o_cOutput, i_dMin_WL, i_dMax_WL, i_bChi2);
}