Return to x11fns.c CVS log

Up to [Apple XNU] / GNUtools / emacs / src

GNU tools for NeXTSTEP 3.3

/* Functions for the X window system.
   Copyright (C) 1988, 1990, 1992 Free Software Foundation.

This file is part of GNU Emacs.

GNU Emacs 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 1, or (at your option)
any later version.

GNU Emacs 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 GNU Emacs; see the file COPYING.  If not, write to
the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */

/* Written by Yakim Martillo; rearranged by Richard Stallman.  */
/* Color and other features added by Robert Krawitz*/
/* Converted to X11 by Robert French */

#include <stdio.h>
#include <signal.h>
#include "config.h"

/* Get FIONREAD, if it is available.  */
#ifdef USG
#include <termio.h>
#endif /* USG */
#include <fcntl.h>

#ifndef VMS
#include <sys/ioctl.h>
#endif /* not VMS */

/* Allow m- file to inhibit use of interrupt-driven input.  */
#ifdef BROKEN_FIONREAD
#undef FIONREAD
#endif

/* We are unable to use interrupts if FIONREAD is not available,
   so flush SIGIO so we won't try.  */
#ifndef FIONREAD
#ifdef SIGIO
#undef SIGIO
#endif
#endif

#include "x11term.h"
#include "dispextern.h"
#include "termchar.h"

#ifdef HAVE_SOCKETS
#include <sys/socket.h>		/* Must be done before gettime.h.  */
#endif
/* Include time.h or sys/time.h or both.  */
#include "gettime.h"
#include <setjmp.h>

/* Prepare for lisp.h definition of NULL.
   Sometimes x11term.h includes stddef.h.  */
#ifdef NULL
#undef NULL
#endif

#include "lisp.h"
#include "window.h"

#ifdef HAVE_X_WINDOWS

#define abs(x) ((x < 0) ? ((x)) : (x))
#define sgn(x) ((x < 0) ? (-1) : (1))
#define min(a,b) ((a) < (b) ? (a) : (b))
#define max(a,b) ((a) > (b) ? (a) : (b))
  
/* Non-nil if Emacs is running with an X window for display.
   Nil if Emacs is run on an ordinary terminal.  */

Lisp_Object Vxterm;

Lisp_Object Vx_mouse_pos;
Lisp_Object Vx_mouse_abs_pos;

Lisp_Object Vx_mouse_item;

/* These are standard "white" and "black" strings, used in the
   *_color variables when the color was not specially allocated for them.  */
char *white_color = "white";
char *black_color = "black";

extern Lisp_Object MouseMap;

extern Lisp_Object minibuf_window;
extern int minibuf_prompt_width;

extern XEvent *XXm_queue[XMOUSEBUFSIZE];
extern int XXm_queue_num;
extern int XXm_queue_in;
extern int XXm_queue_out;
extern char *fore_color;
extern char *back_color;
extern char *brdr_color;
extern char *mous_color;
extern char *curs_color;

extern unsigned long fore;
extern unsigned long back;
extern unsigned long brdr;
extern unsigned long curs;

extern int XXborder;
extern int XXInternalBorder;

extern char *progname;

extern XFontStruct *fontinfo;
extern Font XXfid;
extern GC XXgc_norm,XXgc_rev,XXgc_curs,XXgc_temp,XXgc_curs_rev;
extern XGCValues XXgcv;
extern int XXfontw,XXfonth,XXbase,XXisColor;
extern Colormap XXColorMap;

extern int PendingExposure;
extern char *default_window;
extern char *desiredwindow;

extern int XXscreen;
extern Window XXwindow;
extern Cursor EmacsCursor;
extern short MouseCursor[], MouseMask[];
extern char *XXcurrentfont;
extern int informflag;

extern int WindowMapped;
extern int CurHL;
extern int pixelwidth, pixelheight;
extern int XXpid;

extern char *XXidentity;

extern Display *XXdisplay;
extern int bitblt, CursorExists, VisibleX, VisibleY;

check_xterm ()
{
	if (NULL (Vxterm))
		error ("Terminal does not understand X protocol.");
}

DEFUN ("x-set-bell", Fx_set_bell, Sx_set_bell, 1, 1, "P",
  "For X window system, set audible vs visible bell.\n\
With non-nil argument (prefix arg), use visible bell; otherwise, audible bell.")
   (arg)
     Lisp_Object arg;
{
	BLOCK_INPUT_DECLARE ();

	check_xterm ();
	BLOCK_INPUT ();
	if (!NULL (arg))
		XSetFlash ();
	else
		XSetFeep ();
	UNBLOCK_INPUT ();
	return arg;
}

DEFUN ("x-flip-color", Fx_flip_color, Sx_flip_color, 0, 0, "",
  "Toggle the background and foreground colors")
  ()
{
	check_xterm ();
	XFlipColor ();
	return Qt;
}

DEFUN ("x-set-foreground-color", Fx_set_foreground_color,
       Sx_set_foreground_color, 1, 1, "sSet foreground color:  ",
       "Set foreground (text) color to COLOR.")
  (arg)
     Lisp_Object arg;
{
	XColor cdef;
	BLOCK_INPUT_DECLARE ();
	char *save_color;
	unsigned long save;

	save_color = fore_color;
	save = fore;
	check_xterm ();
	CHECK_STRING (arg,1);
	fore_color = (char *) xmalloc (XSTRING (arg)->size + 1);
	bcopy (XSTRING (arg)->data, fore_color, XSTRING (arg)->size + 1);

	BLOCK_INPUT ();

	if (fore_color && XXisColor &&
	    XParseColor (XXdisplay, XXColorMap, fore_color, &cdef) &&
	    XAllocColor(XXdisplay, XXColorMap, &cdef))
	  fore = cdef.pixel;
	else if (fore_color && !strcmp (fore_color, "white"))
	  fore = WhitePixel (XXdisplay, XXscreen), fore_color = white_color;
	else if (fore_color && !strcmp (fore_color, "black"))
	  fore = BlackPixel (XXdisplay, XXscreen), fore_color = black_color;
	else
	  fore_color = save_color;

	/* Now free the old background color
	   if it was specially allocated and we are not still using it.  */
	if (save_color != white_color && save_color != black_color
	    && save_color != fore_color)
	  {
	    XFreeColors (XXdisplay, XXColorMap, &save, 1, 0);
	    free (save_color);
	  }

	XSetForeground(XXdisplay, XXgc_norm, fore);
	XSetBackground(XXdisplay, XXgc_rev, fore);
	
	Fredraw_display ();
	UNBLOCK_INPUT ();

	XFlush (XXdisplay);
	return Qt;
}

DEFUN ("x-set-background-color", Fx_set_background_color,
       Sx_set_background_color, 1, 1, "sSet background color: ",
       "Set background color to COLOR.")
  (arg)
     Lisp_Object arg;
{
	XColor cdef;
	BLOCK_INPUT_DECLARE ();
	char *save_color;
	unsigned long save;

	check_xterm ();
	CHECK_STRING (arg,1);
	save_color = back_color;
	save = back;
	back_color = (char *) xmalloc (XSTRING (arg)->size + 1);
	bcopy (XSTRING (arg)->data, back_color, XSTRING (arg)->size + 1);

	BLOCK_INPUT ();

	if (back_color && XXisColor &&
	    XParseColor (XXdisplay, XXColorMap, back_color, &cdef) &&
	    XAllocColor(XXdisplay, XXColorMap, &cdef))
	  back = cdef.pixel;
	else if (back_color && !strcmp (back_color, "white"))
	  back = WhitePixel (XXdisplay, XXscreen), back_color = white_color;
	else if (back_color && !strcmp (back_color, "black"))
	  back = BlackPixel (XXdisplay, XXscreen), back_color = black_color;
	else
	  back_color = save_color;

	/* Now free the old background color
	   if it was specially allocated and we are not still using it.  */
	if (save_color != white_color && save_color != black_color
	    && save_color != back_color)
	  {
	    XFreeColors (XXdisplay, XXColorMap, &save, 1, 0);
	    free (save_color);
	  }

	XSetBackground (XXdisplay, XXgc_norm, back);
	XSetForeground (XXdisplay, XXgc_rev, back);
	XSetForeground (XXdisplay, XXgc_curs, back);
	XSetBackground (XXdisplay, XXgc_curs_rev, back);
	XSetWindowBackground(XXdisplay, XXwindow, back);
	XClearArea (XXdisplay, XXwindow, 0, 0,
		    screen_width*XXfontw+2*XXInternalBorder,
		    screen_height*XXfonth+2*XXInternalBorder, 0);
	
	UNBLOCK_INPUT ();
	Fredraw_display ();

	XFlush (XXdisplay);
	return Qt;
}

DEFUN ("x-set-border-color", Fx_set_border_color, Sx_set_border_color, 1, 1,
       "sSet border color: ",
       "Set border color to COLOR.")
  (arg)
     Lisp_Object arg;
{
	XColor cdef;
	BLOCK_INPUT_DECLARE ();
	unsigned long save;
	char *save_color;

	check_xterm ();
	CHECK_STRING (arg,1);
	brdr_color= (char *) xmalloc (XSTRING (arg)->size + 1);
	save = brdr;
	save_color = brdr_color;
	bcopy (XSTRING (arg)->data, brdr_color, XSTRING (arg)->size + 1);

	BLOCK_INPUT ();

	if (brdr_color && XXisColor &&
	    XParseColor (XXdisplay, XXColorMap, brdr_color, &cdef) &&
	    XAllocColor(XXdisplay, XXColorMap, &cdef))
	  brdr = cdef.pixel;
	else
	  {
	    if (brdr_color && !strcmp (brdr_color, "black"))
	      {
		brdr = BlackPixel (XXdisplay, XXscreen);
		brdr_color = black_color;
	      }
	    else
	      if (brdr_color && !strcmp (brdr_color, "white"))
		{
		  brdr = WhitePixel (XXdisplay, XXscreen);
		  brdr_color = white_color;
		}
	      else {
		brdr_color = black_color;
		brdr = BlackPixel (XXdisplay, XXscreen);
	      }
	  }

	/* Now free the old background color
	   if it was specially allocated and we are not still using it.  */
	if (save_color != white_color && save_color != black_color
	    && save_color != brdr_color)
	  {
	    XFreeColors (XXdisplay, XXColorMap, &save, 1, 0);
	    free (save_color);
	  }

	if (XXborder) {
		XSetWindowBorder(XXdisplay, XXwindow, brdr);
		XFlush (XXdisplay);
	}
	
	UNBLOCK_INPUT ();

	return Qt;
}

DEFUN ("x-set-cursor-color", Fx_set_cursor_color, Sx_set_cursor_color, 1, 1,
       "sSet text cursor color: ",
       "Set text cursor color to COLOR.")
  (arg)
     Lisp_Object arg;
{
	XColor cdef;
	BLOCK_INPUT_DECLARE ();
	char *save_color;
	unsigned long save;

	check_xterm ();
	CHECK_STRING (arg,1);
	save_color = curs_color;
	save = curs;
	curs_color = (char *) xmalloc (XSTRING (arg)->size + 1);
	bcopy (XSTRING (arg)->data, curs_color, XSTRING (arg)->size + 1);

	BLOCK_INPUT ();

	if (curs_color && XXisColor &&
	    XParseColor (XXdisplay, XXColorMap, curs_color, &cdef) &&
	    XAllocColor(XXdisplay, XXColorMap, &cdef))
	  curs = cdef.pixel;
	else if (curs_color && !strcmp (curs_color, "white"))
	  curs = WhitePixel (XXdisplay, XXscreen), curs_color = white_color;
	else if (curs_color && !strcmp (curs_color, "black"))
	  curs = BlackPixel (XXdisplay, XXscreen), curs_color = black_color;
	else
	  curs_color = save_color;

	/* Now free the old background color
	   if it was specially allocated and we are not still using it.  */
	if (save_color != white_color && save_color != black_color
	    && save_color != curs_color)
	  {
	    XFreeColors (XXdisplay, XXColorMap, &save, 1, 0);
	    free (save_color);
	  }

	XSetBackground(XXdisplay, XXgc_curs, curs);
	XSetForeground(XXdisplay, XXgc_curs_rev, curs);

	CursorToggle ();
	CursorToggle ();

	UNBLOCK_INPUT ();
	return Qt;
}

DEFUN ("x-set-mouse-color", Fx_set_mouse_color, Sx_set_mouse_color, 1, 1,
       "sSet mouse cursor color: ",
       "Set mouse cursor color to COLOR.")
  (arg)
     Lisp_Object arg;
{
  BLOCK_INPUT_DECLARE ();
  char *save_color;

  check_xterm ();
  CHECK_STRING (arg,1);
  save_color = mous_color;
  mous_color = (char *) xmalloc (XSTRING (arg)->size + 1);
  bcopy (XSTRING (arg)->data, mous_color, XSTRING (arg)->size + 1);

  BLOCK_INPUT ();

  if (! x_set_cursor_colors ())
    mous_color = save_color;
  else if (save_color != white_color && save_color != black_color
	   && save_color != mous_color)
    free (save_color);

  XFlush (XXdisplay);
	
  UNBLOCK_INPUT ();
  return Qt;
}   

/* Set the actual X cursor colors from `mous_color' and `back_color'.  */

int
x_set_cursor_colors ()
{
  XColor forec, backc;

  char	 *useback;

  /* USEBACK is the background color, but on monochrome screens
     changed if necessary not to match the mouse.  */

  useback = back_color;

  if (!XXisColor && !strcmp (mous_color, back_color))
    {
      if (strcmp (back_color, "white"))
	useback = white_color;
      else
	useback = black_color;
    }

  if (XXisColor && mous_color
      && XParseColor (XXdisplay, XXColorMap, mous_color, &forec)
      && XParseColor (XXdisplay, XXColorMap, useback, &backc))
    {
      XRecolorCursor (XXdisplay, EmacsCursor, &forec, &backc);
      return 1;
    }
  else return 0;
}

DEFUN ("x-color-p", Fx_color_p, Sx_color_p, 0, 0, 0,
       "Returns t if the display is a color X terminal.")
  ()
{
	check_xterm ();

	if (XXisColor)
		return Qt;
	else
		return Qnil;
}
	
DEFUN ("x-get-foreground-color", Fx_get_foreground_color,
       Sx_get_foreground_color, 0, 0, 0,
       "Returns the color of the foreground, as a string.")
  ()
{
	Lisp_Object string;

	check_xterm ();
	string = build_string (fore_color);
	return string;
}

DEFUN ("x-get-background-color", Fx_get_background_color,
       Sx_get_background_color, 0, 0, 0,
       "Returns the color of the background, as a string.")
  ()
{
	Lisp_Object string;

	check_xterm ();
	string = build_string (back_color);
	return string;
}

DEFUN ("x-get-border-color", Fx_get_border_color,
       Sx_get_border_color, 0, 0, 0,
       "Returns the color of the border, as a string.")
  ()
{
	Lisp_Object string;

	check_xterm ();
	string = build_string (brdr_color);
	return string;
}

DEFUN ("x-get-cursor-color", Fx_get_cursor_color,
       Sx_get_cursor_color, 0, 0, 0,
       "Returns the color of the cursor, as a string.")
  ()
{
	Lisp_Object string;

	check_xterm ();
	string = build_string (curs_color);
	return string;
}

DEFUN ("x-get-mouse-color", Fx_get_mouse_color,
       Sx_get_mouse_color, 0, 0, 0,
       "Returns the color of the mouse cursor, as a string.")
  ()
{
	Lisp_Object string;

	check_xterm ();
	string = build_string (mous_color);
	return string;
}

DEFUN ("x-get-default", Fx_get_default, Sx_get_default, 1, 1, 0,
       "Get default for X-window attribute ATTRIBUTE from the system.\n\
ATTRIBUTE must be a string.\n\
Returns nil if attribute default isn't specified.")
  (arg)
     Lisp_Object arg;
{
	char *default_name, *value;

	check_xterm ();
	CHECK_STRING (arg, 1);
	default_name = (char *) XSTRING (arg)->data;

#ifdef XBACKWARDS
	/* Some versions of X11R4, at least, have the args backwards.  */
	if (XXidentity && *XXidentity)
		value = XGetDefault (XXdisplay, default_name, XXidentity);
	else
		value = XGetDefault (XXdisplay, default_name, CLASS);
#else
	if (XXidentity && *XXidentity)
		value = XGetDefault (XXdisplay, XXidentity, default_name);
	else
		value = XGetDefault (XXdisplay, CLASS, default_name);
#endif
 	
	if (value)
		return build_string (value);
	return (Qnil);
}

DEFUN ("x-set-font", Fx_set_font, Sx_set_font, 1, 1, "sFont Name: ",
      "Sets the font to be used for the X window.")
  (arg)
     Lisp_Object arg;
{
	register char *newfontname;
	
	CHECK_STRING (arg, 1);
	check_xterm ();

	newfontname = (char *) xmalloc (XSTRING (arg)->size + 1);
	bcopy (XSTRING (arg)->data, newfontname, XSTRING (arg)->size + 1);
	if (XSTRING (arg)->size == 0)
		goto badfont;

	if (!XNewFont (newfontname)) {
		free (XXcurrentfont);
		XXcurrentfont = newfontname;
		return Qt;
	}
badfont:
	error ("Font \"%s\" is not defined", newfontname);
	free (newfontname);

	return Qnil;
}

DEFUN ("coordinates-in-window-p", Fcoordinates_in_window_p,
  Scoordinates_in_window_p, 2, 2, 0,
  "Return non-nil if POSITIONS (a list, (SCREEN-X SCREEN-Y)) is in WINDOW.\n\
Returned value is list of positions expressed\n\
relative to window upper left corner.")
  (coordinate, window)
     register Lisp_Object coordinate, window;
{
	register Lisp_Object xcoord, ycoord;
	int height;
	
	if (!CONSP (coordinate))
		wrong_type_argument (Qlistp, coordinate);

	CHECK_WINDOW (window, 2);
	xcoord = Fcar (coordinate);
	ycoord = Fcar (Fcdr (coordinate));
	CHECK_NUMBER (xcoord, 0);
	CHECK_NUMBER (ycoord, 1);
	if ((XINT (xcoord) < XINT (XWINDOW (window)->left)) ||
	    (XINT (xcoord) >= (XINT (XWINDOW (window)->left) +
			       XINT (XWINDOW (window)->width))))
		return Qnil;

	XFASTINT (xcoord) -= XFASTINT (XWINDOW (window)->left);

	height = XINT (XWINDOW (window)->height);

	if (window != minibuf_window)
	  height --;

	if ((XINT (ycoord) < XINT (XWINDOW (window)->top)) ||
	    (XINT (ycoord) >= XINT (XWINDOW (window)->top) + height))
	  return Qnil;

	XFASTINT (ycoord) -= XFASTINT (XWINDOW (window)->top);
	return Fcons (xcoord, Fcons (ycoord, Qnil));
}

DEFUN ("x-mouse-events", Fx_mouse_events, Sx_mouse_events, 0, 0, 0,
  "Return number of pending mouse events from X window system.")
  ()
{
	register Lisp_Object tem;

	check_xterm ();

	XSET (tem, Lisp_Int, XXm_queue_num);
	
	return tem;
}

DEFUN ("x-proc-mouse-event", Fx_proc_mouse_event, Sx_proc_mouse_event,
  0, 0, 0,
  "Pulls a mouse event out of the mouse event buffer and dispatches\n\
the appropriate function to act upon this event.")
  ()
{
	XEvent event;
	register Lisp_Object mouse_cmd;
	register char com_letter;
	register char key_mask;
	register Lisp_Object tempx;
	register Lisp_Object tempy;
	extern Lisp_Object get_keyelt ();
	extern int meta_prefix_char;
	
	check_xterm ();

	if (XXm_queue_num) {
		event = *XXm_queue[XXm_queue_out];
		free (XXm_queue[XXm_queue_out]);
		XXm_queue_out = (XXm_queue_out + 1) % XMOUSEBUFSIZE;
		XXm_queue_num--;
		com_letter = 3-(event.xbutton.button & 3);
		key_mask = (event.xbutton.state & 15) << 4;
		/* Get rid of the shift-lock bit.  */
		key_mask &= ~0x20;
		/* Report meta in 2 bit, not in 8 bit.  */
		if (key_mask & 0x80)
		  {
		    key_mask |= 0x20;
		    key_mask &= ~0x80;
		  }
		com_letter |= key_mask;
		if (event.type == ButtonRelease)
			com_letter |= 0x04;
		XSET (tempx, Lisp_Int,
		      min (screen_width-1,
			   max (0, (event.xbutton.x-XXInternalBorder)/
				XXfontw)));
		XSET (tempy, Lisp_Int,
		      min (screen_height-1,
			   max (0, (event.xbutton.y-XXInternalBorder)/
				XXfonth)));
		Vx_mouse_pos = Fcons (tempx, Fcons (tempy, Qnil));
		XSET (tempx, Lisp_Int, event.xbutton.x_root);
		XSET (tempy, Lisp_Int, event.xbutton.y_root);
		Vx_mouse_abs_pos = Fcons (tempx, Fcons (tempy, Qnil));
		Vx_mouse_item = make_number (com_letter);
		mouse_cmd
		  = get_keyelt (access_keymap (MouseMap, com_letter));
		if (NULL (mouse_cmd)) {
			if (event.type != ButtonRelease)
				bell ();
			Vx_mouse_pos = Qnil;
		}
		else
			return call1 (mouse_cmd, Vx_mouse_pos);
	}
	return Qnil;
}

DEFUN ("x-get-mouse-event", Fx_get_mouse_event, Sx_get_mouse_event,
  1, 1, 0,
  "Get next mouse event out of mouse event buffer (com-letter (x y)).\n\
ARG non-nil means return nil immediately if no pending event;\n\
otherwise, wait for an event.")
  (arg)
     Lisp_Object arg;
{
	XEvent event;
	register char com_letter;
	register char key_mask;

	register Lisp_Object tempx;
	register Lisp_Object tempy;
	
	check_xterm ();

	if (NULL (arg))
		while (!XXm_queue_num)
		  {
		    consume_available_input ();
		    Fsleep_for (make_number (1));
		  }
	/*** ??? Surely you don't mean to busy wait??? */

	if (XXm_queue_num) {
		event = *XXm_queue[XXm_queue_out];
		free (XXm_queue[XXm_queue_out]);
		XXm_queue_out = (XXm_queue_out + 1) % XMOUSEBUFSIZE;
		XXm_queue_num--;
		com_letter = 3-(event.xbutton.button & 3);
		key_mask = (event.xbutton.state & 15) << 4;
		/* Report meta in 2 bit, not in 8 bit.  */
		if (key_mask & 0x80)
		  {
		    key_mask |= 0x20;
		    key_mask &= ~0x80;
		  }
		com_letter |= key_mask;
		if (event.type == ButtonRelease)
			com_letter |= 0x04;
		XSET (tempx, Lisp_Int,
		      min (screen_width-1,
			   max (0, (event.xbutton.x-XXInternalBorder)/
				XXfontw)));
		XSET (tempy, Lisp_Int,
		      min (screen_height-1,
			   max (0, (event.xbutton.y-XXInternalBorder)/
				XXfonth)));
		Vx_mouse_pos = Fcons (tempx, Fcons (tempy, Qnil));
		XSET (tempx, Lisp_Int, event.xbutton.x_root);
		XSET (tempy, Lisp_Int, event.xbutton.y_root);
		Vx_mouse_abs_pos = Fcons (tempx, Fcons (tempy, Qnil));
		Vx_mouse_item = make_number (com_letter);
		return Fcons (com_letter, Fcons (Vx_mouse_pos, Qnil));
	}
	return Qnil;
}

DEFUN ("x-store-cut-buffer", Fx_store_cut_buffer, Sx_store_cut_buffer,
  1, 1, "sSend string to X:",
  "Store contents of STRING into the cut buffer of the X window system.")
  (string)
     register Lisp_Object string;
{
	BLOCK_INPUT_DECLARE ();

	CHECK_STRING (string, 1);
	check_xterm ();

	BLOCK_INPUT ();
	XStoreBytes (XXdisplay, (char *) XSTRING (string)->data,
		     XSTRING (string)->size);
	/* Clear the selection owner, so that other applications
	   will use the cut buffer rather than a selection.  */
        XSetSelectionOwner (XXdisplay, XA_PRIMARY, None, CurrentTime);
	UNBLOCK_INPUT ();

	return Qnil;
}

DEFUN ("x-get-cut-buffer", Fx_get_cut_buffer, Sx_get_cut_buffer, 0, 0, 0,
  "Return contents of cut buffer of the X window system, as a string.")
  ()
{
	int len;
	register Lisp_Object string;
	BLOCK_INPUT_DECLARE ();
	register char *d;

	check_xterm ();
	BLOCK_INPUT ();
	d = XFetchBytes (XXdisplay, &len);
	string = make_string (d, len);
	UNBLOCK_INPUT ();

	return string;
}

DEFUN ("x-set-border-width", Fx_set_border_width, Sx_set_border_width,
  1, 1, "nBorder width: ",
  "Set width of border to WIDTH, in the X window system.")
  (borderwidth)
     register Lisp_Object borderwidth;
{
	BLOCK_INPUT_DECLARE ();

	CHECK_NUMBER (borderwidth, 0);

	check_xterm ();
  
	if (XINT (borderwidth) < 0)
		XSETINT (borderwidth, 0);
  
	BLOCK_INPUT ();
	XSetWindowBorderWidth(XXdisplay, XXwindow, XINT(borderwidth));
	XFlush(XXdisplay);
	UNBLOCK_INPUT ();

	return Qt;
}


DEFUN ("x-set-internal-border-width", Fx_set_internal_border_width,
       Sx_set_internal_border_width, 1, 1, "nInternal border width: ",
  "Set width of internal border to WIDTH, in the X window system.")
  (internalborderwidth)
     register Lisp_Object internalborderwidth;
{
	BLOCK_INPUT_DECLARE ();

	CHECK_NUMBER (internalborderwidth, 0);

	check_xterm ();
  
	if (XINT (internalborderwidth) < 0)
		XSETINT (internalborderwidth, 0);

	BLOCK_INPUT ();
	XXInternalBorder = XINT(internalborderwidth);
	XSetWindowSize(screen_height,screen_width);
	UNBLOCK_INPUT ();

	return Qt;
}

#ifdef foobar
DEFUN ("x-rebind-key", Fx_rebind_key, Sx_rebind_key, 3, 3, 0,
  "Rebind KEYCODE, with shift bits SHIFT-MASK, to new string NEWSTRING.\n\
KEYCODE and SHIFT-MASK should be numbers representing the X keyboard code\n\
and shift mask respectively.  NEWSTRING is an arbitrary string of keystrokes.\n\
If SHIFT-MASK is nil, then KEYCODE's key will be bound to NEWSTRING for\n\
all shift combinations.\n\
Shift Lock  1	   Shift    2\n\
Meta	    4	   Control  8\n\
\n\
For values of KEYCODE, see /usr/lib/Xkeymap.txt (remember that the codes\n\
in that file are in octal!)\n")

  (keycode, shift_mask, newstring)
     register Lisp_Object keycode;
     register Lisp_Object shift_mask;
     register Lisp_Object newstring;
{
#ifdef notdef
	char *rawstring;
	int rawkey, rawshift;
	int i;
	int strsize;

	CHECK_NUMBER (keycode, 1);
	if (!NULL (shift_mask))
		CHECK_NUMBER (shift_mask, 2);
	CHECK_STRING (newstring, 3);
	strsize = XSTRING (newstring) ->size;
	rawstring = (char *) xmalloc (strsize);
	bcopy (XSTRING (newstring)->data, rawstring, strsize);
	rawkey = ((unsigned) (XINT (keycode))) & 255;
	if (NULL (shift_mask))
		for (i = 0; i <= 15; i++)
			XRebindCode (rawkey, i<<11, rawstring, strsize);
	else
	{
		rawshift = (((unsigned) (XINT (shift_mask))) & 15) << 11;
		XRebindCode (rawkey, rawshift, rawstring, strsize);
	}
#endif notdef
	return Qnil;
}
  
DEFUN ("x-rebind-keys", Fx_rebind_keys, Sx_rebind_keys, 2, 2, 0,
  "Rebind KEYCODE to list of strings STRINGS.\n\
STRINGS should be a list of 16 elements, one for each all shift combination.\n\
nil as element means don't change.\n\
See the documentation of x-rebind-key for more information.")
  (keycode, strings)
     register Lisp_Object keycode;
     register Lisp_Object strings;
{
#ifdef notdef
	register Lisp_Object item;
	register char *rawstring;
	int rawkey, strsize;
	register unsigned i;

	CHECK_NUMBER (keycode, 1);
	CHECK_CONS (strings, 2);
	rawkey = ((unsigned) (XINT (keycode))) & 255;
	for (i = 0; i <= 15; strings = Fcdr (strings), i++)
	{
		item = Fcar (strings);
		if (!NULL (item))
		{
			CHECK_STRING (item, 2);
			strsize = XSTRING (item)->size;
			rawstring = (char *) xmalloc (strsize);
			bcopy (XSTRING (item)->data, rawstring, strsize);
			XRebindCode (rawkey, i << 11, rawstring, strsize);
		}
	}
#endif notdef
	return Qnil;
}

#endif foobar

XExitWithCoreDump ()
{
	XCleanUp ();
	abort ();
}

DEFUN ("x-debug", Fx_debug, Sx_debug, 1, 1, 0,
  "ARG non-nil means that X errors should generate a coredump.")
  (arg)
     register Lisp_Object arg;
{
	int (*handler)();

	check_xterm ();
	if (!NULL (arg))
		handler = XExitWithCoreDump;
	else
	{
		extern int XIgnoreError ();
		handler = XIgnoreError;
	}
	XSetErrorHandler(handler);
	XSetIOErrorHandler(handler);
	return (Qnil);
}

XRedrawDisplay ()
{
	Fredraw_display ();
}

XCleanUp ()
{
	Fdo_auto_save (Qt);

#ifdef subprocesses
	kill_buffer_processes (Qnil);
#endif				/* subprocesses */
}

syms_of_xfns ()
{
  /* If not dumping, init_display ran before us, so don't override it.  */
#ifdef CANNOT_DUMP
  if (noninteractive)
#endif
    Vxterm = Qnil;

  DEFVAR_LISP ("x-mouse-item", &Vx_mouse_item,
	       "Encoded representation of last mouse click, corresponding to\n\
numerical entries in x-mouse-map.");
  Vx_mouse_item = Qnil;
  DEFVAR_LISP ("x-mouse-pos", &Vx_mouse_pos,
	       "Current x-y position of mouse by row, column as specified by font.");
  Vx_mouse_pos = Qnil;
  DEFVAR_LISP ("x-mouse-abs-pos", &Vx_mouse_abs_pos,
	       "Current x-y position of mouse relative to root window.");
  Vx_mouse_abs_pos = Qnil;

  defsubr (&Sx_set_bell);
  defsubr (&Sx_flip_color);
  defsubr (&Sx_set_font);
#ifdef notdef
  defsubr (&Sx_set_icon);
#endif notdef
  defsubr (&Scoordinates_in_window_p);
  defsubr (&Sx_mouse_events);
  defsubr (&Sx_proc_mouse_event);
  defsubr (&Sx_get_mouse_event);
  defsubr (&Sx_store_cut_buffer);
  defsubr (&Sx_get_cut_buffer);
  defsubr (&Sx_set_border_width);
  defsubr (&Sx_set_internal_border_width);
  defsubr (&Sx_set_foreground_color);
  defsubr (&Sx_set_background_color);
  defsubr (&Sx_set_border_color);
  defsubr (&Sx_set_cursor_color);
  defsubr (&Sx_set_mouse_color);
  defsubr (&Sx_get_foreground_color);
  defsubr (&Sx_get_background_color);
  defsubr (&Sx_get_border_color);
  defsubr (&Sx_get_cursor_color);
  defsubr (&Sx_get_mouse_color);
  defsubr (&Sx_color_p);
  defsubr (&Sx_get_default);
#ifdef notdef
  defsubr (&Sx_rebind_key);
  defsubr (&Sx_rebind_keys);
#endif notdef
  defsubr (&Sx_debug);
}

#endif /* HAVE_X_WINDOWS */

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.