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; }