static void debug_print_string(lref_t obj, lref_t port, bool machine_readable)
{
assert(STRINGP(obj));
if (!machine_readable)
{
write_text(port, obj->as.string.data, obj->as.string.dim);
return;
}
WRITE_TEXT_CONSTANT(port, _T("\""));
size_t next_char_to_write = 0;
_TCHAR cbuff[2];
/* To write strings more efficiently, this code scans for the longest
* block of characters that doesn't need special encoding, and then
* passes those blocks on to write_bytes. */
while (next_char_to_write < obj->as.string.dim)
{
unsigned int c;
size_t next_special_char;
/* Scan for the next special character, it ends the block... */
for (next_special_char = next_char_to_write;
next_special_char < obj->as.string.dim;
next_special_char++)
{
c = obj->as.string.data[next_special_char];
if ((c == '\\') || (c == '"') || (c == '\n') || (c == '\r')
|| (c == '\t') || (c == '\0') || (c < 32) || (c >= 127))
break;
}
/* ...which then gets written out. */
if (next_special_char - next_char_to_write > 0)
write_text(port,
&(obj->as.string.data[next_char_to_write]),
next_special_char - next_char_to_write);
if (next_special_char >= obj->as.string.dim)
break;
c = obj->as.string.data[next_special_char];
/* Write the next special character. */
switch (c)
{
case '\\':
case '"':
cbuff[0] = _T('\\');
cbuff[1] = (_TCHAR) c;
write_text(port, cbuff, 2);
break;
case '\n':
WRITE_TEXT_CONSTANT(port, _T("\\n"));
break;
case '\r':
WRITE_TEXT_CONSTANT(port, _T("\\r"));
break;
case '\t':
WRITE_TEXT_CONSTANT(port, _T("\\t"));
break;
case '\0':
WRITE_TEXT_CONSTANT(port, _T("\\000"));
break;
default:
/* This assert will only fail when the special character scanner
* breaks on a character that the special character writer
* does not know how to handle. */
assert((c < 32) || (c >= 127));
scwritef(_T("\\~cC"), port, (unsigned long) c);
}
next_char_to_write = next_special_char + 1;
}
WRITE_TEXT_CONSTANT(port, _T("\""));
}
void
x_session_initialize (struct x_display_info *dpyinfo)
{
#define SM_ERRORSTRING_LEN 512
char errorstring[SM_ERRORSTRING_LEN];
char* previous_id = NULL;
SmcCallbacks callbacks;
int name_len = 0;
ice_fd = -1;
doing_interact = False;
/* Check if we where started by the session manager. If so, we will
have a previous id. */
if (! EQ (Vx_session_previous_id, Qnil) && STRINGP (Vx_session_previous_id))
previous_id = SSDATA (Vx_session_previous_id);
/* Construct the path to the Emacs program. */
if (! EQ (Vinvocation_directory, Qnil))
name_len += strlen (SSDATA (Vinvocation_directory));
name_len += strlen (SSDATA (Vinvocation_name));
/* This malloc will not be freed, but it is only done once, and hopefully
not very large */
emacs_program = xmalloc (name_len + 1);
emacs_program[0] = '\0';
if (! EQ (Vinvocation_directory, Qnil))
strcpy (emacs_program, SSDATA (Vinvocation_directory));
strcat (emacs_program, SSDATA (Vinvocation_name));
/* The SM protocol says all callbacks are mandatory, so set up all
here and in the mask passed to SmcOpenConnection. */
callbacks.save_yourself.callback = smc_save_yourself_CB;
callbacks.save_yourself.client_data = 0;
callbacks.die.callback = smc_die_CB;
callbacks.die.client_data = 0;
callbacks.save_complete.callback = smc_save_complete_CB;
callbacks.save_complete.client_data = 0;
callbacks.shutdown_cancelled.callback = smc_shutdown_cancelled_CB;
callbacks.shutdown_cancelled.client_data = 0;
/* Set error handlers. */
SmcSetErrorHandler (smc_error_handler);
IceSetErrorHandler (ice_error_handler);
IceSetIOErrorHandler (ice_io_error_handler);
/* Install callback for when connection status changes. */
IceAddConnectionWatch (ice_conn_watch_CB, 0);
/* Open the connection to the session manager. A failure is not
critical, it usually means that no session manager is running.
The errorstring is here for debugging. */
smc_conn = SmcOpenConnection (NULL, NULL, 1, 0,
(SmcSaveYourselfProcMask|
SmcDieProcMask|
SmcSaveCompleteProcMask|
SmcShutdownCancelledProcMask),
&callbacks,
previous_id,
&client_id,
SM_ERRORSTRING_LEN,
errorstring);
if (smc_conn != 0)
{
Vx_session_id = make_string (client_id, strlen (client_id));
#ifdef USE_GTK
/* GTK creats a leader window by itself, but we need to tell
it about our client_id. */
gdk_set_sm_client_id (client_id);
#else
create_client_leader_window (dpyinfo, client_id);
#endif
}
}
void
x_session_initialize (struct x_display_info *dpyinfo)
{
#define SM_ERRORSTRING_LEN 512
char errorstring[SM_ERRORSTRING_LEN];
char *previous_id = NULL;
SmcCallbacks callbacks;
ptrdiff_t name_len = 0;
/* libSM seems to crash if pwd is missing - see bug#18851. */
if (! get_current_dir_name ())
{
fprintf (stderr, "Disabling session management due to pwd error: %s\n",
emacs_strerror (errno));
return;
}
ice_fd = -1;
doing_interact = false;
/* Check if we where started by the session manager. If so, we will
have a previous id. */
if (STRINGP (Vx_session_previous_id))
previous_id = SSDATA (Vx_session_previous_id);
/* Construct the path to the Emacs program. */
if (STRINGP (Vinvocation_directory))
name_len += SBYTES (Vinvocation_directory);
if (STRINGP (Vinvocation_name))
name_len += SBYTES (Vinvocation_name);
/* This malloc will not be freed, but it is only done once, and hopefully
not very large */
emacs_program = xmalloc (name_len + 1);
char *z = emacs_program;
if (STRINGP (Vinvocation_directory))
z = lispstpcpy (z, Vinvocation_directory);
if (STRINGP (Vinvocation_name))
lispstpcpy (z, Vinvocation_name);
/* The SM protocol says all callbacks are mandatory, so set up all
here and in the mask passed to SmcOpenConnection. */
callbacks.save_yourself.callback = smc_save_yourself_CB;
callbacks.save_yourself.client_data = 0;
callbacks.die.callback = smc_die_CB;
callbacks.die.client_data = 0;
callbacks.save_complete.callback = smc_save_complete_CB;
callbacks.save_complete.client_data = 0;
callbacks.shutdown_cancelled.callback = smc_shutdown_cancelled_CB;
callbacks.shutdown_cancelled.client_data = 0;
/* Set error handlers. */
SmcSetErrorHandler (smc_error_handler);
IceSetErrorHandler (ice_error_handler);
IceSetIOErrorHandler (ice_io_error_handler);
/* Install callback for when connection status changes. */
IceAddConnectionWatch (ice_conn_watch_CB, 0);
/* Open the connection to the session manager. A failure is not
critical, it usually means that no session manager is running.
The errorstring is here for debugging. */
smc_conn = SmcOpenConnection (NULL, NULL, 1, 0,
(SmcSaveYourselfProcMask|
SmcDieProcMask|
SmcSaveCompleteProcMask|
SmcShutdownCancelledProcMask),
&callbacks,
previous_id,
&client_id,
SM_ERRORSTRING_LEN,
errorstring);
if (smc_conn != 0)
{
Vx_session_id = build_string (client_id);
#ifdef USE_GTK
/* GTK creates a leader window by itself, but we need to tell
it about our client_id. */
gdk_x11_set_sm_client_id (client_id);
#else
create_client_leader_window (dpyinfo, client_id);
#endif
}
}
static int
add_menu_item (HMENU menu, widget_value *wv, HMENU item)
{
UINT fuFlags;
char *out_string, *p, *q;
int return_value;
size_t nlen, orig_len;
USE_SAFE_ALLOCA;
if (menu_separator_name_p (wv->name))
{
fuFlags = MF_SEPARATOR;
out_string = NULL;
}
else
{
if (wv->enabled)
fuFlags = MF_STRING;
else
fuFlags = MF_STRING | MF_GRAYED;
if (wv->key != NULL)
{
out_string = SAFE_ALLOCA (strlen (wv->name) + strlen (wv->key) + 2);
p = stpcpy (out_string, wv->name);
p = stpcpy (p, "\t");
strcpy (p, wv->key);
}
else
out_string = (char *)wv->name;
/* Quote any special characters within the menu item's text and
key binding. */
nlen = orig_len = strlen (out_string);
if (unicode_append_menu)
{
/* With UTF-8, & cannot be part of a multibyte character. */
for (p = out_string; *p; p++)
{
if (*p == '&')
nlen++;
}
}
#ifndef NTGUI_UNICODE
else
{
/* If encoded with the system codepage, use multibyte string
functions in case of multibyte characters that contain '&'. */
for (p = out_string; *p; p = _mbsinc (p))
{
if (_mbsnextc (p) == '&')
nlen++;
}
}
#endif /* !NTGUI_UNICODE */
if (nlen > orig_len)
{
p = out_string;
out_string = SAFE_ALLOCA (nlen + 1);
q = out_string;
while (*p)
{
if (unicode_append_menu)
{
if (*p == '&')
*q++ = *p;
*q++ = *p++;
}
#ifndef NTGUI_UNICODE
else
{
if (_mbsnextc (p) == '&')
{
_mbsncpy (q, p, 1);
q = _mbsinc (q);
}
_mbsncpy (q, p, 1);
p = _mbsinc (p);
q = _mbsinc (q);
}
#endif /* !NTGUI_UNICODE */
}
*q = '\0';
}
if (item != NULL)
fuFlags = MF_POPUP;
else if (wv->title || wv->call_data == 0)
{
/* Only use MF_OWNERDRAW if GetMenuItemInfo is usable, since
we can't deallocate the memory otherwise. */
if (get_menu_item_info)
{
out_string = (char *) local_alloc (strlen (wv->name) + 1);
strcpy (out_string, wv->name);
#ifdef MENU_DEBUG
DebPrint ("Menu: allocating %ld for owner-draw", out_string);
#endif
fuFlags = MF_OWNERDRAW | MF_DISABLED;
}
else
fuFlags = MF_DISABLED;
}
/* Draw radio buttons and tickboxes. */
else if (wv->selected && (wv->button_type == BUTTON_TYPE_TOGGLE ||
wv->button_type == BUTTON_TYPE_RADIO))
fuFlags |= MF_CHECKED;
else
fuFlags |= MF_UNCHECKED;
}
if (unicode_append_menu && out_string)
{
/* Convert out_string from UTF-8 to UTF-16-LE. */
int utf8_len = strlen (out_string);
WCHAR * utf16_string;
if (fuFlags & MF_OWNERDRAW)
utf16_string = local_alloc ((utf8_len + 1) * sizeof (WCHAR));
else
utf16_string = SAFE_ALLOCA ((utf8_len + 1) * sizeof (WCHAR));
utf8to16 ((unsigned char *)out_string, utf8_len, utf16_string);
return_value = unicode_append_menu (menu, fuFlags,
item != NULL ? (UINT_PTR) item
: (UINT_PTR) wv->call_data,
utf16_string);
#ifndef NTGUI_UNICODE /* Fallback does not apply when always UNICODE */
if (!return_value)
{
/* On W9x/ME, Unicode menus are not supported, though AppendMenuW
apparently does exist at least in some cases and appears to be
stubbed out to do nothing. out_string is UTF-8, but since
our standard menus are in English and this is only going to
happen the first time a menu is used, the encoding is
of minor importance compared with menus not working at all. */
return_value =
AppendMenu (menu, fuFlags,
item != NULL ? (UINT_PTR) item: (UINT_PTR) wv->call_data,
out_string);
/* Don't use Unicode menus in future, unless this is Windows
NT or later, where a failure of AppendMenuW does NOT mean
Unicode menus are unsupported. */
if (osinfo_cache.dwPlatformId != VER_PLATFORM_WIN32_NT)
unicode_append_menu = NULL;
}
#endif /* NTGUI_UNICODE */
if (unicode_append_menu && (fuFlags & MF_OWNERDRAW))
local_free (out_string);
}
else
{
return_value =
AppendMenu (menu,
fuFlags,
item != NULL ? (UINT_PTR) item : (UINT_PTR) wv->call_data,
out_string );
}
/* This must be done after the menu item is created. */
if (!wv->title && wv->call_data != 0)
{
if (set_menu_item_info)
{
MENUITEMINFO info;
memset (&info, 0, sizeof (info));
info.cbSize = sizeof (info);
info.fMask = MIIM_DATA;
/* Set help string for menu item. Leave it as a pointer to
a Lisp_String until it is ready to be displayed, since GC
can happen while menus are active. */
if (!NILP (wv->help))
{
/* We use XUNTAG below because in a 32-bit build
--with-wide-int we cannot pass a Lisp_Object
via a DWORD member of MENUITEMINFO. */
/* As of Jul-2012, w32api headers say that dwItemData
has DWORD type, but that's a bug: it should actually
be ULONG_PTR, which is correct for 32-bit and 64-bit
Windows alike. MSVC headers get it right; hopefully,
MinGW headers will, too. */
eassert (STRINGP (wv->help));
info.dwItemData = (ULONG_PTR) XUNTAG (wv->help, Lisp_String);
}
if (wv->button_type == BUTTON_TYPE_RADIO)
{
/* CheckMenuRadioItem allows us to differentiate TOGGLE and
RADIO items, but is not available on NT 3.51 and earlier. */
info.fMask |= MIIM_TYPE | MIIM_STATE;
info.fType = MFT_RADIOCHECK | MFT_STRING;
info.dwTypeData = out_string;
info.fState = wv->selected ? MFS_CHECKED : MFS_UNCHECKED;
}
set_menu_item_info (menu,
item != NULL ? (UINT_PTR) item : (UINT_PTR) wv->call_data,
FALSE, &info);
}
}
SAFE_FREE ();
return return_value;
}
Lisp_Object
get_doc_string (Lisp_Object filepos, bool unibyte, bool definition)
{
char *from, *to, *name, *p, *p1;
int fd;
int offset;
EMACS_INT position;
Lisp_Object file, tem, pos;
ptrdiff_t count;
USE_SAFE_ALLOCA;
if (INTEGERP (filepos))
{
file = Vdoc_file_name;
pos = filepos;
}
else if (CONSP (filepos))
{
file = XCAR (filepos);
pos = XCDR (filepos);
}
else
return Qnil;
position = eabs (XINT (pos));
if (!STRINGP (Vdoc_directory))
return Qnil;
if (!STRINGP (file))
return Qnil;
/* Put the file name in NAME as a C string.
If it is relative, combine it with Vdoc_directory. */
tem = Ffile_name_absolute_p (file);
file = ENCODE_FILE (file);
Lisp_Object docdir
= NILP (tem) ? ENCODE_FILE (Vdoc_directory) : empty_unibyte_string;
ptrdiff_t docdir_sizemax = SBYTES (docdir) + 1;
#ifndef CANNOT_DUMP
docdir_sizemax = max (docdir_sizemax, sizeof sibling_etc);
#endif
name = SAFE_ALLOCA (docdir_sizemax + SBYTES (file));
lispstpcpy (lispstpcpy (name, docdir), file);
fd = emacs_open (name, O_RDONLY, 0);
if (fd < 0)
{
#ifndef CANNOT_DUMP
if (!NILP (Vpurify_flag))
{
/* Preparing to dump; DOC file is probably not installed.
So check in ../etc. */
lispstpcpy (stpcpy (name, sibling_etc), file);
fd = emacs_open (name, O_RDONLY, 0);
}
#endif
if (fd < 0)
{
if (errno == EMFILE || errno == ENFILE)
report_file_error ("Read error on documentation file", file);
SAFE_FREE ();
AUTO_STRING (cannot_open, "Cannot open doc string file \"");
AUTO_STRING (quote_nl, "\"\n");
return concat3 (cannot_open, file, quote_nl);
}
}
count = SPECPDL_INDEX ();
record_unwind_protect_int (close_file_unwind, fd);
/* Seek only to beginning of disk block. */
/* Make sure we read at least 1024 bytes before `position'
so we can check the leading text for consistency. */
offset = min (position, max (1024, position % (8 * 1024)));
if (TYPE_MAXIMUM (off_t) < position
|| lseek (fd, position - offset, 0) < 0)
error ("Position %"pI"d out of range in doc string file \"%s\"",
position, name);
/* Read the doc string into get_doc_string_buffer.
P points beyond the data just read. */
p = get_doc_string_buffer;
while (1)
{
ptrdiff_t space_left = (get_doc_string_buffer_size - 1
- (p - get_doc_string_buffer));
int nread;
/* Allocate or grow the buffer if we need to. */
if (space_left <= 0)
{
ptrdiff_t in_buffer = p - get_doc_string_buffer;
get_doc_string_buffer
= xpalloc (get_doc_string_buffer, &get_doc_string_buffer_size,
16 * 1024, -1, 1);
p = get_doc_string_buffer + in_buffer;
space_left = (get_doc_string_buffer_size - 1
- (p - get_doc_string_buffer));
}
/* Read a disk block at a time.
If we read the same block last time, maybe skip this? */
if (space_left > 1024 * 8)
space_left = 1024 * 8;
nread = emacs_read (fd, p, space_left);
if (nread < 0)
report_file_error ("Read error on documentation file", file);
p[nread] = 0;
if (!nread)
break;
if (p == get_doc_string_buffer)
p1 = strchr (p + offset, '\037');
else
p1 = strchr (p, '\037');
if (p1)
{
*p1 = 0;
p = p1;
break;
}
p += nread;
}
unbind_to (count, Qnil);
SAFE_FREE ();
/* Sanity checking. */
if (CONSP (filepos))
{
int test = 1;
/* A dynamic docstring should be either at the very beginning of a "#@
comment" or right after a dynamic docstring delimiter (in case we
pack several such docstrings within the same comment). */
if (get_doc_string_buffer[offset - test] != '\037')
{
if (get_doc_string_buffer[offset - test++] != ' ')
return Qnil;
while (get_doc_string_buffer[offset - test] >= '0'
&& get_doc_string_buffer[offset - test] <= '9')
test++;
if (get_doc_string_buffer[offset - test++] != '@'
|| get_doc_string_buffer[offset - test] != '#')
return Qnil;
}
}
else
{
int test = 1;
if (get_doc_string_buffer[offset - test++] != '\n')
return Qnil;
while (get_doc_string_buffer[offset - test] > ' ')
test++;
if (get_doc_string_buffer[offset - test] != '\037')
return Qnil;
}
/* Scan the text and perform quoting with ^A (char code 1).
^A^A becomes ^A, ^A0 becomes a null char, and ^A_ becomes a ^_. */
from = get_doc_string_buffer + offset;
to = get_doc_string_buffer + offset;
while (from != p)
{
if (*from == 1)
{
int c;
from++;
c = *from++;
if (c == 1)
*to++ = c;
else if (c == '0')
*to++ = 0;
else if (c == '_')
*to++ = 037;
else
{
unsigned char uc = c;
error ("\
Invalid data in documentation file -- %c followed by code %03o",
1, uc);
}
}
else
*to++ = *from++;
}
/* If DEFINITION, read from this buffer
the same way we would read bytes from a file. */
if (definition)
{
read_bytecode_pointer = (unsigned char *) get_doc_string_buffer + offset;
return Fread (Qlambda);
}
if (unibyte)
return make_unibyte_string (get_doc_string_buffer + offset,
to - (get_doc_string_buffer + offset));
else
{
/* The data determines whether the string is multibyte. */
ptrdiff_t nchars
= multibyte_chars_in_text (((unsigned char *) get_doc_string_buffer
+ offset),
to - (get_doc_string_buffer + offset));
return make_string_from_bytes (get_doc_string_buffer + offset,
nchars,
to - (get_doc_string_buffer + offset));
}
}
static Lisp_Object
casify_object (enum case_action flag, Lisp_Object string_or_char,
Lisp_Object buffer)
{
struct buffer *buf = decode_buffer (buffer, 0);
retry:
if (CHAR_OR_CHAR_INTP (string_or_char))
{
Ichar c;
CHECK_CHAR_COERCE_INT (string_or_char);
c = XCHAR (string_or_char);
if (flag == CASE_DOWN)
{
c = DOWNCASE (buf, c);
}
else if (flag == CASE_UP)
{
c = UPCASE (buf, c);
}
else
{
c = CANONCASE (buf, c);
}
return make_char (c);
}
if (STRINGP (string_or_char))
{
Lisp_Object syntax_table = buf->mirror_syntax_table;
Ibyte *storage =
alloca_ibytes (XSTRING_LENGTH (string_or_char) * MAX_ICHAR_LEN);
Ibyte *newp = storage;
Ibyte *oldp = XSTRING_DATA (string_or_char);
Ibyte *endp = oldp + XSTRING_LENGTH (string_or_char);
int wordp = 0, wordp_prev;
while (oldp < endp)
{
Ichar c = itext_ichar (oldp);
switch (flag)
{
case CASE_UP:
c = UPCASE (buf, c);
break;
case CASE_DOWN:
c = DOWNCASE (buf, c);
break;
case CASE_CANONICALIZE:
c = CANONCASE (buf, c);
break;
case CASE_CAPITALIZE:
case CASE_CAPITALIZE_UP:
wordp_prev = wordp;
wordp = WORD_SYNTAX_P (syntax_table, c);
if (!wordp) break;
if (wordp_prev)
{
if (flag == CASE_CAPITALIZE)
c = DOWNCASE (buf, c);
}
else
c = UPCASE (buf, c);
break;
}
newp += set_itext_ichar (newp, c);
INC_IBYTEPTR (oldp);
}
return make_string (storage, newp - storage);
}
string_or_char = wrong_type_argument (Qchar_or_string_p, string_or_char);
goto retry;
}
/* This does the dirty work. gc_currently_forbidden is 1 when this is called.
*/
int
button_item_to_widget_value(Lisp_Object gui_object_instance,
Lisp_Object gui_item, widget_value * wv,
int allow_text_field_p, int no_keys_p,
int menu_entry_p, int accel_p)
{
/* This function cannot GC because gc_currently_forbidden is set when
it's called */
Lisp_Gui_Item *pgui = 0;
/* degenerate case */
if (STRINGP(gui_item)) {
wv->type = TEXT_TYPE;
if (accel_p)
wv->name = add_accel_and_to_external(gui_item);
else
LISP_STRING_TO_EXTERNAL_MALLOC(gui_item, wv->name,
Qlwlib_encoding);
return 1;
} else if (!GUI_ITEMP(gui_item))
syntax_error("need a string or a gui_item here", gui_item);
pgui = XGUI_ITEM(gui_item);
if (!NILP(pgui->filter))
syntax_error(":filter keyword not permitted on leaf nodes",
gui_item);
#ifdef HAVE_MENUBARS
if (menu_entry_p
&& !gui_item_included_p(gui_item, Vmenubar_configuration)) {
/* the include specification says to ignore this item. */
return 0;
}
#endif /* HAVE_MENUBARS */
if (!STRINGP(pgui->name))
pgui->name = Feval(pgui->name);
CHECK_STRING(pgui->name);
if (accel_p) {
Lisp_Object tmp = gui_item_accelerator(gui_item);
wv->name = add_accel_and_to_external(pgui->name);
wv->accel = LISP_TO_VOID(tmp);
} else {
LISP_STRING_TO_EXTERNAL_MALLOC(pgui->name, wv->name,
Qlwlib_encoding);
wv->accel = LISP_TO_VOID(Qnil);
}
if (!NILP(pgui->suffix)) {
Lisp_Object suffix2;
/* Shortcut to avoid evaluating suffix each time */
if (STRINGP(pgui->suffix))
suffix2 = pgui->suffix;
else {
suffix2 = Feval(pgui->suffix);
CHECK_STRING(suffix2);
}
LISP_STRING_TO_EXTERNAL_MALLOC(suffix2, wv->value,
Qlwlib_encoding);
}
wv_set_evalable_slot(wv->enabled, pgui->active);
wv_set_evalable_slot(wv->selected, pgui->selected);
if (!NILP(pgui->callback) || !NILP(pgui->callback_ex)) {
Lisp_Object tmp = cons3(gui_object_instance,
pgui->callback, pgui->callback_ex);
wv->call_data = LISP_TO_VOID(tmp);
}
if (no_keys_p
#ifdef HAVE_MENUBARS
|| (menu_entry_p && !menubar_show_keybindings)
#endif
) {
wv->key = 0;
} else if (!NILP(pgui->keys)) {
/* Use this string to generate key bindings */
CHECK_STRING(pgui->keys);
pgui->keys = Fsubstitute_command_keys(pgui->keys);
if (XSTRING_LENGTH(pgui->keys) > 0)
LISP_STRING_TO_EXTERNAL_MALLOC(pgui->keys, wv->key,
Qlwlib_encoding);
else
wv->key = 0;
} else if (SYMBOLP(pgui->callback)) { /* Show the binding of this command. */
char buf[1024]; /* #### */
/* #### Warning, dependency here on current_buffer and point */
where_is_to_char(pgui->callback, buf);
if (buf[0])
C_STRING_TO_EXTERNAL_MALLOC(buf, wv->key,
Qlwlib_encoding);
else
wv->key = 0;
}
CHECK_SYMBOL(pgui->style);
if (NILP(pgui->style)) {
Bufbyte *intname = NULL;
Bytecount intlen;
/* If the callback is nil, treat this item like unselectable text.
This way, dashes will show up as a separator. */
if (!wv->enabled)
wv->type = BUTTON_TYPE;
TO_INTERNAL_FORMAT(C_STRING, wv->name,
ALLOCA, (intname, intlen), Qlwlib_encoding);
if (intname != NULL && separator_string_p(intname)) {
wv->type = SEPARATOR_TYPE;
wv->value =
menu_separator_style_and_to_external(intname);
} else {
#if 0
/* #### - this is generally desirable for menubars, but it breaks
a package that uses dialog boxes and next_command_event magic
to use the callback slot in dialog buttons for data instead of
a real callback.
Code is data, right? The beauty of LISP abuse. --Stig */
if (NILP(callback))
wv->type = TEXT_TYPE;
else
#endif
wv->type = BUTTON_TYPE;
}
} else if (EQ(pgui->style, Qbutton))
wv->type = BUTTON_TYPE;
else if (EQ(pgui->style, Qtoggle))
wv->type = TOGGLE_TYPE;
else if (EQ(pgui->style, Qradio))
wv->type = RADIO_TYPE;
else if (EQ(pgui->style, Qtext)) {
wv->type = TEXT_TYPE;
#if 0
wv->value = wv->name;
wv->name = "value";
#endif
} else
syntax_error_2("Unknown style", pgui->style, gui_item);
if (!allow_text_field_p && (wv->type == TEXT_TYPE))
syntax_error("Text field not allowed in this context",
gui_item);
if (!NILP(pgui->selected) && EQ(pgui->style, Qtext))
syntax_error
(":selected only makes sense with :style toggle, radio or button",
gui_item);
return 1;
}
/* include-producer */
obj_t BGl_includezd2producerzd2zzmodule_includez00(obj_t BgL_clausez00_23)
{
AN_OBJECT;
{ /* Module/include.scm 45 */
{
{ /* Module/include.scm 48 */
obj_t BgL_g1529z00_132;
BgL_g1529z00_132 = CDR(BgL_clausez00_23);
{
obj_t BgL_filesz00_134;
BgL_filesz00_134 = BgL_g1529z00_132;
BgL_zc3anonymousza31546ze3z83_135:
if (NULLP(BgL_filesz00_134))
{ /* Module/include.scm 50 */
return BNIL;
}
else
{ /* Module/include.scm 50 */
if (PAIRP(BgL_filesz00_134))
{ /* Module/include.scm 55 */
obj_t BgL_filez00_138;
BgL_filez00_138 = CAR(BgL_filesz00_134);
if (STRINGP(BgL_filez00_138))
{ /* Module/include.scm 58 */
obj_t BgL_srcz00_140;
BgL_srcz00_140 =
BGl_readzd2includezd2zzread_includez00
(BgL_filez00_138);
{ /* Module/include.scm 58 */
obj_t BgL_directivez00_141;
BgL_directivez00_141 = CAR(BgL_srcz00_140);
{ /* Module/include.scm 59 */
obj_t BgL_srczd2codezd2_142;
BgL_srczd2codezd2_142 =
bgl_reverse_bang(CDR(BgL_srcz00_140));
{ /* Module/include.scm 60 */
if (PAIRP(BgL_directivez00_141))
{ /* Module/include.scm 63 */
obj_t BgL_g1533z00_144;
BgL_g1533z00_144 = CDR(BgL_directivez00_141);
{
obj_t BgL_l1531z00_146;
BgL_l1531z00_146 = BgL_g1533z00_144;
BgL_zc3anonymousza31551ze3z83_147:
if (PAIRP(BgL_l1531z00_146))
{ /* Module/include.scm 63 */
BGl_producezd2modulezd2clausez12z12zzmodule_modulez00
(CAR(BgL_l1531z00_146));
{
obj_t BgL_l1531z00_365;
BgL_l1531z00_365 =
CDR(BgL_l1531z00_146);
BgL_l1531z00_146 = BgL_l1531z00_365;
goto
BgL_zc3anonymousza31551ze3z83_147;
}
}
else
{ /* Module/include.scm 63 */
((bool_t) 1);
}
}
}
else
{ /* Module/include.scm 62 */
((bool_t) 0);
}
BGl_za2producedzd2codeza2zd2zzmodule_includez00 =
bgl_append2(BgL_srczd2codezd2_142,
BGl_za2producedzd2codeza2zd2zzmodule_includez00);
{
obj_t BgL_filesz00_368;
BgL_filesz00_368 = CDR(BgL_filesz00_134);
BgL_filesz00_134 = BgL_filesz00_368;
goto BgL_zc3anonymousza31546ze3z83_135;
}
}
}
}
}
else
{ /* Module/include.scm 56 */
BgL_zc3anonymousza31557ze3z83_155:
{ /* Module/include.scm 47 */
obj_t BgL_list1558z00_156;
BgL_list1558z00_156 = MAKE_PAIR(BNIL, BNIL);
return
BGl_userzd2errorzd2zztools_errorz00
(BGl_string1579z00zzmodule_includez00,
BGl_string1580z00zzmodule_includez00,
BgL_clausez00_23, BgL_list1558z00_156);
}
}
}
else
{ /* Module/include.scm 52 */
goto BgL_zc3anonymousza31557ze3z83_155;
}
}
}
}
}
}
}
/* include-consumer */
obj_t BGl_includezd2consumerzd2zzmodule_includez00(obj_t BgL_modulez00_24,
obj_t BgL_clausez00_25)
{
AN_OBJECT;
{ /* Module/include.scm 104 */
{
{ /* Module/include.scm 107 */
obj_t BgL_g1530z00_159;
BgL_g1530z00_159 = CDR(BgL_clausez00_25);
{
obj_t BgL_filesz00_161;
BgL_filesz00_161 = BgL_g1530z00_159;
BgL_zc3anonymousza31559ze3z83_162:
if (NULLP(BgL_filesz00_161))
{ /* Module/include.scm 109 */
return BNIL;
}
else
{ /* Module/include.scm 109 */
if (PAIRP(BgL_filesz00_161))
{ /* Module/include.scm 114 */
obj_t BgL_filez00_165;
BgL_filez00_165 = CAR(BgL_filesz00_161);
if (STRINGP(BgL_filez00_165))
{ /* Module/include.scm 117 */
obj_t BgL_srcz00_167;
BgL_srcz00_167 =
BGl_readzd2includezd2zzread_includez00
(BgL_filez00_165);
{ /* Module/include.scm 117 */
obj_t BgL_directivez00_168;
BgL_directivez00_168 = CAR(BgL_srcz00_167);
{ /* Module/include.scm 118 */
obj_t BgL_srczd2codezd2_169;
BgL_srczd2codezd2_169 = CDR(BgL_srcz00_167);
{ /* Module/include.scm 119 */
if (PAIRP(BgL_directivez00_168))
{ /* Module/include.scm 123 */
obj_t BgL_g1536z00_171;
BgL_g1536z00_171 = CDR(BgL_directivez00_168);
{
obj_t BgL_l1534z00_173;
BgL_l1534z00_173 = BgL_g1536z00_171;
BgL_zc3anonymousza31564ze3z83_174:
if (PAIRP(BgL_l1534z00_173))
{ /* Module/include.scm 128 */
{ /* Module/include.scm 125 */
obj_t BgL_dz00_176;
BgL_dz00_176 = CAR(BgL_l1534z00_173);
{ /* Module/include.scm 126 */
obj_t BgL_arg1566z00_177;
BgL_arg1566z00_177 =
BGl_consumezd2modulezd2clausez12z12zzmodule_modulez00
(BgL_modulez00_24, BgL_dz00_176);
BGl_za2consumedzd2directiveza2zd2zzmodule_includez00
=
bgl_append2(BgL_arg1566z00_177,
BGl_za2consumedzd2directiveza2zd2zzmodule_includez00);
}
}
{
obj_t BgL_l1534z00_394;
BgL_l1534z00_394 =
CDR(BgL_l1534z00_173);
BgL_l1534z00_173 = BgL_l1534z00_394;
goto
BgL_zc3anonymousza31564ze3z83_174;
}
}
else
{ /* Module/include.scm 128 */
((bool_t) 1);
}
}
}
else
{ /* Module/include.scm 122 */
((bool_t) 0);
}
BGl_za2consumedzd2codeza2zd2zzmodule_includez00 =
bgl_append2(BgL_srczd2codezd2_169,
BGl_za2consumedzd2codeza2zd2zzmodule_includez00);
{
obj_t BgL_filesz00_397;
BgL_filesz00_397 = CDR(BgL_filesz00_161);
BgL_filesz00_161 = BgL_filesz00_397;
goto BgL_zc3anonymousza31559ze3z83_162;
}
}
}
}
}
else
{ /* Module/include.scm 115 */
BgL_zc3anonymousza31569ze3z83_182:
{ /* Module/include.scm 106 */
obj_t BgL_list1570z00_183;
BgL_list1570z00_183 = MAKE_PAIR(BNIL, BNIL);
return
BGl_userzd2errorzd2zztools_errorz00
(BGl_string1579z00zzmodule_includez00,
BGl_string1580z00zzmodule_includez00,
BgL_clausez00_25, BgL_list1570z00_183);
}
}
}
else
{ /* Module/include.scm 111 */
goto BgL_zc3anonymousza31569ze3z83_182;
}
}
}
}
}
}
}
/* link */
BGL_EXPORTED_DEF obj_t BGl_linkz00zzengine_linkz00()
{
AN_OBJECT;
{ /* Engine/link.scm 42 */
bgl_register_eval_srfi(CNST_TABLE_REF(((long) 0)));
BGl_installzd2initialzd2expanderz00zzexpand_installz00();
BGl_setzd2backendz12zc0zzbackend_backendz00
(BGl_za2targetzd2languageza2zd2zzengine_paramz00);
{
obj_t BgL_objectsz00_193;
obj_t BgL_sourcesz00_194;
BgL_objectsz00_193 = BGl_za2ozd2filesza2zd2zzengine_paramz00;
BgL_sourcesz00_194 = BNIL;
BgL_zc3anonymousza31622ze3z83_195:
if (NULLP(BgL_objectsz00_193))
{ /* Engine/link.scm 54 */
obj_t BgL_arg1624z00_197;
BgL_arg1624z00_197 = BGl_thezd2backendzd2zzbackend_backendz00();
return
BGl_backendzd2linkzd2objectsz00zzbackend_backendz00(
(BgL_backendz00_bglt) (BgL_arg1624z00_197), BgL_sourcesz00_194);
}
else
{ /* Engine/link.scm 55 */
obj_t BgL_objectz00_198;
BgL_objectz00_198 = CAR(BgL_objectsz00_193);
{ /* Engine/link.scm 55 */
obj_t BgL_prefz00_199;
BgL_prefz00_199 =
BGl_unprofzd2srczd2namez00zzengine_linkz00
(BGl_prefixz00zz__osz00(BgL_objectz00_198));
{ /* Engine/link.scm 56 */
obj_t BgL_bprefz00_200;
BgL_bprefz00_200 = BGl_basenamez00zz__osz00(BgL_prefz00_199);
{ /* Engine/link.scm 57 */
obj_t BgL_scmzd2filezd2_201;
BgL_scmzd2filezd2_201 =
BGl_findzd2srczd2filez00zzengine_linkz00(BgL_prefz00_199,
BgL_bprefz00_200);
{ /* Engine/link.scm 58 */
if (STRINGP(BgL_scmzd2filezd2_201))
{ /* Engine/link.scm 60 */
obj_t BgL_arg1626z00_203;
obj_t BgL_arg1627z00_204;
BgL_arg1626z00_203 = CDR(BgL_objectsz00_193);
{ /* Engine/link.scm 60 */
obj_t BgL_arg1628z00_205;
BgL_arg1628z00_205 =
MAKE_PAIR(BgL_scmzd2filezd2_201, BgL_objectz00_198);
BgL_arg1627z00_204 =
MAKE_PAIR(BgL_arg1628z00_205, BgL_sourcesz00_194);
}
{
obj_t BgL_sourcesz00_598;
obj_t BgL_objectsz00_597;
BgL_objectsz00_597 = BgL_arg1626z00_203;
BgL_sourcesz00_598 = BgL_arg1627z00_204;
BgL_sourcesz00_194 = BgL_sourcesz00_598;
BgL_objectsz00_193 = BgL_objectsz00_597;
goto BgL_zc3anonymousza31622ze3z83_195;
}
}
else
{ /* Engine/link.scm 59 */
{ /* Engine/link.scm 62 */
bool_t BgL_testz00_599;
{ /* Engine/link.scm 62 */
int BgL_arg1637z00_213;
BgL_arg1637z00_213 =
BGl_bigloozd2warningzd2zz__paramz00();
BgL_testz00_599 =
((long) (BgL_arg1637z00_213) >= ((long) 2));
}
if (BgL_testz00_599)
{ /* Engine/link.scm 63 */
obj_t BgL_arg1632z00_209;
BgL_arg1632z00_209 = CAR(BgL_objectsz00_193);
{ /* Engine/link.scm 63 */
obj_t BgL_list1633z00_210;
{ /* Engine/link.scm 63 */
obj_t BgL_arg1635z00_211;
{ /* Engine/link.scm 63 */
obj_t BgL_arg1636z00_212;
BgL_arg1636z00_212 =
MAKE_PAIR(BgL_arg1632z00_209, BNIL);
BgL_arg1635z00_211 =
MAKE_PAIR
(BGl_string1800z00zzengine_linkz00,
BgL_arg1636z00_212);
}
BgL_list1633z00_210 =
MAKE_PAIR(BGl_string1801z00zzengine_linkz00,
BgL_arg1635z00_211);
}
BGl_warningz00zz__errorz00(BgL_list1633z00_210);
}
}
else
{ /* Engine/link.scm 62 */
BFALSE;
}
}
{
obj_t BgL_objectsz00_608;
BgL_objectsz00_608 = CDR(BgL_objectsz00_193);
BgL_objectsz00_193 = BgL_objectsz00_608;
goto BgL_zc3anonymousza31622ze3z83_195;
}
}
}
}
}
}
}
}
}
}
/* find-src-file */
BGL_EXPORTED_DEF obj_t BGl_findzd2srczd2filez00zzengine_linkz00(obj_t
BgL_prefixz00_3, obj_t BgL_bnamez00_4)
{
AN_OBJECT;
{ /* Engine/link.scm 92 */
{
obj_t BgL_suffixz00_231;
obj_t BgL_filesz00_232;
BgL_suffixz00_231 = BGl_za2srczd2suffixza2zd2zzengine_paramz00;
BgL_filesz00_232 = BNIL;
BgL_zc3anonymousza31656ze3z83_233:
if (NULLP(BgL_suffixz00_231))
{ /* Engine/link.scm 95 */
if (NULLP(BgL_filesz00_232))
{ /* Engine/link.scm 97 */
return BFALSE;
}
else
{ /* Engine/link.scm 97 */
if (NULLP(CDR(BgL_filesz00_232)))
{ /* Engine/link.scm 99 */
return CAR(BgL_filesz00_232);
}
else
{ /* Engine/link.scm 99 */
{ /* Engine/link.scm 102 */
obj_t BgL_arg1664z00_240;
BgL_arg1664z00_240 = CAR(BgL_filesz00_232);
{ /* Engine/link.scm 102 */
obj_t BgL_list1665z00_241;
{ /* Engine/link.scm 102 */
obj_t BgL_arg1666z00_242;
{ /* Engine/link.scm 102 */
obj_t BgL_arg1667z00_243;
{ /* Engine/link.scm 102 */
obj_t BgL_arg1668z00_244;
{ /* Engine/link.scm 102 */
obj_t BgL_arg1669z00_245;
BgL_arg1669z00_245 =
MAKE_PAIR(BgL_arg1664z00_240, BNIL);
BgL_arg1668z00_244 =
MAKE_PAIR(BGl_string1802z00zzengine_linkz00,
BgL_arg1669z00_245);
}
BgL_arg1667z00_243 =
MAKE_PAIR(BgL_bnamez00_4, BgL_arg1668z00_244);
}
BgL_arg1666z00_242 =
MAKE_PAIR(BGl_string1803z00zzengine_linkz00,
BgL_arg1667z00_243);
}
BgL_list1665z00_241 =
MAKE_PAIR(BGl_string1801z00zzengine_linkz00,
BgL_arg1666z00_242);
}
BGl_warningz00zz__errorz00(BgL_list1665z00_241);
}
}
return CAR(BgL_filesz00_232);
}
}
}
else
{ /* Engine/link.scm 105 */
obj_t BgL_sufz00_247;
BgL_sufz00_247 = CAR(BgL_suffixz00_231);
{ /* Engine/link.scm 105 */
obj_t BgL_fz00_248;
BgL_fz00_248 =
BGl_findzd2filezd2forzd2linkzd2zzengine_linkz00(string_append_3
(BgL_prefixz00_3, BGl_string1804z00zzengine_linkz00,
BgL_sufz00_247));
{ /* Engine/link.scm 106 */
if (STRINGP(BgL_fz00_248))
{ /* Engine/link.scm 108 */
obj_t BgL_arg1672z00_250;
obj_t BgL_arg1673z00_251;
BgL_arg1672z00_250 = CDR(BgL_suffixz00_231);
BgL_arg1673z00_251 =
MAKE_PAIR(BgL_fz00_248, BgL_filesz00_232);
{
obj_t BgL_filesz00_656;
obj_t BgL_suffixz00_655;
BgL_suffixz00_655 = BgL_arg1672z00_250;
BgL_filesz00_656 = BgL_arg1673z00_251;
BgL_filesz00_232 = BgL_filesz00_656;
BgL_suffixz00_231 = BgL_suffixz00_655;
goto BgL_zc3anonymousza31656ze3z83_233;
}
}
else
{ /* Engine/link.scm 109 */
obj_t BgL_fz00_252;
BgL_fz00_252 =
BGl_findzd2filezd2forzd2linkzd2zzengine_linkz00
(string_append_3(BgL_bnamez00_4,
BGl_string1804z00zzengine_linkz00, BgL_sufz00_247));
if (STRINGP(BgL_fz00_252))
{ /* Engine/link.scm 111 */
obj_t BgL_arg1675z00_254;
obj_t BgL_arg1676z00_255;
BgL_arg1675z00_254 = CDR(BgL_suffixz00_231);
BgL_arg1676z00_255 =
MAKE_PAIR(BgL_fz00_252, BgL_filesz00_232);
{
obj_t BgL_filesz00_664;
obj_t BgL_suffixz00_663;
BgL_suffixz00_663 = BgL_arg1675z00_254;
BgL_filesz00_664 = BgL_arg1676z00_255;
BgL_filesz00_232 = BgL_filesz00_664;
BgL_suffixz00_231 = BgL_suffixz00_663;
goto BgL_zc3anonymousza31656ze3z83_233;
}
}
else
{
obj_t BgL_suffixz00_665;
BgL_suffixz00_665 = CDR(BgL_suffixz00_231);
BgL_suffixz00_231 = BgL_suffixz00_665;
goto BgL_zc3anonymousza31656ze3z83_233;
}
}
}
}
}
}
}
}
/* user-error/location */
BGL_EXPORTED_DEF obj_t BGl_userzd2errorzf2locationz20zztools_errorz00(obj_t
BgL_locz00_32, obj_t BgL_procz00_33, obj_t BgL_msgz00_34,
obj_t BgL_objz00_35, obj_t BgL_continuez00_36)
{
AN_OBJECT;
{ /* Tools/error.scm 114 */
if (OUTPUT_PORTP(BGl_za2tracezd2portza2zd2zztools_tracez00))
{ /* Tools/error.scm 116 */
obj_t BgL_port3252z00_864;
BgL_port3252z00_864 = BGl_za2tracezd2portza2zd2zztools_tracez00;
bgl_display_string(BGl_string3381z00zztools_errorz00,
BgL_port3252z00_864);
bgl_display_obj(BgL_procz00_33, BgL_port3252z00_864);
bgl_display_string(BGl_string3375z00zztools_errorz00,
BgL_port3252z00_864);
bgl_display_obj(BgL_msgz00_34, BgL_port3252z00_864);
bgl_display_string(BGl_string3375z00zztools_errorz00,
BgL_port3252z00_864);
bgl_display_obj(BgL_objz00_35, BgL_port3252z00_864);
bgl_display_char(((unsigned char) '\n'), BgL_port3252z00_864);
}
else
{ /* Tools/error.scm 115 */
BFALSE;
}
{ /* Tools/error.scm 117 */
long BgL_za71za7_1348;
BgL_za71za7_1348 =
(long) CINT(BGl_za2nbzd2errorzd2onzd2passza2zd2zztools_errorz00);
BGl_za2nbzd2errorzd2onzd2passza2zd2zztools_errorz00 =
BINT((BgL_za71za7_1348 + ((long) 1)));
}
{ /* Tools/error.scm 118 */
obj_t BgL_proczd2stringzd2_865;
if (STRINGP(BgL_procz00_33))
{ /* Tools/error.scm 119 */
BgL_proczd2stringzd2_865 = BgL_procz00_33;
}
else
{ /* Tools/error.scm 119 */
if (SYMBOLP(BgL_procz00_33))
{ /* Tools/error.scm 122 */
obj_t BgL_res3370z00_1354;
{ /* Tools/error.scm 122 */
obj_t BgL_symbolz00_1352;
BgL_symbolz00_1352 = BgL_procz00_33;
{ /* Tools/error.scm 122 */
obj_t BgL_arg2063z00_1353;
BgL_arg2063z00_1353 = SYMBOL_TO_STRING(BgL_symbolz00_1352);
BgL_res3370z00_1354 =
BGl_stringzd2copyzd2zz__r4_strings_6_7z00
(BgL_arg2063z00_1353);
}
}
BgL_proczd2stringzd2_865 = BgL_res3370z00_1354;
}
else
{ /* Tools/error.scm 121 */
BgL_proczd2stringzd2_865 = BFALSE;
}
}
{ /* Tools/error.scm 118 */
obj_t BgL_funzd2stringzd2_866;
{ /* Tools/error.scm 125 */
obj_t BgL_arg3312z00_899;
BgL_arg3312z00_899 = CAR(BGl_za2sfunzd2stackza2zd2zztools_errorz00);
{ /* Tools/error.scm 125 */
obj_t BgL_res3371z00_1358;
{ /* Tools/error.scm 125 */
obj_t BgL_symbolz00_1356;
BgL_symbolz00_1356 = BgL_arg3312z00_899;
{ /* Tools/error.scm 125 */
obj_t BgL_arg2063z00_1357;
BgL_arg2063z00_1357 = SYMBOL_TO_STRING(BgL_symbolz00_1356);
BgL_res3371z00_1358 =
BGl_stringzd2copyzd2zz__r4_strings_6_7z00
(BgL_arg2063z00_1357);
}
}
BgL_funzd2stringzd2_866 = BgL_res3371z00_1358;
}
}
{ /* Tools/error.scm 125 */
obj_t BgL_procz00_867;
{ /* Tools/error.scm 126 */
bool_t BgL_testz00_1602;
if (STRINGP(BgL_proczd2stringzd2_865))
{ /* Tools/error.scm 126 */
if (bigloo_strcmp(BgL_proczd2stringzd2_865,
BgL_funzd2stringzd2_866))
{ /* Tools/error.scm 127 */
BgL_testz00_1602 = ((bool_t) 0);
}
else
{ /* Tools/error.scm 127 */
BgL_testz00_1602 = ((bool_t) 1);
}
}
else
{ /* Tools/error.scm 126 */
BgL_testz00_1602 = ((bool_t) 0);
}
if (BgL_testz00_1602)
{ /* Tools/error.scm 126 */
BgL_procz00_867 =
string_append_3(BgL_funzd2stringzd2_866,
BGl_string3375z00zztools_errorz00,
BgL_proczd2stringzd2_865);
}
else
{ /* Tools/error.scm 126 */
BgL_procz00_867 = BgL_funzd2stringzd2_866;
}
}
{ /* Tools/error.scm 126 */
obj_t BgL_objzd2prnzd2_868;
{ /* Tools/error.scm 130 */
obj_t BgL_portz00_888;
{ /* Tools/error.scm 130 */
{ /* Tools/error.scm 130 */
BgL_portz00_888 =
BGl_openzd2outputzd2stringz00zz__r4_ports_6_10_1z00
(BTRUE);
}
}
BGl_displayzd2circlezd2zz__pp_circlez00(BgL_objz00_35,
BgL_portz00_888);
{ /* Tools/error.scm 132 */
obj_t BgL_stringz00_889;
BgL_stringz00_889 = bgl_close_output_port(BgL_portz00_888);
if ((STRING_LENGTH(BgL_stringz00_889) > ((long) 45)))
{ /* Tools/error.scm 133 */
BgL_objzd2prnzd2_868 =
string_append(c_substring(BgL_stringz00_889, ((long) 0),
((long) 44)), BGl_string3382z00zztools_errorz00);
}
else
{ /* Tools/error.scm 133 */
BgL_objzd2prnzd2_868 = BgL_stringz00_889;
}
}
}
{ /* Tools/error.scm 130 */
return
BGl_zc3exitza33295ze3z83zztools_errorz00(BgL_continuez00_36,
BgL_locz00_32, BgL_objzd2prnzd2_868, BgL_msgz00_34,
BgL_procz00_867);
}
}
}
}
}
}
}
static Lisp_Object
casify_object(enum case_action flag, Lisp_Object string_or_char,
Lisp_Object buffer)
{
struct buffer *buf = decode_buffer(buffer, 0);
retry:
if (CHAR_OR_CHAR_INTP(string_or_char)) {
Emchar c;
CHECK_CHAR_COERCE_INT(string_or_char);
c = XCHAR(string_or_char);
c = (flag == CASE_DOWN) ? DOWNCASE(buf, c) : UPCASE(buf, c);
return make_char(c);
}
if (STRINGP(string_or_char)) {
Lisp_Char_Table *syntax_table =
XCHAR_TABLE(buf->mirror_syntax_table);
Bufbyte *storage =
alloca_array(Bufbyte,
XSTRING_LENGTH(string_or_char) *
MAX_EMCHAR_LEN);
Bufbyte *newp = storage;
Bufbyte *oldp = XSTRING_DATA(string_or_char);
int wordp = 0, wordp_prev;
while (*oldp) {
Emchar c = charptr_emchar(oldp);
switch (flag) {
case CASE_UP:
c = UPCASE(buf, c);
break;
case CASE_DOWN:
c = DOWNCASE(buf, c);
break;
case CASE_CAPITALIZE:
case CASE_CAPITALIZE_UP:
wordp_prev = wordp;
wordp = WORD_SYNTAX_P(syntax_table, c);
if (!wordp)
break;
if (wordp_prev) {
if (flag == CASE_CAPITALIZE)
c = DOWNCASE(buf, c);
} else
c = UPCASE(buf, c);
break;
/* can't happen */
default:
/* abort()? */
break;
}
newp += set_charptr_emchar(newp, c);
INC_CHARPTR(oldp);
}
return make_string(storage, newp - storage);
}
string_or_char = wrong_type_argument(Qchar_or_string_p, string_or_char);
goto retry;
}
static Lisp_Object
get_object_file_name (Lisp_Object filepos)
{
REGISTER int fd;
REGISTER Ibyte *name_nonreloc = 0;
EMACS_INT position;
Lisp_Object file, tem;
Lisp_Object name_reloc = Qnil;
int standard_doc_file = 0;
if (FIXNUMP (filepos))
{
file = Vinternal_doc_file_name;
standard_doc_file = 1;
position = XFIXNUM (filepos);
}
else if (CONSP (filepos) && FIXNUMP (XCDR (filepos)))
{
file = XCAR (filepos);
position = XFIXNUM (XCDR (filepos));
if (position < 0)
position = - position;
}
else
return Qnil;
if (!STRINGP (file))
return Qnil;
/* Put the file name in NAME as a C string.
If it is relative, combine it with Vdoc_directory. */
tem = Ffile_name_absolute_p (file);
if (NILP (tem))
{
Bytecount minsize;
/* XEmacs: Move this check here. OK if called during loadup to
load byte code instructions. */
if (!STRINGP (Vdoc_directory))
return Qnil;
minsize = XSTRING_LENGTH (Vdoc_directory);
/* sizeof ("../lib-src/") == 12 */
if (minsize < 12)
minsize = 12;
name_nonreloc = alloca_ibytes (minsize + XSTRING_LENGTH (file) + 8);
string_join (name_nonreloc, Vdoc_directory, file);
}
else
name_reloc = file;
fd = qxe_open (name_nonreloc ? name_nonreloc :
XSTRING_DATA (name_reloc), O_RDONLY | OPEN_BINARY, 0);
if (fd < 0)
{
if (purify_flag)
{
/* sizeof ("../lib-src/") == 12 */
name_nonreloc = alloca_ibytes (12 + XSTRING_LENGTH (file) + 8);
/* Preparing to dump; DOC file is probably not installed.
So check in ../lib-src. */
qxestrcpy_ascii (name_nonreloc, "../lib-src/");
qxestrcat (name_nonreloc, XSTRING_DATA (file));
fd = qxe_open (name_nonreloc, O_RDONLY | OPEN_BINARY, 0);
}
if (fd < 0)
report_file_error ("Cannot open doc string file",
name_nonreloc ? build_istring (name_nonreloc) :
name_reloc);
}
tem = extract_object_file_name (fd, position, name_nonreloc, name_reloc,
standard_doc_file);
retry_close (fd);
if (!STRINGP (tem))
signal_error_1 (Qinvalid_byte_code, tem);
return tem;
}
/* <anonymous:1887> */
obj_t BGl_zc3anonymousza31887ze3z83zz__modulez00(obj_t BgL_envz00_1645)
{ AN_OBJECT;
{ /* Llib/module.scm 107 */
{ /* Llib/module.scm 109 */
obj_t BgL_modz00_1646;obj_t BgL_abasez00_1647;
BgL_modz00_1646 =
PROCEDURE_REF(BgL_envz00_1645,
(int)(((long)0)));
BgL_abasez00_1647 =
PROCEDURE_REF(BgL_envz00_1645,
(int)(((long)1)));
{
if(
NULLP(BgL_abasez00_1647))
{ /* Llib/module.scm 110 */
obj_t BgL_basez00_1367;
{ /* Llib/module.scm 110 */
obj_t BgL_auxz00_1849;
{ /* Llib/module.scm 110 */
obj_t BgL_aux2269z00_1681;
BgL_aux2269z00_1681 = BGl_afilezd2tablezd2zz__modulez00;
{ /* Llib/module.scm 110 */
bool_t BgL_testz00_1850;
if(
PAIRP(BgL_aux2269z00_1681))
{ /* Llib/module.scm 110 */
BgL_testz00_1850 = ((bool_t)1)
; } else
{ /* Llib/module.scm 110 */
BgL_testz00_1850 =
NULLP(BgL_aux2269z00_1681)
; }
if(BgL_testz00_1850)
{ /* Llib/module.scm 110 */
BgL_auxz00_1849 = BgL_aux2269z00_1681
; } else
{
obj_t BgL_auxz00_1854;
BgL_auxz00_1854 =
BGl_typezd2errorzd2zz__errorz00(BGl_string2330z00zz__modulez00,
BINT(((long)4305)), BGl_string2340z00zz__modulez00, BGl_string2341z00zz__modulez00, BgL_aux2269z00_1681);
FAILURE(BgL_auxz00_1854,BFALSE,BFALSE);} } }
BgL_basez00_1367 =
BGl_assocz00zz__r4_pairs_and_lists_6_3z00(BGl_string2339z00zz__modulez00, BgL_auxz00_1849); }
if(
PAIRP(BgL_basez00_1367))
{ /* Llib/module.scm 110 */
return
BGl_resolvezd2abasezf2bucketz20zz__modulez00(BgL_modz00_1646, BgL_basez00_1367);} else
{ /* Llib/module.scm 110 */
return BNIL;} } else
{ /* Llib/module.scm 109 */
if(
STRINGP(BgL_abasez00_1647))
{ /* Llib/module.scm 112 */
obj_t BgL_basez00_1373;
{ /* Llib/module.scm 112 */
obj_t BgL_auxz00_1864;
{ /* Llib/module.scm 112 */
obj_t BgL_aux2271z00_1683;
BgL_aux2271z00_1683 = BGl_afilezd2tablezd2zz__modulez00;
{ /* Llib/module.scm 112 */
bool_t BgL_testz00_1865;
if(
PAIRP(BgL_aux2271z00_1683))
{ /* Llib/module.scm 112 */
BgL_testz00_1865 = ((bool_t)1)
; } else
{ /* Llib/module.scm 112 */
BgL_testz00_1865 =
NULLP(BgL_aux2271z00_1683)
; }
if(BgL_testz00_1865)
{ /* Llib/module.scm 112 */
BgL_auxz00_1864 = BgL_aux2271z00_1683
; } else
{
obj_t BgL_auxz00_1869;
BgL_auxz00_1869 =
BGl_typezd2errorzd2zz__errorz00(BGl_string2330z00zz__modulez00,
BINT(((long)4358)), BGl_string2340z00zz__modulez00, BGl_string2341z00zz__modulez00, BgL_aux2271z00_1683);
FAILURE(BgL_auxz00_1869,BFALSE,BFALSE);} } }
BgL_basez00_1373 =
BGl_assocz00zz__r4_pairs_and_lists_6_3z00(BgL_abasez00_1647, BgL_auxz00_1864); }
if(
PAIRP(BgL_basez00_1373))
{ /* Llib/module.scm 112 */
return
BGl_resolvezd2abasezf2bucketz20zz__modulez00(BgL_modz00_1646, BgL_basez00_1373);} else
{ /* Llib/module.scm 112 */
return BNIL;} } else
{ /* Llib/module.scm 111 */
if(
PAIRP(BgL_abasez00_1647))
{
obj_t BgL_abasez00_800;
BgL_abasez00_800 = BgL_abasez00_1647;
BgL_zc3anonymousza31891ze3z83_801:
if(
PAIRP(BgL_abasez00_800))
{ /* Llib/module.scm 116 */
obj_t BgL_resolvez00_803;
{ /* Llib/module.scm 116 */
obj_t BgL_arg1895z00_806;
BgL_arg1895z00_806 =
CAR(BgL_abasez00_800);
{ /* Llib/module.scm 116 */
obj_t BgL_basez00_1381;
{ /* Llib/module.scm 116 */
obj_t BgL_auxz00_1882;
{ /* Llib/module.scm 116 */
obj_t BgL_aux2273z00_1685;
BgL_aux2273z00_1685 = BGl_afilezd2tablezd2zz__modulez00;
{ /* Llib/module.scm 116 */
bool_t BgL_testz00_1883;
if(
PAIRP(BgL_aux2273z00_1685))
{ /* Llib/module.scm 116 */
BgL_testz00_1883 = ((bool_t)1)
; } else
{ /* Llib/module.scm 116 */
BgL_testz00_1883 =
NULLP(BgL_aux2273z00_1685)
; }
if(BgL_testz00_1883)
{ /* Llib/module.scm 116 */
BgL_auxz00_1882 = BgL_aux2273z00_1685
; } else
{
obj_t BgL_auxz00_1887;
BgL_auxz00_1887 =
BGl_typezd2errorzd2zz__errorz00(BGl_string2330z00zz__modulez00,
BINT(((long)4478)), BGl_string2342z00zz__modulez00, BGl_string2341z00zz__modulez00, BgL_aux2273z00_1685);
FAILURE(BgL_auxz00_1887,BFALSE,BFALSE);} } }
BgL_basez00_1381 =
BGl_assocz00zz__r4_pairs_and_lists_6_3z00(BgL_arg1895z00_806, BgL_auxz00_1882); }
if(
PAIRP(BgL_basez00_1381))
{ /* Llib/module.scm 116 */
BgL_resolvez00_803 =
BGl_resolvezd2abasezf2bucketz20zz__modulez00(BgL_modz00_1646, BgL_basez00_1381); } else
{ /* Llib/module.scm 116 */
BgL_resolvez00_803 = BNIL; } } }
if(
PAIRP(BgL_resolvez00_803))
{ /* Llib/module.scm 117 */
return BgL_resolvez00_803;} else
{
obj_t BgL_abasez00_1897;
BgL_abasez00_1897 =
CDR(BgL_abasez00_800);
BgL_abasez00_800 = BgL_abasez00_1897;
goto BgL_zc3anonymousza31891ze3z83_801;} } else
{ /* Llib/module.scm 115 */
return BNIL;} } else
{ /* Llib/module.scm 113 */
return
BGl_resolvezd2abaseza2z70zz__modulez00(BgL_modz00_1646);} } } } } }
}
/* run-process */
BGL_EXPORTED_DEF obj_t BGl_runzd2processzd2zz__processz00(obj_t
BgL_commandz00_14, obj_t BgL_restz00_15)
{
AN_OBJECT;
{ /* Llib/process.scm 211 */
{ /* Llib/process.scm 212 */
obj_t BgL_forkz00_759;
obj_t BgL_waitz00_760;
obj_t BgL_inputz00_761;
obj_t BgL_outputz00_762;
obj_t BgL_errorz00_763;
obj_t BgL_hostz00_764;
obj_t BgL_pipesz00_765;
obj_t BgL_argsz00_766;
obj_t BgL_envz00_767;
BgL_forkz00_759 = BTRUE;
BgL_waitz00_760 = BFALSE;
BgL_inputz00_761 = BUNSPEC;
BgL_outputz00_762 = BUNSPEC;
BgL_errorz00_763 = BUNSPEC;
BgL_hostz00_764 = BUNSPEC;
BgL_pipesz00_765 = BGl_list2216z00zz__processz00;
BgL_argsz00_766 = BNIL;
BgL_envz00_767 = BNIL;
{
obj_t BgL_restz00_770;
BgL_restz00_770 = BgL_restz00_15;
BgL_zc3anonymousza31880ze3z83_771:
if (NULLP(BgL_restz00_770))
{ /* Llib/process.scm 228 */
obj_t BgL_arg1882z00_773;
BgL_arg1882z00_773 = bgl_reverse_bang(BgL_argsz00_766);
return
c_run_process(BgL_hostz00_764, BgL_forkz00_759, BgL_waitz00_760,
BgL_inputz00_761, BgL_outputz00_762, BgL_errorz00_763,
BgL_commandz00_14, BgL_arg1882z00_773, BgL_envz00_767);
}
else
{ /* Llib/process.scm 229 */
bool_t BgL_testz00_1683;
{ /* Llib/process.scm 229 */
bool_t BgL_testz00_1684;
{ /* Llib/process.scm 229 */
obj_t BgL_auxz00_1685;
BgL_auxz00_1685 = CAR(BgL_restz00_770);
BgL_testz00_1684 = KEYWORDP(BgL_auxz00_1685);
}
if (BgL_testz00_1684)
{ /* Llib/process.scm 229 */
obj_t BgL_auxz00_1688;
BgL_auxz00_1688 = CDR(BgL_restz00_770);
BgL_testz00_1683 = PAIRP(BgL_auxz00_1688);
}
else
{ /* Llib/process.scm 229 */
BgL_testz00_1683 = ((bool_t) 0);
}
}
if (BgL_testz00_1683)
{ /* Llib/process.scm 230 */
obj_t BgL_valz00_775;
{ /* Llib/process.scm 230 */
obj_t BgL_pairz00_1250;
BgL_pairz00_1250 = BgL_restz00_770;
BgL_valz00_775 = CAR(CDR(BgL_pairz00_1250));
}
{ /* Llib/process.scm 231 */
obj_t BgL_casezd2valuezd2_776;
BgL_casezd2valuezd2_776 = CAR(BgL_restz00_770);
if (
(BgL_casezd2valuezd2_776 ==
BGl_keyword2219z00zz__processz00))
{ /* Llib/process.scm 231 */
if (BOOLEANP(BgL_valz00_775))
{ /* Llib/process.scm 233 */
BgL_waitz00_760 = BgL_valz00_775;
}
else
{ /* Llib/process.scm 233 */
BGl_errorz00zz__errorz00
(BGl_string2221z00zz__processz00,
BGl_string2222z00zz__processz00, BgL_restz00_770);
}
}
else
{ /* Llib/process.scm 231 */
if (
(BgL_casezd2valuezd2_776 ==
BGl_keyword2223z00zz__processz00))
{ /* Llib/process.scm 231 */
if (BOOLEANP(BgL_valz00_775))
{ /* Llib/process.scm 237 */
BgL_forkz00_759 = BgL_valz00_775;
}
else
{ /* Llib/process.scm 237 */
BGl_errorz00zz__errorz00
(BGl_string2221z00zz__processz00,
BGl_string2222z00zz__processz00,
BgL_restz00_770);
}
}
else
{ /* Llib/process.scm 231 */
if (
(BgL_casezd2valuezd2_776 ==
BGl_keyword2225z00zz__processz00))
{ /* Llib/process.scm 241 */
bool_t BgL_testz00_1706;
if (STRINGP(BgL_valz00_775))
{ /* Llib/process.scm 241 */
BgL_testz00_1706 = ((bool_t) 1);
}
else
{ /* Llib/process.scm 241 */
BgL_testz00_1706 =
CBOOL
(BGl_memqz00zz__r4_pairs_and_lists_6_3z00
(BgL_valz00_775, BgL_pipesz00_765));
}
if (BgL_testz00_1706)
{ /* Llib/process.scm 241 */
BgL_inputz00_761 = BgL_valz00_775;
}
else
{ /* Llib/process.scm 241 */
BGl_errorz00zz__errorz00
(BGl_string2221z00zz__processz00,
BGl_string2222z00zz__processz00,
BgL_restz00_770);
}
}
else
{ /* Llib/process.scm 231 */
if (
(BgL_casezd2valuezd2_776 ==
BGl_keyword2227z00zz__processz00))
{ /* Llib/process.scm 245 */
bool_t BgL_testz00_1714;
if (STRINGP(BgL_valz00_775))
{ /* Llib/process.scm 245 */
BgL_testz00_1714 = ((bool_t) 1);
}
else
{ /* Llib/process.scm 245 */
if (CBOOL
(BGl_memqz00zz__r4_pairs_and_lists_6_3z00
(BgL_valz00_775, BgL_pipesz00_765)))
{ /* Llib/process.scm 245 */
BgL_testz00_1714 = ((bool_t) 1);
}
else
{ /* Llib/process.scm 245 */
BgL_testz00_1714 =
(BgL_valz00_775 ==
BGl_keyword2229z00zz__processz00);
}
}
if (BgL_testz00_1714)
{ /* Llib/process.scm 245 */
BgL_outputz00_762 = BgL_valz00_775;
}
else
{ /* Llib/process.scm 245 */
BGl_errorz00zz__errorz00
(BGl_string2221z00zz__processz00,
BGl_string2222z00zz__processz00,
BgL_restz00_770);
}
}
else
{ /* Llib/process.scm 231 */
if (
(BgL_casezd2valuezd2_776 ==
BGl_keyword2231z00zz__processz00))
{ /* Llib/process.scm 249 */
bool_t BgL_testz00_1724;
if (STRINGP(BgL_valz00_775))
{ /* Llib/process.scm 249 */
BgL_testz00_1724 = ((bool_t) 1);
}
else
{ /* Llib/process.scm 249 */
if (CBOOL
(BGl_memqz00zz__r4_pairs_and_lists_6_3z00
(BgL_valz00_775,
BgL_pipesz00_765)))
{ /* Llib/process.scm 249 */
BgL_testz00_1724 = ((bool_t) 1);
}
else
{ /* Llib/process.scm 249 */
BgL_testz00_1724 =
(BgL_valz00_775 ==
BGl_keyword2229z00zz__processz00);
}
}
if (BgL_testz00_1724)
{ /* Llib/process.scm 249 */
BgL_errorz00_763 = BgL_valz00_775;
}
else
{ /* Llib/process.scm 249 */
BGl_errorz00zz__errorz00
(BGl_string2221z00zz__processz00,
BGl_string2222z00zz__processz00,
BgL_restz00_770);
}
}
else
{ /* Llib/process.scm 231 */
if (
(BgL_casezd2valuezd2_776 ==
BGl_keyword2233z00zz__processz00))
{ /* Llib/process.scm 231 */
if (STRINGP(BgL_valz00_775))
{ /* Llib/process.scm 253 */
BgL_hostz00_764 =
BgL_valz00_775;
}
else
{ /* Llib/process.scm 253 */
BGl_errorz00zz__errorz00
(BGl_string2221z00zz__processz00,
BGl_string2222z00zz__processz00,
BgL_restz00_770);
}
}
else
{ /* Llib/process.scm 231 */
if (
(BgL_casezd2valuezd2_776 ==
BGl_keyword2235z00zz__processz00))
{ /* Llib/process.scm 231 */
if (STRINGP(BgL_valz00_775))
{ /* Llib/process.scm 257 */
BgL_envz00_767 =
MAKE_PAIR(BgL_valz00_775,
BgL_envz00_767);
}
else
{ /* Llib/process.scm 257 */
BGl_errorz00zz__errorz00
(BGl_string2221z00zz__processz00,
BGl_string2222z00zz__processz00,
BgL_restz00_770);
}
}
else
{ /* Llib/process.scm 231 */
BGl_errorz00zz__errorz00
(BGl_string2221z00zz__processz00,
BGl_string2222z00zz__processz00,
BgL_restz00_770);
}
}
}
}
}
}
}
}
{
obj_t BgL_restz00_1744;
BgL_restz00_1744 = CDR(CDR(BgL_restz00_770));
BgL_restz00_770 = BgL_restz00_1744;
goto BgL_zc3anonymousza31880ze3z83_771;
}
}
else
{ /* Llib/process.scm 263 */
bool_t BgL_testz00_1747;
{ /* Llib/process.scm 263 */
obj_t BgL_auxz00_1748;
BgL_auxz00_1748 = CAR(BgL_restz00_770);
BgL_testz00_1747 = STRINGP(BgL_auxz00_1748);
}
if (BgL_testz00_1747)
{ /* Llib/process.scm 263 */
{ /* Llib/process.scm 264 */
obj_t BgL_arg1906z00_799;
BgL_arg1906z00_799 = CAR(BgL_restz00_770);
BgL_argsz00_766 =
MAKE_PAIR(BgL_arg1906z00_799, BgL_argsz00_766);
}
{
obj_t BgL_restz00_1753;
BgL_restz00_1753 = CDR(BgL_restz00_770);
BgL_restz00_770 = BgL_restz00_1753;
goto BgL_zc3anonymousza31880ze3z83_771;
}
}
else
{ /* Llib/process.scm 263 */
return
BGl_errorz00zz__errorz00
(BGl_string2221z00zz__processz00,
BGl_string2222z00zz__processz00, BgL_restz00_770);
}
}
}
}
}
}
}
static char const *
string_default (Lisp_Object s, char const *default_value)
{
return STRINGP (s) ? SSDATA (s) : default_value;
}
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;
}
cell_t *evaluate(cell_t *exp, environ_t *env) {
++__tl_eval_level;
// push a frame
eval_stack_t s;
s.next = eval_stack;
s.value = env;
eval_stack = &s;
if (DFLAG) {
printf("Eval (%d) got : ", __tl_eval_level);
pretty_print(exp);
}
if (NULL == exp) {
DRETURN(RET_VAL, NULL);
} else if (NILP(exp)) {
DRETURN(RET_VAL, nil_cell);
} else if (ATOMP(exp)) {
if (SYMBOLP(exp)) {
DRETURN(RET_VAL, find_value(env, exp));
} else if (STRINGP(exp) || NUMBERP(exp)) {
DRETURN(RET_VAL, exp);
} else {
DEBUGPRINT_("Expression not valid.\n");
pretty_print(orig_sexpr);
GOTO_TOPLEVEL();
return NULL; /* unreachable */
}
} else { /* list */
handle_t *he = handle_push(exp);
cell_t *first = evaluate(CAR(exp), env); // exp handled
exp = handle_get(he);
handle_pop(he);
cell_t *rest = CDR(exp);
if (DFLAG) {
printf("First is: ");
pretty_print(first);
printf("Rest is: ");
pretty_print(rest);
}
if (NULL == first) {
fast_error(" malformed expression.");
/* This is unreachable */
} else if (PRIMITIVEP(first)) {
cell_t *(*f)(cell_t *, environ_t *) = CELL_PRIMITIVE(first);
DRETURN(RET_PRIM, (*f)(rest, env));
} else if (FUNCTIONP(first)) { /* function call */
cell_t *t;
handle_t *hf;
hf = handle_push(first);
t = evargs(rest, env); // first handled
first = handle_get(hf);
handle_pop(hf);
DRETURN(RET_FUNCALL, invoke(first, t, env)); // no need for handles
}
undefun_error(first, exp); /* Not primitive or funcall, error.*/
return NULL; /* Unreachable, undefun_error() does not return. */
}
}
static Lisp_Object
casify_object (enum case_action flag, Lisp_Object obj)
{
register int c, c1;
register int inword = flag == CASE_DOWN;
/* If the case table is flagged as modified, rescan it. */
if (NILP (XCHAR_TABLE (BVAR (current_buffer, downcase_table))->extras[1]))
Fset_case_table (BVAR (current_buffer, downcase_table));
if (INTEGERP (obj))
{
int flagbits = (CHAR_ALT | CHAR_SUPER | CHAR_HYPER
| CHAR_SHIFT | CHAR_CTL | CHAR_META);
int flags = XINT (obj) & flagbits;
int multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
/* If the character has higher bits set
above the flags, return it unchanged.
It is not a real character. */
if ((unsigned) XFASTINT (obj) > (unsigned) flagbits)
return obj;
c1 = XFASTINT (obj) & ~flagbits;
/* FIXME: Even if enable-multibyte-characters is nil, we may
manipulate multibyte chars. This means we have a bug for latin-1
chars since when we receive an int 128-255 we can't tell whether
it's an eight-bit byte or a latin-1 char. */
if (c1 >= 256)
multibyte = 1;
if (! multibyte)
MAKE_CHAR_MULTIBYTE (c1);
c = downcase (c1);
if (inword)
XSETFASTINT (obj, c | flags);
else if (c == (XFASTINT (obj) & ~flagbits))
{
if (! inword)
c = upcase1 (c1);
if (! multibyte)
MAKE_CHAR_UNIBYTE (c);
XSETFASTINT (obj, c | flags);
}
return obj;
}
if (!STRINGP (obj))
wrong_type_argument (Qchar_or_string_p, obj);
else if (!STRING_MULTIBYTE (obj))
{
EMACS_INT i;
EMACS_INT size = SCHARS (obj);
obj = Fcopy_sequence (obj);
for (i = 0; i < size; i++)
{
c = SREF (obj, i);
MAKE_CHAR_MULTIBYTE (c);
c1 = c;
if (inword && flag != CASE_CAPITALIZE_UP)
c = downcase (c);
else if (!uppercasep (c)
&& (!inword || flag != CASE_CAPITALIZE_UP))
c = upcase1 (c1);
if ((int) flag >= (int) CASE_CAPITALIZE)
inword = (SYNTAX (c) == Sword);
if (c != c1)
{
MAKE_CHAR_UNIBYTE (c);
/* If the char can't be converted to a valid byte, just don't
change it. */
if (c >= 0 && c < 256)
SSET (obj, i, c);
}
}
return obj;
}
else
{
EMACS_INT i, i_byte, size = SCHARS (obj);
int len;
USE_SAFE_ALLOCA;
unsigned char *dst, *o;
/* Over-allocate by 12%: this is a minor overhead, but should be
sufficient in 99.999% of the cases to avoid a reallocation. */
EMACS_INT o_size = SBYTES (obj) + SBYTES (obj) / 8 + MAX_MULTIBYTE_LENGTH;
SAFE_ALLOCA (dst, void *, o_size);
o = dst;
for (i = i_byte = 0; i < size; i++, i_byte += len)
{
if ((o - dst) + MAX_MULTIBYTE_LENGTH > o_size)
{ /* Not enough space for the next char: grow the destination. */
unsigned char *old_dst = dst;
o_size += o_size; /* Probably overkill, but extremely rare. */
SAFE_ALLOCA (dst, void *, o_size);
memcpy (dst, old_dst, o - old_dst);
o = dst + (o - old_dst);
}
c = STRING_CHAR_AND_LENGTH (SDATA (obj) + i_byte, len);
if (inword && flag != CASE_CAPITALIZE_UP)
c = downcase (c);
else if (!uppercasep (c)
&& (!inword || flag != CASE_CAPITALIZE_UP))
c = upcase1 (c);
if ((int) flag >= (int) CASE_CAPITALIZE)
inword = (SYNTAX (c) == Sword);
o += CHAR_STRING (c, o);
}
eassert (o - dst <= o_size);
obj = make_multibyte_string ((char *) dst, size, o - dst);
SAFE_FREE ();
return obj;
}
}
static Lisp_Object
simple_dialog_show (struct frame *f, Lisp_Object contents, Lisp_Object header)
{
int answer;
UINT type;
Lisp_Object lispy_answer = Qnil, temp = XCAR (contents);
type = MB_YESNO;
/* Since we only handle Yes/No dialogs, and we already checked
is_simple_dialog, we don't need to worry about checking contents
to see what type of dialog to use. */
/* Use Unicode if possible, so any language can be displayed. */
if (unicode_message_box)
{
WCHAR *text;
const WCHAR *title;
USE_SAFE_ALLOCA;
if (STRINGP (temp))
{
char *utf8_text = SSDATA (ENCODE_UTF_8 (temp));
/* Be pessimistic about the number of characters needed.
Remember characters outside the BMP will take more than
one utf16 word, so we cannot simply use the character
length of temp. */
int utf8_len = strlen (utf8_text);
text = SAFE_ALLOCA ((utf8_len + 1) * sizeof (WCHAR));
utf8to16 ((unsigned char *)utf8_text, utf8_len, text);
}
else
{
text = (WCHAR *)L"";
}
if (NILP (header))
{
title = L"Question";
type |= MB_ICONQUESTION;
}
else
{
title = L"Information";
type |= MB_ICONINFORMATION;
}
answer = unicode_message_box (FRAME_W32_WINDOW (f), text, title, type);
SAFE_FREE ();
}
else
{
const char *text, *title;
/* Fall back on ANSI message box, but at least use system
encoding so questions representable by the system codepage
are encoded properly. */
if (STRINGP (temp))
text = SSDATA (ENCODE_SYSTEM (temp));
else
text = "";
if (NILP (header))
{
title = "Question";
type |= MB_ICONQUESTION;
}
else
{
title = "Information";
type |= MB_ICONINFORMATION;
}
answer = MessageBox (FRAME_W32_WINDOW (f), text, title, type);
}
if (answer == IDYES)
lispy_answer = build_string ("Yes");
else if (answer == IDNO)
lispy_answer = build_string ("No");
else
Fsignal (Qquit, Qnil);
for (temp = XCDR (contents); CONSP (temp); temp = XCDR (temp))
{
Lisp_Object item, name, value;
item = XCAR (temp);
if (CONSP (item))
{
name = XCAR (item);
value = XCDR (item);
}
else
{
name = item;
value = Qnil;
}
if (!NILP (Fstring_equal (name, lispy_answer)))
{
return value;
}
}
Fsignal (Qquit, Qnil);
return Qnil;
}
/* load-parser */
obj_t BGl_loadzd2parserzd2zzmodule_loadz00(obj_t BgL_protoz00_2,
obj_t BgL_clausez00_3)
{
AN_OBJECT;
{ /* Module/load.scm 50 */
{
obj_t BgL_modulez00_408;
obj_t BgL_filez00_409;
obj_t BgL_filesz00_410;
if (PAIRP(BgL_protoz00_2))
{ /* Module/load.scm 51 */
obj_t BgL_carzd21407zd2_416;
obj_t BgL_cdrzd21408zd2_417;
BgL_carzd21407zd2_416 = CAR(BgL_protoz00_2);
BgL_cdrzd21408zd2_417 = CDR(BgL_protoz00_2);
if (SYMBOLP(BgL_carzd21407zd2_416))
{ /* Module/load.scm 51 */
if (PAIRP(BgL_cdrzd21408zd2_417))
{ /* Module/load.scm 51 */
obj_t BgL_carzd21413zd2_420;
BgL_carzd21413zd2_420 = CAR(BgL_cdrzd21408zd2_417);
if (STRINGP(BgL_carzd21413zd2_420))
{ /* Module/load.scm 51 */
BgL_modulez00_408 = BgL_carzd21407zd2_416;
BgL_filez00_409 = BgL_carzd21413zd2_420;
BgL_filesz00_410 = CDR(BgL_cdrzd21408zd2_417);
{
obj_t BgL_fz00_428;
BgL_fz00_428 = BgL_filesz00_410;
BgL_zc3anonymousza32156ze3z83_429:
if (NULLP(BgL_fz00_428))
{ /* Module/load.scm 56 */
obj_t BgL_arg2159z00_431;
BgL_arg2159z00_431 =
MAKE_PAIR(BgL_filez00_409, BgL_filesz00_410);
return
BGl_loadzd2modulezd2zzread_loadz00
(BgL_modulez00_408, BgL_arg2159z00_431);
}
else
{ /* Module/load.scm 57 */
bool_t BgL_testz00_697;
{ /* Module/load.scm 57 */
obj_t BgL_auxz00_698;
BgL_auxz00_698 = CAR(BgL_fz00_428);
BgL_testz00_697 = STRINGP(BgL_auxz00_698);
}
if (BgL_testz00_697)
{
obj_t BgL_fz00_701;
BgL_fz00_701 = CDR(BgL_fz00_428);
BgL_fz00_428 = BgL_fz00_701;
goto BgL_zc3anonymousza32156ze3z83_429;
}
else
{ /* Module/load.scm 58 */
obj_t BgL_list2166z00_434;
BgL_list2166z00_434 = MAKE_PAIR(BNIL, BNIL);
return
BGl_userzd2errorzd2zztools_errorz00
(BGl_string2258z00zzmodule_loadz00,
BGl_string2260z00zzmodule_loadz00,
BgL_clausez00_3, BgL_list2166z00_434);
}
}
}
}
else
{ /* Module/load.scm 51 */
BgL_tagzd21399zd2_413:
{ /* Module/load.scm 68 */
obj_t BgL_list2209z00_460;
BgL_list2209z00_460 = MAKE_PAIR(BNIL, BNIL);
return
BGl_userzd2errorzd2zztools_errorz00
(BGl_string2258z00zzmodule_loadz00,
BGl_string2260z00zzmodule_loadz00, BgL_clausez00_3,
BgL_list2209z00_460);
}
}
}
else
{ /* Module/load.scm 51 */
goto BgL_tagzd21399zd2_413;
}
}
else
{ /* Module/load.scm 51 */
goto BgL_tagzd21399zd2_413;
}
}
else
{ /* Module/load.scm 51 */
if (SYMBOLP(BgL_protoz00_2))
{ /* Module/load.scm 51 */
{ /* Module/load.scm 62 */
obj_t BgL_abasez00_437;
{ /* Module/load.scm 62 */
obj_t BgL_l2116z00_442;
BgL_l2116z00_442 =
BGl_za2accesszd2filesza2zd2zzengine_paramz00;
if (NULLP(BgL_l2116z00_442))
{ /* Module/load.scm 62 */
BgL_abasez00_437 = BNIL;
}
else
{ /* Module/load.scm 62 */
obj_t BgL_head2118z00_444;
BgL_head2118z00_444 =
MAKE_PAIR(BGl_dirnamez00zz__osz00(CAR
(BgL_l2116z00_442)), BNIL);
{ /* Module/load.scm 62 */
obj_t BgL_g2121z00_445;
BgL_g2121z00_445 = CDR(BgL_l2116z00_442);
{
obj_t BgL_l2116z00_447;
obj_t BgL_tail2119z00_448;
BgL_l2116z00_447 = BgL_g2121z00_445;
BgL_tail2119z00_448 = BgL_head2118z00_444;
BgL_zc3anonymousza32177ze3z83_449:
if (NULLP(BgL_l2116z00_447))
{ /* Module/load.scm 62 */
BgL_abasez00_437 = BgL_head2118z00_444;
}
else
{ /* Module/load.scm 62 */
obj_t BgL_newtail2120z00_451;
BgL_newtail2120z00_451 =
MAKE_PAIR(BGl_dirnamez00zz__osz00(CAR
(BgL_l2116z00_447)), BNIL);
SET_CDR(BgL_tail2119z00_448,
BgL_newtail2120z00_451);
{
obj_t BgL_tail2119z00_724;
obj_t BgL_l2116z00_722;
BgL_l2116z00_722 = CDR(BgL_l2116z00_447);
BgL_tail2119z00_724 = BgL_newtail2120z00_451;
BgL_tail2119z00_448 = BgL_tail2119z00_724;
BgL_l2116z00_447 = BgL_l2116z00_722;
goto BgL_zc3anonymousza32177ze3z83_449;
}
}
}
}
}
}
{ /* Module/load.scm 62 */
obj_t BgL_bz00_438;
{ /* Module/load.scm 63 */
obj_t BgL_fun2175z00_441;
BgL_fun2175z00_441 =
BGl_bigloozd2modulezd2resolverz00zz__modulez00();
BgL_bz00_438 =
PROCEDURE_ENTRY(BgL_fun2175z00_441) (BgL_fun2175z00_441,
BgL_protoz00_2, BgL_abasez00_437, BEOA);
}
{ /* Module/load.scm 63 */
if (PAIRP(BgL_bz00_438))
{ /* Module/load.scm 64 */
return
BGl_loadzd2modulezd2zzread_loadz00(BgL_protoz00_2,
BgL_bz00_438);
}
else
{ /* Module/load.scm 64 */
return
BGl_userzd2errorzd2zztools_errorz00
(BGl_string2261z00zzmodule_loadz00,
BGl_string2262z00zzmodule_loadz00, BgL_protoz00_2,
BNIL);
}
}
}
}
}
else
{ /* Module/load.scm 51 */
goto BgL_tagzd21399zd2_413;
}
}
}
}
}
Lisp_Object
w32_menu_show (struct frame *f, int x, int y, int menuflags,
Lisp_Object title, const char **error)
{
int i;
int menu_item_selection;
HMENU menu;
POINT pos;
widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0;
widget_value **submenu_stack
= (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
Lisp_Object *subprefix_stack
= (Lisp_Object *) alloca (menu_items_used * word_size);
int submenu_depth = 0;
bool first_pane;
*error = NULL;
if (menu_items_n_panes == 0)
return Qnil;
if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
{
*error = "Empty menu";
return Qnil;
}
block_input ();
/* Create a tree of widget_value objects
representing the panes and their items. */
wv = make_widget_value ("menu", NULL, true, Qnil);
wv->button_type = BUTTON_TYPE_NONE;
first_wv = wv;
first_pane = true;
/* Loop over all panes and items, filling in the tree. */
i = 0;
while (i < menu_items_used)
{
if (EQ (AREF (menu_items, i), Qnil))
{
submenu_stack[submenu_depth++] = save_wv;
save_wv = prev_wv;
prev_wv = 0;
first_pane = false;
i++;
}
else if (EQ (AREF (menu_items, i), Qlambda))
{
prev_wv = save_wv;
save_wv = submenu_stack[--submenu_depth];
first_pane = false;
i++;
}
else if (EQ (AREF (menu_items, 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 (AREF (menu_items, i), Qquote))
i += 1;
else if (EQ (AREF (menu_items, i), Qt))
{
/* Create a new pane. */
Lisp_Object pane_name, prefix;
const char *pane_string;
pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
if (STRINGP (pane_name))
{
if (unicode_append_menu)
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);
}
pane_string = (NILP (pane_name)
? "" : SSDATA (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 (!(menuflags & MENU_KEYMAPS) && strcmp (pane_string, ""))
{
wv = make_widget_value (pane_string, NULL, true, Qnil);
if (save_wv)
save_wv->next = wv;
else
first_wv->contents = wv;
if ((menuflags & MENU_KEYMAPS) && !NILP (prefix))
wv->name++;
wv->button_type = BUTTON_TYPE_NONE;
save_wv = wv;
prev_wv = 0;
}
else if (first_pane)
{
save_wv = wv;
prev_wv = 0;
}
first_pane = false;
i += MENU_ITEMS_PANE_LENGTH;
}
else
{
/* Create a new item within current pane. */
Lisp_Object item_name, enable, descrip, def, type, selected, help;
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);
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);
}
wv = make_widget_value (SSDATA (item_name), NULL, !NILP (enable),
STRINGP (help) ? help : Qnil);
if (prev_wv)
prev_wv->next = wv;
else
save_wv->contents = wv;
if (!NILP (descrip))
wv->key = SSDATA (descrip);
/* Use the contents index as call_data, since we are
restricted to 16-bits. */
wv->call_data = !NILP (def) ? (void *) (UINT_PTR) i : 0;
if (NILP (type))
wv->button_type = BUTTON_TYPE_NONE;
else if (EQ (type, QCtoggle))
wv->button_type = BUTTON_TYPE_TOGGLE;
else if (EQ (type, QCradio))
wv->button_type = BUTTON_TYPE_RADIO;
else
emacs_abort ();
wv->selected = !NILP (selected);
prev_wv = wv;
i += MENU_ITEMS_ITEM_LENGTH;
}
}
/* Deal with the title, if it is non-nil. */
if (!NILP (title))
{
widget_value *wv_title;
widget_value *wv_sep = make_widget_value ("--", NULL, false, Qnil);
/* Maybe replace this separator with a bitmap or owner-draw item
so that it looks better. Having two separators looks odd. */
wv_sep->next = first_wv->contents;
if (unicode_append_menu)
title = ENCODE_UTF_8 (title);
else if (STRING_MULTIBYTE (title))
title = ENCODE_SYSTEM (title);
wv_title = make_widget_value (SSDATA (title), NULL, true, Qnil);
wv_title->title = TRUE;
wv_title->button_type = BUTTON_TYPE_NONE;
wv_title->next = wv_sep;
first_wv->contents = wv_title;
}
/* No selection has been chosen yet. */
menu_item_selection = 0;
/* Actually create the menu. */
current_popup_menu = menu = CreatePopupMenu ();
fill_in_menu (menu, first_wv->contents);
/* Adjust coordinates to be root-window-relative. */
pos.x = x;
pos.y = y;
ClientToScreen (FRAME_W32_WINDOW (f), &pos);
/* Display the menu. */
menu_item_selection = SendMessage (FRAME_W32_WINDOW (f),
WM_EMACS_TRACKPOPUPMENU,
(WPARAM)menu, (LPARAM)&pos);
/* Clean up extraneous mouse events which might have been generated
during the call. */
discard_mouse_events ();
FRAME_DISPLAY_INFO (f)->grabbed = 0;
/* Free the widget_value objects we used to specify the contents. */
free_menubar_widget_value_tree (first_wv);
DestroyMenu (menu);
/* Free the owner-drawn and help-echo menu strings. */
w32_free_menu_strings (FRAME_W32_WINDOW (f));
f->output_data.w32->menubar_active = 0;
/* Find the selected item, and its pane, to return
the proper value. */
if (menu_item_selection != 0)
{
Lisp_Object prefix, entry;
prefix = entry = Qnil;
i = 0;
while (i < menu_items_used)
{
if (EQ (AREF (menu_items, i), Qnil))
{
subprefix_stack[submenu_depth++] = prefix;
prefix = entry;
i++;
}
else if (EQ (AREF (menu_items, i), Qlambda))
{
prefix = subprefix_stack[--submenu_depth];
i++;
}
else if (EQ (AREF (menu_items, i), Qt))
{
prefix = AREF (menu_items, 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 (AREF (menu_items, i), Qquote))
i += 1;
else
{
entry = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
if (menu_item_selection == i)
{
if (menuflags & MENU_KEYMAPS)
{
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);
}
unblock_input ();
return entry;
}
i += MENU_ITEMS_ITEM_LENGTH;
}
}
}
else if (!(menuflags & MENU_FOR_CLICK))
{
unblock_input ();
/* Make "Cancel" equivalent to C-g. */
Fsignal (Qquit, Qnil);
}
unblock_input ();
return Qnil;
}
Lisp_Object
get_doc_string (Lisp_Object filepos, int unibyte, int definition)
{
char *from, *to;
register int fd;
register char *name;
register char *p, *p1;
EMACS_INT minsize;
EMACS_INT offset, position;
Lisp_Object file, tem;
if (INTEGERP (filepos))
{
file = Vdoc_file_name;
position = XINT (filepos);
}
else if (CONSP (filepos))
{
file = XCAR (filepos);
position = XINT (XCDR (filepos));
}
else
return Qnil;
if (position < 0)
position = - position;
if (!STRINGP (Vdoc_directory))
return Qnil;
if (!STRINGP (file))
return Qnil;
/* Put the file name in NAME as a C string.
If it is relative, combine it with Vdoc_directory. */
tem = Ffile_name_absolute_p (file);
if (NILP (tem))
{
minsize = SCHARS (Vdoc_directory);
/* sizeof ("../etc/") == 8 */
if (minsize < 8)
minsize = 8;
name = (char *) alloca (minsize + SCHARS (file) + 8);
strcpy (name, SSDATA (Vdoc_directory));
strcat (name, SSDATA (file));
}
else
{
name = SSDATA (file);
}
fd = emacs_open (name, O_RDONLY, 0);
if (fd < 0)
{
#ifndef CANNOT_DUMP
if (!NILP (Vpurify_flag))
{
/* Preparing to dump; DOC file is probably not installed.
So check in ../etc. */
strcpy (name, "../etc/");
strcat (name, SSDATA (file));
fd = emacs_open (name, O_RDONLY, 0);
}
#endif
if (fd < 0)
error ("Cannot open doc string file \"%s\"", name);
}
/* Seek only to beginning of disk block. */
/* Make sure we read at least 1024 bytes before `position'
so we can check the leading text for consistency. */
offset = min (position, max (1024, position % (8 * 1024)));
if (0 > lseek (fd, position - offset, 0))
{
emacs_close (fd);
error ("Position %"pI"d out of range in doc string file \"%s\"",
position, name);
}
/* Read the doc string into get_doc_string_buffer.
P points beyond the data just read. */
p = get_doc_string_buffer;
while (1)
{
EMACS_INT space_left = (get_doc_string_buffer_size
- (p - get_doc_string_buffer));
int nread;
/* Allocate or grow the buffer if we need to. */
if (space_left == 0)
{
EMACS_INT in_buffer = p - get_doc_string_buffer;
get_doc_string_buffer_size += 16 * 1024;
get_doc_string_buffer
= (char *) xrealloc (get_doc_string_buffer,
get_doc_string_buffer_size + 1);
p = get_doc_string_buffer + in_buffer;
space_left = (get_doc_string_buffer_size
- (p - get_doc_string_buffer));
}
/* Read a disk block at a time.
If we read the same block last time, maybe skip this? */
if (space_left > 1024 * 8)
space_left = 1024 * 8;
nread = emacs_read (fd, p, space_left);
if (nread < 0)
{
emacs_close (fd);
error ("Read error on documentation file");
}
p[nread] = 0;
if (!nread)
break;
if (p == get_doc_string_buffer)
p1 = strchr (p + offset, '\037');
else
p1 = strchr (p, '\037');
if (p1)
{
*p1 = 0;
p = p1;
break;
}
p += nread;
}
emacs_close (fd);
/* Sanity checking. */
if (CONSP (filepos))
{
int test = 1;
if (get_doc_string_buffer[offset - test++] != ' ')
return Qnil;
while (get_doc_string_buffer[offset - test] >= '0'
&& get_doc_string_buffer[offset - test] <= '9')
test++;
if (get_doc_string_buffer[offset - test++] != '@'
|| get_doc_string_buffer[offset - test] != '#')
return Qnil;
}
else
{
int test = 1;
if (get_doc_string_buffer[offset - test++] != '\n')
return Qnil;
while (get_doc_string_buffer[offset - test] > ' ')
test++;
if (get_doc_string_buffer[offset - test] != '\037')
return Qnil;
}
/* Scan the text and perform quoting with ^A (char code 1).
^A^A becomes ^A, ^A0 becomes a null char, and ^A_ becomes a ^_. */
from = get_doc_string_buffer + offset;
to = get_doc_string_buffer + offset;
while (from != p)
{
if (*from == 1)
{
int c;
from++;
c = *from++;
if (c == 1)
*to++ = c;
else if (c == '0')
*to++ = 0;
else if (c == '_')
*to++ = 037;
else
{
unsigned char uc = c;
error ("\
Invalid data in documentation file -- %c followed by code %03o",
1, uc);
}
}
else
*to++ = *from++;
}
/* If DEFINITION, read from this buffer
the same way we would read bytes from a file. */
if (definition)
{
read_bytecode_pointer = (unsigned char *) get_doc_string_buffer + offset;
return Fread (Qlambda);
}
if (unibyte)
return make_unibyte_string (get_doc_string_buffer + offset,
to - (get_doc_string_buffer + offset));
else
{
/* The data determines whether the string is multibyte. */
EMACS_INT nchars =
multibyte_chars_in_text (((unsigned char *) get_doc_string_buffer
+ offset),
to - (get_doc_string_buffer + offset));
return make_string_from_bytes (get_doc_string_buffer + offset,
nchars,
to - (get_doc_string_buffer + offset));
}
}
static int
init_gnutls_functions (Lisp_Object libraries)
{
HMODULE library;
int max_log_level = 1;
if (!(library = w32_delayed_load (libraries, Qgnutls_dll)))
{
GNUTLS_LOG (1, max_log_level, "GnuTLS library not found");
return 0;
}
LOAD_GNUTLS_FN (library, gnutls_alert_get);
LOAD_GNUTLS_FN (library, gnutls_alert_get_name);
LOAD_GNUTLS_FN (library, gnutls_alert_send_appropriate);
LOAD_GNUTLS_FN (library, gnutls_anon_allocate_client_credentials);
LOAD_GNUTLS_FN (library, gnutls_anon_free_client_credentials);
LOAD_GNUTLS_FN (library, gnutls_bye);
LOAD_GNUTLS_FN (library, gnutls_certificate_allocate_credentials);
LOAD_GNUTLS_FN (library, gnutls_certificate_free_credentials);
LOAD_GNUTLS_FN (library, gnutls_certificate_get_peers);
LOAD_GNUTLS_FN (library, gnutls_certificate_set_verify_flags);
LOAD_GNUTLS_FN (library, gnutls_certificate_set_x509_crl_file);
LOAD_GNUTLS_FN (library, gnutls_certificate_set_x509_key_file);
LOAD_GNUTLS_FN (library, gnutls_certificate_set_x509_trust_file);
LOAD_GNUTLS_FN (library, gnutls_certificate_type_get);
LOAD_GNUTLS_FN (library, gnutls_certificate_verify_peers2);
LOAD_GNUTLS_FN (library, gnutls_credentials_set);
LOAD_GNUTLS_FN (library, gnutls_deinit);
LOAD_GNUTLS_FN (library, gnutls_dh_set_prime_bits);
LOAD_GNUTLS_FN (library, gnutls_error_is_fatal);
LOAD_GNUTLS_FN (library, gnutls_global_init);
LOAD_GNUTLS_FN (library, gnutls_global_set_log_function);
LOAD_GNUTLS_FN (library, gnutls_global_set_log_level);
LOAD_GNUTLS_FN (library, gnutls_global_set_mem_functions);
LOAD_GNUTLS_FN (library, gnutls_handshake);
LOAD_GNUTLS_FN (library, gnutls_init);
LOAD_GNUTLS_FN (library, gnutls_priority_set_direct);
LOAD_GNUTLS_FN (library, gnutls_record_check_pending);
LOAD_GNUTLS_FN (library, gnutls_record_recv);
LOAD_GNUTLS_FN (library, gnutls_record_send);
LOAD_GNUTLS_FN (library, gnutls_strerror);
LOAD_GNUTLS_FN (library, gnutls_transport_set_errno);
LOAD_GNUTLS_FN (library, gnutls_check_version);
/* We don't need to call gnutls_transport_set_lowat in GnuTLS 2.11.1
and later, and the function was removed entirely in 3.0.0. */
if (!fn_gnutls_check_version ("2.11.1"))
LOAD_GNUTLS_FN (library, gnutls_transport_set_lowat);
LOAD_GNUTLS_FN (library, gnutls_transport_set_ptr2);
LOAD_GNUTLS_FN (library, gnutls_transport_set_pull_function);
LOAD_GNUTLS_FN (library, gnutls_transport_set_push_function);
LOAD_GNUTLS_FN (library, gnutls_x509_crt_check_hostname);
LOAD_GNUTLS_FN (library, gnutls_x509_crt_deinit);
LOAD_GNUTLS_FN (library, gnutls_x509_crt_import);
LOAD_GNUTLS_FN (library, gnutls_x509_crt_init);
max_log_level = global_gnutls_log_level;
{
Lisp_Object name = CAR_SAFE (Fget (Qgnutls_dll, QCloaded_from));
GNUTLS_LOG2 (1, max_log_level, "GnuTLS library loaded:",
STRINGP (name) ? (const char *) SDATA (name) : "unknown");
}
return 1;
}
/* <anonymous:1957> */
obj_t BGl_zc3anonymousza31957ze3z83zz__modulez00(obj_t BgL_envz00_1663, obj_t BgL_portz00_1665)
{ AN_OBJECT;
{ /* Llib/module.scm 208 */
{ /* Llib/module.scm 209 */
obj_t BgL_namez00_1664;
BgL_namez00_1664 =
PROCEDURE_REF(BgL_envz00_1663,
(int)(((long)0)));
{
obj_t BgL_portz00_881;
BgL_portz00_881 = BgL_portz00_1665;
{ /* Llib/module.scm 209 */
obj_t BgL_abasez00_883;
{ /* Llib/module.scm 209 */
obj_t BgL_auxz00_2116;
if(
STRINGP(BgL_namez00_1664))
{ /* Llib/module.scm 209 */
BgL_auxz00_2116 = BgL_namez00_1664
; } else
{
obj_t BgL_auxz00_2119;
BgL_auxz00_2119 =
BGl_typezd2errorzd2zz__errorz00(BGl_string2330z00zz__modulez00,
BINT(((long)8050)), BGl_string2363z00zz__modulez00, BGl_string2355z00zz__modulez00, BgL_namez00_1664);
FAILURE(BgL_auxz00_2119,BFALSE,BFALSE);}
BgL_abasez00_883 =
BGl_dirnamez00zz__osz00(BgL_auxz00_2116); }
{ /* Llib/module.scm 210 */
obj_t BgL_g1846z00_884;
{ /* Llib/module.scm 217 */
obj_t BgL_auxz00_2124;
if(
INPUT_PORTP(BgL_portz00_881))
{ /* Llib/module.scm 217 */
BgL_auxz00_2124 = BgL_portz00_881
; } else
{
obj_t BgL_auxz00_2127;
BgL_auxz00_2127 =
BGl_typezd2errorzd2zz__errorz00(BGl_string2330z00zz__modulez00,
BINT(((long)8329)), BGl_string2363z00zz__modulez00, BGl_string2359z00zz__modulez00, BgL_portz00_881);
FAILURE(BgL_auxz00_2127,BFALSE,BFALSE);}
BgL_g1846z00_884 =
BGl_modulezd2readzd2accesszd2filezd2zz__modulez00(BgL_auxz00_2124); }
{
obj_t BgL_l1844z00_886;
BgL_l1844z00_886 = BgL_g1846z00_884;
BgL_zc3anonymousza31958ze3z83_887:
if(
PAIRP(BgL_l1844z00_886))
{ /* Llib/module.scm 217 */
{ /* Llib/module.scm 211 */
obj_t BgL_accessz00_889;
BgL_accessz00_889 =
CAR(BgL_l1844z00_886);
{ /* Llib/module.scm 211 */
obj_t BgL_infoz00_890;
if(
bigloo_strcmp(BgL_abasez00_883, BGl_string2339z00zz__modulez00))
{ /* Llib/module.scm 212 */
obj_t BgL_pairz00_1433;
if(
PAIRP(BgL_accessz00_889))
{ /* Llib/module.scm 212 */
BgL_pairz00_1433 = BgL_accessz00_889; } else
{
obj_t BgL_auxz00_2139;
BgL_auxz00_2139 =
BGl_typezd2errorzd2zz__errorz00(BGl_string2330z00zz__modulez00,
BINT(((long)8142)), BGl_string2364z00zz__modulez00, BGl_string2343z00zz__modulez00, BgL_accessz00_889);
FAILURE(BgL_auxz00_2139,BFALSE,BFALSE);}
BgL_infoz00_890 =
CDR(BgL_pairz00_1433); } else
{ /* Llib/module.scm 213 */
obj_t BgL_arg1963z00_894;
{ /* Llib/module.scm 215 */
obj_t BgL_pairz00_1434;
if(
PAIRP(BgL_accessz00_889))
{ /* Llib/module.scm 215 */
BgL_pairz00_1434 = BgL_accessz00_889; } else
{
obj_t BgL_auxz00_2146;
BgL_auxz00_2146 =
BGl_typezd2errorzd2zz__errorz00(BGl_string2330z00zz__modulez00,
BINT(((long)8224)), BGl_string2364z00zz__modulez00, BGl_string2343z00zz__modulez00, BgL_accessz00_889);
FAILURE(BgL_auxz00_2146,BFALSE,BFALSE);}
BgL_arg1963z00_894 =
CDR(BgL_pairz00_1434); }
{ /* Llib/module.scm 214 */
obj_t BgL_zc3anonymousza31965ze3z83_1659;
BgL_zc3anonymousza31965ze3z83_1659 =
make_fx_procedure(BGl_zc3anonymousza31965ze3z83zz__modulez00,
(int)(((long)1)),
(int)(((long)1)));
PROCEDURE_SET(BgL_zc3anonymousza31965ze3z83_1659,
(int)(((long)0)), BgL_abasez00_883);
{ /* Llib/module.scm 213 */
obj_t BgL_list1964z00_895;
BgL_list1964z00_895 =
MAKE_PAIR(BgL_arg1963z00_894, BNIL);
BgL_infoz00_890 =
BGl_mapz12z12zz__r4_control_features_6_9z00(BgL_zc3anonymousza31965ze3z83_1659, BgL_list1964z00_895); } } }
{ /* Llib/module.scm 216 */
obj_t BgL_arg1960z00_891;
{ /* Llib/module.scm 216 */
obj_t BgL_pairz00_1435;
if(
PAIRP(BgL_accessz00_889))
{ /* Llib/module.scm 216 */
BgL_pairz00_1435 = BgL_accessz00_889; } else
{
obj_t BgL_auxz00_2160;
BgL_auxz00_2160 =
BGl_typezd2errorzd2zz__errorz00(BGl_string2330z00zz__modulez00,
BINT(((long)8274)), BGl_string2364z00zz__modulez00, BGl_string2343z00zz__modulez00, BgL_accessz00_889);
FAILURE(BgL_auxz00_2160,BFALSE,BFALSE);}
BgL_arg1960z00_891 =
CAR(BgL_pairz00_1435); }
BGl_modulezd2addzd2accesszd2innerz12zc0zz__modulez00(BgL_arg1960z00_891, BgL_infoz00_890, BgL_abasez00_883); } } }
{
obj_t BgL_l1844z00_2166;
BgL_l1844z00_2166 =
CDR(BgL_l1844z00_886);
BgL_l1844z00_886 = BgL_l1844z00_2166;
goto BgL_zc3anonymousza31958ze3z83_887;} } else
{ /* Llib/module.scm 217 */
if(
NULLP(BgL_l1844z00_886))
{ /* Llib/module.scm 217 */
return BTRUE;} else
{ /* Llib/module.scm 217 */
return
BGl_errorz00zz__errorz00(BGl_string2365z00zz__modulez00, BGl_string2366z00zz__modulez00, BgL_l1844z00_886);} } } } } } } }
}
static void
smc_save_yourself_CB (SmcConn smcConn,
SmPointer clientData,
int saveType,
Bool shutdown,
int interactStyle,
Bool fast)
{
#define NR_PROPS 5
SmProp *props[NR_PROPS];
SmProp prop_ptr[NR_PROPS];
SmPropValue values[20], *vp;
int val_idx = 0, vp_idx = 0;
int props_idx = 0;
int i;
char *smid_opt, *chdir_opt = NULL;
Lisp_Object user_login_name = Fuser_login_name (Qnil);
/* Must have these. */
if (! STRINGP (Vinvocation_name) || ! STRINGP (user_login_name))
return;
/* How to start a new instance of Emacs. */
props[props_idx] = &prop_ptr[props_idx];
props[props_idx]->name = xstrdup (SmCloneCommand);
props[props_idx]->type = xstrdup (SmLISTofARRAY8);
props[props_idx]->num_vals = 1;
props[props_idx]->vals = &values[val_idx++];
props[props_idx]->vals[0].length = strlen (emacs_program);
props[props_idx]->vals[0].value = emacs_program;
++props_idx;
/* The name of the program. */
props[props_idx] = &prop_ptr[props_idx];
props[props_idx]->name = xstrdup (SmProgram);
props[props_idx]->type = xstrdup (SmARRAY8);
props[props_idx]->num_vals = 1;
props[props_idx]->vals = &values[val_idx++];
props[props_idx]->vals[0].length = SBYTES (Vinvocation_name);
props[props_idx]->vals[0].value = SDATA (Vinvocation_name);
++props_idx;
/* User id. */
props[props_idx] = &prop_ptr[props_idx];
props[props_idx]->name = xstrdup (SmUserID);
props[props_idx]->type = xstrdup (SmARRAY8);
props[props_idx]->num_vals = 1;
props[props_idx]->vals = &values[val_idx++];
props[props_idx]->vals[0].length = SBYTES (user_login_name);
props[props_idx]->vals[0].value = SDATA (user_login_name);
++props_idx;
char *cwd = get_current_dir_name ();
if (cwd)
{
props[props_idx] = &prop_ptr[props_idx];
props[props_idx]->name = xstrdup (SmCurrentDirectory);
props[props_idx]->type = xstrdup (SmARRAY8);
props[props_idx]->num_vals = 1;
props[props_idx]->vals = &values[val_idx++];
props[props_idx]->vals[0].length = strlen (cwd);
props[props_idx]->vals[0].value = cwd;
++props_idx;
}
/* How to restart Emacs. */
props[props_idx] = &prop_ptr[props_idx];
props[props_idx]->name = xstrdup (SmRestartCommand);
props[props_idx]->type = xstrdup (SmLISTofARRAY8);
/* /path/to/emacs, --smid=xxx --no-splash --chdir=dir ... */
if (INT_ADD_WRAPV (initial_argc, 3, &i))
memory_full (SIZE_MAX);
props[props_idx]->num_vals = i;
vp = xnmalloc (i, sizeof *vp);
props[props_idx]->vals = vp;
props[props_idx]->vals[vp_idx].length = strlen (emacs_program);
props[props_idx]->vals[vp_idx++].value = emacs_program;
smid_opt = xmalloc (strlen (SMID_OPT) + strlen (client_id) + 1);
strcpy (stpcpy (smid_opt, SMID_OPT), client_id);
props[props_idx]->vals[vp_idx].length = strlen (smid_opt);
props[props_idx]->vals[vp_idx++].value = smid_opt;
props[props_idx]->vals[vp_idx].length = strlen (NOSPLASH_OPT);
props[props_idx]->vals[vp_idx++].value = NOSPLASH_OPT;
if (cwd)
{
chdir_opt = xmalloc (strlen (CHDIR_OPT) + strlen (cwd) + 1);
strcpy (stpcpy (chdir_opt, CHDIR_OPT), cwd);
props[props_idx]->vals[vp_idx].length = strlen (chdir_opt);
props[props_idx]->vals[vp_idx++].value = chdir_opt;
}
for (i = 1; i < initial_argc; ++i)
{
props[props_idx]->vals[vp_idx].length = strlen (initial_argv[i]);
props[props_idx]->vals[vp_idx++].value = initial_argv[i];
}
++props_idx;
SmcSetProperties (smcConn, props_idx, props);
xfree (smid_opt);
xfree (chdir_opt);
xfree (cwd);
xfree (vp);
for (i = 0; i < props_idx; ++i)
{
xfree (props[i]->type);
xfree (props[i]->name);
}
/* See if we maybe shall interact with the user. */
if (interactStyle != SmInteractStyleAny
|| ! shutdown
|| saveType == SmSaveLocal
|| ! SmcInteractRequest (smcConn, SmDialogNormal, smc_interact_CB, 0))
{
/* No interaction, we are done saving ourself. */
SmcSaveYourselfDone (smcConn, True);
}
}
/* <anonymous:1965> */
obj_t BGl_zc3anonymousza31965ze3z83zz__modulez00(obj_t BgL_envz00_1666, obj_t BgL_fz00_1668)
{ AN_OBJECT;
{ /* Llib/module.scm 213 */
{ /* Llib/module.scm 214 */
obj_t BgL_abasez00_1667;
BgL_abasez00_1667 =
PROCEDURE_REF(BgL_envz00_1666,
(int)(((long)0)));
{
obj_t BgL_fz00_896;
BgL_fz00_896 = BgL_fz00_1668;
{
obj_t BgL_fz00_903;obj_t BgL_abasez00_904;
BgL_fz00_903 = BgL_fz00_896;
BgL_abasez00_904 = BgL_abasez00_1667;
if(
STRINGP(BgL_fz00_903))
{ /* Llib/module.scm 203 */
bool_t BgL_testz00_2175;
if(
bigloo_strcmp(BgL_fz00_903, BGl_string2367z00zz__modulez00))
{ /* Llib/module.scm 203 */
BgL_testz00_2175 = ((bool_t)1)
; } else
{ /* Llib/module.scm 203 */
unsigned char BgL_arg1972z00_909;obj_t BgL_arg1973z00_910;
{ /* Llib/module.scm 203 */
obj_t BgL_s2257z00_1669;
BgL_s2257z00_1669 = BgL_fz00_903;
{ /* Llib/module.scm 203 */
long BgL_l2259z00_1671;
BgL_l2259z00_1671 =
STRING_LENGTH(BgL_s2257z00_1669);
if(
BOUND_CHECK(((long)0), BgL_l2259z00_1671))
{ /* Llib/module.scm 203 */
BgL_arg1972z00_909 =
STRING_REF(BgL_s2257z00_1669, ((long)0)); } else
{
obj_t BgL_auxz00_2182;
BgL_auxz00_2182 =
BGl_indexzd2outzd2ofzd2boundszd2errorz00zz__errorz00(BGl_string2330z00zz__modulez00,
BINT(((long)7865)), BGl_string2368z00zz__modulez00,
BINT(((long)0)), BgL_s2257z00_1669);
FAILURE(BgL_auxz00_2182,BFALSE,BFALSE);} } }
BgL_arg1973z00_910 =
BGl_filezd2separatorzd2zz__osz00();
{ /* Llib/module.scm 203 */
unsigned char BgL_char2z00_1445;
{ /* Llib/module.scm 203 */
obj_t BgL_auxz00_2188;
if(
CHARP(BgL_arg1973z00_910))
{ /* Llib/module.scm 203 */
BgL_auxz00_2188 = BgL_arg1973z00_910
; } else
{
obj_t BgL_auxz00_2191;
BgL_auxz00_2191 =
BGl_typezd2errorzd2zz__errorz00(BGl_string2330z00zz__modulez00,
BINT(((long)7897)), BGl_string2369z00zz__modulez00, BGl_string2370z00zz__modulez00, BgL_arg1973z00_910);
FAILURE(BgL_auxz00_2191,BFALSE,BFALSE);}
BgL_char2z00_1445 =
CCHAR(BgL_auxz00_2188); }
BgL_testz00_2175 =
(BgL_arg1972z00_909==BgL_char2z00_1445); } }
if(BgL_testz00_2175)
{ /* Llib/module.scm 203 */
return BgL_fz00_903;} else
{ /* Llib/module.scm 204 */
obj_t BgL_auxz00_2197;
if(
STRINGP(BgL_abasez00_904))
{ /* Llib/module.scm 204 */
BgL_auxz00_2197 = BgL_abasez00_904
; } else
{
obj_t BgL_auxz00_2200;
BgL_auxz00_2200 =
BGl_typezd2errorzd2zz__errorz00(BGl_string2330z00zz__modulez00,
BINT(((long)7928)), BGl_string2369z00zz__modulez00, BGl_string2355z00zz__modulez00, BgL_abasez00_904);
FAILURE(BgL_auxz00_2200,BFALSE,BFALSE);}
return
BGl_makezd2filezd2namez00zz__osz00(BgL_auxz00_2197, BgL_fz00_903);} } else
{ /* Llib/module.scm 202 */
return BgL_fz00_903;} } } } }
}
widget_value *
digest_single_submenu (int start, int end, bool top_level_items)
{
widget_value *wv, *prev_wv, *save_wv, *first_wv;
int i;
int submenu_depth = 0;
widget_value **submenu_stack;
bool panes_seen = 0;
struct frame *f = XFRAME (Vmenu_updating_frame);
USE_SAFE_ALLOCA;
SAFE_NALLOCA (submenu_stack, 1, menu_items_used);
wv = make_widget_value ("menu", NULL, true, Qnil);
wv->button_type = BUTTON_TYPE_NONE;
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 (AREF (menu_items, i), Qnil))
{
submenu_stack[submenu_depth++] = save_wv;
save_wv = prev_wv;
prev_wv = 0;
i++;
}
else if (EQ (AREF (menu_items, i), Qlambda))
{
prev_wv = save_wv;
save_wv = submenu_stack[--submenu_depth];
i++;
}
else if (EQ (AREF (menu_items, 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 (AREF (menu_items, i), Qquote))
i += 1;
else if (EQ (AREF (menu_items, i), Qt))
{
/* Create a new pane. */
Lisp_Object pane_name;
const char *pane_string;
panes_seen = 1;
pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
/* TTY menus display menu items via tty_write_glyphs, which
will encode the strings as appropriate. */
if (!FRAME_TERMCAP_P (f))
{
#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)
? "" : SSDATA (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, ""))
{
/* Set value to 1 so update_submenu_strings can handle '@'. */
wv = make_widget_value (NULL, (char *) 1, true, Qnil);
if (save_wv)
save_wv->next = wv;
else
first_wv->contents = wv;
wv->lname = pane_name;
wv->button_type = BUTTON_TYPE_NONE;
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)
emacs_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);
/* TTY menu items and their descriptions will be encoded by
tty_write_glyphs. */
if (!FRAME_TERMCAP_P (f))
{
#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 = make_widget_value (NULL, NULL, !NILP (enable),
STRINGP (help) ? help : Qnil);
if (prev_wv)
prev_wv->next = wv;
else
save_wv->contents = wv;
wv->lname = item_name;
if (!NILP (descrip))
wv->lkey = descrip;
/* The intptr_t 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 *) (intptr_t) i : 0);
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
emacs_abort ();
wv->selected = !NILP (selected);
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;
first_wv = first_wv->contents;
xfree (wv);
}
SAFE_FREE ();
return first_wv;
}
void bgl_odbc_sql_set_connect_attr(SQLHANDLE dbc,
obj_t attribute,
obj_t value)
{
SQLRETURN v;
SQLUINTEGER uintval = 0;
SQLPOINTER valueptr = 0;
SQLINTEGER stringlength = 0;
SQLINTEGER attr = 0;
if(0 == strcmp(BSTRING_TO_STRING(SYMBOL_TO_STRING(attribute)), "access-mode"))
{
attr = SQL_ATTR_ACCESS_MODE;
if(0 == strcmp(BSTRING_TO_STRING(SYMBOL_TO_STRING(attribute)), "read-only"))
{
uintval = SQL_MODE_READ_ONLY;
valueptr = (SQLPOINTER)uintval;
}
else if(0 == strcmp(BSTRING_TO_STRING(SYMBOL_TO_STRING(attribute)), "read-write"))
{
uintval = SQL_MODE_READ_WRITE;
valueptr = (SQLPOINTER)uintval;
}
else
{
odbc_error("bgl_odbc_sql_set_connect_attr",
"Invalid attribute value",
MAKE_PAIR(attribute, value));
}
}
else if(0 == strcmp(BSTRING_TO_STRING(SYMBOL_TO_STRING(attribute)), "asynch-enable"))
{
attr = SQL_ATTR_ASYNC_ENABLE;
if(TRUEP( value ))
{
uintval = SQL_ASYNC_ENABLE_ON;
valueptr = (SQLPOINTER)uintval;
}
else
{
uintval = SQL_ASYNC_ENABLE_OFF;
valueptr = (SQLPOINTER)uintval;
}
}
else if(0 == strcmp(BSTRING_TO_STRING(SYMBOL_TO_STRING(attribute)), "auto-ipd"))
{
attr = SQL_ATTR_AUTO_IPD;
if(TRUEP( value ))
{
uintval = SQL_TRUE;
valueptr = (SQLPOINTER)uintval;
}
else
{
uintval = SQL_FALSE;
valueptr = (SQLPOINTER)uintval;
}
}
else if(0 == strcmp(BSTRING_TO_STRING(SYMBOL_TO_STRING(attribute)), "autocommit"))
{
attr = SQL_ATTR_AUTOCOMMIT;
if(TRUEP( value ))
{
uintval = SQL_AUTOCOMMIT_OFF;
valueptr = (SQLPOINTER)uintval;
}
else
{
uintval = SQL_AUTOCOMMIT_ON;
valueptr = (SQLPOINTER)uintval;
}
}
else if(0 == strcmp(BSTRING_TO_STRING(SYMBOL_TO_STRING(attribute)), "connection-timeout"))
{
attr = SQL_ATTR_CONNECTION_TIMEOUT;
if(INTEGERP( value ))
{
uintval = CINT(value);
valueptr = (SQLPOINTER)uintval;
}
else
{
odbc_error("bgl_odbc_sql_set_connect_attr",
"Invalid attribute value",
MAKE_PAIR(attribute, value));
}
}
else if(0 == strcmp(BSTRING_TO_STRING(SYMBOL_TO_STRING(attribute)), "login-timeout"))
{
attr = SQL_ATTR_LOGIN_TIMEOUT;
if(INTEGERP( value ))
{
uintval = CINT(value);
valueptr = (SQLPOINTER)uintval;
}
else
{
odbc_error("bgl_odbc_sql_set_connect_attr",
"Invalid attribute value",
MAKE_PAIR(attribute, value));
}
}
else if(0 == strcmp(BSTRING_TO_STRING(SYMBOL_TO_STRING(attribute)), "current-catalog"))
{
attr = SQL_ATTR_CURRENT_CATALOG;
if(STRINGP( value ))
{
valueptr = (SQLPOINTER)BSTRING_TO_STRING(value);
stringlength = strlen(BSTRING_TO_STRING(value));
}
else
{
odbc_error("bgl_odbc_sql_set_connect_attr",
"Invalid attribute value",
MAKE_PAIR(attribute, value));
}
}
else if(0 == strcmp(BSTRING_TO_STRING(SYMBOL_TO_STRING(attribute)), "metadata-id"))
{
attr = SQL_ATTR_METADATA_ID;
if(TRUEP( value ))
{
uintval = SQL_TRUE;
valueptr = (SQLPOINTER)uintval;
}
else
{
uintval = SQL_FALSE;
valueptr = (SQLPOINTER)uintval;
}
}
else if(0 == strcmp(BSTRING_TO_STRING(SYMBOL_TO_STRING(attribute)), "odbc-cursor"))
{
attr = SQL_ATTR_ODBC_CURSORS;
if(0 == strcmp(BSTRING_TO_STRING(SYMBOL_TO_STRING(attribute)), "use-if-needed"))
{
uintval = SQL_CUR_USE_IF_NEEDED;
valueptr = (SQLPOINTER)uintval;
}
else if(0 == strcmp(BSTRING_TO_STRING(SYMBOL_TO_STRING(attribute)), "use-odbc"))
{
uintval = SQL_CUR_USE_ODBC;
valueptr = (SQLPOINTER)uintval;
}
else if(0 == strcmp(BSTRING_TO_STRING(SYMBOL_TO_STRING(attribute)), "use-driver"))
{
uintval = SQL_CUR_USE_DRIVER;
valueptr = (SQLPOINTER)uintval;
}
else
{
odbc_error("bgl_odbc_sql_set_connect_attr",
"Invalid attribute value",
MAKE_PAIR(attribute, value));
}
}
else
{
odbc_error("bgl_odbc_sql_set_connect_attr",
"Invalid Or Unsupported attribute",
MAKE_PAIR(attribute, value));
}
v = SQLSetConnectAttr(dbc,
attr,
valueptr,
stringlength);
if(!SQL_SUCCEEDED(v))
{
report_odbc_error("bgl_odbc_sql_set_connect_attr",
SQL_HANDLE_DBC,
dbc);
}
}
