view src/gui-msw.c @ 5307:c096d8051f89

Have NATNUMP give t for positive bignums; check limits appropriately. src/ChangeLog addition: 2010-11-20 Aidan Kehoe <kehoea@parhasard.net> * abbrev.c (Fexpand_abbrev): * alloc.c: * alloc.c (Fmake_list): * alloc.c (Fmake_vector): * alloc.c (Fmake_bit_vector): * alloc.c (Fmake_byte_code): * alloc.c (Fmake_string): * alloc.c (vars_of_alloc): * bytecode.c (UNUSED): * bytecode.c (Fbyte_code): * chartab.c (decode_char_table_range): * cmds.c (Fself_insert_command): * data.c (check_integer_range): * data.c (Fnatnump): * data.c (Fnonnegativep): * data.c (Fstring_to_number): * elhash.c (hash_table_size_validate): * elhash.c (decode_hash_table_size): * eval.c (Fbacktrace_frame): * event-stream.c (lisp_number_to_milliseconds): * event-stream.c (Faccept_process_output): * event-stream.c (Frecent_keys): * event-stream.c (Fdispatch_event): * events.c (Fmake_event): * events.c (Fevent_timestamp): * events.c (Fevent_timestamp_lessp): * events.h: * events.h (struct command_builder): * file-coding.c (gzip_putprop): * fns.c: * fns.c (check_sequence_range): * fns.c (Frandom): * fns.c (Fnthcdr): * fns.c (Flast): * fns.c (Fnbutlast): * fns.c (Fbutlast): * fns.c (Fmember): * fns.c (Ffill): * fns.c (Freduce): * fns.c (replace_string_range_1): * fns.c (Freplace): * font-mgr.c (Ffc_pattern_get): * frame-msw.c (msprinter_set_frame_properties): * glyphs.c (check_valid_xbm_inline): * indent.c (Fmove_to_column): * intl-win32.c (mswindows_multibyte_to_unicode_putprop): * lisp.h: * lisp.h (ARRAY_DIMENSION_LIMIT): * lread.c (decode_mode_1): * mule-ccl.c (ccl_get_compiled_code): * number.h: * process-unix.c (unix_open_multicast_group): * process.c (Fset_process_window_size): * profile.c (Fstart_profiling): * unicode.c (Funicode_to_char): Change NATNUMP to return 1 for positive bignums; changes uses of it and of CHECK_NATNUM appropriately, usually by checking for an integer in an appropriate range. Add array-dimension-limit and use it in #'make-vector, #'make-string. Add array-total-size-limit, array-rank-limit while we're at it, for the sake of any Common Lisp-oriented code that uses these limits. Rename check_int_range to check_integer_range, have it take Lisp_Objects (and thus bignums) instead. Remove bignum_butlast(), just set int_n to an appropriately large integer if N is a bignum. Accept bignums in check_sequence_range(), change the functions that use check_sequence_range() appropriately. Move the definition of NATNUMP() to number.h; document why it's a reasonable name, contradicting an old comment. tests/ChangeLog addition: 2010-11-20 Aidan Kehoe <kehoea@parhasard.net> * automated/lisp-tests.el: * automated/lisp-tests.el (featurep): * automated/lisp-tests.el (wrong-type-argument): * automated/mule-tests.el (featurep): Check for args-out-of-range errors instead of wrong-type-argument errors in various places when code is handed a large bignum instead of a fixnum. Also check for the wrong-type-argument errors when giving the same code a non-integer value.
author Aidan Kehoe <kehoea@parhasard.net>
date Sat, 20 Nov 2010 16:49:11 +0000
parents ecf1ebac70d8
children 308d34e9f07d
line wrap: on
line source

/* mswindows GUI code. (menubars, scrollbars, toolbars, dialogs)
   Copyright (C) 1998 Andy Piper.
   Copyright (C) 2002 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. */

/* This file essentially Mule-ized (except perhaps some Unicode splitting).
   5-2000. */

#include <config.h>
#include "lisp.h"
#include "console-msw-impl.h"
#include "redisplay.h"
#include "gui.h"
#include "glyphs.h"
#include "frame-impl.h"
#include "elhash.h"
#include "events.h"
#include "buffer.h"

/*
 * Return value is Qt if we have dispatched the command,
 * or Qnil if id has not been mapped to a callback.
 * Window procedure may try other targets to route the
 * command if we return nil
 */
Lisp_Object
mswindows_handle_gui_wm_command (struct frame *f, HWND UNUSED (ctrl),
				 LPARAM id)
{
  /* Try to map the command id through the proper hash table */
  Lisp_Object callback, callback_ex, image_instance, frame, event;

  frame = wrap_frame (f);

  image_instance = Fgethash (make_int_verify (id), 
			     FRAME_MSWINDOWS_WIDGET_HASH_TABLE1 (f), Qnil);
  /* It is possible for a widget action to cause it to get out of sync
     with its instantiator. Thus it is necessary to signal this
     possibility. */
  if (IMAGE_INSTANCEP (image_instance))
    XIMAGE_INSTANCE_WIDGET_ACTION_OCCURRED (image_instance) = 1;
  callback = Fgethash (make_int (id), 
		       FRAME_MSWINDOWS_WIDGET_HASH_TABLE2 (f), Qnil);
  callback_ex = Fgethash (make_int (id), 
			  FRAME_MSWINDOWS_WIDGET_HASH_TABLE3 (f), Qnil);

  if (!NILP (callback_ex) && !UNBOUNDP (callback_ex))
    {
      event = Fmake_event (Qnil, Qnil);

      XSET_EVENT_TYPE (event, misc_user_event);
      XSET_EVENT_CHANNEL (event, frame);
      XSET_EVENT_TIMESTAMP (event, GetTickCount());
      XSET_EVENT_MISC_USER_FUNCTION (event, Qeval);
      XSET_EVENT_MISC_USER_OBJECT (event,
			     list4 (Qfuncall, callback_ex, image_instance, event));
    }
  else if (NILP (callback) || UNBOUNDP (callback))
    return Qnil;
  else
    {
      Lisp_Object fn, arg;

      event = Fmake_event (Qnil, Qnil);

      get_gui_callback (callback, &fn, &arg);
      XSET_EVENT_TYPE (event, misc_user_event);
      XSET_EVENT_CHANNEL (event, frame);
      XSET_EVENT_TIMESTAMP (event, GetTickCount());
      XSET_EVENT_MISC_USER_FUNCTION (event, fn);
      XSET_EVENT_MISC_USER_OBJECT (event, arg);
    }

  mswindows_enqueue_dispatch_event (event);
  /* The result of this evaluation could cause other instances to change so 
     enqueue an update callback to check this. */
  enqueue_magic_eval_event (update_widget_instances, frame);
  return Qt;
}

/*
 * Translate X accelerator syntax to win32 accelerator syntax.
 * accel = (Ichar*) to receive the accelerator character
 *         or NULL to suppress accelerators in the menu or dialog item.
 *
 * %% is replaced with %
 * if accel is NULL:
 *   %_ is removed.
 * if accel is non-NULL:
 *   %_ is replaced with &.
 *   The accelerator character is passed back in *accel.
 *   (If there is no accelerator, it will be added on the first character.)
 *
 */

Lisp_Object
mswindows_translate_menu_or_dialog_item (Lisp_Object item, Ichar *accel)
{
  Bytecount len = XSTRING_LENGTH (item);
  Ibyte *it = alloca_ibytes (2 * len + 42), *ptr = it;

  memcpy (ptr, XSTRING_DATA (item), len + 1);
  if (accel)
    *accel = '\0';

  /* Escape '&' as '&&' */
  
  while ((ptr = (Ibyte *) memchr (ptr, '&', len - (ptr - it))) != NULL)
    {
      memmove (ptr + 1, ptr, (len - (ptr - it)) + 1);
      len++;
      ptr += 2;
    }

  /* Replace XEmacs accelerator '%_' with Windows accelerator '&'
     and `%%' with `%'. */
  ptr = it;
  while ((ptr = (Ibyte *) memchr (ptr, '%', len - (ptr - it))) != NULL)
    {
      if (*(ptr + 1) == '_')
	{
	  if (accel)
	    {
	      *ptr = '&';
	      if (!*accel)
		*accel = DOWNCASE (0, itext_ichar (ptr + 2));
	      memmove (ptr + 1, ptr + 2, len - (ptr - it + 2) + 1);
	      len--;
	    }
	  else	/* Skip accelerator */
	    {
	      memmove (ptr, ptr + 2, len - (ptr - it + 2) + 1);
	      len -= 2;
	    }
	}
      else if (*(ptr + 1) == '%')
	{
	  memmove (ptr + 1, ptr + 2, len - (ptr - it + 2) + 1);
	  len--;
	  ptr++;
	}
      else	/* % on its own - shouldn't happen */
	ptr++;
    }

  if (accel && !*accel)
    {
      /* Force a default accelerator */
      ptr = it;
      memmove (ptr + 1, ptr, len + 1);
      *accel = DOWNCASE (0, itext_ichar (ptr + 1));
      *ptr = '&';

      len++;
    }

  return make_string (it, len);
}

void
syms_of_gui_mswindows (void)
{
}