static Lisp_Object
fchdir_unwind (Lisp_Object dir_fd)
{
(void) fchdir (XFASTINT (dir_fd));
(void) close (XFASTINT (dir_fd));
return Qnil;
}
static Lisp_Object
call_process_kill (Lisp_Object fdpid)
{
emacs_close (XFASTINT (Fcar (fdpid)));
EMACS_KILLPG (XFASTINT (Fcdr (fdpid)), SIGKILL);
synch_process_alive = 0;
return Qnil;
}
static Lisp_Object
call_process_cleanup (Lisp_Object arg)
{
Lisp_Object fdpid = Fcdr (arg);
#if defined (MSDOS)
Lisp_Object file;
int fd;
#else
int pid;
#endif
Fset_buffer (Fcar (arg));
#if defined (MSDOS)
/* for MSDOS fdpid is really (fd . tempfile) */
fd = XFASTINT (Fcar (fdpid));
file = Fcdr (fdpid);
/* FD is -1 and FILE is "" when we didn't actually create a
temporary file in call-process. */
if (fd >= 0)
emacs_close (fd);
if (!(strcmp (SDATA (file), NULL_DEVICE) == 0 || SREF (file, 0) == '\0'))
unlink (SDATA (file));
#else /* not MSDOS */
pid = XFASTINT (Fcdr (fdpid));
if (call_process_exited)
{
emacs_close (XFASTINT (Fcar (fdpid)));
return Qnil;
}
if (EMACS_KILLPG (pid, SIGINT) == 0)
{
int count = SPECPDL_INDEX ();
record_unwind_protect (call_process_kill, fdpid);
message1 ("Waiting for process to die...(type C-g again to kill it instantly)");
immediate_quit = 1;
QUIT;
wait_for_termination (pid);
immediate_quit = 0;
specpdl_ptr = specpdl + count; /* Discard the unwind protect. */
message1 ("Waiting for process to die...done");
}
synch_process_alive = 0;
emacs_close (XFASTINT (Fcar (fdpid)));
#endif /* not MSDOS */
return Qnil;
}
static void
module_free_global_ref (emacs_env *env, emacs_value ref)
{
/* TODO: This probably never signals. */
/* FIXME: Wait a minute. Shouldn't this function report an error if
the hash lookup fails? */
MODULE_FUNCTION_BEGIN ();
struct Lisp_Hash_Table *h = XHASH_TABLE (Vmodule_refs_hash);
Lisp_Object obj = value_to_lisp (ref);
EMACS_UINT hashcode;
ptrdiff_t i = hash_lookup (h, obj, &hashcode);
if (i >= 0)
{
Lisp_Object value = HASH_VALUE (h, i);
EMACS_INT refcount = XFASTINT (value) - 1;
if (refcount > 0)
{
value = make_natnum (refcount);
set_hash_value_slot (h, i, value);
}
else
hash_remove_from_table (h, value);
}
}
static emacs_value
module_make_global_ref (emacs_env *env, emacs_value ref)
{
MODULE_FUNCTION_BEGIN (module_nil);
struct Lisp_Hash_Table *h = XHASH_TABLE (Vmodule_refs_hash);
Lisp_Object new_obj = value_to_lisp (ref);
EMACS_UINT hashcode;
ptrdiff_t i = hash_lookup (h, new_obj, &hashcode);
if (i >= 0)
{
Lisp_Object value = HASH_VALUE (h, i);
EMACS_INT refcount = XFASTINT (value) + 1;
if (MOST_POSITIVE_FIXNUM < refcount)
xsignal0 (Qoverflow_error);
value = make_natnum (refcount);
set_hash_value_slot (h, i, value);
}
else
{
hash_put (h, new_obj, make_natnum (1), hashcode);
}
return lisp_to_value (new_obj);
}
Whether the line is visible (if `selective-display' is t) has no effect.")
()
{
Lisp_Object temp;
XFASTINT (temp) = current_column ();
return temp;
}
static Lisp_Object
render (Lisp_Object oformat)
{
HGLOBAL htext = NULL;
UINT format = XFASTINT (oformat);
ONTRACE (fprintf (stderr, "render\n"));
if (NILP (current_text))
return Qnil;
if (current_requires_encoding || format == CF_UNICODETEXT)
{
if (format == current_clipboard_type)
htext = convert_to_handle_as_coded (current_coding_system);
else
switch (format)
{
case CF_UNICODETEXT:
htext = convert_to_handle_as_coded (QUNICODE);
break;
case CF_TEXT:
case CF_OEMTEXT:
{
Lisp_Object cs;
cs = coding_from_cp (cp_from_locale (current_lcid, format));
htext = convert_to_handle_as_coded (cs);
break;
}
}
}
else
htext = convert_to_handle_as_ascii ();
ONTRACE (fprintf (stderr, "render: htext = 0x%08X\n", (unsigned) htext));
if (htext == NULL)
return Qnil;
if (SetClipboardData (format, htext) == NULL)
{
GlobalFree (htext);
return Qnil;
}
return Qt;
}
Lisp_Object arguments, Lisp_Object buffer)
{
CHECK_SYMBOL (type);
CHECK_NATNUM (width);
CHECK_NATNUM (height);
/* This should work a bit like "make-button"
(make-button BEG END &rest PROPERTIES)
TYPE etc. should be keyword args eventually.
(make-xwidget 3 3 'button "oei" 31 31 nil)
(xwidget-info (car xwidget-list)) */
struct xwidget *xw = allocate_xwidget ();
Lisp_Object val;
xw->type = type;
xw->title = title;
xw->buffer = NILP (buffer) ? Fcurrent_buffer () : Fget_buffer_create (buffer);
xw->height = XFASTINT (height);
xw->width = XFASTINT (width);
xw->kill_without_query = false;
XSETXWIDGET (val, xw);
Vxwidget_list = Fcons (val, Vxwidget_list);
xw->widgetwindow_osr = NULL;
xw->widget_osr = NULL;
xw->plist = Qnil;
if (EQ (xw->type, Qwebkit_osr))
{
block_input ();
xw->widgetwindow_osr = gtk_offscreen_window_new ();
gtk_window_resize (GTK_WINDOW (xw->widgetwindow_osr), xw->width,
xw->height);
static Lisp_Object
casify_object (enum case_action flag, Lisp_Object obj)
{
register int c, c1;
register int inword = flag == CASE_DOWN;
/* If the case table is flagged as modified, rescan it. */
if (NILP (XCHAR_TABLE (BVAR (current_buffer, downcase_table))->extras[1]))
Fset_case_table (BVAR (current_buffer, downcase_table));
if (INTEGERP (obj))
{
int flagbits = (CHAR_ALT | CHAR_SUPER | CHAR_HYPER
| CHAR_SHIFT | CHAR_CTL | CHAR_META);
int flags = XINT (obj) & flagbits;
int multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
/* If the character has higher bits set
above the flags, return it unchanged.
It is not a real character. */
if ((unsigned) XFASTINT (obj) > (unsigned) flagbits)
return obj;
c1 = XFASTINT (obj) & ~flagbits;
/* FIXME: Even if enable-multibyte-characters is nil, we may
manipulate multibyte chars. This means we have a bug for latin-1
chars since when we receive an int 128-255 we can't tell whether
it's an eight-bit byte or a latin-1 char. */
if (c1 >= 256)
multibyte = 1;
if (! multibyte)
MAKE_CHAR_MULTIBYTE (c1);
c = downcase (c1);
if (inword)
XSETFASTINT (obj, c | flags);
else if (c == (XFASTINT (obj) & ~flagbits))
{
if (! inword)
c = upcase1 (c1);
if (! multibyte)
MAKE_CHAR_UNIBYTE (c);
XSETFASTINT (obj, c | flags);
}
return obj;
}
if (!STRINGP (obj))
wrong_type_argument (Qchar_or_string_p, obj);
else if (!STRING_MULTIBYTE (obj))
{
EMACS_INT i;
EMACS_INT size = SCHARS (obj);
obj = Fcopy_sequence (obj);
for (i = 0; i < size; i++)
{
c = SREF (obj, i);
MAKE_CHAR_MULTIBYTE (c);
c1 = c;
if (inword && flag != CASE_CAPITALIZE_UP)
c = downcase (c);
else if (!uppercasep (c)
&& (!inword || flag != CASE_CAPITALIZE_UP))
c = upcase1 (c1);
if ((int) flag >= (int) CASE_CAPITALIZE)
inword = (SYNTAX (c) == Sword);
if (c != c1)
{
MAKE_CHAR_UNIBYTE (c);
/* If the char can't be converted to a valid byte, just don't
change it. */
if (c >= 0 && c < 256)
SSET (obj, i, c);
}
}
return obj;
}
else
{
EMACS_INT i, i_byte, size = SCHARS (obj);
int len;
USE_SAFE_ALLOCA;
unsigned char *dst, *o;
/* Over-allocate by 12%: this is a minor overhead, but should be
sufficient in 99.999% of the cases to avoid a reallocation. */
EMACS_INT o_size = SBYTES (obj) + SBYTES (obj) / 8 + MAX_MULTIBYTE_LENGTH;
SAFE_ALLOCA (dst, void *, o_size);
o = dst;
for (i = i_byte = 0; i < size; i++, i_byte += len)
{
if ((o - dst) + MAX_MULTIBYTE_LENGTH > o_size)
{ /* Not enough space for the next char: grow the destination. */
unsigned char *old_dst = dst;
o_size += o_size; /* Probably overkill, but extremely rare. */
SAFE_ALLOCA (dst, void *, o_size);
memcpy (dst, old_dst, o - old_dst);
o = dst + (o - old_dst);
}
c = STRING_CHAR_AND_LENGTH (SDATA (obj) + i_byte, len);
if (inword && flag != CASE_CAPITALIZE_UP)
c = downcase (c);
else if (!uppercasep (c)
&& (!inword || flag != CASE_CAPITALIZE_UP))
c = upcase1 (c);
if ((int) flag >= (int) CASE_CAPITALIZE)
inword = (SYNTAX (c) == Sword);
o += CHAR_STRING (c, o);
}
eassert (o - dst <= o_size);
obj = make_multibyte_string ((char *) dst, size, o - dst);
SAFE_FREE ();
return obj;
}
}
static int
parse_settings (unsigned char *prop,
unsigned long bytes,
struct xsettings *settings)
{
Lisp_Object byteorder = Fbyteorder ();
int my_bo = XFASTINT (byteorder) == 'B' ? MSBFirst : LSBFirst;
int that_bo = prop[0];
CARD32 n_settings;
int bytes_parsed = 0;
int settings_seen = 0;
int i = 0;
/* First 4 bytes is a serial number, skip that. */
if (bytes < 12) return settings_seen;
memcpy (&n_settings, prop+8, 4);
if (my_bo != that_bo) n_settings = bswap_32 (n_settings);
bytes_parsed = 12;
memset (settings, 0, sizeof (*settings));
while (bytes_parsed+4 < bytes && settings_seen < 7
&& i < n_settings)
{
int type = prop[bytes_parsed++];
CARD16 nlen;
CARD32 vlen, ival = 0;
char name[128]; /* The names we are looking for are not this long. */
char sval[128]; /* The values we are looking for are not this long. */
bool want_this;
int to_cpy;
sval[0] = '\0';
++i;
++bytes_parsed; /* Padding */
memcpy (&nlen, prop+bytes_parsed, 2);
bytes_parsed += 2;
if (my_bo != that_bo) nlen = bswap_16 (nlen);
if (bytes_parsed + nlen > bytes) return settings_seen;
to_cpy = min (nlen, sizeof name - 1);
memcpy (name, prop+bytes_parsed, to_cpy);
name[to_cpy] = '\0';
bytes_parsed += nlen;
bytes_parsed = PAD (bytes_parsed);
bytes_parsed += 4; /* Skip serial for this value */
if (bytes_parsed > bytes) return settings_seen;
want_this = strcmp (XSETTINGS_TOOL_BAR_STYLE, name) == 0;
#ifdef HAVE_XFT
if ((nlen > 6 && memcmp (name, "Xft/", 4) == 0)
|| strcmp (XSETTINGS_FONT_NAME, name) == 0)
want_this = true;
#endif
switch (type)
{
case 0: /* Integer */
if (bytes_parsed + 4 > bytes) return settings_seen;
if (want_this)
{
memcpy (&ival, prop+bytes_parsed, 4);
if (my_bo != that_bo) ival = bswap_32 (ival);
}
bytes_parsed += 4;
break;
case 1: /* String */
if (bytes_parsed + 4 > bytes) return settings_seen;
memcpy (&vlen, prop+bytes_parsed, 4);
bytes_parsed += 4;
if (my_bo != that_bo) vlen = bswap_32 (vlen);
if (want_this)
{
to_cpy = min (vlen, sizeof sval - 1);
memcpy (sval, prop+bytes_parsed, to_cpy);
sval[to_cpy] = '\0';
}
bytes_parsed += vlen;
bytes_parsed = PAD (bytes_parsed);
break;
case 2: /* RGB value */
/* No need to parse this */
if (bytes_parsed + 8 > bytes) return settings_seen;
bytes_parsed += 8; /* 4 values (r, b, g, alpha), 2 bytes each. */
break;
default: /* Parse Error */
return settings_seen;
}
if (want_this)
{
if (strcmp (name, XSETTINGS_TOOL_BAR_STYLE) == 0)
{
dupstring (&settings->tb_style, sval);
settings->seen |= SEEN_TB_STYLE;
}
#ifdef HAVE_XFT
else if (strcmp (name, XSETTINGS_FONT_NAME) == 0)
{
dupstring (&settings->font, sval);
settings->seen |= SEEN_FONT;
}
else if (strcmp (name, "Xft/Antialias") == 0)
{
settings->seen |= SEEN_AA;
settings->aa = ival != 0;
}
else if (strcmp (name, "Xft/Hinting") == 0)
{
settings->seen |= SEEN_HINTING;
settings->hinting = ival != 0;
}
# ifdef FC_HINT_STYLE
else if (strcmp (name, "Xft/HintStyle") == 0)
{
settings->seen |= SEEN_HINTSTYLE;
if (strcmp (sval, "hintnone") == 0)
settings->hintstyle = FC_HINT_NONE;
else if (strcmp (sval, "hintslight") == 0)
settings->hintstyle = FC_HINT_SLIGHT;
else if (strcmp (sval, "hintmedium") == 0)
settings->hintstyle = FC_HINT_MEDIUM;
else if (strcmp (sval, "hintfull") == 0)
settings->hintstyle = FC_HINT_FULL;
else
settings->seen &= ~SEEN_HINTSTYLE;
}
# endif
else if (strcmp (name, "Xft/RGBA") == 0)
{
settings->seen |= SEEN_RGBA;
if (strcmp (sval, "none") == 0)
settings->rgba = FC_RGBA_NONE;
else if (strcmp (sval, "rgb") == 0)
settings->rgba = FC_RGBA_RGB;
else if (strcmp (sval, "bgr") == 0)
settings->rgba = FC_RGBA_BGR;
else if (strcmp (sval, "vrgb") == 0)
settings->rgba = FC_RGBA_VRGB;
else if (strcmp (sval, "vbgr") == 0)
settings->rgba = FC_RGBA_VBGR;
else
settings->seen &= ~SEEN_RGBA;
}
else if (strcmp (name, "Xft/DPI") == 0 && ival != (CARD32) -1)
{
settings->seen |= SEEN_DPI;
settings->dpi = ival / 1024.0;
}
else if (strcmp (name, "Xft/lcdfilter") == 0)
{
settings->seen |= SEEN_LCDFILTER;
if (strcmp (sval, "none") == 0)
settings->lcdfilter = FC_LCD_NONE;
else if (strcmp (sval, "lcddefault") == 0)
settings->lcdfilter = FC_LCD_DEFAULT;
else
settings->seen &= ~SEEN_LCDFILTER;
}
#endif /* HAVE_XFT */
else
want_this = false;
settings_seen += want_this;
}
}
return settings_seen;
}