Mercurial > hg > xemacs-beta
changeset 2588:e88115bd840e
[xemacs-hg @ 2005-02-15 03:20:35 by ben]
Remove mistakenly added files
| author | ben |
|---|---|
| date | Tue, 15 Feb 2005 03:20:36 +0000 |
| parents | 1e2a3710564c |
| children | 55aea5392882 |
| files | src/console-xlike.h src/event-xlike.c src/gccache-x.c src/gccache-xlike-inc.c src/intl-gtk.c src/objects-xlike-inc.c src/ui-gtk-inc.c |
| diffstat | 7 files changed, 0 insertions(+), 2101 deletions(-) [+] |
line wrap: on
line diff
--- a/src/console-xlike.h Tue Feb 15 03:17:08 2005 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,51 +0,0 @@ -/* Shared event code between X and GTK. - Copyright (C) 2003, 2005 Ben Wing. - -This file is part of XEmacs. - -XEmacs is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 2, or (at your option) any -later version. - -XEmacs is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ - -/* Synched up with: Not in FSF. */ - -#ifndef INCLUDED_console_xlike_h_ -#define INCLUDED_console_xlike_h_ - -#include <X11/Xlib.h> - -struct xlike_event_key_data -{ - int MetaMask, HyperMask, SuperMask, AltMask, ModeMask; - KeySym lock_interpretation; - - XModifierKeymap *x_modifier_keymap; - - KeySym *x_keysym_map; - int x_keysym_map_min_code; - int x_keysym_map_max_code; - int x_keysym_map_keysyms_per_code; - Lisp_Object x_keysym_map_hash_table; -}; - -void xlike_init_modifier_mapping (struct device *d, - struct xlike_event_key_data *xd); -void xlike_reset_key_mapping (struct device *d, - struct xlike_event_key_data *xd); -void xlike_reset_modifier_mapping (struct device *d, - struct xlike_event_key_data *xd); -void free_xlike_event_key_data (struct xlike_event_key_data *xd); -Lisp_Object xlike_keysym_to_emacs_keysym (long keysym, int simple_p); - -#endif /* INCLUDED_console_xlike_h_ */
--- a/src/event-xlike.c Tue Feb 15 03:17:08 2005 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,664 +0,0 @@ -/* Shared event code between X and GTK. - Copyright (C) 1991-5, 1997 Free Software Foundation, Inc. - Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 1996, 2001, 2002, 2003 Ben Wing. - -This file is part of XEmacs. - -XEmacs is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 2, or (at your option) any -later version. - -XEmacs is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ - -/* Synched up with: Not in FSF. */ - -#include <config.h> -#include "lisp.h" - -#include "charset.h" -#include "elhash.h" -#include "events.h" - -#ifdef HAVE_GTK -#include "console-gtk-impl.h" -#include <gdk/gdkx.h> -#endif -/* Unfortunately GTK currently needs to use some X-specific stuff so we - can't conditionalize the following on HAVE_X_WINDOWS, like we should. - - #### BILL!!! Fix this please! */ -#include "console-x-impl.h" - -#include "device-impl.h" - -#include "toolbar-common.h" - -Lisp_Object Qkey_mapping; -Lisp_Object Qsans_modifiers; - - -/************************************************************************/ -/* keymap handling */ -/************************************************************************/ - -/* X bogusly doesn't define the interpretations of any bits besides - ModControl, ModShift, and ModLock; so the Interclient Communication - Conventions Manual says that we have to bend over backwards to figure - out what the other modifier bits mean. According to ICCCM: - - - Any keycode which is assigned ModControl is a "control" key. - - - Any modifier bit which is assigned to a keycode which generates Meta_L - or Meta_R is the modifier bit meaning "meta". Likewise for Super, Hyper, - etc. - - - Any keypress event which contains ModControl in its state should be - interpreted as a "control" character. - - - Any keypress event which contains a modifier bit in its state which is - generated by a keycode whose corresponding keysym is Meta_L or Meta_R - should be interpreted as a "meta" character. Likewise for Super, Hyper, - etc. - - - It is illegal for a keysym to be associated with more than one modifier - bit. - - This means that the only thing that emacs can reasonably interpret as a - "meta" key is a key whose keysym is Meta_L or Meta_R, and which generates - one of the modifier bits Mod1-Mod5. - - Unfortunately, many keyboards don't have Meta keys in their default - configuration. So, if there are no Meta keys, but there are "Alt" keys, - emacs will interpret Alt as Meta. If there are both Meta and Alt keys, - then the Meta keys mean "Meta", and the Alt keys mean "Alt" (it used to - mean "Symbol," but that just confused the hell out of way too many people). - - This works with the default configurations of the 19 keyboard-types I've - checked. - - Emacs detects keyboard configurations which violate the above rules, and - prints an error message on the standard-error-output. (Perhaps it should - use a pop-up-window instead.) - */ - -static Display * -xlike_device_to_display (struct device *d) -{ -#ifdef HAVE_GTK - if (DEVICE_GTK_P (d)) - return GDK_DISPLAY (); -#endif /* HAVE_GTK */ -#ifdef HAVE_X_WINDOWS - if (DEVICE_GTK_P (d)) - return DEVICE_X_DISPLAY (d); -#endif /* HAVE_X_WINDOWS */ - ABORT (); - return NULL; -} - -/* For every key on the keyboard that has a known character correspondence, - we define the ascii-character property of the keysym, and make the - default binding for the key be self-insert-command. - - The following magic is basically intimate knowledge of X11/keysymdef.h. - The keysym mappings defined by X11 are based on the iso8859 standards, - except for Cyrillic and Greek. - - In a non-Mule world, a user can still have a multi-lingual editor, by doing - (set-face-font "...-iso8859-2" (current-buffer)) - for all their Latin-2 buffers, etc. */ - -static Lisp_Object -x_keysym_to_character (KeySym keysym) -{ -#ifdef MULE - Lisp_Object charset = Qzero; -#define USE_CHARSET(var,cs) \ - ((var) = charset_by_leading_byte (LEADING_BYTE_##cs)) -#else -#define USE_CHARSET(var,lb) -#endif /* MULE */ - int code = 0; - - if ((keysym & 0xff) < 0xa0) - return Qnil; - - switch (keysym >> 8) - { - case 0: /* ASCII + Latin1 */ - USE_CHARSET (charset, LATIN_ISO8859_1); - code = keysym & 0x7f; - break; - case 1: /* Latin2 */ - USE_CHARSET (charset, LATIN_ISO8859_2); - code = keysym & 0x7f; - break; - case 2: /* Latin3 */ - USE_CHARSET (charset, LATIN_ISO8859_3); - code = keysym & 0x7f; - break; - case 3: /* Latin4 */ - USE_CHARSET (charset, LATIN_ISO8859_4); - code = keysym & 0x7f; - break; - case 4: /* Katakana */ - USE_CHARSET (charset, KATAKANA_JISX0201); - if ((keysym & 0xff) > 0xa0) - code = keysym & 0x7f; - break; - case 5: /* Arabic */ - USE_CHARSET (charset, ARABIC_ISO8859_6); - code = keysym & 0x7f; - break; - case 6: /* Cyrillic */ - { - static unsigned char const cyrillic[] = /* 0x20 - 0x7f */ - {0x00, 0x72, 0x73, 0x71, 0x74, 0x75, 0x76, 0x77, - 0x78, 0x79, 0x7a, 0x7b, 0x7c, 0x00, 0x7e, 0x7f, - 0x70, 0x22, 0x23, 0x21, 0x24, 0x25, 0x26, 0x27, - 0x28, 0x29, 0x2a, 0x2b, 0x2c, 0x00, 0x2e, 0x2f, - 0x6e, 0x50, 0x51, 0x66, 0x54, 0x55, 0x64, 0x53, - 0x65, 0x58, 0x59, 0x5a, 0x5b, 0x5c, 0x5d, 0x5e, - 0x5f, 0x6f, 0x60, 0x61, 0x62, 0x63, 0x56, 0x52, - 0x6c, 0x6b, 0x57, 0x68, 0x6d, 0x69, 0x67, 0x6a, - 0x4e, 0x30, 0x31, 0x46, 0x34, 0x35, 0x44, 0x33, - 0x45, 0x38, 0x39, 0x3a, 0x3b, 0x3c, 0x3d, 0x3e, - 0x3f, 0x4f, 0x40, 0x41, 0x42, 0x43, 0x36, 0x32, - 0x4c, 0x4b, 0x37, 0x48, 0x4d, 0x49, 0x47, 0x4a}; - USE_CHARSET (charset, CYRILLIC_ISO8859_5); - code = cyrillic[(keysym & 0x7f) - 0x20]; - break; - } - case 7: /* Greek */ - { - static unsigned char const greek[] = /* 0x20 - 0x7f */ - {0x00, 0x36, 0x38, 0x39, 0x3a, 0x5a, 0x00, 0x3c, - 0x3e, 0x5b, 0x00, 0x3f, 0x00, 0x00, 0x35, 0x2f, - 0x00, 0x5c, 0x5d, 0x5e, 0x5f, 0x7a, 0x40, 0x7c, - 0x7d, 0x7b, 0x60, 0x7e, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x41, 0x42, 0x43, 0x44, 0x45, 0x46, 0x47, - 0x48, 0x49, 0x4a, 0x4b, 0x4c, 0x4d, 0x4e, 0x4f, - 0x50, 0x51, 0x53, 0x00, 0x54, 0x55, 0x56, 0x57, - 0x58, 0x59, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x61, 0x62, 0x63, 0x64, 0x65, 0x66, 0x67, - 0x68, 0x69, 0x6a, 0x6b, 0x6c, 0x6d, 0x6e, 0x6f, - 0x70, 0x71, 0x73, 0x72, 0x74, 0x75, 0x76, 0x77, - 0x78, 0x79, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; - USE_CHARSET (charset, GREEK_ISO8859_7); - code = greek[(keysym & 0x7f) - 0x20]; - break; - } - case 8: /* Technical */ - break; - case 9: /* Special */ - break; - case 10: /* Publishing */ - break; - case 11: /* APL */ - break; - case 12: /* Hebrew */ - USE_CHARSET (charset, HEBREW_ISO8859_8); - code = keysym & 0x7f; - break; - case 13: /* Thai */ - /* #### This needs to deal with character composition. */ - USE_CHARSET (charset, THAI_TIS620); - code = keysym & 0x7f; - break; - case 14: /* Korean Hangul */ - break; - case 19: /* Latin 9 - ISO8859-15 - unsupported charset. */ - break; - case 32: /* Currency */ - break; - default: - break; - } - - if (code == 0) - return Qnil; - -#ifdef MULE - return make_char (make_ichar (charset, code, 0)); -#else - return make_char (code + 0x80); -#endif -} - -/* See comment near character_to_event(). -*/ -static void -maybe_define_x_key_as_self_inserting_character (KeySym keysym, - Lisp_Object symbol) -{ - Lisp_Object character = x_keysym_to_character (keysym); - - if (CHARP (character)) - { - extern Lisp_Object Vcurrent_global_map; - extern Lisp_Object Qascii_character; - if (NILP (Flookup_key (Vcurrent_global_map, symbol, Qnil))) - { - Fput (symbol, Qascii_character, character); - Fdefine_key (Vcurrent_global_map, symbol, Qself_insert_command); - } - } -} - -/* Currently, GDK keysyms are exactly like X keysyms. If this ever - changes, we should rewrite this, but currently there's no point. */ - -Lisp_Object -xlike_keysym_to_emacs_keysym (long keysym, int simple_p) -{ - Ibyte *name; - if (keysym >= XK_exclam && keysym <= XK_asciitilde) - /* We must assume that the X keysym numbers for the ASCII graphic - characters are the same as their ASCII codes. */ - return make_char (keysym); - - switch (keysym) - { - /* These would be handled correctly by the default case, but by - special-casing them here we don't garbage a string or call - intern(). */ - case XK_BackSpace: return QKbackspace; - case XK_Tab: return QKtab; - case XK_Linefeed: return QKlinefeed; - case XK_Return: return QKreturn; - case XK_Escape: return QKescape; - case XK_space: return QKspace; - case XK_Delete: return QKdelete; - case 0: return Qnil; - default: - if (simple_p) return Qnil; - name = NEW_EXTERNAL_TO_C_STRING (XKeysymToString (keysym), - Qx_keysym_encoding); - if (!name || !name[0]) - /* This happens if there is a mismatch between the Xlib of - XEmacs and the Xlib of the X server... - - Let's hard-code in some knowledge of common keysyms introduced - in recent X11 releases. Snarfed from X11/keysymdef.h - - Probably we should add some stuff here for X11R6. */ - switch (keysym) - { - case 0xFF95: return KEYSYM ("kp-home"); - case 0xFF96: return KEYSYM ("kp-left"); - case 0xFF97: return KEYSYM ("kp-up"); - case 0xFF98: return KEYSYM ("kp-right"); - case 0xFF99: return KEYSYM ("kp-down"); - case 0xFF9A: return KEYSYM ("kp-prior"); - case 0xFF9B: return KEYSYM ("kp-next"); - case 0xFF9C: return KEYSYM ("kp-end"); - case 0xFF9D: return KEYSYM ("kp-begin"); - case 0xFF9E: return KEYSYM ("kp-insert"); - case 0xFF9F: return KEYSYM ("kp-delete"); - - case 0x1005FF10: return KEYSYM ("SunF36"); /* labeled F11 */ - case 0x1005FF11: return KEYSYM ("SunF37"); /* labeled F12 */ - default: - { - Ascbyte buf[64]; - sprintf (buf, "unknown-keysym-0x%X", (int) keysym); - return KEYSYM (buf); - } - } - /* If it's got a one-character name, that's good enough. */ - if (!* (name + itext_ichar_len (name))) - return make_char (itext_ichar (name)); - - /* If it's in the "Keyboard" character set, downcase it. - The case of those keysyms is too totally random for us to - force anyone to remember them. - The case of the other character sets is significant, however. - */ - if ((((unsigned int) keysym) & (~0x1FF)) == ((unsigned int) 0xFE00)) - { - Ibyte *buf, *s1; - - IBYTE_STRING_TO_ALLOCA (name, buf); - for (s1 = buf; *s1; s1++) - if (*s1 == '_') - *s1 = '-'; - return LISP_STRING_TO_KEYSYM (Fdowncase (build_intstring (buf), - Qnil)); - } - return KEYSYM ((CIbyte *) name); - } -} - -static void -xlike_has_keysym (KeySym keysym, Lisp_Object hash_table, int with_modifiers) -{ - KeySym upper_lower[2]; - int j; - - if (keysym < 0x80) /* Optimize for ASCII keysyms */ - return; - - /* If you execute: - xmodmap -e 'keysym NN = scaron' - and then press (Shift scaron), X11 will return the different - keysym `Scaron', but `xmodmap -pke' might not even mention `Scaron'. - So we "register" both `scaron' and `Scaron'. */ -#ifdef HAVE_XCONVERTCASE - XConvertCase (keysym, &upper_lower[0], &upper_lower[1]); -#else - upper_lower[0] = upper_lower[1] = keysym; -#endif - - for (j = 0; j < (upper_lower[0] == upper_lower[1] ? 1 : 2); j++) - { - Extbyte *name = XKeysymToString (keysym); - keysym = upper_lower[j]; - - if (name) - { - /* X guarantees NAME to be in the Host Portable Character Encoding */ - Lisp_Object sym = xlike_keysym_to_emacs_keysym (keysym, 0); - Lisp_Object new_value = with_modifiers ? Qt : Qsans_modifiers; - Lisp_Object old_value = Fgethash (sym, hash_table, Qnil); - - if (! EQ (old_value, new_value) - && ! (EQ (old_value, Qsans_modifiers) && - EQ (new_value, Qt))) - { - maybe_define_x_key_as_self_inserting_character (keysym, sym); - Fputhash (build_ext_string (name, Qx_keysym_encoding), new_value, - hash_table); - Fputhash (sym, new_value, hash_table); - } - } - } -} - -void -xlike_reset_key_mapping (struct device *d, struct xlike_event_key_data *xd) -{ - KeySym *keysym, *keysym_end; - Lisp_Object hash_table; - int key_code_count, keysyms_per_code; - Display *display = xlike_device_to_display (d); - - if (xd->x_keysym_map) - XFree ((char *) xd->x_keysym_map); - XDisplayKeycodes (display, - &xd->x_keysym_map_min_code, - &xd->x_keysym_map_max_code); - key_code_count = xd->x_keysym_map_max_code - xd->x_keysym_map_min_code + 1; - xd->x_keysym_map = - (KeySym *) - XGetKeyboardMapping (display, xd->x_keysym_map_min_code, key_code_count, - &xd->x_keysym_map_keysyms_per_code); - - hash_table = xd->x_keysym_map_hash_table; - if (HASH_TABLEP (hash_table)) - Fclrhash (hash_table); - else - xd->x_keysym_map_hash_table = hash_table = - make_lisp_hash_table (128, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL); - - for (keysym = xd->x_keysym_map, - keysyms_per_code = xd->x_keysym_map_keysyms_per_code, - keysym_end = keysym + (key_code_count * keysyms_per_code); - keysym < keysym_end; - keysym += keysyms_per_code) - { - int j; - if (keysym[0] == NoSymbol) - continue; - - xlike_has_keysym (keysym[0], hash_table, 0); - - for (j = 1; j < keysyms_per_code; j++) - { - if (keysym[j] != keysym[0] && - keysym[j] != NoSymbol) - xlike_has_keysym (keysym[j], hash_table, 1); - } - } -} - -static const char * -index_to_name (int indice) -{ - switch (indice) - { - case ShiftMapIndex: return "ModShift"; - case LockMapIndex: return "ModLock"; - case ControlMapIndex: return "ModControl"; - case Mod1MapIndex: return "Mod1"; - case Mod2MapIndex: return "Mod2"; - case Mod3MapIndex: return "Mod3"; - case Mod4MapIndex: return "Mod4"; - case Mod5MapIndex: return "Mod5"; - default: return "???"; - } -} - -/* Boy, I really wish C had local functions... */ -struct c_doesnt_have_closures /* #### not yet used */ -{ - int warned_about_overlapping_modifiers; - int warned_about_predefined_modifiers; - int warned_about_duplicate_modifiers; - int meta_bit; - int hyper_bit; - int super_bit; - int alt_bit; - int mode_bit; -}; - -void -xlike_reset_modifier_mapping (struct device *d, - struct xlike_event_key_data *xd) -{ - int modifier_index, modifier_key, column, mkpm; - int warned_about_overlapping_modifiers = 0; - int warned_about_predefined_modifiers = 0; - int warned_about_duplicate_modifiers = 0; - int meta_bit = 0; - int hyper_bit = 0; - int super_bit = 0; - int alt_bit = 0; - int mode_bit = 0; - Display *display = xlike_device_to_display (d); - - xd->lock_interpretation = 0; - - if (xd->x_modifier_keymap) - XFreeModifiermap (xd->x_modifier_keymap); - - xlike_reset_key_mapping (d, xd); - - xd->x_modifier_keymap = (XModifierKeymap *) XGetModifierMapping (display); - - /* Boy, I really wish C had local functions... - */ - - /* The call to warn_when_safe must be on the same line as the string or - make-msgfile won't pick it up properly (the newline doesn't confuse - it, but the backslash does). */ - -#define modwarn(name,old,other) \ - warn_when_safe (Qkey_mapping, Qwarning, "XEmacs: %s (0x%x) generates %s, which is generated by %s.", \ - name, code, index_to_name (old), other), \ - warned_about_overlapping_modifiers = 1 - -#define modbarf(name,other) \ - warn_when_safe (Qkey_mapping, Qwarning, "XEmacs: %s (0x%x) generates %s, which is nonsensical.", \ - name, code, other), \ - warned_about_predefined_modifiers = 1 - -#define check_modifier(name,mask) \ - if ((1<<modifier_index) != mask) \ - warn_when_safe (Qkey_mapping, Qwarning, "XEmacs: %s (0x%x) generates %s, which is nonsensical.", \ - name, code, index_to_name (modifier_index)), \ - warned_about_predefined_modifiers = 1 - -#define store_modifier(name,old) \ - if (old && old != modifier_index) \ - warn_when_safe (Qkey_mapping, Qwarning, "XEmacs: %s (0x%x) generates both %s and %s, which is nonsensical.",\ - name, code, index_to_name (old), \ - index_to_name (modifier_index)), \ - warned_about_duplicate_modifiers = 1; \ - if (modifier_index == ShiftMapIndex) modbarf (name,"ModShift"); \ - else if (modifier_index == LockMapIndex) modbarf (name,"ModLock"); \ - else if (modifier_index == ControlMapIndex) modbarf (name,"ModControl"); \ - else if (sym == XK_Mode_switch) \ - mode_bit = modifier_index; /* Mode_switch is special, see below... */ \ - else if (modifier_index == meta_bit && old != meta_bit) \ - modwarn (name, meta_bit, "Meta"); \ - else if (modifier_index == super_bit && old != super_bit) \ - modwarn (name, super_bit, "Super"); \ - else if (modifier_index == hyper_bit && old != hyper_bit) \ - modwarn (name, hyper_bit, "Hyper"); \ - else if (modifier_index == alt_bit && old != alt_bit) \ - modwarn (name, alt_bit, "Alt"); \ - else \ - old = modifier_index; - - mkpm = (xd->x_modifier_keymap)->max_keypermod; - for (modifier_index = 0; modifier_index < 8; modifier_index++) - for (modifier_key = 0; modifier_key < mkpm; modifier_key++) { - KeySym last_sym = 0; - for (column = 0; column < 4; column += 2) { - KeyCode code = - (xd->x_modifier_keymap) - ->modifiermap[modifier_index * mkpm + modifier_key]; - KeySym sym = (code ? XKeycodeToKeysym (display, code, column) : 0); - if (sym == last_sym) continue; - last_sym = sym; - switch (sym) { - case XK_Mode_switch:store_modifier ("Mode_switch", mode_bit); break; - case XK_Meta_L: store_modifier ("Meta_L", meta_bit); break; - case XK_Meta_R: store_modifier ("Meta_R", meta_bit); break; - case XK_Super_L: store_modifier ("Super_L", super_bit); break; - case XK_Super_R: store_modifier ("Super_R", super_bit); break; - case XK_Hyper_L: store_modifier ("Hyper_L", hyper_bit); break; - case XK_Hyper_R: store_modifier ("Hyper_R", hyper_bit); break; - case XK_Alt_L: store_modifier ("Alt_L", alt_bit); break; - case XK_Alt_R: store_modifier ("Alt_R", alt_bit); break; - case XK_Control_L: check_modifier ("Control_L", ControlMask); break; - case XK_Control_R: check_modifier ("Control_R", ControlMask); break; - case XK_Shift_L: check_modifier ("Shift_L", ShiftMask); break; - case XK_Shift_R: check_modifier ("Shift_R", ShiftMask); break; - case XK_Shift_Lock: check_modifier ("Shift_Lock", LockMask); - xd->lock_interpretation = XK_Shift_Lock; break; - case XK_Caps_Lock: check_modifier ("Caps_Lock", LockMask); - xd->lock_interpretation = XK_Caps_Lock; break; - - /* It probably doesn't make any sense for a modifier bit to be - assigned to a key that is not one of the above, but OpenWindows - assigns modifier bits to a couple of random function keys for - no reason that I can discern, so printing a warning here would - be annoying. */ - } - } - } -#undef store_modifier -#undef check_modifier -#undef modwarn -#undef modbarf - - /* If there was no Meta key, then try using the Alt key instead. - If there is both a Meta key and an Alt key, then the Alt key - is not disturbed and remains an Alt key. */ - if (! meta_bit && alt_bit) - meta_bit = alt_bit, alt_bit = 0; - - /* mode_bit overrides everything, since it's processed down inside of - XLookupString() instead of by us. If Meta and Mode_switch both - generate the same modifier bit (which is an error), then we don't - interpret that bit as Meta, because we can't make XLookupString() - not interpret it as Mode_switch; and interpreting it as both would - be totally wrong. */ - if (mode_bit) - { - const char *warn = 0; - if (mode_bit == meta_bit) warn = "Meta", meta_bit = 0; - else if (mode_bit == hyper_bit) warn = "Hyper", hyper_bit = 0; - else if (mode_bit == super_bit) warn = "Super", super_bit = 0; - else if (mode_bit == alt_bit) warn = "Alt", alt_bit = 0; - if (warn) - { - warn_when_safe - (Qkey_mapping, Qwarning, - "XEmacs: %s is being used for both Mode_switch and %s.", - index_to_name (mode_bit), warn), - warned_about_overlapping_modifiers = 1; - } - } -#undef index_to_name - - xd->MetaMask = (meta_bit ? (1 << meta_bit) : 0); - xd->HyperMask = (hyper_bit ? (1 << hyper_bit) : 0); - xd->SuperMask = (super_bit ? (1 << super_bit) : 0); - xd->AltMask = (alt_bit ? (1 << alt_bit) : 0); - xd->ModeMask = (mode_bit ? (1 << mode_bit) : 0); /* unused */ - - if (warned_about_overlapping_modifiers) - warn_when_safe (Qkey_mapping, Qwarning, "\n" -" Two distinct modifier keys (such as Meta and Hyper) cannot generate\n" -" the same modifier bit, because Emacs won't be able to tell which\n" -" modifier was actually held down when some other key is pressed. It\n" -" won't be able to tell Meta-x and Hyper-x apart, for example. Change\n" -" one of these keys to use some other modifier bit. If you intend for\n" -" these keys to have the same behavior, then change them to have the\n" -" same keysym as well as the same modifier bit."); - - if (warned_about_predefined_modifiers) - warn_when_safe (Qkey_mapping, Qwarning, "\n" -" The semantics of the modifier bits ModShift, ModLock, and ModControl\n" -" are predefined. It does not make sense to assign ModControl to any\n" -" keysym other than Control_L or Control_R, or to assign any modifier\n" -" bits to the \"control\" keysyms other than ModControl. You can't\n" -" turn a \"control\" key into a \"meta\" key (or vice versa) by simply\n" -" assigning the key a different modifier bit. You must also make that\n" -" key generate an appropriate keysym (Control_L, Meta_L, etc)."); - - /* No need to say anything more for warned_about_duplicate_modifiers. */ - - if (warned_about_overlapping_modifiers || warned_about_predefined_modifiers) - warn_when_safe (Qkey_mapping, Qwarning, "\n" -" The meanings of the modifier bits Mod1 through Mod5 are determined\n" -" by the keysyms used to control those bits. Mod1 does NOT always\n" -" mean Meta, although some non-ICCCM-compliant programs assume that."); -} - -void -xlike_init_modifier_mapping (struct device *d, struct xlike_event_key_data *xd) -{ - xd->x_keysym_map_hash_table = Qnil; - xd->x_keysym_map = NULL; - xd->x_modifier_keymap = NULL; - xlike_reset_modifier_mapping (d, xd); -} - -void -free_xlike_event_key_data (struct xlike_event_key_data *xd) -{ - if (xd->x_modifier_keymap) - XFreeModifiermap (xd->x_modifier_keymap); - if (xd->x_keysym_map) - XFree ((char *) xd->x_keysym_map); -} - -void -syms_of_event_xlike (void) -{ - DEFSYMBOL (Qkey_mapping); - DEFSYMBOL (Qsans_modifiers); -}
--- a/src/gccache-x.c Tue Feb 15 03:17:08 2005 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,26 +0,0 @@ -/* Efficient caching of GCs (graphics contexts) -- shared code, X and GTK. - Copyright (C) 1993 Free Software Foundation, Inc. - Copyright (C) 1994, 1995 Board of Trustees, University of Illinois. - Copyright (C) 2003 Ben Wing. - -This file is part of XEmacs. - -XEmacs is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 2, or (at your option) any -later version. - -XEmacs is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ - -/* Synched up with: Not in FSF. */ - -#define THIS_IS_X -#include "gccache-xlike-inc.c"
--- a/src/gccache-xlike-inc.c Tue Feb 15 03:17:08 2005 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,395 +0,0 @@ -/* Efficient caching of GCs (graphics contexts) -- shared code, X and GTK. - Copyright (C) 1993 Free Software Foundation, Inc. - Copyright (C) 1994, 1995 Board of Trustees, University of Illinois. - Copyright (C) 2003, 2005 Ben Wing. - -This file is part of XEmacs. - -XEmacs is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 2, or (at your option) any -later version. - -XEmacs is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ - -/* Synched up with: Not in FSF. */ - -/* Emacs uses a lot of different display attributes; for example, assume - that only four fonts are in use (normal, bold, italic, and bold-italic). - Then assume that one stipple or background is used for text selections, - and another is used for highlighting mousable regions. That makes 16 - GCs already. Add in the fact that another GC may be needed to display - the text cursor in any of those regions, and you've got 32. Add in - more fonts, and it keeps increasing exponentially. - - We used to keep these GCs in a cache of merged (fully qualified) faces. - However, a lot of other code in xterm.c used XChangeGC of existing GCs, - which is kind of slow and kind of random. Also, managing the face cache - was tricky because it was hard to know when a face was no longer visible - on the frame -- we had to mark all frames as garbaged whenever a face - was changed, which caused an unpleasant amount of flicker (since faces are - created/destroyed (= changed) whenever a frame is created/destroyed. - - So this code maintains a cache at the GC level instead of at the face - level. There is an upper limit on the size of the cache, after which we - will stop creating GCs and start reusing them (reusing the least-recently- - used ones first). So if faces get changed, their GCs will eventually be - recycled. Also more sharing of GCs is possible. - - This code uses hash tables. It could be that, if the cache size is small - enough, a linear search might be faster; but I doubt it, since we need - `equal' comparisons, not `eq', and I expect that the optimal cache size - will be ~100. - - Written by jwz, 14 jun 93 - Hacked by William Perry, apr 2000 for GTK and introduced code - duplication (a no-no) - Undid code duplication, Ben Wing, Jan 28, 2003. - */ - -#include <config.h> -#include "lisp.h" -#include "hash.h" - -#ifndef THIS_IS_GTK -#include <X11/Xlib.h> -#else /* THIS_IS_GTK */ -#include <gtk/gtk.h> -#endif /* THIS_IS_GTK */ - -#define GC_CACHE_SIZE 100 - -#define GCCACHE_HASH - -#ifndef THIS_IS_GTK -#define ZZGCVALUES XGCValues -#define ZZGC GC -#define ZZ(z) x_##z -#else -#define ZZGCVALUES GdkGCValues -#define ZZGC GdkGC * -#define ZZ(z) gtk_##z -#endif - -struct gcv_and_mask { - ZZGCVALUES gcv; - unsigned long mask; -}; - -struct gc_cache_cell { - ZZGC gc; - struct gcv_and_mask gcvm; - struct gc_cache_cell *prev, *next; -}; - -struct gc_cache { -#ifndef THIS_IS_GTK - Display *dpy; /* used only as arg to XCreateGC/XFreeGC */ - Window window; /* used only as arg to XCreateGC */ -#else /* THIS_IS_GTK */ - GdkWindow *window; /* used only as arg to XCreateGC */ -#endif /* THIS_IS_GTK */ - int size; - struct gc_cache_cell *head; - struct gc_cache_cell *tail; -#ifdef GCCACHE_HASH - struct hash_table *table; -#endif - - int create_count; - int delete_count; -}; - -#ifdef GCCACHE_HASH -static Hashcode -gc_cache_hash (const void *arg) -{ - const struct gcv_and_mask *gcvm = (const struct gcv_and_mask *) arg; - unsigned long *longs = (unsigned long *) &gcvm->gcv; - Hashcode hash = gcvm->mask; - int i; - /* This could look at the mask and only use the used slots in the - hash code. That would win in that we wouldn't have to initialize - every slot of the gcv when calling gc_cache_lookup. But we need - the hash function to be as fast as possible; some timings should - be done. */ - for (i = 0; i < (int) (sizeof (ZZGCVALUES) / - sizeof (unsigned long)); i++) - hash = (hash << 1) ^ *longs++; - return hash; -} - -#endif /* GCCACHE_HASH */ - -static int -gc_cache_eql (const void *arg1, const void *arg2) -{ - /* See comment in gc_cache_hash */ -#ifndef THIS_IS_GTK - return !memcmp (arg1, arg2, sizeof (struct gcv_and_mask)); -#else /* THIS_IS_GTK */ - const struct gcv_and_mask *gcvm1 = (const struct gcv_and_mask *) arg1; - const struct gcv_and_mask *gcvm2 = (const struct gcv_and_mask *) arg2; - - return !memcmp (&gcvm1->gcv, &gcvm2->gcv, sizeof (gcvm1->gcv)) - && gcvm1->mask == gcvm2->mask; -#endif /* THIS_IS_GTK */ -} - -struct gc_cache * -#ifndef THIS_IS_GTK -ZZ (make_gc_cache) (Display *dpy, Window window) -#else /* THIS_IS_GTK */ -ZZ (make_gc_cache) (GtkWidget *widget) -#endif /* THIS_IS_GTK */ -{ - struct gc_cache *cache = xnew (struct gc_cache); -#ifndef THIS_IS_GTK - cache->dpy = dpy; - cache->window = window; -#else /* THIS_IS_GTK */ - cache->window = widget->window; -#endif /* THIS_IS_GTK */ - cache->size = 0; - cache->head = cache->tail = 0; - cache->create_count = cache->delete_count = 0; -#ifdef GCCACHE_HASH - cache->table = - make_general_hash_table (GC_CACHE_SIZE, gc_cache_hash, gc_cache_eql); -#endif - return cache; -} - -void -ZZ (free_gc_cache) (struct gc_cache *cache) -{ - struct gc_cache_cell *rest, *next; - rest = cache->head; - while (rest) - { -#ifndef THIS_IS_GTK - XFreeGC (cache->dpy, rest->gc); -#else /* THIS_IS_GTK */ - gdk_gc_destroy (rest->gc); -#endif /* THIS_IS_GTK */ - next = rest->next; - xfree (rest, struct gc_cache_cell *); - rest = next; - } -#ifdef GCCACHE_HASH - free_hash_table (cache->table); -#endif - xfree (cache, struct gc_cache *); -} - -ZZGC -ZZ (gc_cache_lookup) (struct gc_cache *cache, ZZGCVALUES *gcv, unsigned long mask) -{ - struct gc_cache_cell *cell, *next, *prev; - struct gcv_and_mask gcvm; - - if ((!!cache->head) != (!!cache->tail)) ABORT (); - if (cache->head && (cache->head->prev || cache->tail->next)) ABORT (); - -#ifdef THIS_IS_GTK - /* Gdk does not have the equivalent of 'None' for the clip_mask, so - we need to check it carefully, or gdk_gc_new_with_values will - coredump */ - if ((mask & GDK_GC_CLIP_MASK) && !gcv->clip_mask) - mask = (GdkGCValuesMask) (mask & ~GDK_GC_CLIP_MASK); -#endif /* THIS_IS_GTK */ - - gcvm.mask = mask; - gcvm.gcv = *gcv; /* this copies... */ - -#ifdef GCCACHE_HASH - - if (gethash (&gcvm, cache->table, (const void **) &cell)) - -#else /* !GCCACHE_HASH */ - - cell = cache->tail; /* start at the end (most recently used) */ - while (cell) - { - if (gc_cache_eql (&gcvm, &cell->gcvm)) - break; - else - cell = cell->prev; - } - - /* #### This whole file needs some serious overhauling. */ -#ifndef THIS_IS_GTK - if (!(mask | GCTile) && cell->gc->values.tile) -#else /* THIS_IS_GTK */ - if (!(mask | GDK_GC_TILE) && cell->gcvm.gcv.tile) -#endif /* THIS_IS_GTK */ - cell = 0; -#ifndef THIS_IS_GTK - else if (!(mask | GCStipple) && cell->gc->values.stipple) -#else /* THIS_IS_GTK */ - else if (!(mask | GDK_GC_STIPPLE) && cell->gcvm.gcv.stipple) -#endif /* THIS_IS_GTK */ - cell = 0; - - if (cell) - -#endif /* !GCCACHE_HASH */ - - { - /* Found a cell. Move this cell to the end of the list, so that it - will be less likely to be collected than a cell that was accessed - less recently. - */ - if (cell == cache->tail) - return cell->gc; - - next = cell->next; - prev = cell->prev; - if (prev) prev->next = next; - if (next) next->prev = prev; - if (cache->head == cell) cache->head = next; - cell->next = 0; - cell->prev = cache->tail; - cache->tail->next = cell; - cache->tail = cell; - if (cache->head == cell) ABORT (); - if (cell->next) ABORT (); - if (cache->head->prev) ABORT (); - if (cache->tail->next) ABORT (); - return cell->gc; - } - - /* else, cache miss. */ - - if (cache->size == GC_CACHE_SIZE) - /* Reuse the first cell on the list (least-recently-used). - Remove it from the list, and unhash it from the table. - */ - { - cell = cache->head; - cache->head = cell->next; - cache->head->prev = 0; - if (cache->tail == cell) cache->tail = 0; /* only one */ -#ifndef THIS_IS_GTK - XFreeGC (cache->dpy, cell->gc); -#else /* THIS_IS_GTK */ - gdk_gc_destroy (cell->gc); -#endif /* THIS_IS_GTK */ - cache->delete_count++; -#ifdef GCCACHE_HASH - remhash (&cell->gcvm, cache->table); -#endif - } - else if (cache->size > GC_CACHE_SIZE) - ABORT (); - else - { - /* Allocate a new cell (don't put it in the list or table yet). */ - cell = xnew (struct gc_cache_cell); - cache->size++; - } - - /* Now we've got a cell (new or reused). Fill it in. */ - memcpy (&cell->gcvm.gcv, gcv, sizeof (ZZGCVALUES)); - cell->gcvm.mask = mask; - - /* Put the cell on the end of the list. */ - cell->next = 0; - cell->prev = cache->tail; - if (cache->tail) cache->tail->next = cell; - cache->tail = cell; - if (! cache->head) cache->head = cell; - - cache->create_count++; -#ifdef GCCACHE_HASH - /* Hash it in the table */ - puthash (&cell->gcvm, cell, cache->table); -#endif - - /* Now make and return the GC. */ -#ifndef THIS_IS_GTK - cell->gc = XCreateGC (cache->dpy, cache->window, mask, gcv); -#else /* THIS_IS_GTK */ - cell->gc = gdk_gc_new_with_values (cache->window, gcv, (GdkGCValuesMask) mask); -#endif /* THIS_IS_GTK */ - - /* debug */ - assert (cell->gc == ZZ (gc_cache_lookup) (cache, gcv, mask)); - - return cell->gc; -} -#ifndef THIS_IS_GTK - - -#ifdef DEBUG_XEMACS - -void x_describe_gc_cache (struct gc_cache *cache); -void -x_describe_gc_cache (struct gc_cache *cache) -{ - int count = 0; - struct gc_cache_cell *cell = cache->head; - stderr_out ("\nsize: %d", cache->size); - stderr_out ("\ncreated: %d", cache->create_count); - stderr_out ("\ndeleted: %d", cache->delete_count); - while (cell) - { - struct gc_cache_cell *cell2; - int i = 0; - stderr_out ("\n%d:\t0x%lx GC: 0x%08lx hash: 0x%08lx\n", - count, (long) cell, (long) cell->gc, gc_cache_hash (&cell->gcvm)); - for (cell2 = cache->head; cell2; cell2 = cell2->next, i++) - if (count != i && - gc_cache_hash (&cell->gcvm) == gc_cache_hash (&cell2->gcvm)) - stderr_out ("\tHASH COLLISION with cell %d\n", i); - stderr_out ("\tmask: %8lx\n", cell->gcvm.mask); - -#define FROB(field) do { \ - if ((int)cell->gcvm.gcv.field != (~0)) \ - stderr_out ("\t%-12s%8x\n", #field ":", (int)cell->gcvm.gcv.field); \ -} while (0) - FROB (function); - FROB (plane_mask); - FROB (foreground); - FROB (background); - FROB (line_width); - FROB (line_style); - FROB (cap_style); - FROB (join_style); - FROB (fill_style); - FROB (fill_rule); - FROB (arc_mode); - FROB (tile); - FROB (stipple); - FROB (ts_x_origin); - FROB (ts_y_origin); - FROB (font); - FROB (subwindow_mode); - FROB (graphics_exposures); - FROB (clip_x_origin); - FROB (clip_y_origin); - FROB (clip_mask); - FROB (dash_offset); -#undef FROB - - count++; - if (cell->next && cell == cache->tail) - stderr_out ("\nERROR! tail is here!\n\n"); - else if (!cell->next && cell != cache->tail) - stderr_out ("\nERROR! tail is not at the end\n\n"); - cell = cell->next; - } - if (count != cache->size) - stderr_out ("\nERROR! count should be %d\n\n", cache->size); -} - -#endif /* DEBUG_XEMACS */ -#endif /* ! THIS_IS_GTK */
--- a/src/intl-gtk.c Tue Feb 15 03:17:08 2005 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,54 +0,0 @@ -/* GTK internationalization functions. - Copyright (C) 2003 Ben Wing. - -This file is part of XEmacs. - -XEmacs is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 2, or (at your option) any -later version. - -XEmacs is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ - -/* Synched up with: Not in FSF. */ - -/* Authorship: - - Current primary author: Ben Wing <ben@xemacs.org> - */ - -#include <config.h> -#include "lisp.h" - -#include "console-gtk.h" - -/* As best as I can determine from reading the source code, all GTK strings - (gchar *) are UTF-8 in GTK V2, but locale-encoded in GTK V1.2. #### As - usual, the documentation on this is completely nonexistent. There may - well be different encodings for particular kinds of data, e.g. selection - data, drag-n-drop data, etc. --ben */ - -Lisp_Object Vgtk_text_encoding; - -void -vars_of_intl_gtk (void) -{ - staticpro (&Vgtk_text_encoding); -} - -void -init_intl_gtk (void) -{ - if (gtk_major_version >= 2) - Vgtk_text_encoding = Qutf_8; - else - Vgtk_text_encoding = Qnative; -}
--- a/src/objects-xlike-inc.c Tue Feb 15 03:17:08 2005 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,613 +0,0 @@ -/* Include file for common code, X and GTK colors and fonts. - Copyright (C) 1993, 1994 Free Software Foundation, Inc. - Copyright (C) 1995 Board of Trustees, University of Illinois. - Copyright (C) 1995 Tinker Systems. - Copyright (C) 1995, 1996, 2000, 2001, 2002, 2003, 2004, 2005 Ben Wing. - Copyright (C) 1995 Sun Microsystems, Inc. - -This file is part of XEmacs. - -XEmacs is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 2, or (at your option) any -later version. - -XEmacs is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ - -/* Synched up with: Not in FSF. */ - -/* Authors: Jamie Zawinski, Chuck Thompson, Ben Wing */ - -/* Extracted from objects-x.c, objects-gtk.c 2-13-05. - NOTE: There is an advantage to having the code coalesced this way - even when there is a fair amount of difference between the two versions, - provided that they are still parallel -- having them side by side ensures - that logic changes in one are propagated to the other, preventing bit-rot - --ben -*/ - -#ifndef THIS_IS_GTK -#define ZZCOLOR_TYPE XColor -#define ZZCOLOR_INSTANCE(name) COLOR_INSTANCE_X_##name -#define ZZ(z) x_##z -#define ZZEND(z) z##_x -#define ZZCONSOLE_HAS_METHOD(name) CONSOLE_HAS_METHOD (x, name) -#define UNUSED_IF_GTK(arg) arg -#else -#define ZZCOLOR_TYPE GdkColor -#define ZZCOLOR_INSTANCE(name) COLOR_INSTANCE_GTK_##name -#define ZZ(z) gtk_##z -#define ZZEND(z) z##_gtk -#define ZZCONSOLE_HAS_METHOD(name) CONSOLE_HAS_METHOD (gtk, name) -#define UNUSED_IF_GTK(arg) UNUSED (arg) -#endif - - -/************************************************************************/ -/* color instances */ -/************************************************************************/ - -static int -ZZ (parse_nearest_color) (struct device *d, ZZCOLOR_TYPE *color, - Lisp_Object name, Error_Behavior errb) -{ -#ifndef THIS_IS_GTK - Display *dpy = DEVICE_X_DISPLAY (d); - Colormap cmap = DEVICE_X_COLORMAP (d); - Visual *visual = DEVICE_X_VISUAL (d); -#else /* THIS_IS_GTK */ - GdkColormap *cmap = DEVICE_GTK_COLORMAP (d); - GdkVisual *visual = DEVICE_GTK_VISUAL (d); -#endif /* THIS_IS_GTK */ - int result; - - xzero (*color); - -#ifndef THIS_IS_GTK - result = - XParseColor (dpy, cmap, - NEW_LISP_STRING_TO_EXTERNAL (name, Qx_color_name_encoding), - color); -#else /* THIS_IS_GTK */ - result = gdk_color_parse (LISP_STRING_TO_GTK_TEXT (name), color); -#endif /* THIS_IS_GTK */ - if (!result) - { - maybe_signal_error (Qgui_error, "Unrecognized color", - name, Qcolor, errb); - return 0; - } -#ifndef THIS_IS_GTK - result = ZZ (allocate_nearest_color) (dpy, cmap, visual, color); -#else /* THIS_IS_GTK */ - result = ZZ (allocate_nearest_color) (cmap, visual, color); -#endif /* THIS_IS_GTK */ - if (!result) - { - maybe_signal_error (Qgui_error, "Couldn't allocate color", - name, Qcolor, errb); - return 0; - } - - return result; -} - -static int -ZZ (initialize_color_instance) (Lisp_Color_Instance *c, Lisp_Object name, - Lisp_Object device, Error_Behavior errb) -{ - ZZCOLOR_TYPE color; - int result; - - result = ZZ (parse_nearest_color) (XDEVICE (device), &color, 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 fucked. */ - c->data = xnew (struct ZZ (color_instance_data)); - if (result == 3) - ZZCOLOR_INSTANCE (DEALLOC) (c) = 0; - else - ZZCOLOR_INSTANCE (DEALLOC) (c) = 1; -#ifndef THIS_IS_GTK - ZZCOLOR_INSTANCE (COLOR) (c) = color; -#else /* THIS_IS_GTK */ - ZZCOLOR_INSTANCE (COLOR) (c) = gdk_color_copy (&color); -#endif /* THIS_IS_GTK */ - return 1; -} - -static void -ZZ (print_color_instance) (Lisp_Color_Instance *c, - Lisp_Object printcharfun, - int UNUSED (escapeflag)) -{ -#ifndef THIS_IS_GTK - XColor color = COLOR_INSTANCE_X_COLOR (c); - write_fmt_string (printcharfun, " %ld=(%X,%X,%X)", - color.pixel, color.red, color.green, color.blue); -#else /* THIS_IS_GTK */ - GdkColor *color = COLOR_INSTANCE_GTK_COLOR (c); - write_fmt_string (printcharfun, " %ld=(%X,%X,%X)", - color->pixel, color->red, color->green, color->blue); -#endif /* THIS_IS_GTK */ -} - -static void -ZZ (finalize_color_instance) (Lisp_Color_Instance *c) -{ - if (c->data) - { - if (DEVICE_LIVE_P (XDEVICE (c->device))) - { - if (ZZCOLOR_INSTANCE (DEALLOC) (c)) - { -#ifndef THIS_IS_GTK - XFreeColors (DEVICE_X_DISPLAY (XDEVICE (c->device)), - DEVICE_X_COLORMAP (XDEVICE (c->device)), - &COLOR_INSTANCE_X_COLOR (c).pixel, 1, 0); -#else /* THIS_IS_GTK */ - gdk_colormap_free_colors (DEVICE_GTK_COLORMAP - (XDEVICE (c->device)), - COLOR_INSTANCE_GTK_COLOR (c), 1); -#endif /* THIS_IS_GTK */ - } -#ifdef THIS_IS_GTK - gdk_color_free (COLOR_INSTANCE_GTK_COLOR (c)); -#endif /* THIS_IS_GTK */ - } - xfree (c->data, void *); - c->data = 0; - } -} - -/* Color instances are equal if they resolve to the same color on the - screen (have the same RGB values). I imagine that - "same RGB values" == "same cell in the colormap." Arguably we should - be comparing their names or pixel values instead. */ - -static int -ZZ (color_instance_equal) (Lisp_Color_Instance *c1, - Lisp_Color_Instance *c2, - int UNUSED (depth)) -{ -#ifndef THIS_IS_GTK - XColor color1 = COLOR_INSTANCE_X_COLOR (c1); - XColor color2 = COLOR_INSTANCE_X_COLOR (c2); - return ((color1.red == color2.red) && - (color1.green == color2.green) && - (color1.blue == color2.blue)); -#else /* THIS_IS_GTK */ - return (gdk_color_equal (COLOR_INSTANCE_GTK_COLOR (c1), - COLOR_INSTANCE_GTK_COLOR (c2))); -#endif /* THIS_IS_GTK */ -} - -static Hashcode -ZZ (color_instance_hash) (Lisp_Color_Instance *c, int UNUSED (depth)) -{ -#ifndef THIS_IS_GTK - XColor color = COLOR_INSTANCE_X_COLOR (c); - return HASH3 (color.red, color.green, color.blue); -#else /* THIS_IS_GTK */ - return (gdk_color_hash (COLOR_INSTANCE_GTK_COLOR (c), NULL)); -#endif /* THIS_IS_GTK */ -} - -static Lisp_Object -ZZ (color_instance_rgb_components) (Lisp_Color_Instance *c) -{ -#ifndef THIS_IS_GTK - XColor color = COLOR_INSTANCE_X_COLOR (c); - return (list3 (make_int (color.red), - make_int (color.green), - make_int (color.blue))); -#else /* THIS_IS_GTK */ - GdkColor *color = COLOR_INSTANCE_GTK_COLOR (c); - return (list3 (make_int (color->red), - make_int (color->green), - make_int (color->blue))); -#endif /* THIS_IS_GTK */ -} - -static int -ZZ (valid_color_name_p) (struct device *UNUSED_IF_GTK (d), Lisp_Object color) -{ -#ifndef THIS_IS_GTK - XColor c; - Display *dpy = DEVICE_X_DISPLAY (d); - Colormap cmap = DEVICE_X_COLORMAP (d); - const Extbyte *extname; - - LISP_STRING_TO_EXTERNAL (color, extname, Qx_color_name_encoding); - - return XParseColor (dpy, cmap, extname, &c); -#else /* THIS_IS_GTK */ - GdkColor c; - const Extbyte *extname; - - LISP_STRING_TO_EXTERNAL (color, extname, Vgtk_text_encoding); - - if (gdk_color_parse (extname, &c) != TRUE) - return 0; - return 1; -#endif /* THIS_IS_GTK */ -} - -static Lisp_Object -ZZ (color_list) (void) -{ -#ifdef THIS_IS_GTK - /* #### BILL!!! - Is this correct? */ -#endif /* THIS_IS_GTK */ - return call0 (intern ("x-color-list-internal")); -} - - -/************************************************************************/ -/* font instances */ -/************************************************************************/ - -static int -ZZ (initialize_font_instance) (Lisp_Font_Instance *f, - Lisp_Object UNUSED (name), - Lisp_Object UNUSED_IF_GTK (device), - Error_Behavior errb) -{ - XFontStruct *xf; - const Extbyte *extname; - -#ifndef THIS_IS_GTK - Display *dpy = DEVICE_X_DISPLAY (XDEVICE (device)); - - LISP_STRING_TO_EXTERNAL (f->name, extname, Qx_font_name_encoding); - xf = XLoadQueryFont (dpy, extname); - - if (!xf) - { - maybe_signal_error (Qgui_error, "Couldn't load font", f->name, - Qfont, errb); - return 0; - } - - if (!xf->max_bounds.width) - { - /* yes, this has been known to happen. */ - XFreeFont (dpy, xf); - maybe_signal_error (Qgui_error, "X font is too small", f->name, Qfont, - errb); - - return 0; - } - -#else /* THIS_IS_GTK */ - GdkFont *gf; - - LISP_STRING_TO_EXTERNAL (f->name, extname, Vgtk_text_encoding); - gf = gdk_font_load (extname); - - if (!gf) - { - maybe_signal_error (Qgui_error, "Couldn't load font", f->name, - Qfont, errb); - return 0; - } - - xf = (XFontStruct *) GDK_FONT_XFONT (gf); - -#endif /* THIS_IS_GTK */ - - /* Don't allocate the data until we're sure that we will succeed, - or the finalize method may get fucked. */ - -#ifndef THIS_IS_GTK - f->data = xnew (struct x_font_instance_data); - FONT_INSTANCE_X_FONT (f) = xf; - f->ascent = xf->ascent; - f->descent = xf->descent; - f->height = xf->ascent + xf->descent; -#else /* THIS_IS_GTK */ - f->data = xnew (struct gtk_font_instance_data); - FONT_INSTANCE_GTK_FONT (f) = gf; - f->ascent = gf->ascent; - f->descent = gf->descent; - f->height = gf->ascent + gf->descent; -#endif /* THIS_IS_GTK */ - - /* Now let's figure out the width of the font */ - - { - /* following change suggested by Ted Phelps <phelps@dstc.edu.au> */ - int def_char = 'n'; /*xf->default_char;*/ - int byte1, byte2; - - once_more: - byte1 = def_char >> 8; - byte2 = def_char & 0xFF; - - if (xf->per_char) - { - /* Old versions of the R5 font server have garbage (>63k) as - def_char. 'n' might not be a valid character. */ - if (byte1 < (int) xf->min_byte1 || - byte1 > (int) xf->max_byte1 || - byte2 < (int) xf->min_char_or_byte2 || - byte2 > (int) xf->max_char_or_byte2) - f->width = 0; - else - f->width = xf->per_char[(byte1 - xf->min_byte1) * - (xf->max_char_or_byte2 - - xf->min_char_or_byte2 + 1) + - (byte2 - xf->min_char_or_byte2)].width; - } - else - f->width = xf->max_bounds.width; - - /* Some fonts have a default char whose width is 0. This is no good. - If that's the case, first try 'n' as the default char, and if n has - 0 width too (unlikely) then just use the max width. */ - if (f->width == 0) - { - if (def_char == (int) xf->default_char) - f->width = xf->max_bounds.width; - else - { - def_char = xf->default_char; - goto once_more; - } - } - } - /* If all characters don't exist then there could potentially be - 0-width characters lurking out there. Not setting this flag - trips an optimization that would make them appear to have width - to redisplay. This is bad. So we set it if not all characters - have the same width or if not all characters are defined. - */ - /* #### This sucks. There is a measurable performance increase - when using proportional width fonts if this flag is not set. - Unfortunately so many of the fucking X fonts are not fully - defined that we could almost just get rid of this damn flag and - make it an assertion. */ - f->proportional_p = (xf->min_bounds.width != xf->max_bounds.width || - ( -#ifndef THIS_IS_GTK - x_handle_non_fully_specified_fonts && -#else /* THIS_IS_GTK */ - /* x_handle_non_fully_specified_fonts */ 0 && -#endif /* THIS_IS_GTK */ - !xf->all_chars_exist)); - -#if 0 /* THIS_IS_GTK */ - f->width = gdk_char_width (gf, 'n'); - f->proportional_p = (gdk_char_width (gf, '|') != gdk_char_width (gf, 'W')); -#endif - return 1; -} - -static void -ZZ (print_font_instance) (Lisp_Font_Instance *f, - Lisp_Object printcharfun, - int UNUSED (escapeflag)) -{ - write_fmt_string (printcharfun, " 0x%lx", -#ifndef THIS_IS_GTK - (unsigned long) FONT_INSTANCE_X_FONT (f)->fid); -#else /* THIS_IS_GTK */ - (unsigned long) gdk_font_id (FONT_INSTANCE_GTK_FONT (f))); -#endif /* THIS_IS_GTK */ -} - -static void -ZZ (finalize_font_instance) (Lisp_Font_Instance *f) -{ - if (f->data) - { - if (DEVICE_LIVE_P (XDEVICE (f->device))) - { -#ifndef THIS_IS_GTK - XFreeFont (DEVICE_X_DISPLAY (XDEVICE (f->device)), - FONT_INSTANCE_X_FONT (f)); -#else /* THIS_IS_GTK */ - gdk_font_unref (FONT_INSTANCE_GTK_FONT (f)); -#endif /* THIS_IS_GTK */ - } - xfree (f->data, void *); - f->data = 0; - } -} - -/* Unbounded, for sufficiently small values of infinity... */ -#define MAX_FONT_COUNT 5000 - -#ifndef THIS_IS_GTK -static Lisp_Object x_font_truename (Display *dpy, Extbyte *name, - XFontStruct *font); -#else -Lisp_Object __get_gtk_font_truename (GdkFont *gdk_font, int expandp); -#endif - -static Lisp_Object -ZZ (font_instance_truename) (Lisp_Font_Instance *f, Error_Behavior errb) -{ - if (NILP (FONT_INSTANCE_TRUENAME (f))) - { -#ifndef THIS_IS_GTK - FONT_INSTANCE_TRUENAME (f) = - x_font_truename (DEVICE_X_DISPLAY (XDEVICE (f->device)), - NEW_LISP_STRING_TO_EXTERNAL - (f->name, Qx_font_name_encoding), - FONT_INSTANCE_X_FONT (f)); -#else - FONT_INSTANCE_TRUENAME (f) = - __get_gtk_font_truename (FONT_INSTANCE_GTK_FONT (f), 1); -#endif /* THIS_IS_GTK */ - - if (NILP (FONT_INSTANCE_TRUENAME (f))) - { - Lisp_Object font_instance = wrap_font_instance (f); - - - maybe_signal_error (Qgui_error, "Couldn't determine font truename", - font_instance, Qfont, errb); - /* Ok, just this once, return the font name as the truename. - (This is only used by Fequal() right now.) */ - return f->name; - } - } - return FONT_INSTANCE_TRUENAME (f); -} - -#ifdef MULE - -static int -ZZ (font_spec_matches_charset) (struct device *UNUSED (d), Lisp_Object charset, - const Ibyte *nonreloc, Lisp_Object reloc, - Bytecount offset, Bytecount length, - int stage) -{ - if (stage) - return 0; - - if (UNBOUNDP (charset)) - return 1; - /* Hack! Short font names don't have the registry in them, - so we just assume the user knows what they're doing in the - case of ASCII. For other charsets, you gotta give the - long form; sorry buster. - */ - if (EQ (charset, Vcharset_ascii)) - { - const Ibyte *the_nonreloc = nonreloc; - int i; - Bytecount the_length = length; - - if (!the_nonreloc) - the_nonreloc = XSTRING_DATA (reloc); - fixup_internal_substring (nonreloc, reloc, offset, &the_length); - the_nonreloc += offset; - if (!memchr (the_nonreloc, '*', the_length)) - { - for (i = 0;; i++) - { - const Ibyte *new_nonreloc = (const Ibyte *) - memchr (the_nonreloc, '-', the_length); - if (!new_nonreloc) - break; - new_nonreloc++; - the_length -= new_nonreloc - the_nonreloc; - the_nonreloc = new_nonreloc; - } - - /* If it has less than 5 dashes, it's a short font. - Of course, long fonts always have 14 dashes or so, but short - fonts never have more than 1 or 2 dashes, so this is some - sort of reasonable heuristic. */ - if (i < 5) - return 1; - } - } - - return (fast_string_match (XCHARSET_REGISTRY (charset), - nonreloc, reloc, offset, length, 1, - ERROR_ME, 0) >= 0); -} - -/* find a font spec that matches font spec FONT and also matches - (the registry of) CHARSET. */ -static Lisp_Object -ZZ (find_charset_font) (Lisp_Object device, Lisp_Object font, - Lisp_Object charset, int stage) -{ -#ifdef THIS_IS_GTK - /* #### copied from x_find_charset_font */ - /* #### BILL!!! Try to make this go away eventually */ -#endif /* THIS_IS_GTK */ - Extbyte **names; - int count = 0; - Lisp_Object result = Qnil; - const Extbyte *patternext; - int i; - - if (stage) - return Qnil; - - LISP_STRING_TO_EXTERNAL (font, patternext, Qx_font_name_encoding); - - names = XListFonts ( -#ifndef THIS_IS_GTK - DEVICE_X_DISPLAY (XDEVICE (device)), -#else - GDK_DISPLAY (), -#endif - patternext, MAX_FONT_COUNT, &count); - /* #### This code seems awfully bogus -- mrb */ - for (i = 0; i < count; i ++) - { - const Ibyte *intname; - Bytecount intlen; - - EXTERNAL_TO_SIZED_C_STRING (names[i], intname, intlen, - Qx_font_name_encoding); - if (ZZ (font_spec_matches_charset) (XDEVICE (device), charset, - intname, Qnil, 0, -1, stage)) - { - result = make_string (intname, intlen); - break; - } - } - - if (names) - XFreeFontNames (names); - - /* Check for a short font name. */ - if (NILP (result) - && ZZ (font_spec_matches_charset) (XDEVICE (device), charset, 0, - font, 0, -1, stage)) - return font; - - return result; -} - -#endif /* MULE */ - - -/************************************************************************/ -/* initialization */ -/************************************************************************/ - -void -ZZEND (console_type_create_objects) (void) -{ - /* object methods */ - - ZZCONSOLE_HAS_METHOD (initialize_color_instance); - ZZCONSOLE_HAS_METHOD (print_color_instance); - ZZCONSOLE_HAS_METHOD (finalize_color_instance); - ZZCONSOLE_HAS_METHOD (color_instance_equal); - ZZCONSOLE_HAS_METHOD (color_instance_hash); - ZZCONSOLE_HAS_METHOD (color_instance_rgb_components); - ZZCONSOLE_HAS_METHOD (valid_color_name_p); - ZZCONSOLE_HAS_METHOD (color_list); - - ZZCONSOLE_HAS_METHOD (initialize_font_instance); - ZZCONSOLE_HAS_METHOD (print_font_instance); - ZZCONSOLE_HAS_METHOD (finalize_font_instance); - ZZCONSOLE_HAS_METHOD (font_instance_truename); - ZZCONSOLE_HAS_METHOD (font_instance_properties); - ZZCONSOLE_HAS_METHOD (font_list); -#ifdef MULE - ZZCONSOLE_HAS_METHOD (find_charset_font); - ZZCONSOLE_HAS_METHOD (font_spec_matches_charset); -#endif -}
--- a/src/ui-gtk-inc.c Tue Feb 15 03:17:08 2005 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,298 +0,0 @@ -/* ui-gtk-inc.c -** -** Description: Include file for duplicated code in ui-gtk.c -** -** Created by: William M. Perry <wmperry@gnu.org> -** Copyright (c) 2000 William M. Perry <wmperry@gnu.org> - Copyright (c) 2003 Ben Wing. -** -*/ - -#undef GTK_LVALUE - -#ifdef GTK_CONVERT_NORMAL -#define GTK_LVALUE(type) GTK_VALUE_##type (*arg) -#else -#define GTK_LVALUE(type) *(GTK_RETLOC_##type (*arg)) -#endif - -int -#ifdef GTK_CONVERT_NORMAL -lisp_to_gtk_type (Lisp_Object obj, GtkArg *arg) -#else -lisp_to_gtk_ret_type (Lisp_Object obj, GtkArg *arg) -#endif -{ - switch (GTK_FUNDAMENTAL_TYPE (arg->type)) - { - /* flag types */ - case GTK_TYPE_NONE: - return (0); - case GTK_TYPE_CHAR: - case GTK_TYPE_UCHAR: - CHECK_CHAR_COERCE_INT (obj); - GTK_LVALUE (CHAR) = ichar_to_unicode (XCHAR (obj)); - break; - case GTK_TYPE_BOOL: - GTK_LVALUE (BOOL) = NILP (obj) ? FALSE : TRUE; - break; - case GTK_TYPE_INT: - case GTK_TYPE_UINT: - if (NILP (obj) || EQ (Qt, obj)) - { - /* For we are a kind mistress and allow sending t/nil for - 1/0 to stupid GTK functions that say they take guint or - gint in the header files, but actually treat it like a - bool. *sigh* - */ - GTK_LVALUE (INT) = NILP (obj) ? 0 : 1; - } - else - { - CHECK_INT (obj); - GTK_LVALUE (INT) = XINT (obj); - } - break; - case GTK_TYPE_LONG: - case GTK_TYPE_ULONG: - ABORT (); - case GTK_TYPE_FLOAT: - CHECK_INT_OR_FLOAT (obj); - GTK_LVALUE (FLOAT) = extract_float (obj); - break; - case GTK_TYPE_DOUBLE: - CHECK_INT_OR_FLOAT (obj); - GTK_LVALUE (DOUBLE) = extract_float (obj); - break; - case GTK_TYPE_STRING: - if (NILP (obj)) - GTK_LVALUE (STRING) = NULL; - else - { - CHECK_STRING (obj); -#ifdef GTK_CONVERT_NORMAL - LISP_STRING_TO_EXTERNAL_MALLOC (obj, GTK_LVALUE (STRING), - Vgtk_text_encoding); -#else - /* #### BILL!! Is this correct? It followed the old logic */ - LISP_STRING_TO_EXTERNAL (obj, GTK_LVALUE (STRING), - Vgtk_text_encoding); -#endif - - } - break; - case GTK_TYPE_ENUM: - case GTK_TYPE_FLAGS: - /* Convert a lisp symbol to a GTK enum */ - GTK_LVALUE (ENUM) = lisp_to_flag (obj, arg->type); - break; - case GTK_TYPE_BOXED: - if (NILP (obj)) - { - GTK_LVALUE (BOXED) = NULL; - } - else if (GTK_BOXEDP (obj)) - { - GTK_LVALUE (BOXED) = XGTK_BOXED (obj)->object; - } - else if (arg->type == GTK_TYPE_STYLE) - { - obj = Ffind_face (obj); - CHECK_FACE (obj); - GTK_LVALUE (BOXED) = face_to_style (obj); - } - else if (arg->type == GTK_TYPE_GDK_GC) - { - obj = Ffind_face (obj); - CHECK_FACE (obj); - GTK_LVALUE (BOXED) = face_to_gc (obj); - } - else if (arg->type == GTK_TYPE_GDK_WINDOW) - { - if (GLYPHP (obj)) - { - Lisp_Object window = Fselected_window (Qnil); - Lisp_Object instance = - glyph_image_instance (obj, window, ERROR_ME_DEBUG_WARN, 1); - struct Lisp_Image_Instance *p = XIMAGE_INSTANCE (instance); - - switch (XIMAGE_INSTANCE_TYPE (instance)) - { - case IMAGE_TEXT: - case IMAGE_POINTER: - case IMAGE_SUBWINDOW: - case IMAGE_NOTHING: - GTK_LVALUE (BOXED) = NULL; - break; - - case IMAGE_MONO_PIXMAP: - case IMAGE_COLOR_PIXMAP: - GTK_LVALUE (BOXED) = IMAGE_INSTANCE_GTK_PIXMAP (p); - break; - } - } - else if (GTK_OBJECTP (obj) && - GTK_IS_WIDGET (XGTK_OBJECT (obj)->object)) - { - GTK_LVALUE (BOXED) = GTK_WIDGET (XGTK_OBJECT (obj))->window; - } - else - { - invalid_argument - ("Don't know how to convert object to GDK_WINDOW", obj); - } - break; - } - else if (arg->type == GTK_TYPE_GDK_COLOR) - { - if (COLOR_SPECIFIERP (obj)) - { - /* If it is a specifier, we just convert it to an - instance, and let the ifs below handle it. - */ - obj = Fspecifier_instance (obj, Qnil, Qnil, Qnil); - } - - if (COLOR_INSTANCEP (obj)) - { - /* Easiest one */ - GTK_LVALUE (BOXED) = - COLOR_INSTANCE_GTK_COLOR (XCOLOR_INSTANCE (obj)); - } - else if (STRINGP (obj)) - { - invalid_argument - ("Please use a color specifier or instance, not a string", - obj); - } - else - { - invalid_argument ("Don't know how to convert to GdkColor", obj); - } - } - else if (arg->type == GTK_TYPE_GDK_FONT) - { - if (SYMBOLP (obj)) - { - /* If it is a symbol, we treat that as a face name */ - obj = Ffind_face (obj); - } - - if (FACEP (obj)) - { - /* If it is a face, we just grab the font specifier, and - cascade down until we finally reach a FONT_INSTANCE - */ - obj = Fget (obj, Qfont, Qnil); - } - - if (FONT_SPECIFIERP (obj)) - { - /* If it is a specifier, we just convert it to an - instance, and let the ifs below handle it - */ - obj = Fspecifier_instance (obj, Qnil, Qnil, Qnil); - } - - if (FONT_INSTANCEP (obj)) - { - /* Easiest one */ - GTK_LVALUE (BOXED) = - FONT_INSTANCE_GTK_FONT (XFONT_INSTANCE (obj)); - } - else if (STRINGP (obj)) - { - invalid_argument - ("Please use a font specifier or instance, not a string", obj); - } - else - { - invalid_argument ("Don't know how to convert to GdkColor", obj); - } - } - else - { - /* Unknown type to convert to boxed */ - stderr_out ("Don't know how to convert to boxed!\n"); - GTK_LVALUE (BOXED) = NULL; - } - break; - - case GTK_TYPE_POINTER: - if (NILP (obj)) - GTK_LVALUE (POINTER) = NULL; - else - GTK_LVALUE (POINTER) = LISP_TO_VOID (obj); - break; - - /* structured types */ - case GTK_TYPE_SIGNAL: - case GTK_TYPE_ARGS: /* This we can do as a list of values */ - case GTK_TYPE_C_CALLBACK: - case GTK_TYPE_FOREIGN: - stderr_out ("Do not know how to convert `%s' from lisp!\n", - GTK_TEXT_TO_C_STRING (gtk_type_name (arg->type))); - return (-1); - -#if 0 - /* #### BILL! */ - /* #### This is not used, and GTK_RETLOC_CALLBACK does not exist */ - case GTK_TYPE_CALLBACK: - { - GUI_ID id; - - id = new_gui_id (); - obj = Fcons (Qnil, obj); /* Empty data */ - obj = Fcons (make_int (id), obj); - - gcpro_popup_callbacks (id, obj); - - GTK_LVALUE (CALLBACK).marshal = __internal_callback_marshal; - GTK_LVALUE (CALLBACK).data = LISP_TO_VOID (obj); - GTK_LVALUE (CALLBACK).notify = __internal_callback_destroy; - } - break; -#endif - - /* base type of the object system */ - case GTK_TYPE_OBJECT: - if (NILP (obj)) - GTK_LVALUE (OBJECT) = NULL; - else - { - CHECK_GTK_OBJECT (obj); - if (XGTK_OBJECT (obj)->alive_p) - GTK_LVALUE (OBJECT) = XGTK_OBJECT (obj)->object; - else - invalid_argument - ("Attempting to pass dead object to GTK function", obj); - } - break; - - default: - /* GTK_TYPE_ARRAY, GTK_TYPE_LISTOF not constants */ - if (GTK_FUNDAMENTAL_TYPE_EQ (arg->type, GTK_TYPE_ARRAY)) - { - if (NILP (obj)) - GTK_LVALUE (POINTER) = NULL; - else - xemacs_list_to_array (obj, arg); - } - else if (GTK_FUNDAMENTAL_TYPE_EQ (arg->type, GTK_TYPE_LISTOF)) - { - if (NILP (obj)) - GTK_LVALUE (POINTER) = NULL; - else - xemacs_list_to_gtklist (obj, arg); - } - else - { - stderr_out ("Do not know how to convert `%s' from lisp!\n", - GTK_TEXT_TO_C_STRING (gtk_type_name (arg->type))); - ABORT (); - } - break; - } - - return (0); -}