x11fns.c

早期freebsd实现

	/* 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)
	  {
	    XFASTINT (xcoord) -= minibuf_prompt_width;
	    if(XINT (xcoord) < 0)
		XFASTINT (xcoord) = 0;
	  }
	else
	  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;
		/* 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, 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 */