static int
gtk_initialize_color_instance (struct Lisp_Color_Instance *c, Lisp_Object name,
Lisp_Object device, Error_behavior errb)
{
GdkColor color;
int result;
result = gtk_parse_nearest_color (XDEVICE (device), &color,
XSTRING_DATA (name),
XSTRING_LENGTH (name),
errb);
if (!result)
return 0;
/* Don't allocate the data until we're sure that we will succeed,
or the finalize method may get f****d. */
c->data = xnew (struct gtk_color_instance_data);
if (result == 3)
COLOR_INSTANCE_GTK_DEALLOC (c) = 0;
else
COLOR_INSTANCE_GTK_DEALLOC (c) = 1;
COLOR_INSTANCE_GTK_COLOR (c) = gdk_color_copy (&color);
return 1;
}
Extbyte *add_accel_and_to_external(Lisp_Object string)
{
int i;
int found_accel = 0;
Extbyte *retval;
Bufbyte *name = XSTRING_DATA(string);
for (i = 0; name[i]; ++i)
if (name[i] == '%' && name[i + 1] == '_') {
found_accel = 1;
break;
}
if (found_accel)
LISP_STRING_TO_EXTERNAL_MALLOC(string, retval, Qlwlib_encoding);
else {
size_t namelen = XSTRING_LENGTH(string);
Bufbyte *chars = (Bufbyte *) alloca(namelen + 3);
chars[0] = '%';
chars[1] = '_';
memcpy(chars + 2, name, namelen + 1);
C_STRING_TO_EXTERNAL_MALLOC(chars, retval, Qlwlib_encoding);
}
return retval;
}
/* 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;
}
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;
}
EXTERNAL_PROPERTY_LIST_LOOP(list, keyword, value, search_plist)
{
/* Host */
if (EQ (keyword, Qhost))
{
CHECK_STRING (value);
ldap_host = alloca (XSTRING_LENGTH (value) + 1);
strcpy (ldap_host, (char *)XSTRING_DATA (value));
}
/* Filter */
else if (EQ (keyword, Qfilter))
{
CHECK_STRING (value);
ldap_filter = alloca (XSTRING_LENGTH (value) + 1);
strcpy (ldap_filter, (char *)XSTRING_DATA (value));
}
/* Attributes */
else if (EQ (keyword, Qattributes))
{
if (! NILP (value))
{
Lisp_Object attr_left = value;
struct gcpro ngcpro1;
NGCPRO1 (attr_left);
CHECK_CONS (value);
ldap_attributes = alloca ((XINT (Flength (value)) + 1)*sizeof (char *));
for (i=0; !NILP (attr_left); i++) {
CHECK_STRING (XCAR (attr_left));
ldap_attributes[i] = alloca (XSTRING_LENGTH (XCAR (attr_left)) + 1);
strcpy(ldap_attributes[i],
(char *)(XSTRING_DATA( XCAR (attr_left))));
attr_left = XCDR (attr_left);
}
ldap_attributes[i] = NULL;
NUNGCPRO;
}
}
/* Attributes Only */
else if (EQ (keyword, Qattrsonly))
{
CHECK_SYMBOL (value);
ldap_attrsonly = NILP (value) ? 0 : 1;
}
/* Base */
else if (EQ (keyword, Qbase))
{
if (!NILP (value))
{
CHECK_STRING (value);
ldap_base = alloca (XSTRING_LENGTH (value) + 1);
strcpy (ldap_base, (char *)XSTRING_DATA (value));
}
}
/* Scope */
else if (EQ (keyword, Qscope))
{
CHECK_SYMBOL (value);
if (EQ (value, Qbase))
ldap_scope = LDAP_SCOPE_BASE;
else if (EQ (value, Qonelevel))
ldap_scope = LDAP_SCOPE_ONELEVEL;
else if (EQ (value, Qsubtree))
ldap_scope = LDAP_SCOPE_SUBTREE;
else
signal_simple_error ("Invalid scope", value);
}
/* Authentication method */
else if (EQ (keyword, Qauth))
{
CHECK_SYMBOL (value);
if (EQ (value, Qsimple))
ldap_auth = LDAP_AUTH_SIMPLE;
#ifdef LDAP_AUTH_KRBV41
else if (EQ (value, Qkrbv41))
ldap_auth = LDAP_AUTH_KRBV41;
#endif
#ifdef LDAP_AUTH_KRBV42
else if (EQ (value, Qkrbv42))
ldap_auth = LDAP_AUTH_KRBV42;
#endif
else
signal_simple_error ("Invalid authentication method", value);
}
/* Bind DN */
else if (EQ (keyword, Qbinddn))
{
if (!NILP (value))
{
CHECK_STRING (value);
ldap_binddn = alloca (XSTRING_LENGTH (value) + 1);
strcpy (ldap_binddn, (char *)XSTRING_DATA (value));
}
}
/* Password */
else if (EQ (keyword, Qpasswd))
{
if (!NILP (value))
{
CHECK_STRING (value);
ldap_passwd = alloca (XSTRING_LENGTH (value) + 1);
strcpy (ldap_passwd, (char *)XSTRING_DATA (value));
}
}
/* Deref */
else if (EQ (keyword, Qderef))
{
CHECK_SYMBOL (value);
if (EQ (value, Qnever))
ldap_deref = LDAP_DEREF_NEVER;
else if (EQ (value, Qsearch))
ldap_deref = LDAP_DEREF_SEARCHING;
else if (EQ (value, Qfind))
ldap_deref = LDAP_DEREF_FINDING;
else if (EQ (value, Qalways))
ldap_deref = LDAP_DEREF_ALWAYS;
else
signal_simple_error ("Invalid deref value", value);
}
/* Timelimit */
else if (EQ (keyword, Qtimelimit))
{
if (!NILP (value))
{
CHECK_INT (value);
ldap_timelimit = XINT (value);
}
}
/* Sizelimit */
else if (EQ (keyword, Qsizelimit))
{
if (!NILP (value))
{
CHECK_INT (value);
ldap_sizelimit = XINT (value);
}
}
}
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;
}
static void
gtk_output_toolbar_button (struct frame *f, Lisp_Object button)
{
int shadow_thickness = 2;
int x_adj, y_adj, width_adj, height_adj;
GdkWindow *x_win = FRAME_GTK_TEXT_WIDGET (f)->window;
GdkGC *background_gc = get_toolbar_gc (f);
Lisp_Object instance, frame, window, glyph;
struct toolbar_button *tb = XTOOLBAR_BUTTON (button);
struct Lisp_Image_Instance *p;
struct window *w;
int vertical = tb->vertical;
int border_width = tb->border_width;
if (vertical)
{
x_adj = border_width;
width_adj = - 2 * border_width;
y_adj = 0;
height_adj = 0;
}
else
{
x_adj = 0;
width_adj = 0;
y_adj = border_width;
height_adj = - 2 * border_width;
}
XSETFRAME (frame, f);
window = FRAME_LAST_NONMINIBUF_WINDOW (f);
w = XWINDOW (window);
glyph = get_toolbar_button_glyph (w, tb);
if (tb->enabled)
{
if (tb->down)
{
shadow_thickness = -2;
}
else
{
shadow_thickness = 2;
}
}
else
{
shadow_thickness = 0;
}
background_gc = get_toolbar_gc (f);
/* Clear the entire area. */
gdk_draw_rectangle (x_win, background_gc, TRUE,
tb->x + x_adj,
tb->y + y_adj,
tb->width + width_adj,
tb->height + height_adj);
/* Draw the outline. */
if (shadow_thickness)
gtk_output_shadows (f, tb->x + x_adj, tb->y + y_adj,
tb->width + width_adj, tb->height + height_adj,
shadow_thickness);
/* Do the border. */
gdk_draw_rectangle (x_win, background_gc, TRUE, tb->x, tb->y,
(vertical ? border_width : tb->width),
(vertical ? tb->height : border_width));
gdk_draw_rectangle (x_win, background_gc, TRUE,
(vertical ? tb->x + tb->width - border_width : tb->x),
(vertical ? tb->y : tb->y + tb->height - border_width),
(vertical ? border_width : tb->width),
(vertical ? tb->height : border_width));
background_gc = get_toolbar_gc (f);
/* #### It is currently possible for users to trash us by directly
changing the toolbar glyphs. Avoid crashing in that case. */
if (GLYPHP (glyph))
instance = glyph_image_instance (glyph, window, ERROR_ME_NOT, 1);
else
instance = Qnil;
if (IMAGE_INSTANCEP (instance))
{
int width = tb->width + width_adj - shadow_thickness * 2;
int height = tb->height + height_adj - shadow_thickness * 2;
int x_offset = x_adj + shadow_thickness;
int y_offset = y_adj + shadow_thickness;
p = XIMAGE_INSTANCE (instance);
if (IMAGE_INSTANCE_PIXMAP_TYPE_P (p))
{
if (width > (int) IMAGE_INSTANCE_PIXMAP_WIDTH (p))
{
x_offset += ((int) (width - IMAGE_INSTANCE_PIXMAP_WIDTH (p))
/ 2);
width = IMAGE_INSTANCE_PIXMAP_WIDTH (p);
}
if (height > (int) IMAGE_INSTANCE_PIXMAP_HEIGHT (p))
{
y_offset += ((int) (height - IMAGE_INSTANCE_PIXMAP_HEIGHT (p))
/ 2);
height = IMAGE_INSTANCE_PIXMAP_HEIGHT (p);
}
gtk_output_gdk_pixmap (f, XIMAGE_INSTANCE (instance), tb->x + x_offset,
tb->y + y_offset, 0, 0, 0, 0, width, height,
0, 0, 0, background_gc);
}
else if (IMAGE_INSTANCE_TYPE (p) == IMAGE_TEXT)
{
/* #### We need to make the face used configurable. */
struct face_cachel *cachel =
WINDOW_FACE_CACHEL (w, DEFAULT_INDEX);
struct display_line dl;
Lisp_Object string = IMAGE_INSTANCE_TEXT_STRING (p);
unsigned char charsets[NUM_LEADING_BYTES];
Emchar_dynarr *buf;
struct font_metric_info fm;
/* This could be true if we were called via the Expose event
handler. Mark the button as dirty and return
immediately. */
if (f->window_face_cache_reset)
{
tb->dirty = 1;
MARK_TOOLBAR_CHANGED;
return;
}
buf = Dynarr_new (Emchar);
convert_bufbyte_string_into_emchar_dynarr
(XSTRING_DATA (string), XSTRING_LENGTH (string), buf);
find_charsets_in_emchar_string (charsets, Dynarr_atp (buf, 0),
Dynarr_length (buf));
ensure_face_cachel_complete (cachel, window, charsets);
face_cachel_charset_font_metric_info (cachel, charsets, &fm);
dl.ascent = fm.ascent;
dl.descent = fm.descent;
dl.ypos = tb->y + y_offset + fm.ascent;
if (fm.ascent + fm.descent <= height)
{
dl.ypos += (height - fm.ascent - fm.descent) / 2;
dl.clip = 0;
}
else
{
dl.clip = fm.ascent + fm.descent - height;
}
gtk_output_string (w, &dl, buf, tb->x + x_offset, 0, 0, width,
DEFAULT_INDEX, 0, 0, 0, 0);
Dynarr_free (buf);
}
/* We silently ignore the image if it isn't a pixmap or text. */
}
tb->dirty = 0;
}
