view src/console-gtk.c @ 5327:d1b17a33450b

Move the heavy lifting from cl-seq.el to C. src/ChangeLog addition: 2010-12-30 Aidan Kehoe <kehoea@parhasard.net> Move the heavy lifting from cl-seq.el to C, finally making those functions first-class XEmacs citizens, with circularity checking, built-in support for tests other than #'eql, and as much compatibility with current Common Lisp as Paul Dietz' tests require. * fns.c (check_eq_nokey, check_eq_key, check_eql_nokey) (check_eql_key, check_equal_nokey, check_equal_key) (check_equalp_nokey, check_equalp_key, check_string_match_nokey) (check_string_match_key, check_other_nokey, check_other_key) (check_if_nokey, check_if_key, check_match_eq_key) (check_match_eql_key, check_match_equal_key) (check_match_equalp_key, check_match_other_key): New. These are basically to provide function pointers to be used by Lisp functions that take TEST, TEST-NOT and KEY arguments. (get_check_match_function_1, get_check_test_function) (get_check_match_function): These functions work out which of the previous list of functions to use, given the keywords supplied by the user. (count_with_tail): New. This is the bones of #'count. (list_count_from_end, string_count_from_end): Utility functions for #'count. (Fcount): New, moved from cl-seq.el. (list_position_cons_before): New. The implementation of #'member*, and important in implementing various other functions. (FmemberX, Fadjoin, FassocX, FrassocX, Fposition, Ffind) (FdeleteX, FremoveX, Fdelete_duplicates, Fremove_duplicates) (Fnsubstitute, Fsubstitute, Fsublis, Fnsublis, Fsubst, Fnsubst) (Ftree_equal, Fmismatch, Fsearch, Fintersection, Fnintersection) (Fsubsetp, Fset_difference, Fnset_difference, Fnunion, Funion) (Fset_exclusive_or, Fnset_exclusive_or): New, moved here from cl-seq.el. (position): New. The implementation of #'find and #'position. (list_delete_duplicates_from_end, subst, sublis, nsublis) (tree_equal, mismatch_from_end, mismatch_list_list) (mismatch_list_string, mismatch_list_array) (mismatch_string_array, mismatch_string_string) (mismatch_array_array, get_mismatch_func): Helper C functions for the Lisp-visible functions. (venn, nvenn): New. The implementation of the main Lisp functions that treat lists as sets. lisp/ChangeLog addition: 2010-12-30 Aidan Kehoe <kehoea@parhasard.net> * cl-seq.el: Move the heavy lifting from this file to C. Dump the cl-parsing-keywords macro, but don't use defun* for the functions we define that do take keywords, dynamic scope lossage makes that not practical. * subr.el (sort, fillarray): Move these aliases here. (map-plist): #'nsublis is now built-in, but at this point #'eql isn't necessarily available as a test; use #'eq. * obsolete.el (cl-delete-duplicates): Make this available for old compiler macros and old code. (memql): Document that this is equivalent to #'member*, and worse. * cl.el (adjoin, subst): Removed. These are in C.
author Aidan Kehoe <kehoea@parhasard.net>
date Thu, 30 Dec 2010 01:59:52 +0000
parents 71ee43b8a74d
children 308d34e9f07d
line wrap: on
line source

/* Console functions for X windows.
   Copyright (C) 1996 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:

   Ben Wing: January 1996, for 19.14.
   William Perry: April 2000, for 21.1 (Gtk version)
 */

#include <config.h>
#include "lisp.h"

#include "process.h" /* canonicalize_host_name */
#include "redisplay.h" /* for display_arg */

#include "charset.h"
#include "elhash.h"

#include "console-gtk-impl.h"

DEFINE_CONSOLE_TYPE (gtk);

Lisp_Object Vgtk_seen_characters;

static int
gtk_initially_selected_for_input (struct console *UNUSED (con))
{
  return 1;
}

/* Remember, in all of the following functions, we have to verify
   the integrity of our input, because the generic functions don't. */

static Lisp_Object
gtk_device_to_console_connection (Lisp_Object connection,
				  Error_Behavior UNUSED (errb))
{
  /* Strip the trailing .# off of the connection, if it's there. */

  if (NILP (connection))
    return Qnil;
  else
    {
	connection = build_ascstring ("gtk");
    }
  return connection;
}

static Lisp_Object
gtk_semi_canonicalize_console_connection (Lisp_Object connection,
					  Error_Behavior UNUSED (errb))
{
  struct gcpro gcpro1;

  GCPRO1 (connection);

  connection = build_ascstring ("gtk");

  RETURN_UNGCPRO (connection);
}

static Lisp_Object
gtk_canonicalize_console_connection (Lisp_Object connection,
				     Error_Behavior UNUSED (errb))
{
  Lisp_Object hostname = Qnil;
  struct gcpro gcpro1, gcpro2;

  GCPRO2 (connection, hostname);

  connection = build_ascstring ("gtk");

  RETURN_UNGCPRO (connection);
}

static Lisp_Object
gtk_semi_canonicalize_device_connection (Lisp_Object connection,
				         Error_Behavior UNUSED (errb))
{
  struct gcpro gcpro1;

  GCPRO1 (connection);

  connection = build_ascstring("gtk");

  RETURN_UNGCPRO (connection);
}

static Lisp_Object
gtk_canonicalize_device_connection (Lisp_Object connection,
				    Error_Behavior UNUSED (errb))
{
  struct gcpro gcpro1;

  GCPRO1 (connection);
  connection = build_ascstring("gtk");

  RETURN_UNGCPRO (connection);
}

extern Lisp_Object gtk_keysym_to_character(guint keysym);

static Lisp_Object
gtk_perhaps_init_unseen_key_defaults (struct console *UNUSED(con),
				      Lisp_Object key)
{
  Lisp_Object char_to_associate = Qnil;
  extern Lisp_Object Vcurrent_global_map, Qcharacter_of_keysym;

  if (SYMBOLP(key))
    {
      gchar *symbol_name;
      DECLARE_EISTRING(ei_symname);
      
      eicpy_rawz(ei_symname, XSTRING_DATA(symbol_name(XSYMBOL(key))));

      /* No information on the coding system of the string key names in GDK,
	 to my knowledge. Defaulting to binary, */
      eito_external(ei_symname, Qbinary);
      symbol_name = eiextdata(ei_symname);

/* GTK 2.0 has an API we can use, and makes this available in gdkkeys.h

   This has yet to be compiled, because XEmacs' GTK support hasn't yet moved
   to 2.0. So if you're porting XEmacs to GTK 2.0, bear that in mind. */
      char_to_associate 
#ifdef __GDK_KEYS_H__ 
	= Funicode_to_char
	      (make_int(gdk_keyval_to_unicode
			(gdk_keyval_from_name(symbol_name))), Qnil);
#else /* GTK 1.whatever doesn't. Use the X11 map. */
        = gtk_keysym_to_character(gdk_keyval_from_name(symbol_name));
#endif
    }
  else
    {
      CHECK_CHAR(key);
      char_to_associate = key;
    }

  if (!(HASH_TABLEP(Vgtk_seen_characters)))
    {
      Vgtk_seen_characters = make_lisp_hash_table (128, HASH_TABLE_NON_WEAK,
						   Qequal);
    }

  /* Might give the user an opaque error if make_lisp_hash_table fails,
     but it shouldn't crash. */
  CHECK_HASH_TABLE(Vgtk_seen_characters);

  if (EQ(char_to_associate, Qnil) /* If there's no char to bind,  */
      || (XCHAR(char_to_associate) < 0x80) /* or it's ASCII */
      || !NILP(Fgethash(key, Vgtk_seen_characters, Qnil))) /* Or we've seen
							      it already, */
    {
      /* then don't bind the key. */
      return Qnil;
    }

  if (NILP (Flookup_key (Vcurrent_global_map, key, Qnil))) 
    { 
      Fputhash(key, Qt, Vgtk_seen_characters);
      Fdefine_key (Vcurrent_global_map, key, Qself_insert_command); 
      if (SYMBOLP(key))
	{
	  Fput (key, Qcharacter_of_keysym, char_to_associate);
	}
      return Qt; 
    }

  return Qnil;
}

void
console_type_create_gtk (void)
{
  INITIALIZE_CONSOLE_TYPE (gtk, "gtk", "console-gtk-p");

  CONSOLE_HAS_METHOD (gtk, semi_canonicalize_console_connection);
  CONSOLE_HAS_METHOD (gtk, canonicalize_console_connection);
  CONSOLE_HAS_METHOD (gtk, semi_canonicalize_device_connection);
  CONSOLE_HAS_METHOD (gtk, canonicalize_device_connection);
  CONSOLE_HAS_METHOD (gtk, device_to_console_connection);
  CONSOLE_HAS_METHOD (gtk, initially_selected_for_input);
  CONSOLE_HAS_METHOD (gtk, perhaps_init_unseen_key_defaults);
  /* CONSOLE_HAS_METHOD (gtk, delete_console); */
}

void
reinit_console_type_create_gtk (void)
{
  REINITIALIZE_CONSOLE_TYPE (gtk);
}

void
vars_of_console_gtk (void)
{
  staticpro (&Vgtk_seen_characters);
  Vgtk_seen_characters = Qnil;
}